Compare commits

...

345 Commits

Author SHA1 Message Date
Calvin Rose ace60e1898 Add ev/with-*lock macros. 2024-05-18 17:55:47 -05:00
Calvin Rose 91a583db27
Merge pull request #1448 from znley/master
Add LoongArch64 support
2024-05-18 06:33:07 -05:00
znley c1647a74c5 Add LoongArch64 support 2024-05-18 07:18:59 +00:00
Calvin Rose 721f280966 Add `with-env`. 2024-05-16 21:52:49 -05:00
Calvin Rose e914eaf055 Update CHANGELOG.md 2024-05-16 21:37:08 -05:00
Calvin Rose fe54013679 Update naming *module-make-env* for #1447 2024-05-16 19:11:25 -05:00
Calvin Rose fdaf2e1594 Add *module/make-env* 2024-05-16 19:10:30 -05:00
Calvin Rose 9946f3bdf4 Add buffer/format-at
Move changes over from bundle-tools branch and add testing.
2024-05-15 20:16:42 -05:00
Calvin Rose c747e8d16c Address some compiler linter messages on openbsd 2024-05-15 18:20:20 -05:00
Calvin Rose 3e402d397e Use older openbsd build for CI. 2024-05-15 18:16:19 -05:00
Calvin Rose 0350834cd3 By default, require and import extend current env. 2024-05-15 07:40:21 -05:00
Calvin Rose 60e22d9703
Merge pull request #1445 from wishdev/defbind-alias
Add ffi/defbind-alias
2024-05-11 14:25:03 -05:00
John W Higgins ee7362e847 Add ffi/defbind-alias 2024-05-09 21:31:22 -07:00
Calvin Rose 369f96b80e Update README to prefer Zulip. 2024-05-03 07:51:35 -05:00
Calvin Rose 7c5ed04ab1 A few minor improvements.
- Add long-form CLI options
- Update changelog.
- Use snprintf instead of sprintf for linters.
2024-05-02 09:13:29 -05:00
Calvin Rose 4779a445e0 Fix BSD/Macos issue for #1431 2024-04-26 19:32:47 -05:00
Calvin Rose f0f1b7ce9e Address #1431 - level-trigger mode for net/accept-loop
In the edge-trigger mode before this change, if a socket
receives 2 connections before one can be handled, then only a single
connection is handle and 1 connection will never be handled in some
cases. Reverting to level-trigger mode makes this impossible.
2024-04-26 19:28:20 -05:00
Calvin Rose 7c9157a0ed Remove unneeded `string` functions. 2024-04-26 18:11:10 -05:00
Calvin Rose 522a6cb435
Merge pull request #1440 from ahgamut/cosmo-build
Build janet with Cosmopolitan Libc
2024-04-21 08:06:51 -05:00
Gautham d0d551d739 remove superconfigure recipe 2024-04-21 01:16:54 -05:00
Gautham 71a123fef7 apelink 2024-04-21 01:14:58 -05:00
Gautham 3f40c8d7fb fix typo 2024-04-21 01:12:59 -05:00
Gautham 983c2e5499 simplify build to use only cosmocc 2024-04-21 01:10:06 -05:00
Gautham eebb4c3ade remove logging 2024-04-20 22:35:04 -05:00
Gautham 50425eac72 typo 2024-04-20 22:23:29 -05:00
Gautham 382ff77bbe typo 2024-04-20 22:16:23 -05:00
Gautham bf680fb5d3 simplify janet APE build 2024-04-20 22:09:10 -05:00
Gautham 4ed7db4f91 simplify naming 2024-04-19 10:56:46 -05:00
Calvin Rose bf19920d65 Improve casting. 2024-04-18 03:29:45 -05:00
Gautham 174b5f6686 missing folder 2024-04-16 22:24:31 -05:00
Gautham 4173645b81 missing folder 2024-04-16 22:23:12 -05:00
Gautham af511f1f55 patch folder location 2024-04-16 22:15:54 -05:00
Gautham 83c6080380 yml config for building with Cosmopolitan Libc 2024-04-16 22:02:31 -05:00
Calvin Rose 2f0c789ea1 More work to address #1391
Properly set read_fiber and write_fiber to NULL when unused.
This was causing extra listening in the poll implemenation leading to
busy loops where a read was accidentally listening for POLLOUT.
2024-04-15 21:32:17 -05:00
Calvin Rose a9b8f8e8a9 Address #1391 - set fd to negative value if not used.
See https://groups.google.com/g/comp.unix.programmer/c/bNNadBIEpTo/m/G5gs1mqNhbIJ?pli=1 for a conversation and workaround.
2024-04-15 18:12:42 -05:00
Calvin Rose f92f3eb6fa Address #1434 - add dynamic bindings for module state. 2024-04-15 16:20:13 -05:00
Calvin Rose 89e74dca3e Update freebsd build 2024-04-15 16:02:34 -05:00
Calvin Rose f2e86d2f8d
Merge pull request #1432 from wishdev/os/clock
Add additional format options for os/clock
2024-04-15 07:34:02 -05:00
John W Higgins 623da131e5 os/clock docstring typos 2024-03-27 22:32:27 -07:00
John W Higgins e89ec31ae5 Add additional format options for os/clock 2024-03-27 22:32:27 -07:00
Calvin Rose 68a6ed208e
Merge pull request #1430 from pepe/fix-win-clean
Add exists test for dist directory on build command clean
2024-03-24 10:49:34 -07:00
Calvin Rose c01b32c4f3
Merge pull request #1429 from pepe/prepare-134 2024-03-22 06:52:40 -07:00
Josef Pospíšil ee11ff9da9 Move date and sort people 2024-03-22 07:54:23 +01:00
Josef Pospíšil ed56d5d6ff Add @llmII to docs 2024-03-20 10:40:30 +01:00
Josef Pospíšil b317ab755c One more commit 2024-03-20 10:34:30 +01:00
Josef Pospíšil 9819994999 Correct changelog 2024-03-20 10:32:13 +01:00
Josef Pospíšil e9dbaa81d2 Add exists test on clean 2024-03-20 10:18:42 +01:00
Josef Pospíšil 9f9146ffae Prepare for 1.34.0 release 2024-03-20 10:11:08 +01:00
Josef Pospíšil 9d9732af97 Update changelog for 1.34.0 2024-03-20 09:57:57 +01:00
Calvin Rose ebb8fa9787
Merge pull request #1410 from sogaiu/ev-deadline-and-friends-doc-tweaks
Doc tweaks for ev/deadline and ev/with-deadline
2024-03-12 06:18:40 -07:00
Calvin Rose 9e6abbf4d4 Fix asm roundtrip issue. 2024-03-10 09:07:11 -05:00
Calvin Rose 6032a6d658
Merge pull request #1414 from MaxGyver83/master
Fix documentation of peg/replace
2024-02-24 11:06:16 -08:00
Max Schillinger c29ab22e6d Fix documentation of peg/replace 2024-02-23 12:46:45 +01:00
sogaiu 592ac4904c Doc tweaks for ev/deadline and ev/with-deadline 2024-02-23 10:59:43 +09:00
Calvin Rose 03ae2ec153
Merge pull request #1394 from amano-kenji/master
Improve documentation on subprocess API
2024-02-19 11:25:17 -08:00
Calvin Rose 3bc42d0d37 Only re-register when using poll. 2024-02-19 13:19:23 -06:00
Calvin Rose 12630d3e54 Register stream on unmarshal 2024-02-19 13:16:45 -06:00
Calvin Rose c9897f99c3 Address #1405 - don't try and resume fibers that can't be resumed.
FOr fibers that _can_ be resumed and then get cancelled, the sched_id
will be incremented later prevent the spurious wake ups.
2024-02-19 08:37:49 -06:00
Calvin Rose e66dc14b3a Formatting. 2024-02-17 13:35:07 -06:00
Calvin Rose 7a2868c147 Fix macex1 to keep syntax location for all tuples - Address #1404 2024-02-17 13:34:23 -06:00
Calvin Rose 9e0daaee09 Address #1401 - restore if-let tail calls.
Changes to avoid multiple macro expansions of the "false" branch caused
a regression in this functionality.
2024-02-15 06:30:26 -06:00
Calvin Rose c293c7de93
Merge pull request #1402 from sogaiu/each-body-before-set
Swap set / body order for each (#1400)
2024-02-15 04:05:15 -08:00
Calvin Rose 49eb5f8563
Merge pull request #1403 from llmII/fix-os-proc-wait
Fix: make `proc_get_status` compliant to OS documentation.
2024-02-15 04:01:09 -08:00
amano.kenji 674b375b2c
Improve documentation on subprocess API 2024-02-13 05:34:52 +00:00
llmII 7e94c091eb
Fix: os/proc-wait
As discused over gitter, `WIFSIGNALED` macro must be checked before one
uses the WTERMSIG macro. This change reflects that necessity and adds a
final else clause which will panic if no status code could be
determined.
2024-02-12 23:06:08 -06:00
sogaiu 5885ccba61 Swap set / body order for each (#1400) 2024-02-13 11:12:18 +09:00
Calvin Rose 431ecd3d1a Abort on assert failure instead of exit 2024-02-03 14:12:10 -06:00
Calvin Rose f6df8ff935 Expose _exit to skip certain cleanup with os/exit 2024-02-03 14:12:10 -06:00
Calvin Rose 3fd70f0951 Update debug meson options. 2024-02-03 14:12:10 -06:00
Calvin Rose bebb635d4f
Merge pull request #1392 from sogaiu/propagate-docstring-additions
Add to propagate docstring (#1365)
2024-02-03 10:52:27 -08:00
sogaiu 354896bc4b Add to propagate docstring (#1365) 2024-02-03 15:48:19 +09:00
Calvin Rose 5ddefff27e
Merge pull request #1389 from sogaiu/fiber-last-value-doc-tweak 2024-02-02 08:42:48 -08:00
sogaiu 91827eef4f Tweak fiber/last-value docstring 2024-02-02 19:06:56 +09:00
Calvin Rose 9c14c09962 Add explicit stdatomic config setting for #1374
There was some hacky workaround code for development versions of TCC
that interfered with other compilers and technically was not legal
c99.
2024-01-28 15:53:41 -06:00
Calvin Rose e85a84171f Revert local change that removes stdatomic.h 2024-01-28 07:58:22 -06:00
Calvin Rose 3a4f86c3d7 Make host and port configurable for suite-ev.janet 2024-01-28 07:56:59 -06:00
Calvin Rose 5e75963312
Merge pull request #1367 from sogaiu/debug-stacktrace-doc-tweak
Tweak debug/stacktrace docstring (#1365)
2024-01-28 05:33:11 -08:00
Calvin Rose 184d9289b5
Merge pull request #1371 from pepe/destructuring-typo
Fix typo in destructuring
2024-01-28 05:33:05 -08:00
Calvin Rose b7ff9577c0
Merge pull request #1373 from sogaiu/module-expand-path-doc-suggestion
Address #1370
2024-01-28 05:32:50 -08:00
sogaiu 942a1aaac6 Address #1370 2024-01-27 21:20:27 +09:00
Josef Pospíšil 69f0fe004d Fix typo in destructuring 2024-01-26 14:36:56 +01:00
sogaiu 2a04347a42 Tweak debug/stacktrace docstring (#1365) 2024-01-24 16:52:37 +09:00
Calvin Rose 1394f1a5c0
Merge pull request #1364 from sogaiu/module-expand-path-doc-tweak
Cosmetically tweak module/expand-path docstring
2024-01-23 16:01:49 -08:00
sogaiu cf4d19a8ea Cosmetically tweak module/expand-path docstring 2024-01-22 22:16:14 +09:00
Calvin Rose 23b0fe9f8e
Merge pull request #1360 from pepe/patch-1 2024-01-17 11:51:59 -08:00
Josef Pospíšil 1ba718b15e
Update CHANGELOG.md 2024-01-17 13:58:00 +01:00
Calvin Rose df5f79ff35
Merge pull request #1359 from pnelson/binary
Add buffer/push-* sized int and float
2024-01-15 08:56:57 -08:00
Calvin Rose 6d7e8528ea
Merge pull request #1346 from ianthehenry/peg-split
add a new (split) PEG special
2024-01-15 08:16:06 -08:00
Philip Nelson 197bb73a62 Add buffer/push-* sized int and float 2024-01-14 15:32:13 -08:00
Calvin Rose f91e599451
Merge pull request #1351 from pepe/1.33 2024-01-07 13:30:08 -06:00
Josef Pospíšil 5b9aa9237c Prepare for 1.33.0 release 2024-01-07 16:26:20 +01:00
Ian Henry 61f38fab37
add a new (split) PEG special
This works similarly to string/split, but the separator is a PEG.
2024-01-05 22:02:52 -08:00
Calvin Rose 9142f38cbc Fix #1341. 2024-01-01 08:58:31 -06:00
Calvin Rose e8ed961572
Merge pull request #1344 from ianthehenry/peg-sub-special
Add a new (sub) PEG special
2023-12-31 18:40:47 -06:00
Calvin Rose be11a2a1ad Fix #1342 2023-12-31 18:36:55 -06:00
Ian Henry ea75086300
add a new (sub) PEG special
(sub) will first match one pattern, then match another pattern against the
text that the first pattern advanced over.
2023-12-28 22:15:54 -08:00
Calvin Rose 9eeefbd79a
Merge pull request #1340 from sogaiu/string-format-doc-tweak 2023-12-20 09:10:26 -06:00
sogaiu c573a98363 Cosmetically tweak string/format docstring 2023-12-19 18:33:47 +09:00
Calvin Rose 11d7af3f95 Work on addressing #1337 - fix valgrind case. 2023-12-18 08:56:27 -06:00
Calvin Rose a10b4f61d8 Address #1337 (leet!).
Changes a few scheduling details and adds a 0 byte explicitly to
symbols created via gensym.
2023-12-16 16:15:46 -06:00
Calvin Rose a0cb7514f1 Update Makefile for #1329
Add separate import library for libjanet.so and janet.exe with Mingw.
This was causing issues with linking.
2023-12-09 10:11:15 -06:00
Calvin Rose b066edc116
Merge pull request #1336 from pepe/peg-arity-typo 2023-12-07 11:31:13 -06:00
Josef Pospíšil 938f5a689e Fix arity typo in peg 2023-12-07 14:08:03 +01:00
Calvin Rose 772f4c26e8
Merge pull request #1334 from iacore/fix-0
fix (doc next)
2023-12-02 17:28:32 -06:00
Locria Cyber 6b5d151beb
fix typo in (doc next) 2023-12-02 15:38:35 +00:00
Calvin Rose a9176a77e6 Prevent bytecode optimization from remove mk* instructions.
These instructions read from the stack, and therefor have side effects.
Removing them without clearing the stack results in broken bytecode.
2023-11-22 08:18:23 -06:00
Calvin Rose 16f409c6a9 Typo for SIGALARM in os/proc-kill 2023-11-21 21:51:56 -06:00
Calvin Rose 9593c930de Address #1326 in a dynamic way that is fairly conservative.
Another optimization would be to keep track of immutable closure
captures (vs. mutable closure captures) and always detach them.
2023-11-14 21:13:21 -06:00
Calvin Rose 56f33f514b Fix regression #1327 2023-11-14 19:52:22 -06:00
Calvin Rose 1ccd544b94 Address #1326 - marshal_one_env w/ JANET_MARSHAL_UNSAFE.
This allows uses the precise closure state capture
when marshalling data between threads. This prevents
accidental state capture when using ev/do-thread or similar
with closures that reference the current state.
2023-11-10 15:36:45 -06:00
Calvin Rose 93c83a2ee2 Fix warnings w/ MSVC and format. 2023-11-10 15:02:10 -06:00
Calvin Rose f459e32ada
Merge pull request #1325 from zevv/zevv-connect-cleanup
net/ev: Cleaned up unused NetStateConnect, fixed janet_async_end() ev refcount
2023-11-10 15:01:43 -06:00
Ico Doornekamp 9b640c8e9c net/ev: Cleaned up unused NetStateConnect, fixed janet_async_end() ev refcount 2023-11-10 20:34:17 +01:00
Calvin Rose a3228f4997 Add changes and test cases for #1324 2023-11-09 11:18:03 -06:00
Calvin Rose 715eb69d92 Add more ipv6 feature detection. 2023-11-03 18:24:35 -05:00
Calvin Rose df2d5cb3d3 Add ipv6, shared, and cryptorand options to meosn.
Allows for builting with cosmopolitan, both with meson
and Makefile. Use:

CC=comsocc meson setup -Dipv6=false -Ddynamic_modules=false
-Dshared=false -Dos_name=cosmopolitan

to configure for cosmopolitan build.
2023-11-02 08:56:10 -05:00
Calvin Rose 3b189eab64 Fix #1321, poll event loop CPU usage issue
A stream may have a fiber attached for memory management purposes, but
not actually be waiting on anything. Be more seletive with poll, which
is not edge-triggered, to not poll for readiness on these streams.
2023-10-29 11:34:21 -05:00
Calvin Rose 609b629c22 Add support for atomic loads in Janet's atomic abstraction. 2023-10-21 10:40:57 -05:00
Calvin Rose e74365fe38 Be a bit safer with reference counting.
We might want to revisit some uses of refcounts in the
ev module to be more efficient if we care about signal atomicity
(where memory order isn't really important) or multithreading atomicity.
2023-10-21 09:55:00 -05:00
Calvin Rose 46b34833c2
Merge pull request #1314 from williewillus/pr1314
Use libc strlen in janet_buffer_push_cstring
2023-10-20 15:41:29 -07:00
Vincent Lee 045c80869d Use libc strlen in janet_buffer_push_cstring
Platform libc's often contains optimized assembly implementations of strlen, so take
advantage of them here instead of doing a naive count.
2023-10-19 23:30:28 -07:00
Calvin Rose 2ea2e72ddd
Merge pull request #1313 from sogaiu/default-peg-grammar-additions
Add more + and * keywords to default-peg-grammar
2023-10-19 19:26:10 -07:00
sogaiu 1b17e12fd6 Add more + and * keywords to default-peg-grammar 2023-10-19 18:45:20 +09:00
Calvin Rose cc5beda0d2 Update patch release. 2023-10-15 14:33:43 -05:00
Calvin Rose a363fd926d Update CHANGELOG.md 2023-10-15 14:32:56 -05:00
Calvin Rose 21ebede529 Move posix-fork inside correct if-def
Don't compile if processes are disabled.
2023-10-15 11:03:26 -05:00
Calvin Rose 15d67e9191
Merge pull request #1310 from Andriamanitra/patch-forward-word
Change Alt-f in the REPL move to next end of word instead of beginning
2023-10-14 18:36:05 -07:00
Calvin Rose b5996f5f02 Update for 1.32.0 2023-10-14 19:48:20 -05:00
Andriamanitra 83204dc293 Change Alt-f in the REPL move to next end of word instead of beginning 2023-10-14 14:21:16 +03:00
Calvin Rose e3f4142d2a Update result value from janet_do* functions. 2023-10-12 05:26:23 -05:00
Calvin Rose f18ad36b1b Rework #1306 - better default for pretty printing numbers.
Not perfect for serialization, but a representation that
plays well with both safe integers (z where abs(z) < 2^54) and
non-integer floats.
2023-10-11 00:59:57 -05:00
Calvin Rose cb25a2ecd6 Avoid using execvpe function. 2023-10-08 21:33:15 -05:00
Calvin Rose 741a5036e8 Add %D and %I for 64 bit formatting.
Instead of breaking old code with changing %i and %d.
2023-10-08 21:23:03 -05:00
Calvin Rose 549ee95f3d Add os/posix-exec (along os/posix-fork)
Useful for old-style unix daemons, start up scripts, and so on.
Easy to add on top of os/execute.

May want to consider allowing the same IO redirection as os/execute
and os/spawn.

May also want to put both fork and exec behind a config switch since I
suppose some systems may not support them, although I don't know of any
concrete examples.
2023-10-08 21:03:08 -05:00
Calvin Rose 6ae81058aa Be more consistent with va_arg types. 2023-10-08 19:09:35 -05:00
Calvin Rose 267c603824 Don't use full parallelism to avoid oom 2023-10-08 18:37:31 -05:00
Calvin Rose a8f583a372 CMD isn't bash 2023-10-08 18:34:04 -05:00
Calvin Rose 2b5d90f73a Disable amalgamation w/ mingw in CI due to memory limitations 2023-10-08 18:28:07 -05:00
Calvin Rose 4139e426fe Refine interface for janet's new event loop.
Infer the current root fiber and force user to
allocate state for async events.
2023-10-08 18:25:46 -05:00
Calvin Rose a775a89e01 Improve assert-no-error test helper. 2023-10-08 17:34:50 -05:00
Calvin Rose 990f6352e0 Allow for unregistered streams w/ kqueue. 2023-10-08 17:21:42 -05:00
Calvin Rose b344702304 Merge branch 'master' into ev-epoll-fewer-syscalls 2023-10-08 17:20:20 -05:00
Calvin Rose d497612bce Revert 2023-10-08 17:18:36 -05:00
Calvin Rose 2a3b101bd8 ktrace trace -c 2023-10-08 16:25:55 -05:00
Calvin Rose 63e93af421 Ktrace 2023-10-08 16:00:33 -05:00
Calvin Rose ab055b3ebe i dont know how ktrace works 2 2023-10-08 15:54:57 -05:00
Calvin Rose a9a013473f i dont know how ktrace works 2023-10-08 15:53:44 -05:00
Calvin Rose 87de1e5766 Quick experiment on macos 2023-10-08 15:51:44 -05:00
Calvin Rose 894aaef267 Mac please 2023-10-08 15:42:54 -05:00
Calvin Rose e209e54ffe bsds are very strict on C standards
No labels before declarations.
2023-10-08 15:37:23 -05:00
Calvin Rose 7511eadaa7 Update code for freebsd and ENODEV on stream register 2023-10-08 15:26:02 -05:00
Calvin Rose 6c4906605a Some bsds return ENODEV for devices like /dev/null 2023-10-08 15:09:53 -05:00
Calvin Rose 8a9be9d837 Make sure posted events are read from non-blocking socket. 2023-10-08 13:46:24 -05:00
Calvin Rose b72098cc71 remove extra decref 2023-10-08 13:24:42 -05:00
Calvin Rose defe60e08b Handle refcounts in posted events. 2023-10-08 13:18:08 -05:00
Calvin Rose 7f852b8af4 Handle refcounts in posted events. 2023-10-08 13:14:36 -05:00
Calvin Rose d71c100ca7 Revert "Add EV_EOF and EV_CLEAR to selfpipe for kqueue"
This reverts commit 5442c8e86d.
2023-10-08 13:13:58 -05:00
Calvin Rose 5442c8e86d Add EV_EOF and EV_CLEAR to selfpipe for kqueue 2023-10-08 12:34:13 -05:00
Calvin Rose cf4901e713 Update docstring for os/posix-fork 2023-10-08 11:54:25 -05:00
Calvin Rose 4b8c1ac2d2 Add os/posix-fork
Very simple fork function that returns a process object that can be
waited on.
2023-10-08 11:09:00 -05:00
Calvin Rose 555e0c0b85 Try to capture more events in kqueue. 2023-10-08 10:52:27 -05:00
Calvin Rose dc301305de Turn off verbose CI builds for BSD. 2023-10-07 21:35:38 -05:00
Calvin Rose f1111c135b Work on kq 2023-10-07 21:32:20 -05:00
Calvin Rose 3905e92965 kqueue mirror master branch implementation a bit better. 2023-10-07 12:53:59 -07:00
Calvin Rose 1418ada38f Remove duplicate code in kqueue event handling. 2023-10-07 12:40:43 -07:00
Calvin Rose 9256a66b76 Update ev.c for removing msvc warnings 2023-10-07 12:11:14 -07:00
Calvin Rose e8c013a778 Remove some extra fiber state and use a flag. 2023-10-07 12:07:05 -07:00
Calvin Rose fea8242ea7 Reuse overlapped overhead on windows for something useful. 2023-10-07 11:25:20 -07:00
Calvin Rose 7bfb17c209 Lots of work to make iocp work again.
Big issue with IOCP vs. poll variants is that the overlapped
structures have a longer lifetime than intermediate state needed
for epoll. One cannot free overlapped structures after closing a
handle/socket, like one can do with any intermediate state when using
readiness-based IO.
2023-10-07 11:18:43 -07:00
Calvin Rose e7e4341e70 Add EV_EOF for kqueue. 2023-10-06 17:39:52 -05:00
Calvin Rose 6186be4443 Run tests verbosely 2023-10-06 01:40:12 -05:00
Calvin Rose d07f01d7cb Update kqueue 2023-10-06 01:33:51 -05:00
Calvin Rose 73291a30a0 Update marsh.c 2023-10-06 01:26:07 -05:00
Calvin Rose a3b129845b Quick blind take on getting kqueue similar to poll and poll. 2023-10-06 00:48:05 -05:00
Calvin Rose 0ff8f58be8 Simpler async model that is better suited to epoll 2023-10-06 00:37:19 -05:00
Calvin Rose 66292beec9 Don't mess with async connect on BSDs. 2023-10-04 23:33:40 -05:00
Calvin Rose bf2af1051f Missing && 2023-10-04 23:29:54 -05:00
Calvin Rose b6e3020d4c Attempt 2 to fix bsd compilation errors. 2023-10-04 23:27:56 -05:00
Calvin Rose 8f516a1e28 Address some bsd issues. 2023-10-04 23:24:40 -05:00
Calvin Rose 5f2e287efd Make epoll event loop use EPOLLET and not reregister file descriptors.
This results in fewer system calls and presumably more effcient code. It
also brings the epoll (and kqueue) code more in line with how the
windows IOCP code works, incidentally.
2023-10-04 22:35:04 -05:00
Calvin Rose 8c0d65cf9f
Merge pull request #1301 from ianthehenry/typos 2023-10-03 19:25:01 -07:00
Ian Henry fa609a5079
fix some typos in docstrings 2023-10-03 19:17:18 -07:00
Calvin Rose c708ff9708 Allow for qemu and other simulator based testing. 2023-10-02 23:31:55 -07:00
Calvin Rose 2ea90334a3 Remove some checking code for iocp events.
Be more permissive abouts events we get.
2023-10-02 23:25:26 -07:00
Calvin Rose eea8aa555f Revert dccb60b to address #1299
This commit was to address issues with a use after free error in the
windows event loop, but the erroneous code was later reworked.
2023-10-03 00:14:25 -05:00
Calvin Rose 51a75e1872 Update janet_interpreter_interrupt to use new atomics 2023-10-01 10:52:05 -05:00
Calvin Rose af7ed4322e Get rid of req for 64 bit atomics 2023-10-01 10:27:51 -05:00
Calvin Rose 7cdd7cf6eb Expose atomic refcounts to be easier to port.
This code was duplicate in a few places.
2023-10-01 10:09:23 -05:00
Calvin Rose 26aa622afc Update CHANGELOG.md 2023-09-30 12:26:50 -05:00
Calvin Rose 84ad161f1e Add support for weak references in arrays.
Also change weak table syntax to not require keyword arguments.
2023-09-30 10:56:43 -05:00
Calvin Rose 6efb965dab Merge branch 'weak-tables' 2023-09-29 07:38:21 -05:00
Calvin Rose 8c90a12e0f More test cases. 2023-09-29 07:37:33 -05:00
Calvin Rose 2d54e88e74 Update CHANGELOG.md 2023-09-28 20:41:19 -05:00
Calvin Rose 16ea5323e0 More meson tweaks. 2023-09-28 20:32:14 -05:00
Calvin Rose 7a23ce2367 See if we can fix sr.ht build due to change in install. 2023-09-28 20:24:19 -05:00
Calvin Rose e05bc7eb54 Address compiler bug with `break`.
Using result from `break` expression could trigger code that would
work, yet contain invalid, dead code preventing good marshalling.
2023-09-28 20:14:22 -05:00
Calvin Rose b3a6e25ce0 Add weak references in the form of weak tables.
Any references exclusively held by a weak table may be collected
without the programmer needing to free references manually. A table
can be setup to have weak keys, weak values, or both.
2023-09-27 23:36:09 -05:00
Calvin Rose b63d41102e Fix bad merge. 2023-09-27 22:34:46 -05:00
Calvin Rose 964295b59d Merge branch 'net-reworkings' 2023-09-27 19:06:14 -05:00
Calvin Rose d19db30f3d Fix meson install test. 2023-09-27 00:19:35 -05:00
Calvin Rose d12464fc0e Make poll work by going back to array of listeners for gc keeping. 2023-09-26 23:02:06 -05:00
Calvin Rose a96971c8a7 More work on epoll implementation. 2023-09-26 12:05:06 -05:00
Calvin Rose f6f769503a Fix up ev.c to pass tests. 2023-09-26 11:11:29 -05:00
Calvin Rose 82917ac6e3 Kqueue fix. 2023-09-25 19:17:51 -07:00
Calvin Rose a6ffafb1a2 Patches to kqueue implementation. 2023-09-25 19:07:18 -07:00
Calvin Rose fb8c529f2e Partial work updating epoll reimplentation. 2023-09-25 18:52:15 -07:00
Calvin Rose 1ee98e1e66 Get IOCP reworked event loop passing tests. 2023-09-25 15:19:39 -07:00
Calvin Rose 81f35f5dd1 Redo state management for Janet listeners.
Make more use of the built in GC code for abstracts to
be sure things are more correct. Issue before was streams could
be freed before IOCP events arrived.
2023-09-25 00:43:36 -07:00
Calvin Rose 1b402347cd Work on debugging issue with server spawning. 2023-09-24 18:15:58 -07:00
Calvin Rose 7599656784 Update meson build once more. 2023-09-24 15:35:40 -07:00
Calvin Rose dccb60ba35 Ignore IOCP where the event failed to deque. 2023-09-24 12:53:06 -07:00
Calvin Rose ae642ceca0 Don't hide windows segfaults in build_win.bat. 2023-09-24 12:36:15 -07:00
Calvin Rose 471b6f9966 Add TOCLOSE back. 2023-09-24 12:28:35 -07:00
Calvin Rose 5dd18bac2c More fixups to gc.c 2023-09-24 11:51:22 -07:00
Calvin Rose 018f4e0891 Remove some old code. 2023-09-24 10:30:58 -07:00
Calvin Rose e85809a98a Remove remains of gc instrumentation code. 2023-09-24 10:11:24 -07:00
Calvin Rose e6e9bd8147 Redo async connect code to be moved out of ev.c.
Async connect is different than write.
2023-09-24 10:08:40 -07:00
Calvin Rose 221645d2ce More refinement of meson build. 2023-09-23 14:16:13 -07:00
Calvin Rose 2f4a6214a2 Make meson build work on windows.
By default, use more traditional linking pattern with meson.
The janet.exe will now link to janet-x.x.dll on windows (and
similar for linux/posix) when built with meson. This is slightly
less efficient and means that janet.exe built this way is no longer
standalone (you would need to move the dll along with the exe), but
plays better with most build systems.
2023-09-23 08:53:37 -07:00
Calvin Rose e00a461c26 Add optional buffer-size to file/open.
This calls setvbuf to change FILE buffering. A goal is
to be able to use the existing file/* functions for blocking
IO analogous to `read` and `write` system calls.
2023-09-23 09:40:17 -05:00
Calvin Rose c31314be38
Merge pull request #1296 from Andriamanitra/doc-loop-unless
add :unless modifier to (doc loop)
2023-09-22 05:41:06 -07:00
Andriamanitra ee142c4be0 truthy/falsey is more accurate than true/false 2023-09-22 03:04:41 +03:00
Andriamanitra aeacc0b31b add :unless modifier to (doc loop) 2023-09-21 19:23:40 +03:00
Calvin Rose 7b4c3bdbcc Address issues from #1294 on non-nanboxed platforms.
Underlying bug was obscured by nanbox implementation.
2023-09-21 07:36:53 -07:00
Calvin Rose 910b9cf1fd Distinguish between JANET_API and JANET_EXPORT
One is a way to export symbols, the other a way to reference
API functions. Also include prebuilt dlljanet.dll and dlljanet.lib
for windows to save people the trouble of compiling janet.c themselves.
2023-09-20 20:07:03 -07:00
Calvin Rose b10aaceab0 Work on dllimport option for janet. 2023-09-20 17:34:42 -07:00
Calvin Rose 169bd812c9 Update state.h to #include <windows.h>
Should fix usage with msvc in some pipelines.
2023-09-18 23:51:15 -05:00
Calvin Rose 34767f1e13
Merge pull request #1292 from sogaiu/tweak-janetconf-h 2023-09-18 18:50:46 -07:00
sogaiu 4f642c0843 Tweak janetconf.h 2023-09-19 10:34:50 +09:00
Calvin Rose 4e5889ed59 Prepare for 1.31.0 release. 2023-09-17 14:53:03 -05:00
Calvin Rose a1b848ad76
Merge pull request #1288 from sogaiu/more-error-loc-info-in-dobytes
Report line and col more in janet_dobytes
2023-09-14 08:21:52 -07:00
Calvin Rose dbcc1fad3e
Merge pull request #1289 from primo-ppcg/loop-unless
Add `:unless` loop modifier
2023-09-13 11:56:33 -07:00
primo-ppcg db366558e7 add `:unless` loop modifier 2023-09-13 15:21:46 +07:00
sogaiu a23c03fbd0 Report line and col more in janet_dobytes 2023-09-13 15:41:14 +09:00
Calvin Rose ff18b92eb0
Merge pull request #1287 from pepe/fix-arr-push-doc
Document array/push variadic argument
2023-09-12 07:07:42 -07:00
Josef Pospíšil 7f148522ab Document array/push variadic argument 2023-09-12 09:34:21 +02:00
Calvin Rose 159c612924 Update changelog.md 2023-09-09 11:03:14 -05:00
Calvin Rose b95dfd4bdf Update docstring. 2023-09-09 10:58:20 -05:00
Calvin Rose e69954af2f
Merge pull request #1283 from primo-ppcg/mean-partition
Update `partition`, `mean`
2023-09-09 10:30:11 -05:00
primo-ppcg a5ff26f602 add more test cases for `partition` and `mean` 2023-09-08 16:30:44 +07:00
primo-ppcg a7536268e1 update `partition` 2023-09-08 12:38:58 +07:00
primo-ppcg 541469371a update `mean` 2023-09-08 11:35:37 +07:00
Calvin Rose a13aeaf955
Merge pull request #1281 from primo-ppcg/interleave-interpose
Update `interleave`, `interpose`
2023-09-04 10:27:27 -05:00
primo-ppcg 9cf674cdcb update `interleave`, `interpose` 2023-09-04 17:09:53 +07:00
Calvin Rose 51c0cf97bc
Merge pull request #1280 from primo-ppcg/lengthable
Add `lengthable?`
2023-09-01 17:41:25 -05:00
primo-ppcg 4cb1f616c5 allow `reverse` on non-lengthable 2023-09-01 16:04:21 +07:00
primo-ppcg 645109048b update `keys`, `values`, `pairs` 2023-09-01 13:18:31 +07:00
primo-ppcg f969fb69e1 add `lengthable?` 2023-09-01 13:04:53 +07:00
Calvin Rose bfb60fdb84
Merge pull request #1278 from primo-ppcg/loop-range
Allow one-term `:range` and `:down` forms
2023-08-29 08:23:36 -05:00
primo-ppcg 2f43cb843e Allow one-term `:range` and `:down` forms 2023-08-29 10:59:16 +07:00
Calvin Rose 874fd2aba7 don't crash repl if someone sets a bad *pretty-format* 2023-08-27 13:09:22 -05:00
Calvin Rose 33d1371186 Update specials.c for formatting. 2023-08-25 16:28:41 -05:00
Calvin Rose d2dd241e6b
Merge pull request #1269 from primo-ppcg/check-nil-form
Optimize nil conditions for while and if
2023-08-24 09:30:58 -05:00
Calvin Rose 4ecadfabf4 Fix atomics - warnings on windows 2023-08-24 08:00:50 -05:00
Calvin Rose ffd79c6097 Allow multiple simultaneous interrupts cleanly for #1262
Instead of setting a flag, each interrupt increments an atomic
counter. When the interrupt is finally handled, either by scheduling
code to run on the event loop or executing some out of band code, the
user must now decrement the interrupt counter with
janet_interpreter_interrupt_handled. While this counter is non-zero, the
event loop will not enter the interpreter. This changes the API a bit but
makes it possible and easy to handle signals without race conditions
or scheduler hacks, as the runtime can ensure that high priority code is
run before re-entering possibly blocking interpreter code again.

Also included is a new function janet_schedule_soon, which prepends to
the task queue instead of appending, allowing interrupt handler to skip
ahead of all other scheduled fibers.

Lastly, also update meson default options to include the
interpreter_interrupt code and raise a runtime error if os/sigaction
is used with interpreter interrupt but that build option is not enabled.
2023-08-24 07:38:53 -05:00
primo-ppcg 35a8d2a519 Optimize nil conditions for while and if 2023-08-24 17:50:31 +07:00
Calvin Rose 21eab7e9cc Update sigaction to help address #1262.
Update example to have 4 cases - case 3 was previously broken but should
now work.
2023-08-23 09:16:59 -05:00
Calvin Rose d9605c2856 Allow iterating over generators with pairs, keys, and values. 2023-08-22 19:25:05 -05:00
Calvin Rose 70a467d469
Merge pull request #1266 from primo-ppcg/min-max
Speed up `min`, `max`
2023-08-21 22:32:03 -05:00
primo-ppcg 6e8979336d speed up `min`, `max` 2023-08-22 00:39:28 +07:00
Calvin Rose ee01045db5 Update CHANGELOG.md 2023-08-20 15:56:58 -05:00
Calvin Rose b7f8224588 Address #1263
Fix reference counting when cleaning up unused abstract types
per-thread.
2023-08-20 14:53:25 -05:00
Calvin Rose ca4c1e4259 Try to use atomics inside signal handler for ref count. 2023-08-20 08:49:49 -05:00
Calvin Rose 91712add3d Fix threaded abstracts in min build. 2023-08-19 20:19:05 -05:00
Calvin Rose 7198dcb416 Add sanboxing for signal handling. 2023-08-19 17:44:04 -05:00
Calvin Rose 08e20e912d Use pthread_sigmask when adding signal handlers. 2023-08-19 17:30:55 -05:00
Calvin Rose f45571033c Add os/sigaction for signal handling.
Also improve interrupts to work better with busy loops
and signals.
2023-08-19 13:26:29 -05:00
Calvin Rose 2ac36a0572
Merge pull request #1257 from primo-ppcg/any-every
Update `any?`, `every?`
2023-08-18 07:20:44 -05:00
Calvin Rose 3df1d54847
Merge pull request #1258 from primo-ppcg/each
Update `each` keys before body
2023-08-18 07:16:19 -05:00
Calvin Rose f3969b6066
Merge pull request #1259 from primo-ppcg/buffer-from-bytes
Add `buffer/from-bytes`
2023-08-18 07:15:08 -05:00
primo-ppcg 6222f35bc8 add `buffer/from-bytes` 2023-08-18 12:35:12 +07:00
primo-ppcg 2f178963c0 update `each` keys before body 2023-08-18 10:32:24 +07:00
primo-ppcg 15760b0950 update `any?`, `every?`
Updates `any?` and `every?` to be exact functional analogues to `or` and `and`.
2023-08-18 07:39:30 +07:00
Calvin Rose 43a6a70e1e
Merge pull request #1255 from primo-ppcg/sort
Special case common `sort` usages
2023-08-16 20:34:17 -05:00
Calvin Rose cd36f1ef5f Distinguish between threaded channels and non-threaded when marshalling.
Threaded channels _can_ be marshalled, just not for communication
between threads. This is a special case since the same abstract type
is used for both threaded and non-threaded channels.
2023-08-16 14:26:52 -05:00
primo-ppcg cdd7083c86 special case common `sort` usages 2023-08-15 11:58:22 +07:00
Calvin Rose 8df7364319 Quick fix for discussion #1253
Protect against garbage collection during connect.
2023-08-13 12:00:54 -05:00
Calvin Rose 63023722d1
Merge pull request #1246 from wooosh/use-object-typedefs
Use typedefs for strings, symbols, keywords, tuples, structs, and abstracts.
2023-08-13 08:33:19 -05:00
Calvin Rose 79c12e5116
Merge pull request #1252 from primo-ppcg/reverse
Rework `reverse`, again
2023-08-12 14:29:23 -05:00
primo-ppcg 53e16944a1 rework `reverse`, again 2023-08-13 00:54:17 +07:00
Calvin Rose 7475362c85
Merge pull request #1249 from primo-ppcg/compare
Speed up `compare` functions
2023-08-11 19:27:42 -05:00
primo-ppcg 9238b82cde speed up `compare` 2023-08-11 23:48:29 +07:00
Calvin Rose 7049f658ec
Merge pull request #1244 from primo-ppcg/bytes-indexed-dictionary
Move `bytes?`, `indexed?`, `dictionary?` to corelib
2023-08-09 17:56:35 -05:00
wooosh 701913fb19 Use typedefs for strings, symbols, keywords, tuples, structs, and abstracts. 2023-08-09 16:09:34 -04:00
primo-ppcg 831f41a62b move `bytes?`, `indexed?`, `dictionary?` to corelib 2023-08-08 10:00:05 +07:00
Calvin Rose 0ea1da80e7
Merge pull request #1242 from primo-ppcg/reverse
Rework `reverse`
2023-08-06 08:10:56 -05:00
Calvin Rose 06eea74b98
Merge pull request #1241 from primo-ppcg/keys-values-pairs
Rework `keys`, `values`, `pairs`
2023-08-06 08:10:43 -05:00
primo-ppcg c8c0e112bc rework `reverse` 2023-08-06 16:16:41 +07:00
primo-ppcg 7417e82c51 rework `keys`, `values`, `pairs` 2023-08-06 15:39:16 +07:00
Calvin Rose ecc4d80a5a Prepare for 1.30.0 release. 2023-08-05 18:58:04 -05:00
Calvin Rose 3df24c52f4
Merge pull request #1236 from primo-ppcg/range
Move `range` to corelib
2023-08-05 18:05:37 -05:00
primo-ppcg 8a70fb95b5 slight refactoring 2023-08-05 11:00:23 +07:00
primo-ppcg d8b45ecd61 better test coverage 2023-08-03 20:39:32 +07:00
primo-ppcg 61712bae9c speed up range creation 2023-08-02 01:26:03 +07:00
Calvin Rose 4ff81a5a25 Add strip in release process instead of local builds - Address #1233 2023-07-27 21:40:07 -05:00
Calvin Rose 08f0e55d8f Add strip in release process instead of local builds - Address #1233 2023-07-27 21:37:48 -05:00
Calvin Rose 080b37cb31 Update CHANGELOG. 2023-07-25 17:51:21 -05:00
Calvin Rose bbdcd035ba
Merge pull request #1231 from sogaiu/tweak-file-open-doc 2023-07-23 23:20:09 -05:00
sogaiu f9233ef90b Add fopen reference to file/open docstring 2023-07-23 18:39:20 +09:00
Calvin Rose cd3573a4d2
Merge pull request #1224 from primo-ppcg/array-remove 2023-07-15 06:42:15 -05:00
Calvin Rose 738fe24e6d Allow buffer/blit to take explicit nils for default args.
Also small changes for range checking code.
2023-07-14 20:04:10 -05:00
primo-ppcg c2e55b5486 update docstrings for `string/slice` and `tuple/slice` 2023-07-15 00:52:12 +07:00
Calvin Rose 989f0726e3 Make encoding of immediate values capture full range. 2023-07-14 10:06:20 -05:00
primo-ppcg bdefd3ba1e update final array index to be -1 2023-07-14 17:34:55 +07:00
Calvin Rose 4efcff33bd Update inttypes. 2023-07-13 19:58:38 -05:00
Calvin Rose 8183cc5a8d Disallow converting negative numbers to int/u64
The wrap-around rule doesn't make sense once subtraction is
properly fixed.
2023-07-09 22:25:20 -05:00
Calvin Rose f3bda1536d Remove some dead code in cfuns.c 2023-07-09 22:02:10 -05:00
Calvin Rose 3b6371e03d Add test case for issue #1217 2023-07-09 21:56:41 -05:00
Calvin Rose b5d3c87253 Add new opcode subtract immediate. 2023-07-09 21:51:16 -05:00
Calvin Rose f73b8c550a
Merge pull request #1213 from sogaiu/src-view-for-ppasm
Add source view to .ppasm output
2023-07-09 10:54:55 -05:00
Calvin Rose 5437744126
Merge pull request #1216 from sogaiu/tweak-test-grammar-peg
Update and ascii-sort string escapes in peg
2023-07-08 09:26:03 -05:00
sogaiu 5a5e70b001 Update and ascii-sort string escapes in peg 2023-07-08 17:54:00 +09:00
sogaiu 348a5bc0a9 Add source view to .ppasm output 2023-07-06 13:26:03 +09:00
Calvin Rose 026c64fa01 Formatting. 2023-07-02 15:23:22 -05:00
Calvin Rose e38663c457 Update CHANGELOG.md 2023-07-02 13:44:39 -05:00
Calvin Rose 117c741c29 Add test for marshalling channels. 2023-07-02 13:13:59 -05:00
Calvin Rose 9bc5bec9f1 More complete fix with some debugging tools. 2023-07-02 13:04:42 -05:00
Calvin Rose a5f4e4d328 Test small fix for marshalling. 2023-07-02 12:58:55 -05:00
Calvin Rose db0abfde72 Cache references when marshalling abstract types. 2023-07-01 18:02:56 -05:00
Calvin Rose edf263bcb5 Make some fixes to marshalling. 2023-07-01 17:59:07 -05:00
Calvin Rose 60fba585e3 Remove extra MARK_SEEN 2023-07-01 17:37:12 -05:00
Calvin Rose ebb6fe5be3 Patch fix for #1210 2023-07-01 10:34:11 -05:00
Calvin Rose d91c95bf92
Merge pull request #1210 from primo-ppcg/int-bnot
Add bnot for int types
2023-07-01 10:19:04 -05:00
primo-ppcg 2007438424 add tests for inttypes bnot 2023-07-01 21:49:49 +07:00
primo-ppcg 81423635ad Add bnot to int types 2023-07-01 21:41:55 +07:00
Calvin Rose 58d297364a Change code for marshalling abstract types. 2023-07-01 08:50:56 -05:00
Calvin Rose db902c90c4
Merge pull request #1207 from primo-ppcg/divmod
floor div, variadic mod
2023-07-01 08:47:06 -05:00
Calvin Rose 42ccd0f790
Merge pull request #1209 from pyrmont/bugfix.strip-macos
Avoid removing too many symbols with strip on macOS
2023-07-01 08:46:35 -05:00
Michael Camilleri 20ec6f574e
Avoid removing too many symbols with strip on macOS 2023-07-01 19:33:38 +09:00
primo-ppcg b3db367ae7 Add test cases for div and mod 2023-06-30 19:48:45 +07:00
primo-ppcg 8a62c742e6 define `(mod x 0)` as `x`
See: Knuth, Donald E., _The Art of Computer Programming: Volume 1: Fundamental Algorithms_, pp. 15 ([link](https://books.google.com/books?id=x9AsAwAAQBAJ&pg=PA15))
2023-06-30 16:15:04 +07:00
Calvin Rose b125cbeac9
Merge pull request #1203 from czkz/add-escapes
Add C escape sequences
2023-06-28 20:06:10 -05:00
Calvin Rose 3f7a2c2197 Try harder to avoid string copying with janet_getcbytes. 2023-06-28 08:30:09 -05:00
Calvin Rose f6248369fe Update janet_getcbytes to padd buffers with trailing 0. 2023-06-28 08:18:43 -05:00
primo-ppcg c83f3ec097 floor div, variadic mod 2023-06-28 18:31:20 +07:00
Calvin Rose 0cd00da354 Add `ffi/pointer-cfunction` to FFI.
This allows for more flexible C interop from DLLs. Users can skip the
usual extension loading mechanism and manage function pointers manually
if they need to.
2023-06-27 19:47:19 -05:00
bakpakin 4b7b285aa9 Remove MSVC compiler warning. 2023-06-25 17:29:09 -05:00
Dmitry d63379e777 Add parser escape sequences 2023-06-25 19:29:39 +04:00
Calvin Rose b219b146fa Squashed commit of the following:
commit fbb0711ae1
Author: Calvin Rose <calsrose@gmail.com>
Date:   Sat Jun 24 12:07:55 2023 -0500

    Distinguish between subprocess when testing.

commit 676b233566
Author: Calvin Rose <calsrose@gmail.com>
Date:   Sat Jun 24 11:59:17 2023 -0500

    Hack for qemu based testing (also should work with valgrind)

commit d7431c7cdb
Author: Calvin Rose <calsrose@gmail.com>
Date:   Sat Jun 24 11:54:04 2023 -0500

    Revert "Test removing 32bit ptr marshalling."

    This reverts commit 566b45ea44.

commit 566b45ea44
Author: Calvin Rose <calsrose@gmail.com>
Date:   Sat Jun 24 11:52:22 2023 -0500

    Test removing 32bit ptr marshalling.

commit ff2f71d2bc
Author: Calvin Rose <calsrose@gmail.com>
Date:   Sat Jun 24 11:42:10 2023 -0500

    Conditionally compile marshal_ptr code.

commit bd420aeb0e
Author: Calvin Rose <calsrose@gmail.com>
Date:   Sat Jun 24 11:38:34 2023 -0500

    Add range checking to bit-shift code to prevent undefined behavior.

commit b738319f8d
Author: Calvin Rose <calsrose@gmail.com>
Date:   Sat Jun 24 11:17:30 2023 -0500

    Remove range check on 32 bit arch since it will always pass.

commit 7248626235
Author: Calvin Rose <calsrose@gmail.com>
Date:   Sat Jun 24 10:56:45 2023 -0500

    Quiet some build warnings.

commit 141c1de946
Author: Calvin Rose <calsrose@gmail.com>
Date:   Sat Jun 24 10:50:13 2023 -0500

    Add marshal utilities for pointers.

commit c2d77d6720
Merge: 677b8a6f ff90b81e
Author: Calvin Rose <calsrose@gmail.com>
Date:   Sat Jun 24 10:40:35 2023 -0500

    Merge branch 'master' into armtest

commit 677b8a6f32
Author: Ico Doornekamp <ico@zevv.nl>
Date:   Mon Jun 12 21:01:26 2023 +0200

    Added ARM32 test
2023-06-24 12:13:51 -05:00
Calvin Rose ff90b81ec3 Add some utilitites for dealing with unsigned integers in janet.h 2023-06-24 10:38:35 -05:00
Calvin Rose 9120eaef79
Merge pull request #1201 from pyrmont/bugfix.dup-fds
Avoid prematurely closing file descriptors when redirecting IO
2023-06-24 09:51:34 -05:00
Michael Camilleri 1ccd879916
Make test cross-platform 2023-06-24 10:56:47 +09:00
Michael Camilleri f977ace7f8
Avoid prematurely closing file descriptors when redirecting IO 2023-06-23 15:50:19 +09:00
Calvin Rose c3f4dc0c15
Merge pull request #1200 from sogaiu/use-vm_commit
Use vm_commit
2023-06-22 20:40:03 -05:00
sogaiu 78eed9b11c Use vm_commit 2023-06-22 21:36:57 +09:00
75 changed files with 3558 additions and 1523 deletions

View File

@ -1,4 +1,4 @@
image: freebsd/12.x
image: freebsd/14.x
sources:
- https://git.sr.ht/~bakpakin/janet
packages:
@ -9,3 +9,4 @@ tasks:
gmake
gmake test
sudo gmake install
sudo gmake uninstall

View File

@ -1,4 +1,4 @@
image: openbsd/latest
image: openbsd/7.4
sources:
- https://git.sr.ht/~bakpakin/janet
packages:
@ -11,6 +11,7 @@ tasks:
gmake test
doas gmake install
gmake test-install
doas gmake uninstall
- meson_min: |
cd janet
meson setup build_meson_min --buildtype=release -Dsingle_threaded=true -Dnanbox=false -Ddynamic_modules=false -Ddocstrings=false -Dnet=false -Dsourcemaps=false -Dpeg=false -Dassembler=false -Dint_types=false -Dreduced_os=true -Dffi=false
@ -29,4 +30,3 @@ tasks:
ninja
ninja test
doas ninja install

38
.github/cosmo/build vendored Normal file
View File

@ -0,0 +1,38 @@
#!/bin/sh
set -eux
COSMO_DIR="/sc/cosmocc"
# build x86_64
X86_64_CC="/sc/cosmocc/bin/x86_64-unknown-cosmo-cc"
X86_64_AR="/sc/cosmocc/bin/x86_64-unknown-cosmo-ar"
mkdir -p /sc/cosmocc/x86_64
make -j CC="$X86_64_CC" AR="$X86_64_AR" HAS_SHARED=0 JANET_NO_AMALG=1
cp build/janet /sc/cosmocc/x86_64/janet
make clean
# build aarch64
AARCH64_CC="/sc/cosmocc/bin/aarch64-unknown-cosmo-cc"
AARCH64_AR="/sc/cosmocc/bin/aarch64-unknown-cosmo-ar"
mkdir -p /sc/cosmocc/aarch64
make -j CC="$AARCH64_CC" AR="$AARCH64_AR" HAS_SHARED=0 JANET_NO_AMALG=1
cp build/janet /sc/cosmocc/aarch64/janet
make clean
# fat binary
apefat () {
OUTPUT="$1"
OLDNAME_X86_64="$(basename -- "$2")"
OLDNAME_AARCH64="$(basename -- "$3")"
TARG_FOLD="$(dirname "$OUTPUT")"
"$COSMO_DIR/bin/apelink" -l "$COSMO_DIR/bin/ape-x86_64.elf" \
-l "$COSMO_DIR/bin/ape-aarch64.elf" \
-M "$COSMO_DIR/bin/ape-m1.c" \
-o "$OUTPUT" \
"$2" \
"$3"
cp "$2" "$TARG_FOLD/$OLDNAME_X86_64.x86_64"
cp "$3" "$TARG_FOLD/$OLDNAME_AARCH64.aarch64"
}
apefat /sc/cosmocc/janet.com /sc/cosmocc/x86_64/janet /sc/cosmocc/aarch64/janet

21
.github/cosmo/setup vendored Normal file
View File

@ -0,0 +1,21 @@
#!/bin/sh
set -e
sudo apt update
sudo apt-get install -y ca-certificates libssl-dev\
qemu qemu-utils qemu-user-static\
texinfo groff\
cmake ninja-build bison zip\
pkg-config build-essential autoconf re2c
# download cosmocc
cd /sc
wget https://github.com/jart/cosmopolitan/releases/download/3.3.3/cosmocc-3.3.3.zip
mkdir -p cosmocc
cd cosmocc
unzip ../cosmocc-3.3.3.zip
# register
cd /sc/cosmocc
sudo cp ./bin/ape-x86_64.elf /usr/bin/ape
sudo sh -c "echo ':APE:M::MZqFpD::/usr/bin/ape:' >/proc/sys/fs/binfmt_misc/register"

View File

@ -60,3 +60,30 @@ jobs:
./dist/*.zip
./*.zip
./*.msi
release-cosmo:
permissions:
contents: write # for softprops/action-gh-release to create GitHub release
name: Build release binaries for Cosmo
runs-on: ubuntu-latest
steps:
- name: Checkout the repository
uses: actions/checkout@master
- name: create build folder
run: |
sudo mkdir -p /sc
sudo chmod -R 0777 /sc
- name: setup Cosmopolitan Libc
run: bash ./.github/cosmo/setup
- name: Set the version
run: echo "version=${GITHUB_REF/refs\/tags\//}" >> $GITHUB_ENV
- name: Set the platform
run: echo "platform=cosmo" >> $GITHUB_ENV
- name: build Janet APE binary
run: bash ./.github/cosmo/build
- name: push binary to github
uses: softprops/action-gh-release@v1
with:
draft: true
files: |
/sc/cosmocc/janet.com

View File

@ -56,7 +56,7 @@ jobs:
gcc
- name: Build the project
shell: cmd
run: make -j CC=gcc
run: make -j4 CC=gcc JANET_NO_AMALG=1
test-mingw-linux:
name: Build and test with Mingw on Linux + Wine
@ -74,3 +74,18 @@ jobs:
run: make clean && make CC=x86_64-w64-mingw32-gcc LD=x86_64-w64-mingw32-gcc UNAME=MINGW RUN=wine
- name: Test the project
run: make test UNAME=MINGW RUN=wine
test-arm-linux:
name: Build and test ARM32 cross compilation
runs-on: ubuntu-latest
steps:
- name: Checkout the repository
uses: actions/checkout@master
- name: Setup qemu and cross compiler
run: |
sudo apt-get update
sudo apt-get install gcc-arm-linux-gnueabi qemu-user
- name: Compile the project
run: make RUN="qemu-arm -L /usr/arm-linux-gnueabi/" CC=arm-linux-gnueabi-gcc LD=arm-linux-gnueabi-gcc
- name: Test the project
run: make RUN="qemu-arm -L /usr/arm-linux-gnueabi/" SUBRUN="qemu-arm -L /usr/arm-linux-gnueabi/" test

9
.gitignore vendored
View File

@ -34,8 +34,11 @@ local
# Common test files I use.
temp.janet
temp*.janet
temp.c
temp*janet
temp*.c
scratch.janet
scratch.c
# Emscripten
*.bc
@ -57,6 +60,7 @@ xxd.exe
# VSCode
.vs
.clangd
.cache
# Swap files
*.swp
@ -130,6 +134,9 @@ Module.symvers
Mkfile.old
dkms.conf
# Coverage files
*.cov
# End of https://www.gitignore.io/api/c
# Created by https://www.gitignore.io/api/cmake

View File

@ -1,6 +1,83 @@
# Changelog
All notable changes to this project will be documented in this file.
## Unreleased - ???
- Add macros `ev/with-lock`, `ev/with-rlock`, and `ev/with-wlock` for using mutexes and rwlocks.
- Add `with-env`
- Add *module-make-env* dynamic binding
- Add buffer/format-at
- Add long form command line options for readable CLI usage
- Fix bug with `net/accept-loop` that would sometimes miss connections.
## 1.34.0 - 2024-03-22
- Add a new (split) PEG special by @ianthehenry
- Add buffer/push-* sized int and float by @pnelson
- Documentation improvements: @amano-kenji, @llmII, @MaxGyver83, @pepe, @sogaiu.
- Expose _exit to skip certain cleanup with os/exit.
- Swap set / body order for each by @sogaiu.
- Abort on assert failure instead of exit.
- Fix: os/proc-wait by @llmII.
- Fix macex1 to keep syntax location for all tuples.
- Restore if-let tail calls.
- Don't try and resume fibers that can't be resumed.
- Register stream on unmarshal.
- Fix asm roundtrip issue.
## 1.33.0 - 2024-01-07
- Add more + and * keywords to default-peg-grammar by @sogaiu.
- Use libc strlen in janet_buffer_push_cstring by @williewillus.
- Be a bit safer with reference counting.
- Add support for atomic loads in Janet's atomic abstraction.
- Fix poll event loop CPU usage issue.
- Add ipv6, shared, and cryptorand options to meson.
- Add more ipv6 feature detection.
- Fix loop for forever loop.
- Cleaned up unused NetStateConnect, fixed janet_async_end() ev refcount by @zevv.
- Fix warnings w/ MSVC and format.
- Fix marshal_one_env w/ JANET_MARSHAL_UNSAFE.
- Fix `(default)`.
- Fix cannot marshal fiber with c stackframe, in a dynamic way that is fairly conservative.
- Fix typo for SIGALARM in os/proc-kill.
- Prevent bytecode optimization from remove mk* instructions.
- Fix arity typo in peg.c by @pepe.
- Update Makefile for MinGW.
- Fix canceling waiting fiber.
- Add a new (sub) PEG special by @ianthehenry.
- Fix if net/server's handler has incorrect arity.
- Fix macex raising on ().
## 1.32.1 - 2023-10-15
- Fix return value from C function `janet_dobytes` when called on Janet functions that yield to event loop.
- Change C API for event loop interaction - get rid of JanetListener and instead use `janet_async_start` and `janet_async_end`.
- Rework event loop to make fewer system calls on kqueue and epoll.
- Expose atomic refcount abstraction in janet.h
- Add `array/weak` for weak references in arrays
- Add support for weak tables via `table/weak`, `table/weak-keys`, and `table/weak-values`.
- Fix compiler bug with using the result of `(break x)` expression in some contexts.
- Rework internal event loop code to be better behaved on Windows
- Update meson build to work better on windows
## 1.31.0 - 2023-09-17
- Report line and column when using `janet_dobytes`
- Add `:unless` loop modifier
- Allow calling `reverse` on generators.
- Improve performance of a number of core functions including `partition`, `mean`, `keys`, `values`, `pairs`, `interleave`.
- Add `lengthable?`
- Add `os/sigaction`
- Change `every?` and `any?` to behave like the functional versions of the `and` and `or` macros.
- Fix bug with garbage collecting threaded abstract types.
- Add `:signal` to the `sandbox` function to allow intercepting signals.
## 1.30.0 - 2023-08-05
- Change indexing of `array/remove` to start from -1 at the end instead of -2.
- Add new string escape sequences `\\a`, `\\b`, `\\?`, and `\\'`.
- Fix bug with marshalling channels
- Add `div` for floored division
- Make `div` and `mod` variadic
- Support `bnot` for integer types.
- Define `(mod x 0)` as `x`
- Add `ffi/pointer-cfunction` to convert pointers to cfunctions
## 1.29.1 - 2023-06-19
- Add support for passing booleans to PEGs for "always" and "never" matching.
- Allow dictionary types for `take` and `drop`

View File

@ -33,6 +33,7 @@ CLIBS=-lm -lpthread
JANET_TARGET=build/janet
JANET_BOOT=build/janet_boot
JANET_IMPORT_LIB=build/janet.lib
JANET_LIBRARY_IMPORT_LIB=build/libjanet.lib
JANET_LIBRARY=build/libjanet.so
JANET_STATIC_LIBRARY=build/libjanet.a
JANET_PATH?=$(LIBDIR)/janet
@ -42,14 +43,17 @@ JANET_DIST_DIR?=janet-dist
JANET_BOOT_FLAGS:=. JANET_PATH '$(JANET_PATH)'
JANET_TARGET_OBJECTS=build/janet.o build/shell.o
JPM_TAG?=master
HAS_SHARED?=1
DEBUGGER=gdb
SONAME_SETTER=-Wl,-soname,
# For cross compilation
HOSTCC?=$(CC)
HOSTAR?=$(AR)
# Symbols are (optionally) removed later, keep -g as default!
CFLAGS?=-O2 -g
LDFLAGS?=-rdynamic
LIBJANET_LDFLAGS?=$(LD_FLAGS)
RUN:=$(RUN)
COMMON_CFLAGS:=-std=c99 -Wall -Wextra -Isrc/include -Isrc/conf -fvisibility=hidden -fPIC
@ -92,12 +96,17 @@ endif
ifeq ($(findstring MINGW,$(UNAME)), MINGW)
CLIBS:=-lws2_32 -lpsapi -lwsock32
LDFLAGS:=-Wl,--out-implib,$(JANET_IMPORT_LIB)
LIBJANET_LDFLAGS:=-Wl,--out-implib,$(JANET_LIBRARY_IMPORT_LIB)
JANET_TARGET:=$(JANET_TARGET).exe
JANET_BOOT:=$(JANET_BOOT).exe
endif
$(shell mkdir -p build/core build/c build/boot build/mainclient)
all: $(JANET_TARGET) $(JANET_LIBRARY) $(JANET_STATIC_LIBRARY) build/janet.h
all: $(JANET_TARGET) $(JANET_STATIC_LIBRARY) build/janet.h
ifeq ($(HAS_SHARED), 1)
all: $(JANET_LIBRARY)
endif
######################
##### Name Files #####
@ -195,9 +204,9 @@ build/%.bin.o: src/%.c $(JANET_HEADERS) $(JANET_LOCAL_HEADERS) Makefile
########################
ifeq ($(UNAME), Darwin)
SONAME=libjanet.1.29.dylib
SONAME=libjanet.1.34.dylib
else
SONAME=libjanet.so.1.29
SONAME=libjanet.so.1.34
endif
build/c/shell.c: src/mainclient/shell.c
@ -219,7 +228,7 @@ $(JANET_TARGET): $(JANET_TARGET_OBJECTS)
$(HOSTCC) $(LDFLAGS) $(BUILD_CFLAGS) -o $@ $^ $(CLIBS)
$(JANET_LIBRARY): $(JANET_TARGET_OBJECTS)
$(HOSTCC) $(LDFLAGS) $(BUILD_CFLAGS) $(SONAME_SETTER)$(SONAME) -shared -o $@ $^ $(CLIBS)
$(HOSTCC) $(LIBJANET_LDFLAGS) $(BUILD_CFLAGS) $(SONAME_SETTER)$(SONAME) -shared -o $@ $^ $(CLIBS)
$(JANET_STATIC_LIBRARY): $(JANET_TARGET_OBJECTS)
$(HOSTAR) rcs $@ $^
@ -262,20 +271,25 @@ dist: build/janet-dist.tar.gz
build/janet-%.tar.gz: $(JANET_TARGET) \
build/janet.h \
janet.1 LICENSE CONTRIBUTING.md $(JANET_LIBRARY) $(JANET_STATIC_LIBRARY) \
janet.1 LICENSE CONTRIBUTING.md $(JANET_STATIC_LIBRARY) \
README.md build/c/janet.c build/c/shell.c
mkdir -p build/$(JANET_DIST_DIR)/bin
cp $(JANET_TARGET) build/$(JANET_DIST_DIR)/bin/
strip -x -S 'build/$(JANET_DIST_DIR)/bin/janet'
mkdir -p build/$(JANET_DIST_DIR)/include
cp build/janet.h build/$(JANET_DIST_DIR)/include/
mkdir -p build/$(JANET_DIST_DIR)/lib/
cp $(JANET_LIBRARY) $(JANET_STATIC_LIBRARY) build/$(JANET_DIST_DIR)/lib/
cp $(JANET_STATIC_LIBRARY) build/$(JANET_DIST_DIR)/lib/
cp $(JANET_LIBRARY) build/$(JANET_DIST_DIR)/lib/ || true
mkdir -p build/$(JANET_DIST_DIR)/man/man1/
cp janet.1 build/$(JANET_DIST_DIR)/man/man1/janet.1
mkdir -p build/$(JANET_DIST_DIR)/src/
cp build/c/janet.c build/c/shell.c build/$(JANET_DIST_DIR)/src/
cp CONTRIBUTING.md LICENSE README.md build/$(JANET_DIST_DIR)/
cd build && tar -czvf ../$@ ./$(JANET_DIST_DIR)
ifeq ($(HAS_SHARED), 1)
build/janet-%.tar.gz: $(JANET_LIBRARY)
endif
#########################
##### Documentation #####
@ -308,7 +322,7 @@ build/janet.pc: $(JANET_TARGET)
install: $(JANET_TARGET) $(JANET_LIBRARY) $(JANET_STATIC_LIBRARY) build/janet.pc build/janet.h
mkdir -p '$(DESTDIR)$(BINDIR)'
cp $(JANET_TARGET) '$(DESTDIR)$(BINDIR)/janet'
strip '$(DESTDIR)$(BINDIR)/janet'
strip -x -S '$(DESTDIR)$(BINDIR)/janet'
mkdir -p '$(DESTDIR)$(INCLUDEDIR)/janet'
cp -r build/janet.h '$(DESTDIR)$(INCLUDEDIR)/janet'
ln -sf ./janet/janet.h '$(DESTDIR)$(INCLUDEDIR)/janet.h'
@ -329,6 +343,7 @@ install: $(JANET_TARGET) $(JANET_LIBRARY) $(JANET_STATIC_LIBRARY) build/janet.pc
mkdir -p '$(DESTDIR)$(JANET_PKG_CONFIG_PATH)'
cp build/janet.pc '$(DESTDIR)$(JANET_PKG_CONFIG_PATH)/janet.pc'
cp '$(JANET_IMPORT_LIB)' '$(DESTDIR)$(LIBDIR)' || echo 'no import lib to install (mingw only)'
cp '$(JANET_LIBRARY_IMPORT_LIB)' '$(DESTDIR)$(LIBDIR)' || echo 'no import lib to install (mingw only)'
[ -z '$(DESTDIR)' ] && $(LDCONFIG) || echo "You can ignore this error for non-Linux systems or local installs"
install-jpm-git: $(JANET_TARGET)
@ -357,14 +372,14 @@ uninstall:
#################
format:
tools/format.sh
sh tools/format.sh
grammar: build/janet.tmLanguage
build/janet.tmLanguage: tools/tm_lang_gen.janet $(JANET_TARGET)
$(RUN) $(JANET_TARGET) $< > $@
compile-commands:
# Requires pip install copmiledb
# Requires pip install compiledb
compiledb make
clean:

View File

@ -315,8 +315,7 @@ See the [Embedding Section](https://janet-lang.org/capi/embedding.html) on the w
## Discussion
Feel free to ask questions and join the discussion on the [Janet Gitter channel](https://gitter.im/janet-language/community).
Gitter provides Matrix and IRC bridges as well.
Feel free to ask questions and join the discussion on the [Janet Zulip Instance](https://janet.zulipchat.com/)
## FAQ
@ -383,7 +382,7 @@ Usually, one of a few reasons:
### Can I bind to Rust/Zig/Go/Java/Nim/C++/D/Pascal/Fortran/Odin/Jai/(Some new "Systems" Programming Language)?
Probably, if that language has a good interface with C. But the programmer may need to do
some extra work to map Janet's internal memory model may need some to that of the bound language. Janet
some extra work to map Janet's internal memory model to that of the bound language. Janet
also uses `setjmp`/`longjmp` for non-local returns internally. This
approach is out of favor with many programmers now and doesn't always play well with other languages
that have exceptions or stack-unwinding.

View File

@ -41,32 +41,32 @@ if not exist build\boot mkdir build\boot
@rem Build the bootstrap interpreter
for %%f in (src\core\*.c) do (
%JANET_COMPILE% /DJANET_BOOTSTRAP /Fobuild\boot\%%~nf.obj %%f
@if errorlevel 1 goto :BUILDFAIL
@if not errorlevel 0 goto :BUILDFAIL
)
for %%f in (src\boot\*.c) do (
%JANET_COMPILE% /DJANET_BOOTSTRAP /Fobuild\boot\%%~nf.obj %%f
@if errorlevel 1 goto :BUILDFAIL
@if not errorlevel 0 goto :BUILDFAIL
)
%JANET_LINK% /out:build\janet_boot.exe build\boot\*.obj
@if errorlevel 1 goto :BUILDFAIL
@if not errorlevel 0 goto :BUILDFAIL
build\janet_boot . > build\c\janet.c
@rem Build the sources
%JANET_COMPILE% /Fobuild\janet.obj build\c\janet.c
@if errorlevel 1 goto :BUILDFAIL
@if not errorlevel 0 goto :BUILDFAIL
%JANET_COMPILE% /Fobuild\shell.obj src\mainclient\shell.c
@if errorlevel 1 goto :BUILDFAIL
@if not errorlevel 0 goto :BUILDFAIL
@rem Build the resources
rc /nologo /fobuild\janet_win.res janet_win.rc
@rem Link everything to main client
%JANET_LINK% /out:janet.exe build\janet.obj build\shell.obj build\janet_win.res
@if errorlevel 1 goto :BUILDFAIL
@if not errorlevel 0 goto :BUILDFAIL
@rem Build static library (libjanet.a)
@rem Build static library (libjanet.lib)
%JANET_LINK_STATIC% /out:build\libjanet.lib build\janet.obj
@if errorlevel 1 goto :BUILDFAIL
@if not errorlevel 0 goto :BUILDFAIL
echo === Successfully built janet.exe for Windows ===
echo === Run 'build_win test' to run tests. ==
@ -91,14 +91,16 @@ exit /b 0
:CLEAN
del *.exe *.lib *.exp
rd /s /q build
rd /s /q dist
if exist dist (
rd /s /q dist
)
exit /b 0
@rem Run tests
:TEST
for %%f in (test/suite*.janet) do (
janet.exe test\%%f
@if errorlevel 1 goto TESTFAIL
@if not errorlevel 0 goto TESTFAIL
)
exit /b 0
@ -117,6 +119,7 @@ copy README.md dist\README.md
copy janet.lib dist\janet.lib
copy janet.exp dist\janet.exp
copy janet.def dist\janet.def
janet.exe tools\patch-header.janet src\include\janet.h src\conf\janetconf.h build\janet.h
copy build\janet.h dist\janet.h

View File

@ -55,6 +55,7 @@
(ffi/defbind sixints-fn six-ints [])
(ffi/defbind sixints-fn-2 :int [x :int s six-ints])
(ffi/defbind sixints-fn-3 :int [s six-ints x :int])
(ffi/defbind-alias int-fn int-fn-aliased :int [a :int b :int])
#
# Struct reading and writing
@ -119,6 +120,7 @@
(tracev (return-struct 42))
(tracev (double-lots 1 2 3 4 5 6 700 800 9 10))
(tracev (struct-big 11 99.5))
(tracev (int-fn-aliased 10 20))
(assert (= [10 10 12 12] (split-ret-fn 10 12)))
(assert (= [12 12 10 10] (split-flip-ret-fn 10 12)))

View File

@ -0,0 +1,5 @@
# Switch to python
(print "running in Janet")
(os/posix-exec ["python"] :p)
(print "will not print")

41
examples/sigaction.janet Normal file
View File

@ -0,0 +1,41 @@
###
### Usage: janet examples/sigaction.janet 1|2|3|4 &
###
### Then at shell: kill -s SIGTERM $!
###
(defn action
[]
(print "Handled SIGTERM!")
(flush)
(os/exit 1))
(defn main1
[]
(os/sigaction :term action true)
(forever))
(defn main2
[]
(os/sigaction :term action)
(forever))
(defn main3
[]
(os/sigaction :term action true)
(forever (ev/sleep math/inf)))
(defn main4
[]
(os/sigaction :term action)
(forever (ev/sleep math/inf)))
(defn main
[& args]
(def which (scan-number (get args 1 "1")))
(case which
1 (main1) # should work
2 (main2) # will not work
3 (main3) # should work
4 (main4) # should work
(error "bad main")))

View File

@ -0,0 +1,20 @@
(def weak-k (table/weak-keys 10))
(def weak-v (table/weak-values 10))
(def weak-kv (table/weak 10))
(put weak-kv (gensym) 10)
(put weak-kv :hello :world)
(put weak-k :abc123zz77asda :stuff)
(put weak-k true :abc123zz77asda)
(put weak-k :zyzzyz false)
(put weak-v (gensym) 10)
(put weak-v 20 (gensym))
(print "before gc")
(tracev weak-k)
(tracev weak-v)
(tracev weak-kv)
(gccollect)
(print "after gc")
(tracev weak-k)
(tracev weak-v)
(tracev weak-kv)

View File

@ -20,7 +20,7 @@
project('janet', 'c',
default_options : ['c_std=c99', 'build.c_std=c99', 'b_lundef=false', 'default_library=both'],
version : '1.29.1')
version : '1.34.0')
# Global settings
janet_path = join_paths(get_option('prefix'), get_option('libdir'), 'janet')
@ -61,6 +61,7 @@ conf.set('JANET_NO_SOURCEMAPS', not get_option('sourcemaps'))
conf.set('JANET_NO_ASSEMBLER', not get_option('assembler'))
conf.set('JANET_NO_PEG', not get_option('peg'))
conf.set('JANET_NO_NET', not get_option('net'))
conf.set('JANET_NO_IPV6', not get_option('ipv6'))
conf.set('JANET_NO_EV', not get_option('ev') or get_option('single_threaded'))
conf.set('JANET_REDUCED_OS', get_option('reduced_os'))
conf.set('JANET_NO_INT_TYPES', not get_option('int_types'))
@ -78,6 +79,7 @@ conf.set('JANET_EV_NO_KQUEUE', not get_option('kqueue'))
conf.set('JANET_NO_INTERPRETER_INTERRUPT', not get_option('interpreter_interrupt'))
conf.set('JANET_NO_FFI', not get_option('ffi'))
conf.set('JANET_NO_FFI_JIT', not get_option('ffi_jit'))
conf.set('JANET_NO_CRYPTORAND', not get_option('cryptorand'))
if get_option('os_name') != ''
conf.set('JANET_OS_NAME', get_option('os_name'))
endif
@ -169,7 +171,7 @@ janet_boot = executable('janet-boot', core_src, boot_src,
# Build janet.c
janetc = custom_target('janetc',
input : [janet_boot],
input : [janet_boot, 'src/boot/boot.janet'],
output : 'janet.c',
capture : true,
command : [
@ -182,25 +184,41 @@ if not get_option('single_threaded')
janet_dependencies += thread_dep
endif
libjanet = library('janet', janetc,
include_directories : incdir,
dependencies : janet_dependencies,
version: meson.project_version(),
soversion: version_parts[0] + '.' + version_parts[1],
install : true)
# Allow building with no shared library
if cc.has_argument('-fvisibility=hidden')
lib_cflags = ['-fvisibility=hidden']
else
lib_cflags = []
endif
if get_option('shared')
libjanet = library('janet', janetc,
include_directories : incdir,
dependencies : janet_dependencies,
version: meson.project_version(),
soversion: version_parts[0] + '.' + version_parts[1],
c_args : lib_cflags,
install : true)
# Extra c flags - adding -fvisibility=hidden matches the Makefile and
# shaves off about 10k on linux x64, likely similar on other platforms.
if cc.has_argument('-fvisibility=hidden')
extra_cflags = ['-fvisibility=hidden']
if cc.has_argument('-fvisibility=hidden')
extra_cflags = ['-fvisibility=hidden', '-DJANET_DLL_IMPORT']
else
extra_cflags = ['-DJANET_DLL_IMPORT']
endif
janet_mainclient = executable('janet', mainclient_src,
include_directories : incdir,
dependencies : janet_dependencies,
link_with: [libjanet],
c_args : extra_cflags,
install : true)
else
extra_cflags = []
# No shared library
janet_mainclient = executable('janet', mainclient_src, janetc,
include_directories : incdir,
dependencies : janet_dependencies,
c_args : lib_cflags,
install : true)
endif
janet_mainclient = executable('janet', janetc, mainclient_src,
include_directories : incdir,
dependencies : janet_dependencies,
c_args : extra_cflags,
install : true)
if meson.is_cross_build()
native_cc = meson.get_compiler('c', native: true)
@ -264,14 +282,15 @@ endforeach
run_target('repl', command : [janet_nativeclient])
# For use as meson subproject (wrap)
janet_dep = declare_dependency(include_directories : incdir,
link_with : libjanet)
if get_option('shared')
janet_dep = declare_dependency(include_directories : incdir,
link_with : libjanet)
# pkgconfig
pkg = import('pkgconfig')
pkg.generate(libjanet,
subdirs: 'janet',
description: 'Library for the Janet programming language.')
pkg = import('pkgconfig')
pkg.generate(libjanet,
subdirs: 'janet',
description: 'Library for the Janet programming language.')
endif
# Installation
install_man('janet.1')
@ -281,11 +300,12 @@ patched_janet = custom_target('patched-janeth',
install : true,
install_dir : join_paths(get_option('includedir'), 'janet'),
build_by_default : true,
output : ['janet.h'],
output : ['janet_' + meson.project_version() + '.h'],
command : [janet_nativeclient, '@INPUT@', '@OUTPUT@'])
# Create a version of the janet.h header that matches what jpm often expects
if meson.version().version_compare('>=0.61')
install_symlink('janet.h', pointing_to: 'janet/janet.h', install_dir: get_option('includedir'))
install_symlink('janet.h', pointing_to: 'janet/janet_' + meson.project_version() + '.h', install_dir: get_option('includedir'))
install_symlink('janet.h', pointing_to: 'janet_' + meson.project_version() + '.h', install_dir: join_paths(get_option('includedir'), 'janet'))
endif

View File

@ -11,14 +11,15 @@ option('peg', type : 'boolean', value : true)
option('int_types', type : 'boolean', value : true)
option('prf', type : 'boolean', value : false)
option('net', type : 'boolean', value : true)
option('ipv6', type : 'boolean', value : true)
option('ev', type : 'boolean', value : true)
option('processes', type : 'boolean', value : true)
option('umask', type : 'boolean', value : true)
option('realpath', type : 'boolean', value : true)
option('simple_getline', type : 'boolean', value : false)
option('epoll', type : 'boolean', value : false)
option('kqueue', type : 'boolean', value : false)
option('interpreter_interrupt', type : 'boolean', value : false)
option('epoll', type : 'boolean', value : true)
option('kqueue', type : 'boolean', value : true)
option('interpreter_interrupt', type : 'boolean', value : true)
option('ffi', type : 'boolean', value : true)
option('ffi_jit', type : 'boolean', value : true)
@ -29,3 +30,5 @@ option('stack_max', type : 'integer', min : 8096, max : 0x7fffffff, value : 0x7f
option('arch_name', type : 'string', value: '')
option('os_name', type : 'string', value: '')
option('shared', type : 'boolean', value: true)
option('cryptorand', type : 'boolean', value: true)

View File

@ -103,23 +103,13 @@
(defn symbol? "Check if x is a symbol." [x] (= (type x) :symbol))
(defn keyword? "Check if x is a keyword." [x] (= (type x) :keyword))
(defn buffer? "Check if x is a buffer." [x] (= (type x) :buffer))
(defn function? "Check if x is a function (not a cfunction)." [x]
(= (type x) :function))
(defn function? "Check if x is a function (not a cfunction)." [x] (= (type x) :function))
(defn cfunction? "Check if x a cfunction." [x] (= (type x) :cfunction))
(defn table? "Check if x a table." [x] (= (type x) :table))
(defn struct? "Check if x a struct." [x] (= (type x) :struct))
(defn array? "Check if x is an array." [x] (= (type x) :array))
(defn tuple? "Check if x is a tuple." [x] (= (type x) :tuple))
(defn boolean? "Check if x is a boolean." [x] (= (type x) :boolean))
(defn bytes? "Check if x is a string, symbol, keyword, or buffer." [x]
(def t (type x))
(if (= t :string) true (if (= t :symbol) true (if (= t :keyword) true (= t :buffer)))))
(defn dictionary? "Check if x is a table or struct." [x]
(def t (type x))
(if (= t :table) true (= t :struct)))
(defn indexed? "Check if x is an array or tuple." [x]
(def t (type x))
(if (= t :array) true (= t :tuple)))
(defn truthy? "Check if x is truthy." [x] (if x true false))
(defn true? "Check if x is true." [x] (= x true))
(defn false? "Check if x is false." [x] (= x false))
@ -151,7 +141,7 @@
(defmacro -= "Decrements the var x by n." [x & ns] ~(set ,x (,- ,x ,;ns)))
(defmacro *= "Shorthand for (set x (\\* x n))." [x & ns] ~(set ,x (,* ,x ,;ns)))
(defmacro /= "Shorthand for (set x (/ x n))." [x & ns] ~(set ,x (,/ ,x ,;ns)))
(defmacro %= "Shorthand for (set x (% x n))." [x n] ~(set ,x (,% ,x ,n)))
(defmacro %= "Shorthand for (set x (% x n))." [x & ns] ~(set ,x (,% ,x ,;ns)))
(defmacro assert
"Throw an error if x is not truthy. Will not evaluate `err` if x is truthy."
@ -172,7 +162,7 @@
``Define a default value for an optional argument.
Expands to `(def sym (if (= nil sym) val sym))`.``
[sym val]
~(def ,sym (if (= nil ,sym) ,val ,sym)))
~(def ,sym (if (,= nil ,sym) ,val ,sym)))
(defmacro comment
"Ignores the body of the comment."
@ -429,9 +419,15 @@
(error (string "expected tuple for range, got " x))))
(defn- range-template
[binding object rest op comparison]
(let [[start stop step] (check-indexed object)]
(for-template binding start stop (or step 1) comparison op [rest])))
[binding object kind rest op comparison]
(check-indexed object)
(def [a b c] object)
(def [start stop step]
(case (length object)
1 (case kind :range [0 a 1] :down [a 0 1])
2 [a b 1]
[a b c]))
(for-template binding start stop step comparison op [rest]))
(defn- each-template
[binding inx kind body]
@ -481,16 +477,17 @@
:repeat (with-syms [iter]
~(do (var ,iter ,verb) (while (> ,iter 0) ,rest (-- ,iter))))
:when ~(when ,verb ,rest)
:unless ~(unless ,verb ,rest)
(error (string "unexpected loop modifier " binding))))))
# 3 term expression
(def {(+ i 2) object} head)
(let [rest (loop1 body head (+ i 3))]
(case verb
:range (range-template binding object rest + <)
:range-to (range-template binding object rest + <=)
:down (range-template binding object rest - >)
:down-to (range-template binding object rest - >=)
:range (range-template binding object :range rest + <)
:range-to (range-template binding object :range rest + <=)
:down (range-template binding object :down rest - >)
:down-to (range-template binding object :down rest - >=)
:keys (each-template binding object :keys [rest])
:pairs (each-template binding object :pairs [rest])
:in (each-template binding object :each [rest])
@ -597,7 +594,10 @@
* `:repeat n` -- repeats the next inner loop `n` times.
* `:when condition` -- only evaluates the current loop body when `condition`
is true.
is truthy.
* `:unless condition` -- only evaluates the current loop body when `condition`
is falsey.
The `loop` macro always evaluates to nil.
```
@ -651,7 +651,12 @@
(defn mean
"Returns the mean of xs. If empty, returns NaN."
[xs]
(/ (sum xs) (length xs)))
(if (lengthable? xs)
(/ (sum xs) (length xs))
(do
(var [accum total] [0 0])
(each x xs (+= accum x) (++ total))
(/ accum total))))
(defn product
"Returns the product of xs. If xs is empty, returns 1."
@ -660,6 +665,9 @@
(each x xs (*= accum x))
accum)
# declare ahead of time
(var- macexvar nil)
(defmacro if-let
``Make multiple bindings, and if all are truthy,
evaluate the `tru` form. If any are false or nil, evaluate
@ -668,20 +676,19 @@
(def len (length bindings))
(if (= 0 len) (error "expected at least 1 binding"))
(if (odd? len) (error "expected an even number of bindings"))
(def res (gensym))
(def fal2 (if macexvar (macexvar fal) fal))
(defn aux [i]
(if (>= i len)
~(do (set ,res ,tru) true)
tru
(do
(def bl (in bindings i))
(def br (in bindings (+ 1 i)))
(if (symbol? bl)
~(if (def ,bl ,br) ,(aux (+ 2 i)))
~(if (def ,bl ,br) ,(aux (+ 2 i)) ,fal2)
~(if (def ,(def sym (gensym)) ,br)
(do (def ,bl ,sym) ,(aux (+ 2 i))))))))
~(do
(var ,res nil)
(if ,(aux 0) ,res ,fal)))
(do (def ,bl ,sym) ,(aux (+ 2 i)))
,fal2)))))
(aux 0))
(defmacro when-let
"Same as `(if-let bindings (do ;body))`."
@ -712,30 +719,38 @@
[f]
(fn [x] (not (f x))))
(defmacro- do-extreme
[order args]
~(do
(def ds ,args)
(var k (next ds nil))
(var ret (get ds k))
(while (,not= nil (set k (next ds k)))
(def x (in ds k))
(if (,order x ret) (set ret x)))
ret))
(defn extreme
``Returns the most extreme value in `args` based on the function `order`.
`order` should take two values and return true or false (a comparison).
Returns nil if `args` is empty.``
[order args]
(var [ret] args)
(each x args (if (order x ret) (set ret x)))
ret)
[order args] (do-extreme order args))
(defn max
"Returns the numeric maximum of the arguments."
[& args] (extreme > args))
[& args] (do-extreme > args))
(defn min
"Returns the numeric minimum of the arguments."
[& args] (extreme < args))
[& args] (do-extreme < args))
(defn max-of
"Returns the numeric maximum of the argument sequence."
[args] (extreme > args))
[args] (do-extreme > args))
(defn min-of
"Returns the numeric minimum of the argument sequence."
[args] (extreme < args))
[args] (do-extreme < args))
(defn first
"Get the first element from an indexed data structure."
@ -749,6 +764,14 @@
## Polymorphic comparisons
(defmacro- do-compare
[x y]
~(if (def f (get ,x :compare))
(f ,x ,y)
(if (def f (get ,y :compare))
(- (f ,y ,x))
(cmp ,x ,y))))
(defn compare
``Polymorphic compare. Returns -1, 0, 1 for x < y, x = y, x > y respectively.
Differs from the primitive comparators in that it first checks to
@ -756,20 +779,18 @@
compare x and y. If so, it uses that method. If not, it
delegates to the primitive comparators.``
[x y]
(or
(when-let [f (get x :compare)] (f x y))
(when-let [f (get y :compare)] (- (f y x)))
(cmp x y)))
(do-compare x y))
(defn- compare-reduce [op xs]
(var r true)
(loop [i :range [0 (- (length xs) 1)]
:let [c (compare (xs i) (xs (+ i 1)))
ok (op c 0)]
:when (not ok)]
(set r false)
(break))
r)
(defmacro- compare-reduce [op xs]
~(do
(var res true)
(var x (get ,xs 0))
(forv i 1 (length ,xs)
(let [y (in ,xs i)]
(if (,op (do-compare x y) 0)
(set x y)
(do (set res false) (break)))))
res))
(defn compare=
``Equivalent of `=` but using polymorphic `compare` instead of primitive comparator.``
@ -809,21 +830,31 @@
###
###
(defn- median-of-three [a b c]
(if (not= (> a b) (> a c))
a
(if (not= (> b a) (> b c)) b c)))
(defmacro- median-of-three
[x y z]
~(if (<= ,x ,y)
(if (<= ,y ,z) ,y (if (<= ,z ,x) ,x ,z))
(if (<= ,z ,y) ,y (if (<= ,x ,z) ,x ,z))))
(defmacro- sort-partition-template
[ind before? left right pivot]
~(do
(while (,before? (in ,ind ,left) ,pivot) (++ ,left))
(while (,before? ,pivot (in ,ind ,right)) (-- ,right))))
(defn- sort-help [a lo hi before?]
(when (< lo hi)
(def pivot
(median-of-three (in a hi) (in a lo)
(in a (math/floor (/ (+ lo hi) 2)))))
(def [x y z] [(in a lo)
(in a (div (+ lo hi) 2))
(in a hi)])
(def pivot (median-of-three x y z))
(var left lo)
(var right hi)
(while true
(while (before? (in a left) pivot) (++ left))
(while (before? pivot (in a right)) (-- right))
(case before?
< (sort-partition-template a < left right pivot)
> (sort-partition-template a > left right pivot)
(sort-partition-template a before? left right pivot))
(when (<= left right)
(def tmp (in a left))
(set (a left) (in a right))
@ -831,8 +862,10 @@
(++ left)
(-- right))
(if (>= left right) (break)))
(sort-help a lo right before?)
(sort-help a left hi before?))
(if (< lo right)
(sort-help a lo right before?))
(if (< left hi)
(sort-help a left hi before?)))
a)
(defn sort
@ -840,7 +873,8 @@
If a `before?` comparator function is provided, sorts elements using that,
otherwise uses `<`.``
[ind &opt before?]
(sort-help ind 0 (- (length ind) 1) (or before? <)))
(default before? <)
(sort-help ind 0 (- (length ind) 1) before?))
(defn sort-by
``Sorts `ind` in-place by calling a function `f` on each element and
@ -947,7 +981,6 @@
1 (map-n 1 ,maptype ,res ,f ,ind ,inds)
2 (map-n 2 ,maptype ,res ,f ,ind ,inds)
3 (map-n 3 ,maptype ,res ,f ,ind ,inds)
4 (map-n 4 ,maptype ,res ,f ,ind ,inds)
(do
(def iter-keys (array/new-filled ninds))
(def call-buffer (array/new-filled ninds))
@ -1007,30 +1040,6 @@
(map-template :keep res pred ind inds)
res)
(defn range
`Create an array of values [start, end) with a given step.
With one argument, returns a range [0, end). With two arguments, returns
a range [start, end). With three, returns a range with optional step size.`
[& args]
(case (length args)
1 (do
(def [n] args)
(def arr (array/new n))
(forv i 0 n (put arr i i))
arr)
2 (do
(def [n m] args)
(def arr (array/new (- m n)))
(forv i n m (put arr (- i n) i))
arr)
3 (do
(def [n m s] args)
(cond
(zero? s) @[]
(neg? s) (seq [i :down [n m (- s)]] i)
(seq [i :range [n m s]] i)))
(error "expected 1 to 3 arguments to range")))
(defn find-index
``Find the index of indexed type for which `pred` is true. Returns `dflt` if not found.``
[pred ind &opt dflt]
@ -1229,7 +1238,7 @@
(defdyn *debug* "Enables a built in debugger on errors and other useful features for debugging in a repl.")
(defdyn *exit* "When set, will cause the current context to complete. Can be set to exit from repl (or file), for example.")
(defdyn *exit-value* "Set the return value from `run-context` upon an exit. By default, `run-context` will return nil.")
(defdyn *task-id* "When spawning a thread or fiber, the task-id can be assigned for concurrecny control.")
(defdyn *task-id* "When spawning a thread or fiber, the task-id can be assigned for concurrency control.")
(defdyn *macro-form*
"Inside a macro, is bound to the source form that invoked the macro")
@ -1264,7 +1273,7 @@
(defn keep-syntax
``Creates a tuple with the tuple type and sourcemap of `before` but the
elements of `after`. If either one of its argements is not a tuple, returns
elements of `after`. If either one of its arguments is not a tuple, returns
`after` unmodified. Useful to preserve syntactic information when transforming
an ast in macros.``
[before after]
@ -1414,6 +1423,11 @@
~(setdyn ,(bindings i) ,(bindings (+ i 1)))))
~(,resume (,fiber/new (fn [] ,;dyn-forms ,;body) :p)))
(defmacro with-env
`Run a block of code with a given environment table`
[env & body]
~(,resume (,fiber/new (fn [] ,;body) : ,env)))
(defmacro with-vars
``Evaluates `body` with each var in `vars` temporarily bound. Similar signature to
`let`, but each binding must be a var.``
@ -1439,48 +1453,50 @@
(fn [& r] (f ;more ;r))))
(defn every?
``Returns true if each value in `ind` is truthy, otherwise returns the first
falsey value.``
``Evaluates to the last element of `ind` if all preceding elements are truthy,
otherwise evaluates to the first falsey element.``
[ind]
(var res true)
(loop [x :in ind :while res]
(if x nil (set res x)))
(set res x))
res)
(defn any?
``Returns the first truthy value in `ind`, otherwise nil.``
``Evaluates to the last element of `ind` if all preceding elements are falsey,
otherwise evaluates to the first truthy element.``
[ind]
(var res nil)
(loop [x :in ind :until res]
(if x (set res x)))
(set res x))
res)
(defn reverse!
`Reverses the order of the elements in a given array or buffer and returns it
mutated.`
[t]
(def len-1 (- (length t) 1))
(def half (/ len-1 2))
(forv i 0 half
(def j (- len-1 i))
(def l (in t i))
(def r (in t j))
(put t i r)
(put t j l))
(var i 0)
(var j (length t))
(while (< i (-- j))
(def ti (in t i))
(put t i (in t j))
(put t j ti)
(++ i))
t)
(defn reverse
`Reverses the order of the elements in a given array or tuple and returns
a new array. If a string or buffer is provided, returns an array of its
byte values, reversed.`
a new array. If a string or buffer is provided, returns a buffer instead.`
[t]
(def len (length t))
(var n (- len 1))
(def ret (array/new len))
(while (>= n 0)
(array/push ret (in t n))
(-- n))
ret)
(if (lengthable? t)
(do
(var n (length t))
(def ret (if (bytes? t)
(buffer/new-filled n)
(array/new-filled n)))
(each v t
(put ret (-- n) v))
ret)
(reverse! (seq [v :in t] v))))
(defn invert
``Given an associative data structure `ds`, returns a new table where the
@ -1590,32 +1606,41 @@
(defn keys
"Get the keys of an associative data structure."
[x]
(def arr @[])
(var k (next x nil))
(while (not= nil k)
(array/push arr k)
(set k (next x k)))
arr)
(if (lengthable? x)
(do
(def arr (array/new-filled (length x)))
(var i 0)
(eachk k x
(put arr i k)
(++ i))
arr)
(seq [k :keys x] k)))
(defn values
"Get the values of an associative data structure."
[x]
(def arr @[])
(var k (next x nil))
(while (not= nil k)
(array/push arr (in x k))
(set k (next x k)))
arr)
(if (lengthable? x)
(do
(def arr (array/new-filled (length x)))
(var i 0)
(each v x
(put arr i v)
(++ i))
arr)
(seq [v :in x] v)))
(defn pairs
"Get the key-value pairs of an associative data structure."
[x]
(def arr @[])
(var k (next x nil))
(while (not= nil k)
(array/push arr (tuple k (in x k)))
(set k (next x k)))
arr)
(if (lengthable? x)
(do
(def arr (array/new-filled (length x)))
(var i 0)
(eachp p x
(put arr i p)
(++ i))
arr)
(seq [p :pairs x] p)))
(defn frequencies
"Get the number of occurrences of each value in an indexed data structure."
@ -1660,14 +1685,7 @@
(defn interleave
"Returns an array of the first elements of each col, then the second elements, etc."
[& cols]
(def res @[])
(def ncol (length cols))
(when (> ncol 0)
(def len (min ;(map length cols)))
(loop [i :range [0 len]
ci :range [0 ncol]]
(array/push res (in (in cols ci) i))))
res)
(mapcat tuple ;cols))
(defn distinct
"Returns an array of the deduplicated values in `xs`."
@ -1714,29 +1732,46 @@
``Returns a sequence of the elements of `ind` separated by
`sep`. Returns a new array.``
[sep ind]
(var k (next ind nil))
(if (not= nil k)
(if (lengthable? ind)
(do
(def ret (array/new-filled (- (* 2 (length ind)) 1) sep))
(var i 0)
(while (not= nil k)
(put ret i (in ind k))
(set k (next ind k))
(+= i 2))
ret)
(do
(def ret @[(in ind k)])
(while (not= nil (set k (next ind k)))
(array/push ret sep (in ind k)))
ret))
@[]))
(defn- partition-slice
[f n ind]
(var [start end] [0 n])
(def len (length ind))
(def ret (array/new (- (* 2 len) 1)))
(if (> len 0) (put ret 0 (in ind 0)))
(var i 1)
(while (< i len)
(array/push ret sep (in ind i))
(++ i))
(def parts (div len n))
(def ret (array/new-filled parts))
(forv k 0 parts
(put ret k (f ind start end))
(set start end)
(+= end n))
(if (< start len)
(array/push ret (f ind start)))
ret)
(defn partition
``Partition an indexed data structure `ind` into tuples
of size `n`. Returns a new array.``
[n ind]
(var i 0) (var nextn n)
(def len (length ind))
(def ret (array/new (math/ceil (/ len n))))
(def slicer (if (bytes? ind) string/slice tuple/slice))
(while (<= nextn len)
(array/push ret (slicer ind i nextn))
(set i nextn)
(+= nextn n))
(if (not= i len) (array/push ret (slicer ind i)))
ret)
(cond
(indexed? ind) (partition-slice tuple/slice n ind)
(bytes? ind) (partition-slice string/slice n ind)
(partition-slice tuple/slice n (values ind))))
###
###
@ -2099,21 +2134,22 @@
'upscope expandall})
(defn dotup [t]
(if (= nil (next t)) (break ()))
(def h (in t 0))
(def s (in specs h))
(def entry (or (dyn h) {}))
(def m (do (def r (get entry :ref)) (if r (in r 0) (get entry :value))))
(def m? (in entry :macro))
(cond
s (s t)
s (keep-syntax t (s t))
m? (do (setdyn *macro-form* t) (m ;(tuple/slice t 1)))
(tuple/slice (map recur t))))
(keep-syntax! t (map recur t))))
(def ret
(case (type x)
:tuple (if (= (tuple/type x) :brackets)
(tuple/brackets ;(map recur x))
(dotup x))
(tuple/brackets ;(map recur x))
(dotup x))
:array (map recur x)
:struct (table/to-struct (dotable x recur))
:table (dotable x recur)
@ -2219,6 +2255,8 @@
(set current (macex1 current on-binding)))
current)
(set macexvar macex)
(defmacro varfn
``Create a function that can be rebound. `varfn` has the same signature
as `defn`, but defines functions in the environment as vars. If a var `name`
@ -2309,26 +2347,36 @@
(def default-peg-grammar
`The default grammar used for pegs. This grammar defines several common patterns
that should make it easier to write more complex patterns.`
~@{:d (range "09")
:a (range "az" "AZ")
~@{:a (range "az" "AZ")
:d (range "09")
:h (range "09" "af" "AF")
:s (set " \t\r\n\0\f\v")
:w (range "az" "AZ" "09")
:h (range "09" "af" "AF")
:S (if-not :s 1)
:W (if-not :w 1)
:A (if-not :a 1)
:D (if-not :d 1)
:H (if-not :h 1)
:d+ (some :d)
:S (if-not :s 1)
:W (if-not :w 1)
:a+ (some :a)
:d+ (some :d)
:h+ (some :h)
:s+ (some :s)
:w+ (some :w)
:h+ (some :h)
:d* (any :d)
:A+ (some :A)
:D+ (some :D)
:H+ (some :H)
:S+ (some :S)
:W+ (some :W)
:a* (any :a)
:w* (any :w)
:d* (any :d)
:h* (any :h)
:s* (any :s)
:h* (any :h)})
:w* (any :w)
:A* (any :A)
:D* (any :D)
:H* (any :H)
:S* (any :S)
:W* (any :W)})
(setdyn *peg-grammar* default-peg-grammar)
@ -2724,6 +2772,12 @@
(defn- check-is-dep [x] (unless (or (string/has-prefix? "/" x) (string/has-prefix? "@" x) (string/has-prefix? "." x)) x))
(defn- check-project-relative [x] (if (string/has-prefix? "/" x) x))
(defdyn *module-cache* "Dynamic binding for overriding `module/cache`")
(defdyn *module-paths* "Dynamic binding for overriding `module/cache`")
(defdyn *module-loading* "Dynamic binding for overriding `module/cache`")
(defdyn *module-loaders* "Dynamic binding for overriding `module/loaders`")
(defdyn *module-make-env* "Dynamic binding for creating new environments for `import`, `require`, and `dofile`. Overrides `make-env`.")
(def module/cache
"A table, mapping loaded module identifiers to their environments."
@{})
@ -2752,24 +2806,25 @@
keyword name of a loader in `module/loaders`. Returns the modified `module/paths`.
```
[ext loader]
(def mp (dyn *module-paths* module/paths))
(defn- find-prefix
[pre]
(or (find-index |(and (string? ($ 0)) (string/has-prefix? pre ($ 0))) module/paths) 0))
(or (find-index |(and (string? ($ 0)) (string/has-prefix? pre ($ 0))) mp) 0))
(def dyn-index (find-prefix ":@all:"))
(array/insert module/paths dyn-index [(string ":@all:" ext) loader check-dyn-relative])
(array/insert mp dyn-index [(string ":@all:" ext) loader check-dyn-relative])
(def all-index (find-prefix ".:all:"))
(array/insert module/paths all-index [(string ".:all:" ext) loader check-project-relative])
(array/insert mp all-index [(string ".:all:" ext) loader check-project-relative])
(def sys-index (find-prefix ":sys:"))
(array/insert module/paths sys-index [(string ":sys:/:all:" ext) loader check-is-dep])
(array/insert mp sys-index [(string ":sys:/:all:" ext) loader check-is-dep])
(def curall-index (find-prefix ":cur:/:all:"))
(array/insert module/paths curall-index [(string ":cur:/:all:" ext) loader check-relative])
module/paths)
(array/insert mp curall-index [(string ":cur:/:all:" ext) loader check-relative])
mp)
(module/add-paths ":native:" :native)
(module/add-paths "/init.janet" :source)
(module/add-paths ".janet" :source)
(module/add-paths ".jimage" :image)
(array/insert module/paths 0 [(fn is-cached [path] (if (in module/cache path) path)) :preload check-not-relative])
(array/insert module/paths 0 [(fn is-cached [path] (if (in (dyn *module-cache* module/cache) path) path)) :preload check-not-relative])
# Version of fexists that works even with a reduced OS
(defn- fexists
@ -2799,7 +2854,8 @@
```
[path]
(var ret nil)
(each [p mod-kind checker] module/paths
(def mp (dyn *module-paths* module/paths))
(each [p mod-kind checker] mp
(when (mod-filter checker path)
(if (function? p)
(when-let [res (p path)]
@ -2815,7 +2871,7 @@
(when (string? t)
(when (mod-filter chk path)
(module/expand-path path t))))
paths (filter identity (map expander module/paths))
paths (filter identity (map expander mp))
str-parts (interpose "\n " paths)]
[nil (string "could not find module " path ":\n " ;str-parts)])))
@ -2883,7 +2939,12 @@
(if (= :dead fs)
(when is-repl
(put env '_ @{:value x})
(printf (get env *pretty-format* "%q") x)
(def pf (get env *pretty-format* "%q"))
(try
(printf pf x)
([e]
(eprintf "bad pretty format %v: %v" pf e)
(eflush)))
(flush))
(do
(debug/stacktrace f x "")
@ -2903,7 +2964,7 @@
:core/stream path
(file/open path :rb)))
(def path-is-file (= f path))
(default env (make-env))
(default env ((dyn *module-make-env* make-env)))
(def spath (string path))
(put env :source (or source (if-not path-is-file spath path)))
(var exit-error nil)
@ -2965,13 +3026,15 @@
of files as modules.``
@{:native (fn native-loader [path &] (native path (make-env)))
:source (fn source-loader [path args]
(put module/loading path true)
(defer (put module/loading path nil)
(def ml (dyn *module-loading* module/loading))
(put ml path true)
(defer (put ml path nil)
(dofile path ;args)))
:preload (fn preload-loader [path & args]
(when-let [m (in module/cache path)]
(def mc (dyn *module-cache* module/cache))
(when-let [m (in mc path)]
(if (function? m)
(set (module/cache path) (m path ;args))
(set (mc path) (m path ;args))
m)))
:image (fn image-loader [path &] (load-image (slurp path)))})
@ -2979,15 +3042,18 @@
[path args kargs]
(def [fullpath mod-kind] (module/find path))
(unless fullpath (error mod-kind))
(if-let [check (if-not (kargs :fresh) (in module/cache fullpath))]
(def mc (dyn *module-cache* module/cache))
(def ml (dyn *module-loading* module/loading))
(def mls (dyn *module-loaders* module/loaders))
(if-let [check (if-not (kargs :fresh) (in mc fullpath))]
check
(if (module/loading fullpath)
(if (ml fullpath)
(error (string "circular dependency " fullpath " detected"))
(do
(def loader (if (keyword? mod-kind) (module/loaders mod-kind) mod-kind))
(def loader (if (keyword? mod-kind) (mls mod-kind) mod-kind))
(unless loader (error (string "module type " mod-kind " unknown")))
(def env (loader fullpath args))
(put module/cache fullpath env)
(put mc fullpath env)
env))))
(defn require
@ -3384,9 +3450,9 @@
(defn- print-special-form-entry
[x]
(print "\n\n"
(string " special form\n\n")
(string " (" x " ...)\n\n")
(string " See https://janet-lang.org/docs/specials.html\n\n")))
" special form\n\n"
" (" x " ...)\n\n"
" See https://janet-lang.org/docs/specials.html\n\n"))
(defn doc*
"Get the documentation for a symbol in a given environment. Function form of `doc`."
@ -3520,6 +3586,24 @@
(when-let [constants (dasm :constants)]
(eprintf " constants: %.4q" constants))
(eprintf " slots: %.4q\n" (frame :slots))
(when-let [src-path (in dasm :source)]
(when (and (fexists src-path)
sourcemap)
(defn dump
[src cur]
(def offset 5)
(def beg (max 1 (- cur offset)))
(def lines (array/concat @[""] (string/split "\n" src)))
(def end (min (+ cur offset) (length lines)))
(def digits (inc (math/floor (math/log10 end))))
(def fmt-str (string "%" digits "d: %s"))
(for i beg end
(eprin " ") # breakpoint someday?
(eprin (if (= i cur) "> " " "))
(eprintf fmt-str i (get lines i))))
(let [[sl _] (sourcemap pc)]
(dump (slurp src-path) sl)
(eprint))))
(def padding (string/repeat " " 20))
(loop [i :range [0 (length bytecode)]
:let [instr (bytecode i)]]
@ -3664,18 +3748,50 @@
[& body]
~(,ev/thread (fn _do-thread [&] ,;body)))
(defn- acquire-release
[acq rel lock body]
(def l (gensym))
~(do
(def ,l ,lock)
(,acq ,l)
(defer (,rel ,l)
,;body)))
(defmacro ev/with-lock
``Run a body of code after acquiring a lock. Will automatically release the lock when done.``
[lock & body]
(acquire-release ev/acquire-lock ev/release-lock lock body))
(defmacro ev/with-rlock
``Run a body of code after acquiring read access to an rwlock. Will automatically release the lock when done.``
[lock & body]
(acquire-release ev/acquire-rlock ev/release-rlock lock body))
(defmacro ev/with-wlock
``Run a body of code after acquiring read access to an rwlock. Will automatically release the lock when done.``
[lock & body]
(acquire-release ev/acquire-wlock ev/release-wlock lock body))
(defmacro ev/spawn-thread
``Run some code in a new thread. Like `ev/do-thread`, but returns nil immediately.``
[& body]
~(,ev/thread (fn _spawn-thread [&] ,;body) nil :n))
(defmacro ev/with-deadline
`Run a body of code with a deadline, such that if the code does not complete before
the deadline is up, it will be canceled.`
[deadline & body]
``
Create a fiber to execute `body`, schedule the event loop to cancel
the task (root fiber) associated with `body`'s fiber, and start
`body`'s fiber by resuming it.
The event loop will try to cancel the root fiber if `body`'s fiber
has not completed after at least `sec` seconds.
`sec` is a number that can have a fractional part.
``
[sec & body]
(with-syms [f]
~(let [,f (coro ,;body)]
(,ev/deadline ,deadline nil ,f)
(,ev/deadline ,sec nil ,f)
(,resume ,f))))
(defn- cancel-all [chan fibers reason]
@ -3719,7 +3835,7 @@
[host port &opt handler type]
(def s (net/listen host port type))
(if handler
(ev/call (fn [] (net/accept-loop s handler))))
(ev/go (fn [] (net/accept-loop s handler))))
s))
###
@ -3767,9 +3883,11 @@
:lazy lazy
:map-symbols map-symbols}))
(defmacro ffi/defbind
"Generate bindings for native functions in a convenient manner."
[name ret-type & body]
(defmacro ffi/defbind-alias
"Generate bindings for native functions in a convenient manner.
Similar to defbind but allows for the janet function name to be
different than the FFI function."
[name alias ret-type & body]
(def real-ret-type (eval ret-type))
(def meta (slice body 0 -2))
(def arg-pairs (partition 2 (last body)))
@ -3786,11 +3904,16 @@
(defn make-ptr []
(assert (ffi/lookup (if lazy (llib) lib) raw-symbol) (string "failed to find ffi symbol " raw-symbol)))
(if lazy
~(defn ,name ,;meta [,;formal-args]
~(defn ,alias ,;meta [,;formal-args]
(,ffi/call (,(delay (make-ptr))) (,(delay (make-sig))) ,;formal-args))
~(defn ,name ,;meta [,;formal-args]
~(defn ,alias ,;meta [,;formal-args]
(,ffi/call ,(make-ptr) ,(make-sig) ,;formal-args)))))
(defmacro ffi/defbind
"Generate bindings for native functions in a convenient manner."
[name ret-type & body]
~(ffi/defbind-alias ,name ,name ,ret-type ,;body))
###
###
### Flychecking
@ -3934,6 +4057,28 @@
(def x (in args (+ i 1)))
(or (scan-number x) (keyword x)))
(def- long-to-short
"map long options to short options"
{"-help" "h"
"-version" "v"
"-stdin" "s"
"-eval" "e"
"-expression" "E"
"-debug" "d"
"-repl" "r"
"-noprofile" "R"
"-persistent" "p"
"-quiet" "q"
"-flycheck" "k"
"-syspath" "m"
"-compile" "c"
"-image" "i"
"-nocolor" "n"
"-color" "N"
"-library" "l"
"-lint-warn" "w"
"-lint-error" "x"})
# Flag handlers
(def handlers
{"h" (fn [&]
@ -3941,26 +4086,26 @@
(print
```
Options are:
-h : Show this help
-v : Print the version string
-s : Use raw stdin instead of getline like functionality
-e code : Execute a string of janet
-E code arguments... : Evaluate an expression as a short-fn with arguments
-d : Set the debug flag in the REPL
-r : Enter the REPL after running all scripts
-R : Disables loading profile.janet when JANET_PROFILE is present
-p : Keep on executing if there is a top-level error (persistent)
-q : Hide logo (quiet)
-k : Compile scripts but do not execute (flycheck)
-m syspath : Set system path for loading global modules
-c source output : Compile janet source code into an image
-i : Load the script argument as an image file instead of source code
-n : Disable ANSI color output in the REPL
-N : Enable ANSI color output in the REPL
-l lib : Use a module before processing more arguments
-w level : Set the lint warning level - default is "normal"
-x level : Set the lint error level - default is "none"
-- : Stop handling options
--help (-h) : Show this help
--version (-v) : Print the version string
--stdin (-s) : Use raw stdin instead of getline like functionality
--eval (-e) code : Execute a string of janet
--expression (-E) code arguments... : Evaluate an expression as a short-fn with arguments
--debug (-d) : Set the debug flag in the REPL
--repl (-r) : Enter the REPL after running all scripts
--noprofile (-R) : Disables loading profile.janet when JANET_PROFILE is present
--persistent (-p) : Keep on executing if there is a top-level error (persistent)
--quiet (-q) : Hide logo (quiet)
--flycheck (-k) : Compile scripts but do not execute (flycheck)
--syspath (-m) syspath : Set system path for loading global modules
--compile (-c) source output : Compile janet source code into an image
--image (-i) : Load the script argument as an image file instead of source code
--nocolor (-n) : Disable ANSI color output in the REPL
--color (-N) : Enable ANSI color output in the REPL
--library (-l) lib : Use a module before processing more arguments
--lint-warn (-w) level : Set the lint warning level - default is "normal"
--lint-error (-x) level : Set the lint error level - default is "none"
-- : Stop handling options
```)
(os/exit 0)
1)
@ -4004,8 +4149,8 @@
"R" (fn [&] (setdyn *profilepath* nil) 1)})
(defn- dohandler [n i &]
(def h (in handlers n))
(if h (h i) (do (print "unknown flag -" n) ((in handlers "h")))))
(def h (in handlers (get long-to-short n n)))
(if h (h i handlers) (do (print "unknown flag -" n) ((in handlers "h")))))
# Process arguments
(var i 0)

View File

@ -4,10 +4,10 @@
#define JANETCONF_H
#define JANET_VERSION_MAJOR 1
#define JANET_VERSION_MINOR 29
#define JANET_VERSION_PATCH 1
#define JANET_VERSION_MINOR 34
#define JANET_VERSION_PATCH 0
#define JANET_VERSION_EXTRA ""
#define JANET_VERSION "1.29.1"
#define JANET_VERSION "1.34.0"
/* #define JANET_BUILD "local" */
@ -52,6 +52,9 @@
/* #define JANET_EV_NO_EPOLL */
/* #define JANET_EV_NO_KQUEUE */
/* #define JANET_NO_INTERPRETER_INTERRUPT */
/* #define JANET_NO_IPV6 */
/* #define JANET_NO_CRYPTORAND */
/* #define JANET_USE_STDATOMIC */
/* Custom vm allocator support */
/* #include <mimalloc.h> */

View File

@ -31,8 +31,6 @@
#ifdef JANET_EV
#ifdef JANET_WINDOWS
#include <windows.h>
#else
#include <stdatomic.h>
#endif
#endif
@ -97,14 +95,6 @@ size_t janet_os_rwlock_size(void) {
return sizeof(void *);
}
static int32_t janet_incref(JanetAbstractHead *ab) {
return InterlockedIncrement((LONG volatile *) &ab->gc.data.refcount);
}
static int32_t janet_decref(JanetAbstractHead *ab) {
return InterlockedDecrement((LONG volatile *) &ab->gc.data.refcount);
}
void janet_os_mutex_init(JanetOSMutex *mutex) {
InitializeCriticalSection((CRITICAL_SECTION *) mutex);
}
@ -157,14 +147,6 @@ size_t janet_os_rwlock_size(void) {
return sizeof(pthread_rwlock_t);
}
static int32_t janet_incref(JanetAbstractHead *ab) {
return __atomic_add_fetch(&ab->gc.data.refcount, 1, __ATOMIC_RELAXED);
}
static int32_t janet_decref(JanetAbstractHead *ab) {
return __atomic_add_fetch(&ab->gc.data.refcount, -1, __ATOMIC_RELAXED);
}
void janet_os_mutex_init(JanetOSMutex *mutex) {
pthread_mutexattr_t attr;
pthread_mutexattr_init(&attr);
@ -212,11 +194,11 @@ void janet_os_rwlock_wunlock(JanetOSRWLock *rwlock) {
#endif
int32_t janet_abstract_incref(void *abst) {
return janet_incref(janet_abstract_head(abst));
return janet_atomic_inc(&janet_abstract_head(abst)->gc.data.refcount);
}
int32_t janet_abstract_decref(void *abst) {
return janet_decref(janet_abstract_head(abst));
return janet_atomic_dec(&janet_abstract_head(abst)->gc.data.refcount);
}
#endif

View File

@ -30,9 +30,7 @@
#include <string.h>
/* Creates a new array */
JanetArray *janet_array(int32_t capacity) {
JanetArray *array = janet_gcalloc(JANET_MEMORY_ARRAY, sizeof(JanetArray));
static void janet_array_impl(JanetArray *array, int32_t capacity) {
Janet *data = NULL;
if (capacity > 0) {
janet_vm.next_collection += capacity * sizeof(Janet);
@ -44,6 +42,19 @@ JanetArray *janet_array(int32_t capacity) {
array->count = 0;
array->capacity = capacity;
array->data = data;
}
/* Creates a new array */
JanetArray *janet_array(int32_t capacity) {
JanetArray *array = janet_gcalloc(JANET_MEMORY_ARRAY, sizeof(JanetArray));
janet_array_impl(array, capacity);
return array;
}
/* Creates a new array with weak references */
JanetArray *janet_array_weak(int32_t capacity) {
JanetArray *array = janet_gcalloc(JANET_MEMORY_ARRAY_WEAK, sizeof(JanetArray));
janet_array_impl(array, capacity);
return array;
}
@ -132,6 +143,15 @@ JANET_CORE_FN(cfun_array_new,
return janet_wrap_array(array);
}
JANET_CORE_FN(cfun_array_weak,
"(array/weak capacity)",
"Creates a new empty array with a pre-allocated capacity and support for weak references. Similar to `array/new`.") {
janet_fixarity(argc, 1);
int32_t cap = janet_getinteger(argv, 0);
JanetArray *array = janet_array_weak(cap);
return janet_wrap_array(array);
}
JANET_CORE_FN(cfun_array_new_filled,
"(array/new-filled count &opt value)",
"Creates a new array of `count` elements, all set to `value`, which defaults to nil. Returns the new array.") {
@ -177,8 +197,8 @@ JANET_CORE_FN(cfun_array_peek,
}
JANET_CORE_FN(cfun_array_push,
"(array/push arr x)",
"Insert an element in the end of an array. Modifies the input array and returns it.") {
"(array/push arr & xs)",
"Push all the elements of xs to the end of an array. Modifies the input array and returns it.") {
janet_arity(argc, 1, -1);
JanetArray *array = janet_getarray(argv, 0);
if (INT32_MAX - argc + 1 <= array->count) {
@ -211,7 +231,7 @@ JANET_CORE_FN(cfun_array_slice,
"Takes a slice of array or tuple from `start` to `end`. The range is half open, "
"[start, end). Indexes can also be negative, indicating indexing from the "
"end of the array. By default, `start` is 0 and `end` is the length of the array. "
"Note that index -1 is synonymous with index `(length arrtup)` to allow a full "
"Note that if the range is negative, it is taken as (start, end] to allow a full "
"negative slice range. Returns a new array.") {
JanetView view = janet_getindexed(argv, 0);
JanetRange range = janet_getslice(argc, argv);
@ -259,8 +279,8 @@ JANET_CORE_FN(cfun_array_insert,
"(array/insert arr at & xs)",
"Insert all `xs` into array `arr` at index `at`. `at` should be an integer between "
"0 and the length of the array. A negative value for `at` will index backwards from "
"the end of the array, such that inserting at -1 appends to the array. "
"Returns the array.") {
"the end of the array, inserting after the index such that inserting at -1 appends to "
"the array. Returns the array.") {
size_t chunksize, restsize;
janet_arity(argc, 2, -1);
JanetArray *array = janet_getarray(argv, 0);
@ -297,7 +317,7 @@ JANET_CORE_FN(cfun_array_remove,
int32_t at = janet_getinteger(argv, 1);
int32_t n = 1;
if (at < 0) {
at = array->count + at + 1;
at = array->count + at;
}
if (at < 0 || at > array->count)
janet_panicf("removal index %d out of range [0,%d]", at, array->count);
@ -352,6 +372,7 @@ JANET_CORE_FN(cfun_array_clear,
void janet_lib_array(JanetTable *env) {
JanetRegExt array_cfuns[] = {
JANET_CORE_REG("array/new", cfun_array_new),
JANET_CORE_REG("array/weak", cfun_array_weak),
JANET_CORE_REG("array/new-filled", cfun_array_new_filled),
JANET_CORE_REG("array/fill", cfun_array_fill),
JANET_CORE_REG("array/pop", cfun_array_pop),

View File

@ -75,6 +75,7 @@ static const JanetInstructionDef janet_ops[] = {
{"cmp", JOP_COMPARE},
{"cncl", JOP_CANCEL},
{"div", JOP_DIVIDE},
{"divf", JOP_DIVIDE_FLOOR},
{"divim", JOP_DIVIDE_IMMEDIATE},
{"eq", JOP_EQUALS},
{"eqim", JOP_EQUALS_IMMEDIATE},
@ -137,6 +138,7 @@ static const JanetInstructionDef janet_ops[] = {
{"sru", JOP_SHIFT_RIGHT_UNSIGNED},
{"sruim", JOP_SHIFT_RIGHT_UNSIGNED_IMMEDIATE},
{"sub", JOP_SUBTRACT},
{"subim", JOP_SUBTRACT_IMMEDIATE},
{"tcall", JOP_TAILCALL},
{"tchck", JOP_TYPECHECK}
};
@ -558,6 +560,9 @@ static JanetAssembleResult janet_asm1(JanetAssembler *parent, Janet source, int
x = janet_get1(s, janet_ckeywordv("vararg"));
if (janet_truthy(x)) def->flags |= JANET_FUNCDEF_FLAG_VARARG;
/* Initialize slotcount */
def->slotcount = !!(def->flags & JANET_FUNCDEF_FLAG_VARARG) + def->arity;
/* Check structarg */
x = janet_get1(s, janet_ckeywordv("structarg"));
if (janet_truthy(x)) def->flags |= JANET_FUNCDEF_FLAG_STRUCTARG;
@ -782,8 +787,9 @@ static JanetAssembleResult janet_asm1(JanetAssembler *parent, Janet source, int
}
/* Verify the func def */
if (janet_verify(def)) {
janet_asm_error(&a, "invalid assembly");
int verify_status = janet_verify(def);
if (verify_status) {
janet_asm_errorv(&a, janet_formatc("invalid assembly (%d)", verify_status));
}
/* Add final flags */

View File

@ -135,8 +135,7 @@ void janet_buffer_extra(JanetBuffer *buffer, int32_t n) {
/* Push a cstring to buffer */
void janet_buffer_push_cstring(JanetBuffer *buffer, const char *cstring) {
int32_t len = 0;
while (cstring[len]) ++len;
int32_t len = (int32_t) strlen(cstring);
janet_buffer_push_bytes(buffer, (const uint8_t *) cstring, len);
}
@ -221,6 +220,20 @@ JANET_CORE_FN(cfun_buffer_new_filled,
return janet_wrap_buffer(buffer);
}
JANET_CORE_FN(cfun_buffer_frombytes,
"(buffer/from-bytes & byte-vals)",
"Creates a buffer from integer parameters with byte values. All integers "
"will be coerced to the range of 1 byte 0-255.") {
int32_t i;
JanetBuffer *buffer = janet_buffer(argc);
for (i = 0; i < argc; i++) {
int32_t c = janet_getinteger(argv, i);
buffer->data[i] = c & 0xFF;
}
buffer->count = argc;
return janet_wrap_buffer(buffer);
}
JANET_CORE_FN(cfun_buffer_fill,
"(buffer/fill buffer &opt byte)",
"Fill up a buffer with bytes, defaulting to 0s. Does not change the buffer's length. "
@ -307,6 +320,143 @@ JANET_CORE_FN(cfun_buffer_chars,
return argv[0];
}
static int should_reverse_bytes(const Janet *argv, int32_t argc) {
JanetKeyword order_kw = janet_getkeyword(argv, argc);
if (!janet_cstrcmp(order_kw, "le")) {
#if JANET_BIG_ENDIAN
return 1;
#endif
} else if (!janet_cstrcmp(order_kw, "be")) {
#if JANET_LITTLE_ENDIAN
return 1;
#endif
} else if (!janet_cstrcmp(order_kw, "native")) {
return 0;
} else {
janet_panicf("expected endianness :le, :be or :native, got %v", argv[1]);
}
return 0;
}
static void reverse_u32(uint8_t bytes[4]) {
uint8_t temp;
temp = bytes[3];
bytes[3] = bytes[0];
bytes[0] = temp;
temp = bytes[2];
bytes[2] = bytes[1];
bytes[1] = temp;
}
static void reverse_u64(uint8_t bytes[8]) {
uint8_t temp;
temp = bytes[7];
bytes[7] = bytes[0];
bytes[0] = temp;
temp = bytes[6];
bytes[6] = bytes[1];
bytes[1] = temp;
temp = bytes[5];
bytes[5] = bytes[2];
bytes[2] = temp;
temp = bytes[4];
bytes[4] = bytes[3];
bytes[3] = temp;
}
JANET_CORE_FN(cfun_buffer_push_uint16,
"(buffer/push-uint16 buffer order data)",
"Push a 16 bit unsigned integer data onto the end of the buffer. "
"Returns the modified buffer.") {
janet_fixarity(argc, 3);
JanetBuffer *buffer = janet_getbuffer(argv, 0);
int reverse = should_reverse_bytes(argv, 1);
union {
uint16_t data;
uint8_t bytes[2];
} u;
u.data = (uint16_t) janet_getinteger(argv, 2);
if (reverse) {
uint8_t temp = u.bytes[1];
u.bytes[1] = u.bytes[0];
u.bytes[0] = temp;
}
janet_buffer_push_u16(buffer, *(uint16_t *) u.bytes);
return argv[0];
}
JANET_CORE_FN(cfun_buffer_push_uint32,
"(buffer/push-uint32 buffer order data)",
"Push a 32 bit unsigned integer data onto the end of the buffer. "
"Returns the modified buffer.") {
janet_fixarity(argc, 3);
JanetBuffer *buffer = janet_getbuffer(argv, 0);
int reverse = should_reverse_bytes(argv, 1);
union {
uint32_t data;
uint8_t bytes[4];
} u;
u.data = (uint32_t) janet_getinteger(argv, 2);
if (reverse)
reverse_u32(u.bytes);
janet_buffer_push_u32(buffer, *(uint32_t *) u.bytes);
return argv[0];
}
JANET_CORE_FN(cfun_buffer_push_uint64,
"(buffer/push-uint64 buffer order data)",
"Push a 64 bit unsigned integer data onto the end of the buffer. "
"Returns the modified buffer.") {
janet_fixarity(argc, 3);
JanetBuffer *buffer = janet_getbuffer(argv, 0);
int reverse = should_reverse_bytes(argv, 1);
union {
uint64_t data;
uint8_t bytes[8];
} u;
u.data = (uint64_t) janet_getuinteger64(argv, 2);
if (reverse)
reverse_u64(u.bytes);
janet_buffer_push_u64(buffer, *(uint64_t *) u.bytes);
return argv[0];
}
JANET_CORE_FN(cfun_buffer_push_float32,
"(buffer/push-float32 buffer order data)",
"Push the underlying bytes of a 32 bit float data onto the end of the buffer. "
"Returns the modified buffer.") {
janet_fixarity(argc, 3);
JanetBuffer *buffer = janet_getbuffer(argv, 0);
int reverse = should_reverse_bytes(argv, 1);
union {
float data;
uint8_t bytes[4];
} u;
u.data = (float) janet_getnumber(argv, 2);
if (reverse)
reverse_u32(u.bytes);
janet_buffer_push_u32(buffer, *(uint32_t *) u.bytes);
return argv[0];
}
JANET_CORE_FN(cfun_buffer_push_float64,
"(buffer/push-float64 buffer order data)",
"Push the underlying bytes of a 64 bit float data onto the end of the buffer. "
"Returns the modified buffer.") {
janet_fixarity(argc, 3);
JanetBuffer *buffer = janet_getbuffer(argv, 0);
int reverse = should_reverse_bytes(argv, 1);
union {
double data;
uint8_t bytes[8];
} u;
u.data = janet_getnumber(argv, 2);
if (reverse)
reverse_u64(u.bytes);
janet_buffer_push_u64(buffer, *(uint64_t *) u.bytes);
return argv[0];
}
static void buffer_push_impl(JanetBuffer *buffer, Janet *argv, int32_t argc_offset, int32_t argc) {
for (int32_t i = argc_offset; i < argc; i++) {
if (janet_checktype(argv[i], JANET_NUMBER)) {
@ -462,13 +612,15 @@ JANET_CORE_FN(cfun_buffer_blit,
int same_buf = src.bytes == dest->data;
int32_t offset_dest = 0;
int32_t offset_src = 0;
if (argc > 2)
if (argc > 2 && !janet_checktype(argv[2], JANET_NIL))
offset_dest = janet_gethalfrange(argv, 2, dest->count, "dest-start");
if (argc > 3)
if (argc > 3 && !janet_checktype(argv[3], JANET_NIL))
offset_src = janet_gethalfrange(argv, 3, src.len, "src-start");
int32_t length_src;
if (argc > 4) {
int32_t src_end = janet_gethalfrange(argv, 4, src.len, "src-end");
int32_t src_end = src.len;
if (!janet_checktype(argv[4], JANET_NIL))
src_end = janet_gethalfrange(argv, 4, src.len, "src-end");
length_src = src_end - offset_src;
if (length_src < 0) length_src = 0;
} else {
@ -503,15 +655,42 @@ JANET_CORE_FN(cfun_buffer_format,
return argv[0];
}
JANET_CORE_FN(cfun_buffer_format_at,
"(buffer/format-at buffer at format & args)",
"Snprintf like functionality for printing values into a buffer. Returns "
"the modified buffer.") {
janet_arity(argc, 2, -1);
JanetBuffer *buffer = janet_getbuffer(argv, 0);
int32_t at = janet_getinteger(argv, 1);
if (at < 0) {
at += buffer->count + 1;
}
if (at > buffer->count || at < 0) janet_panicf("expected index at to be in range [0, %d), got %d", buffer->count, at);
int32_t oldcount = buffer->count;
buffer->count = at;
const char *strfrmt = (const char *) janet_getstring(argv, 2);
janet_buffer_format(buffer, strfrmt, 2, argc, argv);
if (buffer->count < oldcount) {
buffer->count = oldcount;
}
return argv[0];
}
void janet_lib_buffer(JanetTable *env) {
JanetRegExt buffer_cfuns[] = {
JANET_CORE_REG("buffer/new", cfun_buffer_new),
JANET_CORE_REG("buffer/new-filled", cfun_buffer_new_filled),
JANET_CORE_REG("buffer/from-bytes", cfun_buffer_frombytes),
JANET_CORE_REG("buffer/fill", cfun_buffer_fill),
JANET_CORE_REG("buffer/trim", cfun_buffer_trim),
JANET_CORE_REG("buffer/push-byte", cfun_buffer_u8),
JANET_CORE_REG("buffer/push-word", cfun_buffer_word),
JANET_CORE_REG("buffer/push-string", cfun_buffer_chars),
JANET_CORE_REG("buffer/push-uint16", cfun_buffer_push_uint16),
JANET_CORE_REG("buffer/push-uint32", cfun_buffer_push_uint32),
JANET_CORE_REG("buffer/push-uint64", cfun_buffer_push_uint64),
JANET_CORE_REG("buffer/push-float32", cfun_buffer_push_float32),
JANET_CORE_REG("buffer/push-float64", cfun_buffer_push_float64),
JANET_CORE_REG("buffer/push", cfun_buffer_push),
JANET_CORE_REG("buffer/push-at", cfun_buffer_push_at),
JANET_CORE_REG("buffer/popn", cfun_buffer_popn),
@ -523,6 +702,7 @@ void janet_lib_buffer(JanetTable *env) {
JANET_CORE_REG("buffer/bit-toggle", cfun_buffer_bittoggle),
JANET_CORE_REG("buffer/blit", cfun_buffer_blit),
JANET_CORE_REG("buffer/format", cfun_buffer_format),
JANET_CORE_REG("buffer/format-at", cfun_buffer_format_at),
JANET_REG_END
};
janet_core_cfuns_ext(env, NULL, buffer_cfuns);

View File

@ -37,11 +37,13 @@ enum JanetInstructionType janet_instructions[JOP_INSTRUCTION_COUNT] = {
JINT_0, /* JOP_RETURN_NIL, */
JINT_SSI, /* JOP_ADD_IMMEDIATE, */
JINT_SSS, /* JOP_ADD, */
JINT_SSI, /* JOP_SUBTRACT_IMMEDIATE, */
JINT_SSS, /* JOP_SUBTRACT, */
JINT_SSI, /* JOP_MULTIPLY_IMMEDIATE, */
JINT_SSS, /* JOP_MULTIPLY, */
JINT_SSI, /* JOP_DIVIDE_IMMEDIATE, */
JINT_SSS, /* JOP_DIVIDE, */
JINT_SSS, /* JOP_DIVIDE_FLOOR */
JINT_SSS, /* JOP_MODULO, */
JINT_SSS, /* JOP_REMAINDER, */
JINT_SSS, /* JOP_BAND, */
@ -224,6 +226,7 @@ void janet_bytecode_movopt(JanetFuncDef *def) {
case JOP_LOAD_TRUE:
case JOP_LOAD_FALSE:
case JOP_LOAD_SELF:
break;
case JOP_MAKE_ARRAY:
case JOP_MAKE_BUFFER:
case JOP_MAKE_STRING:
@ -231,6 +234,8 @@ void janet_bytecode_movopt(JanetFuncDef *def) {
case JOP_MAKE_TABLE:
case JOP_MAKE_TUPLE:
case JOP_MAKE_BRACKET_TUPLE:
/* Reads from the stack, don't remove */
janetc_regalloc_touch(&ra, DD);
break;
/* Read A */
@ -250,6 +255,7 @@ void janet_bytecode_movopt(JanetFuncDef *def) {
case JOP_SIGNAL:
/* Write A, Read B */
case JOP_ADD_IMMEDIATE:
case JOP_SUBTRACT_IMMEDIATE:
case JOP_MULTIPLY_IMMEDIATE:
case JOP_DIVIDE_IMMEDIATE:
case JOP_SHIFT_LEFT_IMMEDIATE:
@ -301,6 +307,7 @@ void janet_bytecode_movopt(JanetFuncDef *def) {
case JOP_SUBTRACT:
case JOP_MULTIPLY:
case JOP_DIVIDE:
case JOP_DIVIDE_FLOOR:
case JOP_MODULO:
case JOP_REMAINDER:
case JOP_SHIFT_LEFT:

View File

@ -35,6 +35,13 @@
#endif
#endif
#ifdef JANET_USE_STDATOMIC
#include <stdatomic.h>
/* We don't need stdatomic on most compilers since we use compiler builtins for atomic operations.
* Some (TCC), explicitly require using stdatomic.h and don't have any exposed builtins (that I know of).
* For TCC and similar compilers, one would need -std=c11 or similar then to get access. */
#endif
JANET_NO_RETURN static void janet_top_level_signal(const char *msg) {
#ifdef JANET_TOP_LEVEL_SIGNAL
JANET_TOP_LEVEL_SIGNAL(msg);
@ -216,12 +223,32 @@ const char *janet_getcstring(const Janet *argv, int32_t n) {
}
const char *janet_getcbytes(const Janet *argv, int32_t n) {
/* Ensure buffer 0-padded */
if (janet_checktype(argv[n], JANET_BUFFER)) {
JanetBuffer *b = janet_unwrap_buffer(argv[n]);
if ((b->gc.flags & JANET_BUFFER_FLAG_NO_REALLOC) && b->count == b->capacity) {
/* Make a copy with janet_smalloc in the rare case we have a buffer that
* cannot be realloced and pushing a 0 byte would panic. */
char *new_string = janet_smalloc(b->count + 1);
memcpy(new_string, b->data, b->count);
new_string[b->count] = 0;
if (strlen(new_string) != (size_t) b->count) goto badzeros;
return new_string;
} else {
/* Ensure trailing 0 */
janet_buffer_push_u8(b, 0);
b->count--;
if (strlen((char *)b->data) != (size_t) b->count) goto badzeros;
return (const char *) b->data;
}
}
JanetByteView view = janet_getbytes(argv, n);
const char *cstr = (const char *)view.bytes;
if (strlen(cstr) != (size_t) view.len) {
janet_panic("bytes contain embedded 0s");
}
if (strlen(cstr) != (size_t) view.len) goto badzeros;
return cstr;
badzeros:
janet_panic("bytes contain embedded 0s");
}
const char *janet_optcbytes(const Janet *argv, int32_t argc, int32_t n, const char *dflt) {
@ -273,6 +300,14 @@ int32_t janet_getinteger(const Janet *argv, int32_t n) {
return janet_unwrap_integer(x);
}
uint32_t janet_getuinteger(const Janet *argv, int32_t n) {
Janet x = argv[n];
if (!janet_checkuint(x)) {
janet_panicf("bad slot #%d, expected 32 bit signed integer, got %v", n, x);
}
return janet_unwrap_integer(x);
}
int64_t janet_getinteger64(const Janet *argv, int32_t n) {
#ifdef JANET_INT_TYPES
return janet_unwrap_s64(argv[n]);
@ -290,7 +325,7 @@ uint64_t janet_getuinteger64(const Janet *argv, int32_t n) {
return janet_unwrap_u64(argv[n]);
#else
Janet x = argv[n];
if (!janet_checkint64(x)) {
if (!janet_checkuint64(x)) {
janet_panicf("bad slot #%d, expected 64 bit unsigned integer, got %v", n, x);
}
return (uint64_t) janet_unwrap_number(x);
@ -310,16 +345,30 @@ int32_t janet_gethalfrange(const Janet *argv, int32_t n, int32_t length, const c
int32_t not_raw = raw;
if (not_raw < 0) not_raw += length + 1;
if (not_raw < 0 || not_raw > length)
janet_panicf("%s index %d out of range [%d,%d]", which, raw, -length - 1, length);
janet_panicf("%s index %d out of range [%d,%d]", which, (int64_t) raw, -(int64_t)length - 1, (int64_t) length);
return not_raw;
}
int32_t janet_getstartrange(const Janet *argv, int32_t argc, int32_t n, int32_t length) {
if (n >= argc || janet_checktype(argv[n], JANET_NIL)) {
return 0;
}
return janet_gethalfrange(argv, n, length, "start");
}
int32_t janet_getendrange(const Janet *argv, int32_t argc, int32_t n, int32_t length) {
if (n >= argc || janet_checktype(argv[n], JANET_NIL)) {
return length;
}
return janet_gethalfrange(argv, n, length, "end");
}
int32_t janet_getargindex(const Janet *argv, int32_t n, int32_t length, const char *which) {
int32_t raw = janet_getinteger(argv, n);
int32_t not_raw = raw;
if (not_raw < 0) not_raw += length;
if (not_raw < 0 || not_raw > length)
janet_panicf("%s index %d out of range [%d,%d)", which, raw, -length, length);
janet_panicf("%s index %d out of range [%d,%d)", which, (int64_t)raw, -(int64_t)length, (int64_t)length);
return not_raw;
}
@ -366,24 +415,10 @@ JanetRange janet_getslice(int32_t argc, const Janet *argv) {
janet_arity(argc, 1, 3);
JanetRange range;
int32_t length = janet_length(argv[0]);
if (argc == 1) {
range.start = 0;
range.end = length;
} else if (argc == 2) {
range.start = janet_checktype(argv[1], JANET_NIL)
? 0
: janet_gethalfrange(argv, 1, length, "start");
range.end = length;
} else {
range.start = janet_checktype(argv[1], JANET_NIL)
? 0
: janet_gethalfrange(argv, 1, length, "start");
range.end = janet_checktype(argv[2], JANET_NIL)
? length
: janet_gethalfrange(argv, 2, length, "end");
if (range.end < range.start)
range.end = range.start;
}
range.start = janet_getstartrange(argv, argc, 1, length);
range.end = janet_getendrange(argv, argc, 2, length);
if (range.end < range.start)
range.end = range.start;
return range;
}
@ -463,9 +498,41 @@ void *janet_optabstract(const Janet *argv, int32_t argc, int32_t n, const JanetA
return janet_getabstract(argv, n, at);
}
/* Atomic refcounts */
JanetAtomicInt janet_atomic_inc(JanetAtomicInt volatile *x) {
#ifdef JANET_WINDOWS
return InterlockedIncrement(x);
#elif defined(JANET_USE_STDATOMIC)
return atomic_fetch_add_explicit(x, 1, memory_order_relaxed) + 1;
#else
return __atomic_add_fetch(x, 1, __ATOMIC_RELAXED);
#endif
}
JanetAtomicInt janet_atomic_dec(JanetAtomicInt volatile *x) {
#ifdef JANET_WINDOWS
return InterlockedDecrement(x);
#elif defined(JANET_USE_STDATOMIC)
return atomic_fetch_add_explicit(x, -1, memory_order_acq_rel) - 1;
#else
return __atomic_add_fetch(x, -1, __ATOMIC_ACQ_REL);
#endif
}
JanetAtomicInt janet_atomic_load(JanetAtomicInt volatile *x) {
#ifdef JANET_WINDOWS
return InterlockedOr(x, 0);
#elif defined(JANET_USE_STDATOMIC)
return atomic_load_explicit(x, memory_order_acquire);
#else
return __atomic_load_n(x, __ATOMIC_ACQUIRE);
#endif
}
/* Some definitions for function-like macros */
JANET_API JanetStructHead *(janet_struct_head)(const JanetKV *st) {
JANET_API JanetStructHead *(janet_struct_head)(JanetStruct st) {
return janet_struct_head(st);
}
@ -473,10 +540,10 @@ JANET_API JanetAbstractHead *(janet_abstract_head)(const void *abstract) {
return janet_abstract_head(abstract);
}
JANET_API JanetStringHead *(janet_string_head)(const uint8_t *s) {
JANET_API JanetStringHead *(janet_string_head)(JanetString s) {
return janet_string_head(s);
}
JANET_API JanetTupleHead *(janet_tuple_head)(const Janet *tuple) {
JANET_API JanetTupleHead *(janet_tuple_head)(JanetTuple tuple) {
return janet_tuple_head(tuple);
}

View File

@ -99,7 +99,7 @@ static JanetSlot opfunction(
static int can_be_imm(Janet x, int8_t *out) {
if (!janet_checkint(x)) return 0;
int32_t integer = janet_unwrap_integer(x);
if (integer > 127 || integer < -127) return 0;
if (integer > INT8_MAX || integer < INT8_MIN) return 0;
*out = (int8_t) integer;
return 1;
}
@ -116,12 +116,11 @@ static JanetSlot opreduce(
JanetSlot *args,
int op,
int opim,
Janet nullary) {
Janet nullary,
Janet unary) {
JanetCompiler *c = opts.compiler;
int32_t i, len;
int8_t imm = 0;
int neg = opim < 0;
if (opim < 0) opim = -opim;
len = janet_v_count(args);
JanetSlot t;
if (len == 0) {
@ -132,19 +131,19 @@ static JanetSlot opreduce(
if (op == JOP_SUBTRACT) {
janetc_emit_ssi(c, JOP_MULTIPLY_IMMEDIATE, t, args[0], -1, 1);
} else {
janetc_emit_sss(c, op, t, janetc_cslot(nullary), args[0], 1);
janetc_emit_sss(c, op, t, janetc_cslot(unary), args[0], 1);
}
return t;
}
t = janetc_gettarget(opts);
if (opim && can_slot_be_imm(args[1], &imm)) {
janetc_emit_ssi(c, opim, t, args[0], neg ? -imm : imm, 1);
janetc_emit_ssi(c, opim, t, args[0], imm, 1);
} else {
janetc_emit_sss(c, op, t, args[0], args[1], 1);
}
for (i = 2; i < len; i++) {
if (opim && can_slot_be_imm(args[i], &imm)) {
janetc_emit_ssi(c, opim, t, t, neg ? -imm : imm, 1);
janetc_emit_ssi(c, opim, t, t, imm, 1);
} else {
janetc_emit_sss(c, op, t, t, args[i], 1);
}
@ -155,7 +154,7 @@ static JanetSlot opreduce(
/* Function optimizers */
static JanetSlot do_propagate(JanetFopts opts, JanetSlot *args) {
return opreduce(opts, args, JOP_PROPAGATE, 0, janet_wrap_nil());
return opreduce(opts, args, JOP_PROPAGATE, 0, janet_wrap_nil(), janet_wrap_nil());
}
static JanetSlot do_error(JanetFopts opts, JanetSlot *args) {
janetc_emit_s(opts.compiler, JOP_ERROR, args[0], 0);
@ -172,7 +171,7 @@ static JanetSlot do_debug(JanetFopts opts, JanetSlot *args) {
return t;
}
static JanetSlot do_in(JanetFopts opts, JanetSlot *args) {
return opreduce(opts, args, JOP_IN, 0, janet_wrap_nil());
return opreduce(opts, args, JOP_IN, 0, janet_wrap_nil(), janet_wrap_nil());
}
static JanetSlot do_get(JanetFopts opts, JanetSlot *args) {
if (janet_v_count(args) == 3) {
@ -192,20 +191,14 @@ static JanetSlot do_get(JanetFopts opts, JanetSlot *args) {
c->buffer[label] |= (current - label) << 16;
return t;
} else {
return opreduce(opts, args, JOP_GET, 0, janet_wrap_nil());
return opreduce(opts, args, JOP_GET, 0, janet_wrap_nil(), janet_wrap_nil());
}
}
static JanetSlot do_next(JanetFopts opts, JanetSlot *args) {
return opfunction(opts, args, JOP_NEXT, janet_wrap_nil());
}
static JanetSlot do_modulo(JanetFopts opts, JanetSlot *args) {
return opreduce(opts, args, JOP_MODULO, 0, janet_wrap_nil());
}
static JanetSlot do_remainder(JanetFopts opts, JanetSlot *args) {
return opreduce(opts, args, JOP_REMAINDER, 0, janet_wrap_nil());
}
static JanetSlot do_cmp(JanetFopts opts, JanetSlot *args) {
return opreduce(opts, args, JOP_COMPARE, 0, janet_wrap_nil());
return opreduce(opts, args, JOP_COMPARE, 0, janet_wrap_nil(), janet_wrap_nil());
}
static JanetSlot do_put(JanetFopts opts, JanetSlot *args) {
if (opts.flags & JANET_FOPTS_DROP) {
@ -262,34 +255,43 @@ static JanetSlot do_apply(JanetFopts opts, JanetSlot *args) {
/* Variadic operators specialization */
static JanetSlot do_add(JanetFopts opts, JanetSlot *args) {
return opreduce(opts, args, JOP_ADD, JOP_ADD_IMMEDIATE, janet_wrap_integer(0));
return opreduce(opts, args, JOP_ADD, JOP_ADD_IMMEDIATE, janet_wrap_integer(0), janet_wrap_integer(0));
}
static JanetSlot do_sub(JanetFopts opts, JanetSlot *args) {
return opreduce(opts, args, JOP_SUBTRACT, -JOP_ADD_IMMEDIATE, janet_wrap_integer(0));
return opreduce(opts, args, JOP_SUBTRACT, JOP_SUBTRACT_IMMEDIATE, janet_wrap_integer(0), janet_wrap_integer(0));
}
static JanetSlot do_mul(JanetFopts opts, JanetSlot *args) {
return opreduce(opts, args, JOP_MULTIPLY, JOP_MULTIPLY_IMMEDIATE, janet_wrap_integer(1));
return opreduce(opts, args, JOP_MULTIPLY, JOP_MULTIPLY_IMMEDIATE, janet_wrap_integer(1), janet_wrap_integer(1));
}
static JanetSlot do_div(JanetFopts opts, JanetSlot *args) {
return opreduce(opts, args, JOP_DIVIDE, JOP_DIVIDE_IMMEDIATE, janet_wrap_integer(1));
return opreduce(opts, args, JOP_DIVIDE, JOP_DIVIDE_IMMEDIATE, janet_wrap_integer(1), janet_wrap_integer(1));
}
static JanetSlot do_divf(JanetFopts opts, JanetSlot *args) {
return opreduce(opts, args, JOP_DIVIDE_FLOOR, 0, janet_wrap_integer(1), janet_wrap_integer(1));
}
static JanetSlot do_modulo(JanetFopts opts, JanetSlot *args) {
return opreduce(opts, args, JOP_MODULO, 0, janet_wrap_integer(0), janet_wrap_integer(1));
}
static JanetSlot do_remainder(JanetFopts opts, JanetSlot *args) {
return opreduce(opts, args, JOP_REMAINDER, 0, janet_wrap_integer(0), janet_wrap_integer(1));
}
static JanetSlot do_band(JanetFopts opts, JanetSlot *args) {
return opreduce(opts, args, JOP_BAND, 0, janet_wrap_integer(-1));
return opreduce(opts, args, JOP_BAND, 0, janet_wrap_integer(-1), janet_wrap_integer(-1));
}
static JanetSlot do_bor(JanetFopts opts, JanetSlot *args) {
return opreduce(opts, args, JOP_BOR, 0, janet_wrap_integer(0));
return opreduce(opts, args, JOP_BOR, 0, janet_wrap_integer(0), janet_wrap_integer(0));
}
static JanetSlot do_bxor(JanetFopts opts, JanetSlot *args) {
return opreduce(opts, args, JOP_BXOR, 0, janet_wrap_integer(0));
return opreduce(opts, args, JOP_BXOR, 0, janet_wrap_integer(0), janet_wrap_integer(0));
}
static JanetSlot do_lshift(JanetFopts opts, JanetSlot *args) {
return opreduce(opts, args, JOP_SHIFT_LEFT, JOP_SHIFT_LEFT_IMMEDIATE, janet_wrap_integer(1));
return opreduce(opts, args, JOP_SHIFT_LEFT, JOP_SHIFT_LEFT_IMMEDIATE, janet_wrap_integer(1), janet_wrap_integer(1));
}
static JanetSlot do_rshift(JanetFopts opts, JanetSlot *args) {
return opreduce(opts, args, JOP_SHIFT_RIGHT, JOP_SHIFT_RIGHT_IMMEDIATE, janet_wrap_integer(1));
return opreduce(opts, args, JOP_SHIFT_RIGHT, JOP_SHIFT_RIGHT_IMMEDIATE, janet_wrap_integer(1), janet_wrap_integer(1));
}
static JanetSlot do_rshiftu(JanetFopts opts, JanetSlot *args) {
return opreduce(opts, args, JOP_SHIFT_RIGHT_UNSIGNED, JOP_SHIFT_RIGHT_UNSIGNED_IMMEDIATE, janet_wrap_integer(1));
return opreduce(opts, args, JOP_SHIFT_RIGHT_UNSIGNED, JOP_SHIFT_RIGHT_UNSIGNED_IMMEDIATE, janet_wrap_integer(1), janet_wrap_integer(1));
}
static JanetSlot do_bnot(JanetFopts opts, JanetSlot *args) {
return genericSS(opts, JOP_BNOT, args[0]);
@ -383,10 +385,11 @@ static const JanetFunOptimizer optimizers[] = {
{fixarity2, do_propagate},
{arity2or3, do_get},
{arity1or2, do_next},
{fixarity2, do_modulo},
{fixarity2, do_remainder},
{NULL, do_modulo},
{NULL, do_remainder},
{fixarity2, do_cmp},
{fixarity2, do_cancel},
{NULL, do_divf}
};
const JanetFunOptimizer *janetc_funopt(uint32_t flags) {

View File

@ -69,6 +69,7 @@ typedef enum {
#define JANET_FUN_REMAINDER 30
#define JANET_FUN_CMP 31
#define JANET_FUN_CANCEL 32
#define JANET_FUN_DIVIDE_FLOOR 33
/* Compiler typedefs */
typedef struct JanetCompiler JanetCompiler;

View File

@ -69,15 +69,15 @@ JanetModule janet_native(const char *name, const uint8_t **error) {
host.minor < modconf.minor ||
host.bits != modconf.bits) {
char errbuf[128];
sprintf(errbuf, "config mismatch - host %d.%.d.%d(%.4x) vs. module %d.%d.%d(%.4x)",
host.major,
host.minor,
host.patch,
host.bits,
modconf.major,
modconf.minor,
modconf.patch,
modconf.bits);
snprintf(errbuf, sizeof(errbuf), "config mismatch - host %d.%.d.%d(%.4x) vs. module %d.%d.%d(%.4x)",
host.major,
host.minor,
host.patch,
host.bits,
modconf.major,
modconf.minor,
modconf.patch,
modconf.bits);
*error = janet_cstring(errbuf);
return NULL;
}
@ -110,14 +110,14 @@ JANET_CORE_FN(janet_core_expand_path,
"(module/expand-path path template)",
"Expands a path template as found in `module/paths` for `module/find`. "
"This takes in a path (the argument to require) and a template string, "
"to expand the path to a path that can be "
"used for importing files. The replacements are as follows:\n\n"
"to expand the path to a path that can be used for importing files. "
"The replacements are as follows:\n\n"
"* :all: -- the value of path verbatim.\n\n"
"* :@all: -- Same as :all:, but if `path` starts with the @ character,\n"
" the first path segment is replaced with a dynamic binding\n"
" `(dyn <first path segment as keyword>)`.\n\n"
"* :cur: -- the current file, or (dyn :current-file)\n\n"
"* :dir: -- the directory containing the current file\n\n"
"* :@all: -- Same as :all:, but if `path` starts with the @ character, "
"the first path segment is replaced with a dynamic binding "
"`(dyn <first path segment as keyword>)`.\n\n"
"* :cur: -- the directory portion, if any, of (dyn :current-file)\n\n"
"* :dir: -- the directory portion, if any, of the path argument\n\n"
"* :name: -- the name component of path, with extension if given\n\n"
"* :native: -- the extension used to load natives, .so or .dll\n\n"
"* :sys: -- the system path, or (dyn :syspath)") {
@ -426,6 +426,36 @@ JANET_CORE_FN(janet_core_slice,
}
}
JANET_CORE_FN(janet_core_range,
"(range & args)",
"Create an array of values [start, end) with a given step. "
"With one argument, returns a range [0, end). With two arguments, returns "
"a range [start, end). With three, returns a range with optional step size.") {
janet_arity(argc, 1, 3);
int32_t start = 0, stop = 0, step = 1, count = 0;
if (argc == 3) {
start = janet_getinteger(argv, 0);
stop = janet_getinteger(argv, 1);
step = janet_getinteger(argv, 2);
count = (step > 0) ? (stop - start - 1) / step + 1 :
((step < 0) ? (stop - start + 1) / step + 1 : 0);
} else if (argc == 2) {
start = janet_getinteger(argv, 0);
stop = janet_getinteger(argv, 1);
count = stop - start;
} else {
stop = janet_getinteger(argv, 0);
count = stop;
}
count = (count > 0) ? count : 0;
JanetArray *array = janet_array(count);
for (int32_t i = 0; i < count; i++) {
array->data[i] = janet_wrap_number(start + i * step);
}
array->count = count;
return janet_wrap_array(array);
}
JANET_CORE_FN(janet_core_table,
"(table & kvs)",
"Creates a new table from a variadic number of keys and values. "
@ -629,6 +659,34 @@ ret_false:
return janet_wrap_false();
}
JANET_CORE_FN(janet_core_is_bytes,
"(bytes? x)",
"Check if x is a string, symbol, keyword, or buffer.") {
janet_fixarity(argc, 1);
return janet_wrap_boolean(janet_checktypes(argv[0], JANET_TFLAG_BYTES));
}
JANET_CORE_FN(janet_core_is_indexed,
"(indexed? x)",
"Check if x is an array or tuple.") {
janet_fixarity(argc, 1);
return janet_wrap_boolean(janet_checktypes(argv[0], JANET_TFLAG_INDEXED));
}
JANET_CORE_FN(janet_core_is_dictionary,
"(dictionary? x)",
"Check if x is a table or struct.") {
janet_fixarity(argc, 1);
return janet_wrap_boolean(janet_checktypes(argv[0], JANET_TFLAG_DICTIONARY));
}
JANET_CORE_FN(janet_core_is_lengthable,
"(lengthable? x)",
"Check if x is a bytes, indexed, or dictionary.") {
janet_fixarity(argc, 1);
return janet_wrap_boolean(janet_checktypes(argv[0], JANET_TFLAG_LENGTHABLE));
}
JANET_CORE_FN(janet_core_signal,
"(signal what x)",
"Raise a signal with payload x. ") {
@ -690,6 +748,7 @@ static const SandboxOption sandbox_options[] = {
{"net-connect", JANET_SANDBOX_NET_CONNECT},
{"net-listen", JANET_SANDBOX_NET_LISTEN},
{"sandbox", JANET_SANDBOX_SANDBOX},
{"signal", JANET_SANDBOX_SIGNAL},
{"subprocess", JANET_SANDBOX_SUBPROCESS},
{NULL, 0}
};
@ -714,6 +773,7 @@ JANET_CORE_FN(janet_core_sandbox,
"* :net-connect - disallow making outbound network connections\n"
"* :net-listen - disallow accepting inbound network connections\n"
"* :sandbox - disallow calling this function\n"
"* :signal - disallow adding or removing signal handlers\n"
"* :subprocess - disallow running subprocesses") {
uint32_t flags = 0;
for (int32_t i = 0; i < argc; i++) {
@ -985,14 +1045,6 @@ static const uint32_t next_asm[] = {
JOP_NEXT | (1 << 24),
JOP_RETURN
};
static const uint32_t modulo_asm[] = {
JOP_MODULO | (1 << 24),
JOP_RETURN
};
static const uint32_t remainder_asm[] = {
JOP_REMAINDER | (1 << 24),
JOP_RETURN
};
static const uint32_t cmp_asm[] = {
JOP_COMPARE | (1 << 24),
JOP_RETURN
@ -1031,7 +1083,12 @@ static void janet_load_libs(JanetTable *env) {
JANET_CORE_REG("module/expand-path", janet_core_expand_path),
JANET_CORE_REG("int?", janet_core_check_int),
JANET_CORE_REG("nat?", janet_core_check_nat),
JANET_CORE_REG("bytes?", janet_core_is_bytes),
JANET_CORE_REG("indexed?", janet_core_is_indexed),
JANET_CORE_REG("dictionary?", janet_core_is_dictionary),
JANET_CORE_REG("lengthable?", janet_core_is_lengthable),
JANET_CORE_REG("slice", janet_core_slice),
JANET_CORE_REG("range", janet_core_range),
JANET_CORE_REG("signal", janet_core_signal),
JANET_CORE_REG("memcmp", janet_core_memcmp),
JANET_CORE_REG("getproto", janet_core_getproto),
@ -1077,14 +1134,6 @@ static void janet_load_libs(JanetTable *env) {
JanetTable *janet_core_env(JanetTable *replacements) {
JanetTable *env = (NULL != replacements) ? replacements : janet_table(0);
janet_quick_asm(env, JANET_FUN_MODULO,
"mod", 2, 2, 2, 2, modulo_asm, sizeof(modulo_asm),
JDOC("(mod dividend divisor)\n\n"
"Returns the modulo of dividend / divisor."));
janet_quick_asm(env, JANET_FUN_REMAINDER,
"%", 2, 2, 2, 2, remainder_asm, sizeof(remainder_asm),
JDOC("(% dividend divisor)\n\n"
"Returns the remainder of dividend / divisor."));
janet_quick_asm(env, JANET_FUN_CMP,
"cmp", 2, 2, 2, 2, cmp_asm, sizeof(cmp_asm),
JDOC("(cmp x y)\n\n"
@ -1095,17 +1144,20 @@ JanetTable *janet_core_env(JanetTable *replacements) {
JDOC("(next ds &opt key)\n\n"
"Gets the next key in a data structure. Can be used to iterate through "
"the keys of a data structure in an unspecified order. Keys are guaranteed "
"to be seen only once per iteration if they data structure is not mutated "
"to be seen only once per iteration if the data structure is not mutated "
"during iteration. If key is nil, next returns the first key. If next "
"returns nil, there are no more keys to iterate through."));
janet_quick_asm(env, JANET_FUN_PROP,
"propagate", 2, 2, 2, 2, propagate_asm, sizeof(propagate_asm),
JDOC("(propagate x fiber)\n\n"
"Propagate a signal from a fiber to the current fiber. The resulting "
"stack trace from the current fiber will include frames from fiber. If "
"fiber is in a state that can be resumed, resuming the current fiber will "
"first resume fiber. This function can be used to re-raise an error without "
"losing the original stack trace."));
"Propagate a signal from a fiber to the current fiber and "
"set the last value of the current fiber to `x`. The signal "
"value is then available as the status of the current fiber. "
"The resulting stack trace from the current fiber will include "
"frames from fiber. If fiber is in a state that can be resumed, "
"resuming the current fiber will first resume `fiber`. "
"This function can be used to re-raise an error without losing "
"the original stack trace."));
janet_quick_asm(env, JANET_FUN_DEBUG,
"debug", 1, 0, 1, 1, debug_asm, sizeof(debug_asm),
JDOC("(debug &opt x)\n\n"
@ -1183,6 +1235,18 @@ JanetTable *janet_core_env(JanetTable *replacements) {
"Returns the quotient of xs. If xs is empty, returns 1. If xs has one value x, returns "
"the reciprocal of x. Otherwise return the first value of xs repeatedly divided by the remaining "
"values."));
templatize_varop(env, JANET_FUN_DIVIDE_FLOOR, "div", 1, 1, JOP_DIVIDE_FLOOR,
JDOC("(div & xs)\n\n"
"Returns the floored division of xs. If xs is empty, returns 1. If xs has one value x, returns "
"the reciprocal of x. Otherwise return the first value of xs repeatedly divided by the remaining "
"values."));
templatize_varop(env, JANET_FUN_MODULO, "mod", 0, 1, JOP_MODULO,
JDOC("(mod & xs)\n\n"
"Returns the result of applying the modulo operator on the first value of xs with each remaining value. "
"`(mod x 0)` is defined to be `x`."));
templatize_varop(env, JANET_FUN_REMAINDER, "%", 0, 1, JOP_REMAINDER,
JDOC("(% & xs)\n\n"
"Returns the remainder of dividing the first value of xs by each remaining value."));
templatize_varop(env, JANET_FUN_BAND, "band", -1, -1, JOP_BAND,
JDOC("(band & xs)\n\n"
"Returns the bit-wise and of all values in xs. Each x in xs must be an integer."));

View File

@ -388,8 +388,8 @@ JANET_CORE_FN(cfun_debug_stack,
JANET_CORE_FN(cfun_debug_stacktrace,
"(debug/stacktrace fiber &opt err prefix)",
"Prints a nice looking stacktrace for a fiber. Can optionally provide "
"an error value to print the stack trace with. If `err` is nil or not "
"provided, and no prefix is given, will skip the error line. Returns the fiber.") {
"an error value to print the stack trace with. If `prefix` is nil or not "
"provided, will skip the error line. Returns the fiber.") {
janet_arity(argc, 1, 3);
JanetFiber *fiber = janet_getfiber(argv, 0);
Janet x = argc == 1 ? janet_wrap_nil() : argv[1];

View File

@ -26,6 +26,7 @@
#include "emit.h"
#include "vector.h"
#include "regalloc.h"
#include "util.h"
#endif
/* Get a register */
@ -128,7 +129,8 @@ static void janetc_movenear(JanetCompiler *c,
((uint32_t)(src.envindex) << 16) |
((uint32_t)(dest) << 8) |
JOP_LOAD_UPVALUE);
} else if (src.index > 0xFF || src.index != dest) {
} else if (src.index != dest) {
janet_assert(src.index >= 0, "bad slot");
janetc_emit(c,
((uint32_t)(src.index) << 16) |
((uint32_t)(dest) << 8) |
@ -155,6 +157,7 @@ static void janetc_moveback(JanetCompiler *c,
((uint32_t)(src) << 8) |
JOP_SET_UPVALUE);
} else if (dest.index != src) {
janet_assert(dest.index >= 0, "bad slot");
janetc_emit(c,
((uint32_t)(dest.index) << 16) |
((uint32_t)(src) << 8) |

File diff suppressed because it is too large Load Diff

View File

@ -1381,7 +1381,7 @@ JANET_CORE_FN(cfun_ffi_buffer_write,
"(ffi/write ffi-type data &opt buffer index)",
"Append a native type to a buffer such as it would appear in memory. This can be used "
"to pass pointers to structs in the ffi, or send C/C++/native structs over the network "
"or to files. Returns a modifed buffer or a new buffer if one is not supplied.") {
"or to files. Returns a modified buffer or a new buffer if one is not supplied.") {
janet_sandbox_assert(JANET_SANDBOX_FFI_USE);
janet_arity(argc, 2, 4);
JanetFFIType type = decode_ffi_type(argv[0]);
@ -1530,9 +1530,25 @@ JANET_CORE_FN(cfun_ffi_pointer_buffer,
return janet_wrap_buffer(janet_pointer_buffer_unsafe(offset_pointer, capacity, count));
}
JANET_CORE_FN(cfun_ffi_pointer_cfunction,
"(ffi/pointer-cfunction pointer &opt name source-file source-line)",
"Create a C Function from a raw pointer. Optionally give the cfunction a name and "
"source location for stack traces and debugging.") {
janet_sandbox_assert(JANET_SANDBOX_FFI_USE);
janet_arity(argc, 1, 4);
void *pointer = janet_getpointer(argv, 0);
const char *name = janet_optcstring(argv, argc, 1, NULL);
const char *source = janet_optcstring(argv, argc, 2, NULL);
int32_t line = janet_optinteger(argv, argc, 3, -1);
if ((name != NULL) || (source != NULL) || (line != -1)) {
janet_registry_put((JanetCFunction) pointer, name, NULL, source, line);
}
return janet_wrap_cfunction((JanetCFunction) pointer);
}
JANET_CORE_FN(cfun_ffi_supported_calling_conventions,
"(ffi/calling-conventions)",
"Get an array of all supported calling conventions on the current arhcitecture. Some architectures may have some FFI "
"Get an array of all supported calling conventions on the current architecture. Some architectures may have some FFI "
"functionality (ffi/malloc, ffi/free, ffi/read, ffi/write, etc.) but not support "
"any calling conventions. This function can be used to get all supported calling conventions "
"that can be used on this architecture. All architectures support the :none calling "
@ -1567,6 +1583,7 @@ void janet_lib_ffi(JanetTable *env) {
JANET_CORE_REG("ffi/malloc", cfun_ffi_malloc),
JANET_CORE_REG("ffi/free", cfun_ffi_free),
JANET_CORE_REG("ffi/pointer-buffer", cfun_ffi_pointer_buffer),
JANET_CORE_REG("ffi/pointer-cfunction", cfun_ffi_pointer_cfunction),
JANET_CORE_REG("ffi/calling-conventions", cfun_ffi_supported_calling_conventions),
JANET_REG_END
};

View File

@ -39,8 +39,10 @@ static void fiber_reset(JanetFiber *fiber) {
fiber->env = NULL;
fiber->last_value = janet_wrap_nil();
#ifdef JANET_EV
fiber->waiting = NULL;
fiber->sched_id = 0;
fiber->ev_callback = NULL;
fiber->ev_state = NULL;
fiber->ev_stream = NULL;
fiber->supervisor_channel = NULL;
#endif
janet_fiber_set_status(fiber, JANET_STATUS_NEW);
@ -85,7 +87,6 @@ JanetFiber *janet_fiber_reset(JanetFiber *fiber, JanetFunction *callee, int32_t
if (janet_fiber_funcframe(fiber, callee)) return NULL;
janet_fiber_frame(fiber)->flags |= JANET_STACKFRAME_ENTRANCE;
#ifdef JANET_EV
fiber->waiting = NULL;
fiber->supervisor_channel = NULL;
#endif
return fiber;
@ -238,8 +239,8 @@ int janet_fiber_funcframe(JanetFiber *fiber, JanetFunction *func) {
fiber->data + tuplehead,
oldtop - tuplehead)
: janet_wrap_tuple(janet_tuple_n(
fiber->data + tuplehead,
oldtop - tuplehead));
fiber->data + tuplehead,
oldtop - tuplehead));
}
}
@ -369,8 +370,8 @@ int janet_fiber_funcframe_tail(JanetFiber *fiber, JanetFunction *func) {
fiber->data + tuplehead,
fiber->stacktop - tuplehead)
: janet_wrap_tuple(janet_tuple_n(
fiber->data + tuplehead,
fiber->stacktop - tuplehead));
fiber->data + tuplehead,
fiber->stacktop - tuplehead));
}
stacksize = tuplehead - fiber->stackstart + 1;
} else {
@ -661,7 +662,7 @@ JANET_CORE_FN(cfun_fiber_can_resume,
}
JANET_CORE_FN(cfun_fiber_last_value,
"(fiber/last-value)",
"(fiber/last-value fiber)",
"Get the last value returned or signaled from the fiber.") {
janet_fixarity(argc, 1);
JanetFiber *fiber = janet_getfiber(argv, 0);

View File

@ -59,6 +59,9 @@
#define JANET_FIBER_EV_FLAG_CANCELED 0x10000
#define JANET_FIBER_EV_FLAG_SUSPENDED 0x20000
#define JANET_FIBER_FLAG_ROOT 0x40000
#define JANET_FIBER_EV_FLAG_IN_FLIGHT 0x1
/* used only on windows, should otherwise be unset */
#define janet_fiber_set_status(f, s) do {\
(f)->flags &= ~JANET_FIBER_STATUS_MASK;\

View File

@ -132,6 +132,24 @@ static void janet_mark_many(const Janet *values, int32_t n) {
}
}
/* Mark a bunch of key values items in memory */
static void janet_mark_keys(const JanetKV *kvs, int32_t n) {
const JanetKV *end = kvs + n;
while (kvs < end) {
janet_mark(kvs->key);
kvs++;
}
}
/* Mark a bunch of key values items in memory */
static void janet_mark_values(const JanetKV *kvs, int32_t n) {
const JanetKV *end = kvs + n;
while (kvs < end) {
janet_mark(kvs->value);
kvs++;
}
}
/* Mark a bunch of key values items in memory */
static void janet_mark_kvs(const JanetKV *kvs, int32_t n) {
const JanetKV *end = kvs + n;
@ -146,7 +164,9 @@ static void janet_mark_array(JanetArray *array) {
if (janet_gc_reachable(array))
return;
janet_gc_mark(array);
janet_mark_many(array->data, array->count);
if (janet_gc_type((JanetGCObject *) array) == JANET_MEMORY_ARRAY) {
janet_mark_many(array->data, array->count);
}
}
static void janet_mark_table(JanetTable *table) {
@ -154,7 +174,15 @@ recur: /* Manual tail recursion */
if (janet_gc_reachable(table))
return;
janet_gc_mark(table);
janet_mark_kvs(table->data, table->capacity);
enum JanetMemoryType memtype = janet_gc_type(table);
if (memtype == JANET_MEMORY_TABLE_WEAKK) {
janet_mark_values(table->data, table->capacity);
} else if (memtype == JANET_MEMORY_TABLE_WEAKV) {
janet_mark_keys(table->data, table->capacity);
} else if (memtype == JANET_MEMORY_TABLE) {
janet_mark_kvs(table->data, table->capacity);
}
/* do nothing for JANET_MEMORY_TABLE_WEAKKV */
if (table->proto) {
table = table->proto;
goto recur;
@ -268,6 +296,12 @@ recur:
if (fiber->supervisor_channel) {
janet_mark_abstract(fiber->supervisor_channel);
}
if (fiber->ev_stream) {
janet_mark_abstract(fiber->ev_stream);
}
if (fiber->ev_callback) {
fiber->ev_callback(fiber, JANET_ASYNC_EVENT_MARK);
}
#endif
/* Explicit tail recursion */
@ -292,9 +326,17 @@ static void janet_deinit_block(JanetGCObject *mem) {
case JANET_MEMORY_TABLE:
janet_free(((JanetTable *) mem)->data);
break;
case JANET_MEMORY_FIBER:
janet_free(((JanetFiber *)mem)->data);
break;
case JANET_MEMORY_FIBER: {
JanetFiber *f = (JanetFiber *)mem;
#ifdef JANET_EV
if (f->ev_state && !(f->flags & JANET_FIBER_EV_FLAG_IN_FLIGHT)) {
janet_ev_dec_refcount();
janet_free(f->ev_state);
}
#endif
janet_free(f->data);
}
break;
case JANET_MEMORY_BUFFER:
janet_buffer_deinit((JanetBuffer *) mem);
break;
@ -326,12 +368,98 @@ static void janet_deinit_block(JanetGCObject *mem) {
}
}
/* Check that a value x has been visited in the mark phase */
static int janet_check_liveref(Janet x) {
switch (janet_type(x)) {
default:
return 1;
case JANET_ARRAY:
case JANET_TABLE:
case JANET_FUNCTION:
case JANET_BUFFER:
case JANET_FIBER:
return janet_gc_reachable(janet_unwrap_pointer(x));
case JANET_STRING:
case JANET_SYMBOL:
case JANET_KEYWORD:
return janet_gc_reachable(janet_string_head(janet_unwrap_string(x)));
case JANET_ABSTRACT:
return janet_gc_reachable(janet_abstract_head(janet_unwrap_abstract(x)));
case JANET_TUPLE:
return janet_gc_reachable(janet_tuple_head(janet_unwrap_tuple(x)));
case JANET_STRUCT:
return janet_gc_reachable(janet_struct_head(janet_unwrap_struct(x)));
}
}
/* Iterate over all allocated memory, and free memory that is not
* marked as reachable. Flip the gc color flag for next sweep. */
void janet_sweep() {
JanetGCObject *previous = NULL;
JanetGCObject *current = janet_vm.blocks;
JanetGCObject *current = janet_vm.weak_blocks;
JanetGCObject *next;
/* Sweep weak heap to drop weak refs */
while (NULL != current) {
next = current->data.next;
if (current->flags & (JANET_MEM_REACHABLE | JANET_MEM_DISABLED)) {
/* Check for dead references */
enum JanetMemoryType type = janet_gc_type(current);
if (type == JANET_MEMORY_ARRAY_WEAK) {
JanetArray *array = (JanetArray *) current;
for (uint32_t i = 0; i < (uint32_t) array->count; i++) {
if (!janet_check_liveref(array->data[i])) {
array->data[i] = janet_wrap_nil();
}
}
} else {
JanetTable *table = (JanetTable *) current;
int check_values = (type == JANET_MEMORY_TABLE_WEAKV) || (type == JANET_MEMORY_TABLE_WEAKKV);
int check_keys = (type == JANET_MEMORY_TABLE_WEAKK) || (type == JANET_MEMORY_TABLE_WEAKKV);
JanetKV *end = table->data + table->capacity;
JanetKV *kvs = table->data;
while (kvs < end) {
int drop = 0;
if (check_keys && !janet_check_liveref(kvs->key)) drop = 1;
if (check_values && !janet_check_liveref(kvs->value)) drop = 1;
if (drop) {
/* Inlined from janet_table_remove without search */
table->count--;
table->deleted++;
kvs->key = janet_wrap_nil();
kvs->value = janet_wrap_false();
}
kvs++;
}
}
}
current = next;
}
/* Sweep weak heap to free blocks */
previous = NULL;
current = janet_vm.weak_blocks;
while (NULL != current) {
next = current->data.next;
if (current->flags & (JANET_MEM_REACHABLE | JANET_MEM_DISABLED)) {
previous = current;
current->flags &= ~JANET_MEM_REACHABLE;
} else {
janet_vm.block_count--;
janet_deinit_block(current);
if (NULL != previous) {
previous->data.next = next;
} else {
janet_vm.weak_blocks = next;
}
janet_free(current);
}
current = next;
}
/* Sweep main heap to free blocks */
previous = NULL;
current = janet_vm.blocks;
while (NULL != current) {
next = current->data.next;
if (current->flags & (JANET_MEM_REACHABLE | JANET_MEM_DISABLED)) {
@ -349,6 +477,7 @@ void janet_sweep() {
}
current = next;
}
#ifdef JANET_EV
/* Sweep threaded abstract types for references to decrement */
JanetKV *items = janet_vm.threaded_abstracts.data;
@ -370,14 +499,15 @@ void janet_sweep() {
if (head->type->gc) {
janet_assert(!head->type->gc(head->data, head->size), "finalizer failed");
}
/* Mark as tombstone in place */
items[i].key = janet_wrap_nil();
items[i].value = janet_wrap_false();
janet_vm.threaded_abstracts.deleted++;
janet_vm.threaded_abstracts.count--;
/* Free memory */
janet_free(janet_abstract_head(abst));
}
/* Mark as tombstone in place */
items[i].key = janet_wrap_nil();
items[i].value = janet_wrap_false();
janet_vm.threaded_abstracts.deleted++;
janet_vm.threaded_abstracts.count--;
}
/* Reset for next sweep */
@ -405,8 +535,15 @@ void *janet_gcalloc(enum JanetMemoryType type, size_t size) {
/* Prepend block to heap list */
janet_vm.next_collection += size;
mem->data.next = janet_vm.blocks;
janet_vm.blocks = mem;
if (type < JANET_MEMORY_TABLE_WEAKK) {
/* normal heap */
mem->data.next = janet_vm.blocks;
janet_vm.blocks = mem;
} else {
/* weak heap */
mem->data.next = janet_vm.weak_blocks;
janet_vm.weak_blocks = mem;
}
janet_vm.block_count++;
return (void *)mem;
@ -437,7 +574,8 @@ void janet_collect(void) {
uint32_t i;
if (janet_vm.gc_suspend) return;
depth = JANET_RECURSION_GUARD;
/* Try and prevent many major collections back to back.
janet_vm.gc_mark_phase = 1;
/* Try to prevent many major collections back to back.
* A full collection will take O(janet_vm.block_count) time.
* If we have a large heap, make sure our interval is not too
* small so we won't make many collections over it. This is just a
@ -456,6 +594,7 @@ void janet_collect(void) {
Janet x = janet_vm.roots[--janet_vm.root_count];
janet_mark(x);
}
janet_vm.gc_mark_phase = 0;
janet_sweep();
janet_vm.next_collection = 0;
janet_free_all_scratch();
@ -559,7 +698,9 @@ void janet_gcunlock(int handle) {
janet_vm.gc_suspend = handle;
}
/* Scratch memory API */
/* Scratch memory API
* Scratch memory allocations do not need to be free (but optionally can be), and will be automatically cleaned
* up in the next call to janet_collect. */
void *janet_smalloc(size_t size) {
JanetScratch *s = janet_malloc(sizeof(JanetScratch) + size);

View File

@ -57,6 +57,10 @@ enum JanetMemoryType {
JANET_MEMORY_FUNCENV,
JANET_MEMORY_FUNCDEF,
JANET_MEMORY_THREADED_ABSTRACT,
JANET_MEMORY_TABLE_WEAKK,
JANET_MEMORY_TABLE_WEAKV,
JANET_MEMORY_TABLE_WEAKKV,
JANET_MEMORY_ARRAY_WEAK
};
/* To allocate collectable memory, one must call janet_alloc, initialize the memory,

View File

@ -73,13 +73,13 @@ static void *int64_unmarshal(JanetMarshalContext *ctx) {
static void it_s64_tostring(void *p, JanetBuffer *buffer) {
char str[32];
sprintf(str, "%" PRId64, *((int64_t *)p));
snprintf(str, sizeof(str), "%" PRId64, *((int64_t *)p));
janet_buffer_push_cstring(buffer, str);
}
static void it_u64_tostring(void *p, JanetBuffer *buffer) {
char str[32];
sprintf(str, "%" PRIu64, *((uint64_t *)p));
snprintf(str, sizeof(str), "%" PRIu64, *((uint64_t *)p));
janet_buffer_push_cstring(buffer, str);
}
@ -118,10 +118,9 @@ int64_t janet_unwrap_s64(Janet x) {
default:
break;
case JANET_NUMBER : {
double dbl = janet_unwrap_number(x);
if (fabs(dbl) <= MAX_INT_IN_DBL)
return (int64_t)dbl;
break;
double d = janet_unwrap_number(x);
if (!janet_checkint64range(d)) break;
return (int64_t) d;
}
case JANET_STRING: {
int64_t value;
@ -147,12 +146,9 @@ uint64_t janet_unwrap_u64(Janet x) {
default:
break;
case JANET_NUMBER : {
double dbl = janet_unwrap_number(x);
/* Allow negative values to be cast to "wrap around".
* This let's addition and subtraction work as expected. */
if (fabs(dbl) <= MAX_INT_IN_DBL)
return (uint64_t)dbl;
break;
double d = janet_unwrap_number(x);
if (!janet_checkuint64range(d)) break;
return (uint64_t) d;
}
case JANET_STRING: {
uint64_t value;
@ -243,7 +239,7 @@ JANET_CORE_FN(cfun_to_bytes,
"Write the bytes of an `int/s64` or `int/u64` into a buffer.\n"
"The `buffer` parameter specifies an existing buffer to write to, if unset a new buffer will be created.\n"
"Returns the modified buffer.\n"
"The `endianness` paramater indicates the byte order:\n"
"The `endianness` parameter indicates the byte order:\n"
"- `nil` (unset): system byte order\n"
"- `:le`: little-endian, least significant byte first\n"
"- `:be`: big-endian, most significant byte first\n") {
@ -307,8 +303,8 @@ static int compare_double_double(double x, double y) {
static int compare_int64_double(int64_t x, double y) {
if (isnan(y)) {
return 0; // clojure and python do this
} else if ((y > (- ((double) MAX_INT_IN_DBL))) && (y < ((double) MAX_INT_IN_DBL))) {
return 0;
} else if ((y > JANET_INTMIN_DOUBLE) && (y < JANET_INTMAX_DOUBLE)) {
double dx = (double) x;
return compare_double_double(dx, y);
} else if (y > ((double) INT64_MAX)) {
@ -323,10 +319,10 @@ static int compare_int64_double(int64_t x, double y) {
static int compare_uint64_double(uint64_t x, double y) {
if (isnan(y)) {
return 0; // clojure and python do this
return 0;
} else if (y < 0) {
return 1;
} else if ((y >= 0) && (y < ((double) MAX_INT_IN_DBL))) {
} else if ((y >= 0) && (y < JANET_INTMAX_DOUBLE)) {
double dx = (double) x;
return compare_double_double(dx, y);
} else if (y > ((double) UINT64_MAX)) {
@ -339,8 +335,9 @@ static int compare_uint64_double(uint64_t x, double y) {
static Janet cfun_it_s64_compare(int32_t argc, Janet *argv) {
janet_fixarity(argc, 2);
if (janet_is_int(argv[0]) != JANET_INT_S64)
if (janet_is_int(argv[0]) != JANET_INT_S64) {
janet_panic("compare method requires int/s64 as first argument");
}
int64_t x = janet_unwrap_s64(argv[0]);
switch (janet_type(argv[1])) {
default:
@ -355,7 +352,6 @@ static Janet cfun_it_s64_compare(int32_t argc, Janet *argv) {
int64_t y = *(int64_t *)abst;
return janet_wrap_number((x < y) ? -1 : (x > y ? 1 : 0));
} else if (janet_abstract_type(abst) == &janet_u64_type) {
// comparing signed to unsigned -- be careful!
uint64_t y = *(uint64_t *)abst;
if (x < 0) {
return janet_wrap_number(-1);
@ -374,8 +370,9 @@ static Janet cfun_it_s64_compare(int32_t argc, Janet *argv) {
static Janet cfun_it_u64_compare(int32_t argc, Janet *argv) {
janet_fixarity(argc, 2);
if (janet_is_int(argv[0]) != JANET_INT_U64) // is this needed?
if (janet_is_int(argv[0]) != JANET_INT_U64) {
janet_panic("compare method requires int/u64 as first argument");
}
uint64_t x = janet_unwrap_u64(argv[0]);
switch (janet_type(argv[1])) {
default:
@ -390,7 +387,6 @@ static Janet cfun_it_u64_compare(int32_t argc, Janet *argv) {
uint64_t y = *(uint64_t *)abst;
return janet_wrap_number((x < y) ? -1 : (x > y ? 1 : 0));
} else if (janet_abstract_type(abst) == &janet_s64_type) {
// comparing unsigned to signed -- be careful!
int64_t y = *(int64_t *)abst;
if (y < 0) {
return janet_wrap_number(1);
@ -431,7 +427,7 @@ static Janet cfun_it_##type##_##name(int32_t argc, Janet *argv) { \
} \
#define OPMETHODINVERT(T, type, name, oper) \
static Janet cfun_it_##type##_##name(int32_t argc, Janet *argv) { \
static Janet cfun_it_##type##_##name##i(int32_t argc, Janet *argv) { \
janet_fixarity(argc, 2); \
T *box = janet_abstract(&janet_##type##_type, sizeof(T)); \
*box = janet_unwrap_##type(argv[1]); \
@ -440,6 +436,19 @@ static Janet cfun_it_##type##_##name(int32_t argc, Janet *argv) { \
return janet_wrap_abstract(box); \
} \
#define UNARYMETHOD(T, type, name, oper) \
static Janet cfun_it_##type##_##name(int32_t argc, Janet *argv) { \
janet_fixarity(argc, 1); \
T *box = janet_abstract(&janet_##type##_type, sizeof(T)); \
*box = oper(janet_unwrap_##type(argv[0])); \
return janet_wrap_abstract(box); \
} \
#define DIVZERO(name) DIVZERO_##name
#define DIVZERO_div janet_panic("division by zero")
#define DIVZERO_rem janet_panic("division by zero")
#define DIVZERO_mod return janet_wrap_abstract(box)
#define DIVMETHOD(T, type, name, oper) \
static Janet cfun_it_##type##_##name(int32_t argc, Janet *argv) { \
janet_arity(argc, 2, -1); \
@ -447,19 +456,19 @@ static Janet cfun_it_##type##_##name(int32_t argc, Janet *argv) { \
*box = janet_unwrap_##type(argv[0]); \
for (int32_t i = 1; i < argc; i++) { \
T value = janet_unwrap_##type(argv[i]); \
if (value == 0) janet_panic("division by zero"); \
if (value == 0) DIVZERO(name); \
*box oper##= value; \
} \
return janet_wrap_abstract(box); \
} \
#define DIVMETHODINVERT(T, type, name, oper) \
static Janet cfun_it_##type##_##name(int32_t argc, Janet *argv) { \
static Janet cfun_it_##type##_##name##i(int32_t argc, Janet *argv) { \
janet_fixarity(argc, 2); \
T *box = janet_abstract(&janet_##type##_type, sizeof(T)); \
*box = janet_unwrap_##type(argv[1]); \
T value = janet_unwrap_##type(argv[0]); \
if (value == 0) janet_panic("division by zero"); \
if (value == 0) DIVZERO(name); \
*box oper##= value; \
return janet_wrap_abstract(box); \
} \
@ -471,7 +480,7 @@ static Janet cfun_it_##type##_##name(int32_t argc, Janet *argv) { \
*box = janet_unwrap_##type(argv[0]); \
for (int32_t i = 1; i < argc; i++) { \
T value = janet_unwrap_##type(argv[i]); \
if (value == 0) janet_panic("division by zero"); \
if (value == 0) DIVZERO(name); \
if ((value == -1) && (*box == INT64_MIN)) janet_panic("INT64_MIN divided by -1"); \
*box oper##= value; \
} \
@ -479,26 +488,50 @@ static Janet cfun_it_##type##_##name(int32_t argc, Janet *argv) { \
} \
#define DIVMETHODINVERT_SIGNED(T, type, name, oper) \
static Janet cfun_it_##type##_##name(int32_t argc, Janet *argv) { \
static Janet cfun_it_##type##_##name##i(int32_t argc, Janet *argv) { \
janet_fixarity(argc, 2); \
T *box = janet_abstract(&janet_##type##_type, sizeof(T)); \
*box = janet_unwrap_##type(argv[1]); \
T value = janet_unwrap_##type(argv[0]); \
if (value == 0) janet_panic("division by zero"); \
if (value == 0) DIVZERO(name); \
if ((value == -1) && (*box == INT64_MIN)) janet_panic("INT64_MIN divided by -1"); \
*box oper##= value; \
return janet_wrap_abstract(box); \
} \
static Janet cfun_it_s64_divf(int32_t argc, Janet *argv) {
janet_fixarity(argc, 2);
int64_t *box = janet_abstract(&janet_s64_type, sizeof(int64_t));
int64_t op1 = janet_unwrap_s64(argv[0]);
int64_t op2 = janet_unwrap_s64(argv[1]);
if (op2 == 0) janet_panic("division by zero");
int64_t x = op1 / op2;
*box = x - (((op1 ^ op2) < 0) && (x * op2 != op1));
return janet_wrap_abstract(box);
}
static Janet cfun_it_s64_divfi(int32_t argc, Janet *argv) {
janet_fixarity(argc, 2);
int64_t *box = janet_abstract(&janet_s64_type, sizeof(int64_t));
int64_t op2 = janet_unwrap_s64(argv[0]);
int64_t op1 = janet_unwrap_s64(argv[1]);
if (op2 == 0) janet_panic("division by zero");
int64_t x = op1 / op2;
*box = x - (((op1 ^ op2) < 0) && (x * op2 != op1));
return janet_wrap_abstract(box);
}
static Janet cfun_it_s64_mod(int32_t argc, Janet *argv) {
janet_fixarity(argc, 2);
int64_t *box = janet_abstract(&janet_s64_type, sizeof(int64_t));
int64_t op1 = janet_unwrap_s64(argv[0]);
int64_t op2 = janet_unwrap_s64(argv[1]);
int64_t x = op1 % op2;
*box = (op1 > 0)
? ((op2 > 0) ? x : (0 == x ? x : x + op2))
: ((op2 > 0) ? (0 == x ? x : x + op2) : x);
if (op2 == 0) {
*box = op1;
} else {
int64_t x = op1 % op2;
*box = (((op1 ^ op2) < 0) && (x != 0)) ? x + op2 : x;
}
return janet_wrap_abstract(box);
}
@ -507,37 +540,43 @@ static Janet cfun_it_s64_modi(int32_t argc, Janet *argv) {
int64_t *box = janet_abstract(&janet_s64_type, sizeof(int64_t));
int64_t op2 = janet_unwrap_s64(argv[0]);
int64_t op1 = janet_unwrap_s64(argv[1]);
int64_t x = op1 % op2;
*box = (op1 > 0)
? ((op2 > 0) ? x : (0 == x ? x : x + op2))
: ((op2 > 0) ? (0 == x ? x : x + op2) : x);
if (op2 == 0) {
*box = op1;
} else {
int64_t x = op1 % op2;
*box = (((op1 ^ op2) < 0) && (x != 0)) ? x + op2 : x;
}
return janet_wrap_abstract(box);
}
OPMETHOD(int64_t, s64, add, +)
OPMETHOD(int64_t, s64, sub, -)
OPMETHODINVERT(int64_t, s64, subi, -)
OPMETHODINVERT(int64_t, s64, sub, -)
OPMETHOD(int64_t, s64, mul, *)
DIVMETHOD_SIGNED(int64_t, s64, div, /)
DIVMETHOD_SIGNED(int64_t, s64, rem, %)
DIVMETHODINVERT_SIGNED(int64_t, s64, divi, /)
DIVMETHODINVERT_SIGNED(int64_t, s64, remi, %)
DIVMETHODINVERT_SIGNED(int64_t, s64, div, /)
DIVMETHODINVERT_SIGNED(int64_t, s64, rem, %)
OPMETHOD(int64_t, s64, and, &)
OPMETHOD(int64_t, s64, or, |)
OPMETHOD(int64_t, s64, xor, ^)
UNARYMETHOD(int64_t, s64, not, ~)
OPMETHOD(int64_t, s64, lshift, <<)
OPMETHOD(int64_t, s64, rshift, >>)
OPMETHOD(uint64_t, u64, add, +)
OPMETHOD(uint64_t, u64, sub, -)
OPMETHODINVERT(uint64_t, u64, subi, -)
OPMETHODINVERT(uint64_t, u64, sub, -)
OPMETHOD(uint64_t, u64, mul, *)
DIVMETHOD(uint64_t, u64, div, /)
DIVMETHOD(uint64_t, u64, rem, %)
DIVMETHOD(uint64_t, u64, mod, %)
DIVMETHODINVERT(uint64_t, u64, divi, /)
DIVMETHODINVERT(uint64_t, u64, modi, %)
DIVMETHODINVERT(uint64_t, u64, div, /)
DIVMETHODINVERT(uint64_t, u64, rem, %)
DIVMETHODINVERT(uint64_t, u64, mod, %)
OPMETHOD(uint64_t, u64, and, &)
OPMETHOD(uint64_t, u64, or, |)
OPMETHOD(uint64_t, u64, xor, ^)
UNARYMETHOD(uint64_t, u64, not, ~)
OPMETHOD(uint64_t, u64, lshift, <<)
OPMETHOD(uint64_t, u64, rshift, >>)
@ -555,6 +594,8 @@ static JanetMethod it_s64_methods[] = {
{"r*", cfun_it_s64_mul},
{"/", cfun_it_s64_div},
{"r/", cfun_it_s64_divi},
{"div", cfun_it_s64_divf},
{"rdiv", cfun_it_s64_divfi},
{"mod", cfun_it_s64_mod},
{"rmod", cfun_it_s64_modi},
{"%", cfun_it_s64_rem},
@ -565,6 +606,7 @@ static JanetMethod it_s64_methods[] = {
{"r|", cfun_it_s64_or},
{"^", cfun_it_s64_xor},
{"r^", cfun_it_s64_xor},
{"~", cfun_it_s64_not},
{"<<", cfun_it_s64_lshift},
{">>", cfun_it_s64_rshift},
{"compare", cfun_it_s64_compare},
@ -580,16 +622,19 @@ static JanetMethod it_u64_methods[] = {
{"r*", cfun_it_u64_mul},
{"/", cfun_it_u64_div},
{"r/", cfun_it_u64_divi},
{"div", cfun_it_u64_div},
{"rdiv", cfun_it_u64_divi},
{"mod", cfun_it_u64_mod},
{"rmod", cfun_it_u64_modi},
{"%", cfun_it_u64_mod},
{"r%", cfun_it_u64_modi},
{"%", cfun_it_u64_rem},
{"r%", cfun_it_u64_remi},
{"&", cfun_it_u64_and},
{"r&", cfun_it_u64_and},
{"|", cfun_it_u64_or},
{"r|", cfun_it_u64_or},
{"^", cfun_it_u64_xor},
{"r^", cfun_it_u64_xor},
{"~", cfun_it_u64_not},
{"<<", cfun_it_u64_lshift},
{">>", cfun_it_u64_rshift},
{"compare", cfun_it_u64_compare},

View File

@ -131,7 +131,7 @@ JANET_CORE_FN(cfun_io_temp,
}
JANET_CORE_FN(cfun_io_fopen,
"(file/open path &opt mode)",
"(file/open path &opt mode buffer-size)",
"Open a file. `path` is an absolute or relative path, and "
"`mode` is a set of flags indicating the mode to open the file in. "
"`mode` is a keyword where each character represents a flag. If the file "
@ -143,8 +143,9 @@ JANET_CORE_FN(cfun_io_fopen,
"Following one of the initial flags, 0 or more of the following flags can be appended:\n\n"
"* b - open the file in binary mode (rather than text mode)\n\n"
"* + - append to the file instead of overwriting it\n\n"
"* n - error if the file cannot be opened instead of returning nil") {
janet_arity(argc, 1, 2);
"* n - error if the file cannot be opened instead of returning nil\n\n"
"See fopen (<stdio.h>, C99) for further details.") {
janet_arity(argc, 1, 3);
const uint8_t *fname = janet_getstring(argv, 0);
const uint8_t *fmode;
int32_t flags;
@ -157,6 +158,15 @@ JANET_CORE_FN(cfun_io_fopen,
flags = JANET_FILE_READ;
}
FILE *f = fopen((const char *)fname, (const char *)fmode);
if (f != NULL) {
size_t bufsize = janet_optsize(argv, argc, 2, BUFSIZ);
if (bufsize != BUFSIZ) {
int result = setvbuf(f, NULL, bufsize ? _IOFBF : _IONBF, bufsize);
if (result) {
janet_panic("failed to set buffer size for file");
}
}
}
return f ? janet_makefile(f, flags)
: (flags & JANET_FILE_NONIL) ? (janet_panicf("failed to open file %s: %s", fname, strerror(errno)), janet_wrap_nil())
: janet_wrap_nil();

View File

@ -154,7 +154,7 @@ static void pushbytes(MarshalState *st, const uint8_t *bytes, int32_t len) {
janet_buffer_push_bytes(st->buf, bytes, len);
}
static void pushpointer(MarshalState *st, void *ptr) {
static void pushpointer(MarshalState *st, const void *ptr) {
janet_buffer_push_bytes(st->buf, (const uint8_t *) &ptr, sizeof(ptr));
}
@ -185,6 +185,19 @@ static void marshal_one_env(MarshalState *st, JanetFuncEnv *env, int flags);
/* Prevent stack overflows */
#define MARSH_STACKCHECK if ((flags & 0xFFFF) > JANET_RECURSION_GUARD) janet_panic("stack overflow")
/* Quick check if a fiber cannot be marshalled. This is will
* have no false positives, but may have false negatives. */
static int fiber_cannot_be_marshalled(JanetFiber *fiber) {
if (janet_fiber_status(fiber) == JANET_STATUS_ALIVE) return 1;
int32_t i = fiber->frame;
while (i > 0) {
JanetStackFrame *frame = (JanetStackFrame *)(fiber->data + i - JANET_FRAME_SIZE);
if (!frame->func) return 1; /* has cfunction on stack */
i = frame->prevframe;
}
return 0;
}
/* Marshal a function env */
static void marshal_one_env(MarshalState *st, JanetFuncEnv *env, int flags) {
MARSH_STACKCHECK;
@ -197,7 +210,9 @@ static void marshal_one_env(MarshalState *st, JanetFuncEnv *env, int flags) {
}
janet_env_valid(env);
janet_v_push(st->seen_envs, env);
if (env->offset > 0 && (JANET_STATUS_ALIVE == janet_fiber_status(env->as.fiber))) {
/* Special case for early detachment */
if (env->offset > 0 && fiber_cannot_be_marshalled(env->as.fiber)) {
pushint(st, 0);
pushint(st, env->length);
Janet *values = env->as.fiber->data + env->offset;
@ -246,6 +261,7 @@ static void marshal_one_def(MarshalState *st, JanetFuncDef *def, int flags) {
}
/* Add to lookup */
janet_v_push(st->seen_defs, def);
pushint(st, def->flags);
pushint(st, def->slotcount);
pushint(st, def->arity);
@ -266,14 +282,14 @@ static void marshal_one_def(MarshalState *st, JanetFuncDef *def, int flags) {
/* marshal constants */
for (int32_t i = 0; i < def->constants_length; i++)
marshal_one(st, def->constants[i], flags);
marshal_one(st, def->constants[i], flags + 1);
/* Marshal symbol map, if needed */
for (int32_t i = 0; i < def->symbolmap_length; i++) {
pushint(st, (int32_t) def->symbolmap[i].birth_pc);
pushint(st, (int32_t) def->symbolmap[i].death_pc);
pushint(st, (int32_t) def->symbolmap[i].slot_index);
marshal_one(st, janet_wrap_symbol(def->symbolmap[i].symbol), flags);
marshal_one(st, janet_wrap_symbol(def->symbolmap[i].symbol), flags + 1);
}
/* marshal the bytecode */
@ -327,7 +343,7 @@ static void marshal_one_fiber(MarshalState *st, JanetFiber *fiber, int flags) {
while (i > 0) {
JanetStackFrame *frame = (JanetStackFrame *)(fiber->data + i - JANET_FRAME_SIZE);
if (frame->env) frame->flags |= JANET_STACKFRAME_HASENV;
if (!frame->func) janet_panic("cannot marshal fiber with c stackframe");
if (!frame->func) janet_panicf("cannot marshal fiber with c stackframe (%v)", janet_wrap_cfunction((JanetCFunction) frame->pc));
pushint(st, frame->flags);
pushint(st, frame->prevframe);
int32_t pcdiff = (int32_t)(frame->pc - frame->func->def->bytecode);
@ -362,6 +378,15 @@ void janet_marshal_int(JanetMarshalContext *ctx, int32_t value) {
pushint(st, value);
}
/* Only use in unsafe - don't marshal pointers otherwise */
void janet_marshal_ptr(JanetMarshalContext *ctx, const void *ptr) {
if (!(ctx->flags & JANET_MARSHAL_UNSAFE)) {
janet_panic("can only marshal pointers in unsafe mode");
}
MarshalState *st = (MarshalState *)(ctx->m_state);
pushpointer(st, ptr);
}
void janet_marshal_byte(JanetMarshalContext *ctx, uint8_t value) {
MarshalState *st = (MarshalState *)(ctx->m_state);
pushbyte(st, value);
@ -378,18 +403,27 @@ void janet_marshal_janet(JanetMarshalContext *ctx, Janet x) {
marshal_one(st, x, ctx->flags + 1);
}
#ifdef JANET_MARSHAL_DEBUG
#define MARK_SEEN() \
do { if (st->maybe_cycles) { \
Janet _check = janet_table_get(&st->seen, x); \
if (!janet_checktype(_check, JANET_NIL)) janet_eprintf("double MARK_SEEN on %v\n", x); \
janet_eprintf("made reference %d (%t) to %v\n", st->nextid, x, x); \
janet_table_put(&st->seen, x, janet_wrap_integer(st->nextid++)); \
} } while (0)
#else
#define MARK_SEEN() \
do { if (st->maybe_cycles) { \
janet_table_put(&st->seen, x, janet_wrap_integer(st->nextid++)); \
} } while (0)
#endif
void janet_marshal_abstract(JanetMarshalContext *ctx, void *abstract) {
MarshalState *st = (MarshalState *)(ctx->m_state);
if (st->maybe_cycles) {
janet_table_put(&st->seen,
janet_wrap_abstract(abstract),
janet_wrap_integer(st->nextid++));
}
Janet x = janet_wrap_abstract(abstract);
MARK_SEEN();
}
#define MARK_SEEN() \
do { if (st->maybe_cycles) janet_table_put(&st->seen, x, janet_wrap_integer(st->nextid++)); } while (0)
static void marshal_one_abstract(MarshalState *st, Janet x, int flags) {
void *abstract = janet_unwrap_abstract(x);
#ifdef JANET_EV
@ -411,7 +445,7 @@ static void marshal_one_abstract(MarshalState *st, Janet x, int flags) {
if (at->marshal) {
pushbyte(st, LB_ABSTRACT);
marshal_one(st, janet_csymbolv(at->name), flags + 1);
JanetMarshalContext context = {st, NULL, flags, NULL, at};
JanetMarshalContext context = {st, NULL, flags + 1, NULL, at};
at->marshal(abstract, &context);
} else {
janet_panicf("cannot marshal %p", x);
@ -728,9 +762,22 @@ static uint64_t read64(UnmarshalState *st, const uint8_t **atdata) {
return ret;
}
#ifdef JANET_MARSHAL_DEBUG
static void dump_reference_table(UnmarshalState *st) {
for (int32_t i = 0; i < janet_v_count(st->lookup); i++) {
janet_eprintf(" reference %d (%t) = %v\n", i, st->lookup[i], st->lookup[i]);
}
}
#endif
/* Assert a janet type */
static void janet_asserttype(Janet x, JanetType t) {
static void janet_asserttype(Janet x, JanetType t, UnmarshalState *st) {
if (!janet_checktype(x, t)) {
#ifdef JANET_MARSHAL_DEBUG
dump_reference_table(st);
#else
(void) st;
#endif
janet_panicf("expected type %T, got %v", 1 << t, x);
}
}
@ -782,7 +829,7 @@ static const uint8_t *unmarshal_one_env(
Janet fiberv;
/* On stack variant */
data = unmarshal_one(st, data, &fiberv, flags);
janet_asserttype(fiberv, JANET_FIBER);
janet_asserttype(fiberv, JANET_FIBER, st);
env->as.fiber = janet_unwrap_fiber(fiberv);
/* Negative offset indicates untrusted input */
env->offset = -offset;
@ -880,13 +927,13 @@ static const uint8_t *unmarshal_one_def(
if (def->flags & JANET_FUNCDEF_FLAG_HASNAME) {
Janet x;
data = unmarshal_one(st, data, &x, flags + 1);
janet_asserttype(x, JANET_STRING);
janet_asserttype(x, JANET_STRING, st);
def->name = janet_unwrap_string(x);
}
if (def->flags & JANET_FUNCDEF_FLAG_HASSOURCE) {
Janet x;
data = unmarshal_one(st, data, &x, flags + 1);
janet_asserttype(x, JANET_STRING);
janet_asserttype(x, JANET_STRING, st);
def->source = janet_unwrap_string(x);
}
@ -916,8 +963,9 @@ static const uint8_t *unmarshal_one_def(
def->symbolmap[i].slot_index = (uint32_t) readint(st, &data);
Janet value;
data = unmarshal_one(st, data, &value, flags + 1);
if (!janet_checktype(value, JANET_SYMBOL))
janet_panic("expected symbol in symbol map");
if (!janet_checktype(value, JANET_SYMBOL)) {
janet_panicf("corrupted symbolmap when unmarshalling debug info, got %v", value);
}
def->symbolmap[i].symbol = janet_unwrap_symbol(value);
}
def->symbolmap_length = (uint32_t) symbolmap_length;
@ -1015,9 +1063,11 @@ static const uint8_t *unmarshal_one_fiber(
fiber->env = NULL;
fiber->last_value = janet_wrap_nil();
#ifdef JANET_EV
fiber->waiting = NULL;
fiber->sched_id = 0;
fiber->supervisor_channel = NULL;
fiber->ev_state = NULL;
fiber->ev_callback = NULL;
fiber->ev_stream = NULL;
#endif
/* Push fiber to seen stack */
@ -1066,7 +1116,7 @@ static const uint8_t *unmarshal_one_fiber(
/* Get function */
Janet funcv;
data = unmarshal_one(st, data, &funcv, flags + 1);
janet_asserttype(funcv, JANET_FUNCTION);
janet_asserttype(funcv, JANET_FUNCTION, st);
func = janet_unwrap_function(funcv);
def = func->def;
@ -1112,7 +1162,7 @@ static const uint8_t *unmarshal_one_fiber(
Janet envv;
fiber_flags &= ~JANET_FIBER_FLAG_HASENV;
data = unmarshal_one(st, data, &envv, flags + 1);
janet_asserttype(envv, JANET_TABLE);
janet_asserttype(envv, JANET_TABLE, st);
fiber_env = janet_unwrap_table(envv);
}
@ -1121,7 +1171,7 @@ static const uint8_t *unmarshal_one_fiber(
Janet fiberv;
fiber_flags &= ~JANET_FIBER_FLAG_HASCHILD;
data = unmarshal_one(st, data, &fiberv, flags + 1);
janet_asserttype(fiberv, JANET_FIBER);
janet_asserttype(fiberv, JANET_FIBER, st);
fiber->child = janet_unwrap_fiber(fiberv);
}
@ -1165,6 +1215,18 @@ int64_t janet_unmarshal_int64(JanetMarshalContext *ctx) {
return read64(st, &(ctx->data));
}
void *janet_unmarshal_ptr(JanetMarshalContext *ctx) {
if (!(ctx->flags & JANET_MARSHAL_UNSAFE)) {
janet_panic("can only unmarshal pointers in unsafe mode");
}
UnmarshalState *st = (UnmarshalState *)(ctx->u_state);
void *ptr;
MARSH_EOS(st, ctx->data + sizeof(void *) - 1);
memcpy((char *) &ptr, ctx->data, sizeof(void *));
ctx->data += sizeof(void *);
return ptr;
}
uint8_t janet_unmarshal_byte(JanetMarshalContext *ctx) {
UnmarshalState *st = (UnmarshalState *)(ctx->u_state);
MARSH_EOS(st, ctx->data);
@ -1200,6 +1262,18 @@ void *janet_unmarshal_abstract(JanetMarshalContext *ctx, size_t size) {
return p;
}
void *janet_unmarshal_abstract_threaded(JanetMarshalContext *ctx, size_t size) {
#ifdef JANET_THREADS
void *p = janet_abstract_threaded(ctx->at, size);
janet_unmarshal_abstract_reuse(ctx, p);
return p;
#else
(void) ctx;
(void) size;
janet_panic("threaded abstracts not supported");
#endif
}
static const uint8_t *unmarshal_one_abstract(UnmarshalState *st, const uint8_t *data, Janet *out, int flags) {
Janet key;
data = unmarshal_one(st, data, &key, flags + 1);
@ -1207,7 +1281,9 @@ static const uint8_t *unmarshal_one_abstract(UnmarshalState *st, const uint8_t *
if (at == NULL) janet_panic("unknown abstract type");
if (at->unmarshal) {
JanetMarshalContext context = {NULL, st, flags, data, at};
*out = janet_wrap_abstract(at->unmarshal(&context));
void *abst = at->unmarshal(&context);
janet_assert(abst != NULL, "null pointer abstract");
*out = janet_wrap_abstract(abst);
if (context.at != NULL) {
janet_panic("janet_unmarshal_abstract not called");
}
@ -1308,7 +1384,7 @@ static const uint8_t *unmarshal_one(
}
case LB_FIBER: {
JanetFiber *fiber;
data = unmarshal_one_fiber(st, data + 1, &fiber, flags);
data = unmarshal_one_fiber(st, data + 1, &fiber, flags + 1);
*out = janet_wrap_fiber(fiber);
return data;
}
@ -1323,6 +1399,9 @@ static const uint8_t *unmarshal_one(
func = janet_gcalloc(JANET_MEMORY_FUNCTION, sizeof(JanetFunction) +
len * sizeof(JanetFuncEnv));
func->def = NULL;
for (int32_t i = 0; i < len; i++) {
func->envs[i] = NULL;
}
*out = janet_wrap_function(func);
janet_v_push(st->lookup, *out);
data = unmarshal_one_def(st, data, &def, flags + 1);
@ -1376,7 +1455,7 @@ static const uint8_t *unmarshal_one(
if (lead == LB_STRUCT_PROTO) {
Janet proto;
data = unmarshal_one(st, data, &proto, flags + 1);
janet_asserttype(proto, JANET_STRUCT);
janet_asserttype(proto, JANET_STRUCT, st);
janet_struct_proto(struct_) = janet_unwrap_struct(proto);
}
for (int32_t i = 0; i < len; i++) {
@ -1399,7 +1478,7 @@ static const uint8_t *unmarshal_one(
if (lead == LB_TABLE_PROTO) {
Janet proto;
data = unmarshal_one(st, data, &proto, flags + 1);
janet_asserttype(proto, JANET_TABLE);
janet_asserttype(proto, JANET_TABLE, st);
t->proto = janet_unwrap_table(proto);
}
for (int32_t i = 0; i < len; i++) {

View File

@ -119,7 +119,7 @@ double janet_rng_double(JanetRNG *rng) {
JANET_CORE_FN(cfun_rng_make,
"(math/rng &opt seed)",
"Creates a Psuedo-Random number generator, with an optional seed. "
"Creates a Pseudo-Random number generator, with an optional seed. "
"The seed should be an unsigned 32 bit integer or a buffer. "
"Do not use this for cryptography. Returns a core/rng abstract type."
) {
@ -411,11 +411,11 @@ void janet_lib_math(JanetTable *env) {
JANET_CORE_DEF(env, "math/int32-min", janet_wrap_number(INT32_MIN),
"The minimum contiguous integer representable by a 32 bit signed integer");
JANET_CORE_DEF(env, "math/int32-max", janet_wrap_number(INT32_MAX),
"The maximum contiguous integer represtenable by a 32 bit signed integer");
"The maximum contiguous integer representable by a 32 bit signed integer");
JANET_CORE_DEF(env, "math/int-min", janet_wrap_number(JANET_INTMIN_DOUBLE),
"The minimum contiguous integer representable by a double (2^53)");
JANET_CORE_DEF(env, "math/int-max", janet_wrap_number(JANET_INTMAX_DOUBLE),
"The maximum contiguous integer represtenable by a double (-(2^53))");
"The maximum contiguous integer representable by a double (-(2^53))");
#ifdef NAN
JANET_CORE_DEF(env, "math/nan", janet_wrap_number(NAN), "Not a number (IEEE-754 NaN)");
#else

View File

@ -24,6 +24,7 @@
#include "features.h"
#include <janet.h>
#include "util.h"
#include "fiber.h"
#endif
#ifdef JANET_NET
@ -78,12 +79,20 @@ const JanetAbstractType janet_address_type = {
/* maximum number of bytes in a socket address host (post name resolution) */
#ifdef JANET_WINDOWS
#ifdef JANET_NO_IPV6
#define SA_ADDRSTRLEN (INET_ADDRSTRLEN + 1)
#else
#define SA_ADDRSTRLEN (INET6_ADDRSTRLEN + 1)
#endif
typedef unsigned short in_port_t;
#else
#define JANET_SA_MAX(a, b) (((a) > (b))? (a) : (b))
#ifdef JANET_NO_IPV6
#define SA_ADDRSTRLEN JANET_SA_MAX(INET_ADDRSTRLEN + 1, (sizeof ((struct sockaddr_un *)0)->sun_path) + 1)
#else
#define SA_ADDRSTRLEN JANET_SA_MAX(INET6_ADDRSTRLEN + 1, (sizeof ((struct sockaddr_un *)0)->sun_path) + 1)
#endif
#endif
static JanetStream *make_stream(JSock handle, uint32_t flags);
@ -111,12 +120,57 @@ static void janet_net_socknoblock(JSock s) {
#endif
}
/* State machine for async connect */
void net_callback_connect(JanetFiber *fiber, JanetAsyncEvent event) {
JanetStream *stream = fiber->ev_stream;
switch (event) {
default:
break;
#ifndef JANET_WINDOWS
/* Wait until we have an actual event before checking.
* Windows doesn't support async connect with this, just try immediately.*/
case JANET_ASYNC_EVENT_INIT:
#endif
case JANET_ASYNC_EVENT_DEINIT:
return;
case JANET_ASYNC_EVENT_CLOSE:
janet_cancel(fiber, janet_cstringv("stream closed"));
janet_async_end(fiber);
return;
}
#ifdef JANET_WINDOWS
int res = 0;
int size = sizeof(res);
int r = getsockopt((SOCKET)stream->handle, SOL_SOCKET, SO_ERROR, (char *)&res, &size);
#else
int res = 0;
socklen_t size = sizeof res;
int r = getsockopt(stream->handle, SOL_SOCKET, SO_ERROR, &res, &size);
#endif
if (r == 0) {
if (res == 0) {
janet_schedule(fiber, janet_wrap_abstract(stream));
} else {
janet_cancel(fiber, janet_cstringv(strerror(res)));
stream->flags |= JANET_STREAM_TOCLOSE;
}
} else {
janet_cancel(fiber, janet_ev_lasterr());
stream->flags |= JANET_STREAM_TOCLOSE;
}
janet_async_end(fiber);
}
static JANET_NO_RETURN void net_sched_connect(JanetStream *stream) {
janet_async_start(stream, JANET_ASYNC_LISTEN_WRITE, net_callback_connect, NULL);
}
/* State machine for accepting connections. */
#ifdef JANET_WINDOWS
typedef struct {
JanetListenerState head;
WSAOVERLAPPED overlapped;
JanetFunction *function;
JanetStream *lstream;
@ -124,10 +178,10 @@ typedef struct {
char buf[1024];
} NetStateAccept;
static int net_sched_accept_impl(NetStateAccept *state, Janet *err);
static int net_sched_accept_impl(NetStateAccept *state, JanetFiber *fiber, Janet *err);
JanetAsyncStatus net_machine_accept(JanetListenerState *s, JanetAsyncEvent event) {
NetStateAccept *state = (NetStateAccept *)s;
void net_callback_accept(JanetFiber *fiber, JanetAsyncEvent event) {
NetStateAccept *state = (NetStateAccept *)fiber->ev_state;
switch (event) {
default:
break;
@ -138,55 +192,60 @@ JanetAsyncStatus net_machine_accept(JanetListenerState *s, JanetAsyncEvent event
break;
}
case JANET_ASYNC_EVENT_CLOSE:
janet_schedule(s->fiber, janet_wrap_nil());
return JANET_ASYNC_STATUS_DONE;
janet_schedule(fiber, janet_wrap_nil());
janet_async_end(fiber);
return;
case JANET_ASYNC_EVENT_COMPLETE: {
if (state->astream->flags & JANET_STREAM_CLOSED) {
janet_cancel(s->fiber, janet_cstringv("failed to accept connection"));
return JANET_ASYNC_STATUS_DONE;
janet_cancel(fiber, janet_cstringv("failed to accept connection"));
janet_async_end(fiber);
return;
}
SOCKET lsock = (SOCKET) state->lstream->handle;
if (NO_ERROR != setsockopt((SOCKET) state->astream->handle, SOL_SOCKET, SO_UPDATE_ACCEPT_CONTEXT,
(char *) &lsock, sizeof(lsock))) {
janet_cancel(s->fiber, janet_cstringv("failed to accept connection"));
return JANET_ASYNC_STATUS_DONE;
janet_cancel(fiber, janet_cstringv("failed to accept connection"));
janet_async_end(fiber);
return;
}
Janet streamv = janet_wrap_abstract(state->astream);
if (state->function) {
/* Schedule worker */
JanetFiber *fiber = janet_fiber(state->function, 64, 1, &streamv);
fiber->supervisor_channel = s->fiber->supervisor_channel;
janet_schedule(fiber, janet_wrap_nil());
JanetFiber *sub_fiber = janet_fiber(state->function, 64, 1, &streamv);
sub_fiber->supervisor_channel = fiber->supervisor_channel;
janet_schedule(sub_fiber, janet_wrap_nil());
/* Now listen again for next connection */
Janet err;
if (net_sched_accept_impl(state, &err)) {
janet_cancel(s->fiber, err);
return JANET_ASYNC_STATUS_DONE;
if (net_sched_accept_impl(state, fiber, &err)) {
janet_cancel(fiber, err);
janet_async_end(fiber);
return;
}
} else {
janet_schedule(s->fiber, streamv);
return JANET_ASYNC_STATUS_DONE;
janet_schedule(fiber, streamv);
janet_async_end(fiber);
return;
}
}
}
return JANET_ASYNC_STATUS_NOT_DONE;
}
JANET_NO_RETURN static void janet_sched_accept(JanetStream *stream, JanetFunction *fun) {
Janet err;
JanetListenerState *s = janet_listen(stream, net_machine_accept, JANET_ASYNC_LISTEN_READ, sizeof(NetStateAccept), NULL);
NetStateAccept *state = (NetStateAccept *)s;
NetStateAccept *state = janet_malloc(sizeof(NetStateAccept));
memset(&state->overlapped, 0, sizeof(WSAOVERLAPPED));
memset(&state->buf, 0, 1024);
state->function = fun;
state->lstream = stream;
s->tag = &state->overlapped;
if (net_sched_accept_impl(state, &err)) janet_panicv(err);
janet_await();
if (net_sched_accept_impl(state, janet_root_fiber(), &err)) {
janet_free(state);
janet_panicv(err);
}
janet_async_start(stream, JANET_ASYNC_LISTEN_READ, net_callback_accept, state);
}
static int net_sched_accept_impl(NetStateAccept *state, Janet *err) {
static int net_sched_accept_impl(NetStateAccept *state, JanetFiber *fiber, Janet *err) {
SOCKET lsock = (SOCKET) state->lstream->handle;
SOCKET asock = WSASocketW(AF_INET, SOCK_STREAM, IPPROTO_TCP, NULL, 0, WSA_FLAG_OVERLAPPED);
if (asock == INVALID_SOCKET) {
@ -198,7 +257,11 @@ static int net_sched_accept_impl(NetStateAccept *state, Janet *err) {
int socksize = sizeof(SOCKADDR_STORAGE) + 16;
if (FALSE == AcceptEx(lsock, asock, state->buf, 0, socksize, socksize, NULL, &state->overlapped)) {
int code = WSAGetLastError();
if (code == WSA_IO_PENDING) return 0; /* indicates io is happening async */
if (code == WSA_IO_PENDING) {
/* indicates io is happening async */
janet_async_in_flight(fiber);
return 0;
}
*err = janet_ev_lasterr();
return 1;
}
@ -208,12 +271,12 @@ static int net_sched_accept_impl(NetStateAccept *state, Janet *err) {
#else
typedef struct {
JanetListenerState head;
JanetFunction *function;
} NetStateAccept;
JanetAsyncStatus net_machine_accept(JanetListenerState *s, JanetAsyncEvent event) {
NetStateAccept *state = (NetStateAccept *)s;
void net_callback_accept(JanetFiber *fiber, JanetAsyncEvent event) {
JanetStream *stream = fiber->ev_stream;
NetStateAccept *state = (NetStateAccept *)fiber->ev_state;
switch (event) {
default:
break;
@ -222,38 +285,42 @@ JanetAsyncStatus net_machine_accept(JanetListenerState *s, JanetAsyncEvent event
break;
}
case JANET_ASYNC_EVENT_CLOSE:
janet_schedule(s->fiber, janet_wrap_nil());
return JANET_ASYNC_STATUS_DONE;
janet_schedule(fiber, janet_wrap_nil());
janet_async_end(fiber);
return;
case JANET_ASYNC_EVENT_INIT:
case JANET_ASYNC_EVENT_READ: {
#if defined(JANET_LINUX)
JSock connfd = accept4(s->stream->handle, NULL, NULL, SOCK_CLOEXEC);
JSock connfd = accept4(stream->handle, NULL, NULL, SOCK_CLOEXEC);
#else
/* On BSDs, CLOEXEC should be inherited from server socket */
JSock connfd = accept(s->stream->handle, NULL, NULL);
JSock connfd = accept(stream->handle, NULL, NULL);
#endif
if (JSOCKVALID(connfd)) {
janet_net_socknoblock(connfd);
JanetStream *stream = make_stream(connfd, JANET_STREAM_READABLE | JANET_STREAM_WRITABLE);
Janet streamv = janet_wrap_abstract(stream);
if (state->function) {
JanetFiber *fiber = janet_fiber(state->function, 64, 1, &streamv);
fiber->supervisor_channel = s->fiber->supervisor_channel;
janet_schedule(fiber, janet_wrap_nil());
JanetFiber *sub_fiber = janet_fiber(state->function, 64, 1, &streamv);
sub_fiber->supervisor_channel = fiber->supervisor_channel;
janet_schedule(sub_fiber, janet_wrap_nil());
} else {
janet_schedule(s->fiber, streamv);
return JANET_ASYNC_STATUS_DONE;
janet_schedule(fiber, streamv);
janet_async_end(fiber);
return;
}
}
break;
}
}
return JANET_ASYNC_STATUS_NOT_DONE;
}
JANET_NO_RETURN static void janet_sched_accept(JanetStream *stream, JanetFunction *fun) {
NetStateAccept *state = (NetStateAccept *) janet_listen(stream, net_machine_accept, JANET_ASYNC_LISTEN_READ, sizeof(NetStateAccept), NULL);
NetStateAccept *state = janet_malloc(sizeof(NetStateAccept));
memset(state, 0, sizeof(NetStateAccept));
state->function = fun;
janet_await();
if (fun) janet_stream_level_triggered(stream);
janet_async_start(stream, JANET_ASYNC_LISTEN_READ, net_callback_accept, state);
}
#endif
@ -496,7 +563,7 @@ JANET_CORE_FN(cfun_net_connect,
}
#endif
if (status != 0) {
if (status) {
#ifdef JANET_WINDOWS
if (err != WSAEWOULDBLOCK) {
#else
@ -508,10 +575,7 @@ JANET_CORE_FN(cfun_net_connect,
}
}
/* Handle the connect() result in the event loop*/
janet_ev_connect(stream, MSG_NOSIGNAL);
janet_await();
net_sched_connect(stream);
}
static const char *serverify_socket(JSock sfd) {
@ -682,6 +746,7 @@ static Janet janet_so_getname(const void *sa_any) {
Janet pair[2] = {janet_cstringv(buffer), janet_wrap_integer(ntohs(sai->sin_port))};
return janet_wrap_tuple(janet_tuple_n(pair, 2));
}
#ifndef JANET_NO_IPV6
case AF_INET6: {
const struct sockaddr_in6 *sai6 = sa_any;
if (!inet_ntop(AF_INET6, &(sai6->sin6_addr), buffer, sizeof(buffer))) {
@ -690,6 +755,7 @@ static Janet janet_so_getname(const void *sa_any) {
Janet pair[2] = {janet_cstringv(buffer), janet_wrap_integer(ntohs(sai6->sin6_port))};
return janet_wrap_tuple(janet_tuple_n(pair, 2));
}
#endif
#ifndef JANET_WINDOWS
case AF_UNIX: {
const struct sockaddr_un *sun = sa_any;
@ -756,6 +822,7 @@ JANET_CORE_FN(cfun_stream_accept_loop,
JanetStream *stream = janet_getabstract(argv, 0, &janet_stream_type);
janet_stream_flags(stream, JANET_STREAM_ACCEPTABLE | JANET_STREAM_SOCKET);
JanetFunction *fun = janet_getfunction(argv, 1);
if (fun->def->min_arity < 1) janet_panic("handler function must take at least 1 argument");
janet_sched_accept(stream, fun);
}
@ -792,7 +859,6 @@ JANET_CORE_FN(cfun_stream_read,
if (to != INFINITY) janet_addtimeout(to);
janet_ev_recv(stream, buffer, n, MSG_NOSIGNAL);
}
janet_await();
}
JANET_CORE_FN(cfun_stream_chunk,
@ -807,7 +873,6 @@ JANET_CORE_FN(cfun_stream_chunk,
double to = janet_optnumber(argv, argc, 3, INFINITY);
if (to != INFINITY) janet_addtimeout(to);
janet_ev_recvchunk(stream, buffer, n, MSG_NOSIGNAL);
janet_await();
}
JANET_CORE_FN(cfun_stream_recv_from,
@ -822,7 +887,6 @@ JANET_CORE_FN(cfun_stream_recv_from,
double to = janet_optnumber(argv, argc, 3, INFINITY);
if (to != INFINITY) janet_addtimeout(to);
janet_ev_recvfrom(stream, buffer, n, MSG_NOSIGNAL);
janet_await();
}
JANET_CORE_FN(cfun_stream_write,
@ -842,7 +906,6 @@ JANET_CORE_FN(cfun_stream_write,
if (to != INFINITY) janet_addtimeout(to);
janet_ev_send_string(stream, bytes.bytes, MSG_NOSIGNAL);
}
janet_await();
}
JANET_CORE_FN(cfun_stream_send_to,
@ -863,7 +926,6 @@ JANET_CORE_FN(cfun_stream_send_to,
if (to != INFINITY) janet_addtimeout(to);
janet_ev_sendto_string(stream, bytes.bytes, dest, MSG_NOSIGNAL);
}
janet_await();
}
JANET_CORE_FN(cfun_stream_flush,
@ -897,8 +959,10 @@ static const struct sockopt_type sockopt_type_list[] = {
{ "ip-multicast-ttl", IPPROTO_IP, IP_MULTICAST_TTL, JANET_NUMBER },
{ "ip-add-membership", IPPROTO_IP, IP_ADD_MEMBERSHIP, JANET_POINTER },
{ "ip-drop-membership", IPPROTO_IP, IP_DROP_MEMBERSHIP, JANET_POINTER },
#ifndef JANET_NO_IPV6
{ "ipv6-join-group", IPPROTO_IPV6, IPV6_JOIN_GROUP, JANET_POINTER },
{ "ipv6-leave-group", IPPROTO_IPV6, IPV6_LEAVE_GROUP, JANET_POINTER },
#endif
{ NULL, 0, 0, JANET_POINTER }
};
@ -935,7 +999,9 @@ JANET_CORE_FN(cfun_net_setsockopt,
union {
int v_int;
struct ip_mreq v_mreq;
#ifndef JANET_NO_IPV6
struct ipv6_mreq v_mreq6;
#endif
} val;
void *optval = (void *)&val;
@ -953,12 +1019,14 @@ JANET_CORE_FN(cfun_net_setsockopt,
val.v_mreq.imr_interface.s_addr = htonl(INADDR_ANY);
inet_pton(AF_INET, addr, &val.v_mreq.imr_multiaddr.s_addr);
optlen = sizeof(val.v_mreq);
#ifndef JANET_NO_IPV6
} else if (st->optname == IPV6_JOIN_GROUP || st->optname == IPV6_LEAVE_GROUP) {
const char *addr = janet_getcstring(argv, 2);
memset(&val.v_mreq6, 0, sizeof val.v_mreq6);
val.v_mreq6.ipv6mr_interface = 0;
inet_pton(AF_INET6, addr, &val.v_mreq6.ipv6mr_multiaddr);
optlen = sizeof(val.v_mreq6);
#endif
} else {
janet_panicf("invalid socket option type");
}

View File

@ -229,10 +229,11 @@ JANET_CORE_FN(os_compiler,
#undef janet_stringify
JANET_CORE_FN(os_exit,
"(os/exit &opt x)",
"(os/exit &opt x force)",
"Exit from janet with an exit code equal to x. If x is not an integer, "
"the exit with status equal the hash of x.") {
janet_arity(argc, 0, 1);
"the exit with status equal the hash of x. If `force` is truthy will exit immediately and "
"skip cleanup code.") {
janet_arity(argc, 0, 2);
int status;
if (argc == 0) {
status = EXIT_SUCCESS;
@ -242,7 +243,11 @@ JANET_CORE_FN(os_exit,
status = EXIT_FAILURE;
}
janet_deinit();
exit(status);
if (argc >= 2 && janet_truthy(argv[1])) {
_exit(status);
} else {
exit(status);
}
return janet_wrap_nil();
}
@ -500,8 +505,11 @@ static int proc_get_status(JanetProc *proc) {
status = WEXITSTATUS(status);
} else if (WIFSTOPPED(status)) {
status = WSTOPSIG(status) + 128;
} else {
} else if (WIFSIGNALED(status)) {
status = WTERMSIG(status) + 128;
} else {
/* Could possibly return -1 but for now, just panic */
janet_panicf("Undefined status code for process termination, %d.", status);
}
return status;
}
@ -517,7 +525,6 @@ static JanetEVGenericMessage janet_proc_wait_subr(JanetEVGenericMessage args) {
/* Callback that is called in main thread when subroutine completes. */
static void janet_proc_wait_cb(JanetEVGenericMessage args) {
janet_ev_dec_refcount();
JanetProc *proc = (JanetProc *) args.argp;
if (NULL != proc) {
int status = args.tag;
@ -530,7 +537,9 @@ static void janet_proc_wait_cb(JanetEVGenericMessage args) {
JanetString s = janet_formatc("command failed with non-zero exit code %d", status);
janet_cancel(args.fiber, janet_wrap_string(s));
} else {
janet_schedule(args.fiber, janet_wrap_integer(status));
if (janet_fiber_can_resume(args.fiber)) {
janet_schedule(args.fiber, janet_wrap_integer(status));
}
}
}
}
@ -612,7 +621,11 @@ os_proc_wait_impl(JanetProc *proc) {
JANET_CORE_FN(os_proc_wait,
"(os/proc-wait proc)",
"Block until the subprocess completes. Returns the subprocess return code.") {
"Suspend the current fiber until the subprocess completes. Returns the subprocess return code. "
"os/proc-wait cannot be called twice on the same process. If `ev/with-deadline` cancels `os/proc-wait` "
"with an error or os/proc-wait is cancelled with any error caused by anything else, os/proc-wait still "
"finishes in the background. Only after os/proc-wait finishes, a process is cleaned up by the operating "
"system. Thus, a process becomes a zombie process if os/proc-wait is not called.") {
janet_fixarity(argc, 1);
JanetProc *proc = janet_getabstract(argv, 0, &ProcAT);
#ifdef JANET_EV
@ -641,7 +654,7 @@ static const struct keyword_signal signal_keywords[] = {
#ifdef SIGTERM
{"term", SIGTERM},
#endif
#ifdef SIGARLM
#ifdef SIGALRM
{"alrm", SIGALRM},
#endif
#ifdef SIGHUP
@ -706,15 +719,28 @@ static const struct keyword_signal signal_keywords[] = {
#endif
{NULL, 0},
};
static int get_signal_kw(const Janet *argv, int32_t n) {
JanetKeyword signal_kw = janet_getkeyword(argv, n);
const struct keyword_signal *ptr = signal_keywords;
while (ptr->keyword) {
if (!janet_cstrcmp(signal_kw, ptr->keyword)) {
return ptr->signal;
}
ptr++;
}
janet_panicf("undefined signal %v", argv[n]);
}
#endif
JANET_CORE_FN(os_proc_kill,
"(os/proc-kill proc &opt wait signal)",
"Kill a subprocess by sending SIGKILL to it on posix systems, or by closing the process "
"handle on windows. If `wait` is truthy, will wait for the process to finish and "
"returns the exit code. Otherwise, returns `proc`. If signal is specified send it instead."
"Signal keywords are named after their C counterparts but in lowercase with the leading "
"`SIG` stripped. Signals are ignored on windows.") {
"handle on windows. If os/proc-wait already finished for proc, os/proc-kill raises an error. After "
"sending signal to proc, if `wait` is truthy, will wait for the process to finish and return the exit "
"code by calling os/proc-wait. Otherwise, returns `proc`. If signal is specified, send it instead. "
"Signal keywords are named after their C counterparts but in lowercase with the leading `SIG` stripped. "
"Signals are ignored on windows.") {
janet_arity(argc, 1, 3);
JanetProc *proc = janet_getabstract(argv, 0, &ProcAT);
if (proc->flags & JANET_PROC_WAITED) {
@ -731,18 +757,7 @@ JANET_CORE_FN(os_proc_kill,
#else
int signal = -1;
if (argc == 3) {
JanetKeyword signal_kw = janet_getkeyword(argv, 2);
const struct keyword_signal *ptr = signal_keywords;
while (ptr->keyword) {
if (!janet_cstrcmp(signal_kw, ptr->keyword)) {
signal = ptr->signal;
break;
}
ptr++;
}
if (signal == -1) {
janet_panic("undefined signal");
}
signal = get_signal_kw(argv, 2);
}
int status = kill(proc->pid, signal == -1 ? SIGKILL : signal);
if (status) {
@ -764,8 +779,9 @@ JANET_CORE_FN(os_proc_kill,
JANET_CORE_FN(os_proc_close,
"(os/proc-close proc)",
"Wait on a process if it has not been waited on, and close pipes created by `os/spawn` "
"if they have not been closed. Returns nil.") {
"Close pipes created by `os/spawn` if they have not been closed. Then, if os/proc-wait was not already "
"called on proc, os/proc-wait is called on it, and it returns the exit code returned by os/proc-wait. "
"Otherwise, returns nil.") {
janet_fixarity(argc, 1);
JanetProc *proc = janet_getabstract(argv, 0, &ProcAT);
#ifdef JANET_EV
@ -803,6 +819,106 @@ static void close_handle(JanetHandle handle) {
#endif
}
#ifdef JANET_EV
#ifndef JANET_WINDOWS
static void janet_signal_callback(JanetEVGenericMessage msg) {
int sig = msg.tag;
if (msg.argi) janet_interpreter_interrupt_handled(NULL);
Janet handlerv = janet_table_get(&janet_vm.signal_handlers, janet_wrap_integer(sig));
if (!janet_checktype(handlerv, JANET_FUNCTION)) {
/* Let another thread/process try to handle this */
sigset_t set;
sigemptyset(&set);
sigaddset(&set, sig);
#ifdef JANET_THREADS
pthread_sigmask(SIG_BLOCK, &set, NULL);
#else
sigprocmask(SIG_BLOCK, &set, NULL);
#endif
raise(sig);
return;
}
JanetFunction *handler = janet_unwrap_function(handlerv);
JanetFiber *fiber = janet_fiber(handler, 64, 0, NULL);
janet_schedule_soon(fiber, janet_wrap_nil(), JANET_SIGNAL_OK);
}
static void janet_signal_trampoline_no_interrupt(int sig) {
/* Do not interact with global janet state here except for janet_ev_post_event, unsafe! */
JanetEVGenericMessage msg;
memset(&msg, 0, sizeof(msg));
msg.tag = sig;
janet_ev_post_event(&janet_vm, janet_signal_callback, msg);
}
static void janet_signal_trampoline(int sig) {
/* Do not interact with global janet state here except for janet_ev_post_event, unsafe! */
JanetEVGenericMessage msg;
memset(&msg, 0, sizeof(msg));
msg.tag = sig;
msg.argi = 1;
janet_interpreter_interrupt(NULL);
janet_ev_post_event(&janet_vm, janet_signal_callback, msg);
}
#endif
JANET_CORE_FN(os_sigaction,
"(os/sigaction which &opt handler interrupt-interpreter)",
"Add a signal handler for a given action. Use nil for the `handler` argument to remove a signal handler. "
"All signal handlers are the same as supported by `os/proc-kill`.") {
janet_sandbox_assert(JANET_SANDBOX_SIGNAL);
janet_arity(argc, 1, 3);
#ifdef JANET_WINDOWS
(void) argv;
janet_panic("unsupported on this platform");
#else
/* TODO - per thread signal masks */
int rc;
int sig = get_signal_kw(argv, 0);
JanetFunction *handler = janet_optfunction(argv, argc, 1, NULL);
int can_interrupt = janet_optboolean(argv, argc, 2, 0);
Janet oldhandler = janet_table_get(&janet_vm.signal_handlers, janet_wrap_integer(sig));
if (!janet_checktype(oldhandler, JANET_NIL)) {
janet_gcunroot(oldhandler);
}
if (NULL != handler) {
Janet handlerv = janet_wrap_function(handler);
janet_gcroot(handlerv);
janet_table_put(&janet_vm.signal_handlers, janet_wrap_integer(sig), handlerv);
} else {
janet_table_put(&janet_vm.signal_handlers, janet_wrap_integer(sig), janet_wrap_nil());
}
struct sigaction action;
sigset_t mask;
sigaddset(&mask, sig);
memset(&action, 0, sizeof(action));
action.sa_flags |= SA_RESTART;
if (can_interrupt) {
#ifdef JANET_NO_INTERPRETER_INTERRUPT
janet_panic("interpreter interrupt not enabled");
#else
action.sa_handler = janet_signal_trampoline;
#endif
} else {
action.sa_handler = janet_signal_trampoline_no_interrupt;
}
action.sa_mask = mask;
RETRY_EINTR(rc, sigaction(sig, &action, NULL));
sigset_t set;
sigemptyset(&set);
sigaddset(&set, sig);
#ifdef JANET_THREADS
pthread_sigmask(SIG_UNBLOCK, &set, NULL);
#else
sigprocmask(SIG_UNBLOCK, &set, NULL);
#endif
return janet_wrap_nil();
#endif
}
#endif
/* Create piped file for os/execute and os/spawn. Need to be careful that we mark
the error flag if we can't create pipe and don't leak handles. *handle will be cleaned
up by the calling function. If everything goes well, *handle is owned by the calling function,
@ -982,11 +1098,18 @@ static JanetFile *get_stdio_for_handle(JanetHandle handle, void *orig, int iswri
}
#endif
static Janet os_execute_impl(int32_t argc, Janet *argv, int is_spawn) {
typedef enum {
JANET_EXECUTE_EXECUTE,
JANET_EXECUTE_SPAWN,
JANET_EXECUTE_EXEC
} JanetExecuteMode;
static Janet os_execute_impl(int32_t argc, Janet *argv, JanetExecuteMode mode) {
janet_sandbox_assert(JANET_SANDBOX_SUBPROCESS);
janet_arity(argc, 1, 3);
/* Get flags */
int is_spawn = mode == JANET_EXECUTE_SPAWN;
uint64_t flags = 0;
if (argc > 1) {
flags = janet_getflags(argv, 1, "epxd");
@ -1010,7 +1133,7 @@ static Janet os_execute_impl(int32_t argc, Janet *argv, int is_spawn) {
int pipe_owner_flags = (is_spawn && (flags & 0x8)) ? JANET_PROC_ALLOW_ZOMBIE : 0;
/* Get optional redirections */
if (argc > 2) {
if (argc > 2 && (mode != JANET_EXECUTE_EXEC)) {
JanetDictView tab = janet_getdictionary(argv, 2);
Janet maybe_stdin = janet_dictionary_get(tab.kvs, tab.cap, janet_ckeywordv("in"));
Janet maybe_stdout = janet_dictionary_get(tab.kvs, tab.cap, janet_ckeywordv("out"));
@ -1131,12 +1254,32 @@ static Janet os_execute_impl(int32_t argc, Janet *argv, int is_spawn) {
* of posix_spawn would modify the argv array passed in. */
char *const *cargv = (char *const *)child_argv;
/* Use posix_spawn to spawn new process */
if (use_environ) {
janet_lock_environ();
}
/* exec mode */
if (mode == JANET_EXECUTE_EXEC) {
#ifdef JANET_WINDOWS
janet_panic("not supported on windows");
#else
int status;
if (!use_environ) {
environ = envp;
}
do {
if (janet_flag_at(flags, 1)) {
status = execvp(cargv[0], cargv);
} else {
status = execv(cargv[0], cargv);
}
} while (status == -1 && errno == EINTR);
janet_panicf("%p: %s", cargv[0], strerror(errno ? errno : ENOENT));
#endif
}
/* Use posix_spawn to spawn new process */
/* Posix spawn setup */
posix_spawn_file_actions_t actions;
posix_spawn_file_actions_init(&actions);
@ -1145,14 +1288,16 @@ static Janet os_execute_impl(int32_t argc, Janet *argv, int is_spawn) {
posix_spawn_file_actions_addclose(&actions, pipe_in);
} else if (new_in != JANET_HANDLE_NONE && new_in != 0) {
posix_spawn_file_actions_adddup2(&actions, new_in, 0);
posix_spawn_file_actions_addclose(&actions, new_in);
if (new_in != new_out && new_in != new_err)
posix_spawn_file_actions_addclose(&actions, new_in);
}
if (pipe_out != JANET_HANDLE_NONE) {
posix_spawn_file_actions_adddup2(&actions, pipe_out, 1);
posix_spawn_file_actions_addclose(&actions, pipe_out);
} else if (new_out != JANET_HANDLE_NONE && new_out != 1) {
posix_spawn_file_actions_adddup2(&actions, new_out, 1);
posix_spawn_file_actions_addclose(&actions, new_out);
if (new_out != new_err)
posix_spawn_file_actions_addclose(&actions, new_out);
}
if (pipe_err != JANET_HANDLE_NONE) {
posix_spawn_file_actions_adddup2(&actions, pipe_err, 2);
@ -1241,22 +1386,63 @@ JANET_CORE_FN(os_execute,
"* :d - Don't try and terminate the process on garbage collection (allow spawning zombies).\n"
"`env` is a table or struct mapping environment variables to values. It can also "
"contain the keys :in, :out, and :err, which allow redirecting stdio in the subprocess. "
"These arguments should be core/file values. "
"Returns the exit status of the program.") {
return os_execute_impl(argc, argv, 0);
":in, :out, and :err should be core/file values or core/stream values. core/file values and core/stream "
"values passed to :in, :out, and :err should be closed manually because os/execute doesn't close them. "
"Returns the exit code of the program.") {
return os_execute_impl(argc, argv, JANET_EXECUTE_EXECUTE);
}
JANET_CORE_FN(os_spawn,
"(os/spawn args &opt flags env)",
"Execute a program on the system and return a handle to the process. Otherwise, takes the "
"same arguments as `os/execute`. Does not wait for the process. "
"For each of the :in, :out, and :err keys to the `env` argument, one "
"can also pass in the keyword `:pipe` "
"to get streams for standard IO of the subprocess that can be read from and written to. "
"The returned value `proc` has the fields :in, :out, :err, :return-code, and "
"the additional field :pid on unix-like platforms. Use `(os/proc-wait proc)` to rejoin the "
"subprocess or `(os/proc-kill proc)`.") {
return os_execute_impl(argc, argv, 1);
"same arguments as `os/execute`. Does not wait for the process. For each of the :in, :out, and :err keys "
"of the `env` argument, one can also pass in the keyword `:pipe` to get streams for standard IO of the "
"subprocess that can be read from and written to. The returned value `proc` has the fields :in, :out, "
":err, and the additional field :pid on unix-like platforms. `(os/proc-wait proc)` must be called to "
"rejoin the subprocess. After `(os/proc-wait proc)` finishes, proc gains a new field, :return-code. "
"If :x flag is passed to os/spawn, non-zero exit code will cause os/proc-wait to raise an error. "
"If pipe streams created with :pipe keyword are not closed in time, janet can run out of file "
"descriptors. They can be closed individually, or `os/proc-close` can close all pipe streams on proc. "
"If pipe streams aren't read before `os/proc-wait` finishes, then pipe buffers become full, and the "
"process cannot finish because the process cannot print more on pipe buffers which are already full. "
"If the process cannot finish, os/proc-wait cannot finish, either.") {
return os_execute_impl(argc, argv, JANET_EXECUTE_SPAWN);
}
JANET_CORE_FN(os_posix_exec,
"(os/posix-exec args &opt flags env)",
"Use the execvpe or execve system calls to replace the current process with an interface similar to os/execute. "
"Hoever, instead of creating a subprocess, the current process is replaced. Is not supported on windows, and "
"does not allow redirection of stdio.") {
return os_execute_impl(argc, argv, JANET_EXECUTE_EXEC);
}
JANET_CORE_FN(os_posix_fork,
"(os/posix-fork)",
"Make a `fork` system call and create a new process. Return nil if in the new process, otherwise a core/process object (as returned by os/spawn). "
"Not supported on all systems (POSIX only).") {
janet_sandbox_assert(JANET_SANDBOX_SUBPROCESS);
janet_fixarity(argc, 0);
(void) argv;
#ifdef JANET_WINDOWS
janet_panic("not supported");
#else
pid_t result;
do {
result = fork();
} while (result == -1 && errno == EINTR);
if (result == -1) {
janet_panic(strerror(errno));
}
if (result) {
JanetProc *proc = janet_abstract(&ProcAT, sizeof(JanetProc));
memset(proc, 0, sizeof(JanetProc));
proc->pid = result;
proc->flags = JANET_PROC_ALLOW_ZOMBIE;
return janet_wrap_abstract(proc);
}
return janet_wrap_nil();
#endif
}
#ifdef JANET_EV
@ -1332,8 +1518,8 @@ JANET_CORE_FN(os_getenv,
janet_sandbox_assert(JANET_SANDBOX_ENV);
janet_arity(argc, 1, 2);
const char *cstr = janet_getcstring(argv, 0);
const char *res = getenv(cstr);
janet_lock_environ();
const char *res = getenv(cstr);
Janet ret = res
? janet_cstringv(res)
: argc == 2
@ -1378,34 +1564,51 @@ JANET_CORE_FN(os_time,
}
JANET_CORE_FN(os_clock,
"(os/clock &opt source)",
"Return the number of whole + fractional seconds of the requested clock source.\n\n"
"(os/clock &opt source format)",
"Return the current time of the requested clock source.\n\n"
"The `source` argument selects the clock source to use, when not specified the default "
"is `:realtime`:\n"
"- :realtime: Return the real (i.e., wall-clock) time. This clock is affected by discontinuous "
" jumps in the system time\n"
"- :monotonic: Return the number of whole + fractional seconds since some fixed point in "
" time. The clock is guaranteed to be non-decreasing in real time.\n"
"- :cputime: Return the CPU time consumed by this process (i.e. all threads in the process)\n") {
"- :cputime: Return the CPU time consumed by this process (i.e. all threads in the process)\n"
"The `format` argument selects the type of output, when not specified the default is `:double`:\n"
"- :double: Return the number of seconds + fractional seconds as a double\n"
"- :int: Return the number of seconds as an integer\n"
"- :tuple: Return a 2 integer tuple [seconds, nanoseconds]\n") {
enum JanetTimeSource source;
janet_sandbox_assert(JANET_SANDBOX_HRTIME);
janet_arity(argc, 0, 1);
enum JanetTimeSource source = JANET_TIME_REALTIME;
if (argc == 1) {
JanetKeyword sourcestr = janet_getkeyword(argv, 0);
if (janet_cstrcmp(sourcestr, "realtime") == 0) {
source = JANET_TIME_REALTIME;
} else if (janet_cstrcmp(sourcestr, "monotonic") == 0) {
source = JANET_TIME_MONOTONIC;
} else if (janet_cstrcmp(sourcestr, "cputime") == 0) {
source = JANET_TIME_CPUTIME;
} else {
janet_panicf("expected :realtime, :monotonic, or :cputime, got %v", argv[0]);
}
janet_arity(argc, 0, 2);
JanetKeyword sourcestr = janet_optkeyword(argv, argc, 0, (const uint8_t *) "realtime");
if (janet_cstrcmp(sourcestr, "realtime") == 0) {
source = JANET_TIME_REALTIME;
} else if (janet_cstrcmp(sourcestr, "monotonic") == 0) {
source = JANET_TIME_MONOTONIC;
} else if (janet_cstrcmp(sourcestr, "cputime") == 0) {
source = JANET_TIME_CPUTIME;
} else {
janet_panicf("expected :realtime, :monotonic, or :cputime, got %v", argv[0]);
}
struct timespec tv;
if (janet_gettime(&tv, source)) janet_panic("could not get time");
double dtime = tv.tv_sec + (tv.tv_nsec / 1E9);
return janet_wrap_number(dtime);
JanetKeyword formatstr = janet_optkeyword(argv, argc, 1, (const uint8_t *) "double");
if (janet_cstrcmp(formatstr, "double") == 0) {
double dtime = (double)(tv.tv_sec + (tv.tv_nsec / 1E9));
return janet_wrap_number(dtime);
} else if (janet_cstrcmp(formatstr, "int") == 0) {
return janet_wrap_number((double)(tv.tv_sec));
} else if (janet_cstrcmp(formatstr, "tuple") == 0) {
Janet tup[2] = {janet_wrap_number((double)tv.tv_sec),
janet_wrap_number((double)tv.tv_nsec)
};
return janet_wrap_tuple(janet_tuple_n(tup, 2));
} else {
janet_panicf("expected :double, :int, or :tuple, got %v", argv[1]);
}
}
JANET_CORE_FN(os_sleep,
@ -2521,6 +2724,8 @@ void janet_lib_os(JanetTable *env) {
JANET_CORE_REG("os/execute", os_execute),
JANET_CORE_REG("os/spawn", os_spawn),
JANET_CORE_REG("os/shell", os_shell),
JANET_CORE_REG("os/posix-fork", os_posix_fork),
JANET_CORE_REG("os/posix-exec", os_posix_exec),
/* no need to sandbox process management if you can't create processes
* (allows for limited functionality if use exposes C-functions to create specific processes) */
JANET_CORE_REG("os/proc-wait", os_proc_wait),
@ -2534,6 +2739,7 @@ void janet_lib_os(JanetTable *env) {
#ifdef JANET_EV
JANET_CORE_REG("os/open", os_open), /* fs read and write */
JANET_CORE_REG("os/pipe", os_pipe),
JANET_CORE_REG("os/sigaction", os_sigaction),
#endif
#endif
JANET_REG_END

View File

@ -259,6 +259,14 @@ static int checkescape(uint8_t c) {
return '\f';
case 'v':
return '\v';
case 'a':
return '\a';
case 'b':
return '\b';
case '\'':
return '\'';
case '?':
return '?';
case 'e':
return 27;
case '"':

View File

@ -39,6 +39,10 @@
typedef struct {
const uint8_t *text_start;
const uint8_t *text_end;
/* text_end can be restricted by some rules, but
outer_text_end will always contain the real end of
input, which we need to generate a line mapping */
const uint8_t *outer_text_end;
const uint32_t *bytecode;
const Janet *constants;
JanetArray *captures;
@ -114,12 +118,12 @@ static LineCol get_linecol_from_position(PegState *s, int32_t position) {
/* Generate if not made yet */
if (s->linemaplen < 0) {
int32_t newline_count = 0;
for (const uint8_t *c = s->text_start; c < s->text_end; c++) {
for (const uint8_t *c = s->text_start; c < s->outer_text_end; c++) {
if (*c == '\n') newline_count++;
}
int32_t *mem = janet_smalloc(sizeof(int32_t) * newline_count);
size_t index = 0;
for (const uint8_t *c = s->text_start; c < s->text_end; c++) {
for (const uint8_t *c = s->text_start; c < s->outer_text_end; c++) {
if (*c == '\n') mem[index++] = (int32_t)(c - s->text_start);
}
s->linemaplen = newline_count;
@ -179,7 +183,7 @@ static const uint8_t *peg_rule(
const uint32_t *rule,
const uint8_t *text) {
tail:
switch (*rule & 0x1F) {
switch (*rule) {
default:
janet_panic("unexpected opcode");
return NULL;
@ -482,6 +486,68 @@ tail:
return result;
}
case RULE_SUB: {
const uint8_t *text_start = text;
const uint32_t *rule_window = s->bytecode + rule[1];
const uint32_t *rule_subpattern = s->bytecode + rule[2];
down1(s);
const uint8_t *window_end = peg_rule(s, rule_window, text);
up1(s);
if (!window_end) {
return NULL;
}
const uint8_t *saved_end = s->text_end;
s->text_end = window_end;
down1(s);
const uint8_t *next_text = peg_rule(s, rule_subpattern, text_start);
up1(s);
s->text_end = saved_end;
if (!next_text) {
return NULL;
}
return window_end;
}
case RULE_SPLIT: {
const uint8_t *saved_end = s->text_end;
const uint32_t *rule_separator = s->bytecode + rule[1];
const uint32_t *rule_subpattern = s->bytecode + rule[2];
const uint8_t *separator_end = NULL;
do {
const uint8_t *text_start = text;
CapState cs = cap_save(s);
down1(s);
while (text <= s->text_end) {
separator_end = peg_rule(s, rule_separator, text);
cap_load(s, cs);
if (separator_end) {
break;
}
text++;
}
up1(s);
if (separator_end) {
s->text_end = text;
text = separator_end;
}
down1(s);
const uint8_t *subpattern_end = peg_rule(s, rule_subpattern, text_start);
up1(s);
s->text_end = saved_end;
if (!subpattern_end) {
return NULL;
}
} while (separator_end);
return s->text_end;
}
case RULE_REPLACE:
case RULE_MATCHTIME: {
uint32_t tag = rule[3];
@ -1107,6 +1173,22 @@ static void spec_matchtime(Builder *b, int32_t argc, const Janet *argv) {
emit_3(r, RULE_MATCHTIME, subrule, cindex, tag);
}
static void spec_sub(Builder *b, int32_t argc, const Janet *argv) {
peg_fixarity(b, argc, 2);
Reserve r = reserve(b, 3);
uint32_t subrule1 = peg_compile1(b, argv[0]);
uint32_t subrule2 = peg_compile1(b, argv[1]);
emit_2(r, RULE_SUB, subrule1, subrule2);
}
static void spec_split(Builder *b, int32_t argc, const Janet *argv) {
peg_fixarity(b, argc, 2);
Reserve r = reserve(b, 3);
uint32_t subrule1 = peg_compile1(b, argv[0]);
uint32_t subrule2 = peg_compile1(b, argv[1]);
emit_2(r, RULE_SPLIT, subrule1, subrule2);
}
#ifdef JANET_INT_TYPES
#define JANET_MAX_READINT_WIDTH 8
#else
@ -1190,6 +1272,8 @@ static const SpecialPair peg_specials[] = {
{"sequence", spec_sequence},
{"set", spec_set},
{"some", spec_some},
{"split", spec_split},
{"sub", spec_sub},
{"thru", spec_thru},
{"to", spec_to},
{"uint", spec_uint_le},
@ -1431,7 +1515,7 @@ static void *peg_unmarshal(JanetMarshalContext *ctx) {
uint32_t instr = bytecode[i];
uint32_t *rule = bytecode + i;
op_flags[i] |= 0x02;
switch (instr & 0x1F) {
switch (instr) {
case RULE_LITERAL:
i += 2 + ((rule[1] + 3) >> 2);
break;
@ -1524,6 +1608,15 @@ static void *peg_unmarshal(JanetMarshalContext *ctx) {
op_flags[rule[1]] |= 0x01;
i += 4;
break;
case RULE_SUB:
case RULE_SPLIT:
/* [rule, rule] */
if (rule[1] >= blen) goto bad;
if (rule[2] >= blen) goto bad;
op_flags[rule[1]] |= 0x01;
op_flags[rule[2]] |= 0x01;
i += 3;
break;
case RULE_ERROR:
case RULE_DROP:
case RULE_NOT:
@ -1652,7 +1745,7 @@ typedef struct {
static PegCall peg_cfun_init(int32_t argc, Janet *argv, int get_replace) {
PegCall ret;
int32_t min = get_replace ? 3 : 2;
janet_arity(argc, get_replace, -1);
janet_arity(argc, min, -1);
if (janet_checktype(argv[0], JANET_ABSTRACT) &&
janet_abstract_type(janet_unwrap_abstract(argv[0])) == &janet_peg_type) {
ret.peg = janet_unwrap_abstract(argv[0]);
@ -1677,6 +1770,7 @@ static PegCall peg_cfun_init(int32_t argc, Janet *argv, int get_replace) {
ret.s.mode = PEG_MODE_NORMAL;
ret.s.text_start = ret.bytes.bytes;
ret.s.text_end = ret.bytes.bytes + ret.bytes.len;
ret.s.outer_text_end = ret.s.text_end;
ret.s.depth = JANET_RECURSION_GUARD;
ret.s.captures = janet_array(0);
ret.s.tagged_captures = janet_array(0);
@ -1771,7 +1865,7 @@ JANET_CORE_FN(cfun_peg_replace_all,
}
JANET_CORE_FN(cfun_peg_replace,
"(peg/replace peg repl text &opt start & args)",
"(peg/replace peg subst text &opt start & args)",
"Replace first match of `peg` in `text` with `subst`, returning a new buffer. "
"The peg does not need to make captures to do replacement. "
"If `subst` is a function, it will be called with the "

View File

@ -31,6 +31,7 @@
#include <string.h>
#include <ctype.h>
#include <inttypes.h>
#include <float.h>
/* Implements a pretty printer for Janet. The pretty printer
* is simple and not that flexible, but fast. */
@ -38,11 +39,15 @@
/* Temporary buffer size */
#define BUFSIZE 64
/* Preprocessor hacks */
#define STR_HELPER(x) #x
#define STR(x) STR_HELPER(x)
static void number_to_string_b(JanetBuffer *buffer, double x) {
janet_buffer_ensure(buffer, buffer->count + BUFSIZE, 2);
const char *fmt = (x == floor(x) &&
x <= JANET_INTMAX_DOUBLE &&
x >= JANET_INTMIN_DOUBLE) ? "%.0f" : "%g";
x >= JANET_INTMIN_DOUBLE) ? "%.0f" : ("%." STR(DBL_DIG) "g");
int count;
if (x == 0.0) {
/* Prevent printing of '-0' */
@ -152,6 +157,12 @@ static void janet_escape_string_impl(JanetBuffer *buffer, const uint8_t *str, in
case '\v':
janet_buffer_push_bytes(buffer, (const uint8_t *)"\\v", 2);
break;
case '\a':
janet_buffer_push_bytes(buffer, (const uint8_t *)"\\a", 2);
break;
case '\b':
janet_buffer_push_bytes(buffer, (const uint8_t *)"\\b", 2);
break;
case 27:
janet_buffer_push_bytes(buffer, (const uint8_t *)"\\e", 2);
break;
@ -244,6 +255,10 @@ void janet_to_string_b(JanetBuffer *buffer, Janet x) {
case JANET_FUNCTION: {
JanetFunction *fun = janet_unwrap_function(x);
JanetFuncDef *def = fun->def;
if (def == NULL) {
janet_buffer_push_cstring(buffer, "<incomplete function>");
break;
}
if (def->name) {
const uint8_t *n = def->name;
janet_buffer_push_cstring(buffer, "<function ");
@ -762,6 +777,8 @@ struct FmtMapping {
/* Janet uses fixed width integer types for most things, so map
* format specifiers to these fixed sizes */
static const struct FmtMapping format_mappings[] = {
{'D', PRId64},
{'I', PRIi64},
{'d', PRId64},
{'i', PRIi64},
{'o', PRIo64},
@ -813,7 +830,7 @@ static const char *scanformat(
if (loc != NULL && *loc != '\0') {
const char *mapping = get_fmt_mapping(*p2++);
size_t len = strlen(mapping);
strcpy(form, mapping);
memcpy(form, mapping, len);
form += len;
} else {
*(form++) = *(p2++);
@ -840,13 +857,19 @@ void janet_formatbv(JanetBuffer *b, const char *format, va_list args) {
c = scanformat(c, form, width, precision);
switch (*c++) {
case 'c': {
int n = va_arg(args, long);
int n = va_arg(args, int);
nb = snprintf(item, MAX_ITEM, form, n);
break;
}
case 'd':
case 'i': {
int64_t n = va_arg(args, int);
int64_t n = (int64_t) va_arg(args, int32_t);
nb = snprintf(item, MAX_ITEM, form, n);
break;
}
case 'D':
case 'I': {
int64_t n = va_arg(args, int64_t);
nb = snprintf(item, MAX_ITEM, form, n);
break;
}
@ -854,7 +877,7 @@ void janet_formatbv(JanetBuffer *b, const char *format, va_list args) {
case 'X':
case 'o':
case 'u': {
uint64_t n = va_arg(args, unsigned int);
uint64_t n = va_arg(args, uint64_t);
nb = snprintf(item, MAX_ITEM, form, n);
break;
}
@ -898,7 +921,7 @@ void janet_formatbv(JanetBuffer *b, const char *format, va_list args) {
janet_buffer_push_cstring(b, typestr(va_arg(args, Janet)));
break;
case 'T': {
int types = va_arg(args, long);
int types = va_arg(args, int);
pushtypes(b, types);
break;
}
@ -1007,6 +1030,8 @@ void janet_buffer_format(
janet_getinteger(argv, arg));
break;
}
case 'D':
case 'I':
case 'd':
case 'i': {
int64_t n = janet_getinteger64(argv, arg);

View File

@ -32,6 +32,7 @@ int janet_dobytes(JanetTable *env, const uint8_t *bytes, int32_t len, const char
int errflags = 0, done = 0;
int32_t index = 0;
Janet ret = janet_wrap_nil();
JanetFiber *fiber = NULL;
const uint8_t *where = sourcePath ? janet_cstring(sourcePath) : NULL;
if (where) janet_gcroot(janet_wrap_string(where));
@ -47,7 +48,7 @@ int janet_dobytes(JanetTable *env, const uint8_t *bytes, int32_t len, const char
JanetCompileResult cres = janet_compile(form, env, where);
if (cres.status == JANET_COMPILE_OK) {
JanetFunction *f = janet_thunk(cres.funcdef);
JanetFiber *fiber = janet_fiber(f, 64, 0, NULL);
fiber = janet_fiber(f, 64, 0, NULL);
fiber->env = env;
JanetSignal status = janet_continue(fiber, janet_wrap_nil(), &ret);
if (status != JANET_SIGNAL_OK && status != JANET_SIGNAL_EVENT) {
@ -57,12 +58,20 @@ int janet_dobytes(JanetTable *env, const uint8_t *bytes, int32_t len, const char
}
} else {
ret = janet_wrap_string(cres.error);
int32_t line = (int32_t) parser.line;
int32_t col = (int32_t) parser.column;
if ((cres.error_mapping.line > 0) &&
(cres.error_mapping.column > 0)) {
line = cres.error_mapping.line;
col = cres.error_mapping.column;
}
if (cres.macrofiber) {
janet_eprintf("compile error in %s: ", sourcePath);
janet_eprintf("%s:%d:%d: compile error", sourcePath,
line, col);
janet_stacktrace_ext(cres.macrofiber, ret, "");
} else {
janet_eprintf("compile error in %s: %s\n", sourcePath,
(const char *)cres.error);
janet_eprintf("%s:%d:%d: compile error: %s\n", sourcePath,
line, col, (const char *)cres.error);
}
errflags |= 0x02;
done = 1;
@ -104,9 +113,14 @@ int janet_dobytes(JanetTable *env, const uint8_t *bytes, int32_t len, const char
#ifdef JANET_EV
/* Enter the event loop if we are not already in it */
if (janet_vm.stackn == 0) {
janet_gcroot(ret);
if (fiber) {
janet_gcroot(janet_wrap_fiber(fiber));
}
janet_loop();
janet_gcunroot(ret);
if (fiber) {
janet_gcunroot(janet_wrap_fiber(fiber));
ret = fiber->last_value;
}
}
#endif
if (out) *out = ret;

View File

@ -149,7 +149,7 @@ static int destructure(JanetCompiler *c,
JanetTable *attr) {
switch (janet_type(left)) {
default:
janetc_error(c, janet_formatc("unexpected type in destruction, got %v", left));
janetc_error(c, janet_formatc("unexpected type in destructuring, got %v", left));
return 1;
case JANET_SYMBOL:
/* Leaf, assign right to left */
@ -357,7 +357,8 @@ SlotHeadPair *dohead_destructure(JanetCompiler *c, SlotHeadPair *into, JanetFopt
if (has_drop && can_destructure_lhs && rhs_is_indexed) {
/* Code is of the form (def [a b] [1 2]), avoid the allocation of two tuples */
JanetView view_lhs, view_rhs;
JanetView view_lhs = {0};
JanetView view_rhs = {0};
janet_indexed_view(lhs, &view_lhs.items, &view_lhs.len);
janet_indexed_view(rhs, &view_rhs.items, &view_rhs.len);
int found_amp = 0;
@ -529,6 +530,26 @@ static JanetSlot janetc_def(JanetFopts opts, int32_t argn, const Janet *argv) {
return ret;
}
/* Check if a form matches the pattern (= nil _) or (not= nil _) */
static int janetc_check_nil_form(Janet x, Janet *capture, uint32_t fun_tag) {
if (!janet_checktype(x, JANET_TUPLE)) return 0;
JanetTuple tup = janet_unwrap_tuple(x);
if (3 != janet_tuple_length(tup)) return 0;
Janet op1 = tup[0];
if (!janet_checktype(op1, JANET_FUNCTION)) return 0;
JanetFunction *fun = janet_unwrap_function(op1);
uint32_t tag = fun->def->flags & JANET_FUNCDEF_FLAG_TAG;
if (tag != fun_tag) return 0;
if (janet_checktype(tup[1], JANET_NIL)) {
*capture = tup[2];
return 1;
} else if (janet_checktype(tup[2], JANET_NIL)) {
*capture = tup[1];
return 1;
}
return 0;
}
/*
* :condition
* ...
@ -549,6 +570,7 @@ static JanetSlot janetc_if(JanetFopts opts, int32_t argn, const Janet *argv) {
JanetScope condscope, tempscope;
const int tail = opts.flags & JANET_FOPTS_TAIL;
const int drop = opts.flags & JANET_FOPTS_DROP;
uint8_t ifnjmp = JOP_JUMP_IF_NOT;
if (argn < 2 || argn > 3) {
janetc_cerror(c, "expected 2 or 3 arguments to if");
@ -571,12 +593,24 @@ static JanetSlot janetc_if(JanetFopts opts, int32_t argn, const Janet *argv) {
/* Compile condition */
janetc_scope(&condscope, c, 0, "if");
cond = janetc_value(condopts, argv[0]);
Janet condform = argv[0];
if (janetc_check_nil_form(condform, &condform, JANET_FUN_EQ)) {
ifnjmp = JOP_JUMP_IF_NOT_NIL;
} else if (janetc_check_nil_form(condform, &condform, JANET_FUN_NEQ)) {
ifnjmp = JOP_JUMP_IF_NIL;
}
cond = janetc_value(condopts, condform);
/* Check constant condition. */
/* TODO: Use type info for more short circuits */
if (cond.flags & JANET_SLOT_CONSTANT) {
if (!janet_truthy(cond.constant)) {
int swap_condition = 0;
if (ifnjmp == JOP_JUMP_IF_NOT && !janet_truthy(cond.constant)) swap_condition = 1;
if (ifnjmp == JOP_JUMP_IF_NIL && janet_checktype(cond.constant, JANET_NIL)) swap_condition = 1;
if (ifnjmp == JOP_JUMP_IF_NOT_NIL && !janet_checktype(cond.constant, JANET_NIL)) swap_condition = 1;
if (swap_condition) {
/* Swap the true and false bodies */
Janet temp = falsebody;
falsebody = truebody;
@ -594,7 +628,7 @@ static JanetSlot janetc_if(JanetFopts opts, int32_t argn, const Janet *argv) {
}
/* Compile jump to right */
labeljr = janetc_emit_si(c, JOP_JUMP_IF_NOT, cond, 0, 0);
labeljr = janetc_emit_si(c, ifnjmp, cond, 0, 0);
/* Condition left body */
janetc_scope(&tempscope, c, 0, "if-true");
@ -604,7 +638,7 @@ static JanetSlot janetc_if(JanetFopts opts, int32_t argn, const Janet *argv) {
/* Compile jump to done */
labeljd = janet_v_count(c->buffer);
if (!tail) janetc_emit(c, JOP_JUMP);
if (!tail && !(drop && janet_checktype(falsebody, JANET_NIL))) janetc_emit(c, JOP_JUMP);
/* Compile right body */
labelr = janet_v_count(c->buffer);
@ -715,9 +749,8 @@ static JanetSlot janetc_break(JanetFopts opts, int32_t argn, const Janet *argv)
if (!(scope->flags & JANET_SCOPE_WHILE) && argn) {
/* Closure body with return argument */
subopts.flags |= JANET_FOPTS_TAIL;
JanetSlot ret = janetc_value(subopts, argv[0]);
ret.flags |= JANET_SLOT_RETURNED;
return ret;
janetc_value(subopts, argv[0]);
return janetc_cslot(janet_wrap_nil());
} else {
/* while loop IIFE or no argument */
if (argn) {
@ -725,9 +758,7 @@ static JanetSlot janetc_break(JanetFopts opts, int32_t argn, const Janet *argv)
janetc_value(subopts, argv[0]);
}
janetc_emit(c, JOP_RETURN_NIL);
JanetSlot s = janetc_cslot(janet_wrap_nil());
s.flags |= JANET_SLOT_RETURNED;
return s;
return janetc_cslot(janet_wrap_nil());
}
} else {
if (argn) {
@ -740,20 +771,6 @@ static JanetSlot janetc_break(JanetFopts opts, int32_t argn, const Janet *argv)
}
}
/* Check if a form matches the pattern (not= nil _) */
static int janetc_check_notnil_form(Janet x, Janet *capture) {
if (!janet_checktype(x, JANET_TUPLE)) return 0;
JanetTuple tup = janet_unwrap_tuple(x);
if (!janet_checktype(tup[0], JANET_FUNCTION)) return 0;
if (3 != janet_tuple_length(tup)) return 0;
JanetFunction *fun = janet_unwrap_function(tup[0]);
uint32_t tag = fun->def->flags & JANET_FUNCDEF_FLAG_TAG;
if (tag != JANET_FUN_NEQ) return 0;
if (!janet_checktype(tup[1], JANET_NIL)) return 0;
*capture = tup[2];
return 1;
}
/*
* :whiletop
* ...
@ -770,6 +787,7 @@ static JanetSlot janetc_while(JanetFopts opts, int32_t argn, const Janet *argv)
JanetScope tempscope;
int32_t labelwt, labeld, labeljt, labelc, i;
int infinite = 0;
int is_nil_form = 0;
int is_notnil_form = 0;
uint8_t ifjmp = JOP_JUMP_IF;
uint8_t ifnjmp = JOP_JUMP_IF_NOT;
@ -783,11 +801,16 @@ static JanetSlot janetc_while(JanetFopts opts, int32_t argn, const Janet *argv)
janetc_scope(&tempscope, c, JANET_SCOPE_WHILE, "while");
/* Check for `(not= nil _)` in condition, and if so, use the
/* Check for `(= nil _)` or `(not= nil _)` in condition, and if so, use the
* jmpnl or jmpnn instructions. This let's us implement `(each ...)`
* more efficiently. */
Janet condform = argv[0];
if (janetc_check_notnil_form(condform, &condform)) {
if (janetc_check_nil_form(condform, &condform, JANET_FUN_EQ)) {
is_nil_form = 1;
ifjmp = JOP_JUMP_IF_NIL;
ifnjmp = JOP_JUMP_IF_NOT_NIL;
}
if (janetc_check_nil_form(condform, &condform, JANET_FUN_NEQ)) {
is_notnil_form = 1;
ifjmp = JOP_JUMP_IF_NOT_NIL;
ifnjmp = JOP_JUMP_IF_NIL;
@ -799,7 +822,9 @@ static JanetSlot janetc_while(JanetFopts opts, int32_t argn, const Janet *argv)
/* Check for constant condition */
if (cond.flags & JANET_SLOT_CONSTANT) {
/* Loop never executes */
int never_executes = is_notnil_form
int never_executes = is_nil_form
? !janet_checktype(cond.constant, JANET_NIL)
: is_notnil_form
? janet_checktype(cond.constant, JANET_NIL)
: !janet_truthy(cond.constant);
if (never_executes) {

View File

@ -24,6 +24,11 @@
#include "features.h"
#include <janet.h>
#include "state.h"
#include "util.h"
#endif
#ifdef JANET_WINDOWS
#include <windows.h>
#endif
JANET_THREAD_LOCAL JanetVM janet_vm;
@ -57,5 +62,10 @@ void janet_vm_load(JanetVM *from) {
* use NULL to interrupt the current VM when convenient */
void janet_interpreter_interrupt(JanetVM *vm) {
vm = vm ? vm : &janet_vm;
vm->auto_suspend = 1;
janet_atomic_inc(&vm->auto_suspend);
}
void janet_interpreter_interrupt_handled(JanetVM *vm) {
vm = vm ? vm : &janet_vm;
janet_atomic_dec(&vm->auto_suspend);
}

View File

@ -89,7 +89,7 @@ struct JanetVM {
/* If this flag is true, suspend on function calls and backwards jumps.
* When this occurs, this flag will be reset to 0. */
int auto_suspend;
volatile JanetAtomicInt auto_suspend;
/* The current running fiber on the current thread.
* Set and unset by functions in vm.c */
@ -121,10 +121,12 @@ struct JanetVM {
/* Garbage collection */
void *blocks;
void *weak_blocks;
size_t gc_interval;
size_t next_collection;
size_t block_count;
int gc_suspend;
int gc_mark_phase;
/* GC roots */
Janet *roots;
@ -154,12 +156,10 @@ struct JanetVM {
JanetQueue spawn;
JanetTimeout *tq;
JanetRNG ev_rng;
JanetListenerState **listeners;
size_t listener_count;
size_t listener_cap;
size_t extra_listeners;
volatile JanetAtomicInt listener_count; /* used in signal handler, must be volatile */
JanetTable threaded_abstracts; /* All abstract types that can be shared between threads (used in this thread) */
JanetTable active_tasks; /* All possibly live task fibers - used just for tracking */
JanetTable signal_handlers;
#ifdef JANET_WINDOWS
void **iocp;
#elif defined(JANET_EV_EPOLL)
@ -175,6 +175,9 @@ struct JanetVM {
int timer;
int timer_enabled;
#else
JanetStream **streams;
size_t stream_count;
size_t stream_capacity;
pthread_attr_t new_thread_attr;
JanetHandle selfpipe[2];
struct pollfd *fds;

View File

@ -175,8 +175,9 @@ JANET_CORE_FN(cfun_string_slice,
"Returns a substring from a byte sequence. The substring is from "
"index `start` inclusive to index `end`, exclusive. All indexing "
"is from 0. `start` and `end` can also be negative to indicate indexing "
"from the end of the string. Note that index -1 is synonymous with "
"index `(length bytes)` to allow a full negative slice range. ") {
"from the end of the string. Note that if `start` is negative it is "
"exclusive, and if `end` is negative it is inclusive, to allow a full "
"negative slice range.") {
JanetByteView view = janet_getbytes(argv, 0);
JanetRange range = janet_getslice(argc, argv);
return janet_stringv(view.bytes + range.start, range.end - range.start);
@ -548,12 +549,12 @@ JANET_CORE_FN(cfun_string_format,
"- `a`, `A`: floating point number, formatted as a hexadecimal number.\n"
"- `s`: formatted as a string, precision indicates padding and maximum length.\n"
"- `t`: emit the type of the given value.\n"
"- `v`: format with (describe x)"
"- `V`: format with (string x)"
"- `v`: format with (describe x)\n"
"- `V`: format with (string x)\n"
"- `j`: format to jdn (Janet data notation).\n"
"\n"
"The following conversion specifiers are used for \"pretty-printing\", where the upper-case "
"variants generate colored output. These speficiers can take a precision "
"variants generate colored output. These specifiers can take a precision "
"argument to specify the maximum nesting depth to print.\n"
"- `p`, `P`: pretty format, truncating if necessary\n"
"- `m`, `M`: pretty format without truncating.\n"

View File

@ -234,6 +234,7 @@ const uint8_t *janet_symbol_gen(void) {
head->hash = hash;
sym = (uint8_t *)(head->data);
memcpy(sym, janet_vm.gensym_counter, sizeof(janet_vm.gensym_counter));
sym[head->length] = 0;
janet_symcache_put((const uint8_t *)sym, bucket);
return (const uint8_t *)sym;
}

View File

@ -87,11 +87,27 @@ void janet_table_deinit(JanetTable *table) {
}
/* Create a new table */
JanetTable *janet_table(int32_t capacity) {
JanetTable *table = janet_gcalloc(JANET_MEMORY_TABLE, sizeof(JanetTable));
return janet_table_init_impl(table, capacity, 0);
}
JanetTable *janet_table_weakk(int32_t capacity) {
JanetTable *table = janet_gcalloc(JANET_MEMORY_TABLE_WEAKK, sizeof(JanetTable));
return janet_table_init_impl(table, capacity, 0);
}
JanetTable *janet_table_weakv(int32_t capacity) {
JanetTable *table = janet_gcalloc(JANET_MEMORY_TABLE_WEAKV, sizeof(JanetTable));
return janet_table_init_impl(table, capacity, 0);
}
JanetTable *janet_table_weakkv(int32_t capacity) {
JanetTable *table = janet_gcalloc(JANET_MEMORY_TABLE_WEAKKV, sizeof(JanetTable));
return janet_table_init_impl(table, capacity, 0);
}
/* Find the bucket that contains the given key. Will also return
* bucket where key should go if not in the table. */
JanetKV *janet_table_find(JanetTable *t, Janet key) {
@ -111,12 +127,11 @@ static void janet_table_rehash(JanetTable *t, int32_t size) {
JANET_OUT_OF_MEMORY;
}
}
int32_t i, oldcapacity;
oldcapacity = t->capacity;
int32_t oldcapacity = t->capacity;
t->data = newdata;
t->capacity = size;
t->deleted = 0;
for (i = 0; i < oldcapacity; i++) {
for (int32_t i = 0; i < oldcapacity; i++) {
JanetKV *kv = olddata + i;
if (!janet_checktype(kv->key, JANET_NIL)) {
JanetKV *newkv = janet_table_find(t, kv->key);
@ -298,11 +313,46 @@ JANET_CORE_FN(cfun_table_new,
"Creates a new empty table with pre-allocated memory "
"for `capacity` entries. This means that if one knows the number of "
"entries going into a table on creation, extra memory allocation "
"can be avoided. Returns the new table.") {
"can be avoided. "
"Returns the new table.") {
janet_fixarity(argc, 1);
int32_t cap = janet_getnat(argv, 0);
return janet_wrap_table(janet_table(cap));
}
/*
uint32_t flags = janet_getflags(argv, 1, "kv");
if (flags == 0) return janet_wrap_table(janet_table(cap));
if (flags == 1) return janet_wrap_table(janet_table_weakk(cap));
if (flags == 2) return janet_wrap_table(janet_table_weakv(cap));
return janet_wrap_table(janet_table_weakkv(cap));
*/
JANET_CORE_FN(cfun_table_weak,
"(table/weak capacity)",
"Creates a new empty table with weak references to keys and values. Similar to `table/new`. "
"Returns the new table.") {
janet_fixarity(argc, 1);
int32_t cap = janet_getnat(argv, 0);
return janet_wrap_table(janet_table_weakkv(cap));
}
JANET_CORE_FN(cfun_table_weak_keys,
"(table/weak-keys capacity)",
"Creates a new empty table with weak references to keys and normal references to values. Similar to `table/new`. "
"Returns the new table.") {
janet_fixarity(argc, 1);
int32_t cap = janet_getnat(argv, 0);
return janet_wrap_table(janet_table_weakk(cap));
}
JANET_CORE_FN(cfun_table_weak_values,
"(table/weak-values capacity)",
"Creates a new empty table with normal references to keys and weak references to values. Similar to `table/new`. "
"Returns the new table.") {
janet_fixarity(argc, 1);
int32_t cap = janet_getnat(argv, 0);
return janet_wrap_table(janet_table_weakv(cap));
}
JANET_CORE_FN(cfun_table_getproto,
"(table/getproto tab)",
@ -377,6 +427,9 @@ JANET_CORE_FN(cfun_table_proto_flatten,
void janet_lib_table(JanetTable *env) {
JanetRegExt table_cfuns[] = {
JANET_CORE_REG("table/new", cfun_table_new),
JANET_CORE_REG("table/weak", cfun_table_weak),
JANET_CORE_REG("table/weak-keys", cfun_table_weak_keys),
JANET_CORE_REG("table/weak-values", cfun_table_weak_values),
JANET_CORE_REG("table/to-struct", cfun_table_tostruct),
JANET_CORE_REG("table/getproto", cfun_table_getproto),
JANET_CORE_REG("table/setproto", cfun_table_setproto),

View File

@ -69,9 +69,9 @@ JANET_CORE_FN(cfun_tuple_slice,
"inclusive to index `end` exclusive. If `start` or `end` are not provided, "
"they default to 0 and the length of `arrtup`, respectively. "
"`start` and `end` can also be negative to indicate indexing "
"from the end of the input. Note that index -1 is synonymous with "
"index `(length arrtup)` to allow a full negative slice range. "
"Returns the new tuple.") {
"from the end of the input. Note that if `start` is negative it is "
"exclusive, and if `end` is negative it is inclusive, to allow a full "
"negative slice range. Returns the new tuple.") {
JanetView view = janet_getindexed(argv, 0);
JanetRange range = janet_getslice(argc, argv);
return janet_wrap_tuple(janet_tuple_n(view.items + range.start, range.end - range.start));

View File

@ -805,6 +805,13 @@ int janet_checkint(Janet x) {
return janet_checkintrange(dval);
}
int janet_checkuint(Janet x) {
if (!janet_checktype(x, JANET_NUMBER))
return 0;
double dval = janet_unwrap_number(x);
return janet_checkuintrange(dval);
}
int janet_checkint64(Janet x) {
if (!janet_checktype(x, JANET_NUMBER))
return 0;
@ -816,7 +823,7 @@ int janet_checkuint64(Janet x) {
if (!janet_checktype(x, JANET_NUMBER))
return 0;
double dval = janet_unwrap_number(x);
return dval >= 0 && dval <= JANET_INTMAX_DOUBLE && dval == (uint64_t) dval;
return janet_checkuint64range(dval);
}
int janet_checksize(Janet x) {
@ -953,6 +960,7 @@ void arc4random_buf(void *buf, size_t nbytes);
#endif
int janet_cryptorand(uint8_t *out, size_t n) {
#ifndef JANET_NO_CRYPTORAND
#ifdef JANET_WINDOWS
for (size_t i = 0; i < n; i += sizeof(unsigned int)) {
unsigned int v;
@ -964,7 +972,10 @@ int janet_cryptorand(uint8_t *out, size_t n) {
}
}
return 0;
#elif defined(JANET_LINUX) || defined(JANET_CYGWIN) || ( defined(JANET_APPLE) && !defined(MAC_OS_X_VERSION_10_7) )
#elif defined(JANET_BSD) || defined(MAC_OS_X_VERSION_10_7)
arc4random_buf(out, n);
return 0;
#else
/* We should be able to call getrandom on linux, but it doesn't seem
to be uniformly supported on linux distros.
On Mac, arc4random_buf wasn't available on until 10.7.
@ -986,12 +997,10 @@ int janet_cryptorand(uint8_t *out, size_t n) {
}
RETRY_EINTR(rc, close(randfd));
return 0;
#elif defined(JANET_BSD) || defined(MAC_OS_X_VERSION_10_7)
arc4random_buf(out, n);
return 0;
#endif
#else
(void) n;
(void) out;
(void) n;
return -1;
#endif
}

View File

@ -49,11 +49,11 @@
#ifndef JANET_EXIT
#include <stdio.h>
#define JANET_EXIT(m) do { \
fprintf(stderr, "C runtime error at line %d in file %s: %s\n",\
fprintf(stderr, "janet internal error at line %d in file %s: %s\n",\
__LINE__,\
__FILE__,\
(m));\
exit(1);\
abort();\
} while (0)
#endif

View File

@ -698,11 +698,16 @@ Janet janet_lengthv(Janet x) {
const JanetAbstractType *type = janet_abstract_type(abst);
if (type->length != NULL) {
size_t len = type->length(abst, janet_abstract_size(abst));
if ((uint64_t) len <= (uint64_t) JANET_INTMAX_INT64) {
/* If len is always less then double, we can never overflow */
#ifdef JANET_32
return janet_wrap_number(len);
#else
if (len < (size_t) JANET_INTMAX_INT64) {
return janet_wrap_number((double) len);
} else {
janet_panicf("integer length %u too large", len);
}
#endif
}
Janet argv[1] = { x };
return janet_mcall("length", 1, argv);

View File

@ -116,7 +116,6 @@
#else
#define vm_maybe_auto_suspend(COND) do { \
if ((COND) && janet_vm.auto_suspend) { \
janet_vm.auto_suspend = 0; \
fiber->flags |= (JANET_FIBER_RESUME_NO_USEVAL | JANET_FIBER_RESUME_NO_SKIP); \
vm_return(JANET_SIGNAL_INTERRUPT, janet_wrap_nil()); \
} \
@ -138,7 +137,7 @@
vm_pcnext();\
}\
}
#define _vm_bitop_immediate(op, type1)\
#define _vm_bitop_immediate(op, type1, rangecheck, msg)\
{\
Janet op1 = stack[B];\
if (!janet_checktype(op1, JANET_NUMBER)) {\
@ -147,13 +146,15 @@
stack[A] = janet_mcall(#op, 2, _argv);\
vm_checkgc_pcnext();\
} else {\
type1 x1 = (type1) janet_unwrap_integer(op1);\
stack[A] = janet_wrap_integer(x1 op CS);\
double y1 = janet_unwrap_number(op1);\
if (!rangecheck(y1)) { vm_commit(); janet_panicf("value %v out of range for " msg, op1); }\
type1 x1 = (type1) y1;\
stack[A] = janet_wrap_number((type1) (x1 op CS));\
vm_pcnext();\
}\
}
#define vm_bitop_immediate(op) _vm_bitop_immediate(op, int32_t);
#define vm_bitopu_immediate(op) _vm_bitop_immediate(op, uint32_t);
#define vm_bitop_immediate(op) _vm_bitop_immediate(op, int32_t, janet_checkintrange, "32-bit signed integers");
#define vm_bitopu_immediate(op) _vm_bitop_immediate(op, uint32_t, janet_checkuintrange, "32-bit unsigned integers");
#define _vm_binop(op, wrap)\
{\
Janet op1 = stack[B];\
@ -170,14 +171,18 @@
}\
}
#define vm_binop(op) _vm_binop(op, janet_wrap_number)
#define _vm_bitop(op, type1)\
#define _vm_bitop(op, type1, rangecheck, msg)\
{\
Janet op1 = stack[B];\
Janet op2 = stack[C];\
if (janet_checktype(op1, JANET_NUMBER) && janet_checktype(op2, JANET_NUMBER)) {\
type1 x1 = (type1) janet_unwrap_integer(op1);\
int32_t x2 = janet_unwrap_integer(op2);\
stack[A] = janet_wrap_integer(x1 op x2);\
double y1 = janet_unwrap_number(op1);\
double y2 = janet_unwrap_number(op2);\
if (!rangecheck(y1)) { vm_commit(); janet_panicf("value %v out of range for " msg, op1); }\
if (!janet_checkintrange(y2)) { vm_commit(); janet_panicf("rhs must be valid 32-bit signed integer, got %f", op2); }\
type1 x1 = (type1) y1;\
int32_t x2 = (int32_t) y2;\
stack[A] = janet_wrap_number((type1) (x1 op x2));\
vm_pcnext();\
} else {\
vm_commit();\
@ -185,8 +190,8 @@
vm_checkgc_pcnext();\
}\
}
#define vm_bitop(op) _vm_bitop(op, int32_t)
#define vm_bitopu(op) _vm_bitop(op, uint32_t)
#define vm_bitop(op) _vm_bitop(op, int32_t, janet_checkintrange, "32-bit signed integers")
#define vm_bitopu(op) _vm_bitop(op, uint32_t, janet_checkuintrange, "32-bit unsigned integers")
#define vm_compop(op) \
{\
Janet op1 = stack[B];\
@ -295,6 +300,16 @@ static Janet janet_method_lookup(Janet x, const char *name) {
return method_to_fun(janet_ckeywordv(name), x);
}
static Janet janet_unary_call(const char *method, Janet arg) {
Janet m = janet_method_lookup(arg, method);
if (janet_checktype(m, JANET_NIL)) {
janet_panicf("could not find method :%s for %v", method, arg);
} else {
Janet argv[1] = { arg };
return janet_method_invoke(m, 1, argv);
}
}
/* Call a method first on the righthand side, and then on the left hand side with a prefix */
static Janet janet_binop_call(const char *lmethod, const char *rmethod, Janet lhs, Janet rhs) {
Janet lm = janet_method_lookup(lhs, lmethod);
@ -331,11 +346,13 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in) {
&&label_JOP_RETURN_NIL,
&&label_JOP_ADD_IMMEDIATE,
&&label_JOP_ADD,
&&label_JOP_SUBTRACT_IMMEDIATE,
&&label_JOP_SUBTRACT,
&&label_JOP_MULTIPLY_IMMEDIATE,
&&label_JOP_MULTIPLY,
&&label_JOP_DIVIDE_IMMEDIATE,
&&label_JOP_DIVIDE,
&&label_JOP_DIVIDE_FLOOR,
&&label_JOP_MODULO,
&&label_JOP_REMAINDER,
&&label_JOP_BAND,
@ -576,8 +593,6 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in) {
&&label_unknown_op,
&&label_unknown_op,
&&label_unknown_op,
&&label_unknown_op,
&&label_unknown_op,
&&label_unknown_op
};
#endif
@ -667,6 +682,9 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in) {
VM_OP(JOP_ADD)
vm_binop(+);
VM_OP(JOP_SUBTRACT_IMMEDIATE)
vm_binop_immediate(-);
VM_OP(JOP_SUBTRACT)
vm_binop(-);
@ -682,14 +700,33 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in) {
VM_OP(JOP_DIVIDE)
vm_binop( /);
VM_OP(JOP_DIVIDE_FLOOR) {
Janet op1 = stack[B];
Janet op2 = stack[C];
if (janet_checktype(op1, JANET_NUMBER) && janet_checktype(op2, JANET_NUMBER)) {
double x1 = janet_unwrap_number(op1);
double x2 = janet_unwrap_number(op2);
stack[A] = janet_wrap_number(floor(x1 / x2));
vm_pcnext();
} else {
vm_commit();
stack[A] = janet_binop_call("div", "rdiv", op1, op2);
vm_checkgc_pcnext();
}
}
VM_OP(JOP_MODULO) {
Janet op1 = stack[B];
Janet op2 = stack[C];
if (janet_checktype(op1, JANET_NUMBER) && janet_checktype(op2, JANET_NUMBER)) {
double x1 = janet_unwrap_number(op1);
double x2 = janet_unwrap_number(op2);
double intres = x2 * floor(x1 / x2);
stack[A] = janet_wrap_number(x1 - intres);
if (x2 == 0) {
stack[A] = janet_wrap_number(x1);
} else {
double intres = x2 * floor(x1 / x2);
stack[A] = janet_wrap_number(x1 - intres);
}
vm_pcnext();
} else {
vm_commit();
@ -724,9 +761,14 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in) {
VM_OP(JOP_BNOT) {
Janet op = stack[E];
vm_assert_type(op, JANET_NUMBER);
stack[A] = janet_wrap_integer(~janet_unwrap_integer(op));
vm_pcnext();
if (janet_checktype(op, JANET_NUMBER)) {
stack[A] = janet_wrap_integer(~janet_unwrap_integer(op));
vm_pcnext();
} else {
vm_commit();
stack[A] = janet_unary_call("~", op);
vm_checkgc_pcnext();
}
}
VM_OP(JOP_SHIFT_RIGHT_UNSIGNED)
@ -757,13 +799,13 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in) {
VM_OP(JOP_JUMP)
pc += DS;
vm_maybe_auto_suspend(DS < 0);
vm_maybe_auto_suspend(DS <= 0);
vm_next();
VM_OP(JOP_JUMP_IF)
if (janet_truthy(stack[A])) {
pc += ES;
vm_maybe_auto_suspend(ES < 0);
vm_maybe_auto_suspend(ES <= 0);
} else {
pc++;
}
@ -774,14 +816,14 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in) {
pc++;
} else {
pc += ES;
vm_maybe_auto_suspend(ES < 0);
vm_maybe_auto_suspend(ES <= 0);
}
vm_next();
VM_OP(JOP_JUMP_IF_NIL)
if (janet_checktype(stack[A], JANET_NIL)) {
pc += ES;
vm_maybe_auto_suspend(ES < 0);
vm_maybe_auto_suspend(ES <= 0);
} else {
pc++;
}
@ -792,7 +834,7 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in) {
pc++;
} else {
pc += ES;
vm_maybe_auto_suspend(ES < 0);
vm_maybe_auto_suspend(ES <= 0);
}
vm_next();
@ -819,7 +861,7 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in) {
vm_pcnext();
VM_OP(JOP_EQUALS_IMMEDIATE)
stack[A] = janet_wrap_boolean(janet_unwrap_number(stack[B]) == (double) CS);
stack[A] = janet_wrap_boolean(janet_checktype(stack[B], JANET_NUMBER) && (janet_unwrap_number(stack[B]) == (double) CS));
vm_pcnext();
VM_OP(JOP_NOT_EQUALS)
@ -827,7 +869,7 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in) {
vm_pcnext();
VM_OP(JOP_NOT_EQUALS_IMMEDIATE)
stack[A] = janet_wrap_boolean(janet_unwrap_number(stack[B]) != (double) CS);
stack[A] = janet_wrap_boolean(!janet_checktype(stack[B], JANET_NUMBER) || (janet_unwrap_number(stack[B]) != (double) CS));
vm_pcnext();
VM_OP(JOP_COMPARE)
@ -980,7 +1022,7 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in) {
if (func->gc.flags & JANET_FUNCFLAG_TRACE) {
vm_do_trace(func, fiber->stacktop - fiber->stackstart, fiber->data + fiber->stackstart);
}
janet_stack_frame(stack)->pc = pc;
vm_commit();
if (janet_fiber_funcframe(fiber, func)) {
int32_t n = fiber->stacktop - fiber->stackstart;
janet_panicf("%v called with %d argument%s, expected %d",
@ -1543,9 +1585,11 @@ int janet_init(void) {
/* Garbage collection */
janet_vm.blocks = NULL;
janet_vm.weak_blocks = NULL;
janet_vm.next_collection = 0;
janet_vm.gc_interval = 0x400000;
janet_vm.block_count = 0;
janet_vm.gc_mark_phase = 0;
janet_symcache_init();

View File

@ -43,10 +43,10 @@ int (janet_truthy)(Janet x) {
return janet_truthy(x);
}
const JanetKV *(janet_unwrap_struct)(Janet x) {
JanetStruct(janet_unwrap_struct)(Janet x) {
return janet_unwrap_struct(x);
}
const Janet *(janet_unwrap_tuple)(Janet x) {
JanetTuple(janet_unwrap_tuple)(Janet x) {
return janet_unwrap_tuple(x);
}
JanetFiber *(janet_unwrap_fiber)(Janet x) {
@ -61,16 +61,16 @@ JanetTable *(janet_unwrap_table)(Janet x) {
JanetBuffer *(janet_unwrap_buffer)(Janet x) {
return janet_unwrap_buffer(x);
}
const uint8_t *(janet_unwrap_string)(Janet x) {
JanetString(janet_unwrap_string)(Janet x) {
return janet_unwrap_string(x);
}
const uint8_t *(janet_unwrap_symbol)(Janet x) {
JanetSymbol(janet_unwrap_symbol)(Janet x) {
return janet_unwrap_symbol(x);
}
const uint8_t *(janet_unwrap_keyword)(Janet x) {
JanetKeyword(janet_unwrap_keyword)(Janet x) {
return janet_unwrap_keyword(x);
}
void *(janet_unwrap_abstract)(Janet x) {
JanetAbstract(janet_unwrap_abstract)(Janet x) {
return janet_unwrap_abstract(x);
}
void *(janet_unwrap_pointer)(Janet x) {
@ -102,22 +102,22 @@ Janet(janet_wrap_false)(void) {
Janet(janet_wrap_boolean)(int x) {
return janet_wrap_boolean(x);
}
Janet(janet_wrap_string)(const uint8_t *x) {
Janet(janet_wrap_string)(JanetString x) {
return janet_wrap_string(x);
}
Janet(janet_wrap_symbol)(const uint8_t *x) {
Janet(janet_wrap_symbol)(JanetSymbol x) {
return janet_wrap_symbol(x);
}
Janet(janet_wrap_keyword)(const uint8_t *x) {
Janet(janet_wrap_keyword)(JanetKeyword x) {
return janet_wrap_keyword(x);
}
Janet(janet_wrap_array)(JanetArray *x) {
return janet_wrap_array(x);
}
Janet(janet_wrap_tuple)(const Janet *x) {
Janet(janet_wrap_tuple)(JanetTuple x) {
return janet_wrap_tuple(x);
}
Janet(janet_wrap_struct)(const JanetKV *x) {
Janet(janet_wrap_struct)(JanetStruct x) {
return janet_wrap_struct(x);
}
Janet(janet_wrap_fiber)(JanetFiber *x) {
@ -135,7 +135,7 @@ Janet(janet_wrap_cfunction)(JanetCFunction x) {
Janet(janet_wrap_table)(JanetTable *x) {
return janet_wrap_table(x);
}
Janet(janet_wrap_abstract)(void *x) {
Janet(janet_wrap_abstract)(JanetAbstract x) {
return janet_wrap_abstract(x);
}
Janet(janet_wrap_pointer)(void *x) {
@ -317,4 +317,3 @@ JANET_WRAP_DEFINE(pointer, void *, JANET_POINTER, pointer)
#undef JANET_WRAP_DEFINE
#endif

View File

@ -112,7 +112,8 @@ extern "C" {
|| defined(__s390x__) /* S390 64-bit (BE) */ \
|| (defined(__ppc64__) || defined(__PPC64__)) \
|| defined(__aarch64__) /* ARM 64-bit */ \
|| (defined(__riscv) && (__riscv_xlen == 64)) /* RISC-V 64-bit */
|| (defined(__riscv) && (__riscv_xlen == 64)) /* RISC-V 64-bit */ \
|| defined(__loongarch64) /* LoongArch64 64-bit */
#define JANET_64 1
#else
#define JANET_32 1
@ -234,10 +235,28 @@ extern "C" {
#define JANET_EV_KQUEUE
#endif
/* Use poll as last resort */
#if !defined(JANET_WINDOWS) && !defined(JANET_EV_EPOLL) && !defined(JANET_EV_KQUEUE)
#define JANET_EV_POLL
#endif
/* How to export symbols */
#ifndef JANET_EXPORT
#ifdef JANET_WINDOWS
#define JANET_EXPORT __declspec(dllexport)
#else
#define JANET_EXPORT __attribute__((visibility ("default")))
#endif
#endif
/* How declare API functions */
#ifndef JANET_API
#ifdef JANET_WINDOWS
#ifdef JANET_DLL_IMPORT
#define JANET_API __declspec(dllimport)
#else
#define JANET_API __declspec(dllexport)
#endif
#else
#define JANET_API __attribute__((visibility ("default")))
#endif
@ -393,12 +412,11 @@ typedef enum {
JANET_SIGNAL_USER6,
JANET_SIGNAL_USER7,
JANET_SIGNAL_USER8,
JANET_SIGNAL_USER9
JANET_SIGNAL_USER9,
JANET_SIGNAL_INTERRUPT = JANET_SIGNAL_USER8,
JANET_SIGNAL_EVENT = JANET_SIGNAL_USER9,
} JanetSignal;
#define JANET_SIGNAL_EVENT JANET_SIGNAL_USER9
#define JANET_SIGNAL_INTERRUPT JANET_SIGNAL_USER8
/* Fiber statuses - mostly corresponds to signals. */
typedef enum {
JANET_STATUS_DEAD,
@ -562,7 +580,7 @@ typedef void *JanetAbstract;
#define JANET_STREAM_CLOSED 0x1
#define JANET_STREAM_SOCKET 0x2
#define JANET_STREAM_IOCP 0x4
#define JANET_STREAM_UNREGISTERED 0x4
#define JANET_STREAM_READABLE 0x200
#define JANET_STREAM_WRITABLE 0x400
#define JANET_STREAM_ACCEPTABLE 0x800
@ -570,62 +588,73 @@ typedef void *JanetAbstract;
#define JANET_STREAM_TOCLOSE 0x10000
typedef enum {
JANET_ASYNC_EVENT_INIT,
JANET_ASYNC_EVENT_MARK,
JANET_ASYNC_EVENT_DEINIT,
JANET_ASYNC_EVENT_CLOSE,
JANET_ASYNC_EVENT_ERR,
JANET_ASYNC_EVENT_HUP,
JANET_ASYNC_EVENT_READ,
JANET_ASYNC_EVENT_WRITE,
JANET_ASYNC_EVENT_CANCEL,
JANET_ASYNC_EVENT_COMPLETE, /* Used on windows for IOCP */
JANET_ASYNC_EVENT_USER
JANET_ASYNC_EVENT_INIT = 0,
JANET_ASYNC_EVENT_MARK = 1,
JANET_ASYNC_EVENT_DEINIT = 2,
JANET_ASYNC_EVENT_CLOSE = 3,
JANET_ASYNC_EVENT_ERR = 4,
JANET_ASYNC_EVENT_HUP = 5,
JANET_ASYNC_EVENT_READ = 6,
JANET_ASYNC_EVENT_WRITE = 7,
JANET_ASYNC_EVENT_COMPLETE = 8, /* Used on windows for IOCP */
JANET_ASYNC_EVENT_FAILED = 9 /* Used on windows for IOCP */
} JanetAsyncEvent;
#define JANET_ASYNC_LISTEN_READ (1 << JANET_ASYNC_EVENT_READ)
#define JANET_ASYNC_LISTEN_WRITE (1 << JANET_ASYNC_EVENT_WRITE)
typedef enum {
JANET_ASYNC_STATUS_NOT_DONE,
JANET_ASYNC_STATUS_DONE
} JanetAsyncStatus;
JANET_ASYNC_LISTEN_READ = 1,
JANET_ASYNC_LISTEN_WRITE,
JANET_ASYNC_LISTEN_BOTH
} JanetAsyncMode;
/* Typedefs */
typedef struct JanetListenerState JanetListenerState;
typedef struct JanetStream JanetStream;
typedef JanetAsyncStatus(*JanetListener)(JanetListenerState *state, JanetAsyncEvent event);
/* Wrapper around file descriptors and HANDLEs that can be polled. */
struct JanetStream {
JanetHandle handle;
uint32_t flags;
/* Linked list of all in-flight IO routines for this stream */
JanetListenerState *state;
uint32_t index;
JanetFiber *read_fiber;
JanetFiber *write_fiber;
const void *methods; /* Methods for this stream */
/* internal - used to disallow multiple concurrent reads / writes on the same stream.
* this constraint may be lifted later but allowing such would require more internal book keeping
* for some implementations. You can read and write at the same time on the same stream, though. */
int _mask;
};
/* Interface for state machine based event loop */
struct JanetListenerState {
JanetListener machine;
JanetFiber *fiber;
JanetStream *stream;
void *event; /* Used to pass data from asynchronous IO event. Contents depend on both
implementation of the event loop and the particular event. */
typedef void (*JanetEVCallback)(JanetFiber *fiber, JanetAsyncEvent event);
/* Start listening for events from a stream on the current root fiber. After
* calling this, users should call janet_await() before returning from the
* current C Function. This also will call janet_await.
* mode is which events to listen for, and callback is the function pointer to
* call when ever an event is sent from the event loop. state is an optional (can be NULL)
* pointer to data allocated with janet_malloc. This pointer will be passed to callback as
* fiber->ev_state. It will also be freed for you by the runtime when the event loop determines
* it can no longer be referenced. On windows, the contents of state MUST contained an OVERLAPPED struct. */
JANET_API JANET_NO_RETURN void janet_async_start(JanetStream *stream, JanetAsyncMode mode, JanetEVCallback callback, void *state);
/* Do not send any more events to the given callback. Call this after scheduling fiber to be resume
* or canceled. */
JANET_API void janet_async_end(JanetFiber *fiber);
/* Needed for windows to mark a fiber as waiting for an IOCP completion event. Noop on other platforms. */
JANET_API void janet_async_in_flight(JanetFiber *fiber);
/* On some platforms, it is important to be able to control if a stream is edge-trigger or level triggered.
* For example, a server that is accepting connections might want to be level triggered or edge-triggered
* depending on expected service. */
JANET_API void janet_stream_edge_triggered(JanetStream *stream);
JANET_API void janet_stream_level_triggered(JanetStream *stream);
#endif
/* Janet uses atomic integers in several places for synchronization between threads and
* signals. Define them here */
#ifdef JANET_WINDOWS
void *tag; /* Used to associate listeners with an overlapped structure */
int bytes; /* Used to track how many bytes were transfered. */
#endif
/* internal */
size_t _index;
int _mask;
JanetListenerState *_next;
};
typedef long JanetAtomicInt;
#else
typedef int32_t JanetAtomicInt;
#endif
JANET_API JanetAtomicInt janet_atomic_inc(JanetAtomicInt volatile *x);
JANET_API JanetAtomicInt janet_atomic_dec(JanetAtomicInt volatile *x);
JANET_API JanetAtomicInt janet_atomic_load(JanetAtomicInt volatile *x);
/* We provide three possible implementations of Janets. The preferred
* nanboxing approach, for 32 or 64 bits, and the standard C version. Code in the rest of the
@ -653,10 +682,10 @@ struct JanetListenerState {
* external bindings, we should prefer using the Head structs directly, and
* use the host language to add sugar around the manipulation of the Janet types. */
JANET_API JanetStructHead *janet_struct_head(const JanetKV *st);
JANET_API JanetStructHead *janet_struct_head(JanetStruct st);
JANET_API JanetAbstractHead *janet_abstract_head(const void *abstract);
JANET_API JanetStringHead *janet_string_head(const uint8_t *s);
JANET_API JanetTupleHead *janet_tuple_head(const Janet *tuple);
JANET_API JanetStringHead *janet_string_head(JanetString s);
JANET_API JanetTupleHead *janet_tuple_head(JanetTuple tuple);
/* Some language bindings won't have access to the macro versions. */
@ -665,16 +694,16 @@ JANET_API int janet_checktype(Janet x, JanetType type);
JANET_API int janet_checktypes(Janet x, int typeflags);
JANET_API int janet_truthy(Janet x);
JANET_API const JanetKV *janet_unwrap_struct(Janet x);
JANET_API const Janet *janet_unwrap_tuple(Janet x);
JANET_API JanetStruct janet_unwrap_struct(Janet x);
JANET_API JanetTuple janet_unwrap_tuple(Janet x);
JANET_API JanetFiber *janet_unwrap_fiber(Janet x);
JANET_API JanetArray *janet_unwrap_array(Janet x);
JANET_API JanetTable *janet_unwrap_table(Janet x);
JANET_API JanetBuffer *janet_unwrap_buffer(Janet x);
JANET_API const uint8_t *janet_unwrap_string(Janet x);
JANET_API const uint8_t *janet_unwrap_symbol(Janet x);
JANET_API const uint8_t *janet_unwrap_keyword(Janet x);
JANET_API void *janet_unwrap_abstract(Janet x);
JANET_API JanetString janet_unwrap_string(Janet x);
JANET_API JanetSymbol janet_unwrap_symbol(Janet x);
JANET_API JanetKeyword janet_unwrap_keyword(Janet x);
JANET_API JanetAbstract janet_unwrap_abstract(Janet x);
JANET_API void *janet_unwrap_pointer(Janet x);
JANET_API JanetFunction *janet_unwrap_function(Janet x);
JANET_API JanetCFunction janet_unwrap_cfunction(Janet x);
@ -687,18 +716,18 @@ JANET_API Janet janet_wrap_number(double x);
JANET_API Janet janet_wrap_true(void);
JANET_API Janet janet_wrap_false(void);
JANET_API Janet janet_wrap_boolean(int x);
JANET_API Janet janet_wrap_string(const uint8_t *x);
JANET_API Janet janet_wrap_symbol(const uint8_t *x);
JANET_API Janet janet_wrap_keyword(const uint8_t *x);
JANET_API Janet janet_wrap_string(JanetString x);
JANET_API Janet janet_wrap_symbol(JanetSymbol x);
JANET_API Janet janet_wrap_keyword(JanetKeyword x);
JANET_API Janet janet_wrap_array(JanetArray *x);
JANET_API Janet janet_wrap_tuple(const Janet *x);
JANET_API Janet janet_wrap_struct(const JanetKV *x);
JANET_API Janet janet_wrap_tuple(JanetTuple x);
JANET_API Janet janet_wrap_struct(JanetStruct x);
JANET_API Janet janet_wrap_fiber(JanetFiber *x);
JANET_API Janet janet_wrap_buffer(JanetBuffer *x);
JANET_API Janet janet_wrap_function(JanetFunction *x);
JANET_API Janet janet_wrap_cfunction(JanetCFunction x);
JANET_API Janet janet_wrap_table(JanetTable *x);
JANET_API Janet janet_wrap_abstract(void *x);
JANET_API Janet janet_wrap_abstract(JanetAbstract x);
JANET_API Janet janet_wrap_pointer(void *x);
JANET_API Janet janet_wrap_integer(int32_t x);
@ -730,6 +759,7 @@ JANET_API Janet janet_wrap_integer(int32_t x);
? janet_nanbox_isnumber(x) \
: janet_nanbox_checkauxtype((x), (t)))
/* Use JANET_API so that modules will use a local version of these functions if possible */
JANET_API void *janet_nanbox_to_pointer(Janet x);
JANET_API Janet janet_nanbox_from_pointer(void *p, uint64_t tagmask);
JANET_API Janet janet_nanbox_from_cpointer(const void *p, uint64_t tagmask);
@ -776,14 +806,14 @@ JANET_API Janet janet_nanbox_from_bits(uint64_t bits);
#define janet_wrap_pointer(s) janet_nanbox_wrap_((s), JANET_POINTER)
/* Unwrap the pointer types */
#define janet_unwrap_struct(x) ((const JanetKV *)janet_nanbox_to_pointer(x))
#define janet_unwrap_tuple(x) ((const Janet *)janet_nanbox_to_pointer(x))
#define janet_unwrap_struct(x) ((JanetStruct)janet_nanbox_to_pointer(x))
#define janet_unwrap_tuple(x) ((JanetTuple)janet_nanbox_to_pointer(x))
#define janet_unwrap_fiber(x) ((JanetFiber *)janet_nanbox_to_pointer(x))
#define janet_unwrap_array(x) ((JanetArray *)janet_nanbox_to_pointer(x))
#define janet_unwrap_table(x) ((JanetTable *)janet_nanbox_to_pointer(x))
#define janet_unwrap_buffer(x) ((JanetBuffer *)janet_nanbox_to_pointer(x))
#define janet_unwrap_string(x) ((const uint8_t *)janet_nanbox_to_pointer(x))
#define janet_unwrap_symbol(x) ((const uint8_t *)janet_nanbox_to_pointer(x))
#define janet_unwrap_string(x) ((JanetString)janet_nanbox_to_pointer(x))
#define janet_unwrap_symbol(x) ((JanetSymbol)janet_nanbox_to_pointer(x))
#define janet_unwrap_keyword(x) ((const uint8_t *)janet_nanbox_to_pointer(x))
#define janet_unwrap_abstract(x) (janet_nanbox_to_pointer(x))
#define janet_unwrap_pointer(x) (janet_nanbox_to_pointer(x))
@ -825,15 +855,15 @@ JANET_API Janet janet_nanbox32_from_tagp(uint32_t tag, void *pointer);
#define janet_wrap_cfunction(s) janet_nanbox32_from_tagp(JANET_CFUNCTION, (void *)(s))
#define janet_wrap_pointer(s) janet_nanbox32_from_tagp(JANET_POINTER, (void *)(s))
#define janet_unwrap_struct(x) ((const JanetKV *)(x).tagged.payload.pointer)
#define janet_unwrap_tuple(x) ((const Janet *)(x).tagged.payload.pointer)
#define janet_unwrap_struct(x) ((JanetStruct)(x).tagged.payload.pointer)
#define janet_unwrap_tuple(x) ((JanetTuple)(x).tagged.payload.pointer)
#define janet_unwrap_fiber(x) ((JanetFiber *)(x).tagged.payload.pointer)
#define janet_unwrap_array(x) ((JanetArray *)(x).tagged.payload.pointer)
#define janet_unwrap_table(x) ((JanetTable *)(x).tagged.payload.pointer)
#define janet_unwrap_buffer(x) ((JanetBuffer *)(x).tagged.payload.pointer)
#define janet_unwrap_string(x) ((const uint8_t *)(x).tagged.payload.pointer)
#define janet_unwrap_symbol(x) ((const uint8_t *)(x).tagged.payload.pointer)
#define janet_unwrap_keyword(x) ((const uint8_t *)(x).tagged.payload.pointer)
#define janet_unwrap_string(x) ((JanetString)(x).tagged.payload.pointer)
#define janet_unwrap_symbol(x) ((JanetSymbol)(x).tagged.payload.pointer)
#define janet_unwrap_keyword(x) ((JanetKeyword)(x).tagged.payload.pointer)
#define janet_unwrap_abstract(x) ((x).tagged.payload.pointer)
#define janet_unwrap_pointer(x) ((x).tagged.payload.pointer)
#define janet_unwrap_function(x) ((JanetFunction *)(x).tagged.payload.pointer)
@ -848,15 +878,15 @@ JANET_API Janet janet_nanbox32_from_tagp(uint32_t tag, void *pointer);
#define janet_truthy(x) \
((x).type != JANET_NIL && ((x).type != JANET_BOOLEAN || ((x).as.u64 & 0x1)))
#define janet_unwrap_struct(x) ((const JanetKV *)(x).as.pointer)
#define janet_unwrap_tuple(x) ((const Janet *)(x).as.pointer)
#define janet_unwrap_struct(x) ((JanetStruct)(x).as.pointer)
#define janet_unwrap_tuple(x) ((JanetTuple)(x).as.pointer)
#define janet_unwrap_fiber(x) ((JanetFiber *)(x).as.pointer)
#define janet_unwrap_array(x) ((JanetArray *)(x).as.pointer)
#define janet_unwrap_table(x) ((JanetTable *)(x).as.pointer)
#define janet_unwrap_buffer(x) ((JanetBuffer *)(x).as.pointer)
#define janet_unwrap_string(x) ((const uint8_t *)(x).as.pointer)
#define janet_unwrap_symbol(x) ((const uint8_t *)(x).as.pointer)
#define janet_unwrap_keyword(x) ((const uint8_t *)(x).as.pointer)
#define janet_unwrap_string(x) ((JanetString)(x).as.pointer)
#define janet_unwrap_symbol(x) ((JanetSymbol)(x).as.pointer)
#define janet_unwrap_keyword(x) ((JanetKeyword)(x).as.pointer)
#define janet_unwrap_abstract(x) ((x).as.pointer)
#define janet_unwrap_pointer(x) ((x).as.pointer)
#define janet_unwrap_function(x) ((JanetFunction *)(x).as.pointer)
@ -868,12 +898,15 @@ JANET_API Janet janet_nanbox32_from_tagp(uint32_t tag, void *pointer);
#endif
JANET_API int janet_checkint(Janet x);
JANET_API int janet_checkuint(Janet x);
JANET_API int janet_checkint64(Janet x);
JANET_API int janet_checkuint64(Janet x);
JANET_API int janet_checksize(Janet x);
JANET_API JanetAbstract janet_checkabstract(Janet x, const JanetAbstractType *at);
#define janet_checkintrange(x) ((x) >= INT32_MIN && (x) <= INT32_MAX && (x) == (int32_t)(x))
#define janet_checkuintrange(x) ((x) >= 0 && (x) <= UINT32_MAX && (x) == (uint32_t)(x))
#define janet_checkint64range(x) ((x) >= JANET_INTMIN_DOUBLE && (x) <= JANET_INTMAX_DOUBLE && (x) == (int64_t)(x))
#define janet_checkuint64range(x) ((x) >= 0 && (x) <= JANET_INTMAX_DOUBLE && (x) == (uint64_t)(x))
#define janet_unwrap_integer(x) ((int32_t) janet_unwrap_number(x))
#define janet_wrap_integer(x) janet_wrap_number((int32_t)(x))
@ -886,7 +919,7 @@ struct JanetGCObject {
int32_t flags;
union {
JanetGCObject *next;
int32_t refcount; /* For threaded abstract types */
volatile JanetAtomicInt refcount; /* For threaded abstract types */
} data;
};
@ -909,8 +942,10 @@ struct JanetFiber {
* that is, fibers that are scheduled on the event loop and behave much like threads
* in a multi-tasking system. It would be possible to move these fields to a new
* type, say "JanetTask", that as separate from fibers to save a bit of space. */
JanetListenerState *waiting;
uint32_t sched_id; /* Increment everytime fiber is scheduled by event loop */
JanetEVCallback ev_callback; /* Call this before starting scheduled fibers */
JanetStream *ev_stream; /* which stream we are waiting on */
void *ev_state; /* Extra data for ev callback state. On windows, first element must be OVERLAPPED. */
void *supervisor_channel; /* Channel to push self to when complete */
#endif
};
@ -1259,11 +1294,13 @@ enum JanetOpCode {
JOP_RETURN_NIL,
JOP_ADD_IMMEDIATE,
JOP_ADD,
JOP_SUBTRACT_IMMEDIATE,
JOP_SUBTRACT,
JOP_MULTIPLY_IMMEDIATE,
JOP_MULTIPLY,
JOP_DIVIDE_IMMEDIATE,
JOP_DIVIDE,
JOP_DIVIDE_FLOOR,
JOP_MODULO,
JOP_REMAINDER,
JOP_BAND,
@ -1383,9 +1420,7 @@ JANET_API void janet_stream_flags(JanetStream *stream, uint32_t flags);
JANET_API void janet_schedule(JanetFiber *fiber, Janet value);
JANET_API void janet_cancel(JanetFiber *fiber, Janet value);
JANET_API void janet_schedule_signal(JanetFiber *fiber, Janet value, JanetSignal sig);
/* Start a state machine listening for events from a stream */
JANET_API JanetListenerState *janet_listen(JanetStream *stream, JanetListener behavior, int mask, size_t size, void *user);
JANET_API void janet_schedule_soon(JanetFiber *fiber, Janet value, JanetSignal sig);
/* Shorthand for yielding to event loop in C */
JANET_NO_RETURN JANET_API void janet_await(void);
@ -1473,23 +1508,22 @@ JANET_API void janet_ev_post_event(JanetVM *vm, JanetCallback cb, JanetEVGeneric
JANET_API void janet_ev_default_threaded_callback(JanetEVGenericMessage return_value);
/* Read async from a stream */
JANET_API void janet_ev_read(JanetStream *stream, JanetBuffer *buf, int32_t nbytes);
JANET_API void janet_ev_readchunk(JanetStream *stream, JanetBuffer *buf, int32_t nbytes);
JANET_NO_RETURN JANET_API void janet_ev_read(JanetStream *stream, JanetBuffer *buf, int32_t nbytes);
JANET_NO_RETURN JANET_API void janet_ev_readchunk(JanetStream *stream, JanetBuffer *buf, int32_t nbytes);
#ifdef JANET_NET
JANET_API void janet_ev_recv(JanetStream *stream, JanetBuffer *buf, int32_t nbytes, int flags);
JANET_API void janet_ev_recvchunk(JanetStream *stream, JanetBuffer *buf, int32_t nbytes, int flags);
JANET_API void janet_ev_recvfrom(JanetStream *stream, JanetBuffer *buf, int32_t nbytes, int flags);
JANET_API void janet_ev_connect(JanetStream *stream, int flags);
JANET_NO_RETURN JANET_API void janet_ev_recv(JanetStream *stream, JanetBuffer *buf, int32_t nbytes, int flags);
JANET_NO_RETURN JANET_API void janet_ev_recvchunk(JanetStream *stream, JanetBuffer *buf, int32_t nbytes, int flags);
JANET_NO_RETURN JANET_API void janet_ev_recvfrom(JanetStream *stream, JanetBuffer *buf, int32_t nbytes, int flags);
#endif
/* Write async to a stream */
JANET_API void janet_ev_write_buffer(JanetStream *stream, JanetBuffer *buf);
JANET_API void janet_ev_write_string(JanetStream *stream, JanetString str);
JANET_NO_RETURN JANET_API void janet_ev_write_buffer(JanetStream *stream, JanetBuffer *buf);
JANET_NO_RETURN JANET_API void janet_ev_write_string(JanetStream *stream, JanetString str);
#ifdef JANET_NET
JANET_API void janet_ev_send_buffer(JanetStream *stream, JanetBuffer *buf, int flags);
JANET_API void janet_ev_send_string(JanetStream *stream, JanetString str, int flags);
JANET_API void janet_ev_sendto_buffer(JanetStream *stream, JanetBuffer *buf, void *dest, int flags);
JANET_API void janet_ev_sendto_string(JanetStream *stream, JanetString str, void *dest, int flags);
JANET_NO_RETURN JANET_API void janet_ev_send_buffer(JanetStream *stream, JanetBuffer *buf, int flags);
JANET_NO_RETURN JANET_API void janet_ev_send_string(JanetStream *stream, JanetString str, int flags);
JANET_NO_RETURN JANET_API void janet_ev_sendto_buffer(JanetStream *stream, JanetBuffer *buf, void *dest, int flags);
JANET_NO_RETURN JANET_API void janet_ev_sendto_string(JanetStream *stream, JanetString str, void *dest, int flags);
#endif
#endif
@ -1578,6 +1612,7 @@ JANET_API double janet_rng_double(JanetRNG *rng);
/* Array functions */
JANET_API JanetArray *janet_array(int32_t capacity);
JANET_API JanetArray *janet_array_weak(int32_t capacity);
JANET_API JanetArray *janet_array_n(const Janet *elements, int32_t n);
JANET_API void janet_array_ensure(JanetArray *array, int32_t capacity, int32_t growth);
JANET_API void janet_array_setcount(JanetArray *array, int32_t count);
@ -1607,7 +1642,7 @@ JANET_API void janet_buffer_push_u64(JanetBuffer *buffer, uint64_t x);
#define JANET_TUPLE_FLAG_BRACKETCTOR 0x10000
#define janet_tuple_head(t) ((JanetTupleHead *)((char *)t - offsetof(JanetTupleHead, data)))
#define janet_tuple_from_head(gcobject) ((const Janet *)((char *)gcobject + offsetof(JanetTupleHead, data)))
#define janet_tuple_from_head(gcobject) ((JanetTuple)((char *)gcobject + offsetof(JanetTupleHead, data)))
#define janet_tuple_length(t) (janet_tuple_head(t)->length)
#define janet_tuple_hash(t) (janet_tuple_head(t)->hash)
#define janet_tuple_sm_line(t) (janet_tuple_head(t)->sm_line)
@ -1653,7 +1688,7 @@ JANET_API JanetSymbol janet_symbol_gen(void);
/* Structs */
#define janet_struct_head(t) ((JanetStructHead *)((char *)t - offsetof(JanetStructHead, data)))
#define janet_struct_from_head(t) ((const JanetKV *)((char *)gcobject + offsetof(JanetStructHead, data)))
#define janet_struct_from_head(t) ((JanetStruct)((char *)gcobject + offsetof(JanetStructHead, data)))
#define janet_struct_length(t) (janet_struct_head(t)->length)
#define janet_struct_capacity(t) (janet_struct_head(t)->capacity)
#define janet_struct_hash(t) (janet_struct_head(t)->hash)
@ -1794,6 +1829,7 @@ JANET_API void janet_vm_free(JanetVM *vm);
JANET_API void janet_vm_save(JanetVM *into);
JANET_API void janet_vm_load(JanetVM *from);
JANET_API void janet_interpreter_interrupt(JanetVM *vm);
JANET_API void janet_interpreter_interrupt_handled(JanetVM *vm);
JANET_API JanetSignal janet_continue(JanetFiber *fiber, Janet in, Janet *out);
JANET_API JanetSignal janet_continue_signal(JanetFiber *fiber, Janet in, Janet *out, JanetSignal sig);
JANET_API JanetSignal janet_pcall(JanetFunction *fun, int32_t argn, const Janet *argv, Janet *out, JanetFiber **f);
@ -1817,6 +1853,7 @@ JANET_API void janet_stacktrace_ext(JanetFiber *fiber, Janet err, const char *pr
#define JANET_SANDBOX_FS_TEMP 1024
#define JANET_SANDBOX_FFI_USE 2048
#define JANET_SANDBOX_FFI_JIT 4096
#define JANET_SANDBOX_SIGNAL 8192
#define JANET_SANDBOX_FFI (JANET_SANDBOX_FFI_DEFINE | JANET_SANDBOX_FFI_USE | JANET_SANDBOX_FFI_JIT)
#define JANET_SANDBOX_FS (JANET_SANDBOX_FS_WRITE | JANET_SANDBOX_FS_READ | JANET_SANDBOX_FS_TEMP)
#define JANET_SANDBOX_NET (JANET_SANDBOX_NET_CONNECT | JANET_SANDBOX_NET_LISTEN)
@ -1940,10 +1977,10 @@ JANET_API void janet_register(const char *name, JanetCFunction cfun);
#endif
#ifndef JANET_ENTRY_NAME
#define JANET_MODULE_ENTRY \
JANET_MODULE_PREFIX JANET_API JanetBuildConfig _janet_mod_config(void) { \
JANET_MODULE_PREFIX JANET_EXPORT JanetBuildConfig _janet_mod_config(void) { \
return janet_config_current(); \
} \
JANET_MODULE_PREFIX JANET_API void _janet_init
JANET_MODULE_PREFIX JANET_EXPORT void _janet_init
#else
#define JANET_MODULE_ENTRY JANET_MODULE_PREFIX JANET_API void JANET_ENTRY_NAME
#endif
@ -1992,6 +2029,8 @@ JANET_API JanetDictView janet_getdictionary(const Janet *argv, int32_t n);
JANET_API void *janet_getabstract(const Janet *argv, int32_t n, const JanetAbstractType *at);
JANET_API JanetRange janet_getslice(int32_t argc, const Janet *argv);
JANET_API int32_t janet_gethalfrange(const Janet *argv, int32_t n, int32_t length, const char *which);
JANET_API int32_t janet_getstartrange(const Janet *argv, int32_t argc, int32_t n, int32_t length);
JANET_API int32_t janet_getendrange(const Janet *argv, int32_t argc, int32_t n, int32_t length);
JANET_API int32_t janet_getargindex(const Janet *argv, int32_t n, int32_t length, const char *which);
JANET_API uint64_t janet_getflags(const Janet *argv, int32_t n, const char *flags);
@ -2050,6 +2089,7 @@ JANET_API int janet_cryptorand(uint8_t *out, size_t n);
JANET_API void janet_marshal_size(JanetMarshalContext *ctx, size_t value);
JANET_API void janet_marshal_int(JanetMarshalContext *ctx, int32_t value);
JANET_API void janet_marshal_int64(JanetMarshalContext *ctx, int64_t value);
JANET_API void janet_marshal_ptr(JanetMarshalContext *ctx, const void *value);
JANET_API void janet_marshal_byte(JanetMarshalContext *ctx, uint8_t value);
JANET_API void janet_marshal_bytes(JanetMarshalContext *ctx, const uint8_t *bytes, size_t len);
JANET_API void janet_marshal_janet(JanetMarshalContext *ctx, Janet x);
@ -2059,10 +2099,12 @@ JANET_API void janet_unmarshal_ensure(JanetMarshalContext *ctx, size_t size);
JANET_API size_t janet_unmarshal_size(JanetMarshalContext *ctx);
JANET_API int32_t janet_unmarshal_int(JanetMarshalContext *ctx);
JANET_API int64_t janet_unmarshal_int64(JanetMarshalContext *ctx);
JANET_API void *janet_unmarshal_ptr(JanetMarshalContext *ctx);
JANET_API uint8_t janet_unmarshal_byte(JanetMarshalContext *ctx);
JANET_API void janet_unmarshal_bytes(JanetMarshalContext *ctx, uint8_t *dest, size_t len);
JANET_API Janet janet_unmarshal_janet(JanetMarshalContext *ctx);
JANET_API JanetAbstract janet_unmarshal_abstract(JanetMarshalContext *ctx, size_t size);
JANET_API JanetAbstract janet_unmarshal_abstract_threaded(JanetMarshalContext *ctx, size_t size);
JANET_API void janet_unmarshal_abstract_reuse(JanetMarshalContext *ctx, void *p);
JANET_API void janet_register_abstract_type(const JanetAbstractType *at);
@ -2105,7 +2147,9 @@ typedef enum {
RULE_LINE, /* [tag] */
RULE_COLUMN, /* [tag] */
RULE_UNREF, /* [rule, tag] */
RULE_CAPTURE_NUM /* [rule, tag] */
RULE_CAPTURE_NUM, /* [rule, tag] */
RULE_SUB, /* [rule, rule] */
RULE_SPLIT /* [rule, rule] */
} JanetPegOpcod;
typedef struct {

View File

@ -502,10 +502,10 @@ static void kright(void) {
}
static void krightw(void) {
while (gbl_pos != gbl_len && !isspace(gbl_buf[gbl_pos])) {
while (gbl_pos != gbl_len && isspace(gbl_buf[gbl_pos])) {
gbl_pos++;
}
while (gbl_pos != gbl_len && isspace(gbl_buf[gbl_pos])) {
while (gbl_pos != gbl_len && !isspace(gbl_buf[gbl_pos])) {
gbl_pos++;
}
refresh();

View File

@ -19,7 +19,7 @@
(frame :source) (frame :source-line)))
(if x
(when is-verbose (eprintf "\e[32m✔\e[0m %s: %s: %v" line-info (describe e) x))
(eprintf "\e[31m✘\e[0m %s: %s: %v" line-info (describe e) x))
(do (eprintf "\e[31m✘\e[0m %s: %s: %v" line-info (describe e) x) (eflush)))
x)
(defmacro assert-error
@ -34,17 +34,17 @@
(defmacro assert-no-error
[msg & forms]
(def errsym (keyword (gensym)))
~(assert (not= ,errsym (try (do ,;forms) ([_] ,errsym))) ,msg))
(def e (gensym))
(def f (gensym))
(if is-verbose
~(try (do ,;forms (,assert true ,msg)) ([,e ,f] (,assert false ,msg) (,debug/stacktrace ,f ,e "\e[31m✘\e[0m ")))
~(try (do ,;forms (,assert true ,msg)) ([_] (,assert false ,msg)))))
(defn start-suite [&opt x]
(default x (dyn :current-file))
(set suite-name
(cond
(number? x) (string x)
(string? x) (string/slice x
(length "test/suite-")
(- (inc (length ".janet"))))
(string x)))
(set start-time (os/clock))
(eprint "Starting suite " suite-name "..."))

View File

@ -44,7 +44,7 @@
(assert (deep= (array/remove @[1 2 3 4 5] 2) @[1 2 4 5]) "array/remove 1")
(assert (deep= (array/remove @[1 2 3 4 5] 2 2) @[1 2 5]) "array/remove 2")
(assert (deep= (array/remove @[1 2 3 4 5] 2 200) @[1 2]) "array/remove 3")
(assert (deep= (array/remove @[1 2 3 4 5] -3 200) @[1 2 3]) "array/remove 4")
(assert (deep= (array/remove @[1 2 3 4 5] -2 200) @[1 2 3]) "array/remove 4")
# array/peek

View File

@ -51,5 +51,13 @@
(def f (asm (disasm (fn [x] (fn [y] (+ x y))))))
(assert (= ((f 10) 37) 47) "asm environment tables")
# issue #1424
(assert-no-error "arity > used slots (issue #1424)"
(asm
(disasm
(fn []
(def foo (fn [one two] one))
(foo 100 200)))))
(end-suite)

View File

@ -113,13 +113,22 @@
# 7478ad11
(assert (= nil (any? [])) "any? 1")
(assert (= nil (any? [false nil])) "any? 2")
(assert (= nil (any? [nil false])) "any? 3")
(assert (= false (any? [nil false])) "any? 3")
(assert (= 1 (any? [1])) "any? 4")
(assert (nan? (any? [nil math/nan nil])) "any? 5")
(assert (= true
(any? [nil nil false nil nil true nil nil nil nil false :a nil]))
"any? 6")
(assert (= true (every? [])) "every? 1")
(assert (= true (every? [1 true])) "every? 2")
(assert (= 1 (every? [true 1])) "every? 3")
(assert (= nil (every? [nil])) "every? 4")
(assert (= 2 (every? [1 math/nan 2])) "every? 5")
(assert (= false
(every? [1 1 true 1 1 false 1 1 1 1 true :a nil]))
"every? 6")
# Some higher order functions and macros
# 5e2de33
(def my-array @[1 2 3 4 5 6])
@ -177,6 +186,11 @@
(assert (= txs [[-1 -1] [-1 0] [-1 1] [0 -1] [0 1] [1 -1] [1 0] [1 1]])
"nested seq")
# :unless modifier
(assert (deep= (seq [i :range [0 10] :unless (odd? i)] i)
@[0 2 4 6 8])
":unless modifier")
# 515891b03
(assert (deep= (tabseq [i :in (range 3)] i (* 3 i))
@{0 0 1 3 2 6}))
@ -195,6 +209,12 @@
(assert (deep= (seq [x :down-to [10 0]] x) (seq [x :down [10 -1]] x))
"loop :down-to")
# one-term :range forms
(assert (deep= (seq [x :range [10]] x) (seq [x :range [0 10]] x))
"one-term :range")
(assert (deep= (seq [x :down [10]] x) (seq [x :down [10 0]] x))
"one-term :down")
# 7880d7320
(def res @{})
(loop [[k v] :pairs @{1 2 3 4 5 6}]
@ -221,6 +241,16 @@
(assert (pos? (% x 4)) "generate in loop"))
(assert (= gencount 75) "generate loop count")
# more loop checks
(assert (deep= (seq [i :range [0 10]] i) @[0 1 2 3 4 5 6 7 8 9]) "seq 1")
(assert (deep= (seq [i :range [0 10 2]] i) @[0 2 4 6 8]) "seq 2")
(assert (deep= (seq [i :range [10]] i) @[0 1 2 3 4 5 6 7 8 9]) "seq 3")
(assert (deep= (seq [i :range-to [10]] i) @[0 1 2 3 4 5 6 7 8 9 10]) "seq 4")
(def gen (generate [x :range-to [0 nil 2]] x))
(assert (deep= (take 5 gen) @[0 2 4 6 8]) "generate nil limit")
(def gen (generate [x :range [0 nil 2]] x))
(assert (deep= (take 5 gen) @[0 2 4 6 8]) "generate nil limit 2")
# Even and odd
# ff163a5ae
(assert (odd? 9) "odd? 1")
@ -334,6 +364,13 @@
"sort 5")
(assert (<= ;(sort (map (fn [x] (math/random)) (range 1000)))) "sort 6")
# #1283
(assert (deep=
(partition 2 (generate [ i :in [:a :b :c :d :e]] i))
'@[(:a :b) (:c :d) (:e)]))
(assert (= (mean (generate [i :in [2 3 5 7 11]] i))
5.6))
# And and or
# c16a9d846
(assert (= (and true true) true) "and true true")
@ -362,14 +399,7 @@
(assert (= false (and false false)) "and 1")
(assert (= false (or false false)) "or 1")
# Range
# a982f351d
(assert (deep= (range 10) @[0 1 2 3 4 5 6 7 8 9]) "range 1 argument")
(assert (deep= (range 5 10) @[5 6 7 8 9]) "range 2 arguments")
(assert (deep= (range 5 10 2) @[5 7 9]) "range 3 arguments")
# 11cd1279d
(assert (= (length (range 10)) 10) "(range 10)")
(assert (= (length (range 1 10)) 9) "(range 1 10)")
(assert (deep= @{:a 1 :b 2 :c 3} (zipcoll '[:a :b :c] '[1 2 3])) "zipcoll")
# bc8be266f
@ -904,4 +934,49 @@
[:strict 3 4 "bar-oops"]])
"maclintf 2")
# Bad bytecode wrt. using result from break expression
(defn bytecode-roundtrip
[f]
(assert-no-error "bytecode round-trip" (unmarshal (marshal f make-image-dict))))
(defn case-1 [&] (def x (break 1)))
(bytecode-roundtrip case-1)
(defn foo [&])
(defn case-2 [&]
(foo (break (foo)))
(foo))
(bytecode-roundtrip case-2)
(defn case-3 [&]
(def x (break (do (foo)))))
(bytecode-roundtrip case-3)
(defn case-4 [&]
(def x (break (break (foo)))))
(bytecode-roundtrip case-4)
(defn case-4 [&]
(def x (break (break (break)))))
(bytecode-roundtrip case-4)
(defn case-5 []
(def foo (fn [one two] one))
(foo 100 200))
(bytecode-roundtrip case-5)
# Debug bytecode of these functions
# (pp (disasm case-1))
# (pp (disasm case-2))
# (pp (disasm case-3))
# Regression #1330
(defn regress-1330 [&]
(def a [1 2 3])
(def b [;a])
(identity a))
(assert (= [1 2 3] (regress-1330)) "regression 1330")
# Issue 1341
(assert (= () '() (macex '())) "macex ()")
(assert (= '[] (macex '[])) "macex []")
(assert (= :a (with-env @{:b :a} (dyn :b))) "with-env dyn")
(assert-error "unknown symbol +" (with-env @{} (eval '(+ 1 2))))
(end-suite)

View File

@ -77,6 +77,54 @@
(buffer/push-string b5 "456" @"789")
(assert (= "123456789" (string b5)) "buffer/push-buffer 2")
(def buffer-uint16-be @"")
(buffer/push-uint16 buffer-uint16-be :be 0x0102)
(assert (= "\x01\x02" (string buffer-uint16-be)) "buffer/push-uint16 big endian")
(def buffer-uint16-le @"")
(buffer/push-uint16 buffer-uint16-le :le 0x0102)
(assert (= "\x02\x01" (string buffer-uint16-le)) "buffer/push-uint16 little endian")
(def buffer-uint16-negative @"")
(buffer/push-uint16 buffer-uint16-negative :be -1)
(assert (= "\xff\xff" (string buffer-uint16-negative)) "buffer/push-uint16 negative")
(def buffer-uint32-be @"")
(buffer/push-uint32 buffer-uint32-be :be 0x01020304)
(assert (= "\x01\x02\x03\x04" (string buffer-uint32-be)) "buffer/push-uint32 big endian")
(def buffer-uint32-le @"")
(buffer/push-uint32 buffer-uint32-le :le 0x01020304)
(assert (= "\x04\x03\x02\x01" (string buffer-uint32-le)) "buffer/push-uint32 little endian")
(def buffer-uint32-negative @"")
(buffer/push-uint32 buffer-uint32-negative :be -1)
(assert (= "\xff\xff\xff\xff" (string buffer-uint32-negative)) "buffer/push-uint32 negative")
(def buffer-float32-be @"")
(buffer/push-float32 buffer-float32-be :be 1.234)
(assert (= "\x3f\x9d\xf3\xb6" (string buffer-float32-be)) "buffer/push-float32 big endian")
(def buffer-float32-le @"")
(buffer/push-float32 buffer-float32-le :le 1.234)
(assert (= "\xb6\xf3\x9d\x3f" (string buffer-float32-le)) "buffer/push-float32 little endian")
(def buffer-float64-be @"")
(buffer/push-float64 buffer-float64-be :be 1.234)
(assert (= "\x3f\xf3\xbe\x76\xc8\xb4\x39\x58" (string buffer-float64-be)) "buffer/push-float64 big endian")
(def buffer-float64-le @"")
(buffer/push-float64 buffer-float64-le :le 1.234)
(assert (= "\x58\x39\xb4\xc8\x76\xbe\xf3\x3f" (string buffer-float64-le)) "buffer/push-float64 little endian")
# Buffer from bytes
(assert (deep= @"" (buffer/from-bytes)) "buffer/from-bytes 1")
(assert (deep= @"ABC" (buffer/from-bytes 65 66 67)) "buffer/from-bytes 2")
(assert (deep= @"0123456789" (buffer/from-bytes ;(range 48 58))) "buffer/from-bytes 3")
(assert (= 0 (length (buffer/from-bytes))) "buffer/from-bytes 4")
(assert (= 5 (length (buffer/from-bytes ;(range 5)))) "buffer/from-bytes 5")
(assert-error "bad slot #1, expected 32 bit signed integer" (buffer/from-bytes :abc))
# some tests for buffer/format
# 029394d
(assert (= (string (buffer/format @"" "pi = %6.3f" math/pi)) "pi = 3.142")
@ -103,6 +151,7 @@
(assert (deep= @"bcde" (buffer/blit @"" a -1 1 5)) "buffer/blit 3")
(assert (deep= @"cde" (buffer/blit @"" a -1 2 5)) "buffer/blit 4")
(assert (deep= @"de" (buffer/blit @"" a -1 3 5)) "buffer/blit 5")
(assert (deep= @"de" (buffer/blit @"" a nil 3 5)) "buffer/blit 6")
# buffer/push-at
# c55d93512
@ -113,8 +162,20 @@
(assert (deep= @"abc423" (buffer/push-at @"abc123" 3 "4"))
"buffer/push-at 3")
# 4782a76
(assert (= 10 (do (var x 10) (def y x) (++ x) y)) "no invalid aliasing")
# buffer/format-at
(def start-buf (buffer/new-filled 100 (chr "x")))
(buffer/format-at start-buf 50 "aa%dbb" 32)
(assert (= (string start-buf) (string (string/repeat "x" 50) "aa32bb" (string/repeat "x" 44)))
"buffer/format-at 1")
(assert
(deep=
(buffer/format @"" "%j" [1 2 3 :a :b :c])
(buffer/format-at @"" 0 "%j" [1 2 3 :a :b :c]))
"buffer/format-at empty buffer")
(def buf @"xxxyyy")
(buffer/format-at buf -4 "xxx")
(assert (= (string buf) "xxxxxx") "buffer/format-at negative index")
(assert-error "expected index at to be in range [0, 0), got 1" (buffer/format-at @"" 1 "abc"))
(end-suite)

View File

@ -30,10 +30,12 @@
(assert (= 1 (brshift 4 2)) "right shift")
# unsigned shift
(assert (= 32768 (brushift 0x80000000 16)) "right shift unsigned 1")
(assert (= -32768 (brshift 0x80000000 16)) "right shift unsigned 2")
(assert-error "right shift unsigned 2" (= -32768 (brshift 0x80000000 16)))
(assert (= -1 (brshift -1 16)) "right shift unsigned 3")
# non-immediate forms
(assert (= 32768 (brushift 0x80000000 (+ 0 16))) "right shift unsigned non-immediate")
(assert (= -32768 (brshift 0x80000000 (+ 0 16))) "right shift non-immediate")
(assert-error "right shift non-immediate" (= -32768 (brshift 0x80000000 (+ 0 16))))
(assert (= -1 (brshift -1 (+ 0 16))) "right shift non-immediate 2")
(assert (= 32768 (blshift 1 (+ 0 15))) "left shift non-immediate")
# 7e46ead
(assert (< 1 2 3 4 5 6) "less than integers")
@ -44,8 +46,28 @@
(assert (<= 1.0 2.0 3.0 3.0 4.0 5.0 6.0) "less than or equal to reals")
(assert (>= 6 5 4 4 3 2 1) "greater than or equal to integers")
(assert (>= 6.0 5.0 4.0 4.0 3.0 2.0 1.0) "greater than or equal to reals")
(assert (= 7 (% 20 13)) "modulo 1")
(assert (= -7 (% -20 13)) "modulo 2")
(assert (= 7 (% 20 13)) "rem 1")
(assert (= -7 (% -20 13)) "rem 2")
(assert (= 7 (% 20 -13)) "rem 3")
(assert (= -7 (% -20 -13)) "rem 4")
(assert (nan? (% 20 0)) "rem 5")
(assert (= 7 (mod 20 13)) "mod 1")
(assert (= 6 (mod -20 13)) "mod 2")
(assert (= -6 (mod 20 -13)) "mod 3")
(assert (= -7 (mod -20 -13)) "mod 4")
(assert (= 20 (mod 20 0)) "mod 5")
(assert (= 1 (div 20 13)) "div 1")
(assert (= -2 (div -20 13)) "div 2")
(assert (= -2 (div 20 -13)) "div 3")
(assert (= 1 (div -20 -13)) "div 4")
(assert (= math/inf (div 20 0)) "div 5")
(assert (all = (seq [n :range [0 10]] (mod n 5 3))
(seq [n :range [0 10]] (% n 5 3))
[0 1 2 0 1 0 1 2 0 1]) "variadic mod")
(assert (< 1.0 nil false true
(fiber/new (fn [] 1))
@ -137,5 +159,23 @@
(assert-error "invalid offset-a: 1" (memcmp "a" "b" 1 1 0))
(assert-error "invalid offset-b: 1" (memcmp "a" "b" 1 0 1))
# Range
# a982f351d
(assert (deep= (range 10) @[0 1 2 3 4 5 6 7 8 9]) "(range 10)")
(assert (deep= (range 5 10) @[5 6 7 8 9]) "(range 5 10)")
(assert (deep= (range 0 16 4) @[0 4 8 12]) "(range 0 16 4)")
(assert (deep= (range 0 17 4) @[0 4 8 12 16]) "(range 0 17 4)")
(assert (deep= (range 16 0 -4) @[16 12 8 4]) "(range 16 0 -4)")
(assert (deep= (range 17 0 -4) @[17 13 9 5 1]) "(range 17 0 -4)")
(assert (= (length (range 10)) 10) "(range 10)")
(assert (= (length (range -10)) 0) "(range -10)")
(assert (= (length (range 1 10)) 9) "(range 1 10)")
# iterating over generator
(assert-no-error "iterate over coro 1" (values (generate [x :range [0 10]] x)))
(assert-no-error "iterate over coro 2" (keys (generate [x :range [0 10]] x)))
(assert-no-error "iterate over coro 3" (pairs (generate [x :range [0 10]] x)))
(end-suite)

View File

@ -21,42 +21,48 @@
(import ./helper :prefix "" :exit true)
(start-suite)
(def test-port (os/getenv "JANET_TEST_PORT" "8761"))
(def test-host (os/getenv "JANET_TEST_HOST" "127.0.0.1"))
# Subprocess
# 5e1a8c86f
(def janet (dyn :executable))
(def janet (dyn *executable*))
# Subprocess should inherit the "RUN" parameter for fancy testing
(def run (filter next (string/split " " (os/getenv "SUBRUN" ""))))
(repeat 10
(let [p (os/spawn [janet "-e" `(print "hello")`] :p {:out :pipe})]
(let [p (os/spawn [;run janet "-e" `(print "hello")`] :p {:out :pipe})]
(os/proc-wait p)
(def x (:read (p :out) :all))
(assert (deep= "hello" (string/trim x))
"capture stdout from os/spawn pre close."))
(let [p (os/spawn [janet "-e" `(print "hello")`] :p {:out :pipe})]
(let [p (os/spawn [;run janet "-e" `(print "hello")`] :p {:out :pipe})]
(def x (:read (p :out) 1024))
(os/proc-wait p)
(assert (deep= "hello" (string/trim x))
"capture stdout from os/spawn post close."))
(let [p (os/spawn [janet "-e" `(file/read stdin :line)`] :px
(let [p (os/spawn [;run janet "-e" `(file/read stdin :line)`] :px
{:in :pipe})]
(:write (p :in) "hello!\n")
(assert-no-error "pipe stdin to process" (os/proc-wait p))))
(let [p (os/spawn [janet "-e" `(print (file/read stdin :line))`] :px
(let [p (os/spawn [;run janet "-e" `(print (file/read stdin :line))`] :px
{:in :pipe :out :pipe})]
(:write (p :in) "hello!\n")
(def x (:read (p :out) 1024))
(assert-no-error "pipe stdin to process 2" (os/proc-wait p))
(assert (= "hello!" (string/trim x)) "round trip pipeline in process"))
(let [p (os/spawn [janet "-e" `(do (ev/sleep 30) (os/exit 24)`] :p)]
(let [p (os/spawn [;run janet "-e" `(do (ev/sleep 30) (os/exit 24)`] :p)]
(os/proc-kill p)
(def retval (os/proc-wait p))
(assert (not= retval 24) "Process was *not* terminated by parent"))
(let [p (os/spawn [janet "-e" `(do (ev/sleep 30) (os/exit 24)`] :p)]
(let [p (os/spawn [;run janet "-e" `(do (ev/sleep 30) (os/exit 24)`] :p)]
(os/proc-kill p false :term)
(def retval (os/proc-wait p))
(assert (not= retval 24) "Process was *not* terminated by parent"))
@ -66,7 +72,7 @@
(defn calc-1
"Run subprocess, read from stdout, then wait on subprocess."
[code]
(let [p (os/spawn [janet "-e" (string `(printf "%j" ` code `)`)] :px
(let [p (os/spawn [;run janet "-e" (string `(printf "%j" ` code `)`)] :px
{:out :pipe})]
(os/proc-wait p)
(def output (:read (p :out) :all))
@ -86,7 +92,7 @@
to 10 bytes instead of :all
``
[code]
(let [p (os/spawn [janet "-e" (string `(printf "%j" ` code `)`)] :px
(let [p (os/spawn [;run janet "-e" (string `(printf "%j" ` code `)`)] :px
{:out :pipe})]
(def output (:read (p :out) 10))
(os/proc-wait p)
@ -104,18 +110,18 @@
# a1cc5ca04
(assert-no-error "file writing 1"
(with [f (file/temp)]
(os/execute [janet "-e" `(repeat 20 (print :hello))`] :p {:out f})))
(os/execute [;run janet "-e" `(repeat 20 (print :hello))`] :p {:out f})))
(assert-no-error "file writing 2"
(with [f (file/open "unique.txt" :w)]
(os/execute [janet "-e" `(repeat 20 (print :hello))`] :p {:out f})
(os/execute [;run janet "-e" `(repeat 20 (print :hello))`] :p {:out f})
(file/flush f)))
# Issue #593
# a1cc5ca04
(assert-no-error "file writing 3"
(def outfile (file/open "unique.txt" :w))
(os/execute [janet "-e" "(pp (seq [i :range (1 10)] i))"] :p
(os/execute [;run janet "-e" "(pp (seq [i :range (1 10)] i))"] :p
{:out outfile})
(file/flush outfile)
(file/close outfile)
@ -189,11 +195,11 @@
(net/write stream b)
(buffer/clear b)))
(def s (net/server "127.0.0.1" "8000" handler))
(def s (net/server test-host test-port handler))
(assert s "made server 1")
(defn test-echo [msg]
(with [conn (net/connect "127.0.0.1" "8000")]
(with [conn (net/connect test-host test-port)]
(net/write conn msg)
(def res (net/read conn 1024))
(assert (= (string res) msg) (string "echo " msg))))
@ -202,7 +208,8 @@
(test-echo "world")
(test-echo (string/repeat "abcd" 200))
(:close s))
(:close s)
(gccollect))
# Test on both server and client
# 504411e
@ -212,18 +219,18 @@
# prevent immediate close
(ev/read stream 1)
(def [host port] (net/localname stream))
(assert (= host "127.0.0.1") "localname host server")
(assert (= port 8000) "localname port server")))
(assert (= host test-host) "localname host server")
(assert (= port (scan-number test-port)) "localname port server")))
# Test localname and peername
# 077bf5eba
(repeat 10
(with [s (net/server "127.0.0.1" "8000" names-handler)]
(with [s (net/server test-host test-port names-handler)]
(repeat 10
(with [conn (net/connect "127.0.0.1" "8000")]
(with [conn (net/connect test-host test-port)]
(def [host port] (net/peername conn))
(assert (= host "127.0.0.1") "peername host client ")
(assert (= port 8000) "peername port client")
(assert (= host test-host) "peername host client ")
(assert (= port (scan-number test-port)) "peername port client")
# let server close
(ev/write conn " "))))
(gccollect))
@ -256,7 +263,7 @@
(ev/cancel fiber "boop")
# f0dbc2e
(assert (os/execute [janet "-e" `(+ 1 2 3)`] :xp) "os/execute self")
(assert (os/execute [;run janet "-e" `(+ 1 2 3)`] :xp) "os/execute self")
# Test some channel
# e76b8da26
@ -341,5 +348,31 @@
(ev/go |(ev/chan-close ch))
(assert (= (ev/select [ch 1]) [:close ch]))
(end-suite)
# ev/gather check
(defn exec-slurp
"Read stdout of subprocess and return it trimmed in a string."
[& args]
(def env (os/environ))
(put env :out :pipe)
(def proc (os/spawn args :epx env))
(def out (get proc :out))
(def buf @"")
(ev/gather
(:read out :all buf)
(:wait proc))
(string/trimr buf))
(assert-no-error
"ev/with-deadline 1"
(assert (= "hi"
(ev/with-deadline
10
(exec-slurp ;run janet "-e" "(print :hi)")))
"exec-slurp 1"))
# valgrind-able check for #1337
(def superv (ev/chan 10))
(def f (ev/go |(ev/sleep 1e9) nil superv))
(ev/cancel f (gensym))
(ev/take superv)
(end-suite)

View File

@ -126,7 +126,7 @@
(assert (deep= (int/to-bytes (u64 300) :be buf2)
@"abcd\x00\x00\x00\x00\x00\x00\x01\x2C")))
# int/s64 and int/u64 paramater type checking
# int/s64 and int/u64 parameter type checking
# 6aea7c7f7
(assert-error
"bad value passed to int/to-bytes"
@ -171,22 +171,44 @@
(assert (not (even? (int/s64 "-1001"))) "even? 6")
# integer type operations
(defn modcheck [x y]
(assert (= (string (mod x y)) (string (mod (int/s64 x) y)))
(string "int/s64 (mod " x " " y ") expected " (mod x y) ", got "
(mod (int/s64 x) y)))
(assert (= (string (% x y)) (string (% (int/s64 x) y)))
(string "int/s64 (% " x " " y ") expected " (% x y) ", got "
(% (int/s64 x) y))))
(defn opcheck [int x y]
(each op [mod % div]
(assert (compare= (op x y) (op (int x) y))
(string int " (" op " " x " " y ") expected " (op x y)
", got " (op (int x) y)))
(assert (compare= (op x y) (op x (int y)))
(string int " (" op " " x " " y ") expected " (op x y)
", got " (op x (int y))))
(assert (compare= (op x y) (op (int x) (int y)))
(string int " (" op " " x " " y ") expected " (op x y)
", got " (op (int x) (int y))))))
(modcheck 1 2)
(modcheck 1 3)
(modcheck 4 2)
(modcheck 4 1)
(modcheck 10 3)
(modcheck 10 -3)
(modcheck -10 3)
(modcheck -10 -3)
(loop [x :in [-5 -3 0 3 5]
y :in [-4 -3 3 4]]
(opcheck int/s64 x y)
(if (and (>= x 0) (>= y 0))
(opcheck int/u64 x y)))
(each int [int/s64 int/u64]
(each op [% / div]
(assert-error "division by zero" (op (int 7) 0))
(assert-error "division by zero" (op 7 (int 0)))
(assert-error "division by zero" (op (int 7) (int 0)))))
(each int [int/s64 int/u64]
(loop [x :in [-5 -3 0 3 5] :when (or (pos? x) (= int int/s64))]
# skip check when comparing negative values with unsigned integers.
(assert (= (int x) (mod (int x) 0)) (string int " mod 0"))
(assert (= (int x) (mod x (int 0))) (string int " mod 0"))
(assert (= (int x) (mod (int x) (int 0))) (string int " mod 0"))))
(loop [x :in [-5 -3 0 3 5]]
(assert (compare= (bnot x) (bnot (int/s64 x))) "int/s64 bnot"))
(loop [x :range [0 10]]
(assert (= (int/u64 "0xFFFF_FFFF_FFFF_FFFF")
(bxor (int/u64 x) (bnot (int/u64 x))))
"int/u64 bnot"))
# Check for issue #1130
# 7e65c2bda
@ -246,13 +268,21 @@
# compare u64/i64
(assert (= (compare (u64 1) (i64 2)) -1) "compare 7")
(assert (= (compare (u64 1) (i64 -1)) +1) "compare 8")
(assert (= (compare (u64 -1) (i64 -1)) +1) "compare 9")
(assert (= (compare (u64 0) (i64 -1)) +1) "compare 9")
# compare i64/u64
(assert (= (compare (i64 1) (u64 2)) -1) "compare 10")
(assert (= (compare (i64 -1) (u64 1)) -1) "compare 11")
(assert (= (compare (i64 -1) (u64 -1)) -1) "compare 12")
(assert (= (compare (i64 -1) (u64 0)) -1) "compare 12")
# off by 1 error in inttypes
# a3e812b86
(assert (= (int/s64 "-0x8000_0000_0000_0000")
(+ (int/s64 "0x7FFF_FFFF_FFFF_FFFF") 1)) "int types wrap around")
(assert (= (int/s64 "0x7FFF_FFFF_FFFF_FFFF")
(- (int/s64 "-0x8000_0000_0000_0000") 1)) "int types wrap around")
# Issue #1217
(assert (= (- (int/u64 "0xFFFFFFFF") 1) (int/u64 "0xFFFFFFFE")) "u64 subtract")
(end-suite)

View File

@ -138,5 +138,13 @@ neldb\0\0\0\xD8\x05printG\x01\0\xDE\xDE\xDE'\x03\0marshal_tes/\x02
# XXX: still needed? see 72beeeea
(gccollect)
# ev/chan marshalling
(compwhen (dyn 'ev/chan)
(def chan (ev/chan 10))
(ev/give chan chan)
(def newchan (unmarshal (marshal chan)))
(def item (ev/take newchan))
(assert (= item newchan) "ev/chan marshalling"))
(end-suite)

View File

@ -21,6 +21,9 @@
(import ./helper :prefix "" :exit true)
(start-suite)
(def janet (dyn :executable))
(def run (filter next (string/split " " (os/getenv "SUBRUN" ""))))
# OS Date test
# 719f7ba0c
(assert (deep= {:year-day 0
@ -93,10 +96,22 @@
(assert (= (in buf 0) 0) "cryptorand doesn't overwrite buffer")
(assert (= (length buf) 2) "cryptorand appends to buffer"))
(assert-no-error "realtime clock" (os/clock))
(assert-no-error "realtime clock" (os/clock nil))
(assert-no-error "realtime clock" (os/clock nil nil))
# 80db68210
(assert-no-error (os/clock :realtime) "realtime clock")
(assert-no-error (os/clock :cputime) "cputime clock")
(assert-no-error (os/clock :monotonic) "monotonic clock")
(assert-no-error "realtime clock" (os/clock :realtime))
(assert-no-error "cputime clock" (os/clock :cputime))
(assert-no-error "monotonic clock" (os/clock :monotonic))
(assert-no-error "realtime clock double output" (os/clock nil :double))
(assert-no-error "realtime clock int output" (os/clock nil :int))
(assert-no-error "realtime clock tuple output" (os/clock nil :tuple))
(assert-error "invalid clock" (os/clock :a))
(assert-error "invalid output" (os/clock :realtime :b))
(assert-error "invalid clock and output" (os/clock :a :b))
(def before (os/clock :monotonic))
(def after (os/clock :monotonic))
@ -118,16 +133,30 @@
# os/execute with environment variables
# issue #636 - 7e2c433ab
(assert (= 0 (os/execute [(dyn :executable) "-e" "(+ 1 2 3)"] :pe
(assert (= 0 (os/execute [;run janet "-e" "(+ 1 2 3)"] :pe
(merge (os/environ) {"HELLO" "WORLD"})))
"os/execute with env")
# os/execute regressions
# 427f7c362
(for i 0 10
(assert (= i (os/execute [(dyn :executable) "-e"
(assert (= i (os/execute [;run janet "-e"
(string/format "(os/exit %d)" i)] :p))
(string "os/execute " i)))
(end-suite)
# os/execute IO redirection
(assert-no-error "IO redirection"
(defn devnull []
(def os (os/which))
(def path (if (or (= os :mingw) (= os :windows))
"NUL"
"/dev/null"))
(os/open path :w))
(with [dn (devnull)]
(os/execute [;run janet
"-e"
"(print :foo) (eprint :bar)"]
:px
{:out dn :err dn})))
(end-suite)

View File

@ -263,6 +263,9 @@
(marshpeg '(if-not "abcdf" 123))
(marshpeg ~(cmt "abcdf" ,identity))
(marshpeg '(group "abc"))
(marshpeg '(sub "abcdf" "abc"))
(marshpeg '(* (sub 1 1)))
(marshpeg '(split "," (+ "a" "b" "c")))
# Peg swallowing errors
# 159651117
@ -307,12 +310,12 @@
(check-deep '(uint 2) "\xff\x7f" @[0x7fff])
(check-deep '(uint-be 2) "\x7f\xff" @[0x7fff])
(check-deep '(uint-be 2) "\x7f\xff" @[0x7fff])
(check-deep '(uint 8) "\xff\x7f\x00\x00\x00\x00\x00\x00"
@[(int/u64 0x7fff)])
(check-deep '(int 8) "\xff\x7f\x00\x00\x00\x00\x00\x00"
@[(int/s64 0x7fff)])
(check-deep '(uint 7) "\xff\x7f\x00\x00\x00\x00\x00" @[(int/u64 0x7fff)])
(check-deep '(int 7) "\xff\x7f\x00\x00\x00\x00\x00" @[(int/s64 0x7fff)])
(when-let [u64 int/u64
i64 int/s64]
(check-deep '(uint 8) "\xff\x7f\x00\x00\x00\x00\x00\x00" @[(u64 0x7fff)])
(check-deep '(int 8) "\xff\x7f\x00\x00\x00\x00\x00\x00" @[(i64 0x7fff)])
(check-deep '(uint 7) "\xff\x7f\x00\x00\x00\x00\x00" @[(u64 0x7fff)])
(check-deep '(int 7) "\xff\x7f\x00\x00\x00\x00\x00" @[(i64 0x7fff)]))
(check-deep '(* (int 2) -1) "123" nil)
@ -367,7 +370,7 @@
(set "!$%&*+-./:<?=>@^_|"))
:token (some :symchars)
:hex (range "09" "af" "AF")
:escape (* "\\" (+ (set "ntrvzf0e\"\\")
:escape (* "\\" (+ (set `"'0?\abefnrtvz`)
(* "x" :hex :hex)
(error (constant "bad hex escape"))))
:comment (/ '(* "#" (any (if-not (+ "\n" -1) 1))) (constant :comment))
@ -660,5 +663,98 @@
(peg/match '(if (not (* (constant 7) "a")) "hello") "hello")
@[]) "peg if not")
(defn test [name peg input expected]
(assert (deep= (peg/match peg input) expected) name))
(test "sub: matches the same input twice"
~(sub "abcd" "abc")
"abcdef"
@[])
(test "sub: second pattern cannot match more than the first pattern"
~(sub "abcd" "abcde")
"abcdef"
nil)
(test "sub: fails if first pattern fails"
~(sub "x" "abc")
"abcdef"
nil)
(test "sub: fails if second pattern fails"
~(sub "abc" "x")
"abcdef"
nil)
(test "sub: keeps captures from both patterns"
~(sub '"abcd" '"abc")
"abcdef"
@["abcd" "abc"])
(test "sub: second pattern can reference captures from first"
~(* (constant 5 :tag) (sub (capture "abc" :tag) (backref :tag)))
"abcdef"
@[5 "abc" "abc"])
(test "sub: second pattern can't see past what the first pattern matches"
~(sub "abc" (* "abc" -1))
"abcdef"
@[])
(test "sub: positions inside second match are still relative to the entire input"
~(* "one\ntw" (sub "o" (* ($) (line) (column))))
"one\ntwo\nthree\n"
@[6 2 3])
(test "sub: advances to the end of the first pattern's match"
~(* (sub "abc" "ab") "d")
"abcdef"
@[])
(test "split: basic functionality"
~(split "," '1)
"a,b,c"
@["a" "b" "c"])
(test "split: drops captures from separator pattern"
~(split '"," '1)
"a,b,c"
@["a" "b" "c"])
(test "split: can match empty subpatterns"
~(split "," ':w*)
",a,,bar,,,c,,"
@["" "a" "" "bar" "" "" "c" "" ""])
(test "split: subpattern is limited to only text before the separator"
~(split "," '(to -1))
"a,,bar,c"
@["a" "" "bar" "c"])
(test "split: fails if any subpattern fails"
~(split "," '"a")
"a,a,b"
nil)
(test "split: separator does not have to match anything"
~(split "x" '(to -1))
"a,a,b"
@["a,a,b"])
(test "split: always consumes entire input"
~(split 1 '"")
"abc"
@["" "" "" ""])
(test "split: separator can be an arbitrary PEG"
~(split :s+ '(to -1))
"a b c"
@["a" "b" "c"])
(test "split: does not advance past the end of the input"
~(* (split "," ':w+) 0)
"a,b,c"
@["a" "b" "c"])
(end-suite)

View File

@ -198,5 +198,9 @@
(assert (= (test) '(1 ())) "issue #919")
(end-suite)
# Regression #1327
(def x "A")
(def x (if (= nil x) "B" x))
(assert (= x "A"))
(end-suite)

View File

@ -35,10 +35,5 @@
# c876e63
0xf&1fffFFFF
# off by 1 error in inttypes
# a3e812b86
(assert (= (int/s64 "-0x8000_0000_0000_0000")
(+ (int/s64 "0x7FFF_FFFF_FFFF_FFFF") 1)) "int types wrap around")
(end-suite)

View File

@ -292,5 +292,8 @@
[2 6 4 'z]])
"arg & inner symbolmap")
# 4782a76
(assert (= 10 (do (var x 10) (def y x) (++ x) y)) "no invalid aliasing")
(end-suite)

2
tools/format.sh Executable file → Normal file
View File

@ -1,4 +1,4 @@
#!/usr/bin/env bash
#!/usr/bin/env sh
# Format all code with astyle