1
0
mirror of https://github.com/janet-lang/janet synced 2025-10-27 21:57:41 +00:00

Compare commits

...

753 Commits

Author SHA1 Message Date
Calvin Rose
b5996f5f02 Update for 1.32.0 2023-10-14 19:48:20 -05: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
Calvin Rose
3a4d56afca Patch release. 2023-06-19 07:18:35 -05:00
Calvin Rose
63bb93fc07 Fix isatty code to not use functions only defined if ev is enabled. 2023-06-19 07:14:56 -05:00
Calvin Rose
5a39a04a79 Prepare for 1.29.0 release. 2023-06-19 06:48:33 -05:00
Calvin Rose
2fde34b519 Remove extra function call that cannot ever trigger. 2023-06-18 09:41:53 -05:00
Calvin Rose
1ef5c038db Merge pull request #1187 from CosmicToast/peg-boolean
peg: add support for "true" and "false" primitives to always/never match
2023-06-18 09:40:46 -05:00
Calvin Rose
e2459cfb47 Merge pull request #1185 from chris-chambers/macro-lints-fix
Fix order in which *macro-lints* is set during expansion
2023-06-18 09:39:25 -05:00
Calvin Rose
cfffc0bcf1 Merge pull request #1190 from primo-ppcg/if-let
update if-let
2023-06-18 09:38:44 -05:00
Calvin Rose
7272f43191 Merge pull request #1188 from primo-ppcg/if-let 2023-06-11 07:21:38 -05:00
primo-ppcg
2a7ea27bb7 do not expand false branch more than once
Fixes #1191
2023-06-11 19:15:48 +07:00
primo-ppcg
32c5b816ae use unquotes instead 2023-06-11 18:38:20 +07:00
Chloe Kudryavtsev
e54ea7a1d8 fixup! peg: add support for "true" and "false" primitives to always/never match 2023-06-11 12:38:40 +02:00
primo-ppcg
1077efd03a update if-let
Fixes #1189
2023-06-11 17:19:29 +07:00
Chloe Kudryavtsev
f9ab91511d peg: add support for "true" and "false" primitives to always/never match
The use cases involve user-expandable grammars.
For example, consider the IRC nickname specification.
> They SHOULD NOT contain any dot character ('.', 0x2E).
> Servers MAY have additional implementation-specific nickname restrictions.

To implement this, we can do something along these lines:
```janet
(def nickname @{:main '(some :allowed)
                :allowed (! (+ :forbidden/dot :forbidden/user))
	        # for lax mode, (put nickname :forbidden/dot false)
	        :forbidden/dot "."
		# to add your own requirements
		# (put nickname :forbidden/user 'something)
		:forbidden/user false})
```

Additionally, it's common in parsing theory to allow matches of the
empty string (epsilon). `true` essentially allows for this.

Note that this does not strictly add new functionality, you could
emulate this previously using `0` and `(! 0)` respectively, but this
should be faster and more intuitive.
The speed improvement primarily comes from `(! 0)` which is now a single
step.
2023-06-11 10:44:39 +02:00
primo-ppcg
2c3ca2984e simplify if-let logic 2023-06-11 12:09:58 +07:00
primo-ppcg
94722e566c if-let better test coverage 2023-06-11 12:07:13 +07:00
Christopher Chambers
163f7ee85d Add test for maclintf in nested macro invocations 2023-06-10 16:52:20 -04:00
Christopher Chambers
52d3470cbe Fix order in which *macro-lints* is set during expansion
Previously, `*macro-lints*` was set after the `macroexpand1` fiber was
resumed, rather than just before.  And, `*macro-lints*` was never
cleared.  This behavior was typically fine since the main users of
`compile` pass the same lint array repeatedly, and the first macro
expansion (somewhere in boot.janet) never produces a lint.  But, when
compiling with a fresh lint array, if the first macro invocation
produced a lint, the lint was always lost.
2023-06-09 12:53:10 -04:00
Calvin Rose
0bd6e85c61 update changelog 2023-06-08 19:54:01 -05:00
Calvin Rose
e35c6b876f Merge pull request #1183 from primo-ppcg/take-drop
Make take and drop more symmetric
2023-06-08 14:52:51 -05:00
Calvin Rose
9a2897e741 Run through astyle with manual corrections 2023-06-08 13:01:49 -05:00
primo-ppcg
70b2e8179d nitpick performance tweak 2023-06-08 23:57:07 +07:00
primo-ppcg
5317edc65d minor readability change
As suggested by @sogaiu

@zevv forget to push this change in a recent PR (https://github.com/janet-lang/janet/pull/1175#issuecomment-1576128152).

Incidentally, the affected lines were already reformatted in the current PR, via fmt/format-file.
2023-06-08 23:00:05 +07:00
Calvin Rose
866d83579e Address #1165 - Allow for partial ffi support without totally removing testing.
Query at runtime which calling conventions are supported, including
a placeholder :none.
2023-06-08 09:07:16 -05:00
primo-ppcg
a238391b36 take-drop performance tweaks
Increase efficiency for `take` and `drop` with slices.
Check indexed types before bytes types.
2023-06-08 14:50:37 +07:00
Calvin Rose
5e152d30db Merge pull request #1182 from chris-chambers/channel-close-resumptions 2023-06-07 17:15:45 -05:00
Christopher Chambers
57c954783d Fix resumption values when closing a channel.
When suspended in `ev/give` or `ev/take`, closing the channel should
cause the result of `ev/give` or `ev/take` to be `nil`.

When suspended in `ev/select`, closing the channel should cause the
result of `ev/select` to be `[:close ch]`.

The results were flipped before.
2023-06-07 15:01:56 -04:00
primo-ppcg
b5407ac708 take-drop dictionaries
Return table for `take` of dictionary types.
Allow `drop` of dictionary types.
2023-06-07 19:20:05 +07:00
primo-ppcg
472ec730b5 take-drop symmetry
Allow `take` from the end of bytes or indexed (as `drop` does).
Allow `drop` from fibers (as `take` does).
2023-06-07 18:12:36 +07:00
Calvin Rose
8c819b1f91 Update README.md 2023-06-05 12:55:08 -05:00
Calvin Rose
528a516390 Add more sandbox capabilities.
Add more granularity to ffi sandbox capabilities - distinguish between
using FFI functions, creating FFI functions, and creating executable
memory.
2023-06-04 18:48:34 -05:00
Calvin Rose
6509e37c84 Update CHANGELOG.md and README.md 2023-06-04 16:11:17 -05:00
Calvin Rose
649173f661 Merge pull request #1175 from zevv/quicky
Added JANET_NO_AMALG flag to Makefile
2023-06-04 14:24:35 -05:00
Calvin Rose
1efb0adb35 Add 3 argument form to fiber/new
Allow passing in environment table at fiber creation since
it is a fairly common thing to do.
2023-06-04 14:17:18 -05:00
Calvin Rose
88a8e2c1df Define *task-id* since it is part of the event-loop runtime. 2023-06-04 14:05:37 -05:00
Ico Doornekamp
bb4ff05d35 Added NO_AMALG flag to Makefile to build janet from the individual
source files instead of from the amalgamated janet.c; this considerably
speeds up parallel builds on modern CPUs
2023-06-04 20:02:47 +02:00
Calvin Rose
dd3b601c87 Don't do fiber double arity check. 2023-06-04 12:56:03 -05:00
Calvin Rose
e22d101a62 Merge pull request #1179 from zevv/zevv-tests
Added misc tests to increase test coverage
2023-06-04 12:53:43 -05:00
Calvin Rose
4b3c813f5a Revert to old behavior of janet_fiber returning NULL.
When there is a bad arity function passed in to the fiber
constructor, return NULL so the runtime can choose what to do.
This is not the prettiest API but does work, and gives better error
messages for instance in the compiler.
2023-06-04 11:21:52 -05:00
Calvin Rose
67f375bea2 Small code style change to boot.janet 2023-06-04 11:10:39 -05:00
Calvin Rose
88ba99b87e Merge pull request #1181 from chris-chambers/ev-gather-cancel
Ensure ev/gather fibers are fully canceled on error
2023-06-04 11:10:24 -05:00
Christopher Chambers
53447e9d0b Ensure ev/gather fibers are fully canceled on error. 2023-06-04 10:49:30 -04:00
Calvin Rose
c4c86f8671 Run boot.janet through janet-format. 2023-06-03 16:47:59 -05:00
Calvin Rose
658941d26d Fix macro declaration. 2023-06-03 14:24:41 -05:00
Calvin Rose
e4bf27b01c Macro hack for meson-min build. 2023-06-03 14:22:16 -05:00
Calvin Rose
7d48b75f81 Update README.md 2023-06-03 14:19:02 -05:00
Calvin Rose
5f56bf836c Update meson.build file. 2023-06-03 13:55:49 -05:00
Ico Doornekamp
c0f5f97ddb Added misc tests to increase test coverage 2023-06-03 19:06:51 +02:00
Calvin Rose
15177ac2e9 Merge pull request #1162 from sogaiu/reorg-tests-new
Reorganize tests
2023-06-03 08:01:34 -05:00
Calvin Rose
8360bc93ac Merge pull request #1177 from zevv/zevv-isatty
added os/isatty, do not enable colors if stdout is not a tty
2023-06-03 07:58:16 -05:00
Ico Doornekamp
e0ea844d50 added os/isatty, do not enable colors if stdout is not a tty 2023-06-02 16:59:54 +02:00
sogaiu
9675411f35 Reorganize tests 2023-06-02 07:04:07 +09:00
Calvin Rose
e97299fc65 Fix #1174 - bad debug info causing stack traversal to segfault.
Coming from commit 77189b6e66, relating
to changes in source mapping debug info, this caused a segfault when
traversing a stack frame where the birth_pc was incredibly large due
to wrap around. This fix prevents the wrap around and does saturating
subtraction to 0.
2023-06-01 13:01:59 -05:00
Calvin Rose
26a113927e Add handling for new bytecode optimizations. 2023-06-01 12:47:59 -05:00
Calvin Rose
d0aa7ef590 Add a few asserts to quiet some of the -fanalyze calls in gcc 13. 2023-06-01 10:52:34 -05:00
Calvin Rose
5de889419f Rename contains? and contains-key? to has-value? and has-key?
Shorten docstrings to be less like a tutorial. They get put into RAM
and memory ain't free.
2023-05-31 22:35:57 -05:00
Calvin Rose
0fcbda2da7 Merge pull request #1017 from Techcable/feature/helper-func-contains
Add `contains?` helper function to boot.janet
2023-05-31 22:28:41 -05:00
Calvin Rose
14e33c295f Make clock tests less fragile for CI. 2023-05-31 22:21:12 -05:00
Calvin Rose
644ac8caf8 Add compiler optimizations for #1163 - eachp
Should result in much better bytecode in the simple case.
2023-05-31 12:26:27 -05:00
Calvin Rose
77189b6e66 Fix some symbol mapping inside nested functions. 2023-05-31 08:19:24 -05:00
Calvin Rose
4f8f7f66ee Merge branch 'bytecode_opt' 2023-05-31 07:57:13 -05:00
Calvin Rose
b099bd97f2 Merge branch 'master' into bytecode_opt 2023-05-30 18:13:02 -05:00
Calvin Rose
961c6ea15a Merge pull request #1172 from zevv/windows-recvfrom
fix for crash on windows in src/core/ev.c: initialze state->fromlen
2023-05-30 16:54:24 -05:00
Calvin Rose
9c97d8f648 Merge pull request #1171 from zevv/zevv-net-connect
Fixed net/connect binding address
2023-05-30 16:53:24 -05:00
Ico Doornekamp
ad7bf80611 fix for crash on windows in src/core/ev.c: initialze state->fromlen
before doing WSARecvFrom() to prevent crash (likely caused by the
memcpy() of `state->from` at line
2301 with the memcpy length set to -1)
2023-05-30 19:33:34 +02:00
Ico Doornekamp
40080b23ae Fixed net/connect binding address 2023-05-30 16:57:17 +02:00
Calvin Rose
7acb5c63e0 Remove bad windows10 check. 2023-05-29 18:17:22 -05:00
Calvin Rose
fcca9bbab3 Add recursion to the pruning optimization. 2023-05-29 18:05:14 -05:00
Calvin Rose
dbb2187425 Merge pull request #1167 from zevv/janet-formatbf-fix
Fix janet_formatbv() type when handling %d %u int specifiers
2023-05-29 18:03:13 -05:00
Calvin Rose
82e51f9e81 Merge pull request #1169 from zevv/fix-buffer-push-at-doc
Updated documentation for buffer/push-at
2023-05-29 18:02:05 -05:00
Calvin Rose
4782a76bca Add inital bytecode optimizations for #1163
This removes unnecessary movn, movf, lds, and a few other instructions.
Any instructions that has not side effects and writes to a slot that
isn't used can be removed. A number of other optimizations can follow
from this:

- Implement the def-aliasing-var optimization better
- This function can be iterated as a fix point until no more
  instructions are removed.
- If we implement slot renaming, then we no longer need to free slots
  and can simplify the initial code generation a lot.
2023-05-29 16:10:48 -05:00
Ico Doornekamp
d13788a4ed Updated documentation for buffer/push-at 2023-05-29 22:03:37 +02:00
Ico Doornekamp
e64a0175b1 change janet_formatbv() to handle int/unsigned int instead of long/unsigned long on '%d' and '%u' format specifiers. 2023-05-29 19:50:14 +02:00
Calvin Rose
4aca94154f Be more selective when testing FFI.
In the future, we really should get more FFI testing for
partially supported FFI on various platforms.
2023-05-28 15:28:17 -05:00
Calvin Rose
ac5f118dac Merge pull request #1164 from dressupgeekout/janet_h_symlink
More portable method of installing janet.h -> janet/janet.h symlink
2023-05-28 15:22:12 -05:00
Charlotte Koch
a2812ec5eb More portable method of installing janet.h -> janet/janet.h symlink 2023-05-27 14:22:11 -07:00
Calvin Rose
70f13f1b62 Merge pull request #1157 from zevv/file-lines
Add file/lines iterator
2023-05-26 18:16:14 -05:00
Calvin Rose
77e62a25cb Merge pull request #1160 from primo-ppcg/mapcat-et-al
Allow mapcat et al to accept multiple iterable arguments
2023-05-26 18:15:09 -05:00
Ico Doornekamp
09345ec786 file/linex now only acceps a file, not a path name 2023-05-26 17:50:26 +02:00
primo-ppcg
bad73baf98 Add test cases for variadic arguments to map-like functions 2023-05-26 19:08:00 +07:00
primo-ppcg
3602f5aa5d Update boot.janet
`kvs` is not yet defined at this point.
2023-05-25 18:27:31 +07:00
primo-ppcg
672b705faf Allow mapcat et al to accept multiple iterable arguments
#1159
2023-05-25 18:12:38 +07:00
Ico Doornekamp
64e3cdeb2b Add file/lines iterator 2023-05-24 16:54:04 +02:00
Calvin Rose
909c906080 Fix yields inside nested fibers. 2023-05-23 20:09:46 -05:00
Calvin Rose
71bde11e95 Allow one argument to while. 2023-05-23 20:09:46 -05:00
Calvin Rose
fc20fbed92 Merge pull request #1151 from zevv/document-string-format
Add docstring to string/format
2023-05-23 18:57:55 -05:00
Calvin Rose
e6b7c85c37 Merge pull request #1152 from zevv/error-messages
Improved various error messages when handling unexpected types.
2023-05-23 18:57:20 -05:00
Ico Doornekamp
b3a92363f8 Add docstring to string/format 2023-05-23 07:21:26 +02:00
Ico Doornekamp
e9f2d1aca7 changed some error messages 'x|y' -> 'x or y' 2023-05-23 06:58:52 +02:00
Ico Doornekamp
b4e3dbf331 Improved various error messages when handling unexpected types.
error: bad slot #1, expected string|symbol|keyword|buffer, got ...
error: bad slot #1, expected a string, symbol, keyword or buffer, got ...

bad s64 initializer: "donkey"
can not convert string "donkey" to s64
2023-05-23 06:57:12 +02:00
Calvin Rose
c3620786cf Merge branch 'master' of github.com:janet-lang/janet 2023-05-22 20:41:05 -05:00
Calvin Rose
41943746e4 Fix #1149 - deep-not= should only return true/false.
Also improve perf at same time.
2023-05-22 20:40:30 -05:00
Calvin Rose
176e816b8c Merge pull request #1153 from zevv/fix-warning
Fix warning in janet_gettime()
2023-05-22 18:46:55 -05:00
Ico Doornekamp
50a19bd870 Fix warning in janet_gettime() 2023-05-22 20:53:03 +02:00
Calvin Rose
57b751b994 Merge branch 'master' of github.com:janet-lang/janet 2023-05-21 16:23:44 -05:00
Calvin Rose
77732a8f44 inet_test change. 2023-05-21 13:36:11 -05:00
Calvin Rose
c47c2e538d Merge pull request #1137 from tionis/master
os/proc-kill now accepts an optional signal to send
2023-05-21 13:33:24 -05:00
Calvin Rose
cc5545277d Merge pull request #1147 from zevv/error-messages
improved error messages for special forms
2023-05-21 13:31:06 -05:00
Ico Doornekamp
63353b98cd improved error messages for special forms 2023-05-21 20:18:32 +02:00
tionis
4dfc869b8a fixed formatting in src/core/os.c 2023-05-21 15:55:11 +02:00
tionis
b4b1c7d80b Merge branch 'janet-lang:master' into master 2023-05-21 13:51:24 +00:00
tionis
e53c03028f ignoring signals on windows in os/proc-kill again 2023-05-21 15:50:15 +02:00
Calvin Rose
8680aef42f Merge pull request #1146 from zevv/os-clock
Add  clock sources to os/clock (:realtime, :monotonic, :cputime)
2023-05-21 08:35:24 -05:00
Calvin Rose
c3fd71d643 Merge pull request #1142 from tionis/thaw
added thaw to complement freeze
2023-05-21 08:09:47 -05:00
Ico Doornekamp
30c47d685d Fixed :cputime because msdn does not implement clock() properly 2023-05-21 07:29:27 +02:00
Ico Doornekamp
80db682109 Added tests for os/clock 2023-05-21 07:29:27 +02:00
Ico Doornekamp
e8e5f66f4c Implement janet_gettime() for win32 and macos; need testing 2023-05-21 07:29:27 +02:00
Ico Doornekamp
aaf3d08bcd Added 'source' argument to os/clock to select the clock source 2023-05-21 07:29:27 +02:00
Ico Doornekamp
61132d6c40 os/time and janet_gettime now use CLOCK_MONOTONIC instead of CLOCK_REALTIM, this matches the description from the documentation of os/clock. Fixes issue #1144 2023-05-21 07:29:27 +02:00
tionis
9cc0645a1e added test for thaw and freeze 2023-05-20 17:35:25 +02:00
Calvin Rose
fc8c6a429e Modulo should not be variadic. 2023-05-20 07:45:18 -05:00
Calvin Rose
2f966883d9 Fix #1145 - variadic imperative arith. macros.
Also update CHANGELOG
2023-05-20 07:42:50 -05:00
tionis
320ba80ca1 added support for tables/structs with prototypes in thaw 2023-05-20 14:00:33 +02:00
Calvin Rose
b621d4dd2e Merge pull request #1139 from zevv/async-connect
changed net/connect to be non-blocking / asynchronous
2023-05-19 21:12:16 -05:00
tionis
56d927c72d added thaw to complement freeze 2023-05-19 21:18:54 +02:00
tionis
53afc2e50a Merge branch 'janet-lang:master' into master 2023-05-19 19:14:12 +00:00
Ico Doornekamp
89debac8f6 Fixed janet_loop1_impl stream use after dealloc 2023-05-19 20:00:59 +02:00
Calvin Rose
f2197fa2d8 Merge pull request #1141 from zevv/mingw-test
Add CI test for mingw/wine on linux
2023-05-19 07:25:47 -05:00
Ico Doornekamp
a6a097c111 Add CI test for mingw/wine on linux 2023-05-18 15:15:41 +02:00
Ico Doornekamp
c3e28bc924 added deferred closing of streams after async connect() fails 2023-05-18 14:10:22 +02:00
Ico Doornekamp
8d78fb1f6b changed net/connect to be non-blocking / asynchronous 2023-05-18 10:55:48 +02:00
Calvin Rose
148917d4ca Move -g to CFLAGS to make it easier to remove/customize 2023-05-16 21:10:18 -05:00
Calvin Rose
d8cf9bf942 Merge pull request #1140 from zevv/debug-symbols
Enable debug symbols in janet binary; strip target at 'make install'
2023-05-16 21:08:12 -05:00
Calvin Rose
d6f5a060ed Squashed commit of the following:
commit 725b8749464895e21c761f1c5479692335282f62
Author: Calvin Rose <calsrose@gmail.com>
Date:   Tue May 16 20:58:34 2023 -0500

    Update header file.

commit 38bf2a5131
Author: Calvin Rose <calsrose@gmail.com>
Date:   Tue May 16 19:43:22 2023 -0500

    Run experiment on bsd.
2023-05-16 21:00:31 -05:00
Calvin Rose
692b6ef8ac Merge pull request #1138 from zevv/setsockopt
add net/setsockopt
2023-05-16 19:29:25 -05:00
Ico Doornekamp
ac5f1fe1be enable debug symbols in janet binary; strip target at 'make instal' 2023-05-16 19:48:18 +02:00
tionis
0f35acade1 use SIGTERM for os/proc-kill signal test 2023-05-16 18:47:38 +02:00
tionis
56d72ec4c5 support sending signals to processes on windows 2023-05-16 17:07:51 +02:00
tionis
71d51c160d added simple test for signal handling in os/proc-kill using :kill 2023-05-16 13:27:52 +02:00
tionis
0b58e505ee os/proc-kill now accepts an optional signal to send 2023-05-16 00:44:19 +02:00
Ico Doornekamp
2a6c615bec features.h: define _DARWIN_C_SOURCE for __APPLE__ 2023-05-15 16:55:09 +02:00
Ico Doornekamp
ab8c5a0b5f net/setsockopt optname symbols are now lower case 2023-05-15 15:25:09 +02:00
Ico Doornekamp
68c35feaea Formatting 2023-05-15 12:33:37 +02:00
Ico Doornekamp
88d0c2ca0f add net/setsockopt 2023-05-15 12:15:36 +02:00
Calvin Rose
398833ebe3 Enable FFI module unconditionally. 2023-05-14 09:18:54 -05:00
Calvin Rose
358f5a03bf Version bump to 1.28.0 2023-05-13 09:59:55 -05:00
Calvin Rose
fba1fdabe4 Update short-fn to fix #1123
Symbols are renamed on expansion to avoid the issue.
2023-05-13 09:44:30 -05:00
Calvin Rose
d42afd21e5 Merge branch 'master' of github.com:janet-lang/janet 2023-05-12 19:08:35 -05:00
Calvin Rose
20ada86761 Fix NAN typo. 2023-05-12 19:08:26 -05:00
Calvin Rose
3b353f1855 Merge pull request #1133 from zevv/cross
Updated Makefile for better cross-compilation support.
2023-05-12 08:41:54 -05:00
Calvin Rose
1467ab4f93 Copy paste error. 2023-05-11 20:56:12 -05:00
Calvin Rose
7e65c2bdad Fix #1130 - mod flipped for signed integers. 2023-05-11 18:15:37 -05:00
Calvin Rose
84a4e3e98a Update CHANGELOG.
and format.
2023-05-11 18:03:38 -05:00
Calvin Rose
bcbeedb001 Merge pull request #1128 from zevv/master
Added os.strftime()
2023-05-11 18:01:39 -05:00
Calvin Rose
e04b103b5d Merge pull request #1134 from CosmicToast/const_sourceline
Make JANET_FN_S* sourceline const
2023-05-11 17:59:27 -05:00
Chloe Kudryavtsev
ac75b94679 Make JANET_FN_S* sourceline const
Otherwise attempts to use it on some platforms cause the following error
`error: initializer element is not a compile-time constant`
when attempting to use the corresponding `JANET_REG`.
2023-05-11 16:07:34 -04:00
Ico Doornekamp
d3bb06cfd6 Updated Makefile for better cross-compilation support.
Building janet requires janet_boot to be run on the host at build time;

- $(UNAME) can now be overridden from the make cmdline
- Added $(RUN) variable to allow a emulator to be specified
- Added ".exe" extension to binaries when using MINGW

Examples:

Cross compiling for win32 and running under wine:

```
make test \
       CC=i686-w64-mingw32-gcc \
       LD=i686-w64-mingw32-gcc \
       UNAME=MINGW \
       RUN=wine

Janet 1.27.0-ad7c3bed mingw/x86/gcc - '(doc)' for help
```

Cross compiling for aarch64 and running under qemu:

```
make repl \
        CC=aarch64-none-linux-gnu-gcc \
        LD=aarch64-none-linux-gnu-gcc \
        RUN="qemu-aarch64 -L /tmp/aarch64/"

Janet 1.27.0-ad7c3bed linux/aarch64/gcc - '(doc)' for help
```
2023-05-11 07:46:36 +02:00
Ico Doornekamp
5cd729c4c1 Added os.strftime() 2023-05-11 06:08:19 +02:00
Calvin Rose
c9fd2bdf39 Merge branch 'master' of github.com:janet-lang/janet 2023-05-10 18:46:42 -05:00
Calvin Rose
e4be5992b3 Address issue with #1131 2023-05-10 18:43:33 -05:00
Calvin Rose
2ac4988f1b Merge pull request #1124 from sogaiu/tweak-ev-select-docstring
Tweak ev/select docstring
2023-05-08 04:17:25 -05:00
Calvin Rose
19f14adb9e Update changelog. 2023-05-07 21:07:22 -05:00
Calvin Rose
86de039492 Merge branch 'master' of github.com:janet-lang/janet 2023-05-07 11:54:20 -05:00
Calvin Rose
2360164e4f Address #1125 - fix ev/select to only take and release locks once.
By take and releasing locks twice per channel in the case where nothing
is reading, there was an opportunity for ev/select to hang in the
multithreaded case. Also silence valgrind/helgrind errors.
2023-05-07 11:54:06 -05:00
Calvin Rose
c93ddceadb Merge pull request #1122 from CosmicToast/getcbytes
Add get/opt cbytes
2023-05-07 10:33:09 -05:00
sogaiu
cd19dec44a Tweak ev/select docstring 2023-05-07 22:22:33 +09:00
Chloe Kudryavtsev
53ba9c800a Add get/opt cbytes
Like getcstring, but operates on a byteview.
When writing bindings (i.e what capi.c is primarily used for), it's
common to want to accept a buffer *or* a string rather than just
a string.
For this, a byteview is perfect (and why not accept keywords while
you're at it?).
However, there's no built-in function for getting a cstring out of
a byteview, this adds one.
This also reformulates getcstring to be an edge-case of getcbytes
(simply adding an explicit check for stringness).
2023-05-06 22:13:53 -04:00
Calvin Rose
cabbaded68 Add support for the NO_COLOR environment variable. 2023-05-06 16:33:45 -05:00
Calvin Rose
9bb589f827 update readme 2023-05-06 15:56:27 -05:00
Calvin Rose
c3a06686c2 Merge branch 'shell-win-feature-check' 2023-05-06 15:53:02 -05:00
Calvin Rose
7d57f87007 Address #1121 - disallow extra splices.
This turns splices that are ignored into compiler errors. Other
alternatives here should also be considered, for example making this
a compiler warning rather than an error. For example, the latest
spork as of a3ee63c137ee3234987dbbca71b566994ff8ae8c has an error of this
kind, but the resulting program does work correctly.

Also disallow splice propagation - code of the
form (+ 1 (do ;[2 3 4]) 5).
2023-05-06 13:12:31 -05:00
Calvin Rose
4cc4a9d38b (and ... <truthy-value> true) will return true as per docs. 2023-05-06 10:16:05 -05:00
Calvin Rose
02c7cd0194 Merge pull request #1116 from sogaiu/tweak-long-string-peg
Tweak long-string|bytes peg in test suite files
2023-04-30 16:21:12 -05:00
Calvin Rose
696efcb9e2 Add header file. 2023-04-30 12:19:55 -05:00
Calvin Rose
6e9cde8ac1 Add feature check for windows version shell.c
Tried to get console working on windows 7 and below
2023-04-30 10:36:42 -05:00
sogaiu
a9fae49671 Tweak long-string|bytes peg in test suite files 2023-04-30 21:55:43 +09:00
Calvin Rose
440af9fd64 Remove extra allocation in drop. 2023-04-24 09:41:33 -05:00
Calvin Rose
347721ae40 Fix macos behavior - Closes #1097, Fixes #1015 2023-04-24 09:37:49 -05:00
Calvin Rose
daea91044c Give different names to the user9 and user8 fiber statuses.
These now have semantic menaings that are pretty difficult to
work around. Code that tries to maniuplate user8 and user9 signals
right now may be affected
2023-04-24 09:19:15 -05:00
Calvin Rose
4ed3f2c662 Merge pull request #1114 from ianthehenry/drop-from-end
drop with a negative count now drops from the end
2023-04-24 09:16:10 -05:00
Calvin Rose
3641c8f60a Merge pull request #1108 from wackbyte/read
README grammar and formatting changes
2023-04-24 09:15:07 -05:00
Calvin Rose
e4b68cd940 Merge pull request #1109 from wackbyte/remove-double-space
Remove double space in help message
2023-04-24 09:11:45 -05:00
Calvin Rose
b8c936e2fe Merge pull request #1113 from ianthehenry/catseq
add catseq
2023-04-24 09:07:38 -05:00
Calvin Rose
83cd519702 Merge pull request #1112 from ianthehenry/dynamic-replace
string and peg replacement functions can now take functions
2023-04-24 09:07:03 -05:00
Ian Henry
54b54f85f3 drop with a negative count now drops from the end 2023-04-23 21:39:14 -07:00
Ian Henry
ccd874fe4e add catseq 2023-04-23 21:20:01 -07:00
Ian Henry
9dc7e8ed3a peg replacement functions have access to captures
When peg/replace or peg/replace-all are given a function to serve as the text
replacement, any captures produced by the PEG are passed as additional
arguments to that function.
2023-04-23 09:15:46 -07:00
Ian Henry
485099fd6e string and peg replacement functions can now take functions
Functions will be invoked with the matched text, and their result will be
coerced to a string and used as the new replacement text.

This also allows passing non-function, non-byteviewable values, which will be
converted into strings during replacement (only once, and only if at least
one match is found).
2023-04-23 08:36:17 -07:00
wackbyte
d359c6b43e Remove double space in help message 2023-04-22 21:46:24 -04:00
Calvin Rose
d9ed7a77f8 Merge pull request #1106 from CosmicToast/1105
handle null-byte case in scanformat (fixes #1105)
2023-04-22 15:25:48 -05:00
wackbyte
4238a4ca6a README grammar and formatting changes 2023-04-20 21:06:33 -04:00
Chloe Kudryavtsev
0902a5a981 improve null format handling
there was a request to improve the error message, but the whole function
has non-informative errors. (both functions, actually, since the code is
duplicated)
as such, instead of catching it directly, address the assumption that
led to the SIGSEGV and let it be caught by the functions themselves,
thus reusing existing error messages (which can then be improved
separately).
2023-04-20 11:51:11 -04:00
Chloe Kudryavtsev
f3192303ab check for NULL in get_fmt_mapping (fixes #1105)
When there is no format to be found after a %, get_fmt_mapping returns
NULL. It then gets called against strlen, which is a typical SEGV.
Check for NULL aginst mapping, which signals a null format being
specified.
2023-04-19 12:55:25 -04:00
Calvin Rose
bef5bd72c2 Merge pull request #1095 from ml-2/ml
Add `keep-syntax` and `keep-syntax!` functions
2023-04-08 10:46:47 -05:00
ML
b6175e4296 Add keep-syntax and keep-syntax! functions
These functions are designed to make it easier to properly preserve the
sourcemap and tuple type in macros. This commit also modifies the threading
macros to make use of these functions.
2023-04-07 21:09:52 -04:00
Calvin Rose
3858b2e177 Add ev/all-tasks to get running and pending root fibers. 2023-04-01 18:57:13 -05:00
Calvin Rose
9a76e77981 Update for undefined behavior sanitizer. 2023-03-24 18:49:21 -05:00
Calvin Rose
8182d640cd Merge branch 'master' of github.com:janet-lang/janet 2023-03-12 10:33:06 -05:00
Calvin Rose
1c6fda1a5c Address #1076 - unexpected shadowing behavior
While the old behavior was reasonable, it is not spelled out anywhere
in the documentation and was incidental rather than intentional.
Parameters of the same name of the function should probably take
precedence on name collision, following the principle of least surprise.
2023-03-12 10:30:59 -05:00
Calvin Rose
c51db1cf2f Merge pull request #1081 from ianthehenry/log-gamma-docstring
remove quotes in math/log-gamma docstring
2023-03-12 10:17:51 -05:00
Ian Henry
4e7930fc4c remove quotes around log-gamma 2023-03-11 12:26:45 -08:00
Calvin Rose
3563f8ccdb Merge pull request #1079 from dressupgeekout/charlotte_dragonfly
Some basic fixes for DragonFly
2023-03-08 15:05:51 -06:00
Charlotte Koch
575af763f6 os/which can return :dragonfly
While here, document that :bsd is another possible return value.
2023-03-07 06:45:31 -08:00
Charlotte Koch
8b16b9b246 Need to enable __BSD_VISIBLE on DragonFly in conjunction with -std=c99 2023-03-07 06:40:58 -08:00
Calvin Rose
01aab66667 Prepare for 1.27.0 release. 2023-03-05 09:48:25 -06:00
Calvin Rose
aa5c987a94 Change semantics of bracketed tuple equality.
Comparison between different bracket and normal tuples
will now take into account the delimiter type. This solves strange
non-locality issues in the compiler due to this false equality, and is
more consistent with Janet's otherwise strong equality philosophy.
2023-03-03 18:24:02 -06:00
Calvin Rose
75229332c8 Merge pull request #1075 from sogaiu/math-rng-int-docs
Tweak math/rng-int docs
2023-03-03 18:09:11 -06:00
sogaiu
9d5b1ba838 Tweak math/rng-int docs 2023-02-24 19:55:47 +09:00
Calvin Rose
f27b225b34 Merge pull request #1072 from sogaiu/ftell
Add file/tell
2023-02-21 07:13:00 -06:00
sogaiu
3c523d66e9 Add file/tell 2023-02-21 20:19:17 +09:00
Calvin Rose
1144c27c54 Merge pull request #1071 from ianthehenry/number-pegfault
fix a segfault in the (number) special
2023-02-20 21:01:33 -06:00
Ian Henry
b442b21d3f fix a segfault in the (number) special
This was an error about the base argument that referenced the tag argument,
which might not exist.
2023-02-20 17:07:42 -08:00
Calvin Rose
746ff5307d Update for more minimal builds. 2023-02-12 12:14:11 -06:00
Calvin Rose
ef85b24d8f Add optional offset to ffi/write. 2023-02-12 12:08:28 -06:00
Calvin Rose
c55d93512b Add buffer/push-at for easier manipulation of buffers
buffer/blit is difficult to use, and while buffer/push is the easiet
buffer manipulation function to use it only appends to the buffer.
buffer/push-at lets users manipulate buffers at any index - useful
for buffers used as an in-memory databases, for example.
2023-02-12 11:26:00 -06:00
Calvin Rose
2e38f9ba61 Allow passing pointer-buffers to other threads. 2023-02-12 11:07:45 -06:00
Calvin Rose
1cadff8e58 Add ffi/pointer-buffer for easier memory manipulation in FFI.
Added underlying buffer support for buffer instances that cannot
reallocated underlying memory - useful for (small) memory mapped
files and other FFI utilties.
2023-02-12 09:20:05 -06:00
Calvin Rose
d1eba60ba8 Add separate sandbox flag for file/temp
Doesn't really impart (much) file systtem information when used, and
can be used for a lot of things where file functions are used to process
in a stream.
2023-02-09 08:57:53 -06:00
Calvin Rose
057dccad8f Turn on nanboxing by default for risc-v 64. 2023-02-09 03:09:53 -06:00
Calvin Rose
4285200b4b Add a sandbox option to disable native modules.
Also sort the sandbox docstring list.
2023-02-09 00:19:56 -06:00
Calvin Rose
73c2fbbc2a Check sandbox capabilities instead of ignoring unknown ones. 2023-02-06 17:38:00 -06:00
Calvin Rose
37b7e170fa Update changelist. 2023-02-06 12:31:49 -06:00
Calvin Rose
b032d94877 Add sandboxing API.
The sandboxing API is meant to make janet a bit more attractive
for certain application embedding use cases. The sandboxing API
puts limits on what system resources the interpreter can access.
2023-02-06 09:05:57 -06:00
Calvin Rose
9476016741 Update asm.c 2023-02-05 23:49:18 -06:00
Calvin Rose
7a1c9c7798 Add support for debugging upvalues.
Upvalues are stored in the symbol slots structure as well, but
since they are always live, we repurpose the death_pc field to
refer to the environment index that we want to look at at runtime.
2023-02-05 15:30:01 -06:00
Calvin Rose
c7fb7b4451 Merge branch 'master' into localbindings 2023-02-05 11:36:57 -06:00
Calvin Rose
67c474fc7a More fixes to ev/gather (tested on httpf server). 2023-02-05 10:21:37 -06:00
Calvin Rose
4e8154cf8a Fix ev/gather to cancel children on cancellation.
Otherwise, we would be leaving zombie fibers around.
2023-02-05 09:43:16 -06:00
Calvin Rose
9582d3c623 Allow infinite wait to work without issues. 2023-02-05 09:29:39 -06:00
Calvin Rose
0079500713 Merge branch 'master' into localbindings 2023-02-04 13:39:24 -06:00
Calvin Rose
55af6ce834 Fix write after free with printing to files. 2023-02-04 13:36:30 -06:00
Calvin Rose
3e82fdc125 Update symbolmapping code with marshal/unmarshal. 2023-02-03 17:33:11 -06:00
Calvin Rose
7344a6cfc0 Fix null check. 2023-02-03 16:24:50 -06:00
Calvin Rose
0aded71343 Fix issue with environments in asm.c 2023-02-03 16:24:50 -06:00
Calvin Rose
7663b1e703 Fix null check. 2023-02-02 22:03:18 -06:00
Calvin Rose
282546c03f Fix issue with environments in asm.c 2023-02-02 21:12:17 -06:00
Calvin Rose
f4bc89d1c0 Progress. 2023-02-02 21:08:48 -06:00
Jona Ekenberg
fa277c3797 added future test for upvalues and symbolslots 2023-02-01 21:26:29 +01:00
Jona Ekenberg
c0c8ab25e6 added symbolslots to asm 2023-02-01 21:12:42 +01:00
Jona Ekenberg
b685bf3026 updated symbolslots-test 2023-02-01 11:46:36 +01:00
Jona Ekenberg
ce31db09e4 symbolslots should be gc'd, local_symbols always pushed in case *debug* is set in middle of function 2023-02-01 11:45:13 +01:00
Jona Ekenberg
624a6cf619 symbolslots nil when there are no symbols, changed debugger to not have special case 2023-02-01 11:25:52 +01:00
Jona Ekenberg
587aa87d28 symbolslots now use janet_v vectors, flat structure 2023-02-01 11:06:33 +01:00
Jona Ekenberg
88813c4f87 initial slotsyms implementation 2023-02-01 09:39:24 +01:00
Calvin Rose
dacbe29771 Allow round-tripping more functions with disasm and asm.
Nested functions that captured with environments didn't
work well with asm.
2023-01-30 09:04:42 -06:00
Calvin Rose
244833cfa1 Merge pull request #1040 from lgtm-migrator/codeql
Add CodeQL workflow for GitHub code scanning
2023-01-29 09:04:18 -06:00
Calvin Rose
05e7f974e3 Add os/compiler to the core.
Allows querying what compiler was used to compile Janet.
2023-01-28 14:00:02 -06:00
Calvin Rose
0dbef65a73 Merge pull request #1065 from sogaiu/comment-tweaks
Misc comment tweaks
2023-01-27 11:26:05 -06:00
Calvin Rose
9106228787 Add :riscv32 and :riscv32 values for os/arch. 2023-01-27 11:23:57 -06:00
Calvin Rose
6ae3bdb25c Add RISC-V 64 bit detection in janet.h 2023-01-26 22:40:05 -06:00
sogaiu
310bcec260 Misc comment tweaks 2023-01-25 18:45:19 +09:00
Calvin Rose
8c4cc4e671 Merge pull request #1064 from sogaiu/realpath-doc-tweak
Update os/realpath docstring
2023-01-24 09:50:44 -06:00
Calvin Rose
c6eaaa83ed Buffer initialized with janet_buffer_init will not be gced.
Set an internal flag that disables garbage collection on such
buffers. For all currently correct usage, this should have no effect,
and will fix use cases where buffers are initialized this way and then
passed to the interpreter.
2023-01-23 20:57:30 -06:00
sogaiu
8f598d6f96 Update os/realpath docstring 2023-01-23 12:55:04 +09:00
Calvin Rose
20bc323d17 Use gcc explicitly in mingw build. 2023-01-22 11:21:28 -06:00
Calvin Rose
8b0bcf4db9 Add the mingw toolchain. 2023-01-22 11:10:04 -06:00
Calvin Rose
8955e6f536 Merge branch 'master' of github.com:janet-lang/janet 2023-01-22 11:05:39 -06:00
Calvin Rose
f8ddea6452 Add msys2 testing with github actions. 2023-01-22 11:05:27 -06:00
Calvin Rose
987e04086d Merge pull request #1063 from AlecTroemel/1062-io-flag-types
use int32_t type for file flags, just like header
2023-01-22 10:56:19 -06:00
Calvin Rose
85f2acbf52 Fix tools/format.sh file permissions. 2023-01-22 10:47:33 -06:00
alectroemel
1acf4c3ab7 add int32_t type for file flags, just like header
Signed-off-by: alectroemel <alectroemel@hotmail.com>
Signed-off-by: alectroemel <alec@mirusresearch.com>
2023-01-22 10:24:46 -06:00
Calvin Rose
07a3158fba Merge pull request #1060 from ianthehenry/doc-typos
Fix some docstring typos
2023-01-21 16:21:57 -06:00
bakpakin
2f8bed9d82 Build and install an import library on mingw 2023-01-21 14:31:48 -06:00
bakpakin
a490937cd9 Add :mingw value when getting the OS setting when compiled with mingw. 2023-01-21 11:50:03 -06:00
bakpakin
8ee5942481 Fix windows build with JANET_NO_NET - #1055 2023-01-21 10:56:20 -06:00
bakpakin
93b469885a Initial Mingw support with Makefile.
Also add a macro JANET_MSVC to distinguish between
a windows build (JANET_WINDOWS) and a build with msvc.
2023-01-21 10:37:34 -06:00
Calvin Rose
d8d1de2dcb Don't compile library loading code on windows if it is disabled. 2023-01-21 09:36:03 -06:00
Ian Henry
ab224514f0 Fix some docstring typos. 2023-01-18 19:41:56 -08:00
Calvin Rose
75179de8da Merge pull request #1056 from fd00/use-dev-urandom-on-cygwin
Use `/dev/urandom` for `janet_cryptorand` on cygwin
2023-01-08 09:29:52 -06:00
Calvin Rose
c28df14e6b Prepare for 1.26.0 release 2023-01-07 15:08:40 -06:00
Calvin Rose
b73855b193 Merge branch 'master' of github.com:janet-lang/janet 2023-01-07 15:05:16 -06:00
Calvin Rose
2093ab2baa Update copyrights. 2023-01-07 15:04:56 -06:00
Calvin Rose
a0f40042cb Update copyright year. 2023-01-07 15:03:35 -06:00
Daisuke Fujimura (fd0)
3254c2c477 Use /dev/urandom for janet_cryptorand on cygwin 2023-01-07 08:58:35 +09:00
Calvin Rose
0a8eb9e3ba Merge pull request #1057 from sogaiu/update-tests-for-meson
Add test files to meson suite 11 - 14
2023-01-04 04:13:18 -06:00
sogaiu
70e0c6f9ef Add test files to meson suite 11 - 14 2023-01-04 12:59:26 +09:00
Calvin Rose
a8a78d4525 Merge pull request #1052 from dressupgeekout/cpu_count_reduced_os
(os/cpu-count) should not be defined at all with JANET_REDUCED_OS
2022-12-16 11:11:30 -06:00
Calvin Rose
57e6ee963d Merge pull request #1046 from dressupgeekout/charlotte_sort_doc
Explicitly mention that `sort-by` sorts a list in place.
2022-12-16 11:11:07 -06:00
Calvin Rose
ce6bfb8420 Merge pull request #1049 from harryvederci/patch-1
Improve documentation for the `all` function.
2022-12-16 09:51:59 -06:00
Calvin Rose
f0672bdc59 Merge pull request #1051 from sogaiu/math-abs-vs-fabs-issue
Tweak math/abs to improve doc result
2022-12-16 09:51:43 -06:00
Charlotte Koch
23de953fbd (os/cpu-count) should not be defined at all with JANET_REDUCED_OS 2022-12-15 20:16:43 -08:00
Calvin Rose
03c496bdd8 Update changelog 2022-12-15 21:38:36 -06:00
Calvin Rose
d5ee6cf521 Add malloc and free to ffi.
Very "unsafe", but a good tool of last resort. In most cases
a buffer is preferable, but the lifetime can be a bit unclear.
This allows very granular control over memory.
2022-12-15 21:35:44 -06:00
sogaiu
fb7981e053 Tweak math/abs to improve doc result 2022-12-11 00:09:50 +09:00
harryvederci
846123ecab Improve documentation for the all function. 2022-12-09 11:16:42 +00:00
Calvin Rose
373cb444fe Merge branch 'master' of github.com:janet-lang/janet 2022-12-04 11:08:28 -06:00
Calvin Rose
90f212df92 Add length method ffi/jitfn abstract values. 2022-12-04 11:08:17 -06:00
Calvin Rose
12286e4246 Add length method ffi/jitfn abstract values. 2022-12-04 10:27:28 -06:00
Calvin Rose
aa60c1f36a Add ffi jit example. 2022-12-03 17:52:23 -06:00
Calvin Rose
c731f01067 Address windows compilation warning. 2022-12-03 12:10:22 -06:00
Calvin Rose
6c9c1cdb30 MAP_ANON(YMOUS) not strictly needed. 2022-12-03 11:45:33 -06:00
Calvin Rose
9ba2b40e87 Add MAP_ANON instead of MAP_ANONYMOUS for mac 2022-12-03 11:31:04 -06:00
Calvin Rose
7a3d055012 Add ffi/jitfn for JIT compilation.
Convert a byte sequence of machine code to an
an executable pointer that can be used with ffi/call.
2022-12-03 11:26:23 -06:00
Calvin Rose
0824f45e29 Format compile.c 2022-11-27 10:15:01 -06:00
Charlotte Koch
4debe3446c Explicitly mention that sort-by sorts a list in place. 2022-11-20 20:51:49 -08:00
Calvin Rose
07fe9bcdf6 Update state header to include pthread 2022-11-11 11:48:50 -06:00
Calvin Rose
6a557a73f5 Simplify eval.
Also add more conventional handling of nil to the `compile` function.
2022-11-11 11:25:06 -06:00
Calvin Rose
8d1cfe0c56 Simplify eval-string implementation. 2022-11-11 11:15:53 -06:00
Calvin Rose
a3a42eebea Create pthread threads with detached attribute.
Rather than calling pthread_detach on a default thread.
2022-11-11 11:01:59 -06:00
Calvin Rose
76be8006a4 Add channel marshalling. 2022-11-10 16:32:54 -06:00
Calvin Rose
bfcfd58259 Update for TCC to include stdatomic.h 2022-11-09 07:55:21 -06:00
Calvin Rose
914a4360e7 Indicate version bump since header file changed. 2022-11-05 16:38:52 -05:00
Calvin Rose
8c31874eeb Remove unused assert.h 2022-11-05 11:44:14 -05:00
Calvin Rose
ef7afeb2ea Add 64 bit integer support to printf and other formatting functions. 2022-11-05 11:33:19 -05:00
LGTM Migrator
4067f883a2 Add CodeQL workflow for GitHub code scanning 2022-11-05 10:22:49 +00:00
Calvin Rose
c8974fffbe Fix docstring. 2022-11-04 11:23:08 -05:00
Calvin Rose
b75fb8dc9e Add :@all: to module/expand-path
Allow more easily importing modules from custom directories
without jumping through too many hoops. Technically, this was
possible before but required circumventing the built-in module/paths
and was just a hassle.

Also add entries to module/path (and module/add-path) to allow code
like the following.

(setdyn :my-libs "/home/me/janet-stuff/")

(import @my-libs/toolbox)

Intended for things like test harnesses where code might not
be installed to the usual directories.
2022-11-04 11:15:48 -05:00
Calvin Rose
57356781a9 Fix typo. 2022-10-30 13:36:13 -05:00
Calvin Rose
e43eab5fd6 Fix panicf call. 2022-10-30 09:57:40 -05:00
Calvin Rose
894cd0e022 Prepare for 1.25.1 release. 2022-10-29 11:58:29 -05:00
Calvin Rose
db2c63fffc Update CHANGELOG.md 2022-10-24 20:32:02 -05:00
Calvin Rose
60e0f32f1a Fix os/open with :rw permissions on posix. 2022-10-24 19:39:58 -05:00
Calvin Rose
e731996a68 Allow overriding JANETCONF_HEADER in Makefile.
This allows a configuration workflow that is a bit simpler than before
and doesn't requiring applying patches. Instead, add a config.mk to
source dir with JANETCONF_HEADER=myconfig.h and compile as usual.

The patching workflow will of course still work exactly as before.
2022-10-24 09:49:51 -05:00
Calvin Rose
2f69cd4209 Add easier option for adding config.mk in root directory. 2022-10-23 13:11:07 -05:00
Calvin Rose
fd59de25c5 Add memcmp to the core. Useful in binary protocol implementations. 2022-10-18 11:54:07 -05:00
Calvin Rose
af12c3d41a Typo fixes. 2022-10-10 18:38:24 -05:00
Calvin Rose
54b52bbeb5 Prepare for 1.25.0 release. 2022-10-10 18:24:48 -05:00
Calvin Rose
1174c68d9a Update CHANGELOG.md 2022-10-10 18:23:15 -05:00
Calvin Rose
448ea7167f Add CLOEXEC when calling accept on Linux.
Prevents leakage of file descriptors to subprocesses.
The symptom of the above issue is sockets that don't seem to close
until a subprocess completes.
2022-10-10 18:06:31 -05:00
Calvin Rose
6b27008c99 Fix os/date with nil argument. 2022-10-10 15:24:28 -05:00
Calvin Rose
725c785882 Formatting. 2022-10-10 14:24:03 -05:00
Calvin Rose
ab068cff67 Remove WNOWAIT code on linux.
Would cause os/proc-wait to block in some circumstances.
2022-10-10 14:23:17 -05:00
bakpakin
9dc03adfda Fix pass by reference in windows FFI to accomodate stack shift. 2022-09-22 10:58:16 -05:00
bakpakin
49f9e4eddf Fix ifdef in capi.c for janet_getuinteger64 and janet_getinteger64 2022-09-20 15:42:20 -05:00
bakpakin
43c47ac44c Address #1037 - move stack hack after arg writing logic to avoid
clobber.
2022-09-20 15:37:20 -05:00
Calvin Rose
1cebe64664 Add some soft test cases for #1037. 2022-09-20 10:01:12 -05:00
Calvin Rose
f33c381043 Improve sysv64 classify algorithm. 2022-09-20 09:45:17 -05:00
Calvin Rose
3479841c77 Address #1034 - add handling for 8-16 byte structs in FFI. 2022-09-20 09:28:46 -05:00
Calvin Rose
6a899968a9 Allow passing user signals to (signal) as keywords. 2022-09-17 21:18:07 -05:00
Calvin Rose
bb8405a36e Merge pull request #1029 from locriacyber/patch-0
Fix documentation for ev/go, ev/spawn
2022-09-16 07:32:25 -05:00
bakpakin
c7bc711f63 Add windows FFI example test case for void functions with double
argument.
2022-09-15 13:58:54 -05:00
bakpakin
e326071c35 Fix void returns in windows FFI - address #1025 2022-09-15 13:51:11 -05:00
Locria Cyber
ad6a669381 Add doc for ev/go
Document that you can pass a function instead of a fiber to ev/go
2022-09-14 00:17:53 +00:00
Locria Cyber
e4c9dafc9a Fix typo in ev/spawn doc 2022-09-13 23:49:42 +00:00
Calvin Rose
dfc0aefd87 Merge pull request #1028 from autumnull/master
Made peg 'not' and 'if-not' drop their captures on success
2022-09-13 15:20:10 -05:00
Calvin Rose
356b39c6f5 Add test case for #1027 2022-09-12 19:00:59 -05:00
Calvin Rose
8da7bb6b68 Fix peg/replace-all and family - Fix #1027 2022-09-12 18:58:48 -05:00
Autumn!
9341081a4d Made peg 'not' and 'if-not' drop their captures on success 2022-09-12 23:07:56 +01:00
Calvin Rose
324a086eb4 Merge pull request #1023 from ScriptDevil/set-manpath
Set JANET_MANPATH environment variable while installing.
2022-09-10 09:55:01 -05:00
Ashok Gautham
ed595f52c2 Set JANET_MANPATH environment variable while installing.
JPM on windows currently installs its manpage to C:\ directly because this isn't set when installing Janet through the MSI installer
2022-09-09 13:24:36 +05:30
Calvin Rose
64ad0023bb Merge pull request #1022 from autumnull/master
Removed unnecessary backslashes from documentation
2022-09-08 08:52:55 -05:00
Autumn!
fe5f661d15 Removed unnecessary backslashes from documentation 2022-09-08 13:21:17 +01:00
Calvin Rose
ff26e3a8ba Remove end of string check that is now redudant.
The addition of some code to avoid valgrind warnings made this code
redundant.
2022-09-05 20:13:15 -05:00
Calvin Rose
14657a762c Fix peg RULE_SET op code when at tail of string in some cases. 2022-09-05 14:11:03 -05:00
Calvin Rose
4754fa3902 Fix issue #1021 - bad format specifiers in run.c 2022-09-03 14:03:51 -05:00
Calvin Rose
f302f87337 Merge pull request #1019 from Techcable/fix/inttypes-overflow
Signed integer overflow is undefined behavior in C, avoid it in inttypes.c
2022-08-30 23:23:11 -05:00
Calvin Rose
94dbcde292 Merge pull request #1020 from pepe/comment-typo
Fix typo in define comment
2022-08-30 22:57:52 -05:00
Josef Pospíšil
4336a174b1 Fix typo in define comment 2022-08-30 09:21:20 +02:00
Techcable
0adb13ed71 inttypes.c: Avoid signed integer overflow (U.B.)
In C, signed arithmetic overflow is undefined behvior
but unsigned arithmetic overflow is twos complement

Unconditionally switch to unsigned arithmetic internally for +, -, *
This will not affect the result thanks to twos complement awesomeness.

I don't think this will be an issue in these functions,
but it has a history of causing bugs.....
2022-08-29 18:38:51 -07:00
Techcable
e78a3d1c19 Add unit tests for contains? 2022-08-26 21:47:18 -07:00
Techcable
c099ec05ee Remove documentation on type error from index-of
Three reasons:
1. This same behavior is not documented on the `next` function
2. This function does not throw the error directly,
   it only throws an error because `next` does.
3. Following the same idea as the previous commit, this behavior is
   more or less implementation-defined for nonsensical types
  > In dynamic languages, the usual idea is garbage in, garbage out.

Various other documentation cleanup.
2022-08-26 21:46:58 -07:00
Techcable
a20612478e Remove try from contains?, allowing type errors
> Remove the try. In dynamic languages, the usual idea is garbage in, garbage out. You misunderstood my point about the type error. “Test” functions are not special in that regard.
> - @bakpakin
2022-08-26 20:36:17 -07:00
Techcable
f778e8bbd1 Fix incorrect usage of the test macro
I need unit tests....
2022-08-26 15:35:26 -07:00
Techcable
7203c046f9 Remove collection? type test
No longer used to guard the type tests.
2022-08-26 15:23:52 -07:00
Techcable
754b61c593 Clarify documentation of contains?
Also contains-value?
2022-08-26 15:19:39 -07:00
Techcable
927e9e4e4d Make contains? consistently iterate over values.
Remove `contains-value?` because it is now redundant.

Clarify in the documentation that it checks dictionary values.
2022-08-26 15:06:09 -07:00
Techcable
699f9622d7 Warn about index-of type errors when not iterable
This is just documentation of existing behavior, it does not change anything.

The reason index-of throws a type error on non-iterable types is because `next` does.
This is hardcoded into the JOP_NEXT opcode (see src/core/value.c:janet_next_impl).

Unfortunately, there is currently no corresponding `iterable?` check.
2022-08-26 15:05:39 -07:00
Techcable
765eb84c33 on bad type, contains? shuld return false (not error)
Note this actually changes behavior from a thin wrapper over `index-of`.
This is because `(index-of 3 3)` throws "error: expected iterable type, got 3"
2022-08-26 14:23:36 -07:00
Calvin Rose
03ba1f7021 Update CHANGELOG and version numbers. 2022-08-26 13:15:30 -05:00
Calvin Rose
1f7f20788c Add line loop example for awk or sed like processing. 2022-08-26 12:29:23 -05:00
Calvin Rose
c59dd29190 Add stress test for marshalling to examples. 2022-08-26 12:27:53 -05:00
Calvin Rose
99f63a41a3 Improve pointer hashing to avoid hash collisions. 2022-08-26 12:18:10 -05:00
Calvin Rose
a575f5df36 Add option to marshal values without cycle detection. 2022-08-26 11:20:02 -05:00
Techcable
12a1849090 Add utilities for contains? and contains-key?
This is significantly clearer than using (not (nil? (index-of col val)))

Most major programming languages offer some sort of contains function (Python, Java, C, Rust).
The only exception I know of is C.
2022-08-25 21:00:02 -07:00
Calvin Rose
0817e627ee Prepare for 1.24.1 release. 2022-08-24 13:23:53 -05:00
Calvin Rose
14d90239a7 Merge branch 'master' of github.com:janet-lang/janet 2022-08-24 11:35:37 -05:00
Calvin Rose
f5d11dc656 Address #1014 improve parse errors when bad delimiters are found.
Reuse some existing logic for eof errors.
2022-08-24 11:34:59 -05:00
Calvin Rose
6dcf5bf077 Merge pull request #1012 from Techcable/doc/clarify-flag-E
Clarify the documentation of janet -E flag
2022-08-21 13:45:17 -05:00
Calvin Rose
ac2082e9b3 Allow adding name to short-fns.
When short-fn is used in a macro, it can be useful to
give the function a nicer name then a raw pointer.
2022-08-18 14:33:59 -05:00
Techcable
dbac495bee Clarify the documentation of janet -E flag
This confused me, despite having a fair deal of janet experience.
2022-08-18 12:16:14 -07:00
Calvin Rose
fe5ccb163e Merge branch 'master' of github.com:janet-lang/janet 2022-08-16 12:38:59 -05:00
Calvin Rose
1aea5ee007 Remove stack inversion code for sysv64 FFI. 2022-08-16 12:38:44 -05:00
Calvin Rose
13cd9f8067 Remove stack inversion code for sysv64 FFI. 2022-08-16 12:20:38 -05:00
bakpakin
34496ecaf0 Prepare for 1.24.0 release. 2022-08-14 20:20:09 -05:00
bakpakin
c043b1d949 Add win32 ffi example. 2022-08-14 15:40:09 -05:00
bakpakin
9a6d2a7b32 Fix FFI for reference return values and stack parameter passing. 2022-08-14 15:20:30 -05:00
bakpakin
f8a9efa8e4 Allow binding pre-loaded symbols in windows FFI.
Mimic the posix RTLD_NOW setting for dlopen by iterating
opened DLLs to look for symbols.
2022-08-14 13:26:13 -05:00
Calvin Rose
5b2169e0d1 Fix docstring. 2022-08-02 14:58:32 -05:00
Calvin Rose
2c927ea768 Add testcase for issue #1005 2022-08-02 12:34:24 -05:00
Calvin Rose
f4bbcdcbc8 Get rid of disabled tracing. #1005 2022-08-02 12:19:22 -05:00
Calvin Rose
79c375b1af Address #1005 - Fix janet_call stack clobbering on dirty stack. 2022-08-02 12:13:56 -05:00
Calvin Rose
f443a3b3a1 Remove type_array option to meson_min build 2022-07-26 14:27:22 -05:00
Calvin Rose
684d2d63f4 Emphasize the ldconfig error is expected. 2022-07-20 11:19:09 -05:00
Calvin Rose
1900d8f843 Fix build warnings on Linux GCC version 12.1.0 x64 2022-07-20 08:04:03 -05:00
Calvin Rose
3c2af95d21 Update CHANGELOG.md 2022-07-19 20:05:21 -05:00
Calvin Rose
b35414ea0f Merge branch 'master' of github.com:janet-lang/janet 2022-07-19 20:04:44 -05:00
Calvin Rose
fb5b056f7b Address #1001 - don't process names passed to dlopen. 2022-07-19 20:04:17 -05:00
bakpakin
7248c1dfdb Give up if ln fail. 2022-07-09 19:10:25 -05:00
bakpakin
4c7ea9e893 Merge branch 'master' of github.com:janet-lang/janet 2022-07-09 11:44:20 -05:00
bakpakin
c7801ce277 Address #997 - clang undefined behavior warning. 2022-07-09 11:43:51 -05:00
Calvin Rose
f741a8e3ff Merge pull request #998 from autumnull/master
stop doc-format detecting other modes within code blocks
2022-07-09 11:40:51 -05:00
bakpakin
6a92e8b609 Update CHANGELOG and make tweaks to win32 shell 2022-07-09 11:39:06 -05:00
bakpakin
9da91a8217 Update shell.c to have smart behavior on windows. 2022-07-09 11:23:02 -05:00
bakpakin
69853c8e5c Merge branch 'master' of github.com:janet-lang/janet 2022-07-08 09:49:56 -05:00
Autumn!
1f41b6c138 doc-format no longer detects other modes within code blocks 2022-07-07 14:41:46 +01:00
Calvin Rose
e001efa9fd Fix #996 - linking command works on busybox. 2022-07-04 16:48:07 -05:00
Calvin Rose
435e64d4cf Allow shorthand for setting task-id on new threads with flag.
Avoids the need to wrap function bodies in closures in many cases.
2022-07-03 12:08:21 -05:00
Calvin Rose
f296c8f5fb Merge branch 'master' of github.com:janet-lang/janet 2022-07-02 21:11:55 -05:00
Calvin Rose
8d0e6ed32f Fix function handlers for :out and :err.
They were not properly handled for formatting functions.
2022-07-02 21:11:05 -05:00
Calvin Rose
b6a36afffe Merge pull request #994 from shassard/master
Use relative path for include/janet.h symlink
2022-07-02 12:30:39 -05:00
Stephen Hassard
e422abc269 Use relative path for include/janet.h symlink
When using make to build an rpm, the current symlink is
created with an absolute path to the buildroot as causes
the make install target to fail with:

error: Symlink points to BuildRoot: /usr/include/janet.h -> /home/stephen/rpmbuild/BUILDROOT/janet-1.23.0-3.x86_64/usr/include/janet/janet.h

We can create the link relatively which makes this more
portable, where:

ln -sf -t '/home/stephen/rpmbuild/BUILDROOT/janet-1.23.0-3.x86_64/usr/include' janet.h janet/janet.h

Resulting in the following symlink:

ls -la BUILDROOT/usr/include/janet.h
lrwxrwxrwx. 1 stephen stephen 13 Jul  2 08:17 BUILDROOT/usr/include/janet.h -> janet/janet.h

This symlink can then be properly packaged without path
issues.

Signed-off-by: Stephen Hassard <steve@hassard.net>
2022-07-02 08:52:17 -07:00
Calvin Rose
221d71d07b Merge pull request #993 from pepe/test-tabseq
Add basic test for tabseq
2022-07-02 09:30:59 -05:00
Calvin Rose
9f35f0837e Merge pull request #991 from pepe/master
Trace function to the stderr
2022-07-02 09:29:18 -05:00
Josef Pospíšil
515891b035 Add basic test for tabseq 2022-07-02 07:43:28 +02:00
Josef Pospíšil
94a506876f Trace function to the stderr 2022-07-01 12:23:25 +02:00
Calvin Rose
9bde57854a Add tabseq macro. 2022-06-28 22:51:41 -05:00
Calvin Rose
f456369941 Add support for a dyn :task-id
Adds extra information to default information from supervisor
channels. For threaded channels as supervisors, we don't get
the source fiber so identifying the source of messages was not
possible. This change allows better multithreading with  supervisors.
2022-06-25 18:51:21 -05:00
Calvin Rose
8f0a1ffe5d Github showing old git attributes. 2022-06-20 11:23:21 -05:00
Calvin Rose
e4bafc621a Remove ssize_t usage. 2022-06-20 11:09:41 -05:00
Calvin Rose
cfa39ab3b0 Prepare for 1.23.0 release. 2022-06-20 10:49:25 -05:00
Calvin Rose
47e91bfd89 Fix docstring. 2022-06-19 18:52:37 -05:00
Calvin Rose
eecc388ebd Add support for 0-element arrays in FFI.
Allows for flexible array member construct mapping.
2022-06-19 16:29:55 -05:00
Calvin Rose
0a15a5ee56 Prepare for 1.23.0 release. 2022-06-19 15:07:35 -05:00
Calvin Rose
cfaae47cea Fix trailing :pack-all or :pack in struct. 2022-06-19 13:06:19 -05:00
Calvin Rose
c1a0352592 Fix unset field in JanetFFIType. 2022-06-19 12:58:45 -05:00
Calvin Rose
965f45aa3f Update changelog to say FFI initially only available on non-windows
platforms.
2022-06-19 12:42:44 -05:00
Calvin Rose
6ea27fe836 Error message sounded a bit unsure. 2022-06-19 10:29:42 -05:00
Calvin Rose
0dccc22b38 Improve error messages when using bad metadata
Print metadata value as well as binding name.
2022-06-19 10:28:18 -05:00
Calvin Rose
cbe833962b Remove bad suite0009 test. Close #871
The issue is that there was no synchronization on writes.
The stability of the test relied on the fact that the server
would read in an entire message in one call to ev/read, which
would _almost_ always happen since the messages are so small.
2022-06-19 10:01:10 -05:00
Calvin Rose
b5720f6f10 On suite0009 errors for localname/peername, add info
Tag when the issue in the server or in the client. On windows, sometimes
these seemed to get swapped for strange reason.
2022-06-19 09:31:43 -05:00
Calvin Rose
56b4e0b0ec Update CONTRIBUTING.md 2022-06-19 09:18:59 -05:00
Calvin Rose
e316ccb1e0 Use _tzset() on windows before localtime_s 2022-06-19 08:49:54 -05:00
Calvin Rose
a6f93efd39 Support for array types in ffi. 2022-06-19 08:03:32 -05:00
Calvin Rose
20511cf608 Cast NULL pointer to nil in return in ffi. 2022-06-18 16:53:01 -05:00
Calvin Rose
1a1dd39367 Use __builtin_alloca if no other option. 2022-06-18 13:54:47 -05:00
Calvin Rose
589981bdcb BSD systems put alloca in the stdlib 2022-06-18 12:18:06 -05:00
Calvin Rose
89546776b2 alloca 2022-06-18 12:15:16 -05:00
Calvin Rose
f0d7b3cd12 No alloca.h? 2022-06-18 11:19:14 -05:00
Calvin Rose
e37be627e0 Allow loading current process on windows as well. 2022-06-18 10:31:00 -05:00
Calvin Rose
d803561582 Fix ffi/defbind for non-lazy bindings.
Add testing to bind to symbols in current binary.
2022-06-18 10:14:42 -05:00
Calvin Rose
a1aab4008f Update FFI example. 2022-06-18 10:06:39 -05:00
Calvin Rose
a1172529bf Fix named arguments with optional args. 2022-06-18 09:46:28 -05:00
Calvin Rose
1d905bf07f SRWLock is the size of a void pointer. 2022-06-17 17:49:02 -05:00
Calvin Rose
eed678a14b Include windows.h for windows builds 2022-06-17 17:41:50 -05:00
Calvin Rose
b1bdffbc34 Don't inlcude pthread on windows. 2022-06-17 17:35:58 -05:00
Calvin Rose
cff718f37d Add suite0012 stub with delay test. 2022-06-17 17:27:42 -05:00
Calvin Rose
40e9430278 Move examples to example directory. 2022-06-17 17:24:52 -05:00
Calvin Rose
62fc55fc74 Remove pthread.h from janet.h
Should make janet a bit easier to use. Also changes the
header to not expose the size of native mutexes and rwlocks, except
with janet_os_mutex_size and janet_os_rwlock_size.
2022-06-17 17:13:58 -05:00
Calvin Rose
80729353c8 Add :lazy option for ffi/context for jpm quickbin usage. 2022-06-13 21:26:03 -05:00
Calvin Rose
105ba5e124 Add ffi/context and ffi/defbind helpers.
Wrap the very bare-bones FFI library to be a bit more
useful out of the box.
2022-06-12 18:48:47 -05:00
Calvin Rose
ad1b50d1f5 Update dofile function signature. 2022-06-12 18:03:23 -05:00
Calvin Rose
1905437abe Merge branch 'master' into ffi 2022-06-12 13:59:37 -05:00
Calvin Rose
87fc339c45 Add named arguments with the &named symbol.
Similar to &keys, but more ergonomic.
2022-06-12 13:53:18 -05:00
Calvin Rose
3af7d61d3e Update gtk example. 2022-06-12 12:51:06 -05:00
Calvin Rose
a45ef7a856 Update CHANGELOG to reflect new function renames. 2022-06-12 10:17:25 -05:00
Calvin Rose
299998055d Update meson min build to turn off ffi. 2022-06-12 10:15:36 -05:00
Calvin Rose
c9586d39ed Add a :none calling convention.
The ffi module is useful even when true ffi calls
are not yet implemented. This lets the ffi be enabled
on any architecture, albeit with a degraded feature set
where calling conventions are not implemented.
2022-06-12 10:12:45 -05:00
Calvin Rose
2e9f67f4e4 Change all "native-*" to ffi/. Move new dll loading funcs.
native-close, raw-native and native-lookup have become
ffi/close, ffi/native, and ffi/lookup instead.

The new ffi module will be useful for any architecture even if we don't
support making calls to certain functions. We can simple add a
do-nothing calling convetion that panics on call. ffi/read and ffi/write
are useful in their own right.
2022-06-12 10:02:02 -05:00
Calvin Rose
e318170fea Begin working on windows calling convetion.
Also remove inline assembly for making sysv64 calls.
Instead, use crafted function signatures to set all needed registers.
2022-06-12 09:16:10 -05:00
Calvin Rose
73c4289792 Fix define check. 2022-06-11 21:50:34 -05:00
Calvin Rose
ea45d7ee47 Convert to one big blob of assembly for sysv cc.
Also begin working on win64 calling convention.
2022-06-11 21:43:35 -05:00
Calvin Rose
6d970725e7 Update boot.janet for typos. 2022-06-11 21:19:42 -05:00
Calvin Rose
458c2c6d88 Make calling convention optional for trampoline 2022-06-11 15:47:51 -05:00
Calvin Rose
0cc53a8964 Get a GTK example working. Good proof of concept. 2022-06-11 14:47:35 -05:00
Calvin Rose
0bc96304a9 Add r32 and r64 aliases for real numbers in ffi types. 2022-06-11 09:40:37 -05:00
Calvin Rose
c75b088ff8 Format boot.janet with janet-format. 2022-06-10 19:13:23 -05:00
Calvin Rose
181f0341f5 Add :pack and :pack-all keywords to allow for struct packing.
Syntax may need some work but covers both fully packed structs
as well as packing of individual members.
2022-06-10 18:53:22 -05:00
Calvin Rose
33bb08d53b Merge branch 'master' into ffi 2022-06-10 16:24:55 -05:00
Calvin Rose
6d188f6e44 Improve .ppasm function. 2022-06-10 16:24:40 -05:00
Calvin Rose
c3648331f1 Expose an easy to use debugger function. 2022-06-10 15:39:29 -05:00
Calvin Rose
a5b66029d3 Expose the built-in debugger in more places. 2022-06-10 15:23:15 -05:00
Calvin Rose
49bfe80191 Make sure void return types work as expected. 2022-06-10 12:33:01 -05:00
Calvin Rose
a5def77bfe Add support for struct return values. 2022-06-10 12:25:08 -05:00
Calvin Rose
9ecb5b4791 Add native-read function as inverse to native-write. 2022-06-10 09:38:52 -05:00
Calvin Rose
1cc48a370a Add native-write, which will write structs to buffers.
Useful for testing as well as useful in its own right. Begs
for an inverse, native-read which would convert byte data
to native structs.
2022-06-10 08:46:20 -05:00
Calvin Rose
f1ec8d1e11 Beginning of struct support.
TODO:
- struct return values
- support for unions in signatures
- more testing
- complex types
- packed structs
- writing structs to buffers (useful and we have most of the machinery).
2022-06-09 20:27:56 -05:00
Calvin Rose
55c34cd84f Merge pull request #985 from masukomi/readme_update
added make install & install-jpm-git to Readme
2022-06-09 10:02:58 -05:00
masukomi
aca52d1e36 added make install & install-jpm-git to readme 2022-06-08 21:58:55 -04:00
Calvin Rose
6f90df26a5 Alloca included by default on some OS, but not all.
Do explcitly include alloca on non-msvc compilers.
2022-06-08 10:01:19 -05:00
Calvin Rose
9d9cb378ff Don't include alloca.h, not in MSVC. 2022-06-08 09:59:13 -05:00
Calvin Rose
f92aac14aa Only enable FFI on x86-64, non-windows OSes. 2022-06-08 09:50:31 -05:00
Calvin Rose
3f27d78ab5 Add some FFI testing and more improvements to sysv abi.
Add support for integer return and floating point return variants, as
well as arguments on the stack. Start flushing out struct arguments.

Still needed:
- structs (packed and unpacked)
- complex numbers
- long doubles
- MASM alternative for windows (you can technically use sysv abi on
  windows)
- more calling conventions.
2022-06-08 09:44:49 -05:00
Calvin Rose
282d1ba22f Implement sys v abi on x64 partially. 2022-06-06 18:54:17 -05:00
Calvin Rose
94c19575b1 Fix when clib is not pointer type. 2022-06-06 13:37:07 -05:00
Calvin Rose
e3e485285b Prevent double usage of native objects after closing. 2022-06-06 13:36:03 -05:00
Calvin Rose
986e36720e Update windows builds for raw-natives. 2022-06-06 13:08:12 -05:00
Calvin Rose
74348ab6c2 Fix symbol lookup when symbol isn't found. 2022-06-06 10:53:00 -05:00
Calvin Rose
8d1ad99f42 Add stubs that are precursor to FFI.
FFI may be best implemented as an external library
(libffi has incompatible license to Janet) or as code
that takes void * and wraps then into Janet C functions
given a function signature. Either way, we need to some way
to load symbols from arbitrary dynamic libraries.
2022-06-06 10:49:30 -05:00
Calvin Rose
e69bbff195 Update CHANGELOG.md 2022-06-05 17:40:50 -05:00
Calvin Rose
c9f33bbde0 Add rwlocks. 2022-06-05 16:42:18 -05:00
Calvin Rose
9c9f9d4fa6 Add some thread coordination primitives.
Due to the nature of event loops, it is a bit difficult to integrate
lock and other primitives such that they don't block fibers on the same
thread.
2022-06-05 15:24:34 -05:00
Calvin Rose
2f64a6b0cb Add parse-all function as a natural extension to the parse function. 2022-05-28 19:02:17 -05:00
Calvin Rose
dfa78ad3c6 typo 2022-05-28 12:23:28 -05:00
Calvin Rose
677ae46f0c Fix README links for sourcehut. 2022-05-28 12:22:28 -05:00
Calvin Rose
6ada2a458f Fixes on bsd for os/cpu-count. 2022-05-28 12:21:44 -05:00
Calvin Rose
8145f3b68d On linux, available CPUs is more useful information. 2022-05-28 12:19:25 -05:00
Calvin Rose
48289acee6 Add os/cpu-count functionality. 2022-05-28 12:01:23 -05:00
Calvin Rose
e5a989c6f9 Remove multiple outputs with same name for old meson versions. 2022-05-27 21:14:47 -05:00
Calvin Rose
4c56704935 Merge pull request #979 from turrisxyz/Pinned-Dependencies-GitHub
chore: Set permissions for GitHub actions
2022-05-27 17:03:54 -05:00
naveen
9cda44f443 chore: Set permissions for GitHub actions
Restrict the GitHub token permissions only to the required ones; this way, even if the attackers will succeed in compromising your workflow, they won’t be able to do much.

- Included permissions for the action. https://github.com/ossf/scorecard/blob/main/docs/checks.md#token-permissions

https://docs.github.com/en/actions/using-workflows/workflow-syntax-for-github-actions#permissions

https://docs.github.com/en/actions/using-jobs/assigning-permissions-to-jobs

[Keeping your GitHub Actions and workflows secure Part 1: Preventing pwn requests](https://securitylab.github.com/research/github-actions-preventing-pwn-requests/)

Signed-off-by: naveen <172697+naveensrinivasan@users.noreply.github.com>
2022-05-27 00:32:28 +00:00
Calvin Rose
431451bac2 Make install work ok if meson is old. 2022-05-25 22:35:20 -05:00
Calvin Rose
395ca7feea Fix meson.build for older versions of meson. 2022-05-14 10:27:28 -05:00
bakpakin
e0b7533c39 Add toggle macro. 2022-05-12 15:36:29 -05:00
bakpakin
5b2a402930 Fix version bump. 2022-05-09 10:28:09 -05:00
bakpakin
85129a1873 Prepare for 1.22.0 release. 2022-05-09 10:19:40 -05:00
Calvin Rose
487d333024 Add module/value function to make grabbing bindings out module tables. 2022-05-05 19:24:44 -05:00
Calvin Rose
fe7d35171f Remove file/popen - address #974 2022-05-05 18:33:34 -05:00
Calvin Rose
b3aed13567 Use janet_getnat when non-negative integer needed. 2022-05-05 18:27:29 -05:00
Calvin Rose
a9d4d2bfa3 Merge pull request #976 from rick2600/master
Fix #975 - null ptr dereference when a table is created with negative capacity
2022-05-05 08:56:15 -05:00
rick2600
1ff521683f Fix #975 - null ptr dereference when a table is created with negative capacity 2022-05-05 02:11:43 -03:00
Calvin Rose
0395a03b6b Merge pull request #973 from rick2600/master
fix negative count passed to cfun_array_new_filled
2022-05-02 11:13:20 -05:00
rick2600
7fda7709ff fix negative count passed to cfun_array_new_filled 2022-05-02 12:57:47 -03:00
Calvin Rose
65a9200cff Merge pull request #972 from uvtc/patch-2
os.c doc formatting typo
2022-04-29 23:04:31 -05:00
John Gabriele
473eec26c1 os.c doc formatting typo 2022-04-29 23:57:37 -04:00
Calvin Rose
9fa945ad93 Don't include captures of last match from to combinator. 2022-04-29 19:21:10 -05:00
Calvin Rose
a895219d2f Fix #971 - remove to rule optimization
For to and thru, we need to restore eveytime through the loop since rules need
run with the right captures on the stack, especially if they have any
sort of backrefs.
2022-04-29 19:15:56 -05:00
bakpakin
427f7c362e Fix os/execute regression. 2022-04-27 22:59:27 -05:00
Calvin Rose
73f5c41fae Address #968 Ignore :pipe arguments in os/execute.
They are only useful in os/spawn. Also update docstrings.
2022-04-27 20:13:10 -05:00
Calvin Rose
b4ec168401 Address #950 - add defn suggestion on bad def.
While generally we are not in the business of making a very chatty
compiler, this is a simple improvement that involves compiling
metadata before the binding, as well as adding a suggestion for `defn`
in case the compiler encounters an unexpected tuple.
2022-04-23 22:27:34 -05:00
Calvin Rose
726d35c766 Update changelog with a few fixes. 2022-04-22 23:13:08 -05:00
Calvin Rose
6db796e10c Add janet.h (in addition to janet/janet.h) on install.
A number of bindings (many of which I have written) include
<janet.h> rather than <janet/janet.h>.
2022-04-22 22:29:12 -05:00
Calvin Rose
c38d9134cd Merge pull request #967 from uvtc/patch-2
boot.janet docstrings (part 3, last part)
2022-04-20 20:53:30 -05:00
John Gabriele
471204b163 boot.janet docstrings (part 3, last part)
Added some backticks around code in docstrings to distinguish them from prose.

Also some light editing.
2022-04-20 18:31:06 -04:00
Calvin Rose
7f23bfa66d Merge pull request #966 from uvtc/patch-2
boot.janet docstrings (part 2)
2022-04-19 20:24:32 -05:00
John Gabriele
9287b26042 boot.janet docstrings (part 2)
Added some backticks around code in docstrings to distinguish them from prose.

Also some light editing.
2022-04-19 01:55:37 -04:00
Calvin Rose
e22936fbf8 Merge pull request #964 from uvtc/patch-9
tuple.c docstrings
2022-04-18 14:07:41 -05:00
Calvin Rose
04ace9fc16 Merge pull request #963 from uvtc/patch-8
table.c docstrings
2022-04-18 14:07:26 -05:00
Calvin Rose
8466b333fb Merge pull request #965 from uvtc/patch-2
boot.janet docstrings
2022-04-18 14:07:16 -05:00
John Gabriele
96602612ba boot.janet
Added some backticks around code in docstrings to distinguish them from prose.
2022-04-17 22:35:04 -04:00
John Gabriele
690b98bff9 tuple.c docstrings
Added some backticks around code in docstrings to distinguish them from prose.
2022-04-17 21:26:53 -04:00
John Gabriele
8329131bfe table.c docstrings
Added some backticks around code in docstrings to distinguish them from prose.

Light editing to `table/raw-get`. Is my change there correct? (t --> the key)
2022-04-17 21:21:01 -04:00
Calvin Rose
9986aab326 Merge pull request #960 from uvtc/patch-5
math.c
2022-04-17 20:03:25 -05:00
Calvin Rose
0b105bc535 Merge pull request #959 from uvtc/patch-4
io.c docstrings
2022-04-17 20:03:11 -05:00
Calvin Rose
51ac9c9506 Merge pull request #961 from uvtc/patch-6
os.c docstrings
2022-04-17 20:02:56 -05:00
Calvin Rose
0310176696 Merge pull request #962 from uvtc/patch-7
parse.c docstrings
2022-04-17 20:02:26 -05:00
Calvin Rose
84a7a2bc3e Merge pull request #958 from uvtc/patch-3
buffer.c docstrings
2022-04-17 20:01:57 -05:00
Calvin Rose
1e66a7e555 Merge pull request #957 from uvtc/patch-2
array.c docstrings
2022-04-17 20:01:31 -05:00
John Gabriele
2bffb9d682 parse.c docstrings
Added some backticks around code in docstrings to distinguish them from prose.
2022-04-17 20:53:36 -04:00
John Gabriele
811125a760 os.c docstrings
Some code backticks in docstrings where useful. Also some light editing of punctuation, etc.
2022-04-17 20:42:32 -04:00
John Gabriele
0dd91082a1 math.c
Fix typo, and backticks around one word.
2022-04-17 20:15:41 -04:00
John Gabriele
c80587868e io.c docstrings
Added some backticks around code in docstrings to distinguish them from prose.
2022-04-17 20:07:05 -04:00
John Gabriele
8c52dc86c7 buffer.c docstrings
Added backticks around code in docstrings to distinguish from prose.
2022-04-17 19:49:29 -04:00
John Gabriele
be24592bc3 array.c docstrings
Added some backticks around code in docstrings to distinguish from prose.
2022-04-17 19:35:57 -04:00
Calvin Rose
0d1a5c621d Merge pull request #955 from uvtc/patch-2
string.c docstrings
2022-04-17 12:33:52 -05:00
Calvin Rose
8a3eff3b65 Merge pull request #956 from uvtc/patch-3
Update .gitattributes
2022-04-17 12:33:37 -05:00
John Gabriele
b1050b884d Update .gitattributes
Github now supports Janet.
2022-04-17 12:17:54 -04:00
John Gabriele
181d883a1d string.c docstrings
Add backticks around code values to distinguish them from prose.
2022-04-17 12:08:26 -04:00
Calvin Rose
e01b65fd3d Fix some printing issues for docs. 2022-04-16 11:40:33 -05:00
Calvin Rose
bbd74b5ae2 Merge pull request #952 from rick2600/master
#951 - fix unchecked count in cfun_buffer_new_filled
2022-04-15 16:43:11 -05:00
rick2600
d5a5c49357 #951 - fix unchecked count in cfun_buffer_new_filled 2022-04-14 16:20:04 -03:00
Calvin Rose
a964b164a6 Merge branch 'master' of github.com:janet-lang/janet 2022-04-13 17:20:49 -05:00
Calvin Rose
1aac0489d7 Add a number of defs for used dynamic bindings. 2022-04-13 17:20:33 -05:00
Calvin Rose
e474755887 Merge pull request #949 from sogaiu/syspath-defdyn
Use defdyn for syspath in boot.janet
2022-04-13 15:52:14 -05:00
sogaiu
bf9a60f70d Use defdyn for syspath in boot.janet 2022-04-13 19:39:41 +09:00
Calvin Rose
a2ba0913d3 Merge pull request #943 from cellularmitosis/make
Produce dylibs on macOS
2022-04-05 20:18:17 -05:00
Calvin Rose
f74df41fff Merge branch 'master' into make 2022-04-05 20:18:12 -05:00
Jason Pepas
43139b43b1 Produce dylibs on macOS 2022-03-31 00:17:59 -05:00
132 changed files with 13388 additions and 5633 deletions

View File

@@ -9,3 +9,4 @@ tasks:
gmake
gmake test
sudo gmake install
sudo gmake uninstall

View File

@@ -11,9 +11,10 @@ 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 -Dtyped_array=false -Dreduced_os=true
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
cd build_meson_min
ninja
- meson_prf: |
@@ -29,4 +30,3 @@ tasks:
ninja
ninja test
doas ninja install

3
.gitattributes vendored
View File

@@ -1,5 +1,4 @@
*.janet linguist-language=Clojure
*.janet linguist-language=Janet
*.janet text eol=lf
*.c text eol=lf
*.h text eol=lf

41
.github/workflows/codeql.yml vendored Normal file
View File

@@ -0,0 +1,41 @@
name: "CodeQL"
on:
push:
branches: [ "master" ]
pull_request:
branches: [ "master" ]
schedule:
- cron: "2 7 * * 4"
jobs:
analyze:
name: Analyze
runs-on: ubuntu-latest
permissions:
actions: read
contents: read
security-events: write
strategy:
fail-fast: false
matrix:
language: [ cpp ]
steps:
- name: Checkout
uses: actions/checkout@v3
- name: Initialize CodeQL
uses: github/codeql-action/init@v2
with:
languages: ${{ matrix.language }}
queries: +security-and-quality
- name: Autobuild
uses: github/codeql-action/autobuild@v2
- name: Perform CodeQL Analysis
uses: github/codeql-action/analyze@v2
with:
category: "/language:${{ matrix.language }}"

View File

@@ -5,9 +5,14 @@ on:
tags:
- "v*.*.*"
permissions:
contents: read
jobs:
release:
permissions:
contents: write # for softprops/action-gh-release to create GitHub release
name: Build release binaries
runs-on: ${{ matrix.os }}
strategy:
@@ -35,6 +40,8 @@ jobs:
build/c/shell.c
release-windows:
permissions:
contents: write # for softprops/action-gh-release to create GitHub release
name: Build release binaries for windows
runs-on: windows-latest
steps:

View File

@@ -2,6 +2,9 @@ name: Test
on: [push, pull_request]
permissions:
contents: read
jobs:
test-posix:
@@ -32,3 +35,57 @@ jobs:
- name: Test the project
shell: cmd
run: build_win test
test-mingw:
name: Build on Windows with Mingw (no test yet)
runs-on: windows-latest
defaults:
run:
shell: msys2 {0}
steps:
- name: Checkout the repository
uses: actions/checkout@master
- name: Setup Mingw
uses: msys2/setup-msys2@v2
with:
msystem: UCRT64
update: true
install: >-
base-devel
git
gcc
- name: Build the project
shell: cmd
run: make -j4 CC=gcc JANET_NO_AMALG=1
test-mingw-linux:
name: Build and test with Mingw on Linux + Wine
runs-on: ubuntu-latest
steps:
- name: Checkout the repository
uses: actions/checkout@master
- name: Setup Mingw and wine
run: |
sudo dpkg --add-architecture i386
sudo apt-get update
sudo apt-get install libstdc++6:i386 libgcc-s1:i386
sudo apt-get install gcc-mingw-w64-x86-64-win32 wine wine32 wine64
- name: Compile the project
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

11
.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
@@ -68,10 +72,13 @@ tags
vgcore.*
*.out.*
# Wix artifacts
# WiX artifacts
*.msi
*.wixpdb
# Makefile config
/config.mk
# Created by https://www.gitignore.io/api/c
### C ###

View File

@@ -1,6 +1,161 @@
# Changelog
All notable changes to this project will be documented in this file.
## 1.32.0 - 2023-10-14
- 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`
- Fix bug with closing channels while other fibers were waiting on them - `ev/take`, `ev/give`, and `ev/select` will now return the correct (documented) value when another fiber closes the channel.
- Add `ffi/calling-conventions` to show all available calling conventions for FFI.
- Add `net/setsockopt`
- Add `signal` argument to `os/proc-kill` to send signals besides `SIGKILL` on Posix.
- Add `source` argument to `os/clock` to get different time sources.
- Various combinator functions now are variadic like `map`
- Add `file/lines` to iterate over lines in a file lazily.
- Reorganize test suite to be sorted by module rather than pseudo-randomly.
- Add `*task-id*`
- Add `env` argument to `fiber/new`.
- Add `JANET_NO_AMALG` flag to Makefile to properly incremental builds
- Optimize bytecode compiler to generate fewer instructions and improve loops.
- Fix bug with `ev/gather` and hung fibers.
- Add `os/isatty`
- Add `has-key?` and `has-value?`
- Make imperative arithmetic macros variadic
- `ev/connect` now yields to the event loop instead of blocking while waiting for an ACK.
## 1.28.0 - 2023-05-13
- Various bug fixes
- Make nested short-fn's behave a bit more predictably (it is still not recommended to nest short-fns).
- Add `os/strftime` for date formatting.
- Fix `ev/select` on threaded channels sometimes live-locking.
- Support the `NO_COLOR` environment variable to turn off VT100 color codes in repl (and in scripts).
See http://no-color.org/
- Disallow using `(splice x)` in contexts where it doesn't make sense rather than silently coercing to `x`.
Instead, raise a compiler error.
- Change the names of `:user8` and `:user9` sigals to `:interrupt` and `:await`
- Change the names of `:user8` and `:user9` fiber statuses to `:interrupted` and `:suspended`.
- Add `ev/all-tasks` to see all currently suspended fibers.
- Add `keep-syntax` and `keep-syntax!` functions to make writing macros easier.
## 1.27.0 - 2023-03-05
- Change semantics around bracket tuples to no longer be equal to regular tuples.
- Add `index` argument to `ffi/write` for symmetry with `ffi/read`.
- Add `buffer/push-at`
- Add `ffi/pointer-buffer` to convert pointers to buffers the cannot be reallocated. This
allows easier manipulation of FFI memory, memory mapped files, and buffer memory shared between threads.
- Calling `ev/cancel` on a fiber waiting on `ev/gather` will correctly
cancel the child fibers.
- Add `(sandbox ...)` function to core for permission based security. Also add `janet_sandbox` to C API.
The sandbox allows limiting access to the file system, network, ffi, and OS resources at runtime.
- Add `(.locals)` function to debugger to see currently bound local symbols.
- Track symbol -> slot mapping so debugger can get symbolic information. This exposes local bindings
in `debug/stack` and `disasm`.
- Add `os/compiler` to detect what host compiler was used to compile the interpreter
- Add support for mingw and cygwin builds (mingw support also added in jpm).
## 1.26.0 - 2023-01-07
- Add `ffi/malloc` and `ffi/free`. Useful as tools of last resort.
- Add `ffi/jitfn` to allow calling function pointers generated at runtime from machine code.
Bring your own assembler, though.
- Channels can now be marshalled. Pending state is not saved, only items in the channel.
- Use the new `.length` function pointer on abstract types for lengths. Adding
a `length` method will still work as well.
- Support byte views on abstract types with the `.bytes` function pointer.
- Add the `u` format specifier to printf family functions.
- Allow printing 64 integer types in `printf` and `string/format` family functions.
- Allow importing modules from custom directories more easily with the `@` prefix
to module paths. For example, if there is a dynamic binding :custom-modules that
is a file system path to a directory of modules, import from that directory with
`(import @custom-modules/mymod)`.
- Fix error message bug in FFI library.
## 1.25.1 - 2022-10-29
- Add `memcmp` function to core library.
- Fix bug in `os/open` with `:rw` permissions not correct on Linux.
- Support config.mk for more easily configuring the Makefile.
## 1.25.0 - 2022-10-10
- Windows FFI fixes.
- Fix PEG `if-not` combinator with captures in the condition
- Fix bug with `os/date` with nil first argument
- Fix bug with `net/accept` on Linux that could leak file descriptors to subprocesses
- Reduce number of hash collisions from pointer hashing
- Add optional parameter to `marshal` to skip cycle checking code
## 1.24.1 - 2022-08-24
- Fix FFI bug on Linux/Posix
- Improve parse error messages for bad delimiters.
- Add optional `name` parameter to the `short-fn` macro.
## 1.24.0 - 2022-08-14
- Add FFI support to 64-bit windows compiled with MSVC
- Don't process shared object names passed to dlopen.
- Add better support for windows console in the default shell.c for auto-completion and
other shell-like input features.
- Improve default error message from `assert`.
- Add the `tabseq` macro for simpler table comprehensions.
- Allow setting `(dyn :task-id)` in fibers to improve context in supervisor messages. Prior to
this change, supervisor messages over threaded channels would be from ambiguous threads/fibers.
## 1.23.0 - 2022-06-20
- Add experimental `ffi/` module for interfacing with dynamic libraries and raw function pointers. Only available
on 64 bit linux, mac, and bsd systems.
- Allow using `&named` in function prototypes for named arguments. This is a more ergonomic
variant of `&keys` that isn't as redundant, more self documenting, and allows extension to
things like default arguments.
- Add `delay` macro for lazy evaluate-and-save thunks.
- Remove pthread.h from janet.h for easier includes.
- Add `debugger` - an easy to use debugger function that just takes a fiber.
- `dofile` will now start a debugger on errors if the environment it is passed has `:debug` set.
- Add `debugger-on-status` function, which can be passed to `run-context` to start a debugger on
abnormal fiber signals.
- Allow running scripts with the `-d` flag to use the built-in debugger on errors and breakpoints.
- Add mutexes (locks) and reader-writer locks to ev module for thread coordination.
- Add `parse-all` as a generalization of the `parse` function.
- Add `os/cpu-count` to get the number of available processors on a machine
## 1.22.0 - 2022-05-09
- Prohibit negative size argument to `table/new`.
- Add `module/value`.
- Remove `file/popen`. Use `os/spawn` with the `:pipe` options instead.
- Fix bug in peg `thru` and `to` combinators.
- Fix printing issue in `doc` macro.
- Numerous updates to function docstrings
- Add `defdyn` aliases for various dynamic bindings used in core.
- Install `janet.h` symlink to make Janet native libraries and applications
easier to build without `jpm`.
## 1.21.2 - 2022-04-01
- C functions `janet_dobytes` and `janet_dostring` will now enter the event loop if it is enabled.
- Fix hashing regression - hash of negative 0 must be the same as positive 0 since they are equal.

View File

@@ -43,7 +43,7 @@ For changes to the VM and Core code, you will probably need to know C. Janet is
a subset of C99 that works with Microsoft Visual C++. This means most of C99 but with the following
omissions.
* No `restrict`
* No `restrict`
* Certain functions in the standard library are not always available
In practice, this means programming for both MSVC on one hand and everything else on the other.
@@ -64,6 +64,23 @@ ensure a consistent code style for C.
All janet code in the project should be formatted similar to the code in core.janet.
The auto formatting from janet.vim will work well.
## Typo Fixing and One-Line changes
Typo fixes are welcome, as are simple one line fixes. Do not open many separate pull requests for each
individual typo fix. This is incredibly annoying to deal with as someone needs to review each PR, run
CI, and merge. Instead, accumulate batches of typo fixes into a single PR. If there are objections to
specific changes, these can be addressed in the review process before the final merge, if the changes
are accepted.
Similarly, low effort and bad faith changes are annoying to developers and such issues may be closed
immediately without response.
## Contributions from Automated Tools
People making changes found or generated by automated tools MUST note this when opening an issue
or creating a pull request. This can help give context to developers if the change/issue is
confusing or nonsensical.
## Suggesting Changes
To suggest changes, open an issue on GitHub. Check GitHub for other issues

View File

@@ -1,4 +1,4 @@
Copyright (c) 2021 Calvin Rose and contributors
Copyright (c) 2023 Calvin Rose and contributors
Permission is hereby granted, free of charge, to any person obtaining a copy of
this software and associated documentation files (the "Software"), to deal in

111
Makefile
View File

@@ -1,4 +1,4 @@
# Copyright (c) 2021 Calvin Rose
# Copyright (c) 2023 Calvin Rose
#
# Permission is hereby granted, free of charge, to any person obtaining a copy
# of this software and associated documentation files (the "Software"), to
@@ -21,21 +21,26 @@
################################
##### Set global variables #####
################################
sinclude config.mk
PREFIX?=/usr/local
JANETCONF_HEADER?=src/conf/janetconf.h
INCLUDEDIR?=$(PREFIX)/include
BINDIR?=$(PREFIX)/bin
LIBDIR?=$(PREFIX)/lib
JANET_BUILD?="\"$(shell git log --pretty=format:'%h' -n 1 2> /dev/null || echo local)\""
CLIBS=-lm -lpthread
JANET_TARGET=build/janet
JANET_BOOT=build/janet_boot
JANET_IMPORT_LIB=build/janet.lib
JANET_LIBRARY=build/libjanet.so
JANET_STATIC_LIBRARY=build/libjanet.a
JANET_PATH?=$(LIBDIR)/janet
JANET_MANPATH?=$(PREFIX)/share/man/man1/
JANET_PKG_CONFIG_PATH?=$(LIBDIR)/pkgconfig
JANET_DIST_DIR?=janet-dist
JANET_BOOT_FLAGS:=. JANET_PATH '$(JANET_PATH)'
JANET_TARGET_OBJECTS=build/janet.o build/shell.o
JPM_TAG?=master
DEBUGGER=gdb
SONAME_SETTER=-Wl,-soname,
@@ -43,21 +48,30 @@ SONAME_SETTER=-Wl,-soname,
# For cross compilation
HOSTCC?=$(CC)
HOSTAR?=$(AR)
CFLAGS?=-O2
# Symbols are (optionally) removed later, keep -g as default!
CFLAGS?=-O2 -g
LDFLAGS?=-rdynamic
RUN:=$(RUN)
COMMON_CFLAGS:=-std=c99 -Wall -Wextra -Isrc/include -Isrc/conf -fvisibility=hidden -fPIC
BOOT_CFLAGS:=-DJANET_BOOTSTRAP -DJANET_BUILD=$(JANET_BUILD) -O0 -g $(COMMON_CFLAGS)
BOOT_CFLAGS:=-DJANET_BOOTSTRAP -DJANET_BUILD=$(JANET_BUILD) -O0 $(COMMON_CFLAGS) -g
BUILD_CFLAGS:=$(CFLAGS) $(COMMON_CFLAGS)
# Disable amalgamated build
ifeq ($(JANET_NO_AMALG), 1)
JANET_TARGET_OBJECTS+=$(patsubst src/%.c,build/%.bin.o,$(JANET_CORE_SOURCES))
JANET_BOOT_FLAGS+=image-only
endif
# For installation
LDCONFIG:=ldconfig "$(LIBDIR)"
# Check OS
UNAME:=$(shell uname -s)
UNAME?=$(shell uname -s)
ifeq ($(UNAME), Darwin)
CLIBS:=$(CLIBS) -ldl
SONAME_SETTER:=-Wl,-install_name,
JANET_LIBRARY=build/libjanet.dylib
LDCONFIG:=true
else ifeq ($(UNAME), Linux)
CLIBS:=$(CLIBS) -lrt -ldl
@@ -75,14 +89,22 @@ ifeq ($(shell uname -o), Android)
endif
endif
$(shell mkdir -p build/core build/c build/boot)
# Mingw
ifeq ($(findstring MINGW,$(UNAME)), MINGW)
CLIBS:=-lws2_32 -lpsapi -lwsock32
LDFLAGS:=-Wl,--out-implib,$(JANET_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
######################
##### Name Files #####
######################
JANET_HEADERS=src/include/janet.h src/conf/janetconf.h
JANET_HEADERS=src/include/janet.h $(JANETCONF_HEADER)
JANET_LOCAL_HEADERS=src/core/features.h \
src/core/util.h \
@@ -107,6 +129,7 @@ JANET_CORE_SOURCES=src/core/abstract.c \
src/core/debug.c \
src/core/emit.c \
src/core/ev.c \
src/core/ffi.c \
src/core/fiber.c \
src/core/gc.c \
src/core/inttypes.c \
@@ -153,42 +176,53 @@ $(JANET_BOOT_OBJECTS): $(JANET_BOOT_HEADERS)
build/%.boot.o: src/%.c $(JANET_HEADERS) $(JANET_LOCAL_HEADERS) Makefile
$(CC) $(BOOT_CFLAGS) -o $@ -c $<
build/janet_boot: $(JANET_BOOT_OBJECTS)
$(JANET_BOOT): $(JANET_BOOT_OBJECTS)
$(CC) $(BOOT_CFLAGS) -o $@ $(JANET_BOOT_OBJECTS) $(CLIBS)
# Now the reason we bootstrap in the first place
build/c/janet.c: build/janet_boot src/boot/boot.janet
build/janet_boot . JANET_PATH '$(JANET_PATH)' > $@
build/c/janet.c: $(JANET_BOOT) src/boot/boot.janet
$(RUN) $(JANET_BOOT) $(JANET_BOOT_FLAGS) > $@
cksum $@
##################
##### Quicky #####
##################
build/%.bin.o: src/%.c $(JANET_HEADERS) $(JANET_LOCAL_HEADERS) Makefile
$(HOSTCC) $(BUILD_CFLAGS) -o $@ -c $<
########################
##### Amalgamation #####
########################
SONAME=libjanet.so.1.21
ifeq ($(UNAME), Darwin)
SONAME=libjanet.1.32.dylib
else
SONAME=libjanet.so.1.32
endif
build/c/shell.c: src/mainclient/shell.c
cp $< $@
build/janet.h: $(JANET_TARGET) src/include/janet.h src/conf/janetconf.h
./$(JANET_TARGET) tools/patch-header.janet src/include/janet.h src/conf/janetconf.h $@
build/janet.h: $(JANET_TARGET) src/include/janet.h $(JANETCONF_HEADER)
$(RUN) ./$(JANET_TARGET) tools/patch-header.janet src/include/janet.h $(JANETCONF_HEADER) $@
build/janetconf.h: src/conf/janetconf.h
build/janetconf.h: $(JANETCONF_HEADER)
cp $< $@
build/janet.o: build/c/janet.c src/conf/janetconf.h src/include/janet.h
build/janet.o: build/c/janet.c $(JANETCONF_HEADER) src/include/janet.h
$(HOSTCC) $(BUILD_CFLAGS) -c $< -o $@
build/shell.o: build/c/shell.c src/conf/janetconf.h src/include/janet.h
build/shell.o: build/c/shell.c $(JANETCONF_HEADER) src/include/janet.h
$(HOSTCC) $(BUILD_CFLAGS) -c $< -o $@
$(JANET_TARGET): build/janet.o build/shell.o
$(JANET_TARGET): $(JANET_TARGET_OBJECTS)
$(HOSTCC) $(LDFLAGS) $(BUILD_CFLAGS) -o $@ $^ $(CLIBS)
$(JANET_LIBRARY): build/janet.o build/shell.o
$(JANET_LIBRARY): $(JANET_TARGET_OBJECTS)
$(HOSTCC) $(LDFLAGS) $(BUILD_CFLAGS) $(SONAME_SETTER)$(SONAME) -shared -o $@ $^ $(CLIBS)
$(JANET_STATIC_LIBRARY): build/janet.o build/shell.o
$(JANET_STATIC_LIBRARY): $(JANET_TARGET_OBJECTS)
$(HOSTAR) rcs $@ $^
###################
@@ -200,19 +234,19 @@ $(JANET_STATIC_LIBRARY): build/janet.o build/shell.o
TEST_SCRIPTS=$(wildcard test/suite*.janet)
repl: $(JANET_TARGET)
./$(JANET_TARGET)
$(RUN) ./$(JANET_TARGET)
debug: $(JANET_TARGET)
$(DEBUGGER) ./$(JANET_TARGET)
VALGRIND_COMMAND=valgrind --leak-check=full
VALGRIND_COMMAND=valgrind --leak-check=full --quiet
valgrind: $(JANET_TARGET)
$(VALGRIND_COMMAND) ./$(JANET_TARGET)
test: $(JANET_TARGET) $(TEST_PROGRAMS)
for f in test/suite*.janet; do ./$(JANET_TARGET) "$$f" || exit; done
for f in examples/*.janet; do ./$(JANET_TARGET) -k "$$f"; done
for f in test/suite*.janet; do $(RUN) ./$(JANET_TARGET) "$$f" || exit; done
for f in examples/*.janet; do $(RUN) ./$(JANET_TARGET) -k "$$f"; done
valtest: $(JANET_TARGET) $(TEST_PROGRAMS)
for f in test/suite*.janet; do $(VALGRIND_COMMAND) ./$(JANET_TARGET) "$$f" || exit; done
@@ -233,6 +267,7 @@ build/janet-%.tar.gz: $(JANET_TARGET) \
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/
@@ -251,7 +286,7 @@ build/janet-%.tar.gz: $(JANET_TARGET) \
docs: build/doc.html
build/doc.html: $(JANET_TARGET) tools/gendoc.janet
$(JANET_TARGET) tools/gendoc.janet > build/doc.html
$(RUN) $(JANET_TARGET) tools/gendoc.janet > build/doc.html
########################
##### Installation #####
@@ -267,7 +302,7 @@ build/janet.pc: $(JANET_TARGET)
echo "Name: janet" >> $@
echo "Url: https://janet-lang.org" >> $@
echo "Description: Library for the Janet programming language." >> $@
$(JANET_TARGET) -e '(print "Version: " janet/version)' >> $@
$(RUN) $(JANET_TARGET) -e '(print "Version: " janet/version)' >> $@
echo 'Cflags: -I$${includedir}' >> $@
echo 'Libs: -L$${libdir} -ljanet' >> $@
echo 'Libs.private: $(CLIBS)' >> $@
@@ -275,19 +310,28 @@ 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 -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'
mkdir -p '$(DESTDIR)$(JANET_PATH)'
mkdir -p '$(DESTDIR)$(LIBDIR)'
cp $(JANET_LIBRARY) '$(DESTDIR)$(LIBDIR)/libjanet.so.$(shell $(JANET_TARGET) -e '(print janet/version)')'
if test $(UNAME) = Darwin ; then \
cp $(JANET_LIBRARY) '$(DESTDIR)$(LIBDIR)/libjanet.$(shell $(JANET_TARGET) -e '(print janet/version)').dylib' ; \
ln -sf $(SONAME) '$(DESTDIR)$(LIBDIR)/libjanet.dylib' ; \
ln -sf libjanet.$(shell $(JANET_TARGET) -e '(print janet/version)').dylib $(DESTDIR)$(LIBDIR)/$(SONAME) ; \
else \
cp $(JANET_LIBRARY) '$(DESTDIR)$(LIBDIR)/libjanet.so.$(shell $(JANET_TARGET) -e '(print janet/version)')' ; \
ln -sf $(SONAME) '$(DESTDIR)$(LIBDIR)/libjanet.so' ; \
ln -sf libjanet.so.$(shell $(JANET_TARGET) -e '(print janet/version)') $(DESTDIR)$(LIBDIR)/$(SONAME) ; \
fi
cp $(JANET_STATIC_LIBRARY) '$(DESTDIR)$(LIBDIR)/libjanet.a'
ln -sf $(SONAME) '$(DESTDIR)$(LIBDIR)/libjanet.so'
ln -sf libjanet.so.$(shell $(JANET_TARGET) -e '(print janet/version)') $(DESTDIR)$(LIBDIR)/$(SONAME)
mkdir -p '$(DESTDIR)$(JANET_MANPATH)'
cp janet.1 '$(DESTDIR)$(JANET_MANPATH)'
mkdir -p '$(DESTDIR)$(JANET_PKG_CONFIG_PATH)'
cp build/janet.pc '$(DESTDIR)$(JANET_PKG_CONFIG_PATH)/janet.pc'
[ -z '$(DESTDIR)' ] && $(LDCONFIG) || true
cp '$(JANET_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)
mkdir -p build
@@ -299,11 +343,12 @@ install-jpm-git: $(JANET_TARGET)
JANET_HEADERPATH='$(INCLUDEDIR)/janet' \
JANET_BINPATH='$(BINDIR)' \
JANET_LIBPATH='$(LIBDIR)' \
../../$(JANET_TARGET) ./bootstrap.janet
$(RUN) ../../$(JANET_TARGET) ./bootstrap.janet
uninstall:
-rm '$(DESTDIR)$(BINDIR)/janet'
-rm -rf '$(DESTDIR)$(INCLUDEDIR)/janet'
-rm -rf '$(DESTDIR)$(INCLUDEDIR)/janet.h'
-rm -rf '$(DESTDIR)$(LIBDIR)'/libjanet.*
-rm '$(DESTDIR)$(JANET_PKG_CONFIG_PATH)/janet.pc'
-rm '$(DESTDIR)$(JANET_MANPATH)/janet.1'
@@ -314,14 +359,14 @@ uninstall:
#################
format:
tools/format.sh
sh tools/format.sh
grammar: build/janet.tmLanguage
build/janet.tmLanguage: tools/tm_lang_gen.janet $(JANET_TARGET)
$(JANET_TARGET) $< > $@
$(RUN) $(JANET_TARGET) $< > $@
compile-commands:
# Requires pip install copmiledb
# Requires pip install compiledb
compiledb make
clean:

240
README.md
View File

@@ -1,63 +1,136 @@
[![Join the chat](https://badges.gitter.im/janet-language/community.svg)](https://gitter.im/janet-language/community)
&nbsp;
[![builds.sr.ht status](https://builds.sr.ht/~bakpakin/janet/commits/freebsd.yml.svg)](https://builds.sr.ht/~bakpakin/janet/commits/freebsd.yml?)
[![builds.sr.ht status](https://builds.sr.ht/~bakpakin/janet/commits/openbsd.yml.svg)](https://builds.sr.ht/~bakpakin/janet/commits/openbsd.yml?)
[![builds.sr.ht status](https://builds.sr.ht/~bakpakin/janet/commits/master/freebsd.yml.svg)](https://builds.sr.ht/~bakpakin/janet/commits/master/freebsd.yml?)
[![builds.sr.ht status](https://builds.sr.ht/~bakpakin/janet/commits/master/openbsd.yml.svg)](https://builds.sr.ht/~bakpakin/janet/commits/master/openbsd.yml?)
[![Actions Status](https://github.com/janet-lang/janet/actions/workflows/test.yml/badge.svg)](https://github.com/janet-lang/janet/actions/workflows/test.yml)
<img src="https://raw.githubusercontent.com/janet-lang/janet/master/assets/janet-w200.png" alt="Janet logo" width=200 align="left">
**Janet** is a functional and imperative programming language and bytecode interpreter. It is a
lisp-like language, but lists are replaced
by other data structures (arrays, tables (hash table), struct (immutable hash table), tuples).
The language also supports bridging to native code written in C, meta-programming with macros, and bytecode assembly.
**Janet** is a programming language for system scripting, expressive automation, and
extending programs written in C or C++ with user scripting capabilities.
Janet makes a good system scripting language, or a language to embed in other programs.
It's like Lua and GNU Guile in that regard. It has more built-in functionality and a richer core language than
Lua, but smaller than GNU Guile or Python. However, it is much easier to embed and port than Python or Guile.
There is a REPL for trying out the language, as well as the ability
to run script files. This client program is separate from the core runtime, so
Janet can be embedded in other programs. Try Janet in your browser at
[https://janet-lang.org](https://janet-lang.org).
<https://janet-lang.org>.
If you'd like to financially support the ongoing development of Janet, consider
[sponsoring its primary author](https://github.com/sponsors/bakpakin) through GitHub.
<br>
## Use Cases
## Examples
Janet makes a good system scripting language, or a language to embed in other programs.
It's like Lua and Guile in that regard. It has more built-in functionality and a richer core language than
Lua, but smaller than GNU Guile or Python.
See the examples directory for all provided example programs.
## Features
### Game of Life
* Configurable at build time - turn features on or off for a smaller or more featureful build
* Minimal setup - one binary and you are good to go!
```janet
# John Conway's Game of Life
(def- window
(seq [x :range [-1 2]
y :range [-1 2]
:when (not (and (zero? x) (zero? y)))]
[x y]))
(defn- neighbors
[[x y]]
(map (fn [[x1 y1]] [(+ x x1) (+ y y1)]) window))
(defn tick
"Get the next state in the Game Of Life."
[state]
(def cell-set (frequencies state))
(def neighbor-set (frequencies (mapcat neighbors state)))
(seq [coord :keys neighbor-set
:let [count (get neighbor-set coord)]
:when (or (= count 3) (and (get cell-set coord) (= count 2)))]
coord))
(defn draw
"Draw cells in the game of life from (x1, y1) to (x2, y2)"
[state x1 y1 x2 y2]
(def cellset @{})
(each cell state (put cellset cell true))
(loop [x :range [x1 (+ 1 x2)]
:after (print)
y :range [y1 (+ 1 y2)]]
(file/write stdout (if (get cellset [x y]) "X " ". ")))
(print))
# Print the first 20 generations of a glider
(var *state* '[(0 0) (-1 0) (1 0) (1 1) (0 2)])
(for i 0 20
(print "generation " i)
(draw *state* -7 -7 7 7)
(set *state* (tick *state*)))
```
### TCP Echo Server
```janet
# A simple TCP echo server using the built-in socket networking and event loop.
(defn handler
"Simple handler for connections."
[stream]
(defer (:close stream)
(def id (gensym))
(def b @"")
(print "Connection " id "!")
(while (:read stream 1024 b)
(printf " %v -> %v" id b)
(:write stream b)
(buffer/clear b))
(printf "Done %v!" id)
(ev/sleep 0.5)))
(net/server "127.0.0.1" "8000" handler)
```
### Windows FFI Hello, World!
```janet
# Use the FFI to popup a Windows message box - no C required
(ffi/context "user32.dll")
(ffi/defbind MessageBoxA :int
[w :ptr text :string cap :string typ :int])
(MessageBoxA nil "Hello, World!" "Test" 0)
```
## Language Features
* 600+ functions and macros in the core library
* Built-in socket networking, threading, subprocesses, and file system functions.
* Parsing Expression Grammars (PEG) engine as a more robust Regex alternative
* Macros and compile-time computation
* Per-thread event loop for efficient IO (epoll/IOCP/kqueue)
* First-class green threads (continuations) as well as OS threads
* Erlang-style supervision trees that integrate with the event loop
* First-class closures
* Garbage collection
* First-class green threads (continuations)
* Distributed as janet.c and janet.h for embedding into a larger program.
* Python-style generators (implemented as a plain macro)
* Mutable and immutable arrays (array/tuple)
* Mutable and immutable hashtables (table/struct)
* Mutable and immutable strings (buffer/string)
* Macros
* Multithreading
* Per-thread event loop for efficient evented IO
* Byte code interpreter with an assembly interface, as well as bytecode verification
* Tail call Optimization
* Direct interop with C via abstract types and C functions
* Dynamically load C libraries
* Functional and imperative standard library
* Lexical scoping
* Imperative programming as well as functional
* REPL
* Parsing Expression Grammars built into the core library
* 400+ functions and macros in the core library
* Embedding Janet in other programs
* Interactive environment with detailed stack traces
* Tail recursion
* Interface with C functions and dynamically load plugins ("natives").
* Built-in C FFI for when the native bindings are too much work
* REPL development with debugger and inspectable runtime
## Documentation
* For a quick tutorial, see [the introduction](https://janet-lang.org/docs/index.html) for more details.
* For the full API for all functions in the core library, see [the core API doc](https://janet-lang.org/api/index.html)
* For the full API for all functions in the core library, see [the core API doc](https://janet-lang.org/api/index.html).
Documentation is also available locally in the REPL.
Use the `(doc symbol-name)` macro to get API
@@ -65,7 +138,7 @@ documentation for symbols in the core library. For example,
```
(doc apply)
```
Shows documentation for the `apply` function.
shows documentation for the `apply` function.
To get a list of all bindings in the default
environment, use the `(all-bindings)` function. You
@@ -84,11 +157,13 @@ the SourceHut mirror is actively maintained.
The Makefile is non-portable and requires GNU-flavored make.
```
```sh
cd somewhere/my/projects/janet
make
make test
make repl
make install
make install-jpm-git
```
Find out more about the available make targets by running `make help`.
@@ -98,42 +173,45 @@ Find out more about the available make targets by running `make help`.
32-bit Haiku build instructions are the same as the UNIX-like build instructions,
but you need to specify an alternative compiler, such as `gcc-x86`.
```
```sh
cd somewhere/my/projects/janet
make CC=gcc-x86
make test
make repl
make install
make install-jpm-git
```
### FreeBSD
FreeBSD build instructions are the same as the UNIX-like build instructions,
but you need `gmake` to compile. Alternatively, install directly from
packages, using `pkg install lang/janet`.
but you need `gmake` to compile. Alternatively, install the package directly with `pkg install lang/janet`.
```
```sh
cd somewhere/my/projects/janet
gmake
gmake test
gmake repl
gmake install
gmake install-jpm-git
```
### NetBSD
NetBSD build instructions are the same as the FreeBSD build instructions.
Alternatively, install directly from packages, using `pkgin install janet`.
Alternatively, install the package directly with `pkgin install janet`.
### Windows
1. Install [Visual Studio](https://visualstudio.microsoft.com/thank-you-downloading-visual-studio/?sku=Community&rel=15#) or [Visual Studio Build Tools](https://visualstudio.microsoft.com/thank-you-downloading-visual-studio/?sku=BuildTools&rel=15#)
2. Run a Visual Studio Command Prompt (cl.exe and link.exe need to be on the PATH) and cd to the directory with janet.
3. Run `build_win` to compile janet.
1. Install [Visual Studio](https://visualstudio.microsoft.com/thank-you-downloading-visual-studio/?sku=Community&rel=15#) or [Visual Studio Build Tools](https://visualstudio.microsoft.com/thank-you-downloading-visual-studio/?sku=BuildTools&rel=15#).
2. Run a Visual Studio Command Prompt (`cl.exe` and `link.exe` need to be on your PATH) and `cd` to the directory with Janet.
3. Run `build_win` to compile Janet.
4. Run `build_win test` to make sure everything is working.
To build an `.msi` installer executable, in addition to the above steps, you will have to:
5. Install, or otherwise add to your PATH the [WiX 3.11 Toolset](https://github.com/wixtoolset/wix3/releases)
6. run `build_win dist`
5. Install, or otherwise add to your PATH the [WiX 3.11 Toolset](https://github.com/wixtoolset/wix3/releases).
6. Run `build_win dist`.
Now you should have an `.msi`. You can run `build_win install` to install the `.msi`, or execute the file itself.
@@ -169,9 +247,9 @@ ninja -C build install
Janet can be hacked on with pretty much any environment you like, but for IDE
lovers, [Gnome Builder](https://wiki.gnome.org/Apps/Builder) is probably the
best option, as it has excellent meson integration. It also offers code completion
best option, as it has excellent Meson integration. It also offers code completion
for Janet's C API right out of the box, which is very useful for exploring. VSCode, Vim,
Emacs, and Atom will have syntax packages for the Janet language, though.
Emacs, and Atom each have syntax packages for the Janet language, though.
## Installation
@@ -180,8 +258,8 @@ to try out the language, you don't need to install anything. You can also move t
## Usage
A REPL is launched when the binary is invoked with no arguments. Pass the -h flag
to display the usage information. Individual scripts can be run with `./janet myscript.janet`
A REPL is launched when the binary is invoked with no arguments. Pass the `-h` flag
to display the usage information. Individual scripts can be run with `./janet myscript.janet`.
If you are looking to explore, you can print a list of all available macros, functions, and constants
by entering the command `(all-bindings)` into the REPL.
@@ -196,20 +274,26 @@ Hello, World!
nil
janet:3:> (os/exit)
$ janet -h
usage: build/janet [options] script args...
usage: janet [options] script args...
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 prompt, logo, and REPL output (quiet)
-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
-l path : Execute code in a file before running the main script
-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
```
@@ -220,8 +304,8 @@ If installed, you can also run `man janet` to get usage information.
Janet can be embedded in a host program very easily. The normal build
will create a file `build/janet.c`, which is a single C file
that contains all the source to Janet. This file, along with
`src/include/janet.h` and `src/conf/janetconf.h` can be dragged into any C
project and compiled into the project. Janet should be compiled with `-std=c99`
`src/include/janet.h` and `src/conf/janetconf.h`, can be dragged into any C
project and compiled into it. Janet should be compiled with `-std=c99`
on most compilers, and will need to be linked to the math library, `-lm`, and
the dynamic linker, `-ldl`, if one wants to be able to load dynamic modules. If
there is no need for dynamic modules, add the define
@@ -229,26 +313,36 @@ there is no need for dynamic modules, add the define
See the [Embedding Section](https://janet-lang.org/capi/embedding.html) on the website for more information.
## Examples
See the examples directory for some example janet code.
## 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 Gitter channel](https://gitter.im/janet-language/community).
Gitter provides Matrix and IRC bridges as well.
## FAQ
### How fast is it?
It is about the same speed as most interpreted languages without a JIT compiler. Tight, critical
loops should probably be written in C or C++ . Programs tend to be a bit faster than
they would be in a language like Python due to the discouragement of slow Object-Oriented abstraction
with lots of hash-table lookups, and making late-binding explicit. All values are boxed in an 8-byte
representation by default and allocated on the heap, with the exception of numbers, nils and booleans. The
PEG engine is a specialized interpreter that can efficiently process string and buffer data.
The GC is simple and stop-the-world, but GC knobs are exposed in the core library and separate threads
have isolated heaps and garbage collectors. Data that is shared between threads is reference counted.
YMMV.
### Where is (favorite feature from other language)?
It may exist, it may not. If you want to propose major language features, go ahead and open an issue, but
they will likely by closed as "will not implement". Often, such features make one usecase simpler at the expense
It may exist, it may not. If you want to propose a major language feature, go ahead and open an issue, but
it will likely be closed as "will not implement". Often, such features make one usecase simpler at the expense
of 5 others by making the language more complicated.
### Is there a language spec?
There is not currently a spec besides the documentation at https://janet-lang.org.
There is not currently a spec besides the documentation at <https://janet-lang.org>.
### Is this Scheme/Common Lisp? Where are the cons cells?
@@ -257,20 +351,20 @@ Nope. There are no cons cells here.
### Is this a Clojure port?
No. It's similar to Clojure superficially because I like Lisps and I like the aesthetics.
Internally, Janet is not at all like Clojure.
Internally, Janet is not at all like Clojure, Scheme, or Common Lisp.
### Are the immutable data structures (tuples and structs) implemented as hash tries?
No. They are immutable arrays and hash tables. Don't try and use them like Clojure's vectors
and maps, instead they work well as table keys or other identifiers.
### Can I do Object Oriented programming with Janet?
### Can I do object-oriented programming with Janet?
To some extent, yes. However, it is not the recommended method of abstraction, and performance may suffer.
That said, tables can be used to make mutable objects with inheritance and polymorphism, where object
methods are implemeted with keywords.
methods are implemented with keywords.
```
```clj
(def Car @{:honk (fn [self msg] (print "car " self " goes " msg)) })
(def my-car (table/setproto @{} Car))
(:honk my-car "Beep!")
@@ -281,17 +375,25 @@ methods are implemeted with keywords.
Usually, one of a few reasons:
- Often, it already exists in a different form and the Clojure port would be redundant.
- Clojure programs often generate a lot of garbage and rely on the JVM to clean it up.
Janet does not run on the JVM, and has a more primitive garbage collector.
- We want to keep the Janet core small. With Lisps, usually a feature can be added as a library
without feeling "bolted on", especially when compared to ALGOL like languages. Adding features
Janet does not run on the JVM and has a more primitive garbage collector.
- We want to keep the Janet core small. With Lisps, a feature can usually be added as a library
without feeling "bolted on", especially when compared to ALGOL-like languages. Adding features
to the core also makes it a bit more difficult to keep Janet maximally portable.
### 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 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.
### Why is my terminal spitting out junk when I run the REPL?
Make sure your terminal supports ANSI escape codes. Most modern terminals will
support these, but some older terminals, Windows consoles, or embedded terminals
will not. If your terminal does not support ANSI escape codes, run the REPL with
the `-n` flag, which disables color output. You can also try the `-s` if further issues
the `-n` flag, which disables color output. You can also try the `-s` flag if further issues
ensue.
## Why is it called "Janet"?

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. ==
@@ -98,7 +98,7 @@ exit /b 0
: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 +117,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

45
examples/evlocks.janet Normal file
View File

@@ -0,0 +1,45 @@
(defn sleep
"Sleep the entire thread, not just a single fiber."
[n]
(os/sleep (* 0.1 n)))
(defn work [lock n]
(ev/acquire-lock lock)
(print "working " n "...")
(sleep n)
(print "done working...")
(ev/release-lock lock))
(defn reader
[rwlock n]
(ev/acquire-rlock rwlock)
(print "reading " n "...")
(sleep n)
(print "done reading " n "...")
(ev/release-rlock rwlock))
(defn writer
[rwlock n]
(ev/acquire-wlock rwlock)
(print "writing " n "...")
(sleep n)
(print "done writing...")
(ev/release-wlock rwlock))
(defn test-lock
[]
(def lock (ev/lock))
(for i 3 7
(ev/spawn-thread
(work lock i))))
(defn test-rwlock
[]
(def rwlock (ev/rwlock))
(for i 0 20
(if (> 0.1 (math/random))
(ev/spawn-thread (writer rwlock i))
(ev/spawn-thread (reader rwlock i)))))
(test-rwlock)
(test-lock)

71
examples/ffi/gtk.janet Normal file
View File

@@ -0,0 +1,71 @@
# :lazy true needed for jpm quickbin
# lazily loads library on first function use
# so the `main` function
# can be marshalled.
(ffi/context "/usr/lib/libgtk-3.so" :lazy true)
(ffi/defbind
gtk-application-new :ptr
"Add docstrings as needed."
[title :string flags :uint])
(ffi/defbind
g-signal-connect-data :ulong
[a :ptr b :ptr c :ptr d :ptr e :ptr f :int])
(ffi/defbind
g-application-run :int
[app :ptr argc :int argv :ptr])
(ffi/defbind
gtk-application-window-new :ptr
[a :ptr])
(ffi/defbind
gtk-button-new-with-label :ptr
[a :ptr])
(ffi/defbind
gtk-container-add :void
[a :ptr b :ptr])
(ffi/defbind
gtk-widget-show-all :void
[a :ptr])
(ffi/defbind
gtk-button-set-label :void
[a :ptr b :ptr])
(def cb (delay (ffi/trampoline :default)))
(defn ffi/array
``Convert a janet array to a buffer that can be passed to FFI functions.
For example, to create an array of type `char *` (array of c strings), one
could use `(ffi/array ["hello" "world"] :ptr)`. One needs to be careful that
array elements are not garbage collected though - the GC can't follow references
inside an arbitrary byte buffer.``
[arr ctype &opt buf]
(default buf @"")
(each el arr
(ffi/write ctype el buf))
buf)
(defn on-active
[app]
(def window (gtk-application-window-new app))
(def btn (gtk-button-new-with-label "Click Me!"))
(g-signal-connect-data btn "clicked" (cb)
(fn [btn] (gtk-button-set-label btn "Hello World"))
nil 1)
(gtk-container-add window btn)
(gtk-widget-show-all window))
(defn main
[&]
(def app (gtk-application-new "org.janet-lang.example.HelloApp" 0))
(g-signal-connect-data app "activate" (cb) on-active nil 1)
# manually build an array with ffi/write
# - we are responsible for preventing gc when the arg array is used
(def argv (ffi/array (dyn *args*) :string))
(g-application-run app (length (dyn *args*)) argv))

205
examples/ffi/so.c Normal file
View File

@@ -0,0 +1,205 @@
#include <stdio.h>
#include <stdint.h>
#include <string.h>
#ifdef _WIN32
#define EXPORTER __declspec(dllexport)
#else
#define EXPORTER
#endif
/* Structs */
typedef struct {
int a, b;
float c, d;
} Split;
typedef struct {
float c, d;
int a, b;
} SplitFlip;
typedef struct {
int u, v, w, x, y, z;
} SixInts;
typedef struct {
int a;
int b;
} intint;
typedef struct {
int a;
int b;
int c;
} intintint;
typedef struct {
int64_t a;
int64_t b;
int64_t c;
} big;
/* Functions */
EXPORTER
int int_fn(int a, int b) {
return (a << 2) + b;
}
EXPORTER
double my_fn(int64_t a, int64_t b, const char *x) {
return (double)(a + b) + 0.5 + strlen(x);
}
EXPORTER
double double_fn(double x, double y, double z) {
return (x + y) * z * 3;
}
EXPORTER
double double_many(double x, double y, double z, double w, double a, double b) {
return x + y + z + w + a + b;
}
EXPORTER
double double_lots(
double a,
double b,
double c,
double d,
double e,
double f,
double g,
double h,
double i,
double j) {
return i + j;
}
EXPORTER
double double_lots_2(
double a,
double b,
double c,
double d,
double e,
double f,
double g,
double h,
double i,
double j) {
return a +
10.0 * b +
100.0 * c +
1000.0 * d +
10000.0 * e +
100000.0 * f +
1000000.0 * g +
10000000.0 * h +
100000000.0 * i +
1000000000.0 * j;
}
EXPORTER
double float_fn(float x, float y, float z) {
return (x + y) * z;
}
EXPORTER
int intint_fn(double x, intint ii) {
printf("double: %g\n", x);
return ii.a + ii.b;
}
EXPORTER
int intintint_fn(double x, intintint iii) {
printf("double: %g\n", x);
return iii.a + iii.b + iii.c;
}
EXPORTER
intint return_struct(int i) {
intint ret;
ret.a = i;
ret.b = i * i;
return ret;
}
EXPORTER
big struct_big(int i, double d) {
big ret;
ret.a = i;
ret.b = (int64_t) d;
ret.c = ret.a + ret.b + 1000;
return ret;
}
EXPORTER
void void_fn(void) {
printf("void fn ran\n");
}
EXPORTER
void void_fn_2(double y) {
printf("y = %f\n", y);
}
EXPORTER
void void_ret_fn(int x) {
printf("void fn ran: %d\n", x);
}
EXPORTER
int intintint_fn_2(intintint iii, int i) {
fprintf(stderr, "iii.a = %d, iii.b = %d, iii.c = %d, i = %d\n", iii.a, iii.b, iii.c, i);
return i * (iii.a + iii.b + iii.c);
}
EXPORTER
float split_fn(Split s) {
return s.a * s.c + s.b * s.d;
}
EXPORTER
float split_flip_fn(SplitFlip s) {
return s.a * s.c + s.b * s.d;
}
EXPORTER
Split split_ret_fn(int x, float y) {
Split ret;
ret.a = x;
ret.b = x;
ret.c = y;
ret.d = y;
return ret;
}
EXPORTER
SplitFlip split_flip_ret_fn(int x, float y) {
SplitFlip ret;
ret.a = x;
ret.b = x;
ret.c = y;
ret.d = y;
return ret;
}
EXPORTER
SixInts sixints_fn(void) {
return (SixInts) {
6666, 1111, 2222, 3333, 4444, 5555
};
}
EXPORTER
int sixints_fn_2(int x, SixInts s) {
return x + s.u + s.v + s.w + s.x + s.y + s.z;
}
EXPORTER
int sixints_fn_3(SixInts s, int x) {
return x + s.u + s.v + s.w + s.x + s.y + s.z;
}

134
examples/ffi/test.janet Normal file
View File

@@ -0,0 +1,134 @@
#
# Simple FFI test script that tests against a simple shared object
#
(def is-windows (= :windows (os/which)))
(def ffi/loc (string "examples/ffi/so." (if is-windows "dll" "so")))
(def ffi/source-loc "examples/ffi/so.c")
(if is-windows
(os/execute ["cl.exe" "/nologo" "/LD" ffi/source-loc "/link" "/DLL" (string "/OUT:" ffi/loc)] :px)
(os/execute ["cc" ffi/source-loc "-shared" "-o" ffi/loc] :px))
(ffi/context ffi/loc)
(def intintint (ffi/struct :int :int :int))
(def big (ffi/struct :s64 :s64 :s64))
(def split (ffi/struct :int :int :float :float))
(def split-flip (ffi/struct :float :float :int :int))
(def six-ints (ffi/struct :int :int :int :int :int :int))
(ffi/defbind int-fn :int [a :int b :int])
(ffi/defbind double-fn :double [a :double b :double c :double])
(ffi/defbind double-many :double
[x :double y :double z :double w :double a :double b :double])
(ffi/defbind double-lots :double
[a :double b :double c :double d :double e :double f :double g :double h :double i :double j :double])
(ffi/defbind float-fn :double
[x :float y :float z :float])
(ffi/defbind intint-fn :int
[x :double ii [:int :int]])
(ffi/defbind return-struct [:int :int]
[i :int])
(ffi/defbind intintint-fn :int
[x :double iii intintint])
(ffi/defbind struct-big big
[i :int d :double])
(ffi/defbind void-fn :void [])
(ffi/defbind double-lots-2 :double
[a :double
b :double
c :double
d :double
e :double
f :double
g :double
h :double
i :double
j :double])
(ffi/defbind void-fn-2 :void [y :double])
(ffi/defbind intintint-fn-2 :int [iii intintint i :int])
(ffi/defbind split-fn :float [s split])
(ffi/defbind split-flip-fn :float [s split-flip])
(ffi/defbind split-ret-fn split [x :int y :float])
(ffi/defbind split-flip-ret-fn split-flip [x :int y :float])
(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])
#
# Struct reading and writing
#
(defn check-round-trip
[t value]
(def buf (ffi/write t value))
(def same-value (ffi/read t buf))
(assert (deep= value same-value)
(string/format "round trip %j (got %j)" value same-value)))
(check-round-trip :bool true)
(check-round-trip :bool false)
(check-round-trip :void nil)
(check-round-trip :void nil)
(check-round-trip :s8 10)
(check-round-trip :s8 0)
(check-round-trip :s8 -10)
(check-round-trip :u8 10)
(check-round-trip :u8 0)
(check-round-trip :s16 10)
(check-round-trip :s16 0)
(check-round-trip :s16 -12312)
(check-round-trip :u16 10)
(check-round-trip :u16 0)
(check-round-trip :u32 0)
(check-round-trip :u32 10)
(check-round-trip :u32 0xFFFF7777)
(check-round-trip :s32 0x7FFF7777)
(check-round-trip :s32 0)
(check-round-trip :s32 -1234567)
(def s (ffi/struct :s8 :s8 :s8 :float))
(check-round-trip s [1 3 5 123.5])
(check-round-trip s [-1 -3 -5 -123.5])
#
# Call functions
#
(tracev (sixints-fn))
(tracev (sixints-fn-2 100 [1 2 3 4 5 6]))
(tracev (sixints-fn-3 [1 2 3 4 5 6] 200))
(tracev (split-ret-fn 10 12))
(tracev (split-flip-ret-fn 10 12))
(tracev (split-flip-ret-fn 12 10))
(tracev (intintint-fn-2 [10 20 30] 3))
(tracev (split-fn [5 6 1.2 3.4]))
(tracev (void-fn-2 10.3))
(tracev (double-many 1 2 3 4 5 6))
(tracev (string/format "%.17g" (double-many 1 2 3 4 5 6)))
(tracev (type (double-many 1 2 3 4 5 6)))
(tracev (double-lots-2 0 1 2 3 4 5 6 7 8 9))
(tracev (void-fn))
(tracev (int-fn 10 20))
(tracev (double-fn 1.5 2.5 3.5))
(tracev (double-lots 1 2 3 4 5 6 7 8 9 10))
(tracev (float-fn 8 4 17))
(tracev (intint-fn 123.456 [10 20]))
(tracev (intintint-fn 123.456 [10 20 30]))
(tracev (return-struct 42))
(tracev (double-lots 1 2 3 4 5 6 700 800 9 10))
(tracev (struct-big 11 99.5))
(assert (= [10 10 12 12] (split-ret-fn 10 12)))
(assert (= [12 12 10 10] (split-flip-ret-fn 10 12)))
(assert (= 183 (intintint-fn-2 [10 20 31] 3)))
(assert (= 264 (math/round (* 10 (split-fn [5 6 1.2 3.4])))))
(assert (= 9876543210 (double-lots-2 0 1 2 3 4 5 6 7 8 9)))
(assert (= 60 (int-fn 10 20)))
(assert (= 42 (double-fn 1.5 2.5 3.5)))
(assert (= 21 (math/round (double-many 1 2 3 4 5 6.01))))
(assert (= 19 (double-lots 1 2 3 4 5 6 7 8 9 10)))
(assert (= 204 (float-fn 8 4 17)))
(print "Done.")

7
examples/ffi/win32.janet Normal file
View File

@@ -0,0 +1,7 @@
(ffi/context "user32.dll")
(ffi/defbind MessageBoxA :int
[w :ptr text :string cap :string typ :int])
(MessageBoxA nil "Hello, World!" "Test" 0)

BIN
examples/jitfn/hello.bin Normal file

Binary file not shown.

17
examples/jitfn/hello.nasm Normal file
View File

@@ -0,0 +1,17 @@
BITS 64
;;;
;;; Code
;;;
mov rax, 1 ; write(
mov rdi, 1 ; STDOUT_FILENO,
lea rsi, [rel msg] ; msg,
mov rdx, msglen ; sizeof(msg)
syscall ; );
ret ; return;
;;;
;;; Constants
;;;
msg: db "Hello, world!", 10
msglen: equ $ - msg

View File

@@ -0,0 +1,13 @@
###
### Relies on NASM being installed to assemble code.
### Only works on x86-64 Linux.
###
### Before running, compile hello.nasm to hello.bin with
### $ nasm hello.nasm -o hello.bin
(def bin (slurp "hello.bin"))
(def f (ffi/jitfn bin))
(def signature (ffi/signature :default :void))
(ffi/call f signature)
(print "called a jitted function with FFI!")
(print "machine code: " (describe (string/slice f)))

2
examples/lineloop.janet Normal file
View File

@@ -0,0 +1,2 @@
(while (not (empty? (def line (getline))))
(prin "line: " line))

View File

@@ -0,0 +1,30 @@
(defn init-db [c]
(def res @{:clients @{}})
(var i 0)
(repeat c
(def n (string "client" i))
(put-in res [:clients n] @{:name n :projects @{}})
(++ i)
(repeat c
(def pn (string "project" i))
(put-in res [:clients n :projects pn] @{:name pn})
(++ i)
(repeat c
(def tn (string "task" i))
(put-in res [:clients n :projects pn :tasks tn] @{:name pn})
(++ i))))
res)
(loop [c :range [30 80 1]]
(var s (os/clock))
(print "Marshal DB with " c " clients, "
(* c c) " projects and "
(* c c c) " tasks. "
"Total " (+ (* c c c) (* c c) c) " tables")
(def buf (marshal (init-db c) @{} @""))
(print "Buffer is " (length buf) " bytes")
(print "Duration " (- (os/clock) s))
(set s (os/clock))
(gccollect)
(print "Collected garbage in " (- (os/clock) s)))

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)

17
janet.1
View File

@@ -164,10 +164,15 @@ Execute a string of Janet source. Source code is executed in the order it is enc
arguments are executed before later ones.
.TP
.BR \-E\ code arguments
.BR \-E\ code\ arguments...
Execute a single Janet expression as a Janet short-fn, passing the remaining command line arguments to the expression. This allows
more concise one-liners with command line arguments.
Example: janet -E '(print $0)' 12 is equivalent to '((short-fn (print $0)) 12)', which is in turn equivalent to
`((fn [k] (print k)) 12)`
See docs for the `short-fn` function for more details.
.TP
.BR \-d
Enable debug mode. On all terminating signals as well the debug signal, this will
@@ -178,6 +183,10 @@ default repl.
.BR \-n
Disable ANSI colors in the repl. Has no effect if no repl is run.
.TP
.BR \-N
Enable ANSI colors in the repl. Has no effect if no repl is run.
.TP
.BR \-r
Open a REPL (Read Eval Print Loop) after executing all sources. By default, if Janet is called with no
@@ -263,5 +272,11 @@ This variable does nothing in the default configuration of Janet, as PRF is disa
cannot be defined for this variable to have an effect.
.RE
.B NO_COLOR
.RS
Turn off color by default in the repl and in the error handler of scripts. This can be changed at runtime
via dynamic bindings *err-color* and *pretty-format*, or via the command line parameters -n and -N.
.RE
.SH AUTHOR
Written by Calvin Rose <calsrose@gmail.com>

View File

@@ -1,4 +1,4 @@
# Copyright (c) 2021 Calvin Rose and contributors
# Copyright (c) 2023 Calvin Rose and contributors
#
# Permission is hereby granted, free of charge, to any person obtaining a copy
# of this software and associated documentation files (the "Software"), to
@@ -20,7 +20,7 @@
project('janet', 'c',
default_options : ['c_std=c99', 'build.c_std=c99', 'b_lundef=false', 'default_library=both'],
version : '1.21.2')
version : '1.32.0')
# Global settings
janet_path = join_paths(get_option('prefix'), get_option('libdir'), 'janet')
@@ -76,6 +76,8 @@ conf.set('JANET_SIMPLE_GETLINE', get_option('simple_getline'))
conf.set('JANET_EV_NO_EPOLL', not get_option('epoll'))
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'))
if get_option('os_name') != ''
conf.set('JANET_OS_NAME', get_option('os_name'))
endif
@@ -116,6 +118,7 @@ core_src = [
'src/core/debug.c',
'src/core/emit.c',
'src/core/ev.c',
'src/core/ffi.c',
'src/core/fiber.c',
'src/core/gc.c',
'src/core/inttypes.c',
@@ -166,7 +169,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 : [
@@ -179,23 +182,30 @@ if not get_option('single_threaded')
janet_dependencies += thread_dep
endif
if cc.has_argument('-fvisibility=hidden')
lib_cflags = ['-fvisibility=hidden']
else
lib_cflags = []
endif
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']
extra_cflags = ['-fvisibility=hidden', '-DJANET_DLL_IMPORT']
else
extra_cflags = []
extra_cflags = ['-DJANET_DLL_IMPORT']
endif
janet_mainclient = executable('janet', janetc, mainclient_src,
janet_mainclient = executable('janet', mainclient_src,
include_directories : incdir,
dependencies : janet_dependencies,
link_with: [libjanet],
c_args : extra_cflags,
install : true)
@@ -224,17 +234,34 @@ docs = custom_target('docs',
# Tests
test_files = [
'test/suite0000.janet',
'test/suite0001.janet',
'test/suite0002.janet',
'test/suite0003.janet',
'test/suite0004.janet',
'test/suite0005.janet',
'test/suite0006.janet',
'test/suite0007.janet',
'test/suite0008.janet',
'test/suite0009.janet',
'test/suite0010.janet'
'test/suite-array.janet',
'test/suite-asm.janet',
'test/suite-boot.janet',
'test/suite-buffer.janet',
'test/suite-capi.janet',
'test/suite-cfuns.janet',
'test/suite-compile.janet',
'test/suite-corelib.janet',
'test/suite-debug.janet',
'test/suite-ev.janet',
'test/suite-ffi.janet',
'test/suite-inttypes.janet',
'test/suite-io.janet',
'test/suite-marsh.janet',
'test/suite-math.janet',
'test/suite-os.janet',
'test/suite-parse.janet',
'test/suite-peg.janet',
'test/suite-pp.janet',
'test/suite-specials.janet',
'test/suite-string.janet',
'test/suite-strtod.janet',
'test/suite-struct.janet',
'test/suite-symcache.janet',
'test/suite-table.janet',
'test/suite-unknown.janet',
'test/suite-value.janet',
'test/suite-vm.janet'
]
foreach t : test_files
test(t, janet_nativeclient, args : files([t]), workdir : meson.current_source_dir())
@@ -261,5 +288,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_' + 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

@@ -18,7 +18,9 @@ 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('interpreter_interrupt', type : 'boolean', value : true)
option('ffi', type : 'boolean', value : true)
option('ffi_jit', type : 'boolean', value : true)
option('recursion_guard', type : 'integer', min : 10, max : 8000, value : 1024)
option('max_proto_depth', type : 'integer', min : 10, max : 8000, value : 200)

View File

@@ -1,5 +1,5 @@
/*
* Copyright (c) 2022 Calvin Rose
* Copyright (c) 2023 Calvin Rose
*
* Permission is hereby granted, free of charge, to any person obtaining a copy
* of this software and associated documentation files (the "Software"), to

View File

@@ -1,5 +1,5 @@
/*
* Copyright (c) 2022 Calvin Rose
* Copyright (c) 2023 Calvin Rose
*
* Permission is hereby granted, free of charge, to any person obtaining a copy
* of this software and associated documentation files (the "Software"), to

File diff suppressed because it is too large Load Diff

View File

@@ -1,5 +1,5 @@
/*
* Copyright (c) 2022 Calvin Rose
* Copyright (c) 2023 Calvin Rose
*
* Permission is hereby granted, free of charge, to any person obtaining a copy
* of this software and associated documentation files (the "Software"), to

View File

@@ -1,5 +1,5 @@
/*
* Copyright (c) 2022 Calvin Rose
* Copyright (c) 2023 Calvin Rose
*
* Permission is hereby granted, free of charge, to any person obtaining a copy
* of this software and associated documentation files (the "Software"), to

View File

@@ -1,5 +1,5 @@
/*
* Copyright (c) 2022 Calvin Rose
* Copyright (c) 2023 Calvin Rose
*
* Permission is hereby granted, free of charge, to any person obtaining a copy
* of this software and associated documentation files (the "Software"), to
@@ -70,6 +70,5 @@ int system_test() {
assert(janet_equals(tuple1, tuple2));
return 0;
}

View File

@@ -1,5 +1,5 @@
/*
* Copyright (c) 2022 Calvin Rose
* Copyright (c) 2023 Calvin Rose
*
* Permission is hereby granted, free of charge, to any person obtaining a copy
* of this software and associated documentation files (the "Software"), to

View File

@@ -4,10 +4,10 @@
#define JANETCONF_H
#define JANET_VERSION_MAJOR 1
#define JANET_VERSION_MINOR 21
#define JANET_VERSION_PATCH 2
#define JANET_VERSION_MINOR 32
#define JANET_VERSION_PATCH 0
#define JANET_VERSION_EXTRA ""
#define JANET_VERSION "1.21.2"
#define JANET_VERSION "1.32.0"
/* #define JANET_BUILD "local" */
@@ -33,6 +33,8 @@
/* #define JANET_NO_SYMLINKS */
/* #define JANET_NO_UMASK */
/* #define JANET_NO_THREADS */
/* #define JANET_NO_FFI */
/* #define JANET_NO_FFI_JIT */
/* Other settings */
/* #define JANET_DEBUG */

View File

@@ -1,5 +1,5 @@
/*
* Copyright (c) 2022 Calvin Rose
* Copyright (c) 2023 Calvin Rose
*
* Permission is hereby granted, free of charge, to any person obtaining a copy
* of this software and associated documentation files (the "Software"), to
@@ -23,12 +23,16 @@
#ifndef JANET_AMALG
#include "features.h"
#include <janet.h>
#include "util.h"
#include "gc.h"
#include "state.h"
#endif
#ifdef JANET_EV
#ifdef JANET_WINDOWS
#include <windows.h>
#endif
#else
#include <stdatomic.h>
#endif
#endif
@@ -85,12 +89,12 @@ void *janet_abstract_threaded(const JanetAbstractType *atype, size_t size) {
#ifdef JANET_WINDOWS
static int32_t janet_incref(JanetAbstractHead *ab) {
return InterlockedIncrement(&ab->gc.data.refcount);
size_t janet_os_mutex_size(void) {
return sizeof(CRITICAL_SECTION);
}
static int32_t janet_decref(JanetAbstractHead *ab) {
return InterlockedDecrement(&ab->gc.data.refcount);
size_t janet_os_rwlock_size(void) {
return sizeof(void *);
}
void janet_os_mutex_init(JanetOSMutex *mutex) {
@@ -106,43 +110,97 @@ void janet_os_mutex_lock(JanetOSMutex *mutex) {
}
void janet_os_mutex_unlock(JanetOSMutex *mutex) {
/* error handling? May want to keep counter */
LeaveCriticalSection((CRITICAL_SECTION *) mutex);
}
void janet_os_rwlock_init(JanetOSRWLock *rwlock) {
InitializeSRWLock((PSRWLOCK) rwlock);
}
void janet_os_rwlock_deinit(JanetOSRWLock *rwlock) {
/* no op? */
(void) rwlock;
}
void janet_os_rwlock_rlock(JanetOSRWLock *rwlock) {
AcquireSRWLockShared((PSRWLOCK) rwlock);
}
void janet_os_rwlock_wlock(JanetOSRWLock *rwlock) {
AcquireSRWLockExclusive((PSRWLOCK) rwlock);
}
void janet_os_rwlock_runlock(JanetOSRWLock *rwlock) {
ReleaseSRWLockShared((PSRWLOCK) rwlock);
}
void janet_os_rwlock_wunlock(JanetOSRWLock *rwlock) {
ReleaseSRWLockExclusive((PSRWLOCK) rwlock);
}
#else
static int32_t janet_incref(JanetAbstractHead *ab) {
return __atomic_add_fetch(&ab->gc.data.refcount, 1, __ATOMIC_RELAXED);
size_t janet_os_mutex_size(void) {
return sizeof(pthread_mutex_t);
}
static int32_t janet_decref(JanetAbstractHead *ab) {
return __atomic_add_fetch(&ab->gc.data.refcount, -1, __ATOMIC_RELAXED);
size_t janet_os_rwlock_size(void) {
return sizeof(pthread_rwlock_t);
}
void janet_os_mutex_init(JanetOSMutex *mutex) {
pthread_mutex_init(mutex, NULL);
pthread_mutexattr_t attr;
pthread_mutexattr_init(&attr);
pthread_mutexattr_settype(&attr, PTHREAD_MUTEX_RECURSIVE);
pthread_mutex_init((pthread_mutex_t *) mutex, &attr);
}
void janet_os_mutex_deinit(JanetOSMutex *mutex) {
pthread_mutex_destroy(mutex);
pthread_mutex_destroy((pthread_mutex_t *) mutex);
}
void janet_os_mutex_lock(JanetOSMutex *mutex) {
pthread_mutex_lock(mutex);
pthread_mutex_lock((pthread_mutex_t *) mutex);
}
void janet_os_mutex_unlock(JanetOSMutex *mutex) {
pthread_mutex_unlock(mutex);
int ret = pthread_mutex_unlock((pthread_mutex_t *) mutex);
if (ret) janet_panic("cannot release lock");
}
void janet_os_rwlock_init(JanetOSRWLock *rwlock) {
pthread_rwlock_init((pthread_rwlock_t *) rwlock, NULL);
}
void janet_os_rwlock_deinit(JanetOSRWLock *rwlock) {
pthread_rwlock_destroy((pthread_rwlock_t *) rwlock);
}
void janet_os_rwlock_rlock(JanetOSRWLock *rwlock) {
pthread_rwlock_rdlock((pthread_rwlock_t *) rwlock);
}
void janet_os_rwlock_wlock(JanetOSRWLock *rwlock) {
pthread_rwlock_wrlock((pthread_rwlock_t *) rwlock);
}
void janet_os_rwlock_runlock(JanetOSRWLock *rwlock) {
pthread_rwlock_unlock((pthread_rwlock_t *) rwlock);
}
void janet_os_rwlock_wunlock(JanetOSRWLock *rwlock) {
pthread_rwlock_unlock((pthread_rwlock_t *) 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

@@ -1,5 +1,5 @@
/*
* Copyright (c) 2022 Calvin Rose
* Copyright (c) 2023 Calvin Rose
*
* Permission is hereby granted, free of charge, to any person obtaining a copy
* of this software and associated documentation files (the "Software"), to
@@ -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;
}
@@ -125,18 +136,27 @@ Janet janet_array_peek(JanetArray *array) {
JANET_CORE_FN(cfun_array_new,
"(array/new capacity)",
"Creates a new empty array with a pre-allocated capacity. The same as "
"(array) but can be more efficient if the maximum size of an array is known.") {
"`(array)` but can be more efficient if the maximum size of an array is known.") {
janet_fixarity(argc, 1);
int32_t cap = janet_getinteger(argv, 0);
JanetArray *array = janet_array(cap);
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.") {
janet_arity(argc, 1, 2);
int32_t count = janet_getinteger(argv, 0);
int32_t count = janet_getnat(argv, 0);
Janet x = (argc == 2) ? argv[1] : janet_wrap_nil();
JanetArray *array = janet_array(count);
for (int32_t i = 0; i < count; i++) {
@@ -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) {
@@ -194,7 +214,7 @@ JANET_CORE_FN(cfun_array_push,
JANET_CORE_FN(cfun_array_ensure,
"(array/ensure arr capacity growth)",
"Ensures that the memory backing the array is large enough for `capacity` "
"items at the given rate of growth. Capacity and growth must be integers. "
"items at the given rate of growth. `capacity` and `growth` must be integers. "
"If the backing capacity is already enough, then this function does nothing. "
"Otherwise, the backing memory will be reallocated so that there is enough space.") {
janet_fixarity(argc, 3);
@@ -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

@@ -1,5 +1,5 @@
/*
* Copyright (c) 2022 Calvin Rose
* Copyright (c) 2023 Calvin Rose
*
* Permission is hereby granted, free of charge, to any person obtaining a copy
* of this software and associated documentation files (the "Software"), to
@@ -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}
};
@@ -187,7 +189,11 @@ static void janet_asm_longjmp(JanetAssembler *a) {
/* Throw some kind of assembly error */
static void janet_asm_error(JanetAssembler *a, const char *message) {
a->errmessage = janet_formatc("%s, instruction %d", message, a->errindex);
if (a->errindex < 0) {
a->errmessage = janet_formatc("%s", message);
} else {
a->errmessage = janet_formatc("%s, instruction %d", message, a->errindex);
}
janet_asm_longjmp(a);
}
#define janet_asm_assert(a, c, m) do { if (!(c)) janet_asm_error((a), (m)); } while (0)
@@ -516,6 +522,7 @@ static JanetAssembleResult janet_asm1(JanetAssembler *parent, Janet source, int
#endif
if (NULL != a.parent) {
janet_asm_deinit(&a);
a.parent->errmessage = a.errmessage;
janet_asm_longjmp(a.parent);
}
result.funcdef = NULL;
@@ -553,6 +560,10 @@ 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;
/* Check structarg */
x = janet_get1(s, janet_ckeywordv("structarg"));
if (janet_truthy(x)) def->flags |= JANET_FUNCDEF_FLAG_STRUCTARG;
/* Check source */
x = janet_get1(s, janet_ckeywordv("source"));
if (janet_checktype(x, JANET_STRING)) def->source = janet_unwrap_string(x);
@@ -597,6 +608,9 @@ static JanetAssembleResult janet_asm1(JanetAssembler *parent, Janet source, int
/* Parse sub funcdefs */
x = janet_get1(s, janet_ckeywordv("closures"));
if (janet_checktype(x, JANET_NIL)) {
x = janet_get1(s, janet_ckeywordv("defs"));
}
if (janet_indexed_view(x, &arr, &count)) {
int32_t i;
for (i = 0; i < count; i++) {
@@ -709,10 +723,63 @@ static JanetAssembleResult janet_asm1(JanetAssembler *parent, Janet source, int
}
}
/* Set symbolmap */
def->symbolmap = NULL;
def->symbolmap_length = 0;
x = janet_get1(s, janet_ckeywordv("symbolmap"));
if (janet_indexed_view(x, &arr, &count)) {
def->symbolmap_length = count;
def->symbolmap = janet_malloc(sizeof(JanetSymbolMap) * (size_t)count);
if (NULL == def->symbolmap) {
JANET_OUT_OF_MEMORY;
}
for (i = 0; i < count; i++) {
const Janet *tup;
Janet entry = arr[i];
JanetSymbolMap ss;
if (!janet_checktype(entry, JANET_TUPLE)) {
janet_asm_error(&a, "expected tuple");
}
tup = janet_unwrap_tuple(entry);
if (janet_keyeq(tup[0], "upvalue")) {
ss.birth_pc = UINT32_MAX;
} else if (!janet_checkint(tup[0])) {
janet_asm_error(&a, "expected integer");
} else {
ss.birth_pc = janet_unwrap_integer(tup[0]);
}
if (!janet_checkint(tup[1])) {
janet_asm_error(&a, "expected integer");
}
if (!janet_checkint(tup[2])) {
janet_asm_error(&a, "expected integer");
}
if (!janet_checktype(tup[3], JANET_SYMBOL)) {
janet_asm_error(&a, "expected symbol");
}
ss.death_pc = janet_unwrap_integer(tup[1]);
ss.slot_index = janet_unwrap_integer(tup[2]);
ss.symbol = janet_unwrap_symbol(tup[3]);
def->symbolmap[i] = ss;
}
}
if (def->symbolmap_length) def->flags |= JANET_FUNCDEF_FLAG_HASSYMBOLMAP;
/* Set environments */
def->environments =
janet_realloc(def->environments, def->environments_length * sizeof(int32_t));
if (NULL == def->environments) {
x = janet_get1(s, janet_ckeywordv("environments"));
if (janet_indexed_view(x, &arr, &count)) {
def->environments_length = count;
if (def->environments_length) {
def->environments = janet_realloc(def->environments, def->environments_length * sizeof(int32_t));
}
for (int32_t i = 0; i < count; i++) {
if (!janet_checkint(arr[i])) {
janet_asm_error(&a, "expected integer");
}
def->environments[i] = janet_unwrap_integer(arr[i]);
}
}
if (def->environments_length && NULL == def->environments) {
JANET_OUT_OF_MEMORY;
}
@@ -861,6 +928,29 @@ static Janet janet_disasm_slotcount(JanetFuncDef *def) {
return janet_wrap_integer(def->slotcount);
}
static Janet janet_disasm_symbolslots(JanetFuncDef *def) {
if (def->symbolmap == NULL) {
return janet_wrap_nil();
}
JanetArray *symbolslots = janet_array(def->symbolmap_length);
Janet upvaluekw = janet_ckeywordv("upvalue");
for (int32_t i = 0; i < def->symbolmap_length; i++) {
JanetSymbolMap ss = def->symbolmap[i];
Janet *t = janet_tuple_begin(4);
if (ss.birth_pc == UINT32_MAX) {
t[0] = upvaluekw;
} else {
t[0] = janet_wrap_integer(ss.birth_pc);
}
t[1] = janet_wrap_integer(ss.death_pc);
t[2] = janet_wrap_integer(ss.slot_index);
t[3] = janet_wrap_symbol(ss.symbol);
symbolslots->data[i] = janet_wrap_tuple(janet_tuple_end(t));
}
symbolslots->count = def->symbolmap_length;
return janet_wrap_array(symbolslots);
}
static Janet janet_disasm_bytecode(JanetFuncDef *def) {
JanetArray *bcode = janet_array(def->bytecode_length);
for (int32_t i = 0; i < def->bytecode_length; i++) {
@@ -884,6 +974,10 @@ static Janet janet_disasm_vararg(JanetFuncDef *def) {
return janet_wrap_boolean(def->flags & JANET_FUNCDEF_FLAG_VARARG);
}
static Janet janet_disasm_structarg(JanetFuncDef *def) {
return janet_wrap_boolean(def->flags & JANET_FUNCDEF_FLAG_STRUCTARG);
}
static Janet janet_disasm_constants(JanetFuncDef *def) {
JanetArray *constants = janet_array(def->constants_length);
for (int32_t i = 0; i < def->constants_length; i++) {
@@ -933,8 +1027,10 @@ Janet janet_disasm(JanetFuncDef *def) {
janet_table_put(ret, janet_ckeywordv("bytecode"), janet_disasm_bytecode(def));
janet_table_put(ret, janet_ckeywordv("source"), janet_disasm_source(def));
janet_table_put(ret, janet_ckeywordv("vararg"), janet_disasm_vararg(def));
janet_table_put(ret, janet_ckeywordv("structarg"), janet_disasm_structarg(def));
janet_table_put(ret, janet_ckeywordv("name"), janet_disasm_name(def));
janet_table_put(ret, janet_ckeywordv("slotcount"), janet_disasm_slotcount(def));
janet_table_put(ret, janet_ckeywordv("symbolmap"), janet_disasm_symbolslots(def));
janet_table_put(ret, janet_ckeywordv("constants"), janet_disasm_constants(def));
janet_table_put(ret, janet_ckeywordv("sourcemap"), janet_disasm_sourcemap(def));
janet_table_put(ret, janet_ckeywordv("environments"), janet_disasm_environments(def));
@@ -952,7 +1048,7 @@ JANET_CORE_FN(cfun_asm,
JanetAssembleResult res;
res = janet_asm(argv[0], 0);
if (res.status != JANET_ASSEMBLE_OK) {
janet_panics(res.error);
janet_panics(res.error ? res.error : janet_cstring("invalid assembly"));
}
return janet_wrap_function(janet_thunk(res.funcdef));
}
@@ -971,6 +1067,7 @@ JANET_CORE_FN(cfun_disasm,
"* :source - name of source file that this function was compiled from.\n"
"* :name - name of function.\n"
"* :slotcount - how many virtual registers, or slots, this function uses. Corresponds to stack space used by function.\n"
"* :symbolmap - all symbols and their slots.\n"
"* :constants - an array of constants referenced by this function.\n"
"* :sourcemap - a mapping of each bytecode instruction to a line and column in the source file.\n"
"* :environments - an internal mapping of which enclosing functions are referenced for bindings.\n"
@@ -986,6 +1083,7 @@ JANET_CORE_FN(cfun_disasm,
if (!janet_cstrcmp(kw, "source")) return janet_disasm_source(f->def);
if (!janet_cstrcmp(kw, "name")) return janet_disasm_name(f->def);
if (!janet_cstrcmp(kw, "vararg")) return janet_disasm_vararg(f->def);
if (!janet_cstrcmp(kw, "structarg")) return janet_disasm_structarg(f->def);
if (!janet_cstrcmp(kw, "slotcount")) return janet_disasm_slotcount(f->def);
if (!janet_cstrcmp(kw, "constants")) return janet_disasm_constants(f->def);
if (!janet_cstrcmp(kw, "sourcemap")) return janet_disasm_sourcemap(f->def);

View File

@@ -1,5 +1,5 @@
/*
* Copyright (c) 2022 Calvin Rose
* Copyright (c) 2023 Calvin Rose
*
* Permission is hereby granted, free of charge, to any person obtaining a copy
* of this software and associated documentation files (the "Software"), to
@@ -28,8 +28,15 @@
#include "state.h"
#endif
/* Allow for managed buffers that cannot realloc/free their backing memory */
static void janet_buffer_can_realloc(JanetBuffer *buffer) {
if (buffer->gc.flags & JANET_BUFFER_FLAG_NO_REALLOC) {
janet_panic("buffer cannot reallocate foreign memory");
}
}
/* Initialize a buffer */
JanetBuffer *janet_buffer_init(JanetBuffer *buffer, int32_t capacity) {
static JanetBuffer *janet_buffer_init_impl(JanetBuffer *buffer, int32_t capacity) {
uint8_t *data = NULL;
if (capacity < 4) capacity = 4;
janet_gcpressure(capacity);
@@ -43,15 +50,37 @@ JanetBuffer *janet_buffer_init(JanetBuffer *buffer, int32_t capacity) {
return buffer;
}
/* Initialize a buffer */
JanetBuffer *janet_buffer_init(JanetBuffer *buffer, int32_t capacity) {
janet_buffer_init_impl(buffer, capacity);
buffer->gc.data.next = NULL;
buffer->gc.flags = JANET_MEM_DISABLED;
return buffer;
}
/* Initialize an unmanaged buffer */
JanetBuffer *janet_pointer_buffer_unsafe(void *memory, int32_t capacity, int32_t count) {
if (count < 0) janet_panic("count < 0");
if (capacity < count) janet_panic("capacity < count");
JanetBuffer *buffer = janet_gcalloc(JANET_MEMORY_BUFFER, sizeof(JanetBuffer));
buffer->gc.flags |= JANET_BUFFER_FLAG_NO_REALLOC;
buffer->capacity = capacity;
buffer->count = count;
buffer->data = (uint8_t *) memory;
return buffer;
}
/* Deinitialize a buffer (free data memory) */
void janet_buffer_deinit(JanetBuffer *buffer) {
janet_free(buffer->data);
if (!(buffer->gc.flags & JANET_BUFFER_FLAG_NO_REALLOC)) {
janet_free(buffer->data);
}
}
/* Initialize a buffer */
JanetBuffer *janet_buffer(int32_t capacity) {
JanetBuffer *buffer = janet_gcalloc(JANET_MEMORY_BUFFER, sizeof(JanetBuffer));
return janet_buffer_init(buffer, capacity);
return janet_buffer_init_impl(buffer, capacity);
}
/* Ensure that the buffer has enough internal capacity */
@@ -59,6 +88,7 @@ void janet_buffer_ensure(JanetBuffer *buffer, int32_t capacity, int32_t growth)
uint8_t *new_data;
uint8_t *old = buffer->data;
if (capacity <= buffer->capacity) return;
janet_buffer_can_realloc(buffer);
int64_t big_capacity = ((int64_t) capacity) * growth;
capacity = big_capacity > INT32_MAX ? INT32_MAX : (int32_t) big_capacity;
janet_gcpressure(capacity - buffer->capacity);
@@ -91,6 +121,7 @@ void janet_buffer_extra(JanetBuffer *buffer, int32_t n) {
}
int32_t new_size = buffer->count + n;
if (new_size > buffer->capacity) {
janet_buffer_can_realloc(buffer);
int32_t new_capacity = (new_size > (INT32_MAX / 2)) ? INT32_MAX : (new_size * 2);
uint8_t *new_data = janet_realloc(buffer->data, new_capacity * sizeof(uint8_t));
janet_gcpressure(new_capacity - buffer->capacity);
@@ -164,7 +195,7 @@ void janet_buffer_push_u64(JanetBuffer *buffer, uint64_t x) {
JANET_CORE_FN(cfun_buffer_new,
"(buffer/new capacity)",
"Creates a new, empty buffer with enough backing memory for capacity bytes. "
"Creates a new, empty buffer with enough backing memory for `capacity` bytes. "
"Returns a new buffer of length 0.") {
janet_fixarity(argc, 1);
int32_t cap = janet_getinteger(argv, 0);
@@ -174,21 +205,36 @@ JANET_CORE_FN(cfun_buffer_new,
JANET_CORE_FN(cfun_buffer_new_filled,
"(buffer/new-filled count &opt byte)",
"Creates a new buffer of length count filled with byte. By default, byte is 0. "
"Creates a new buffer of length `count` filled with `byte`. By default, `byte` is 0. "
"Returns the new buffer.") {
janet_arity(argc, 1, 2);
int32_t count = janet_getinteger(argv, 0);
if (count < 0) count = 0;
int32_t byte = 0;
if (argc == 2) {
byte = janet_getinteger(argv, 1) & 0xFF;
}
JanetBuffer *buffer = janet_buffer(count);
if (buffer->data)
if (buffer->data && count > 0)
memset(buffer->data, byte, count);
buffer->count = count;
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. "
@@ -211,6 +257,7 @@ JANET_CORE_FN(cfun_buffer_trim,
"modified buffer.") {
janet_fixarity(argc, 1);
JanetBuffer *buffer = janet_getbuffer(argv, 0);
janet_buffer_can_realloc(buffer);
if (buffer->count < buffer->capacity) {
int32_t newcap = buffer->count > 4 ? buffer->count : 4;
uint8_t *newData = janet_realloc(buffer->data, newcap);
@@ -274,17 +321,8 @@ JANET_CORE_FN(cfun_buffer_chars,
return argv[0];
}
JANET_CORE_FN(cfun_buffer_push,
"(buffer/push buffer & xs)",
"Push both individual bytes and byte sequences to a buffer. For each x in xs, "
"push the byte if x is an integer, otherwise push the bytesequence to the buffer. "
"Thus, this function behaves like both `buffer/push-string` and `buffer/push-byte`. "
"Returns the modified buffer. "
"Will throw an error if the buffer overflows.") {
int32_t i;
janet_arity(argc, 1, -1);
JanetBuffer *buffer = janet_getbuffer(argv, 0);
for (i = 1; i < argc; i++) {
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)) {
janet_buffer_push_u8(buffer, (uint8_t)(janet_getinteger(argv, i) & 0xFF));
} else {
@@ -296,9 +334,39 @@ JANET_CORE_FN(cfun_buffer_push,
janet_buffer_push_bytes(buffer, view.bytes, view.len);
}
}
}
JANET_CORE_FN(cfun_buffer_push_at,
"(buffer/push-at buffer index & xs)",
"Same as buffer/push, but copies the new data into the buffer "
" at index `index`.") {
janet_arity(argc, 2, -1);
JanetBuffer *buffer = janet_getbuffer(argv, 0);
int32_t index = janet_getinteger(argv, 1);
int32_t old_count = buffer->count;
if (index < 0 || index > old_count) {
janet_panicf("index out of range [0, %d)", old_count);
}
buffer->count = index;
buffer_push_impl(buffer, argv, 2, argc);
if (buffer->count < old_count) {
buffer->count = old_count;
}
return argv[0];
}
JANET_CORE_FN(cfun_buffer_push,
"(buffer/push buffer & xs)",
"Push both individual bytes and byte sequences to a buffer. For each x in xs, "
"push the byte if x is an integer, otherwise push the bytesequence to the buffer. "
"Thus, this function behaves like both `buffer/push-string` and `buffer/push-byte`. "
"Returns the modified buffer. "
"Will throw an error if the buffer overflows.") {
janet_arity(argc, 1, -1);
JanetBuffer *buffer = janet_getbuffer(argv, 0);
buffer_push_impl(buffer, argv, 1, argc);
return argv[0];
}
JANET_CORE_FN(cfun_buffer_clear,
"(buffer/clear buffer)",
@@ -312,7 +380,7 @@ JANET_CORE_FN(cfun_buffer_clear,
JANET_CORE_FN(cfun_buffer_popn,
"(buffer/popn buffer n)",
"Removes the last n bytes from the buffer. Returns the modified buffer.") {
"Removes the last `n` bytes from the buffer. Returns the modified buffer.") {
janet_fixarity(argc, 2);
JanetBuffer *buffer = janet_getbuffer(argv, 0);
int32_t n = janet_getinteger(argv, 1);
@@ -327,9 +395,9 @@ JANET_CORE_FN(cfun_buffer_popn,
JANET_CORE_FN(cfun_buffer_slice,
"(buffer/slice bytes &opt start end)",
"Takes a slice of a byte sequence from start to end. The range is half open, "
"Takes a slice of a byte sequence from `start` to `end`. The range is half open, "
"[start, end). Indexes can also be negative, indicating indexing from the end of the "
"end of the array. By default, start is 0 and end is the length of the buffer. "
"end of the array. By default, `start` is 0 and `end` is the length of the buffer. "
"Returns a new buffer.") {
JanetByteView view = janet_getbytes(argv, 0);
JanetRange range = janet_getslice(argc, argv);
@@ -399,22 +467,24 @@ JANET_CORE_FN(cfun_buffer_bittoggle,
JANET_CORE_FN(cfun_buffer_blit,
"(buffer/blit dest src &opt dest-start src-start src-end)",
"Insert the contents of src into dest. Can optionally take indices that "
"indicate which part of src to copy into which part of dest. Indices can be "
"negative to index from the end of src or dest. Returns dest.") {
"Insert the contents of `src` into `dest`. Can optionally take indices that "
"indicate which part of `src` to copy into which part of `dest`. Indices can be "
"negative in order to index from the end of `src` or `dest`. Returns `dest`.") {
janet_arity(argc, 2, 5);
JanetBuffer *dest = janet_getbuffer(argv, 0);
JanetByteView src = janet_getbytes(argv, 1);
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 {
@@ -441,7 +511,7 @@ JANET_CORE_FN(cfun_buffer_blit,
JANET_CORE_FN(cfun_buffer_format,
"(buffer/format buffer format & args)",
"Snprintf like functionality for printing values into a buffer. Returns "
" the modified buffer.") {
"the modified buffer.") {
janet_arity(argc, 2, -1);
JanetBuffer *buffer = janet_getbuffer(argv, 0);
const char *strfrmt = (const char *) janet_getstring(argv, 1);
@@ -453,12 +523,14 @@ 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", cfun_buffer_push),
JANET_CORE_REG("buffer/push-at", cfun_buffer_push_at),
JANET_CORE_REG("buffer/popn", cfun_buffer_popn),
JANET_CORE_REG("buffer/clear", cfun_buffer_clear),
JANET_CORE_REG("buffer/slice", cfun_buffer_slice),

View File

@@ -1,5 +1,5 @@
/*
* Copyright (c) 2022 Calvin Rose
* Copyright (c) 2023 Calvin Rose
*
* Permission is hereby granted, free of charge, to any person obtaining a copy
* of this software and associated documentation files (the "Software"), to
@@ -25,6 +25,7 @@
#include <janet.h>
#include "gc.h"
#include "util.h"
#include "regalloc.h"
#endif
/* Look up table for instructions */
@@ -36,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, */
@@ -106,6 +109,291 @@ enum JanetInstructionType janet_instructions[JOP_INSTRUCTION_COUNT] = {
JINT_SSS /* JOP_CANCEL, */
};
/* Remove all noops while preserving jumps and debugging information.
* Useful as part of a filtering compiler pass. */
void janet_bytecode_remove_noops(JanetFuncDef *def) {
/* Get an instruction rewrite map so we can rewrite jumps */
uint32_t *pc_map = janet_smalloc(sizeof(uint32_t) * (1 + def->bytecode_length));
uint32_t new_bytecode_length = 0;
for (int32_t i = 0; i < def->bytecode_length; i++) {
uint32_t instr = def->bytecode[i];
uint32_t opcode = instr & 0x7F;
pc_map[i] = new_bytecode_length;
if (opcode != JOP_NOOP) {
new_bytecode_length++;
}
}
pc_map[def->bytecode_length] = new_bytecode_length;
/* Linear scan rewrite bytecode and sourcemap. Also fix jumps. */
int32_t j = 0;
for (int32_t i = 0; i < def->bytecode_length; i++) {
uint32_t instr = def->bytecode[i];
uint32_t opcode = instr & 0x7F;
int32_t old_jump_target = 0;
int32_t new_jump_target = 0;
switch (opcode) {
case JOP_NOOP:
continue;
case JOP_JUMP:
/* relative pc is in DS field of instruction */
old_jump_target = i + (((int32_t)instr) >> 8);
new_jump_target = pc_map[old_jump_target];
instr += (new_jump_target - old_jump_target + (i - j)) << 8;
break;
case JOP_JUMP_IF:
case JOP_JUMP_IF_NIL:
case JOP_JUMP_IF_NOT:
case JOP_JUMP_IF_NOT_NIL:
/* relative pc is in ES field of instruction */
old_jump_target = i + (((int32_t)instr) >> 16);
new_jump_target = pc_map[old_jump_target];
instr += (new_jump_target - old_jump_target + (i - j)) << 16;
break;
default:
break;
}
def->bytecode[j] = instr;
if (def->sourcemap != NULL) {
def->sourcemap[j] = def->sourcemap[i];
}
j++;
}
/* Rewrite symbolmap */
for (int32_t i = 0; i < def->symbolmap_length; i++) {
JanetSymbolMap *sm = def->symbolmap + i;
/* Don't rewrite upvalue mappings */
if (sm->birth_pc < UINT32_MAX) {
sm->birth_pc = pc_map[sm->birth_pc];
sm->death_pc = pc_map[sm->death_pc];
}
}
def->bytecode_length = new_bytecode_length;
def->bytecode = janet_realloc(def->bytecode, def->bytecode_length * sizeof(uint32_t));
janet_sfree(pc_map);
}
/* Remove redundant loads, moves and other instructions if possible and convert them to
* noops. Input is assumed valid bytecode. */
void janet_bytecode_movopt(JanetFuncDef *def) {
JanetcRegisterAllocator ra;
int recur = 1;
/* Iterate this until no more instructions can be removed. */
while (recur) {
janetc_regalloc_init(&ra);
/* Look for slots that have writes but no reads (and aren't in the closure bitset). */
if (def->closure_bitset != NULL) {
for (int32_t i = 0; i < def->slotcount; i++) {
int32_t index = i >> 5;
uint32_t mask = 1U << (((uint32_t) i) & 31);
if (def->closure_bitset[index] & mask) {
janetc_regalloc_touch(&ra, i);
}
}
}
#define AA ((instr >> 8) & 0xFF)
#define BB ((instr >> 16) & 0xFF)
#define CC (instr >> 24)
#define DD (instr >> 8)
#define EE (instr >> 16)
/* Check reads and writes */
for (int32_t i = 0; i < def->bytecode_length; i++) {
uint32_t instr = def->bytecode[i];
switch (instr & 0x7F) {
/* Group instructions my how they read from slots */
/* No reads or writes */
default:
janet_assert(0, "unhandled instruction");
case JOP_JUMP:
case JOP_NOOP:
case JOP_RETURN_NIL:
/* Write A */
case JOP_LOAD_INTEGER:
case JOP_LOAD_CONSTANT:
case JOP_LOAD_UPVALUE:
case JOP_CLOSURE:
/* Write D */
case JOP_LOAD_NIL:
case JOP_LOAD_TRUE:
case JOP_LOAD_FALSE:
case JOP_LOAD_SELF:
case JOP_MAKE_ARRAY:
case JOP_MAKE_BUFFER:
case JOP_MAKE_STRING:
case JOP_MAKE_STRUCT:
case JOP_MAKE_TABLE:
case JOP_MAKE_TUPLE:
case JOP_MAKE_BRACKET_TUPLE:
break;
/* Read A */
case JOP_ERROR:
case JOP_TYPECHECK:
case JOP_JUMP_IF:
case JOP_JUMP_IF_NOT:
case JOP_JUMP_IF_NIL:
case JOP_JUMP_IF_NOT_NIL:
case JOP_SET_UPVALUE:
/* Write E, Read A */
case JOP_MOVE_FAR:
janetc_regalloc_touch(&ra, AA);
break;
/* Read B */
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:
case JOP_SHIFT_RIGHT_IMMEDIATE:
case JOP_SHIFT_RIGHT_UNSIGNED_IMMEDIATE:
case JOP_GREATER_THAN_IMMEDIATE:
case JOP_LESS_THAN_IMMEDIATE:
case JOP_EQUALS_IMMEDIATE:
case JOP_NOT_EQUALS_IMMEDIATE:
case JOP_GET_INDEX:
janetc_regalloc_touch(&ra, BB);
break;
/* Read D */
case JOP_RETURN:
case JOP_PUSH:
case JOP_PUSH_ARRAY:
case JOP_TAILCALL:
janetc_regalloc_touch(&ra, DD);
break;
/* Write A, Read E */
case JOP_MOVE_NEAR:
case JOP_LENGTH:
case JOP_BNOT:
case JOP_CALL:
janetc_regalloc_touch(&ra, EE);
break;
/* Read A, B */
case JOP_PUT_INDEX:
janetc_regalloc_touch(&ra, AA);
janetc_regalloc_touch(&ra, BB);
break;
/* Read A, E */
case JOP_PUSH_2:
janetc_regalloc_touch(&ra, AA);
janetc_regalloc_touch(&ra, EE);
break;
/* Read B, C */
case JOP_PROPAGATE:
/* Write A, Read B and C */
case JOP_BAND:
case JOP_BOR:
case JOP_BXOR:
case JOP_ADD:
case JOP_SUBTRACT:
case JOP_MULTIPLY:
case JOP_DIVIDE:
case JOP_DIVIDE_FLOOR:
case JOP_MODULO:
case JOP_REMAINDER:
case JOP_SHIFT_LEFT:
case JOP_SHIFT_RIGHT:
case JOP_SHIFT_RIGHT_UNSIGNED:
case JOP_GREATER_THAN:
case JOP_LESS_THAN:
case JOP_EQUALS:
case JOP_COMPARE:
case JOP_IN:
case JOP_GET:
case JOP_GREATER_THAN_EQUAL:
case JOP_LESS_THAN_EQUAL:
case JOP_NOT_EQUALS:
case JOP_CANCEL:
case JOP_RESUME:
case JOP_NEXT:
janetc_regalloc_touch(&ra, BB);
janetc_regalloc_touch(&ra, CC);
break;
/* Read A, B, C */
case JOP_PUT:
case JOP_PUSH_3:
janetc_regalloc_touch(&ra, AA);
janetc_regalloc_touch(&ra, BB);
janetc_regalloc_touch(&ra, CC);
break;
}
}
/* Iterate and set noops on instructions that make writes that no one ever reads.
* Only set noops for instructions with no side effects - moves, loads, etc. that can't
* raise errors (outside of systemic errors like oom or stack overflow). */
recur = 0;
for (int32_t i = 0; i < def->bytecode_length; i++) {
uint32_t instr = def->bytecode[i];
switch (instr & 0x7F) {
default:
break;
/* Write D */
case JOP_LOAD_NIL:
case JOP_LOAD_TRUE:
case JOP_LOAD_FALSE:
case JOP_LOAD_SELF:
case JOP_MAKE_ARRAY:
case JOP_MAKE_TUPLE:
case JOP_MAKE_BRACKET_TUPLE: {
if (!janetc_regalloc_check(&ra, DD)) {
def->bytecode[i] = JOP_NOOP;
recur = 1;
}
}
break;
/* Write E, Read A */
case JOP_MOVE_FAR: {
if (!janetc_regalloc_check(&ra, EE)) {
def->bytecode[i] = JOP_NOOP;
recur = 1;
}
}
break;
/* Write A, Read E */
case JOP_MOVE_NEAR:
/* Write A, Read B */
case JOP_GET_INDEX:
/* Write A */
case JOP_LOAD_INTEGER:
case JOP_LOAD_CONSTANT:
case JOP_LOAD_UPVALUE:
case JOP_CLOSURE: {
if (!janetc_regalloc_check(&ra, AA)) {
def->bytecode[i] = JOP_NOOP;
recur = 1;
}
}
break;
}
}
janetc_regalloc_deinit(&ra);
#undef AA
#undef BB
#undef CC
#undef DD
#undef EE
}
}
/* Verify some bytecode */
int janet_verify(JanetFuncDef *def) {
int vargs = !!(def->flags & JANET_FUNCDEF_FLAG_VARARG);
@@ -218,6 +506,7 @@ JanetFuncDef *janet_funcdef_alloc(void) {
def->closure_bitset = NULL;
def->flags = 0;
def->slotcount = 0;
def->symbolmap = NULL;
def->arity = 0;
def->min_arity = 0;
def->max_arity = INT32_MAX;
@@ -229,6 +518,7 @@ JanetFuncDef *janet_funcdef_alloc(void) {
def->constants_length = 0;
def->bytecode_length = 0;
def->environments_length = 0;
def->symbolmap_length = 0;
return def;
}

View File

@@ -1,5 +1,5 @@
/*
* Copyright (c) 2022 Calvin Rose
* Copyright (c) 2023 Calvin Rose
*
* Permission is hereby granted, free of charge, to any person obtaining a copy
* of this software and associated documentation files (the "Software"), to
@@ -209,12 +209,46 @@ const char *janet_optcstring(const Janet *argv, int32_t argc, int32_t n, const c
#undef DEFINE_OPTLEN
const char *janet_getcstring(const Janet *argv, int32_t n) {
const uint8_t *jstr = janet_getstring(argv, n);
const char *cstr = (const char *)jstr;
if (strlen(cstr) != (size_t) janet_string_length(jstr)) {
janet_panic("string contains embedded 0s");
if (!janet_checktype(argv[n], JANET_STRING)) {
janet_panic_type(argv[n], n, JANET_TFLAG_STRING);
}
return janet_getcbytes(argv, 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) 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) {
if (n >= argc || janet_checktype(argv[n], JANET_NIL)) {
return dflt;
}
return janet_getcbytes(argv, n);
}
int32_t janet_getnat(const Janet *argv, int32_t n) {
@@ -259,12 +293,36 @@ 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]);
#else
Janet x = argv[n];
if (!janet_checkint64(x)) {
janet_panicf("bad slot #%d, expected 64 bit signed integer, got %v", n, x);
}
return (int64_t) janet_unwrap_number(x);
#endif
}
uint64_t janet_getuinteger64(const Janet *argv, int32_t n) {
#ifdef JANET_INT_TYPES
return janet_unwrap_u64(argv[n]);
#else
Janet x = argv[n];
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);
#endif
}
size_t janet_getsize(const Janet *argv, int32_t n) {
@@ -280,16 +338,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;
}
@@ -336,24 +408,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;
}
@@ -433,9 +491,27 @@ 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);
#else
return __atomic_add_fetch(x, 1, __ATOMIC_RELAXED);
#endif
}
JanetAtomicInt janet_atomic_dec(JanetAtomicInt volatile *x) {
#ifdef JANET_WINDOWS
return InterlockedDecrement(x);
#else
return __atomic_add_fetch(x, -1, __ATOMIC_RELAXED);
#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);
}
@@ -443,10 +519,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

@@ -1,5 +1,5 @@
/*
* Copyright (c) 2022 Calvin Rose
* Copyright (c) 2023 Calvin Rose
*
* Permission is hereby granted, free of charge, to any person obtaining a copy
* of this software and associated documentation files (the "Software"), to
@@ -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

@@ -1,5 +1,5 @@
/*
* Copyright (c) 2022 Calvin Rose
* Copyright (c) 2023 Calvin Rose
*
* Permission is hereby granted, free of charge, to any person obtaining a copy
* of this software and associated documentation files (the "Software"), to
@@ -93,10 +93,14 @@ void janetc_freeslot(JanetCompiler *c, JanetSlot s) {
/* Add a slot to a scope with a symbol associated with it (def or var). */
void janetc_nameslot(JanetCompiler *c, const uint8_t *sym, JanetSlot s) {
SymPair sp;
int32_t cnt = janet_v_count(c->buffer);
sp.sym = sym;
sp.sym2 = sym;
sp.slot = s;
sp.keep = 0;
sp.slot.flags |= JANET_SLOT_NAMED;
sp.birth_pc = cnt ? cnt - 1 : 0;
sp.death_pc = UINT32_MAX;
janet_v_push(c->scope->syms, sp);
}
@@ -159,21 +163,27 @@ void janetc_popscope(JanetCompiler *c) {
if (oldscope->flags & JANET_SCOPE_CLOSURE) {
newscope->flags |= JANET_SCOPE_CLOSURE;
}
if (newscope->ra.max < oldscope->ra.max)
if (newscope->ra.max < oldscope->ra.max) {
newscope->ra.max = oldscope->ra.max;
/* Keep upvalue slots */
for (int32_t i = 0; i < janet_v_count(oldscope->syms); i++) {
SymPair pair = oldscope->syms[i];
if (pair.keep) {
/* The variable should not be lexically accessible */
pair.sym = NULL;
janet_v_push(newscope->syms, pair);
janetc_regalloc_touch(&newscope->ra, pair.slot.index);
}
}
/* Keep upvalue slots and symbols for debugging. */
for (int32_t i = 0; i < janet_v_count(oldscope->syms); i++) {
SymPair pair = oldscope->syms[i];
/* The variable should not be lexically accessible */
pair.sym = NULL;
if (pair.death_pc == UINT32_MAX) {
pair.death_pc = (uint32_t) janet_v_count(c->buffer);
}
if (pair.keep) {
/* The variable should also not be included in the locals */
pair.sym2 = NULL;
janetc_regalloc_touch(&newscope->ra, pair.slot.index);
}
janet_v_push(newscope->syms, pair);
}
}
/* Free the old scope */
janet_v_free(oldscope->consts);
janet_v_free(oldscope->syms);
@@ -334,6 +344,7 @@ found:
}
/* non-local scope needs to expose its environment */
JanetScope *original_scope = scope;
pair->keep = 1;
while (scope && !(scope->flags & JANET_SCOPE_FUNCTION))
scope = scope->parent;
@@ -355,7 +366,7 @@ found:
/* Check if scope already has env. If so, break */
len = janet_v_count(scope->envs);
for (j = 0; j < len; j++) {
if (scope->envs[j] == envindex) {
if (scope->envs[j].envindex == envindex) {
scopefound = 1;
envindex = j;
break;
@@ -364,7 +375,10 @@ found:
/* Add the environment if it is not already referenced */
if (!scopefound) {
len = janet_v_count(scope->envs);
janet_v_push(scope->envs, envindex);
JanetEnvRef ref;
ref.envindex = envindex;
ref.scope = original_scope;
janet_v_push(scope->envs, ref);
envindex = len;
}
}
@@ -408,6 +422,7 @@ JanetSlot *janetc_toslots(JanetCompiler *c, const Janet *vals, int32_t len) {
int32_t i;
JanetSlot *ret = NULL;
JanetFopts subopts = janetc_fopts_default(c);
subopts.flags |= JANET_FOPTS_ACCEPT_SPLICE;
for (i = 0; i < len; i++) {
janet_v_push(ret, janetc_value(subopts, vals[i]));
}
@@ -418,6 +433,7 @@ JanetSlot *janetc_toslots(JanetCompiler *c, const Janet *vals, int32_t len) {
JanetSlot *janetc_toslotskv(JanetCompiler *c, Janet ds) {
JanetSlot *ret = NULL;
JanetFopts subopts = janetc_fopts_default(c);
subopts.flags |= JANET_FOPTS_ACCEPT_SPLICE;
const JanetKV *kvs = NULL;
int32_t cap = 0, len = 0;
janet_dictionary_view(ds, &kvs, &len, &cap);
@@ -730,12 +746,14 @@ static int macroexpand1(
int lock = janet_gclock();
Janet mf_kw = janet_ckeywordv("macro-form");
janet_table_put(c->env, mf_kw, x);
Janet ml_kw = janet_ckeywordv("macro-lints");
if (c->lints) {
janet_table_put(c->env, ml_kw, janet_wrap_array(c->lints));
}
Janet tempOut;
JanetSignal status = janet_continue(fiberp, janet_wrap_nil(), &tempOut);
janet_table_put(c->env, mf_kw, janet_wrap_nil());
if (c->lints) {
janet_table_put(c->env, janet_ckeywordv("macro-lints"), janet_wrap_array(c->lints));
}
janet_table_put(c->env, ml_kw, janet_wrap_nil());
janet_gcunlock(lock);
if (status != JANET_SIGNAL_OK) {
const uint8_t *es = janet_formatc("(macro) %V", tempOut);
@@ -868,7 +886,10 @@ JanetFuncDef *janetc_pop_funcdef(JanetCompiler *c) {
/* Copy envs */
def->environments_length = janet_v_count(scope->envs);
def->environments = janet_v_flatten(scope->envs);
def->environments = janet_malloc(sizeof(int32_t) * def->environments_length);
for (int32_t i = 0; i < def->environments_length; i++) {
def->environments[i] = scope->envs[i].envindex;
}
def->constants_length = janet_v_count(scope->consts);
def->constants = janet_v_flatten(scope->consts);
@@ -923,9 +944,66 @@ JanetFuncDef *janetc_pop_funcdef(JanetCompiler *c) {
def->closure_bitset = chunks;
}
/* Capture symbol to local mapping */
JanetSymbolMap *locals = NULL;
/* Symbol -> upvalue mapping */
JanetScope *top = c->scope;
while (top->parent) top = top->parent;
for (JanetScope *s = top; s != NULL; s = s->child) {
for (int32_t j = 0; j < janet_v_count(scope->envs); j++) {
JanetEnvRef ref = scope->envs[j];
JanetScope *upscope = ref.scope;
if (upscope != s) continue;
for (int32_t i = 0; i < janet_v_count(upscope->syms); i++) {
SymPair pair = upscope->syms[i];
if (pair.sym2) {
JanetSymbolMap jsm;
jsm.birth_pc = UINT32_MAX;
jsm.death_pc = j;
jsm.slot_index = pair.slot.index;
jsm.symbol = pair.sym2;
janet_v_push(locals, jsm);
}
}
}
}
/* Symbol -> slot mapping */
for (int32_t i = 0; i < janet_v_count(scope->syms); i++) {
SymPair pair = scope->syms[i];
if (pair.sym2) {
JanetSymbolMap jsm;
if (pair.death_pc == UINT32_MAX) {
jsm.death_pc = def->bytecode_length;
} else {
jsm.death_pc = pair.death_pc - scope->bytecode_start;
}
/* Handle birth_pc == 0 correctly */
if ((uint32_t) scope->bytecode_start > pair.birth_pc) {
jsm.birth_pc = 0;
} else {
jsm.birth_pc = pair.birth_pc - scope->bytecode_start;
}
janet_assert(jsm.birth_pc <= jsm.death_pc, "birth pc after death pc");
janet_assert(jsm.birth_pc < (uint32_t) def->bytecode_length, "bad birth pc");
janet_assert(jsm.death_pc <= (uint32_t) def->bytecode_length, "bad death pc");
jsm.slot_index = pair.slot.index;
jsm.symbol = pair.sym2;
janet_v_push(locals, jsm);
}
}
def->symbolmap_length = janet_v_count(locals);
def->symbolmap = janet_v_flatten(locals);
if (def->symbolmap_length) def->flags |= JANET_FUNCDEF_FLAG_HASSYMBOLMAP;
/* Pop the scope */
janetc_popscope(c);
/* Do basic optimization */
janet_bytecode_movopt(def);
janet_bytecode_remove_noops(def);
return def;
}
@@ -996,7 +1074,7 @@ JanetCompileResult janet_compile(Janet source, JanetTable *env, const uint8_t *w
}
/* C Function for compiling */
JANET_CORE_FN(cfun,
JANET_CORE_FN(cfun_compile,
"(compile ast &opt env source lints)",
"Compiles an Abstract Syntax Tree (ast) into a function. "
"Pair the compile function with parsing functionality to implement "
@@ -1005,7 +1083,8 @@ JANET_CORE_FN(cfun,
"If a `lints` array is given, linting messages will be appended to the array. "
"Each message will be a tuple of the form `(level line col message)`.") {
janet_arity(argc, 1, 4);
JanetTable *env = argc > 1 ? janet_gettable(argv, 1) : janet_vm.fiber->env;
JanetTable *env = (argc > 1 && !janet_checktype(argv[1], JANET_NIL))
? janet_gettable(argv, 1) : janet_vm.fiber->env;
if (NULL == env) {
env = janet_table(0);
janet_vm.fiber->env = env;
@@ -1017,11 +1096,12 @@ JANET_CORE_FN(cfun,
source = janet_unwrap_string(x);
} else if (janet_checktype(x, JANET_KEYWORD)) {
source = janet_unwrap_keyword(x);
} else {
} else if (!janet_checktype(x, JANET_NIL)) {
janet_panic_type(x, 2, JANET_TFLAG_STRING | JANET_TFLAG_KEYWORD);
}
}
JanetArray *lints = (argc >= 4) ? janet_getarray(argv, 3) : NULL;
JanetArray *lints = (argc >= 4 && !janet_checktype(argv[3], JANET_NIL))
? janet_getarray(argv, 3) : NULL;
JanetCompileResult res = janet_compile_lint(argv[0], env, source, lints);
if (res.status == JANET_COMPILE_OK) {
return janet_wrap_function(janet_thunk(res.funcdef));
@@ -1043,7 +1123,7 @@ JANET_CORE_FN(cfun,
void janet_lib_compile(JanetTable *env) {
JanetRegExt cfuns[] = {
JANET_CORE_REG("compile", cfun),
JANET_CORE_REG("compile", cfun_compile),
JANET_REG_END
};
janet_core_cfuns_ext(env, NULL, cfuns);

View File

@@ -1,5 +1,5 @@
/*
* Copyright (c) 2022 Calvin Rose
* Copyright (c) 2023 Calvin Rose
*
* Permission is hereby granted, free of charge, to any person obtaining a copy
* of this software and associated documentation files (the "Software"), to
@@ -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;
@@ -111,13 +112,21 @@ struct JanetSlot {
typedef struct SymPair {
JanetSlot slot;
const uint8_t *sym;
const uint8_t *sym2;
int keep;
uint32_t birth_pc;
uint32_t death_pc;
} SymPair;
typedef struct JanetEnvRef {
int32_t envindex;
JanetScope *scope;
} JanetEnvRef;
/* A lexical scope during compilation */
struct JanetScope {
/* For debugging */
/* For debugging the compiler */
const char *name;
/* Scopes are doubly linked list */
@@ -133,7 +142,7 @@ struct JanetScope {
/* FuncDefs */
JanetFuncDef **defs;
/* Regsiter allocator */
/* Register allocator */
JanetcRegisterAllocator ra;
/* Upvalue allocator */
@@ -142,7 +151,7 @@ struct JanetScope {
/* Referenced closure environments. The values at each index correspond
* to which index to get the environment from in the parent. The environment
* that corresponds to the direct parent's stack will always have value 0. */
int32_t *envs;
JanetEnvRef *envs;
int32_t bytecode_start;
int flags;
@@ -179,6 +188,7 @@ struct JanetCompiler {
#define JANET_FOPTS_TAIL 0x10000
#define JANET_FOPTS_HINT 0x20000
#define JANET_FOPTS_DROP 0x40000
#define JANET_FOPTS_ACCEPT_SPLICE 0x80000
/* Options for compiling a single form */
struct JanetFopts {
@@ -227,7 +237,7 @@ JanetSlot *janetc_toslots(JanetCompiler *c, const Janet *vals, int32_t len);
/* Get a bunch of slots for function arguments */
JanetSlot *janetc_toslotskv(JanetCompiler *c, Janet ds);
/* Push slots load via janetc_toslots. */
/* Push slots loaded via janetc_toslots. */
int32_t janetc_pushslots(JanetCompiler *c, JanetSlot *slots);
/* Free slots loaded via janetc_toslots */
@@ -258,4 +268,8 @@ JanetSlot janetc_cslot(Janet x);
/* Search for a symbol */
JanetSlot janetc_resolve(JanetCompiler *c, const uint8_t *sym);
/* Bytecode optimization */
void janet_bytecode_movopt(JanetFuncDef *def);
void janet_bytecode_remove_noops(JanetFuncDef *def);
#endif

View File

@@ -1,5 +1,5 @@
/*
* Copyright (c) 2022 Calvin Rose
* Copyright (c) 2023 Calvin Rose
*
* Permission is hereby granted, free of charge, to any person obtaining a copy
* of this software and associated documentation files (the "Software"), to
@@ -42,52 +42,8 @@ extern size_t janet_core_image_size;
#define JDOC(x) NULL
#endif
/* Use LoadLibrary on windows or dlopen on posix to load dynamic libaries
* with native code. */
#if defined(JANET_NO_DYNAMIC_MODULES)
typedef int Clib;
#define load_clib(name) ((void) name, 0)
#define symbol_clib(lib, sym) ((void) lib, (void) sym, NULL)
#define error_clib() "dynamic libraries not supported"
#elif defined(JANET_WINDOWS)
#include <windows.h>
typedef HINSTANCE Clib;
#define load_clib(name) LoadLibrary((name))
#define symbol_clib(lib, sym) GetProcAddress((lib), (sym))
static char error_clib_buf[256];
static char *error_clib(void) {
FormatMessageA(FORMAT_MESSAGE_FROM_SYSTEM | FORMAT_MESSAGE_IGNORE_INSERTS,
NULL, GetLastError(), MAKELANGID(LANG_NEUTRAL, SUBLANG_DEFAULT),
error_clib_buf, sizeof(error_clib_buf), NULL);
error_clib_buf[strlen(error_clib_buf) - 1] = '\0';
return error_clib_buf;
}
#else
#include <dlfcn.h>
typedef void *Clib;
#define load_clib(name) dlopen((name), RTLD_NOW)
#define symbol_clib(lib, sym) dlsym((lib), (sym))
#define error_clib() dlerror()
#endif
static char *get_processed_name(const char *name) {
if (name[0] == '.') return (char *) name;
const char *c;
for (c = name; *c; c++) {
if (*c == '/') return (char *) name;
}
size_t l = (size_t)(c - name);
char *ret = janet_malloc(l + 3);
if (NULL == ret) {
JANET_OUT_OF_MEMORY;
}
ret[0] = '.';
ret[1] = '/';
memcpy(ret + 2, name, l + 1);
return ret;
}
JanetModule janet_native(const char *name, const uint8_t **error) {
janet_sandbox_assert(JANET_SANDBOX_DYNAMIC_MODULES);
char *processed_name = get_processed_name(name);
Clib lib = load_clib(processed_name);
JanetModule init;
@@ -156,7 +112,10 @@ JANET_CORE_FN(janet_core_expand_path,
"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"
"* :all: -- the value of path verbatim\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"
"* :name: -- the name component of path, with extension if given\n\n"
@@ -202,6 +161,21 @@ JANET_CORE_FN(janet_core_expand_path,
if (strncmp(template + i, ":all:", 5) == 0) {
janet_buffer_push_cstring(out, input);
i += 4;
} else if (strncmp(template + i, ":@all:", 6) == 0) {
if (input[0] == '@') {
const char *p = input;
while (*p && !is_path_sep(*p)) p++;
size_t len = p - input - 1;
char *str = janet_smalloc(len + 1);
memcpy(str, input + 1, len);
str[len] = '\0';
janet_formatb(out, "%V", janet_dyn(str));
janet_sfree(str);
janet_buffer_push_cstring(out, p);
} else {
janet_buffer_push_cstring(out, input);
}
i += 5;
} else if (strncmp(template + i, ":cur:", 5) == 0) {
janet_buffer_push_bytes(out, (const uint8_t *)curdir, curlen);
i += 4;
@@ -452,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. "
@@ -484,7 +488,7 @@ JANET_CORE_FN(janet_core_getproto,
? janet_wrap_struct(janet_struct_proto(st))
: janet_wrap_nil();
}
janet_panicf("expected struct|table, got %v", argv[0]);
janet_panicf("expected struct or table, got %v", argv[0]);
}
JANET_CORE_FN(janet_core_struct,
@@ -655,31 +659,137 @@ 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. ") {
janet_arity(argc, 1, 2);
int sig;
Janet payload = argc == 2 ? argv[1] : janet_wrap_nil();
if (janet_checkint(argv[0])) {
int32_t s = janet_unwrap_integer(argv[0]);
if (s < 0 || s > 9) {
janet_panicf("expected user signal between 0 and 9, got %d", s);
}
sig = JANET_SIGNAL_USER0 + s;
janet_signalv(JANET_SIGNAL_USER0 + s, payload);
} else {
JanetKeyword kw = janet_getkeyword(argv, 0);
if (!janet_cstrcmp(kw, "yield")) {
sig = JANET_SIGNAL_YIELD;
} else if (!janet_cstrcmp(kw, "error")) {
sig = JANET_SIGNAL_ERROR;
} else if (!janet_cstrcmp(kw, "debug")) {
sig = JANET_SIGNAL_DEBUG;
} else {
janet_panicf("unknown signal, expected :yield, :error, or :debug, got %v", argv[0]);
for (unsigned i = 0; i < sizeof(janet_signal_names) / sizeof(char *); i++) {
if (!janet_cstrcmp(kw, janet_signal_names[i])) {
janet_signalv((JanetSignal) i, payload);
}
}
}
Janet payload = argc == 2 ? argv[1] : janet_wrap_nil();
janet_signalv(sig, payload);
janet_panicf("unknown signal %v", argv[0]);
}
JANET_CORE_FN(janet_core_memcmp,
"(memcmp a b &opt len offset-a offset-b)",
"Compare memory. Takes two byte sequences `a` and `b`, and "
"return 0 if they have identical contents, a negative integer if a is less than b, "
"and a positive integer if a is greater than b. Optionally take a length and offsets "
"to compare slices of the bytes sequences.") {
janet_arity(argc, 2, 5);
JanetByteView a = janet_getbytes(argv, 0);
JanetByteView b = janet_getbytes(argv, 1);
int32_t len = janet_optnat(argv, argc, 2, a.len < b.len ? a.len : b.len);
int32_t offset_a = janet_optnat(argv, argc, 3, 0);
int32_t offset_b = janet_optnat(argv, argc, 4, 0);
if (offset_a + len > a.len) janet_panicf("invalid offset-a: %d", offset_a);
if (offset_b + len > b.len) janet_panicf("invalid offset-b: %d", offset_b);
return janet_wrap_integer(memcmp(a.bytes + offset_a, b.bytes + offset_b, (size_t) len));
}
typedef struct SandboxOption {
const char *name;
uint32_t flag;
} SandboxOption;
static const SandboxOption sandbox_options[] = {
{"all", JANET_SANDBOX_ALL},
{"env", JANET_SANDBOX_ENV},
{"ffi", JANET_SANDBOX_FFI},
{"ffi-define", JANET_SANDBOX_FFI_DEFINE},
{"ffi-jit", JANET_SANDBOX_FFI_JIT},
{"ffi-use", JANET_SANDBOX_FFI_USE},
{"fs", JANET_SANDBOX_FS},
{"fs-read", JANET_SANDBOX_FS_READ},
{"fs-temp", JANET_SANDBOX_FS_TEMP},
{"fs-write", JANET_SANDBOX_FS_WRITE},
{"hrtime", JANET_SANDBOX_HRTIME},
{"modules", JANET_SANDBOX_DYNAMIC_MODULES},
{"net", JANET_SANDBOX_NET},
{"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}
};
JANET_CORE_FN(janet_core_sandbox,
"(sandbox & forbidden-capabilities)",
"Disable feature sets to prevent the interpreter from using certain system resources. "
"Once a feature is disabled, there is no way to re-enable it. Capabilities can be:\n\n"
"* :all - disallow all (except IO to stdout, stderr, and stdin)\n"
"* :env - disallow reading and write env variables\n"
"* :ffi - disallow FFI (recommended if disabling anything else)\n"
"* :ffi-define - disallow loading new FFI modules and binding new functions\n"
"* :ffi-jit - disallow calling `ffi/jitfn`\n"
"* :ffi-use - disallow using any previously bound FFI functions and memory-unsafe functions.\n"
"* :fs - disallow access to the file system\n"
"* :fs-read - disallow read access to the file system\n"
"* :fs-temp - disallow creating temporary files\n"
"* :fs-write - disallow write access to the file system\n"
"* :hrtime - disallow high-resolution timers\n"
"* :modules - disallow load dynamic modules (natives)\n"
"* :net - disallow network access\n"
"* :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++) {
JanetKeyword kw = janet_getkeyword(argv, i);
const SandboxOption *opt = sandbox_options;
while (opt->name != NULL) {
if (janet_cstrcmp(kw, opt->name) == 0) {
flags |= opt->flag;
break;
}
opt++;
}
if (opt->name == NULL) janet_panicf("unknown capability %v", argv[i]);
}
janet_sandbox(flags);
return janet_wrap_nil();
}
#ifdef JANET_BOOTSTRAP
@@ -935,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
@@ -981,9 +1083,16 @@ 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),
JANET_CORE_REG("sandbox", janet_core_sandbox),
JANET_REG_END
};
janet_core_cfuns_ext(env, NULL, corelib_cfuns);
@@ -1016,20 +1125,15 @@ static void janet_load_libs(JanetTable *env) {
#ifdef JANET_NET
janet_lib_net(env);
#endif
#ifdef JANET_FFI
janet_lib_ffi(env);
#endif
}
#ifdef JANET_BOOTSTRAP
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"
@@ -1128,6 +1232,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

@@ -1,5 +1,5 @@
/*
* Copyright (c) 2022 Calvin Rose
* Copyright (c) 2023 Calvin Rose
*
* Permission is hereby granted, free of charge, to any person obtaining a copy
* of this software and associated documentation files (the "Software"), to
@@ -131,9 +131,9 @@ void janet_stacktrace_ext(JanetFiber *fiber, Janet err, const char *prefix) {
if (!wrote_error) {
JanetFiberStatus status = janet_fiber_status(fiber);
janet_eprintf("%s%s: %s\n",
prefix,
prefix ? prefix : "",
janet_status_names[status],
errstr);
errstr ? errstr : janet_status_names[status]);
wrote_error = 1;
}
@@ -314,6 +314,7 @@ static Janet doframe(JanetStackFrame *frame) {
if (frame->func && frame->pc) {
Janet *stack = (Janet *)frame + JANET_FRAME_SIZE;
JanetArray *slots;
janet_assert(def != NULL, "def != NULL");
off = (int32_t)(frame->pc - def->bytecode);
janet_table_put(t, janet_ckeywordv("pc"), janet_wrap_integer(off));
if (def->sourcemap) {
@@ -329,6 +330,27 @@ static Janet doframe(JanetStackFrame *frame) {
safe_memcpy(slots->data, stack, sizeof(Janet) * def->slotcount);
slots->count = def->slotcount;
janet_table_put(t, janet_ckeywordv("slots"), janet_wrap_array(slots));
/* Add local bindings */
if (def->symbolmap) {
JanetTable *local_bindings = janet_table(0);
for (int32_t i = def->symbolmap_length - 1; i >= 0; i--) {
JanetSymbolMap jsm = def->symbolmap[i];
Janet value = janet_wrap_nil();
uint32_t pc = (uint32_t)(frame->pc - def->bytecode);
if (jsm.birth_pc == UINT32_MAX) {
JanetFuncEnv *env = frame->func->envs[jsm.death_pc];
if (env->offset > 0) {
value = env->as.fiber->data[env->offset + jsm.slot_index];
} else {
value = env->as.values[jsm.slot_index];
}
} else if (pc >= jsm.birth_pc && pc < jsm.death_pc) {
value = stack[jsm.slot_index];
}
janet_table_put(local_bindings, janet_wrap_symbol(jsm.symbol), value);
}
janet_table_put(t, janet_ckeywordv("locals"), janet_wrap_table(local_bindings));
}
}
return janet_wrap_table(t);
}

View File

@@ -1,5 +1,5 @@
/*
* Copyright (c) 2022 Calvin Rose
* Copyright (c) 2023 Calvin Rose
*
* Permission is hereby granted, free of charge, to any person obtaining a copy
* of this software and associated documentation files (the "Software"), to
@@ -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) |

View File

@@ -1,5 +1,5 @@
/*
* Copyright (c) 2022 Calvin Rose
* Copyright (c) 2023 Calvin Rose
*
* Permission is hereby granted, free of charge, to any person obtaining a copy
* of this software and associated documentation files (the "Software"), to

File diff suppressed because it is too large Load Diff

View File

@@ -1,5 +1,5 @@
/*
* Copyright (c) 2022 Calvin Rose
* Copyright (c) 2023 Calvin Rose
*
* Permission is hereby granted, free of charge, to any person obtaining a copy
* of this software and associated documentation files (the "Software"), to
@@ -26,9 +26,10 @@
#define JANET_FEATURES_H_defined
#if defined(__NetBSD__) || defined(__APPLE__) || defined(__OpenBSD__) \
|| defined(__bsdi__) || defined(__DragonFly__)
|| defined(__bsdi__) || defined(__DragonFly__) || defined(__FreeBSD__)
/* Use BSD source on any BSD systems, include OSX */
# define _BSD_SOURCE
# define _POSIX_C_SOURCE 200809L
#else
/* Use POSIX feature flags */
# ifndef _POSIX_C_SOURCE
@@ -36,13 +37,31 @@
# endif
#endif
#if defined(__APPLE__)
#define _DARWIN_C_SOURCE
#endif
/* Needed for sched.h for cpu count */
#ifdef __linux__
#define _GNU_SOURCE
#endif
#if defined(WIN32) || defined(_WIN32)
#define WIN32_LEAN_AND_MEAN
#endif
/* Needed for realpath on linux */
#if !defined(_XOPEN_SOURCE) && (defined(__linux__) || defined(__EMSCRIPTEN__))
#define _XOPEN_SOURCE 500
/* needed for inet_pton and InitializeSRWLock */
#ifdef __MINGW32__
#define _WIN32_WINNT _WIN32_WINNT_VISTA
#endif
/* Needed for realpath on linux, as well as pthread rwlocks. */
#ifndef _XOPEN_SOURCE
#define _XOPEN_SOURCE 600
#endif
#if _XOPEN_SOURCE < 600
#undef _XOPEN_SOURCE
#define _XOPEN_SOURCE 600
#endif
/* Needed for timegm and other extensions when building with -std=c99.
@@ -52,4 +71,9 @@
#define _NETBSD_SOURCE
#endif
/* Needed for several things when building with -std=c99. */
#if !__BSD_VISIBLE && (defined(__DragonFly__) || defined(__FreeBSD__))
#define __BSD_VISIBLE 1
#endif
#endif

1593
src/core/ffi.c Normal file

File diff suppressed because it is too large Load Diff

View File

@@ -1,5 +1,5 @@
/*
* Copyright (c) 2022 Calvin Rose
* Copyright (c) 2023 Calvin Rose
*
* Permission is hereby granted, free of charge, to any person obtaining a copy
* of this software and associated documentation files (the "Software"), to
@@ -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);
@@ -81,10 +83,10 @@ JanetFiber *janet_fiber_reset(JanetFiber *fiber, JanetFunction *callee, int32_t
}
fiber->stacktop = newstacktop;
}
/* Don't panic on failure since we use this to implement janet_pcall */
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;
@@ -237,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));
}
}
@@ -368,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 {
@@ -477,10 +479,10 @@ JANET_CORE_FN(cfun_fiber_setenv,
}
JANET_CORE_FN(cfun_fiber_new,
"(fiber/new func &opt sigmask)",
"(fiber/new func &opt sigmask env)",
"Create a new fiber with function body func. Can optionally "
"take a set of signals to block from the current parent fiber "
"when called. The mask is specified as a keyword where each character "
"take a set of signals `sigmask` to capture from child fibers, "
"and an environment table `env`. The mask is specified as a keyword where each character "
"is used to indicate a signal to block. If the ev module is enabled, and "
"this fiber is used as an argument to `ev/go`, these \"blocked\" signals "
"will result in messages being sent to the supervisor channel. "
@@ -495,19 +497,25 @@ JANET_CORE_FN(cfun_fiber_new,
"* :t - block termination signals: error + user[0-4]\n"
"* :u - block user signals\n"
"* :y - block yield signals\n"
"* :w - block await signals (user9)\n"
"* :r - block interrupt signals (user8)\n"
"* :0-9 - block a specific user signal\n\n"
"The sigmask argument also can take environment flags. If any mutually "
"exclusive flags are present, the last flag takes precedence.\n\n"
"* :i - inherit the environment from the current fiber\n"
"* :p - the environment table's prototype is the current environment table") {
janet_arity(argc, 1, 2);
janet_arity(argc, 1, 3);
JanetFunction *func = janet_getfunction(argv, 0);
JanetFiber *fiber;
if (func->def->min_arity > 1) {
janet_panicf("fiber function must accept 0 or 1 arguments");
}
fiber = janet_fiber(func, 64, func->def->min_arity, NULL);
if (argc == 2) {
janet_assert(fiber != NULL, "bad fiber arity check");
if (argc == 3 && !janet_checktype(argv[2], JANET_NIL)) {
fiber->env = janet_gettable(argv, 2);
}
if (argc >= 2) {
int32_t i;
JanetByteView view = janet_getbytes(argv, 1);
fiber->flags = JANET_FIBER_RESUME_NO_USEVAL | JANET_FIBER_RESUME_NO_SKIP;
@@ -518,7 +526,7 @@ JANET_CORE_FN(cfun_fiber_new,
} else {
switch (view.bytes[i]) {
default:
janet_panicf("invalid flag %c, expected a, t, d, e, u, y, i, or p", view.bytes[i]);
janet_panicf("invalid flag %c, expected a, t, d, e, u, y, w, r, i, or p", view.bytes[i]);
break;
case 'a':
fiber->flags |=
@@ -548,6 +556,12 @@ JANET_CORE_FN(cfun_fiber_new,
case 'y':
fiber->flags |= JANET_FIBER_MASK_YIELD;
break;
case 'w':
fiber->flags |= JANET_FIBER_MASK_USER9;
break;
case 'r':
fiber->flags |= JANET_FIBER_MASK_USER8;
break;
case 'i':
if (!janet_vm.fiber->env) {
janet_vm.fiber->env = janet_table(0);
@@ -575,7 +589,9 @@ JANET_CORE_FN(cfun_fiber_status,
"* :error - the fiber has errored out\n"
"* :debug - the fiber is suspended in debug mode\n"
"* :pending - the fiber has been yielded\n"
"* :user(0-9) - the fiber is suspended by a user signal\n"
"* :user(0-7) - the fiber is suspended by a user signal\n"
"* :interrupted - the fiber was interrupted\n"
"* :suspended - the fiber is waiting to be resumed by the scheduler\n"
"* :alive - the fiber is currently running and cannot be resumed\n"
"* :new - the fiber has just been created and not yet run") {
janet_fixarity(argc, 1);
@@ -625,11 +641,7 @@ JANET_CORE_FN(cfun_fiber_setmaxstack,
return argv[0];
}
JANET_CORE_FN(cfun_fiber_can_resume,
"(fiber/can-resume? fiber)",
"Check if a fiber is finished and cannot be resumed.") {
janet_fixarity(argc, 1);
JanetFiber *fiber = janet_getfiber(argv, 0);
int janet_fiber_can_resume(JanetFiber *fiber) {
JanetFiberStatus s = janet_fiber_status(fiber);
int isFinished = s == JANET_STATUS_DEAD ||
s == JANET_STATUS_ERROR ||
@@ -638,7 +650,15 @@ JANET_CORE_FN(cfun_fiber_can_resume,
s == JANET_STATUS_USER2 ||
s == JANET_STATUS_USER3 ||
s == JANET_STATUS_USER4;
return janet_wrap_boolean(!isFinished);
return !isFinished;
}
JANET_CORE_FN(cfun_fiber_can_resume,
"(fiber/can-resume? fiber)",
"Check if a fiber is finished and cannot be resumed.") {
janet_fixarity(argc, 1);
JanetFiber *fiber = janet_getfiber(argv, 0);
return janet_wrap_boolean(janet_fiber_can_resume(fiber));
}
JANET_CORE_FN(cfun_fiber_last_value,

View File

@@ -1,5 +1,5 @@
/*
* Copyright (c) 2022 Calvin Rose
* Copyright (c) 2023 Calvin Rose
*
* Permission is hereby granted, free of charge, to any person obtaining a copy
* of this software and associated documentation files (the "Software"), to
@@ -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

@@ -1,5 +1,5 @@
/*
* Copyright (c) 2022 Calvin Rose
* Copyright (c) 2023 Calvin Rose
*
* Permission is hereby granted, free of charge, to any person obtaining a copy
* of this software and associated documentation files (the "Software"), to
@@ -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;
@@ -209,6 +237,12 @@ static void janet_mark_funcdef(JanetFuncDef *def) {
janet_mark_string(def->source);
if (def->name)
janet_mark_string(def->name);
if (def->symbolmap) {
for (int i = 0; i < def->symbolmap_length; i++) {
janet_mark_string(def->symbolmap[i].symbol);
}
}
}
static void janet_mark_function(JanetFunction *func) {
@@ -262,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 */
@@ -286,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;
@@ -314,17 +362,104 @@ static void janet_deinit_block(JanetGCObject *mem) {
janet_free(def->bytecode);
janet_free(def->sourcemap);
janet_free(def->closure_bitset);
janet_free(def->symbolmap);
}
break;
}
}
/* 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)) {
@@ -342,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;
@@ -363,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 */
@@ -398,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;
@@ -430,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
@@ -449,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();
@@ -552,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

@@ -1,5 +1,5 @@
/*
* Copyright (c) 2022 Calvin Rose
* Copyright (c) 2023 Calvin Rose
*
* Permission is hereby granted, free of charge, to any person obtaining a copy
* of this software and associated documentation files (the "Software"), to
@@ -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

@@ -1,5 +1,5 @@
/*
* Copyright (c) 2022 Calvin Rose & contributors
* Copyright (c) 2023 Calvin Rose & contributors
*
* Permission is hereby granted, free of charge, to any person obtaining a copy
* of this software and associated documentation files (the "Software"), to
@@ -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;
@@ -138,7 +137,7 @@ int64_t janet_unwrap_s64(Janet x) {
break;
}
}
janet_panicf("bad s64 initializer: %t", x);
janet_panicf("can not convert %t %q to 64 bit signed integer", x, x);
return 0;
}
@@ -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;
@@ -169,7 +165,7 @@ uint64_t janet_unwrap_u64(Janet x) {
break;
}
}
janet_panicf("bad u64 initializer: %t", x);
janet_panicf("can not convert %t %q to a 64 bit unsigned integer", x, x);
return 0;
}
@@ -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);
@@ -407,25 +403,52 @@ static Janet cfun_it_u64_compare(int32_t argc, Janet *argv) {
return janet_wrap_nil();
}
/*
* In C, signed arithmetic overflow is undefined behvior
* but unsigned arithmetic overflow is twos complement
*
* Reference:
* https://en.cppreference.com/w/cpp/language/ub
* http://blog.llvm.org/2011/05/what-every-c-programmer-should-know.html
*
* This means OPMETHOD & OPMETHODINVERT must always use
* unsigned arithmetic internally, regardless of the true type.
* This will not affect the end result (property of twos complement).
*/
#define OPMETHOD(T, type, name, oper) \
static Janet cfun_it_##type##_##name(int32_t argc, Janet *argv) { \
janet_arity(argc, 2, -1); \
T *box = janet_abstract(&janet_##type##_type, sizeof(T)); \
*box = janet_unwrap_##type(argv[0]); \
for (int32_t i = 1; i < argc; i++) \
*box oper##= janet_unwrap_##type(argv[i]); \
/* This avoids undefined behavior. See above for why. */ \
*box = (T) ((uint64_t) (*box)) oper ((uint64_t) janet_unwrap_##type(argv[i])); \
return janet_wrap_abstract(box); \
} \
#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]); \
*box oper##= janet_unwrap_##type(argv[0]); \
/* This avoids undefined behavior. See above for why. */ \
*box = (T) ((uint64_t) *box) oper ((uint64_t) janet_unwrap_##type(argv[0])); \
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); \
@@ -433,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); \
} \
@@ -457,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; \
} \
@@ -465,51 +488,95 @@ 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);
}
static Janet cfun_it_s64_modi(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) {
*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, 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, 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, >>)
@@ -518,7 +585,6 @@ OPMETHOD(uint64_t, u64, rshift, >>)
#undef DIVMETHOD_SIGNED
#undef COMPMETHOD
static JanetMethod it_s64_methods[] = {
{"+", cfun_it_s64_add},
{"r+", cfun_it_s64_add},
@@ -528,20 +594,22 @@ 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_mod},
{"rmod", cfun_it_s64_modi},
{"%", cfun_it_s64_rem},
{"r%", cfun_it_s64_rem},
{"r%", cfun_it_s64_remi},
{"&", cfun_it_s64_and},
{"r&", cfun_it_s64_and},
{"|", cfun_it_s64_or},
{"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},
{NULL, NULL}
};
@@ -554,20 +622,22 @@ 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_mod},
{"%", cfun_it_u64_mod},
{"r%", cfun_it_u64_mod},
{"rmod", 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},
{NULL, NULL}
};

View File

@@ -1,5 +1,5 @@
/*
* Copyright (c) 2022 Calvin Rose
* Copyright (c) 2023 Calvin Rose
*
* Permission is hereby granted, free of charge, to any person obtaining a copy
* of this software and associated documentation files (the "Software"), to
@@ -69,12 +69,15 @@ static int32_t checkflags(const uint8_t *str) {
break;
case 'w':
flags |= JANET_FILE_WRITE;
janet_sandbox_assert(JANET_SANDBOX_FS_WRITE);
break;
case 'a':
flags |= JANET_FILE_APPEND;
janet_sandbox_assert(JANET_SANDBOX_FS);
break;
case 'r':
flags |= JANET_FILE_READ;
janet_sandbox_assert(JANET_SANDBOX_FS_READ);
break;
}
for (i = 1; i < len; i++) {
@@ -84,6 +87,7 @@ static int32_t checkflags(const uint8_t *str) {
break;
case '+':
if (flags & JANET_FILE_UPDATE) return -1;
janet_sandbox_assert(JANET_SANDBOX_FS_WRITE);
flags |= JANET_FILE_UPDATE;
break;
case 'b':
@@ -112,46 +116,11 @@ static void *makef(FILE *f, int32_t flags) {
return iof;
}
/* Open a process */
#ifndef JANET_NO_PROCESSES
JANET_CORE_FN(cfun_io_popen,
"(file/popen command &opt mode) (DEPRECATED for os/spawn)",
"Open a file that is backed by a process. The file must be opened in either "
"the :r (read) or the :w (write) mode. In :r mode, the stdout of the "
"process can be read from the file. In :w mode, the stdin of the process "
"can be written to. Returns the new file.") {
janet_arity(argc, 1, 2);
const uint8_t *fname = janet_getstring(argv, 0);
const uint8_t *fmode = NULL;
int32_t flags;
if (argc == 2) {
fmode = janet_getkeyword(argv, 1);
flags = JANET_FILE_PIPED | checkflags(fmode);
if (flags & (JANET_FILE_UPDATE | JANET_FILE_BINARY | JANET_FILE_APPEND)) {
janet_panicf("invalid popen file mode :%S, expected :r or :w", fmode);
}
fmode = (const uint8_t *)((fmode[0] == 'r') ? "r" : "w");
} else {
fmode = (const uint8_t *)"r";
flags = JANET_FILE_PIPED | JANET_FILE_READ;
}
#ifdef JANET_WINDOWS
#define popen _popen
#endif
FILE *f = popen((const char *)fname, (const char *)fmode);
if (!f) {
if (flags & JANET_FILE_NONIL)
janet_panicf("failed to popen %s: %s", fname, strerror(errno));
return janet_wrap_nil();
}
return janet_makefile(f, flags);
}
#endif
JANET_CORE_FN(cfun_io_temp,
"(file/temp)",
"Open an anonymous temporary file that is removed on close. "
"Raises an error on failure.") {
janet_sandbox_assert(JANET_SANDBOX_FS_TEMP);
(void)argv;
janet_fixarity(argc, 0);
// XXX use mkostemp when we can to avoid CLOEXEC race.
@@ -162,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 "
@@ -174,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;
@@ -184,9 +154,19 @@ JANET_CORE_FN(cfun_io_fopen,
flags = checkflags(fmode);
} else {
fmode = (const uint8_t *)"r";
janet_sandbox_assert(JANET_SANDBOX_FS_READ);
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();
@@ -279,6 +259,13 @@ JANET_CORE_FN(cfun_io_fwrite,
return argv[0];
}
static void io_assert_writeable(JanetFile *iof) {
if (iof->flags & JANET_FILE_CLOSED)
janet_panic("file is closed");
if (!(iof->flags & (JANET_FILE_WRITE | JANET_FILE_APPEND | JANET_FILE_UPDATE)))
janet_panic("file is not writeable");
}
/* Flush the bytes in the file */
JANET_CORE_FN(cfun_io_fflush,
"(file/flush f)",
@@ -286,17 +273,13 @@ JANET_CORE_FN(cfun_io_fflush,
"buffered for efficiency reasons. Returns the file handle.") {
janet_fixarity(argc, 1);
JanetFile *iof = janet_getabstract(argv, 0, &janet_file_type);
if (iof->flags & JANET_FILE_CLOSED)
janet_panic("file is closed");
if (!(iof->flags & (JANET_FILE_WRITE | JANET_FILE_APPEND | JANET_FILE_UPDATE)))
janet_panic("file is not writeable");
io_assert_writeable(iof);
if (fflush(iof->file))
janet_panic("could not flush file");
return argv[0];
}
#ifdef JANET_WINDOWS
#define pclose _pclose
#define WEXITSTATUS(x) x
#endif
@@ -304,15 +287,9 @@ JANET_CORE_FN(cfun_io_fflush,
int janet_file_close(JanetFile *file) {
int ret = 0;
if (!(file->flags & (JANET_FILE_NOT_CLOSEABLE | JANET_FILE_CLOSED))) {
#ifndef JANET_NO_PROCESSES
if (file->flags & JANET_FILE_PIPED) {
ret = pclose(file->file);
} else
#endif
{
ret = fclose(file->file);
}
ret = fclose(file->file);
file->flags |= JANET_FILE_CLOSED;
file->file = NULL; /* NULL derefence is easier to debug then other problems */
return ret;
}
return 0;
@@ -331,30 +308,18 @@ JANET_CORE_FN(cfun_io_fclose,
"(file/close f)",
"Close a file and release all related resources. When you are "
"done reading a file, close it to prevent a resource leak and let "
"other processes read the file. If the file is the result of a file/popen "
"call, close waits for and returns the process exit status.") {
"other processes read the file.") {
janet_fixarity(argc, 1);
JanetFile *iof = janet_getabstract(argv, 0, &janet_file_type);
if (iof->flags & JANET_FILE_CLOSED)
return janet_wrap_nil();
if (iof->flags & (JANET_FILE_NOT_CLOSEABLE))
janet_panic("file not closable");
if (iof->flags & JANET_FILE_PIPED) {
#ifndef JANET_NO_PROCESSES
int status = pclose(iof->file);
iof->flags |= JANET_FILE_CLOSED;
if (status == -1) janet_panic("could not close file");
return janet_wrap_integer(WEXITSTATUS(status));
#else
return janet_wrap_nil();
#endif
} else {
if (fclose(iof->file)) {
iof->flags |= JANET_FILE_NOT_CLOSEABLE;
janet_panic("could not close file");
}
iof->flags |= JANET_FILE_CLOSED;
if (fclose(iof->file)) {
iof->flags |= JANET_FILE_NOT_CLOSEABLE;
janet_panic("could not close file");
}
iof->flags |= JANET_FILE_CLOSED;
return janet_wrap_nil();
}
@@ -393,11 +358,24 @@ JANET_CORE_FN(cfun_io_fseek,
return argv[0];
}
JANET_CORE_FN(cfun_io_ftell,
"(file/tell f)",
"Get the current value of the file position for file `f`.") {
janet_fixarity(argc, 1);
JanetFile *iof = janet_getabstract(argv, 0, &janet_file_type);
if (iof->flags & JANET_FILE_CLOSED)
janet_panic("file is closed");
long pos = ftell(iof->file);
if (pos == -1) janet_panic("error getting position in file");
return janet_wrap_number((double)pos);
}
static JanetMethod io_file_methods[] = {
{"close", cfun_io_fclose},
{"flush", cfun_io_fflush},
{"read", cfun_io_fread},
{"seek", cfun_io_fseek},
{"tell", cfun_io_ftell},
{"write", cfun_io_fwrite},
{NULL, NULL}
};
@@ -505,6 +483,7 @@ static Janet cfun_io_print_impl_x(int32_t argc, Janet *argv, int newline,
if (janet_abstract_type(abstract) != &janet_file_type)
return janet_wrap_nil();
JanetFile *iofile = abstract;
io_assert_writeable(iofile);
f = iofile->file;
break;
}
@@ -535,7 +514,6 @@ static Janet cfun_io_print_impl_x(int32_t argc, Janet *argv, int newline,
return janet_wrap_nil();
}
static Janet cfun_io_print_impl(int32_t argc, Janet *argv,
int newline, const char *name, FILE *dflt_file) {
Janet x = janet_dyn(name);
@@ -546,27 +524,27 @@ JANET_CORE_FN(cfun_io_print,
"(print & xs)",
"Print values to the console (standard out). Value are converted "
"to strings if they are not already. After printing all values, a "
"newline character is printed. Use the value of (dyn :out stdout) to determine "
"what to push characters to. Expects (dyn :out stdout) to be either a core/file or "
"newline character is printed. Use the value of `(dyn :out stdout)` to determine "
"what to push characters to. Expects `(dyn :out stdout)` to be either a core/file or "
"a buffer. Returns nil.") {
return cfun_io_print_impl(argc, argv, 1, "out", stdout);
}
JANET_CORE_FN(cfun_io_prin,
"(prin & xs)",
"Same as print, but does not add trailing newline.") {
"Same as `print`, but does not add trailing newline.") {
return cfun_io_print_impl(argc, argv, 0, "out", stdout);
}
JANET_CORE_FN(cfun_io_eprint,
"(eprint & xs)",
"Same as print, but uses (dyn :err stderr) instead of (dyn :out stdout).") {
"Same as `print`, but uses `(dyn :err stderr)` instead of `(dyn :out stdout)`.") {
return cfun_io_print_impl(argc, argv, 1, "err", stderr);
}
JANET_CORE_FN(cfun_io_eprin,
"(eprin & xs)",
"Same as prin, but uses (dyn :err stderr) instead of (dyn :out stdout).") {
"Same as `prin`, but uses `(dyn :err stderr)` instead of `(dyn :out stdout)`.") {
return cfun_io_print_impl(argc, argv, 0, "err", stderr);
}
@@ -574,7 +552,7 @@ JANET_CORE_FN(cfun_io_xprint,
"(xprint to & xs)",
"Print to a file or other value explicitly (no dynamic bindings) with a trailing "
"newline character. The value to print "
"to is the first argument, and is otherwise the same as print. Returns nil.") {
"to is the first argument, and is otherwise the same as `print`. Returns nil.") {
janet_arity(argc, 1, -1);
return cfun_io_print_impl_x(argc, argv, 1, NULL, 1, argv[0]);
}
@@ -582,7 +560,7 @@ JANET_CORE_FN(cfun_io_xprint,
JANET_CORE_FN(cfun_io_xprin,
"(xprin to & xs)",
"Print to a file or other value explicitly (no dynamic bindings). The value to print "
"to is the first argument, and is otherwise the same as prin. Returns nil.") {
"to is the first argument, and is otherwise the same as `prin`. Returns nil.") {
janet_arity(argc, 1, -1);
return cfun_io_print_impl_x(argc, argv, 0, NULL, 1, argv[0]);
}
@@ -601,6 +579,16 @@ static Janet cfun_io_printf_impl_x(int32_t argc, Janet *argv, int newline,
if (newline) janet_buffer_push_u8(buf, '\n');
return janet_wrap_nil();
}
case JANET_FUNCTION: {
/* Special case function */
JanetFunction *fun = janet_unwrap_function(x);
JanetBuffer *buf = janet_buffer(0);
janet_buffer_format(buf, fmt, offset, argc, argv);
if (newline) janet_buffer_push_u8(buf, '\n');
Janet args[1] = { janet_wrap_buffer(buf) };
janet_call(fun, 1, args);
return janet_wrap_nil();
}
case JANET_NIL:
f = dflt_file;
if (f == NULL) janet_panic("cannot print to nil");
@@ -610,6 +598,10 @@ static Janet cfun_io_printf_impl_x(int32_t argc, Janet *argv, int newline,
if (janet_abstract_type(abstract) != &janet_file_type)
return janet_wrap_nil();
JanetFile *iofile = abstract;
if (iofile->flags & JANET_FILE_CLOSED) {
janet_panic("cannot print to closed file");
}
io_assert_writeable(iofile);
f = iofile->file;
break;
}
@@ -640,38 +632,38 @@ static Janet cfun_io_printf_impl(int32_t argc, Janet *argv, int newline,
JANET_CORE_FN(cfun_io_printf,
"(printf fmt & xs)",
"Prints output formatted as if with (string/format fmt ;xs) to (dyn :out stdout) with a trailing newline.") {
"Prints output formatted as if with `(string/format fmt ;xs)` to `(dyn :out stdout)` with a trailing newline.") {
return cfun_io_printf_impl(argc, argv, 1, "out", stdout);
}
JANET_CORE_FN(cfun_io_prinf,
"(prinf fmt & xs)",
"Like printf but with no trailing newline.") {
"Like `printf` but with no trailing newline.") {
return cfun_io_printf_impl(argc, argv, 0, "out", stdout);
}
JANET_CORE_FN(cfun_io_eprintf,
"(eprintf fmt & xs)",
"Prints output formatted as if with (string/format fmt ;xs) to (dyn :err stderr) with a trailing newline.") {
"Prints output formatted as if with `(string/format fmt ;xs)` to `(dyn :err stderr)` with a trailing newline.") {
return cfun_io_printf_impl(argc, argv, 1, "err", stderr);
}
JANET_CORE_FN(cfun_io_eprinf,
"(eprinf fmt & xs)",
"Like eprintf but with no trailing newline.") {
"Like `eprintf` but with no trailing newline.") {
return cfun_io_printf_impl(argc, argv, 0, "err", stderr);
}
JANET_CORE_FN(cfun_io_xprintf,
"(xprintf to fmt & xs)",
"Like printf but prints to an explicit file or value to. Returns nil.") {
"Like `printf` but prints to an explicit file or value `to`. Returns nil.") {
janet_arity(argc, 2, -1);
return cfun_io_printf_impl_x(argc, argv, 1, NULL, 1, argv[0]);
}
JANET_CORE_FN(cfun_io_xprinf,
"(xprinf to fmt & xs)",
"Like prinf but prints to an explicit file or value to. Returns nil.") {
"Like `prinf` but prints to an explicit file or value `to`. Returns nil.") {
janet_arity(argc, 2, -1);
return cfun_io_printf_impl_x(argc, argv, 0, NULL, 1, argv[0]);
}
@@ -696,7 +688,7 @@ static void janet_flusher(const char *name, FILE *dflt_file) {
JANET_CORE_FN(cfun_io_flush,
"(flush)",
"Flush (dyn :out stdout) if it is a file, otherwise do nothing.") {
"Flush `(dyn :out stdout)` if it is a file, otherwise do nothing.") {
janet_fixarity(argc, 0);
(void) argv;
janet_flusher("out", stdout);
@@ -705,7 +697,7 @@ JANET_CORE_FN(cfun_io_flush,
JANET_CORE_FN(cfun_io_eflush,
"(eflush)",
"Flush (dyn :err stderr) if it is a file, otherwise do nothing.") {
"Flush `(dyn :err stderr)` if it is a file, otherwise do nothing.") {
janet_fixarity(argc, 0);
(void) argv;
janet_flusher("err", stderr);
@@ -734,12 +726,23 @@ void janet_dynprintf(const char *name, FILE *dflt_file, const char *format, ...)
if (janet_abstract_type(abstract) != &janet_file_type)
break;
JanetFile *iofile = abstract;
io_assert_writeable(iofile);
f = iofile->file;
}
fwrite(buffer.data, buffer.count, 1, f);
janet_buffer_deinit(&buffer);
break;
}
case JANET_FUNCTION: {
JanetFunction *fun = janet_unwrap_function(x);
int32_t len = 0;
while (format[len]) len++;
JanetBuffer *buf = janet_buffer(len);
janet_formatbv(buf, format, args);
Janet args[1] = { janet_wrap_buffer(buf) };
janet_call(fun, 1, args);
break;
}
case JANET_BUFFER:
janet_formatbv(janet_unwrap_buffer(x), format, args);
break;
@@ -754,17 +757,17 @@ JanetFile *janet_getjfile(const Janet *argv, int32_t n) {
return janet_getabstract(argv, n, &janet_file_type);
}
FILE *janet_getfile(const Janet *argv, int32_t n, int *flags) {
FILE *janet_getfile(const Janet *argv, int32_t n, int32_t *flags) {
JanetFile *iof = janet_getabstract(argv, n, &janet_file_type);
if (NULL != flags) *flags = iof->flags;
return iof->file;
}
JanetFile *janet_makejfile(FILE *f, int flags) {
JanetFile *janet_makejfile(FILE *f, int32_t flags) {
return makef(f, flags);
}
Janet janet_makefile(FILE *f, int flags) {
Janet janet_makefile(FILE *f, int32_t flags) {
return janet_wrap_abstract(makef(f, flags));
}
@@ -772,7 +775,7 @@ JanetAbstract janet_checkfile(Janet j) {
return janet_checkabstract(j, &janet_file_type);
}
FILE *janet_unwrapfile(Janet j, int *flags) {
FILE *janet_unwrapfile(Janet j, int32_t *flags) {
JanetFile *iof = janet_unwrap_abstract(j);
if (NULL != flags) *flags = iof->flags;
return iof->file;
@@ -802,9 +805,7 @@ void janet_lib_io(JanetTable *env) {
JANET_CORE_REG("file/write", cfun_io_fwrite),
JANET_CORE_REG("file/flush", cfun_io_fflush),
JANET_CORE_REG("file/seek", cfun_io_fseek),
#ifndef JANET_NO_PROCESSES
JANET_CORE_REG("file/popen", cfun_io_popen),
#endif
JANET_CORE_REG("file/tell", cfun_io_ftell),
JANET_REG_END
};
janet_core_cfuns_ext(env, NULL, io_cfuns);

View File

@@ -1,5 +1,5 @@
/*
* Copyright (c) 2022 Calvin Rose
* Copyright (c) 2023 Calvin Rose
*
* Permission is hereby granted, free of charge, to any person obtaining a copy
* of this software and associated documentation files (the "Software"), to
@@ -37,6 +37,7 @@ typedef struct {
JanetFuncEnv **seen_envs;
JanetFuncDef **seen_defs;
int32_t nextid;
int maybe_cycles;
} MarshalState;
/* Lead bytes in marshaling protocol */
@@ -66,7 +67,8 @@ enum {
LB_UNSAFE_POINTER, /* 222 */
LB_STRUCT_PROTO, /* 223 */
#ifdef JANET_EV
LB_THREADED_ABSTRACT/* 224 */
LB_THREADED_ABSTRACT, /* 224 */
LB_POINTER_BUFFER, /* 224 */
#endif
} LeadBytes;
@@ -152,6 +154,10 @@ 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, const void *ptr) {
janet_buffer_push_bytes(st->buf, (const uint8_t *) &ptr, sizeof(ptr));
}
/* Marshal a size_t onto the buffer */
static void push64(MarshalState *st, uint64_t x) {
if (x <= 0xF0) {
@@ -240,6 +246,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);
@@ -251,6 +258,8 @@ static void marshal_one_def(MarshalState *st, JanetFuncDef *def, int flags) {
pushint(st, def->environments_length);
if (def->flags & JANET_FUNCDEF_FLAG_HASDEFS)
pushint(st, def->defs_length);
if (def->flags & JANET_FUNCDEF_FLAG_HASSYMBOLMAP)
pushint(st, def->symbolmap_length);
if (def->flags & JANET_FUNCDEF_FLAG_HASNAME)
marshal_one(st, janet_wrap_string(def->name), flags);
if (def->flags & JANET_FUNCDEF_FLAG_HASSOURCE)
@@ -258,7 +267,15 @@ 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 + 1);
}
/* marshal the bytecode */
janet_marshal_u32s(st, def->bytecode, def->bytecode_length);
@@ -269,7 +286,7 @@ static void marshal_one_def(MarshalState *st, JanetFuncDef *def, int flags) {
/* marshal the sub funcdefs if needed */
for (int32_t i = 0; i < def->defs_length; i++)
marshal_one_def(st, def->defs[i], flags);
marshal_one_def(st, def->defs[i], flags + 1);
/* marshal source maps if needed */
if (def->flags & JANET_FUNCDEF_FLAG_HASSOURCEMAP) {
@@ -346,6 +363,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);
@@ -362,16 +388,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);
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() \
janet_table_put(&st->seen, x, janet_wrap_integer(st->nextid++))
static void marshal_one_abstract(MarshalState *st, Janet x, int flags) {
void *abstract = janet_unwrap_abstract(x);
#ifdef JANET_EV
@@ -393,7 +430,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);
@@ -428,11 +465,14 @@ static void marshal_one(MarshalState *st, Janet x, int flags) {
/* Check reference and registry value */
{
Janet check = janet_table_get(&st->seen, x);
if (janet_checkint(check)) {
pushbyte(st, LB_REFERENCE);
pushint(st, janet_unwrap_integer(check));
return;
Janet check;
if (st->maybe_cycles) {
check = janet_table_get(&st->seen, x);
if (janet_checkint(check)) {
pushbyte(st, LB_REFERENCE);
pushint(st, janet_unwrap_integer(check));
return;
}
}
if (st->rreg) {
check = janet_table_get(st->rreg, x);
@@ -495,6 +535,16 @@ static void marshal_one(MarshalState *st, Janet x, int flags) {
JanetBuffer *buffer = janet_unwrap_buffer(x);
/* Record reference */
MARK_SEEN();
#ifdef JANET_EV
if ((flags & JANET_MARSHAL_UNSAFE) &&
(buffer->gc.flags & JANET_BUFFER_FLAG_NO_REALLOC)) {
pushbyte(st, LB_POINTER_BUFFER);
pushint(st, buffer->count);
pushint(st, buffer->capacity);
pushpointer(st, buffer->data);
return;
}
#endif
pushbyte(st, LB_BUFFER);
pushint(st, buffer->count);
pushbytes(st, buffer->data, buffer->count);
@@ -590,8 +640,7 @@ static void marshal_one(MarshalState *st, Janet x, int flags) {
if (!(flags & JANET_MARSHAL_UNSAFE)) goto no_registry;
MARK_SEEN();
pushbyte(st, LB_UNSAFE_POINTER);
void *ptr = janet_unwrap_pointer(x);
pushbytes(st, (uint8_t *) &ptr, sizeof(void *));
pushpointer(st, janet_unwrap_pointer(x));
return;
}
no_registry:
@@ -613,6 +662,7 @@ void janet_marshal(
st.seen_defs = NULL;
st.seen_envs = NULL;
st.rreg = rreg;
st.maybe_cycles = !(flags & JANET_MARSHAL_NO_CYCLES);
janet_table_init(&st.seen, 0);
marshal_one(&st, x, flags);
janet_table_deinit(&st.seen);
@@ -697,9 +747,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);
}
}
@@ -751,7 +814,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;
@@ -817,6 +880,8 @@ static const uint8_t *unmarshal_one_def(
def->constants = NULL;
def->bytecode = NULL;
def->sourcemap = NULL;
def->symbolmap = NULL;
def->symbolmap_length = 0;
janet_v_push(st->lookup_defs, def);
/* Set default lengths to zero */
@@ -824,6 +889,7 @@ static const uint8_t *unmarshal_one_def(
int32_t constants_length = 0;
int32_t environments_length = 0;
int32_t defs_length = 0;
int32_t symbolmap_length = 0;
/* Read flags and other fixed values */
def->flags = readint(st, &data);
@@ -839,18 +905,20 @@ static const uint8_t *unmarshal_one_def(
environments_length = readnat(st, &data);
if (def->flags & JANET_FUNCDEF_FLAG_HASDEFS)
defs_length = readnat(st, &data);
if (def->flags & JANET_FUNCDEF_FLAG_HASSYMBOLMAP)
symbolmap_length = readnat(st, &data);
/* Check name and source (optional) */
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);
}
@@ -867,6 +935,27 @@ static const uint8_t *unmarshal_one_def(
}
def->constants_length = constants_length;
/* Unmarshal symbol map, if needed */
if (def->flags & JANET_FUNCDEF_FLAG_HASSYMBOLMAP) {
size_t size = sizeof(JanetSymbolMap) * symbolmap_length;
def->symbolmap = janet_malloc(size);
if (def->symbolmap == NULL) {
JANET_OUT_OF_MEMORY;
}
for (int32_t i = 0; i < symbolmap_length; i++) {
def->symbolmap[i].birth_pc = (uint32_t) readint(st, &data);
def->symbolmap[i].death_pc = (uint32_t) readint(st, &data);
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_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;
}
/* Unmarshal bytecode */
def->bytecode = janet_malloc(sizeof(uint32_t) * bytecode_length);
if (!def->bytecode) {
@@ -959,9 +1048,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 */
@@ -1010,7 +1101,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;
@@ -1056,7 +1147,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);
}
@@ -1065,7 +1156,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);
}
@@ -1109,6 +1200,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);
@@ -1144,6 +1247,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);
@@ -1151,7 +1266,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");
}
@@ -1252,7 +1369,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;
}
@@ -1267,6 +1384,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);
@@ -1320,7 +1440,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++) {
@@ -1343,7 +1463,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++) {
@@ -1373,6 +1493,29 @@ static const uint8_t *unmarshal_one(
janet_v_push(st->lookup, *out);
return data;
}
#ifdef JANET_EV
case LB_POINTER_BUFFER: {
data++;
int32_t count = readnat(st, &data);
int32_t capacity = readnat(st, &data);
MARSH_EOS(st, data + sizeof(void *));
union {
void *ptr;
uint8_t bytes[sizeof(void *)];
} u;
if (!(flags & JANET_MARSHAL_UNSAFE)) {
janet_panicf("unsafe flag not given, "
"will not unmarshal raw pointer at index %d",
(int)(data - st->start));
}
memcpy(u.bytes, data, sizeof(void *));
data += sizeof(void *);
JanetBuffer *buffer = janet_pointer_buffer_unsafe(u.ptr, capacity, count);
*out = janet_wrap_buffer(buffer);
janet_v_push(st->lookup, *out);
return data;
}
#endif
case LB_UNSAFE_CFUNCTION: {
MARSH_EOS(st, data + sizeof(JanetCFunction));
data++;
@@ -1471,16 +1614,17 @@ JANET_CORE_FN(cfun_env_lookup,
}
JANET_CORE_FN(cfun_marshal,
"(marshal x &opt reverse-lookup buffer)",
"(marshal x &opt reverse-lookup buffer no-cycles)",
"Marshal a value into a buffer and return the buffer. The buffer "
"can then later be unmarshalled to reconstruct the initial value. "
"Optionally, one can pass in a reverse lookup table to not marshal "
"aliased values that are found in the table. Then a forward "
"lookup table can be used to recover the original value when "
"unmarshalling.") {
janet_arity(argc, 1, 3);
janet_arity(argc, 1, 4);
JanetBuffer *buffer;
JanetTable *rreg = NULL;
uint32_t flags = 0;
if (argc > 1) {
rreg = janet_gettable(argv, 1);
}
@@ -1489,7 +1633,10 @@ JANET_CORE_FN(cfun_marshal,
} else {
buffer = janet_buffer(10);
}
janet_marshal(buffer, argv[0], rreg, 0);
if (argc > 3 && janet_truthy(argv[3])) {
flags |= JANET_MARSHAL_NO_CYCLES;
}
janet_marshal(buffer, argv[0], rreg, flags);
return janet_wrap_buffer(buffer);
}

View File

@@ -1,5 +1,5 @@
/*
* Copyright (c) 2022 Calvin Rose
* Copyright (c) 2023 Calvin Rose
*
* Permission is hereby granted, free of charge, to any person obtaining a copy
* of this software and associated documentation files (the "Software"), to
@@ -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."
) {
@@ -150,8 +150,8 @@ JANET_CORE_FN(cfun_rng_uniform,
JANET_CORE_FN(cfun_rng_int,
"(math/rng-int rng &opt max)",
"Extract a random random integer in the range [0, max] from the RNG. If "
"no max is given, the default is 2^31 - 1."
"Extract a random integer in the range [0, max) for max > 0 from the RNG. "
"If max is 0, return 0. If no max is given, the default is 2^31 - 1."
) {
janet_arity(argc, 1, 2);
JanetRNG *rng = janet_getabstract(argv, 0, &janet_rng_type);
@@ -231,7 +231,7 @@ static Janet janet_rng_next(void *p, Janet key) {
/* Get a random number */
JANET_CORE_FN(janet_rand,
"(math/random)",
"Returns a uniformly distributed random number between 0 and 1") {
"Returns a uniformly distributed random number between 0 and 1.") {
(void) argv;
janet_fixarity(argc, 0);
return janet_wrap_number(janet_rng_double(&janet_vm.rng));
@@ -240,7 +240,7 @@ JANET_CORE_FN(janet_rand,
/* Seed the random number generator */
JANET_CORE_FN(janet_srand,
"(math/seedrandom seed)",
"Set the seed for the random number generator. seed should be "
"Set the seed for the random number generator. `seed` should be "
"an integer or a buffer."
) {
janet_fixarity(argc, 1);
@@ -254,43 +254,45 @@ JANET_CORE_FN(janet_srand,
return janet_wrap_nil();
}
#define JANET_DEFINE_MATHOP(name, fop, doc)\
JANET_CORE_FN(janet_##name, "(math/" #name " x)", doc) {\
#define JANET_DEFINE_NAMED_MATHOP(janet_name, fop, doc)\
JANET_CORE_FN(janet_##fop, "(math/" janet_name " x)", doc) {\
janet_fixarity(argc, 1); \
double x = janet_getnumber(argv, 0); \
return janet_wrap_number(fop(x)); \
}
JANET_DEFINE_MATHOP(acos, acos, "Returns the arccosize of x.")
JANET_DEFINE_MATHOP(asin, asin, "Returns the arcsin of x.")
JANET_DEFINE_MATHOP(atan, atan, "Returns the arctangent of x.")
JANET_DEFINE_MATHOP(cos, cos, "Returns the cosine of x.")
JANET_DEFINE_MATHOP(cosh, cosh, "Returns the hyperbolic cosine of x.")
JANET_DEFINE_MATHOP(acosh, acosh, "Returns the hyperbolic arccosine of x.")
JANET_DEFINE_MATHOP(sin, sin, "Returns the sine of x.")
JANET_DEFINE_MATHOP(sinh, sinh, "Returns the hyperbolic sine of x.")
JANET_DEFINE_MATHOP(asinh, asinh, "Returns the hypberbolic arcsine of x.")
JANET_DEFINE_MATHOP(tan, tan, "Returns the tangent of x.")
JANET_DEFINE_MATHOP(tanh, tanh, "Returns the hyperbolic tangent of x.")
JANET_DEFINE_MATHOP(atanh, atanh, "Returns the hyperbolic arctangent of x.")
JANET_DEFINE_MATHOP(exp, exp, "Returns e to the power of x.")
JANET_DEFINE_MATHOP(exp2, exp2, "Returns 2 to the power of x.")
JANET_DEFINE_MATHOP(expm1, expm1, "Returns e to the power of x minus 1.")
JANET_DEFINE_MATHOP(log, log, "Returns the natural logarithm of x.")
JANET_DEFINE_MATHOP(log10, log10, "Returns the log base 10 of x.")
JANET_DEFINE_MATHOP(log2, log2, "Returns the log base 2 of x.")
JANET_DEFINE_MATHOP(sqrt, sqrt, "Returns the square root of x.")
JANET_DEFINE_MATHOP(cbrt, cbrt, "Returns the cube root of x.")
JANET_DEFINE_MATHOP(ceil, ceil, "Returns the smallest integer value number that is not less than x.")
JANET_DEFINE_MATHOP(fabs, fabs, "Return the absolute value of x.")
JANET_DEFINE_MATHOP(floor, floor, "Returns the largest integer value number that is not greater than x.")
JANET_DEFINE_MATHOP(trunc, trunc, "Returns the integer between x and 0 nearest to x.")
JANET_DEFINE_MATHOP(round, round, "Returns the integer nearest to x.")
JANET_DEFINE_MATHOP(gamma, tgamma, "Returns gamma(x).")
JANET_DEFINE_MATHOP(lgamma, lgamma, "Returns log-gamma(x).")
JANET_DEFINE_MATHOP(log1p, log1p, "Returns (log base e of x) + 1 more accurately than (+ (math/log x) 1)")
JANET_DEFINE_MATHOP(erf, erf, "Returns the error function of x.")
JANET_DEFINE_MATHOP(erfc, erfc, "Returns the complementary error function of x.")
#define JANET_DEFINE_MATHOP(fop, doc) JANET_DEFINE_NAMED_MATHOP(#fop, fop, doc)
JANET_DEFINE_MATHOP(acos, "Returns the arccosine of x.")
JANET_DEFINE_MATHOP(asin, "Returns the arcsin of x.")
JANET_DEFINE_MATHOP(atan, "Returns the arctangent of x.")
JANET_DEFINE_MATHOP(cos, "Returns the cosine of x.")
JANET_DEFINE_MATHOP(cosh, "Returns the hyperbolic cosine of x.")
JANET_DEFINE_MATHOP(acosh, "Returns the hyperbolic arccosine of x.")
JANET_DEFINE_MATHOP(sin, "Returns the sine of x.")
JANET_DEFINE_MATHOP(sinh, "Returns the hyperbolic sine of x.")
JANET_DEFINE_MATHOP(asinh, "Returns the hyperbolic arcsine of x.")
JANET_DEFINE_MATHOP(tan, "Returns the tangent of x.")
JANET_DEFINE_MATHOP(tanh, "Returns the hyperbolic tangent of x.")
JANET_DEFINE_MATHOP(atanh, "Returns the hyperbolic arctangent of x.")
JANET_DEFINE_MATHOP(exp, "Returns e to the power of x.")
JANET_DEFINE_MATHOP(exp2, "Returns 2 to the power of x.")
JANET_DEFINE_MATHOP(expm1, "Returns e to the power of x minus 1.")
JANET_DEFINE_MATHOP(log, "Returns the natural logarithm of x.")
JANET_DEFINE_MATHOP(log10, "Returns the log base 10 of x.")
JANET_DEFINE_MATHOP(log2, "Returns the log base 2 of x.")
JANET_DEFINE_MATHOP(sqrt, "Returns the square root of x.")
JANET_DEFINE_MATHOP(cbrt, "Returns the cube root of x.")
JANET_DEFINE_MATHOP(ceil, "Returns the smallest integer value number that is not less than x.")
JANET_DEFINE_MATHOP(floor, "Returns the largest integer value number that is not greater than x.")
JANET_DEFINE_MATHOP(trunc, "Returns the integer between x and 0 nearest to x.")
JANET_DEFINE_MATHOP(round, "Returns the integer nearest to x.")
JANET_DEFINE_MATHOP(log1p, "Returns (log base e of x) + 1 more accurately than (+ (math/log x) 1)")
JANET_DEFINE_MATHOP(erf, "Returns the error function of x.")
JANET_DEFINE_MATHOP(erfc, "Returns the complementary error function of x.")
JANET_DEFINE_NAMED_MATHOP("log-gamma", lgamma, "Returns log-gamma(x).")
JANET_DEFINE_NAMED_MATHOP("abs", fabs, "Return the absolute value of x.")
JANET_DEFINE_NAMED_MATHOP("gamma", tgamma, "Returns gamma(x).")
#define JANET_DEFINE_MATH2OP(name, fop, signature, doc)\
JANET_CORE_FN(janet_##name, signature, doc) {\
@@ -303,7 +305,7 @@ JANET_CORE_FN(janet_##name, signature, doc) {\
JANET_DEFINE_MATH2OP(atan2, atan2, "(math/atan2 y x)", "Returns the arctangent of y/x. Works even when x is 0.")
JANET_DEFINE_MATH2OP(pow, pow, "(math/pow a x)", "Returns a to the power of x.")
JANET_DEFINE_MATH2OP(hypot, hypot, "(math/hypot a b)", "Returns c from the equation c^2 = a^2 + b^2.")
JANET_DEFINE_MATH2OP(nextafter, nextafter, "(math/next x y)", "Returns the next representable floating point vaue after x in the direction of y.")
JANET_DEFINE_MATH2OP(nextafter, nextafter, "(math/next x y)", "Returns the next representable floating point value after x in the direction of y.")
JANET_CORE_FN(janet_not, "(not x)", "Returns the boolean inverse of x.") {
janet_fixarity(argc, 1);
@@ -315,7 +317,7 @@ static double janet_gcd(double x, double y) {
#ifdef NAN
return NAN;
#else
return 0.0 \ 0.0;
return 0.0 / 0.0;
#endif
}
if (isinf(x) || isinf(y)) return INFINITY;
@@ -383,7 +385,7 @@ void janet_lib_math(JanetTable *env) {
JANET_CORE_REG("math/hypot", janet_hypot),
JANET_CORE_REG("math/exp2", janet_exp2),
JANET_CORE_REG("math/log1p", janet_log1p),
JANET_CORE_REG("math/gamma", janet_gamma),
JANET_CORE_REG("math/gamma", janet_tgamma),
JANET_CORE_REG("math/log-gamma", janet_lgamma),
JANET_CORE_REG("math/erfc", janet_erfc),
JANET_CORE_REG("math/erf", janet_erf),
@@ -409,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

@@ -1,5 +1,5 @@
/*
* Copyright (c) 2022 Calvin Rose and contributors.
* Copyright (c) 2023 Calvin Rose and contributors.
*
* Permission is hereby granted, free of charge, to any person obtaining a copy
* of this software and associated documentation files (the "Software"), to
@@ -24,6 +24,7 @@
#include "features.h"
#include <janet.h>
#include "util.h"
#include "fiber.h"
#endif
#ifdef JANET_NET
@@ -34,9 +35,11 @@
#include <windows.h>
#include <ws2tcpip.h>
#include <mswsock.h>
#ifdef JANET_MSVC
#pragma comment (lib, "Ws2_32.lib")
#pragma comment (lib, "Mswsock.lib")
#pragma comment (lib, "Advapi32.lib")
#endif
#else
#include <arpa/inet.h>
#include <unistd.h>
@@ -109,12 +112,65 @@ static void janet_net_socknoblock(JSock s) {
#endif
}
/* State machine for async connect */
typedef struct {
int did_connect;
} NetStateConnect;
void net_callback_connect(JanetFiber *fiber, JanetAsyncEvent event) {
JanetStream *stream = fiber->ev_stream;
NetStateConnect *state = (NetStateConnect *)fiber->ev_state;
switch (event) {
default:
break;
#ifndef JANET_WINDOWS
/* Wait until we have an actually 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) {
state->did_connect = 1;
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 void net_sched_connect(JanetStream *stream) {
NetStateConnect *state = janet_malloc(sizeof(NetStateConnect));
state->did_connect = 0;
janet_async_start(stream, JANET_ASYNC_LISTEN_WRITE, net_callback_connect, state);
}
/* State machine for accepting connections. */
#ifdef JANET_WINDOWS
typedef struct {
JanetListenerState head;
WSAOVERLAPPED overlapped;
JanetFunction *function;
JanetStream *lstream;
@@ -122,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;
@@ -136,56 +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;
SOCKET lsock = (SOCKET) stream->handle;
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) {
@@ -197,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;
}
@@ -207,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;
@@ -221,36 +285,43 @@ 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: {
JSock connfd = accept(s->stream->handle, NULL, NULL);
#if defined(JANET_LINUX)
JSock connfd = accept4(stream->handle, NULL, NULL, SOCK_CLOEXEC);
#else
/* On BSDs, CLOEXEC should be inherited from server socket */
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();
janet_async_start(stream, JANET_ASYNC_LISTEN_READ, net_callback_accept, state);
}
#endif
/* Adress info */
@@ -328,6 +399,7 @@ JANET_CORE_FN(cfun_net_sockaddr,
"given in the port argument. On Linux, abstract "
"unix domain sockets are specified with a leading '@' character in port. If `multi` is truthy, will "
"return all address that match in an array instead of just the first.") {
janet_sandbox_assert(JANET_SANDBOX_NET_CONNECT); /* connect OR listen */
janet_arity(argc, 2, 4);
int socktype = janet_get_sockettype(argv, argc, 2);
int is_unix = 0;
@@ -373,6 +445,7 @@ JANET_CORE_FN(cfun_net_connect,
"to specify a connection type, either :stream or :datagram. The default is :stream. "
"Bindhost is an optional string to select from what address to make the outgoing "
"connection, with the default being the same as using the OS's preferred address. ") {
janet_sandbox_assert(JANET_SANDBOX_NET_CONNECT);
janet_arity(argc, 2, 5);
/* Check arguments */
@@ -409,7 +482,6 @@ JANET_CORE_FN(cfun_net_connect,
}
}
/* Create socket */
JSock sock = JSOCKDEFAULT;
void *addr = NULL;
@@ -452,7 +524,7 @@ JANET_CORE_FN(cfun_net_connect,
if (binding) {
struct addrinfo *rp = NULL;
int did_bind = 0;
for (rp = ai; rp != NULL; rp = rp->ai_next) {
for (rp = binding; rp != NULL; rp = rp->ai_next) {
if (bind(sock, rp->ai_addr, (int) rp->ai_addrlen) == 0) {
did_bind = 1;
break;
@@ -469,14 +541,20 @@ JANET_CORE_FN(cfun_net_connect,
}
}
/* Wrap socket in abstract type JanetStream */
JanetStream *stream = make_stream(sock, JANET_STREAM_READABLE | JANET_STREAM_WRITABLE);
/* Set up the socket for non-blocking IO before connecting */
janet_net_socknoblock(sock);
/* Connect to socket */
#ifdef JANET_WINDOWS
int status = WSAConnect(sock, addr, addrlen, NULL, NULL, NULL, NULL);
Janet lasterr = janet_ev_lasterr();
int err = WSAGetLastError();
freeaddrinfo(ai);
#else
int status = connect(sock, addr, addrlen);
Janet lasterr = janet_ev_lasterr();
int err = errno;
if (is_unix) {
janet_free(ai);
} else {
@@ -484,17 +562,20 @@ JANET_CORE_FN(cfun_net_connect,
}
#endif
if (status == -1) {
JSOCKCLOSE(sock);
janet_panicf("could not connect socket: %V", lasterr);
if (status) {
#ifdef JANET_WINDOWS
if (err != WSAEWOULDBLOCK) {
#else
if (err != EINPROGRESS) {
#endif
JSOCKCLOSE(sock);
Janet lasterr = janet_ev_lasterr();
janet_panicf("could not connect socket: %V", lasterr);
}
}
/* Set up the socket for non-blocking IO after connect - TODO - non-blocking connect? */
janet_net_socknoblock(sock);
/* Wrap socket in abstract type JanetStream */
JanetStream *stream = make_stream(sock, JANET_STREAM_READABLE | JANET_STREAM_WRITABLE);
return janet_wrap_abstract(stream);
net_sched_connect(stream);
janet_await();
}
static const char *serverify_socket(JSock sfd) {
@@ -567,6 +648,7 @@ JANET_CORE_FN(cfun_net_listen,
"The type parameter specifies the type of network connection, either "
"a :stream (usually tcp), or :datagram (usually udp). If not specified, the default is "
":stream. The host and port arguments are the same as in net/address.") {
janet_sandbox_assert(JANET_SANDBOX_NET_LISTEN);
janet_arity(argc, 2, 3);
/* Get host, port, and handler*/
@@ -701,7 +783,7 @@ JANET_CORE_FN(cfun_net_getsockname,
if (getsockname((JSock)js->handle, (struct sockaddr *) &ss, &slen)) {
janet_panicf("Failed to get localname on %v: %V", argv[0], janet_ev_lasterr());
}
janet_assert(slen <= sizeof(ss), "socket address truncated");
janet_assert(slen <= (socklen_t) sizeof(ss), "socket address truncated");
return janet_so_getname(&ss);
}
@@ -717,13 +799,13 @@ JANET_CORE_FN(cfun_net_getpeername,
if (getpeername((JSock)js->handle, (struct sockaddr *)&ss, &slen)) {
janet_panicf("Failed to get peername on %v: %V", argv[0], janet_ev_lasterr());
}
janet_assert(slen <= sizeof(ss), "socket address truncated");
janet_assert(slen <= (socklen_t) sizeof(ss), "socket address truncated");
return janet_so_getname(&ss);
}
JANET_CORE_FN(cfun_net_address_unpack,
"(net/address-unpack address)",
"Given an address returned by net/adress, return a host, port pair. Unix domain sockets "
"Given an address returned by net/address, return a host, port pair. Unix domain sockets "
"will have only the path in the returned tuple.") {
janet_fixarity(argc, 1);
struct sockaddr *sa = janet_getabstract(argv, 0, &janet_address_type);
@@ -774,7 +856,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,
@@ -789,11 +870,10 @@ 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,
"(net/recv-from stream nbytes buf &opt timoeut)",
"(net/recv-from stream nbytes buf &opt timeout)",
"Receives data from a server stream and puts it into a buffer. Returns the socket-address the "
"packet came from. Takes an optional timeout in seconds, after which will return nil.") {
janet_arity(argc, 3, 4);
@@ -804,7 +884,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,
@@ -824,7 +903,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,
@@ -845,7 +923,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,
@@ -863,6 +940,98 @@ JANET_CORE_FN(cfun_stream_flush,
return argv[0];
}
struct sockopt_type {
const char *name;
int level;
int optname;
enum JanetType type;
};
/* List of supported socket options; The type JANET_POINTER is used
* for options that require special handling depending on the type. */
static const struct sockopt_type sockopt_type_list[] = {
{ "so-broadcast", SOL_SOCKET, SO_BROADCAST, JANET_BOOLEAN },
{ "so-reuseaddr", SOL_SOCKET, SO_REUSEADDR, JANET_BOOLEAN },
{ "so-keepalive", SOL_SOCKET, SO_KEEPALIVE, JANET_BOOLEAN },
{ "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 },
{ "ipv6-join-group", IPPROTO_IPV6, IPV6_JOIN_GROUP, JANET_POINTER },
{ "ipv6-leave-group", IPPROTO_IPV6, IPV6_LEAVE_GROUP, JANET_POINTER },
{ NULL, 0, 0, JANET_POINTER }
};
JANET_CORE_FN(cfun_net_setsockopt,
"(net/setsockopt stream option value)",
"set socket options.\n"
"\n"
"supported options and associated value types:\n"
"- :so-broadcast boolean\n"
"- :so-reuseaddr boolean\n"
"- :so-keepalive boolean\n"
"- :ip-multicast-ttl number\n"
"- :ip-add-membership string\n"
"- :ip-drop-membership string\n"
"- :ipv6-join-group string\n"
"- :ipv6-leave-group string\n") {
janet_arity(argc, 3, 3);
JanetStream *stream = janet_getabstract(argv, 0, &janet_stream_type);
janet_stream_flags(stream, JANET_STREAM_SOCKET);
JanetKeyword optstr = janet_getkeyword(argv, 1);
const struct sockopt_type *st = sockopt_type_list;
while (st->name) {
if (janet_cstrcmp(optstr, st->name) == 0) {
break;
}
st++;
}
if (st->name == NULL) {
janet_panicf("unknown socket option %q", argv[1]);
}
union {
int v_int;
struct ip_mreq v_mreq;
struct ipv6_mreq v_mreq6;
} val;
void *optval = (void *)&val;
socklen_t optlen = 0;
if (st->type == JANET_BOOLEAN) {
val.v_int = janet_getboolean(argv, 2);
optlen = sizeof(val.v_int);
} else if (st->type == JANET_NUMBER) {
val.v_int = janet_getinteger(argv, 2);
optlen = sizeof(val.v_int);
} else if (st->optname == IP_ADD_MEMBERSHIP || st->optname == IP_DROP_MEMBERSHIP) {
const char *addr = janet_getcstring(argv, 2);
memset(&val.v_mreq, 0, sizeof val.v_mreq);
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);
} 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);
} else {
janet_panicf("invalid socket option type");
}
janet_assert(optlen != 0, "invalid socket option value");
int r = setsockopt((JSock) stream->handle, st->level, st->optname, optval, optlen);
if (r == -1) {
janet_panicf("setsockopt(%q): %s", argv[1], strerror(errno));
}
return janet_wrap_nil();
}
static const JanetMethod net_stream_methods[] = {
{"chunk", cfun_stream_chunk},
{"close", janet_cfun_stream_close},
@@ -877,6 +1046,7 @@ static const JanetMethod net_stream_methods[] = {
{"evchunk", janet_cfun_stream_chunk},
{"evwrite", janet_cfun_stream_write},
{"shutdown", cfun_net_shutdown},
{"setsockopt", cfun_net_setsockopt},
{NULL, NULL}
};
@@ -884,7 +1054,6 @@ static JanetStream *make_stream(JSock handle, uint32_t flags) {
return janet_stream((JanetHandle) handle, flags | JANET_STREAM_SOCKET, net_stream_methods);
}
void janet_lib_net(JanetTable *env) {
JanetRegExt net_cfuns[] = {
JANET_CORE_REG("net/address", cfun_net_sockaddr),
@@ -902,6 +1071,7 @@ void janet_lib_net(JanetTable *env) {
JANET_CORE_REG("net/peername", cfun_net_getpeername),
JANET_CORE_REG("net/localname", cfun_net_getsockname),
JANET_CORE_REG("net/address-unpack", cfun_net_address_unpack),
JANET_CORE_REG("net/setsockopt", cfun_net_setsockopt),
JANET_REG_END
};
janet_core_cfuns_ext(env, NULL, net_cfuns);

File diff suppressed because it is too large Load Diff

View File

@@ -1,5 +1,5 @@
/*
* Copyright (c) 2022 Calvin Rose
* Copyright (c) 2023 Calvin Rose
*
* Permission is hereby granted, free of charge, to any person obtaining a copy
* of this software and associated documentation files (the "Software"), to
@@ -206,6 +206,37 @@ static void popstate(JanetParser *p, Janet val) {
}
}
static void delim_error(JanetParser *parser, size_t stack_index, char c, const char *msg) {
JanetParseState *s = parser->states + stack_index;
JanetBuffer *buffer = janet_buffer(40);
if (msg) {
janet_buffer_push_cstring(buffer, msg);
}
if (c) {
janet_buffer_push_u8(buffer, c);
}
if (stack_index > 0) {
janet_buffer_push_cstring(buffer, ", ");
if (s->flags & PFLAG_PARENS) {
janet_buffer_push_u8(buffer, '(');
} else if (s->flags & PFLAG_SQRBRACKETS) {
janet_buffer_push_u8(buffer, '[');
} else if (s->flags & PFLAG_CURLYBRACKETS) {
janet_buffer_push_u8(buffer, '{');
} else if (s->flags & PFLAG_STRING) {
janet_buffer_push_u8(buffer, '"');
} else if (s->flags & PFLAG_LONGSTRING) {
int32_t i;
for (i = 0; i < s->argn; i++) {
janet_buffer_push_u8(buffer, '`');
}
}
janet_formatb(buffer, " opened at line %d, column %d", s->line, s->column);
}
parser->error = (const char *) janet_string(buffer->data, buffer->count);
parser->flag |= JANET_PARSER_GENERATED_ERROR;
}
static int checkescape(uint8_t c) {
switch (c) {
default:
@@ -228,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 '"':
@@ -612,7 +651,7 @@ static int root(JanetParser *p, JanetParseState *state, uint8_t c) {
case '}': {
Janet ds;
if (p->statecount == 1) {
p->error = "unexpected delimiter";
delim_error(p, 0, c, "unexpected closing delimiter ");
return 1;
}
if ((c == ')' && (state->flags & PFLAG_PARENS)) ||
@@ -633,7 +672,7 @@ static int root(JanetParser *p, JanetParseState *state, uint8_t c) {
ds = close_struct(p, state);
}
} else {
p->error = "mismatched delimiter";
delim_error(p, p->statecount - 1, c, "mismatched delimiter ");
return 1;
}
popstate(p, ds);
@@ -684,26 +723,7 @@ void janet_parser_eof(JanetParser *parser) {
size_t oldline = parser->line;
janet_parser_consume(parser, '\n');
if (parser->statecount > 1) {
JanetParseState *s = parser->states + (parser->statecount - 1);
JanetBuffer *buffer = janet_buffer(40);
janet_buffer_push_cstring(buffer, "unexpected end of source, ");
if (s->flags & PFLAG_PARENS) {
janet_buffer_push_u8(buffer, '(');
} else if (s->flags & PFLAG_SQRBRACKETS) {
janet_buffer_push_u8(buffer, '[');
} else if (s->flags & PFLAG_CURLYBRACKETS) {
janet_buffer_push_u8(buffer, '{');
} else if (s->flags & PFLAG_STRING) {
janet_buffer_push_u8(buffer, '"');
} else if (s->flags & PFLAG_LONGSTRING) {
int32_t i;
for (i = 0; i < s->argn; i++) {
janet_buffer_push_u8(buffer, '`');
}
}
janet_formatb(buffer, " opened at line %d, column %d", s->line, s->column);
parser->error = (const char *) janet_string(buffer->data, buffer->count);
parser->flag |= JANET_PARSER_GENERATED_ERROR;
delim_error(parser, parser->statecount - 1, 0, "unexpected end of source");
}
parser->line = oldline;
parser->column = oldcolumn;
@@ -883,7 +903,7 @@ const JanetAbstractType janet_parser_type = {
JANET_CORE_FN(cfun_parse_parser,
"(parser/new)",
"Creates and returns a new parser object. Parsers are state machines "
"that can receive bytes, and generate a stream of values.") {
"that can receive bytes and generate a stream of values.") {
(void) argv;
janet_fixarity(argc, 0);
JanetParser *p = janet_abstract(&janet_parser_type, sizeof(JanetParser));
@@ -894,7 +914,7 @@ JANET_CORE_FN(cfun_parse_parser,
JANET_CORE_FN(cfun_parse_consume,
"(parser/consume parser bytes &opt index)",
"Input bytes into the parser and parse them. Will not throw errors "
"if there is a parse error. Starts at the byte index given by index. Returns "
"if there is a parse error. Starts at the byte index given by `index`. Returns "
"the number of bytes read.") {
janet_arity(argc, 2, 3);
JanetParser *p = janet_getabstract(argv, 0, &janet_parser_type);
@@ -922,7 +942,7 @@ JANET_CORE_FN(cfun_parse_consume,
JANET_CORE_FN(cfun_parse_eof,
"(parser/eof parser)",
"Indicate that the end of file was reached to the parser. This puts the parser in the :dead state.") {
"Indicate to the parser that the end of file was reached. This puts the parser in the :dead state.") {
janet_fixarity(argc, 1);
JanetParser *p = janet_getabstract(argv, 0, &janet_parser_type);
janet_parser_eof(p);
@@ -982,7 +1002,7 @@ JANET_CORE_FN(cfun_parse_has_more,
JANET_CORE_FN(cfun_parse_byte,
"(parser/byte parser b)",
"Input a single byte into the parser byte stream. Returns the parser.") {
"Input a single byte `b` into the parser byte stream. Returns the parser.") {
janet_fixarity(argc, 2);
JanetParser *p = janet_getabstract(argv, 0, &janet_parser_type);
int32_t i = janet_getinteger(argv, 1);
@@ -1022,7 +1042,7 @@ JANET_CORE_FN(cfun_parse_error,
"If the parser is in the error state, returns the message associated with "
"that error. Otherwise, returns nil. Also flushes the parser state and parser "
"queue, so be sure to handle everything in the queue before calling "
"parser/error.") {
"`parser/error`.") {
janet_fixarity(argc, 1);
JanetParser *p = janet_getabstract(argv, 0, &janet_parser_type);
const char *err = janet_parser_error(p);
@@ -1182,7 +1202,8 @@ static Janet parser_state_delimiters(const JanetParser *_p) {
}
}
}
str = janet_string(p->buf + oldcount, (int32_t)(p->bufcount - oldcount));
/* avoid ptr arithmetic on NULL */
str = janet_string(oldcount ? p->buf + oldcount : p->buf, (int32_t)(p->bufcount - oldcount));
p->bufcount = oldcount;
return janet_wrap_string(str);
}
@@ -1193,10 +1214,11 @@ static Janet parser_state_frames(const JanetParser *p) {
states->count = count;
uint8_t *buf = p->buf;
/* Iterate arg stack backwards */
Janet *args = p->args + p->argcount;
Janet *args = p->argcount ? p->args + p->argcount : p->args; /* avoid ptr arithmetic on NULL */
for (int32_t i = count - 1; i >= 0; --i) {
JanetParseState *s = p->states + i;
if (s->flags & PFLAG_CONTAINER) {
/* avoid ptr arithmetic on args if NULL */
if ((s->flags & PFLAG_CONTAINER) && s->argn) {
args -= s->argn;
}
states->data[i] = janet_wrap_parse_state(s, args, buf, (uint32_t) p->bufcount);

View File

@@ -1,5 +1,5 @@
/*
* Copyright (c) 2022 Calvin Rose
* Copyright (c) 2023 Calvin Rose
*
* Permission is hereby granted, free of charge, to any person obtaining a copy
* of this software and associated documentation files (the "Software"), to
@@ -211,9 +211,10 @@ tail:
}
case RULE_SET: {
if (text >= s->text_end) return NULL;
uint32_t word = rule[1 + (text[0] >> 5)];
uint32_t mask = (uint32_t)1 << (text[0] & 0x1F);
return (text < s->text_end && (word & mask))
return (word & mask)
? text + 1
: NULL;
}
@@ -260,30 +261,52 @@ tail:
goto tail;
}
case RULE_IF:
case RULE_IFNOT: {
case RULE_IF: {
const uint32_t *rule_a = s->bytecode + rule[1];
const uint32_t *rule_b = s->bytecode + rule[2];
down1(s);
const uint8_t *result = peg_rule(s, rule_a, text);
up1(s);
if (rule[0] == RULE_IF ? !result : !!result) return NULL;
if (!result) return NULL;
rule = rule_b;
goto tail;
}
case RULE_IFNOT: {
const uint32_t *rule_a = s->bytecode + rule[1];
const uint32_t *rule_b = s->bytecode + rule[2];
down1(s);
CapState cs = cap_save(s);
const uint8_t *result = peg_rule(s, rule_a, text);
if (!!result) {
up1(s);
return NULL;
} else {
cap_load(s, cs);
up1(s);
rule = rule_b;
goto tail;
}
}
case RULE_NOT: {
const uint32_t *rule_a = s->bytecode + rule[1];
down1(s);
CapState cs = cap_save(s);
const uint8_t *result = peg_rule(s, rule_a, text);
up1(s);
return (result) ? NULL : text;
if (result) {
up1(s);
return NULL;
} else {
cap_load(s, cs);
up1(s);
return text;
}
}
case RULE_THRU:
case RULE_TO: {
const uint32_t *rule_a = s->bytecode + rule[1];
const uint8_t *next_text;
const uint8_t *next_text = NULL;
CapState cs = cap_save(s);
down1(s);
while (text <= s->text_end) {
@@ -293,6 +316,7 @@ tail:
if (rule[0] == RULE_TO) cap_load(s, cs2);
break;
}
cap_load(s, cs2);
text++;
}
up1(s);
@@ -1010,7 +1034,7 @@ static void spec_capture_number(Builder *b, int32_t argc, const Janet *argv) {
emit_3(r, RULE_CAPTURE_NUM, rule, base, tag);
return;
error:
peg_panicf(b, "expected integer between 2 and 36, got %v", argv[2]);
peg_panicf(b, "expected integer between 2 and 36, got %v", argv[1]);
}
static void spec_reference(Builder *b, int32_t argc, const Janet *argv) {
@@ -1076,7 +1100,7 @@ static void spec_matchtime(Builder *b, int32_t argc, const Janet *argv) {
Janet fun = argv[1];
if (!janet_checktype(fun, JANET_FUNCTION) &&
!janet_checktype(fun, JANET_CFUNCTION)) {
peg_panicf(b, "expected function|cfunction, got %v", fun);
peg_panicf(b, "expected function or cfunction, got %v", fun);
}
uint32_t tag = (argc == 3) ? emit_tag(b, argv[2]) : 0;
uint32_t cindex = emit_constant(b, fun);
@@ -1237,6 +1261,13 @@ static uint32_t peg_compile1(Builder *b, Janet peg) {
default:
peg_panic(b, "unexpected peg source");
return 0;
case JANET_BOOLEAN: {
int n = janet_unwrap_boolean(peg);
Reserve r = reserve(b, 2);
emit_1(r, n ? RULE_NCHAR : RULE_NOTNCHAR, 0);
break;
}
case JANET_NUMBER: {
int32_t n = peg_getinteger(b, peg);
Reserve r = reserve(b, 2);
@@ -1613,7 +1644,7 @@ typedef struct {
JanetPeg *peg;
PegState s;
JanetByteView bytes;
JanetByteView repl;
Janet subst;
int32_t start;
} PegCall;
@@ -1629,7 +1660,7 @@ static PegCall peg_cfun_init(int32_t argc, Janet *argv, int get_replace) {
ret.peg = compile_peg(argv[0]);
}
if (get_replace) {
ret.repl = janet_getbytes(argv, 1);
ret.subst = argv[1];
ret.bytes = janet_getbytes(argv, 2);
} else {
ret.bytes = janet_getbytes(argv, 1);
@@ -1660,7 +1691,9 @@ static PegCall peg_cfun_init(int32_t argc, Janet *argv, int get_replace) {
}
static void peg_call_reset(PegCall *c) {
c->s.depth = JANET_RECURSION_GUARD;
c->s.captures->count = 0;
c->s.tagged_captures->count = 0;
c->s.scratch->count = 0;
c->s.tags->count = 0;
}
@@ -1712,7 +1745,8 @@ static Janet cfun_peg_replace_generic(int32_t argc, Janet *argv, int only_one) {
trail = i;
}
int32_t nexti = (int32_t)(result - c.bytes.bytes);
janet_buffer_push_bytes(ret, c.repl.bytes, c.repl.len);
JanetByteView subst = janet_text_substitution(&c.subst, c.bytes.bytes + i, nexti - i, c.s.captures);
janet_buffer_push_bytes(ret, subst.bytes, subst.len);
trail = nexti;
if (nexti == i) nexti++;
i = nexti;
@@ -1728,14 +1762,20 @@ static Janet cfun_peg_replace_generic(int32_t argc, Janet *argv, int only_one) {
}
JANET_CORE_FN(cfun_peg_replace_all,
"(peg/replace-all peg repl text &opt start & args)",
"Replace all matches of peg in text with repl, returning a new buffer. The peg does not need to make captures to do replacement.") {
"(peg/replace-all peg subst text &opt start & args)",
"Replace all matches 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 "
"matching text followed by any captures.") {
return cfun_peg_replace_generic(argc, argv, 0);
}
JANET_CORE_FN(cfun_peg_replace,
"(peg/replace peg repl text &opt start & args)",
"Replace first match of peg in text with repl, returning a new buffer. The peg does not need to make captures to do replacement. "
"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 "
"matching text followed by any captures. "
"If no matches are found, returns the input string in a new buffer.") {
return cfun_peg_replace_generic(argc, argv, 1);
}

View File

@@ -1,5 +1,5 @@
/*
* Copyright (c) 2022 Calvin Rose
* Copyright (c) 2023 Calvin Rose
*
* Permission is hereby granted, free of charge, to any person obtaining a copy
* of this software and associated documentation files (the "Software"), to
@@ -30,6 +30,8 @@
#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. */
@@ -37,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' */
@@ -108,7 +114,7 @@ static void string_description_b(JanetBuffer *buffer, const char *title, void *p
pbuf.p = pointer;
*c++ = '<';
/* Maximum of 32 bytes for abstract type name */
for (i = 0; title[i] && i < 32; ++i)
for (i = 0; i < 32 && title[i]; ++i)
*c++ = ((uint8_t *)title) [i];
*c++ = ' ';
*c++ = '0';
@@ -151,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;
@@ -243,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 ");
@@ -636,7 +652,7 @@ static void janet_pretty_one(struct pretty *S, Janet x, int is_dict_value) {
}
}
janet_sorted_keys(kvs, cap, S->keysort_buffer + ks_start);
janet_sorted_keys(kvs, cap, S->keysort_buffer == NULL ? NULL : S->keysort_buffer + ks_start);
S->keysort_start += len;
if (!(S->flags & JANET_PRETTY_NOTRUNC) && (len > JANET_PRETTY_DICT_LIMIT)) {
len = JANET_PRETTY_DICT_LIMIT;
@@ -735,7 +751,7 @@ static void pushtypes(JanetBuffer *buffer, int types) {
if (first) {
first = 0;
} else {
janet_buffer_push_u8(buffer, '|');
janet_buffer_push_cstring(buffer, (types == 1) ? " or " : ", ");
}
janet_buffer_push_cstring(buffer, janet_type_names[i]);
}
@@ -750,20 +766,48 @@ static void pushtypes(JanetBuffer *buffer, int types) {
#define MAX_ITEM 256
#define FMT_FLAGS "-+ #0"
#define FMT_REPLACE_INTTYPES "diouxX"
#define MAX_FORMAT 32
struct FmtMapping {
char c;
const char *mapping;
};
/* 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},
{'u', PRIu64},
{'x', PRIx64},
{'X', PRIX64},
};
static const char *get_fmt_mapping(char c) {
for (size_t i = 0; i < (sizeof(format_mappings) / sizeof(struct FmtMapping)); i++) {
if (format_mappings[i].c == c)
return format_mappings[i].mapping;
}
janet_assert(0, "bad format mapping");
}
static const char *scanformat(
const char *strfrmt,
char *form,
char width[3],
char precision[3]) {
const char *p = strfrmt;
/* Parse strfrmt */
memset(width, '\0', 3);
memset(precision, '\0', 3);
while (*p != '\0' && strchr(FMT_FLAGS, *p) != NULL)
p++; /* skip flags */
if ((size_t)(p - strfrmt) >= sizeof(FMT_FLAGS) / sizeof(char))
janet_panic("invalid format (repeated flags)");
if ((size_t)(p - strfrmt) >= sizeof(FMT_FLAGS)) janet_panic("invalid format (repeated flags)");
if (isdigit((int)(*p)))
width[0] = *p++; /* skip width */
if (isdigit((int)(*p)))
@@ -777,10 +821,23 @@ static const char *scanformat(
}
if (isdigit((int)(*p)))
janet_panic("invalid format (width or precision too long)");
/* Write to form - replace characters with fixed size stuff */
*(form++) = '%';
memcpy(form, strfrmt, ((p - strfrmt) + 1) * sizeof(char));
form += (p - strfrmt) + 1;
const char *p2 = strfrmt;
while (p2 <= p) {
char *loc = strchr(FMT_REPLACE_INTTYPES, *p2);
if (loc != NULL && *loc != '\0') {
const char *mapping = get_fmt_mapping(*p2++);
size_t len = strlen(mapping);
strcpy(form, mapping);
form += len;
} else {
*(form++) = *(p2++);
}
}
*form = '\0';
return p;
}
@@ -800,16 +857,27 @@ 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':
case 'o':
case 'i': {
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;
}
case 'x':
case 'X': {
int32_t n = va_arg(args, long);
case 'X':
case 'o':
case 'u': {
uint64_t n = va_arg(args, uint64_t);
nb = snprintf(item, MAX_ITEM, form, n);
break;
}
@@ -853,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;
}
@@ -962,12 +1030,19 @@ void janet_buffer_format(
janet_getinteger(argv, arg));
break;
}
case 'D':
case 'I':
case 'd':
case 'i':
case 'o':
case 'i': {
int64_t n = janet_getinteger64(argv, arg);
nb = snprintf(item, MAX_ITEM, form, n);
break;
}
case 'x':
case 'X': {
int32_t n = janet_getinteger(argv, arg);
case 'X':
case 'o':
case 'u': {
uint64_t n = janet_getuinteger64(argv, arg);
nb = snprintf(item, MAX_ITEM, form, n);
break;
}
@@ -983,8 +1058,9 @@ void janet_buffer_format(
break;
}
case 's': {
const uint8_t *s = janet_getstring(argv, arg);
int32_t l = janet_string_length(s);
JanetByteView bytes = janet_getbytes(argv, arg);
const uint8_t *s = bytes.bytes;
int32_t l = bytes.len;
if (form[2] == '\0')
janet_buffer_push_bytes(b, s, l);
else {

View File

@@ -1,5 +1,5 @@
/*
* Copyright (c) 2022 Calvin Rose
* Copyright (c) 2023 Calvin Rose
*
* Permission is hereby granted, free of charge, to any person obtaining a copy
* of this software and associated documentation files (the "Software"), to
@@ -27,6 +27,8 @@
#include "util.h"
#endif
/* The JanetRegisterAllocator is really just a bitset. */
void janetc_regalloc_init(JanetcRegisterAllocator *ra) {
ra->chunks = NULL;
ra->count = 0;
@@ -139,6 +141,14 @@ void janetc_regalloc_free(JanetcRegisterAllocator *ra, int32_t reg) {
ra->chunks[chunk] &= ~ithbit(bit);
}
/* Check if a register is set. */
int janetc_regalloc_check(JanetcRegisterAllocator *ra, int32_t reg) {
int32_t chunk = reg >> 5;
int32_t bit = reg & 0x1F;
while (chunk >= ra->count) pushchunk(ra);
return !!(ra->chunks[chunk] & ithbit(bit));
}
/* Get a register that will fit in 8 bits (< 256). Do not call this
* twice with the same value of nth without calling janetc_regalloc_free
* on the returned register before. */

View File

@@ -1,5 +1,5 @@
/*
* Copyright (c) 2022 Calvin Rose
* Copyright (c) 2023 Calvin Rose
*
* Permission is hereby granted, free of charge, to any person obtaining a copy
* of this software and associated documentation files (the "Software"), to
@@ -56,5 +56,6 @@ int32_t janetc_regalloc_temp(JanetcRegisterAllocator *ra, JanetcRegisterTemp nth
void janetc_regalloc_freetemp(JanetcRegisterAllocator *ra, int32_t reg, JanetcRegisterTemp nth);
void janetc_regalloc_clone(JanetcRegisterAllocator *dest, JanetcRegisterAllocator *src);
void janetc_regalloc_touch(JanetcRegisterAllocator *ra, int32_t reg);
int janetc_regalloc_check(JanetcRegisterAllocator *ra, int32_t reg);
#endif

View File

@@ -1,5 +1,5 @@
/*
* Copyright (c) 2022 Calvin Rose
* Copyright (c) 2023 Calvin Rose
*
* Permission is hereby granted, free of charge, to any person obtaining a copy
* of this software and associated documentation files (the "Software"), to
@@ -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;
@@ -80,9 +89,9 @@ int janet_dobytes(JanetTable *env, const uint8_t *bytes, int32_t len, const char
const char *e = janet_parser_error(&parser);
errflags |= 0x04;
ret = janet_cstringv(e);
size_t line = parser.line;
size_t col = parser.column;
janet_eprintf("%s:%lu:%lu: parse error: %s\n", sourcePath, line, col, e);
int32_t line = (int32_t) parser.line;
int32_t col = (int32_t) parser.column;
janet_eprintf("%s:%d:%d: parse error: %s\n", sourcePath, line, col, e);
done = 1;
break;
}
@@ -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

@@ -1,5 +1,5 @@
/*
* Copyright (c) 2022 Calvin Rose
* Copyright (c) 2023 Calvin Rose
*
* Permission is hereby granted, free of charge, to any person obtaining a copy
* of this software and associated documentation files (the "Software"), to
@@ -31,7 +31,7 @@
static JanetSlot janetc_quote(JanetFopts opts, int32_t argn, const Janet *argv) {
if (argn != 1) {
janetc_cerror(opts.compiler, "expected 1 argument");
janetc_cerror(opts.compiler, "expected 1 argument to quote");
return janetc_cslot(janet_wrap_nil());
}
return janetc_cslot(argv[0]);
@@ -39,8 +39,12 @@ static JanetSlot janetc_quote(JanetFopts opts, int32_t argn, const Janet *argv)
static JanetSlot janetc_splice(JanetFopts opts, int32_t argn, const Janet *argv) {
JanetSlot ret;
if (!(opts.flags & JANET_FOPTS_ACCEPT_SPLICE)) {
janetc_cerror(opts.compiler, "splice can only be used in function parameters and data constructors, it has no effect here");
return janetc_cslot(janet_wrap_nil());
}
if (argn != 1) {
janetc_cerror(opts.compiler, "expected 1 argument");
janetc_cerror(opts.compiler, "expected 1 argument to splice");
return janetc_cslot(janet_wrap_nil());
}
ret = janetc_value(opts, argv[0]);
@@ -75,7 +79,9 @@ static JanetSlot quasiquote(JanetFopts opts, Janet x, int depth, int level) {
const uint8_t *head = janet_unwrap_symbol(tup[0]);
if (!janet_cstrcmp(head, "unquote")) {
if (level == 0) {
return janetc_value(janetc_fopts_default(opts.compiler), tup[1]);
JanetFopts subopts = janetc_fopts_default(opts.compiler);
subopts.flags |= JANET_FOPTS_ACCEPT_SPLICE;
return janetc_value(subopts, tup[1]);
} else {
level--;
}
@@ -117,7 +123,7 @@ static JanetSlot quasiquote(JanetFopts opts, Janet x, int depth, int level) {
static JanetSlot janetc_quasiquote(JanetFopts opts, int32_t argn, const Janet *argv) {
if (argn != 1) {
janetc_cerror(opts.compiler, "expected 1 argument");
janetc_cerror(opts.compiler, "expected 1 argument to quasiquote");
return janetc_cslot(janet_wrap_nil());
}
return quasiquote(opts, argv[0], JANET_RECURSION_GUARD, 0);
@@ -143,7 +149,7 @@ static int destructure(JanetCompiler *c,
JanetTable *attr) {
switch (janet_type(left)) {
default:
janetc_cerror(c, "unexpected type in destructuring");
janetc_error(c, janet_formatc("unexpected type in destruction, got %v", left));
return 1;
case JANET_SYMBOL:
/* Leaf, assign right to left */
@@ -176,7 +182,6 @@ static int destructure(JanetCompiler *c,
return 1;
}
if (!janet_checktype(values[i + 1], JANET_SYMBOL)) {
janetc_error(c, janet_formatc("expected symbol following '& in destructuring pattern, found %q", values[i + 1]));
return 1;
@@ -203,8 +208,9 @@ static int destructure(JanetCompiler *c,
janetc_emit(c, JOP_JUMP);
int32_t label_loop_exit = janet_v_count(c->buffer);
c->buffer[label_loop_cond_jump] |= (label_loop_exit - label_loop_cond_jump) << 16;
c->buffer[label_loop_loop] |= (label_loop_start - label_loop_loop) << 8;
/* avoid shifting negative numbers */
c->buffer[label_loop_cond_jump] |= (uint32_t)(label_loop_exit - label_loop_cond_jump) << 16;
c->buffer[label_loop_loop] |= (uint32_t)(label_loop_start - label_loop_loop) << 8;
janetc_freeslot(c, argi);
janetc_freeslot(c, arg);
@@ -257,7 +263,7 @@ static const Janet *janetc_make_sourcemap(JanetCompiler *c) {
static JanetSlot janetc_varset(JanetFopts opts, int32_t argn, const Janet *argv) {
if (argn != 2) {
janetc_cerror(opts.compiler, "expected 2 arguments");
janetc_cerror(opts.compiler, "expected 2 arguments to set");
return janetc_cslot(janet_wrap_nil());
}
JanetFopts subopts = janetc_fopts_default(opts.compiler);
@@ -299,14 +305,24 @@ static JanetSlot janetc_varset(JanetFopts opts, int32_t argn, const Janet *argv)
}
/* Add attributes to a global def or var table */
static JanetTable *handleattr(JanetCompiler *c, int32_t argn, const Janet *argv) {
static JanetTable *handleattr(JanetCompiler *c, const char *kind, int32_t argn, const Janet *argv) {
int32_t i;
JanetTable *tab = janet_table(2);
const char *binding_name = janet_type(argv[0]) == JANET_SYMBOL
? ((const char *)janet_unwrap_symbol(argv[0]))
: "<multiple bindings>";
if (argn < 2) {
janetc_error(c, janet_formatc("expected at least 2 arguments to %s", kind));
return NULL;
}
for (i = 1; i < argn - 1; i++) {
Janet attr = argv[i];
switch (janet_type(attr)) {
case JANET_TUPLE:
janetc_cerror(c, "unexpected form - did you intend to use defn?");
break;
default:
janetc_cerror(c, "could not add metadata to binding");
janetc_error(c, janet_formatc("cannot add metadata %v to binding %s", attr, binding_name));
break;
case JANET_KEYWORD:
janet_table_put(tab, attr, janet_wrap_true());
@@ -322,18 +338,52 @@ static JanetTable *handleattr(JanetCompiler *c, int32_t argn, const Janet *argv)
return tab;
}
static JanetSlot dohead(JanetCompiler *c, JanetFopts opts, Janet *head, int32_t argn, const Janet *argv) {
typedef struct SlotHeadPair {
Janet lhs;
JanetSlot rhs;
} SlotHeadPair;
SlotHeadPair *dohead_destructure(JanetCompiler *c, SlotHeadPair *into, JanetFopts opts, Janet lhs, Janet rhs) {
/* Detect if we can do an optimization to avoid some allocations */
int can_destructure_lhs = janet_checktype(lhs, JANET_TUPLE)
|| janet_checktype(lhs, JANET_ARRAY);
int rhs_is_indexed = janet_checktype(rhs, JANET_ARRAY)
|| (janet_checktype(rhs, JANET_TUPLE) && (janet_tuple_flag(janet_unwrap_tuple(rhs)) & JANET_TUPLE_FLAG_BRACKETCTOR));
uint32_t has_drop = opts.flags & JANET_FOPTS_DROP;
JanetFopts subopts = janetc_fopts_default(c);
JanetSlot ret;
if (argn < 2) {
janetc_cerror(c, "expected at least 2 arguments");
return janetc_cslot(janet_wrap_nil());
}
*head = argv[0];
subopts.flags = opts.flags & ~(JANET_FOPTS_TAIL | JANET_FOPTS_DROP);
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 = {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;
for (int32_t i = 0; i < view_lhs.len; i++) {
if (janet_symeq(view_lhs.items[i], "&")) {
found_amp = 1;
/* Good error will be generated later. */
break;
}
}
if (!found_amp) {
for (int32_t i = 0; i < view_lhs.len; i++) {
Janet sub_rhs = view_rhs.len <= i ? janet_wrap_nil() : view_rhs.items[i];
into = dohead_destructure(c, into, subopts, view_lhs.items[i], sub_rhs);
}
return into;
}
}
/* No optimization, do the simple way */
subopts.hint = opts.hint;
ret = janetc_value(subopts, argv[argn - 1]);
return ret;
JanetSlot ret = janetc_value(subopts, rhs);
SlotHeadPair shp = {lhs, ret};
janet_v_push(into, shp);
return into;
}
/* Def or var a symbol in a local scope */
@@ -341,7 +391,17 @@ static int namelocal(JanetCompiler *c, const uint8_t *head, int32_t flags, Janet
int isUnnamedRegister = !(ret.flags & JANET_SLOT_NAMED) &&
ret.index > 0 &&
ret.envindex >= 0;
if (!isUnnamedRegister) {
/* optimization for `(def x my-def)` - don't emit a movn/movf instruction, we can just alias my-def */
/* TODO - implement optimization for `(def x my-var)` correctly as well w/ de-aliasing */
int canAlias = !(flags & JANET_SLOT_MUTABLE) &&
!(ret.flags & JANET_SLOT_MUTABLE) &&
(ret.flags & JANET_SLOT_NAMED) &&
(ret.index >= 0) &&
(ret.envindex == -1);
if (canAlias) {
ret.flags &= ~JANET_SLOT_MUTABLE;
isUnnamedRegister = 1; /* don't free slot after use - is an alias for another slot */
} else if (!isUnnamedRegister) {
/* Slot is not able to be named */
JanetSlot localslot = janetc_farslot(c);
janetc_copy(c, localslot, ret);
@@ -389,11 +449,23 @@ static int varleaf(
static JanetSlot janetc_var(JanetFopts opts, int32_t argn, const Janet *argv) {
JanetCompiler *c = opts.compiler;
Janet head;
JanetSlot ret = dohead(c, opts, &head, argn, argv);
if (c->result.status == JANET_COMPILE_ERROR)
JanetTable *attr_table = handleattr(c, "var", argn, argv);
if (c->result.status == JANET_COMPILE_ERROR) {
return janetc_cslot(janet_wrap_nil());
destructure(c, argv[0], ret, varleaf, handleattr(c, argn, argv));
}
SlotHeadPair *into = NULL;
into = dohead_destructure(c, into, opts, argv[0], argv[argn - 1]);
if (c->result.status == JANET_COMPILE_ERROR) {
janet_v_free(into);
return janetc_cslot(janet_wrap_nil());
}
JanetSlot ret;
janet_assert(janet_v_count(into) > 0, "bad destructure");
for (int32_t i = 0; i < janet_v_count(into); i++) {
destructure(c, into[i].lhs, into[i].rhs, varleaf, attr_table);
ret = into[i].rhs;
}
janet_v_free(into);
return ret;
}
@@ -437,15 +509,53 @@ static int defleaf(
static JanetSlot janetc_def(JanetFopts opts, int32_t argn, const Janet *argv) {
JanetCompiler *c = opts.compiler;
Janet head;
opts.flags &= ~JANET_FOPTS_HINT;
JanetSlot ret = dohead(c, opts, &head, argn, argv);
if (c->result.status == JANET_COMPILE_ERROR)
JanetTable *attr_table = handleattr(c, "def", argn, argv);
if (c->result.status == JANET_COMPILE_ERROR) {
return janetc_cslot(janet_wrap_nil());
destructure(c, argv[0], ret, defleaf, handleattr(c, argn, argv));
}
opts.flags &= ~JANET_FOPTS_HINT;
SlotHeadPair *into = NULL;
into = dohead_destructure(c, into, opts, argv[0], argv[argn - 1]);
if (c->result.status == JANET_COMPILE_ERROR) {
janet_v_free(into);
return janetc_cslot(janet_wrap_nil());
}
JanetSlot ret;
janet_assert(janet_v_count(into) > 0, "bad destructure");
for (int32_t i = 0; i < janet_v_count(into); i++) {
destructure(c, into[i].lhs, into[i].rhs, defleaf, attr_table);
ret = into[i].rhs;
}
janet_v_free(into);
return ret;
}
/* Check if a form matches the pattern (= nil _) or (not= nil _) */
static int janetc_check_nil_form(JanetFopts opts, 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_SYMBOL)) {
Janet entry = janet_table_get(opts.compiler->env, op1);
if (janet_checktype(entry, JANET_TABLE)) {
op1 = janet_table_get(janet_unwrap_table(entry), janet_ckeywordv("value"));
}
}
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
* ...
@@ -466,6 +576,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");
@@ -479,6 +590,7 @@ static JanetSlot janetc_if(JanetFopts opts, int32_t argn, const Janet *argv) {
/* Get options */
condopts = janetc_fopts_default(c);
bodyopts = opts;
bodyopts.flags &= ~JANET_FOPTS_ACCEPT_SPLICE;
/* Set target for compilation */
target = (drop || tail)
@@ -487,7 +599,16 @@ 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(opts, condform, &condform, JANET_FUN_EQ)) {
ifnjmp = JOP_JUMP_IF_NOT_NIL;
}
if (janetc_check_nil_form(opts, 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 */
@@ -510,7 +631,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");
@@ -520,7 +641,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);
@@ -555,6 +676,7 @@ static JanetSlot janetc_do(JanetFopts opts, int32_t argn, const Janet *argv) {
subopts.flags = JANET_FOPTS_DROP;
} else {
subopts = opts;
subopts.flags &= ~JANET_FOPTS_ACCEPT_SPLICE;
}
ret = janetc_value(subopts, argv[i]);
if (i != argn - 1) {
@@ -565,7 +687,6 @@ static JanetSlot janetc_do(JanetFopts opts, int32_t argn, const Janet *argv) {
return ret;
}
/* Compile an upscope form. Upscope forms execute their body sequentially and
* evaluate to the last expression in the body, but without lexical scope. */
static JanetSlot janetc_upscope(JanetFopts opts, int32_t argn, const Janet *argv) {
@@ -578,6 +699,7 @@ static JanetSlot janetc_upscope(JanetFopts opts, int32_t argn, const Janet *argv
subopts.flags = JANET_FOPTS_DROP;
} else {
subopts = opts;
subopts.flags &= ~JANET_FOPTS_ACCEPT_SPLICE;
}
ret = janetc_value(subopts, argv[i]);
if (i != argn - 1) {
@@ -630,9 +752,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) {
@@ -640,9 +761,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) {
@@ -655,20 +774,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
* ...
@@ -685,12 +790,13 @@ 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;
if (argn < 2) {
janetc_cerror(c, "expected at least 2 arguments");
if (argn < 1) {
janetc_cerror(c, "expected at least 1 argument to while");
return janetc_cslot(janet_wrap_nil());
}
@@ -698,11 +804,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(opts, 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(opts, condform, &condform, JANET_FUN_NEQ)) {
is_notnil_form = 1;
ifjmp = JOP_JUMP_IF_NOT_NIL;
ifnjmp = JOP_JUMP_IF_NIL;
@@ -714,7 +825,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) {
@@ -805,7 +918,7 @@ static JanetSlot janetc_fn(JanetFopts opts, int32_t argn, const Janet *argv) {
JanetSlot ret;
Janet head;
JanetScope fnscope;
int32_t paramcount, argi, parami, arity, min_arity, max_arity, defindex, i;
int32_t paramcount, argi, parami, arity, min_arity = 0, max_arity, defindex, i;
JanetFopts subopts = janetc_fopts_default(c);
const Janet *params;
const char *errmsg = NULL;
@@ -817,6 +930,7 @@ static JanetSlot janetc_fn(JanetFopts opts, int32_t argn, const Janet *argv) {
int selfref = 0;
int seenamp = 0;
int seenopt = 0;
int namedargs = 0;
/* Begin function */
c->scope->flags |= JANET_SCOPE_CLOSURE;
@@ -841,6 +955,9 @@ static JanetSlot janetc_fn(JanetFopts opts, int32_t argn, const Janet *argv) {
/* Keep track of destructured parameters */
JanetSlot *destructed_params = NULL;
JanetSlot *named_params = NULL;
JanetTable *named_table = NULL;
JanetSlot named_slot;
/* Compile function parameters */
params = janet_unwrap_tuple(argv[parami]);
@@ -848,49 +965,75 @@ static JanetSlot janetc_fn(JanetFopts opts, int32_t argn, const Janet *argv) {
arity = paramcount;
for (i = 0; i < paramcount; i++) {
Janet param = params[i];
if (janet_checktype(param, JANET_SYMBOL)) {
if (namedargs) {
arity--;
if (!janet_checktype(param, JANET_SYMBOL)) {
errmsg = "only named arguments can follow &named";
goto error;
}
Janet key = janet_wrap_keyword(janet_unwrap_symbol(param));
janet_table_put(named_table, key, param);
janet_v_push(named_params, janetc_farslot(c));
} else if (janet_checktype(param, JANET_SYMBOL)) {
/* Check for varargs and unfixed arity */
if (!janet_cstrcmp(janet_unwrap_symbol(param), "&")) {
if (seenamp) {
errmsg = "& in unexpected location";
goto error;
} else if (i == paramcount - 1) {
allow_extra = 1;
const uint8_t *sym = janet_unwrap_symbol(param);
if (sym[0] == '&') {
if (!janet_cstrcmp(sym, "&")) {
if (seenamp) {
errmsg = "& in unexpected location";
goto error;
} else if (i == paramcount - 1) {
allow_extra = 1;
arity--;
} else if (i == paramcount - 2) {
vararg = 1;
arity -= 2;
} else {
errmsg = "& in unexpected location";
goto error;
}
seenamp = 1;
} else if (!janet_cstrcmp(sym, "&opt")) {
if (seenopt) {
errmsg = "only one &opt allowed";
goto error;
} else if (i == paramcount - 1) {
errmsg = "&opt cannot be last item in parameter list";
goto error;
}
min_arity = i;
arity--;
} else if (i == paramcount - 2) {
vararg = 1;
arity -= 2;
} else {
errmsg = "& in unexpected location";
goto error;
}
seenamp = 1;
} else if (!janet_cstrcmp(janet_unwrap_symbol(param), "&opt")) {
if (seenopt) {
errmsg = "only one &opt allowed";
goto error;
} else if (i == paramcount - 1) {
errmsg = "&opt cannot be last item in parameter list";
goto error;
}
min_arity = i;
arity--;
seenopt = 1;
} else if (!janet_cstrcmp(janet_unwrap_symbol(param), "&keys")) {
if (seenamp) {
errmsg = "&keys in unexpected location";
goto error;
} else if (i == paramcount - 2) {
seenopt = 1;
} else if (!janet_cstrcmp(sym, "&keys")) {
if (seenamp) {
errmsg = "&keys in unexpected location";
goto error;
} else if (i == paramcount - 2) {
vararg = 1;
structarg = 1;
arity -= 2;
} else {
errmsg = "&keys in unexpected location";
goto error;
}
seenamp = 1;
} else if (!janet_cstrcmp(sym, "&named")) {
if (seenamp) {
errmsg = "&named in unexpected location";
goto error;
}
vararg = 1;
structarg = 1;
arity -= 2;
arity--;
seenamp = 1;
namedargs = 1;
named_table = janet_table(10);
named_slot = janetc_farslot(c);
} else {
errmsg = "&keys in unexpected location";
goto error;
janetc_nameslot(c, sym, janetc_farslot(c));
}
seenamp = 1;
} else {
janetc_nameslot(c, janet_unwrap_symbol(param), janetc_farslot(c));
janetc_nameslot(c, sym, janetc_farslot(c));
}
} else {
janet_v_push(destructed_params, janetc_farslot(c));
@@ -902,6 +1045,7 @@ static JanetSlot janetc_fn(JanetFopts opts, int32_t argn, const Janet *argv) {
for (i = 0; i < paramcount; i++) {
Janet param = params[i];
if (!janet_checktype(param, JANET_SYMBOL)) {
janet_assert(janet_v_count(destructed_params) > j, "out of bounds");
JanetSlot reg = destructed_params[j++];
destructure(c, param, reg, defleaf, NULL);
janetc_freeslot(c, reg);
@@ -909,15 +1053,37 @@ static JanetSlot janetc_fn(JanetFopts opts, int32_t argn, const Janet *argv) {
}
janet_v_free(destructed_params);
/* Compile named arguments */
if (namedargs) {
Janet param = janet_wrap_table(named_table);
destructure(c, param, named_slot, defleaf, NULL);
janetc_freeslot(c, named_slot);
janet_v_free(named_params);
}
max_arity = (vararg || allow_extra) ? INT32_MAX : arity;
if (!seenopt) min_arity = arity;
/* Check for self ref */
/* Check for self ref (also avoid if arguments shadow own name) */
if (selfref) {
JanetSlot slot = janetc_farslot(c);
slot.flags = JANET_SLOT_NAMED | JANET_FUNCTION;
janetc_emit_s(c, JOP_LOAD_SELF, slot, 1);
janetc_nameslot(c, janet_unwrap_symbol(head), slot);
/* Check if the parameters shadow the function name. If so, don't
* emit JOP_LOAD_SELF and add a binding since that most users
* seem to expect that function parameters take precedence over the
* function name */
const uint8_t *sym = janet_unwrap_symbol(head);
int32_t len = janet_v_count(c->scope->syms);
int found = 0;
for (int32_t i = 0; i < len; i++) {
if (c->scope->syms[i].sym == sym) {
found = 1;
}
}
if (!found) {
JanetSlot slot = janetc_farslot(c);
slot.flags = JANET_SLOT_NAMED | JANET_FUNCTION;
janetc_emit_s(c, JOP_LOAD_SELF, slot, 1);
janetc_nameslot(c, sym, slot);
}
}
/* Compile function body */
@@ -984,4 +1150,3 @@ const JanetSpecial *janetc_special(const uint8_t *name) {
sizeof(JanetSpecial),
name);
}

View File

@@ -1,5 +1,5 @@
/*
* Copyright (c) 2022 Calvin Rose
* Copyright (c) 2023 Calvin Rose
*
* Permission is hereby granted, free of charge, to any person obtaining a copy
* of this software and associated documentation files (the "Software"), to
@@ -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

@@ -1,5 +1,5 @@
/*
* Copyright (c) 2022 Calvin Rose
* Copyright (c) 2023 Calvin Rose
*
* Permission is hereby granted, free of charge, to any person obtaining a copy
* of this software and associated documentation files (the "Software"), to
@@ -23,8 +23,15 @@
#ifndef JANET_STATE_H_defined
#define JANET_STATE_H_defined
#include <janet.h>
#include <stdint.h>
#ifdef JANET_EV
#ifndef JANET_WINDOWS
#include <pthread.h>
#endif
#endif
typedef int64_t JanetTimestamp;
typedef struct JanetScratch {
@@ -54,7 +61,7 @@ typedef struct {
int is_error;
} JanetTimeout;
/* Registry table for C functions - containts metadata that can
/* Registry table for C functions - contains metadata that can
* be looked up by cfunction pointer. All strings here are pointing to
* static memory not managed by Janet. */
typedef struct {
@@ -82,10 +89,10 @@ 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 janet_run. */
* Set and unset by functions in vm.c */
JanetFiber *fiber;
JanetFiber *root_fiber;
@@ -101,7 +108,7 @@ struct JanetVM {
size_t registry_count;
int registry_dirty;
/* Registry for abstract abstract types that can be marshalled.
/* Registry for abstract types that can be marshalled.
* We need this to look up the constructors when unmarshalling. */
JanetTable *abstract_registry;
@@ -114,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;
@@ -129,6 +138,9 @@ struct JanetVM {
size_t scratch_cap;
size_t scratch_len;
/* Sandbox flags */
uint32_t sandbox_flags;
/* Random number generator */
JanetRNG rng;
@@ -144,24 +156,29 @@ 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)
pthread_attr_t new_thread_attr;
JanetHandle selfpipe[2];
int epoll;
int timerfd;
int timer_enabled;
#elif defined(JANET_EV_KQUEUE)
pthread_attr_t new_thread_attr;
JanetHandle selfpipe[2];
int kq;
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;
#endif

View File

@@ -1,5 +1,5 @@
/*
* Copyright (c) 2022 Calvin Rose
* Copyright (c) 2023 Calvin Rose
*
* Permission is hereby granted, free of charge, to any person obtaining a copy
* of this software and associated documentation files (the "Software"), to
@@ -173,10 +173,11 @@ static int32_t kmp_next(struct kmp_state *state) {
JANET_CORE_FN(cfun_string_slice,
"(string/slice bytes &opt start end)",
"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. ") {
"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 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);
@@ -184,7 +185,7 @@ JANET_CORE_FN(cfun_string_slice,
JANET_CORE_FN(cfun_symbol_slice,
"(symbol/slice bytes &opt start end)",
"Same a string/slice, but returns a symbol.") {
"Same as string/slice, but returns a symbol.") {
JanetByteView view = janet_getbytes(argv, 0);
JanetRange range = janet_getslice(argc, argv);
return janet_symbolv(view.bytes + range.start, range.end - range.start);
@@ -192,7 +193,7 @@ JANET_CORE_FN(cfun_symbol_slice,
JANET_CORE_FN(cfun_keyword_slice,
"(keyword/slice bytes &opt start end)",
"Same a string/slice, but returns a keyword.") {
"Same as string/slice, but returns a keyword.") {
JanetByteView view = janet_getbytes(argv, 0);
JanetRange range = janet_getslice(argc, argv);
return janet_keywordv(view.bytes + range.start, range.end - range.start);
@@ -200,7 +201,7 @@ JANET_CORE_FN(cfun_keyword_slice,
JANET_CORE_FN(cfun_string_repeat,
"(string/repeat bytes n)",
"Returns a string that is n copies of bytes concatenated.") {
"Returns a string that is `n` copies of `bytes` concatenated.") {
janet_fixarity(argc, 2);
JanetByteView view = janet_getbytes(argv, 0);
int32_t rep = janet_getinteger(argv, 1);
@@ -282,7 +283,7 @@ JANET_CORE_FN(cfun_string_asciiupper,
JANET_CORE_FN(cfun_string_reverse,
"(string/reverse str)",
"Returns a string that is the reversed version of str.") {
"Returns a string that is the reversed version of `str`.") {
janet_fixarity(argc, 1);
JanetByteView view = janet_getbytes(argv, 0);
uint8_t *buf = janet_string_begin(view.len);
@@ -308,8 +309,8 @@ static void findsetup(int32_t argc, Janet *argv, struct kmp_state *s, int32_t ex
JANET_CORE_FN(cfun_string_find,
"(string/find patt str &opt start-index)",
"Searches for the first instance of pattern patt in string "
"str. Returns the index of the first character in patt if found, "
"Searches for the first instance of pattern `patt` in string "
"`str`. Returns the index of the first character in `patt` if found, "
"otherwise returns nil.") {
int32_t result;
struct kmp_state state;
@@ -323,7 +324,7 @@ JANET_CORE_FN(cfun_string_find,
JANET_CORE_FN(cfun_string_hasprefix,
"(string/has-prefix? pfx str)",
"Tests whether str starts with pfx.") {
"Tests whether `str` starts with `pfx`.") {
janet_fixarity(argc, 2);
JanetByteView prefix = janet_getbytes(argv, 0);
JanetByteView str = janet_getbytes(argv, 1);
@@ -334,7 +335,7 @@ JANET_CORE_FN(cfun_string_hasprefix,
JANET_CORE_FN(cfun_string_hassuffix,
"(string/has-suffix? sfx str)",
"Tests whether str ends with sfx.") {
"Tests whether `str` ends with `sfx`.") {
janet_fixarity(argc, 2);
JanetByteView suffix = janet_getbytes(argv, 0);
JanetByteView str = janet_getbytes(argv, 1);
@@ -347,9 +348,9 @@ JANET_CORE_FN(cfun_string_hassuffix,
JANET_CORE_FN(cfun_string_findall,
"(string/find-all patt str &opt start-index)",
"Searches for all instances of pattern patt in string "
"str. Returns an array of all indices of found patterns. Overlapping "
"instances of the pattern are counted individually, meaning a byte in str "
"Searches for all instances of pattern `patt` in string "
"`str`. Returns an array of all indices of found patterns. Overlapping "
"instances of the pattern are counted individually, meaning a byte in `str` "
"may contribute to multiple found patterns.") {
int32_t result;
struct kmp_state state;
@@ -364,14 +365,13 @@ JANET_CORE_FN(cfun_string_findall,
struct replace_state {
struct kmp_state kmp;
const uint8_t *subst;
int32_t substlen;
Janet subst;
};
static void replacesetup(int32_t argc, Janet *argv, struct replace_state *s) {
janet_arity(argc, 3, 4);
JanetByteView pat = janet_getbytes(argv, 0);
JanetByteView subst = janet_getbytes(argv, 1);
Janet subst = argv[1];
JanetByteView text = janet_getbytes(argv, 2);
int32_t start = 0;
if (argc == 4) {
@@ -380,14 +380,15 @@ static void replacesetup(int32_t argc, Janet *argv, struct replace_state *s) {
}
kmp_init(&s->kmp, text.bytes, text.len, pat.bytes, pat.len);
s->kmp.i = start;
s->subst = subst.bytes;
s->substlen = subst.len;
s->subst = subst;
}
JANET_CORE_FN(cfun_string_replace,
"(string/replace patt subst str)",
"Replace the first occurrence of patt with subst in the string str. "
"Will return the new string if patt is found, otherwise returns str.") {
"Replace the first occurrence of `patt` with `subst` in the string `str`. "
"If `subst` is a function, it will be called with `patt` only if a match is found, "
"and should return the actual replacement text to use. "
"Will return the new string if `patt` is found, otherwise returns `str`.") {
int32_t result;
struct replace_state s;
uint8_t *buf;
@@ -397,10 +398,11 @@ JANET_CORE_FN(cfun_string_replace,
kmp_deinit(&s.kmp);
return janet_stringv(s.kmp.text, s.kmp.textlen);
}
buf = janet_string_begin(s.kmp.textlen - s.kmp.patlen + s.substlen);
JanetByteView subst = janet_text_substitution(&s.subst, s.kmp.text + result, s.kmp.patlen, NULL);
buf = janet_string_begin(s.kmp.textlen - s.kmp.patlen + subst.len);
safe_memcpy(buf, s.kmp.text, result);
safe_memcpy(buf + result, s.subst, s.substlen);
safe_memcpy(buf + result + s.substlen,
safe_memcpy(buf + result, subst.bytes, subst.len);
safe_memcpy(buf + result + subst.len,
s.kmp.text + result + s.kmp.patlen,
s.kmp.textlen - result - s.kmp.patlen);
kmp_deinit(&s.kmp);
@@ -409,9 +411,11 @@ JANET_CORE_FN(cfun_string_replace,
JANET_CORE_FN(cfun_string_replaceall,
"(string/replace-all patt subst str)",
"Replace all instances of patt with subst in the string str. Overlapping "
"Replace all instances of `patt` with `subst` in the string `str`. Overlapping "
"matches will not be counted, only the first match in such a span will be replaced. "
"Will return the new string if patt is found, otherwise returns str.") {
"If `subst` is a function, it will be called with `patt` once for each match, "
"and should return the actual replacement text to use. "
"Will return the new string if `patt` is found, otherwise returns `str`.") {
int32_t result;
struct replace_state s;
JanetBuffer b;
@@ -419,8 +423,9 @@ JANET_CORE_FN(cfun_string_replaceall,
replacesetup(argc, argv, &s);
janet_buffer_init(&b, s.kmp.textlen);
while ((result = kmp_next(&s.kmp)) >= 0) {
JanetByteView subst = janet_text_substitution(&s.subst, s.kmp.text + result, s.kmp.patlen, NULL);
janet_buffer_push_bytes(&b, s.kmp.text + lastindex, result - lastindex);
janet_buffer_push_bytes(&b, s.subst, s.substlen);
janet_buffer_push_bytes(&b, subst.bytes, subst.len);
lastindex = result + s.kmp.patlen;
kmp_seti(&s.kmp, lastindex);
}
@@ -433,11 +438,11 @@ JANET_CORE_FN(cfun_string_replaceall,
JANET_CORE_FN(cfun_string_split,
"(string/split delim str &opt start limit)",
"Splits a string str with delimiter delim and returns an array of "
"substrings. The substrings will not contain the delimiter delim. If delim "
"Splits a string `str` with delimiter `delim` and returns an array of "
"substrings. The substrings will not contain the delimiter `delim`. If `delim` "
"is not found, the returned array will have one element. Will start searching "
"for delim at the index start (if provided), and return up to a maximum "
"of limit results (if provided).") {
"for `delim` at the index `start` (if provided), and return up to a maximum "
"of `limit` results (if provided).") {
int32_t result;
JanetArray *array;
struct kmp_state state;
@@ -461,9 +466,9 @@ JANET_CORE_FN(cfun_string_split,
JANET_CORE_FN(cfun_string_checkset,
"(string/check-set set str)",
"Checks that the string str only contains bytes that appear in the string set. "
"Returns true if all bytes in str appear in set, false if some bytes in str do "
"not appear in set.") {
"Checks that the string `str` only contains bytes that appear in the string `set`. "
"Returns true if all bytes in `str` appear in `set`, false if some bytes in `str` do "
"not appear in `set`.") {
uint32_t bitset[8] = {0, 0, 0, 0, 0, 0, 0, 0};
janet_fixarity(argc, 2);
JanetByteView set = janet_getbytes(argv, 0);
@@ -488,7 +493,7 @@ JANET_CORE_FN(cfun_string_checkset,
JANET_CORE_FN(cfun_string_join,
"(string/join parts &opt sep)",
"Joins an array of strings into one string, optionally separated by "
"a separator string sep.") {
"a separator string `sep`.") {
janet_arity(argc, 1, 2);
JanetView parts = janet_getindexed(argv, 0);
JanetByteView joiner;
@@ -530,8 +535,31 @@ JANET_CORE_FN(cfun_string_join,
JANET_CORE_FN(cfun_string_format,
"(string/format format & values)",
"Similar to snprintf, but specialized for operating with Janet values. Returns "
"a new string.") {
"Similar to C's `snprintf`, but specialized for operating with Janet values. Returns "
"a new string.\n\n"
"The following conversion specifiers are supported, where the upper case specifiers generate "
"upper case output:\n"
"- `c`: ASCII character.\n"
"- `d`, `i`: integer, formatted as a decimal number.\n"
"- `x`, `X`: integer, formatted as a hexadecimal number.\n"
"- `o`: integer, formatted as an octal number.\n"
"- `f`, `F`: floating point number, formatted as a decimal number.\n"
"- `e`, `E`: floating point number, formatted in scientific notation.\n"
"- `g`, `G`: floating point number, formatted in its shortest form.\n"
"- `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)"
"- `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 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"
"- `q`, `Q`: pretty format on one line, truncating if necessary.\n"
"- `n`, `N`: pretty format on one line without truncation.\n") {
janet_arity(argc, 1, -1);
JanetBuffer *buffer = janet_buffer(0);
const char *strfrmt = (const char *) janet_getstring(argv, 0);
@@ -574,7 +602,7 @@ static void trim_help_args(int32_t argc, Janet *argv, JanetByteView *str, JanetB
JANET_CORE_FN(cfun_string_trim,
"(string/trim str &opt set)",
"Trim leading and trailing whitespace from a byte sequence. If the argument "
"set is provided, consider only characters in set to be whitespace.") {
"`set` is provided, consider only characters in `set` to be whitespace.") {
JanetByteView str, set;
trim_help_args(argc, argv, &str, &set);
int32_t left_edge = trim_help_leftedge(str, set);
@@ -587,7 +615,7 @@ JANET_CORE_FN(cfun_string_trim,
JANET_CORE_FN(cfun_string_triml,
"(string/triml str &opt set)",
"Trim leading whitespace from a byte sequence. If the argument "
"set is provided, consider only characters in set to be whitespace.") {
"`set` is provided, consider only characters in `set` to be whitespace.") {
JanetByteView str, set;
trim_help_args(argc, argv, &str, &set);
int32_t left_edge = trim_help_leftedge(str, set);
@@ -597,7 +625,7 @@ JANET_CORE_FN(cfun_string_triml,
JANET_CORE_FN(cfun_string_trimr,
"(string/trimr str &opt set)",
"Trim trailing whitespace from a byte sequence. If the argument "
"set is provided, consider only characters in set to be whitespace.") {
"`set` is provided, consider only characters in `set` to be whitespace.") {
JanetByteView str, set;
trim_help_args(argc, argv, &str, &set);
int32_t right_edge = trim_help_rightedge(str, set);

View File

@@ -1,5 +1,5 @@
/*
* Copyright (c) 2022 Calvin Rose
* Copyright (c) 2023 Calvin Rose
*
* Permission is hereby granted, free of charge, to any person obtaining a copy
* of this software and associated documentation files (the "Software"), to

View File

@@ -1,5 +1,5 @@
/*
* Copyright (c) 2022 Calvin Rose
* Copyright (c) 2023 Calvin Rose
*
* Permission is hereby granted, free of charge, to any person obtaining a copy
* of this software and associated documentation files (the "Software"), to

View File

@@ -1,5 +1,5 @@
/*
* Copyright (c) 2022 Calvin Rose
* Copyright (c) 2023 Calvin Rose
*
* Permission is hereby granted, free of charge, to any person obtaining a copy
* of this software and associated documentation files (the "Software"), to
@@ -108,6 +108,7 @@ static const uint8_t **janet_symcache_findmem(
}
notfound:
*success = 0;
janet_assert(firstEmpty != NULL, "symcache failed to get memory");
return firstEmpty;
}

View File

@@ -1,5 +1,5 @@
/*
* Copyright (c) 2022 Calvin Rose
* Copyright (c) 2023 Calvin Rose
*
* Permission is hereby granted, free of charge, to any person obtaining a copy
* of this software and associated documentation files (the "Software"), to

View File

@@ -1,5 +1,5 @@
/*
* Copyright (c) 2022 Calvin Rose
* Copyright (c) 2023 Calvin Rose
*
* Permission is hereby granted, free of charge, to any person obtaining a copy
* of this software and associated documentation files (the "Software"), to
@@ -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);
@@ -296,17 +311,52 @@ JanetTable *janet_table_proto_flatten(JanetTable *t) {
JANET_CORE_FN(cfun_table_new,
"(table/new capacity)",
"Creates a new empty table with pre-allocated memory "
"for capacity entries. This means that if one knows the number of "
"entries going to go in a table on creation, extra memory allocation "
"can be avoided. Returns the new table.") {
"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.") {
janet_fixarity(argc, 1);
int32_t cap = janet_getinteger(argv, 0);
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)",
"Get the prototype table of a table. Returns nil if a table "
"Get the prototype table of a table. Returns nil if the table "
"has no prototype, otherwise returns the prototype.") {
janet_fixarity(argc, 1);
JanetTable *t = janet_gettable(argv, 0);
@@ -317,7 +367,7 @@ JANET_CORE_FN(cfun_table_getproto,
JANET_CORE_FN(cfun_table_setproto,
"(table/setproto tab proto)",
"Set the prototype of a table. Returns the original table tab.") {
"Set the prototype of a table. Returns the original table `tab`.") {
janet_fixarity(argc, 2);
JanetTable *table = janet_gettable(argv, 0);
JanetTable *proto = NULL;
@@ -339,8 +389,8 @@ JANET_CORE_FN(cfun_table_tostruct,
JANET_CORE_FN(cfun_table_rawget,
"(table/rawget tab key)",
"Gets a value from a table without looking at the prototype table. "
"If a table tab does not contain t directly, the function will return "
"Gets a value from a table `tab` without looking at the prototype table. "
"If `tab` does not contain the key directly, the function will return "
"nil without checking the prototype. Returns the value in the table.") {
janet_fixarity(argc, 2);
JanetTable *table = janet_gettable(argv, 0);
@@ -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

@@ -1,5 +1,5 @@
/*
* Copyright (c) 2022 Calvin Rose
* Copyright (c) 2023 Calvin Rose
*
* Permission is hereby granted, free of charge, to any person obtaining a copy
* of this software and associated documentation files (the "Software"), to
@@ -65,13 +65,13 @@ JANET_CORE_FN(cfun_tuple_brackets,
JANET_CORE_FN(cfun_tuple_slice,
"(tuple/slice arrtup [,start=0 [,end=(length arrtup)]])",
"Take a sub sequence of an array or tuple from index start "
"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.") {
"Take a sub-sequence of an array or tuple from index `start` "
"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 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));
@@ -96,7 +96,7 @@ JANET_CORE_FN(cfun_tuple_type,
JANET_CORE_FN(cfun_tuple_sourcemap,
"(tuple/sourcemap tup)",
"Returns the sourcemap metadata attached to a tuple, "
" which is another tuple (line, column).") {
"which is another tuple (line, column).") {
janet_fixarity(argc, 1);
const Janet *tup = janet_gettuple(argv, 0);
Janet contents[2];

View File

@@ -1,5 +1,5 @@
/*
* Copyright (c) 2022 Calvin Rose
* Copyright (c) 2023 Calvin Rose
*
* Permission is hereby granted, free of charge, to any person obtaining a copy
* of this software and associated documentation files (the "Software"), to
@@ -36,6 +36,15 @@
#endif
#endif
#ifdef JANET_WINDOWS
#ifdef JANET_DYNAMIC_MODULES
#include <psapi.h>
#ifdef JANET_MSVC
#pragma comment (lib, "Psapi.lib")
#endif
#endif
#endif
#ifdef JANET_APPLE
#include <AvailabilityMacros.h>
#endif
@@ -83,8 +92,8 @@ const char *const janet_signal_names[14] = {
"user5",
"user6",
"user7",
"user8",
"user9"
"interrupt",
"await"
};
const char *const janet_status_names[16] = {
@@ -100,8 +109,8 @@ const char *const janet_status_names[16] = {
"user5",
"user6",
"user7",
"user8",
"user9",
"interrupted",
"suspended",
"new",
"alive"
};
@@ -109,6 +118,7 @@ const char *const janet_status_names[16] = {
#ifndef JANET_PRF
int32_t janet_string_calchash(const uint8_t *str, int32_t len) {
if (NULL == str) return 5381;
const uint8_t *end = str + len;
uint32_t hash = 5381;
while (str < end)
@@ -258,6 +268,7 @@ int32_t janet_kv_calchash(const JanetKV *kvs, int32_t len) {
/* Calculate next power of 2. May overflow. If n is 0,
* will return 0. */
int32_t janet_tablen(int32_t n) {
if (n < 0) return 0;
n |= n >> 1;
n |= n >> 2;
n |= n >> 4;
@@ -488,7 +499,7 @@ typedef struct {
static void namebuf_init(NameBuf *namebuf, const char *prefix) {
size_t plen = strlen(prefix);
namebuf->plen = plen;
namebuf->buf = janet_malloc(namebuf->plen + 256);
namebuf->buf = janet_smalloc(namebuf->plen + 256);
if (NULL == namebuf->buf) {
JANET_OUT_OF_MEMORY;
}
@@ -497,12 +508,12 @@ static void namebuf_init(NameBuf *namebuf, const char *prefix) {
}
static void namebuf_deinit(NameBuf *namebuf) {
janet_free(namebuf->buf);
janet_sfree(namebuf->buf);
}
static char *namebuf_name(NameBuf *namebuf, const char *suffix) {
size_t slen = strlen(suffix);
namebuf->buf = janet_realloc(namebuf->buf, namebuf->plen + 2 + slen);
namebuf->buf = janet_srealloc(namebuf->buf, namebuf->plen + 2 + slen);
if (NULL == namebuf->buf) {
JANET_OUT_OF_MEMORY;
}
@@ -652,6 +663,59 @@ JanetBinding janet_binding_from_entry(Janet entry) {
return binding;
}
/* If the value at the given address can be coerced to a byte view,
return that byte view. If it can't, replace the value at the address
with the result of janet_to_string, and return a byte view over that
string. */
static JanetByteView memoize_byte_view(Janet *value) {
JanetByteView result;
if (!janet_bytes_view(*value, &result.bytes, &result.len)) {
JanetString str = janet_to_string(*value);
*value = janet_wrap_string(str);
result.bytes = str;
result.len = janet_string_length(str);
}
return result;
}
static JanetByteView to_byte_view(Janet value) {
JanetByteView result;
if (!janet_bytes_view(value, &result.bytes, &result.len)) {
JanetString str = janet_to_string(value);
result.bytes = str;
result.len = janet_string_length(str);
}
return result;
}
JanetByteView janet_text_substitution(
Janet *subst,
const uint8_t *bytes,
uint32_t len,
JanetArray *extra_argv) {
int32_t extra_argc = extra_argv == NULL ? 0 : extra_argv->count;
JanetType type = janet_type(*subst);
switch (type) {
case JANET_FUNCTION:
case JANET_CFUNCTION: {
int32_t argc = 1 + extra_argc;
Janet *argv = janet_tuple_begin(argc);
argv[0] = janet_stringv(bytes, len);
for (int32_t i = 0; i < extra_argc; i++) {
argv[i + 1] = extra_argv->data[i];
}
janet_tuple_end(argv);
if (type == JANET_FUNCTION) {
return to_byte_view(janet_call(janet_unwrap_function(*subst), argc, argv));
} else {
return to_byte_view(janet_unwrap_cfunction(*subst)(argc, argv));
}
}
default:
return memoize_byte_view(subst);
}
}
JanetBinding janet_resolve_ext(JanetTable *env, const uint8_t *sym) {
Janet entry = janet_table_get(env, janet_wrap_symbol(sym));
return janet_binding_from_entry(entry);
@@ -693,15 +757,25 @@ int janet_indexed_view(Janet seq, const Janet **data, int32_t *len) {
/* Read both strings and buffer as unsigned character array + int32_t len.
* Returns 1 if the view can be constructed and 0 if the type is invalid. */
int janet_bytes_view(Janet str, const uint8_t **data, int32_t *len) {
if (janet_checktype(str, JANET_STRING) || janet_checktype(str, JANET_SYMBOL) ||
janet_checktype(str, JANET_KEYWORD)) {
JanetType t = janet_type(str);
if (t == JANET_STRING || t == JANET_SYMBOL || t == JANET_KEYWORD) {
*data = janet_unwrap_string(str);
*len = janet_string_length(janet_unwrap_string(str));
return 1;
} else if (janet_checktype(str, JANET_BUFFER)) {
} else if (t == JANET_BUFFER) {
*data = janet_unwrap_buffer(str)->data;
*len = janet_unwrap_buffer(str)->count;
return 1;
} else if (t == JANET_ABSTRACT) {
void *abst = janet_unwrap_abstract(str);
const JanetAbstractType *atype = janet_abstract_type(abst);
if (NULL == atype->bytes) {
return 0;
}
JanetByteView view = atype->bytes(abst, janet_abstract_size(abst));
*data = view.bytes;
*len = view.len;
return 1;
}
return 0;
}
@@ -731,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;
@@ -738,6 +819,13 @@ int janet_checkint64(Janet x) {
return janet_checkint64range(dval);
}
int janet_checkuint64(Janet x) {
if (!janet_checktype(x, JANET_NUMBER))
return 0;
double dval = janet_unwrap_number(x);
return janet_checkuint64range(dval);
}
int janet_checksize(Janet x) {
if (!janet_checktype(x, JANET_NUMBER))
return 0;
@@ -794,34 +882,73 @@ int32_t janet_sorted_keys(const JanetKV *dict, int32_t cap, int32_t *index_buffe
/* Clock shims for various platforms */
#ifdef JANET_GETTIME
#ifdef JANET_WINDOWS
int janet_gettime(struct timespec *spec) {
FILETIME ftime;
GetSystemTimeAsFileTime(&ftime);
int64_t wintime = (int64_t)(ftime.dwLowDateTime) | ((int64_t)(ftime.dwHighDateTime) << 32);
/* Windows epoch is January 1, 1601 apparently */
wintime -= 116444736000000000LL;
spec->tv_sec = wintime / 10000000LL;
/* Resolution is 100 nanoseconds. */
spec->tv_nsec = wintime % 10000000LL * 100;
#include <profileapi.h>
int janet_gettime(struct timespec *spec, enum JanetTimeSource source) {
if (source == JANET_TIME_REALTIME) {
FILETIME ftime;
GetSystemTimeAsFileTime(&ftime);
int64_t wintime = (int64_t)(ftime.dwLowDateTime) | ((int64_t)(ftime.dwHighDateTime) << 32);
/* Windows epoch is January 1, 1601 apparently */
wintime -= 116444736000000000LL;
spec->tv_sec = wintime / 10000000LL;
/* Resolution is 100 nanoseconds. */
spec->tv_nsec = wintime % 10000000LL * 100;
} else if (source == JANET_TIME_MONOTONIC) {
LARGE_INTEGER count;
LARGE_INTEGER perf_freq;
QueryPerformanceCounter(&count);
QueryPerformanceFrequency(&perf_freq);
spec->tv_sec = count.QuadPart / perf_freq.QuadPart;
spec->tv_nsec = (long)((count.QuadPart % perf_freq.QuadPart) * 1000000000 / perf_freq.QuadPart);
} else if (source == JANET_TIME_CPUTIME) {
FILETIME creationTime, exitTime, kernelTime, userTime;
GetProcessTimes(GetCurrentProcess(), &creationTime, &exitTime, &kernelTime, &userTime);
int64_t tmp = ((int64_t)userTime.dwHighDateTime << 32) + userTime.dwLowDateTime;
spec->tv_sec = tmp / 10000000LL;
spec->tv_nsec = tmp % 10000000LL * 100;
}
return 0;
}
/* clock_gettime() wasn't available on Mac until 10.12. */
#elif defined(JANET_APPLE) && !defined(MAC_OS_X_VERSION_10_12)
#include <mach/clock.h>
#include <mach/mach.h>
int janet_gettime(struct timespec *spec) {
clock_serv_t cclock;
mach_timespec_t mts;
host_get_clock_service(mach_host_self(), CALENDAR_CLOCK, &cclock);
clock_get_time(cclock, &mts);
mach_port_deallocate(mach_task_self(), cclock);
spec->tv_sec = mts.tv_sec;
spec->tv_nsec = mts.tv_nsec;
int janet_gettime(struct timespec *spec, enum JanetTimeSource source) {
if (source == JANET_TIME_REALTIME) {
clock_serv_t cclock;
mach_timespec_t mts;
host_get_clock_service(mach_host_self(), CALENDAR_CLOCK, &cclock);
clock_get_time(cclock, &mts);
mach_port_deallocate(mach_task_self(), cclock);
spec->tv_sec = mts.tv_sec;
spec->tv_nsec = mts.tv_nsec;
} else if (source == JANET_TIME_MONOTONIC) {
clock_serv_t cclock;
int nsecs;
mach_msg_type_number_t count;
host_get_clock_service(mach_host_self(), clock, &cclock);
clock_get_attributes(cclock, CLOCK_GET_TIME_RES, (clock_attr_t)&nsecs, &count);
mach_port_deallocate(mach_task_self(), cclock);
clock_getres(CLOCK_MONOTONIC, spec);
}
if (source == JANET_TIME_CPUTIME) {
clock_t tmp = clock();
spec->tv_sec = tmp;
spec->tv_nsec = (tmp - spec->tv_sec) * 1.0e9;
}
return 0;
}
#else
int janet_gettime(struct timespec *spec) {
return clock_gettime(CLOCK_REALTIME, spec);
int janet_gettime(struct timespec *spec, enum JanetTimeSource source) {
clockid_t cid = CLOCK_REALTIME;
if (source == JANET_TIME_REALTIME) {
cid = CLOCK_REALTIME;
} else if (source == JANET_TIME_MONOTONIC) {
cid = CLOCK_MONOTONIC;
} else if (source == JANET_TIME_CPUTIME) {
cid = CLOCK_PROCESS_CPUTIME_ID;
}
return clock_gettime(cid, spec);
}
#endif
#endif
@@ -838,13 +965,13 @@ int janet_cryptorand(uint8_t *out, size_t n) {
unsigned int v;
if (rand_s(&v))
return -1;
for (int32_t j = 0; (j < sizeof(unsigned int)) && (i + j < n); j++) {
for (int32_t j = 0; (j < (int32_t) sizeof(unsigned int)) && (i + j < n); j++) {
out[i + j] = v & 0xff;
v = v >> 8;
}
}
return 0;
#elif defined(JANET_LINUX) || ( defined(JANET_APPLE) && !defined(MAC_OS_X_VERSION_10_7) )
#elif defined(JANET_LINUX) || defined(JANET_CYGWIN) || ( defined(JANET_APPLE) && !defined(MAC_OS_X_VERSION_10_7) )
/* 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.
@@ -876,6 +1003,81 @@ int janet_cryptorand(uint8_t *out, size_t n) {
#endif
}
/* Dynamic library loading */
char *get_processed_name(const char *name) {
if (name[0] == '.') return (char *) name;
const char *c;
for (c = name; *c; c++) {
if (*c == '/') return (char *) name;
}
size_t l = (size_t)(c - name);
char *ret = janet_malloc(l + 3);
if (NULL == ret) {
JANET_OUT_OF_MEMORY;
}
ret[0] = '.';
ret[1] = '/';
memcpy(ret + 2, name, l + 1);
return ret;
}
#if defined(JANET_NO_DYNAMIC_MODULES)
const char *error_clib(void) {
return "dynamic modules not supported";
}
#else
#if defined(JANET_WINDOWS)
static char error_clib_buf[256];
char *error_clib(void) {
FormatMessageA(FORMAT_MESSAGE_FROM_SYSTEM | FORMAT_MESSAGE_IGNORE_INSERTS,
NULL, GetLastError(), MAKELANGID(LANG_NEUTRAL, SUBLANG_DEFAULT),
error_clib_buf, sizeof(error_clib_buf), NULL);
error_clib_buf[strlen(error_clib_buf) - 1] = '\0';
return error_clib_buf;
}
Clib load_clib(const char *name) {
if (name == NULL) {
return GetModuleHandle(NULL);
} else {
return LoadLibrary(name);
}
}
void free_clib(HINSTANCE clib) {
if (clib != GetModuleHandle(NULL)) {
FreeLibrary(clib);
}
}
void *symbol_clib(HINSTANCE clib, const char *sym) {
if (clib != GetModuleHandle(NULL)) {
return GetProcAddress(clib, sym);
} else {
/* Look up symbols from all loaded modules */
HMODULE hMods[1024];
DWORD needed = 0;
if (EnumProcessModules(GetCurrentProcess(), hMods, sizeof(hMods), &needed)) {
needed /= sizeof(HMODULE);
for (DWORD i = 0; i < needed; i++) {
void *address = GetProcAddress(hMods[i], sym);
if (NULL != address) {
return address;
}
}
} else {
janet_panicf("ffi: %s", error_clib());
}
return NULL;
}
}
#endif
#endif
/* Alloc function macro fills */
void *(janet_malloc)(size_t size) {

View File

@@ -1,5 +1,5 @@
/*
* Copyright (c) 2022 Calvin Rose
* Copyright (c) 2023 Calvin Rose
*
* Permission is hereby granted, free of charge, to any person obtaining a copy
* of this software and associated documentation files (the "Software"), to
@@ -31,6 +31,14 @@
#include <stdio.h>
#include <errno.h>
#include <stddef.h>
#include <stdbool.h>
#ifdef JANET_EV
#ifndef JANET_WINDOWS
#include <pthread.h>
#endif
#endif
#if !defined(JANET_REDUCED_OS) || !defined(JANET_SINGLE_THREADED)
#include <time.h>
@@ -41,7 +49,7 @@
#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 interpreter runtime error at line %d in file %s: %s\n",\
__LINE__,\
__FILE__,\
(m));\
@@ -85,6 +93,11 @@ void janet_buffer_format(
Janet *argv);
Janet janet_next_impl(Janet ds, Janet key, int is_interpreter);
JanetBinding janet_binding_from_entry(Janet entry);
JanetByteView janet_text_substitution(
Janet *subst,
const uint8_t *bytes,
uint32_t len,
JanetArray *extra_args);
/* Registry functions */
void janet_registry_put(
@@ -113,7 +126,12 @@ void janet_core_cfuns_ext(JanetTable *env, const char *regprefix, const JanetReg
/* Clock gettime */
#ifdef JANET_GETTIME
int janet_gettime(struct timespec *spec);
enum JanetTimeSource {
JANET_TIME_REALTIME,
JANET_TIME_MONOTONIC,
JANET_TIME_CPUTIME
};
int janet_gettime(struct timespec *spec, enum JanetTimeSource source);
#endif
/* strdup */
@@ -121,6 +139,31 @@ int janet_gettime(struct timespec *spec);
#define strdup(x) _strdup(x)
#endif
/* Use LoadLibrary on windows or dlopen on posix to load dynamic libaries
* with native code. */
#if defined(JANET_NO_DYNAMIC_MODULES)
typedef int Clib;
#define load_clib(name) ((void) name, 0)
#define symbol_clib(lib, sym) ((void) lib, (void) sym, NULL)
const char *error_clib(void);
#define free_clib(c) ((void) (c), 0)
#elif defined(JANET_WINDOWS)
#include <windows.h>
typedef HINSTANCE Clib;
void *symbol_clib(Clib clib, const char *sym);
void free_clib(Clib clib);
Clib load_clib(const char *name);
char *error_clib(void);
#else
#include <dlfcn.h>
typedef void *Clib;
#define load_clib(name) dlopen((name), RTLD_NOW)
#define free_clib(lib) dlclose((lib))
#define symbol_clib(lib, sym) dlsym((lib), (sym))
#define error_clib dlerror
#endif
char *get_processed_name(const char *name);
#define RETRY_EINTR(RC, CALL) do { (RC) = CALL; } while((RC) < 0 && errno == EINTR)
/* Initialize builtin libraries */
@@ -159,5 +202,8 @@ void janet_lib_ev(JanetTable *env);
void janet_ev_mark(void);
int janet_make_pipe(JanetHandle handles[2], int mode);
#endif
#ifdef JANET_FFI
void janet_lib_ffi(JanetTable *env);
#endif
#endif

View File

@@ -1,5 +1,5 @@
/*
* Copyright (c) 2022 Calvin Rose
* Copyright (c) 2023 Calvin Rose
*
* Permission is hereby granted, free of charge, to any person obtaining a copy
* of this software and associated documentation files (the "Software"), to
@@ -272,6 +272,7 @@ int janet_equals(Janet x, Janet y) {
const Janet *t1 = janet_unwrap_tuple(x);
const Janet *t2 = janet_unwrap_tuple(y);
if (t1 == t2) break;
if (JANET_TUPLE_FLAG_BRACKETCTOR & (janet_tuple_flag(t1) ^ janet_tuple_flag(t2))) return 0;
if (janet_tuple_hash(t1) != janet_tuple_hash(t2)) return 0;
if (janet_tuple_length(t1) != janet_tuple_length(t2)) return 0;
push_traversal_node(janet_tuple_head(t1), janet_tuple_head(t2), 0);
@@ -295,6 +296,15 @@ int janet_equals(Janet x, Janet y) {
return 1;
}
static uint64_t murmur64(uint64_t h) {
h ^= h >> 33;
h *= 0xff51afd7ed558ccdUL;
h ^= h >> 33;
h *= 0xc4ceb9fe1a85ec53UL;
h ^= h >> 33;
return h;
}
/* Computes a hash value for a function */
int32_t janet_hash(Janet x) {
int32_t hash = 0;
@@ -312,6 +322,7 @@ int32_t janet_hash(Janet x) {
break;
case JANET_TUPLE:
hash = janet_tuple_hash(janet_unwrap_tuple(x));
hash += (janet_tuple_flag(janet_unwrap_tuple(x)) & JANET_TUPLE_FLAG_BRACKETCTOR) ? 1 : 0;
break;
case JANET_STRUCT:
hash = janet_struct_hash(janet_unwrap_struct(x));
@@ -341,14 +352,11 @@ int32_t janet_hash(Janet x) {
default:
if (sizeof(double) == sizeof(void *)) {
/* Assuming 8 byte pointer (8 byte aligned) */
uint64_t i = janet_u64(x);
uint32_t lo = (uint32_t)(i & 0xFFFFFFFF);
uint32_t hi = (uint32_t)(i >> 32);
uint32_t hilo = (hi ^ lo) * 2654435769u;
hash = (int32_t)((hilo << 16) | (hilo >> 16));
uint64_t i = murmur64(janet_u64(x));
hash = (int32_t)(i >> 32);
} else {
/* Assuming 4 byte pointer (or smaller) */
ptrdiff_t diff = ((char *)janet_unwrap_pointer(x) - (char *)0);
uintptr_t diff = (uintptr_t) janet_unwrap_pointer(x);
uint32_t hilo = (uint32_t) diff * 2654435769u;
hash = (int32_t)((hilo << 16) | (hilo >> 16));
}
@@ -406,6 +414,9 @@ int janet_compare(Janet x, Janet y) {
case JANET_TUPLE: {
const Janet *lhs = janet_unwrap_tuple(x);
const Janet *rhs = janet_unwrap_tuple(y);
if (JANET_TUPLE_FLAG_BRACKETCTOR & (janet_tuple_flag(lhs) ^ janet_tuple_flag(rhs))) {
return (janet_tuple_flag(lhs) & JANET_TUPLE_FLAG_BRACKETCTOR) ? 1 : -1;
}
push_traversal_node(janet_tuple_head(lhs), janet_tuple_head(rhs), 1);
break;
}
@@ -428,20 +439,21 @@ int janet_compare(Janet x, Janet y) {
return status - 2;
}
static int32_t getter_checkint(Janet key, int32_t max) {
static int32_t getter_checkint(JanetType type, Janet key, int32_t max) {
if (!janet_checkint(key)) goto bad;
int32_t ret = janet_unwrap_integer(key);
if (ret < 0) goto bad;
if (ret >= max) goto bad;
return ret;
bad:
janet_panicf("expected integer key in range [0, %d), got %v", max, key);
janet_panicf("expected integer key for %s in range [0, %d), got %v", janet_type_names[type], max, key);
}
/* Gets a value and returns. Can panic. */
Janet janet_in(Janet ds, Janet key) {
Janet value;
switch (janet_type(ds)) {
JanetType type = janet_type(ds);
switch (type) {
default:
janet_panicf("expected %T, got %v", JANET_TFLAG_LENGTHABLE, ds);
break;
@@ -453,19 +465,19 @@ Janet janet_in(Janet ds, Janet key) {
break;
case JANET_ARRAY: {
JanetArray *array = janet_unwrap_array(ds);
int32_t index = getter_checkint(key, array->count);
int32_t index = getter_checkint(type, key, array->count);
value = array->data[index];
break;
}
case JANET_TUPLE: {
const Janet *tuple = janet_unwrap_tuple(ds);
int32_t len = janet_tuple_length(tuple);
value = tuple[getter_checkint(key, len)];
value = tuple[getter_checkint(type, key, len)];
break;
}
case JANET_BUFFER: {
JanetBuffer *buffer = janet_unwrap_buffer(ds);
int32_t index = getter_checkint(key, buffer->count);
int32_t index = getter_checkint(type, key, buffer->count);
value = janet_wrap_integer(buffer->data[index]);
break;
}
@@ -473,7 +485,7 @@ Janet janet_in(Janet ds, Janet key) {
case JANET_SYMBOL:
case JANET_KEYWORD: {
const uint8_t *str = janet_unwrap_string(ds);
int32_t index = getter_checkint(key, janet_string_length(str));
int32_t index = getter_checkint(type, key, janet_string_length(str));
value = janet_wrap_integer(str[index]);
break;
}
@@ -645,6 +657,15 @@ int32_t janet_length(Janet x) {
case JANET_TABLE:
return janet_unwrap_table(x)->count;
case JANET_ABSTRACT: {
void *abst = janet_unwrap_abstract(x);
const JanetAbstractType *type = janet_abstract_type(abst);
if (type->length != NULL) {
size_t len = type->length(abst, janet_abstract_size(abst));
if (len > INT32_MAX) {
janet_panicf("invalid integer length %u", len);
}
return (int32_t)(len);
}
Janet argv[1] = { x };
Janet len = janet_mcall("length", 1, argv);
if (!janet_checkint(len))
@@ -673,6 +694,21 @@ Janet janet_lengthv(Janet x) {
case JANET_TABLE:
return janet_wrap_integer(janet_unwrap_table(x)->count);
case JANET_ABSTRACT: {
void *abst = janet_unwrap_abstract(x);
const JanetAbstractType *type = janet_abstract_type(abst);
if (type->length != NULL) {
size_t len = type->length(abst, janet_abstract_size(abst));
/* 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);
}
@@ -722,13 +758,14 @@ void janet_putindex(Janet ds, int32_t index, Janet value) {
}
void janet_put(Janet ds, Janet key, Janet value) {
switch (janet_type(ds)) {
JanetType type = janet_type(ds);
switch (type) {
default:
janet_panicf("expected %T, got %v",
JANET_TFLAG_ARRAY | JANET_TFLAG_BUFFER | JANET_TFLAG_TABLE, ds);
case JANET_ARRAY: {
JanetArray *array = janet_unwrap_array(ds);
int32_t index = getter_checkint(key, INT32_MAX - 1);
int32_t index = getter_checkint(type, key, INT32_MAX - 1);
if (index >= array->count) {
janet_array_setcount(array, index + 1);
}
@@ -737,7 +774,7 @@ void janet_put(Janet ds, Janet key, Janet value) {
}
case JANET_BUFFER: {
JanetBuffer *buffer = janet_unwrap_buffer(ds);
int32_t index = getter_checkint(key, INT32_MAX - 1);
int32_t index = getter_checkint(type, key, INT32_MAX - 1);
if (!janet_checkint(value))
janet_panicf("can only put integers in buffers, got %v", value);
if (index >= buffer->count) {

View File

@@ -1,5 +1,5 @@
/*
* Copyright (c) 2022 Calvin Rose
* Copyright (c) 2023 Calvin Rose
*
* Permission is hereby granted, free of charge, to any person obtaining a copy
* of this software and associated documentation files (the "Software"), to
@@ -40,7 +40,7 @@ void *janet_v_grow(void *v, int32_t increment, int32_t itemsize) {
/* Convert a buffer to normal allocated memory (forget capacity) */
void *janet_v_flattenmem(void *v, int32_t itemsize) {
int32_t *p;
char *p;
if (NULL == v) return NULL;
size_t size = (size_t) itemsize * janet_v__cnt(v);
p = janet_malloc(size);

View File

@@ -1,5 +1,5 @@
/*
* Copyright (c) 2022 Calvin Rose
* Copyright (c) 2023 Calvin Rose
*
* Permission is hereby granted, free of charge, to any person obtaining a copy
* of this software and associated documentation files (the "Software"), to

View File

@@ -1,5 +1,5 @@
/*
* Copyright (c) 2022 Calvin Rose
* Copyright (c) 2023 Calvin Rose
*
* Permission is hereby granted, free of charge, to any person obtaining a copy
* of this software and associated documentation files (the "Software"), to
@@ -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];\
@@ -220,14 +225,14 @@
/* Trace a function call */
static void vm_do_trace(JanetFunction *func, int32_t argc, const Janet *argv) {
if (func->def->name) {
janet_printf("trace (%S", func->def->name);
janet_eprintf("trace (%S", func->def->name);
} else {
janet_printf("trace (%p", janet_wrap_function(func));
janet_eprintf("trace (%p", janet_wrap_function(func));
}
for (int32_t i = 0; i < argc; i++) {
janet_printf(" %p", argv[i]);
janet_eprintf(" %p", argv[i]);
}
janet_printf(")\n");
janet_eprintf(")\n");
}
/* Invoke a method once we have looked it up */
@@ -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)
@@ -918,7 +960,7 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in) {
int32_t i;
for (i = 0; i < elen; ++i) {
int32_t inherit = fd->environments[i];
if (inherit == -1) {
if (inherit == -1 || inherit >= func->def->environments_length) {
JanetStackFrame *frame = janet_stack_frame(stack);
if (!frame->env) {
/* Lazy capture of current stack frame */
@@ -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",
@@ -1285,6 +1327,12 @@ JanetSignal janet_step(JanetFiber *fiber, Janet in, Janet *out) {
return signal;
}
static Janet void_cfunction(int32_t argc, Janet *argv) {
(void) argc;
(void) argv;
janet_panic("placeholder");
}
Janet janet_call(JanetFunction *fun, int32_t argc, const Janet *argv) {
/* Check entry conditions */
if (!janet_vm.fiber)
@@ -1292,9 +1340,17 @@ Janet janet_call(JanetFunction *fun, int32_t argc, const Janet *argv) {
if (janet_vm.stackn >= JANET_RECURSION_GUARD)
janet_panic("C stack recursed too deeply");
/* Dirty stack */
int32_t dirty_stack = janet_vm.fiber->stacktop - janet_vm.fiber->stackstart;
if (dirty_stack) {
janet_fiber_cframe(janet_vm.fiber, void_cfunction);
}
/* Tracing */
if (fun->gc.flags & JANET_FUNCFLAG_TRACE) {
janet_vm.stackn++;
vm_do_trace(fun, argc, argv);
janet_vm.stackn--;
}
/* Push frame */
@@ -1322,6 +1378,10 @@ Janet janet_call(JanetFunction *fun, int32_t argc, const Janet *argv) {
/* Teardown */
janet_vm.stackn = oldn;
janet_gcunlock(handle);
if (dirty_stack) {
janet_fiber_popframe(janet_vm.fiber);
janet_vm.fiber->stacktop += dirty_stack;
}
if (signal != JANET_SIGNAL_OK) {
janet_panicv(*janet_vm.return_reg);
@@ -1405,6 +1465,7 @@ static JanetSignal janet_continue_no_check(JanetFiber *fiber, Janet in, Janet *o
if (sig != JANET_SIGNAL_OK && !(child->flags & (1 << sig))) {
*out = in;
janet_fiber_set_status(fiber, sig);
fiber->last_value = child->last_value;
return sig;
}
/* Check if we need any special handling for certain opcodes */
@@ -1498,7 +1559,7 @@ JanetSignal janet_pcall(
fiber = janet_fiber(fun, 64, argc, argv);
}
if (f) *f = fiber;
if (!fiber) {
if (NULL == fiber) {
*out = janet_cstringv("arity mismatch");
return JANET_SIGNAL_ERROR;
}
@@ -1524,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();
@@ -1541,6 +1604,9 @@ int janet_init(void) {
janet_vm.scratch_len = 0;
janet_vm.scratch_cap = 0;
/* Sandbox flags */
janet_vm.sandbox_flags = 0;
/* Initialize registry */
janet_vm.registry = NULL;
janet_vm.registry_cap = 0;
@@ -1582,6 +1648,18 @@ int janet_init(void) {
return 0;
}
/* Disable some features at runtime with no way to re-enable them */
void janet_sandbox(uint32_t flags) {
janet_sandbox_assert(JANET_SANDBOX_SANDBOX);
janet_vm.sandbox_flags |= flags;
}
void janet_sandbox_assert(uint32_t forbidden_flags) {
if (forbidden_flags & janet_vm.sandbox_flags) {
janet_panic("operation forbidden by sandbox");
}
}
/* Clear all memory associated with the VM */
void janet_deinit(void) {
janet_clear_memory();

View File

@@ -1,5 +1,5 @@
/*
* Copyright (c) 2022 Calvin Rose
* Copyright (c) 2023 Calvin Rose
*
* Permission is hereby granted, free of charge, to any person obtaining a copy
* of this software and associated documentation files (the "Software"), to
@@ -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

@@ -1,5 +1,5 @@
/*
* Copyright (c) 2022 Calvin Rose
* Copyright (c) 2023 Calvin Rose
*
* Permission is hereby granted, free of charge, to any person obtaining a copy
* of this software and associated documentation files (the "Software"), to
@@ -67,6 +67,11 @@ extern "C" {
#define JANET_LINUX 1
#endif
/* Check for Cygwin */
#if defined(__CYGWIN__)
#define JANET_CYGWIN 1
#endif
/* Check Unix */
#if defined(_AIX) \
|| defined(__APPLE__) /* Darwin */ \
@@ -87,6 +92,16 @@ extern "C" {
#define JANET_WINDOWS 1
#endif
/* Check if compiling with MSVC - else assume a GCC-like compiler by default */
#ifdef _MSC_VER
#define JANET_MSVC
#endif
/* Check Mingw 32-bit and 64-bit */
#ifdef __MINGW32__
#define JANET_MINGW
#endif
/* Check 64-bit vs 32-bit */
#if ((defined(__x86_64__) || defined(_M_X64)) \
&& (defined(JANET_POSIX) || defined(JANET_WINDOWS))) \
@@ -96,7 +111,8 @@ extern "C" {
|| (defined(__sparc__) && defined(__arch64__) || defined (__sparcv9)) /* BE */ \
|| defined(__s390x__) /* S390 64-bit (BE) */ \
|| (defined(__ppc64__) || defined(__PPC64__)) \
|| defined(__aarch64__) /* ARM 64-bit */
|| defined(__aarch64__) /* ARM 64-bit */ \
|| (defined(__riscv) && (__riscv_xlen == 64)) /* RISC-V 64-bit */
#define JANET_64 1
#else
#define JANET_32 1
@@ -163,6 +179,21 @@ extern "C" {
#define JANET_DYNAMIC_MODULES
#endif
/* Enable or disable the FFI library. Currently, FFI only enabled on
* x86-64 operating systems. */
#ifndef JANET_NO_FFI
#if !defined(__EMSCRIPTEN__)
#define JANET_FFI
#endif
#endif
/* If FFI is enabled and FFI-JIT is not disabled... */
#ifdef JANET_FFI
#ifndef JANET_NO_FFI_JIT
#define JANET_FFI_JIT
#endif
#endif
/* Enable or disable the assembler. Enabled by default. */
#ifndef JANET_NO_ASSEMBLER
#define JANET_ASSEMBLER
@@ -203,10 +234,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
@@ -228,7 +277,7 @@ extern "C" {
/* Maximum depth to follow table prototypes before giving up and returning nil. */
#define JANET_MAX_PROTO_DEPTH 200
/* Maximum depth to follow table prototypes before giving up and returning nil. */
/* Prevent macros to expand too deeply and error out. */
#define JANET_MAX_MACRO_EXPAND 200
/* Define default max stack size for stacks before raising a stack overflow error.
@@ -249,10 +298,11 @@ extern "C" {
#ifndef JANET_NO_NANBOX
#ifdef JANET_32
#define JANET_NANBOX_32
#elif defined(__x86_64__) || defined(_WIN64)
#elif defined(__x86_64__) || defined(_WIN64) || defined(__riscv)
/* We will only enable nanboxing by default on 64 bit systems
* on x86. This is mainly because the approach is tied to the
* implicit 47 bit address space. */
* for x64 and risc-v. This is mainly because the approach is tied to the
* implicit 47 bit address space. Many arches allow/require this, but not all,
* and it requires cooperation from the OS. ARM should also work in many configurations. */
#define JANET_NANBOX_64
#endif
#endif
@@ -299,10 +349,10 @@ typedef struct {
JANET_CURRENT_CONFIG_BITS })
#endif
/* What to do when out of memory */
#ifndef JANET_OUT_OF_MEMORY
#include <stdio.h>
#define JANET_OUT_OF_MEMORY do { fprintf(stderr, "janet out of memory\n"); exit(1); } while (0)
/* Some extra includes if EV is enabled */
#ifdef JANET_EV
typedef struct JanetOSMutex JanetOSMutex;
typedef struct JanetOSRWLock JanetOSRWLock;
#endif
/***** END SECTION CONFIG *****/
@@ -322,23 +372,9 @@ typedef struct {
#include <stddef.h>
#include <stdio.h>
/* Some extra includes if EV is enabled */
#ifdef JANET_EV
#ifdef JANET_WINDOWS
typedef struct JanetDudCriticalSection {
/* Avoid including windows.h here - instead, create a structure of the same size */
/* Needs to be same size as crtical section see WinNT.h for CRITCIAL_SECTION definition */
void *debug_info;
long lock_count;
long recursion_count;
void *owning_thread;
void *lock_semaphore;
unsigned long spin_count;
} JanetOSMutex;
#else
#include <pthread.h>
typedef pthread_mutex_t JanetOSMutex;
#endif
/* What to do when out of memory */
#ifndef JANET_OUT_OF_MEMORY
#define JANET_OUT_OF_MEMORY do { fprintf(stderr, "%s:%d - janet out of memory\n", __FILE__, __LINE__); exit(1); } while (0)
#endif
#ifdef JANET_BSD
@@ -375,12 +411,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,
@@ -430,6 +465,7 @@ typedef struct JanetReg JanetReg;
typedef struct JanetRegExt JanetRegExt;
typedef struct JanetMethod JanetMethod;
typedef struct JanetSourceMapping JanetSourceMapping;
typedef struct JanetSymbolMap JanetSymbolMap;
typedef struct JanetView JanetView;
typedef struct JanetByteView JanetByteView;
typedef struct JanetDictView JanetDictView;
@@ -543,69 +579,74 @@ 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
#define JANET_STREAM_UDPSERVER 0x1000
#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);
#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);
/* 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
@@ -633,10 +674,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. */
@@ -645,16 +686,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);
@@ -667,18 +708,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);
@@ -710,6 +751,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);
@@ -756,14 +798,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))
@@ -805,15 +847,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)
@@ -828,15 +870,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)
@@ -848,11 +890,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))
@@ -865,7 +911,7 @@ struct JanetGCObject {
int32_t flags;
union {
JanetGCObject *next;
int32_t refcount; /* For threaded abstract types */
volatile JanetAtomicInt refcount; /* For threaded abstract types */
} data;
};
@@ -888,8 +934,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
};
@@ -984,6 +1032,7 @@ struct JanetAbstractHead {
/* Some function definition flags */
#define JANET_FUNCDEF_FLAG_VARARG 0x10000
#define JANET_FUNCDEF_FLAG_NEEDSENV 0x20000
#define JANET_FUNCDEF_FLAG_HASSYMBOLMAP 0x40000
#define JANET_FUNCDEF_FLAG_HASNAME 0x80000
#define JANET_FUNCDEF_FLAG_HASSOURCE 0x100000
#define JANET_FUNCDEF_FLAG_HASDEFS 0x200000
@@ -999,6 +1048,14 @@ struct JanetSourceMapping {
int32_t column;
};
/* Symbol to slot mapping & lifetime structure. */
struct JanetSymbolMap {
uint32_t birth_pc;
uint32_t death_pc;
uint32_t slot_index;
const uint8_t *symbol;
};
/* A function definition. Contains information needed to instantiate closures. */
struct JanetFuncDef {
JanetGCObject gc;
@@ -1012,6 +1069,7 @@ struct JanetFuncDef {
JanetSourceMapping *sourcemap;
JanetString source;
JanetString name;
JanetSymbolMap *symbolmap;
int32_t flags;
int32_t slotcount; /* The amount of stack space required for the function */
@@ -1022,6 +1080,7 @@ struct JanetFuncDef {
int32_t bytecode_length;
int32_t environments_length;
int32_t defs_length;
int32_t symbolmap_length;
};
/* A function environment */
@@ -1097,6 +1156,8 @@ struct JanetAbstractType {
int32_t (*hash)(void *p, size_t len);
Janet(*next)(void *p, Janet key);
Janet(*call)(void *p, int32_t argc, Janet *argv);
size_t (*length)(void *p, size_t len);
JanetByteView(*bytes)(void *p, size_t len);
};
/* Some macros to let us add extra types to JanetAbstract types without
@@ -1114,7 +1175,9 @@ struct JanetAbstractType {
#define JANET_ATEND_COMPARE NULL,JANET_ATEND_HASH
#define JANET_ATEND_HASH NULL,JANET_ATEND_NEXT
#define JANET_ATEND_NEXT NULL,JANET_ATEND_CALL
#define JANET_ATEND_CALL
#define JANET_ATEND_CALL NULL,JANET_ATEND_LENGTH
#define JANET_ATEND_LENGTH NULL,JANET_ATEND_BYTES
#define JANET_ATEND_BYTES
struct JanetReg {
const char *name;
@@ -1180,17 +1243,6 @@ typedef struct {
Janet payload;
} JanetTryState;
/* Thread types */
#ifdef JANET_THREADS
typedef struct JanetThread JanetThread;
typedef struct JanetMailbox JanetMailbox;
struct JanetThread {
JanetMailbox *mailbox;
JanetTable *encode;
};
#endif
/***** END SECTION TYPES *****/
/***** START SECTION OPCODES *****/
@@ -1234,11 +1286,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,
@@ -1358,9 +1412,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);
@@ -1379,11 +1431,19 @@ JANET_API void *janet_abstract_threaded(const JanetAbstractType *atype, size_t s
JANET_API int32_t janet_abstract_incref(void *abst);
JANET_API int32_t janet_abstract_decref(void *abst);
/* Expose some OS sync primitives to make portable abstract types easier to implement */
/* Expose some OS sync primitives */
JANET_API size_t janet_os_mutex_size(void);
JANET_API size_t janet_os_rwlock_size(void);
JANET_API void janet_os_mutex_init(JanetOSMutex *mutex);
JANET_API void janet_os_mutex_deinit(JanetOSMutex *mutex);
JANET_API void janet_os_mutex_lock(JanetOSMutex *mutex);
JANET_API void janet_os_mutex_unlock(JanetOSMutex *mutex);
JANET_API void janet_os_rwlock_init(JanetOSRWLock *rwlock);
JANET_API void janet_os_rwlock_deinit(JanetOSRWLock *rwlock);
JANET_API void janet_os_rwlock_rlock(JanetOSRWLock *rwlock);
JANET_API void janet_os_rwlock_wlock(JanetOSRWLock *rwlock);
JANET_API void janet_os_rwlock_runlock(JanetOSRWLock *rwlock);
JANET_API void janet_os_rwlock_wunlock(JanetOSRWLock *rwlock);
/* Get last error from an IO operation */
JANET_API Janet janet_ev_lasterr(void);
@@ -1440,22 +1500,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_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
@@ -1544,6 +1604,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);
@@ -1552,8 +1613,10 @@ JANET_API Janet janet_array_pop(JanetArray *array);
JANET_API Janet janet_array_peek(JanetArray *array);
/* Buffer functions */
#define JANET_BUFFER_FLAG_NO_REALLOC 0x10000
JANET_API JanetBuffer *janet_buffer(int32_t capacity);
JANET_API JanetBuffer *janet_buffer_init(JanetBuffer *buffer, int32_t capacity);
JANET_API JanetBuffer *janet_pointer_buffer_unsafe(void *memory, int32_t capacity, int32_t count);
JANET_API void janet_buffer_deinit(JanetBuffer *buffer);
JANET_API void janet_buffer_ensure(JanetBuffer *buffer, int32_t capacity, int32_t growth);
JANET_API void janet_buffer_setcount(JanetBuffer *buffer, int32_t count);
@@ -1571,7 +1634,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)
@@ -1617,7 +1680,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)
@@ -1652,6 +1715,7 @@ JANET_API void janet_table_clear(JanetTable *table);
JANET_API JanetFiber *janet_fiber(JanetFunction *callee, int32_t capacity, int32_t argc, const Janet *argv);
JANET_API JanetFiber *janet_fiber_reset(JanetFiber *fiber, JanetFunction *callee, int32_t argc, const Janet *argv);
JANET_API JanetFiberStatus janet_fiber_status(JanetFiber *fiber);
JANET_API int janet_fiber_can_resume(JanetFiber *fiber);
JANET_API JanetFiber *janet_current_fiber(void);
JANET_API JanetFiber *janet_root_fiber(void);
@@ -1678,6 +1742,7 @@ JANET_API JanetModule janet_native(const char *name, JanetString *error);
/* Marshaling */
#define JANET_MARSHAL_UNSAFE 0x20000
#define JANET_MARSHAL_NO_CYCLES 0x40000
JANET_API void janet_marshal(
JanetBuffer *buf,
@@ -1756,6 +1821,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);
@@ -1765,6 +1831,28 @@ JANET_API Janet janet_mcall(const char *name, int32_t argc, Janet *argv);
JANET_API void janet_stacktrace(JanetFiber *fiber, Janet err);
JANET_API void janet_stacktrace_ext(JanetFiber *fiber, Janet err, const char *prefix);
/* Sandboxing API */
#define JANET_SANDBOX_SANDBOX 1
#define JANET_SANDBOX_SUBPROCESS 2
#define JANET_SANDBOX_NET_CONNECT 4
#define JANET_SANDBOX_NET_LISTEN 8
#define JANET_SANDBOX_FFI_DEFINE 16
#define JANET_SANDBOX_FS_WRITE 32
#define JANET_SANDBOX_FS_READ 64
#define JANET_SANDBOX_HRTIME 128
#define JANET_SANDBOX_ENV 256
#define JANET_SANDBOX_DYNAMIC_MODULES 512
#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)
#define JANET_SANDBOX_ALL (UINT32_MAX)
JANET_API void janet_sandbox(uint32_t flags);
JANET_API void janet_sandbox_assert(uint32_t forbidden_flags);
/* Scratch Memory API */
typedef void (*JanetScratchFinalizer)(void *);
@@ -1823,7 +1911,7 @@ JANET_API Janet janet_resolve_core(const char *name);
/* sourcemaps only */
#define JANET_REG_S(JNAME, CNAME) {JNAME, CNAME, NULL, __FILE__, CNAME##_sourceline_}
#define JANET_FN_S(CNAME, USAGE, DOCSTRING) \
static int32_t CNAME##_sourceline_ = __LINE__; \
static const int32_t CNAME##_sourceline_ = __LINE__; \
Janet CNAME (int32_t argc, Janet *argv)
#define JANET_DEF_S(ENV, JNAME, VAL, DOC) \
janet_def_sm(ENV, JNAME, VAL, NULL, __FILE__, __LINE__)
@@ -1839,13 +1927,12 @@ JANET_API Janet janet_resolve_core(const char *name);
/* sourcemaps and docstrings */
#define JANET_REG_SD(JNAME, CNAME) {JNAME, CNAME, CNAME##_docstring_, __FILE__, CNAME##_sourceline_}
#define JANET_FN_SD(CNAME, USAGE, DOCSTRING) \
static int32_t CNAME##_sourceline_ = __LINE__; \
static const int32_t CNAME##_sourceline_ = __LINE__; \
static const char CNAME##_docstring_[] = USAGE "\n\n" DOCSTRING; \
Janet CNAME (int32_t argc, Janet *argv)
#define JANET_DEF_SD(ENV, JNAME, VAL, DOC) \
janet_def_sm(ENV, JNAME, VAL, DOC, __FILE__, __LINE__)
/* Choose defaults for source mapping and docstring based on config defs */
#if defined(JANET_NO_SOURCEMAPS) && defined(JANET_NO_DOCSTRINGS)
#define JANET_REG JANET_REG_
@@ -1882,10 +1969,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
@@ -1913,6 +2000,7 @@ JANET_API JanetTable *janet_gettable(const Janet *argv, int32_t n);
JANET_API JanetStruct janet_getstruct(const Janet *argv, int32_t n);
JANET_API JanetString janet_getstring(const Janet *argv, int32_t n);
JANET_API const char *janet_getcstring(const Janet *argv, int32_t n);
JANET_API const char *janet_getcbytes(const Janet *argv, int32_t n);
JANET_API JanetSymbol janet_getsymbol(const Janet *argv, int32_t n);
JANET_API JanetKeyword janet_getkeyword(const Janet *argv, int32_t n);
JANET_API JanetBuffer *janet_getbuffer(const Janet *argv, int32_t n);
@@ -1925,6 +2013,7 @@ JANET_API void *janet_getpointer(const Janet *argv, int32_t n);
JANET_API int32_t janet_getnat(const Janet *argv, int32_t n);
JANET_API int32_t janet_getinteger(const Janet *argv, int32_t n);
JANET_API int64_t janet_getinteger64(const Janet *argv, int32_t n);
JANET_API uint64_t janet_getuinteger64(const Janet *argv, int32_t n);
JANET_API size_t janet_getsize(const Janet *argv, int32_t n);
JANET_API JanetView janet_getindexed(const Janet *argv, int32_t n);
JANET_API JanetByteView janet_getbytes(const Janet *argv, int32_t n);
@@ -1932,6 +2021,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);
@@ -1941,6 +2032,7 @@ JANET_API JanetTuple janet_opttuple(const Janet *argv, int32_t argc, int32_t n,
JANET_API JanetStruct janet_optstruct(const Janet *argv, int32_t argc, int32_t n, JanetStruct dflt);
JANET_API JanetString janet_optstring(const Janet *argv, int32_t argc, int32_t n, JanetString dflt);
JANET_API const char *janet_optcstring(const Janet *argv, int32_t argc, int32_t n, const char *dflt);
JANET_API const char *janet_optcbytes(const Janet *argv, int32_t argc, int32_t n, const char *dflt);
JANET_API JanetSymbol janet_optsymbol(const Janet *argv, int32_t argc, int32_t n, JanetString dflt);
JANET_API JanetKeyword janet_optkeyword(const Janet *argv, int32_t argc, int32_t n, JanetString dflt);
JANET_API JanetFiber *janet_optfiber(const Janet *argv, int32_t argc, int32_t n, JanetFiber *dflt);
@@ -1972,7 +2064,6 @@ extern JANET_API const JanetAbstractType janet_file_type;
#define JANET_FILE_CLOSED 32
#define JANET_FILE_BINARY 64
#define JANET_FILE_SERIALIZABLE 128
#define JANET_FILE_PIPED 256
#define JANET_FILE_NONIL 512
JANET_API Janet janet_makefile(FILE *f, int32_t flags);
@@ -1990,6 +2081,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);
@@ -1999,10 +2091,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);
@@ -2079,16 +2173,6 @@ JANET_API int janet_scan_uint64(const uint8_t *str, int32_t len, uint64_t *out);
#endif
#ifdef JANET_THREADS
extern JANET_API const JanetAbstractType janet_thread_type;
JANET_API int janet_thread_receive(Janet *msg_out, double timeout);
JANET_API int janet_thread_send(JanetThread *thread, Janet msg, double timeout);
JANET_API JanetThread *janet_thread_current(void);
#endif
/* Custom allocator support */
JANET_API void *(janet_malloc)(size_t);
JANET_API void *(janet_realloc)(void *, size_t);

View File

@@ -1,5 +1,5 @@
/*
* Copyright (c) 2022 Calvin Rose
* Copyright (c) 2023 Calvin Rose
*
* Permission is hereby granted, free of charge, to any person obtaining a copy
* of this software and associated documentation files (the "Software"), to
@@ -33,6 +33,9 @@
#ifndef ENABLE_VIRTUAL_TERMINAL_PROCESSING
#define ENABLE_VIRTUAL_TERMINAL_PROCESSING 0x0004
#endif
#ifndef ENABLE_VIRTUAL_TERMINAL_INPUT
#define ENABLE_VIRTUAL_TERMINAL_INPUT 0x0200
#endif
#endif
void janet_line_init();
@@ -87,8 +90,30 @@ static void simpleline(JanetBuffer *buffer) {
}
}
/* Windows */
#if defined(JANET_WINDOWS) || defined(JANET_SIMPLE_GETLINE)
/* State */
#ifndef JANET_SIMPLE_GETLINE
/* static state */
#define JANET_LINE_MAX 1024
#define JANET_MATCH_MAX 256
#define JANET_HISTORY_MAX 100
static JANET_THREAD_LOCAL int gbl_israwmode = 0;
static JANET_THREAD_LOCAL const char *gbl_prompt = "> ";
static JANET_THREAD_LOCAL int gbl_plen = 2;
static JANET_THREAD_LOCAL char gbl_buf[JANET_LINE_MAX];
static JANET_THREAD_LOCAL int gbl_len = 0;
static JANET_THREAD_LOCAL int gbl_pos = 0;
static JANET_THREAD_LOCAL int gbl_cols = 80;
static JANET_THREAD_LOCAL char *gbl_history[JANET_HISTORY_MAX];
static JANET_THREAD_LOCAL int gbl_history_count = 0;
static JANET_THREAD_LOCAL int gbl_historyi = 0;
static JANET_THREAD_LOCAL JanetByteView gbl_matches[JANET_MATCH_MAX];
static JANET_THREAD_LOCAL int gbl_match_count = 0;
static JANET_THREAD_LOCAL int gbl_lines_below = 0;
#endif
/* Fallback */
#if defined(JANET_SIMPLE_GETLINE)
void janet_line_init() {
;
@@ -105,6 +130,83 @@ void janet_line_get(const char *p, JanetBuffer *buffer) {
simpleline(buffer);
}
/* Rich implementation */
#else
/* Windows */
#ifdef _WIN32
#include <stdbool.h>
#include <stdio.h>
#include <stdlib.h>
#include <io.h>
static void setup_console_output(void) {
/* Enable color console on windows 10 console and utf8 output and other processing */
HANDLE hOut = GetStdHandle(STD_OUTPUT_HANDLE);
DWORD dwMode = 0;
GetConsoleMode(hOut, &dwMode);
dwMode |= ENABLE_VIRTUAL_TERMINAL_PROCESSING;
dwMode |= ENABLE_PROCESSED_OUTPUT;
SetConsoleMode(hOut, dwMode);
if (IsValidCodePage(65001)) {
SetConsoleOutputCP(65001);
}
}
/* Ansi terminal raw mode */
static int rawmode(void) {
if (gbl_israwmode) return 0;
HANDLE hOut = GetStdHandle(STD_INPUT_HANDLE);
DWORD dwMode = 0;
GetConsoleMode(hOut, &dwMode);
dwMode &= ~ENABLE_LINE_INPUT;
dwMode &= ~ENABLE_INSERT_MODE;
dwMode &= ~ENABLE_ECHO_INPUT;
dwMode |= ENABLE_VIRTUAL_TERMINAL_INPUT;
dwMode &= ~ENABLE_PROCESSED_INPUT;
if (!SetConsoleMode(hOut, dwMode)) return 1;
gbl_israwmode = 1;
return 0;
}
/* Disable raw mode */
static void norawmode(void) {
if (!gbl_israwmode) return;
HANDLE hOut = GetStdHandle(STD_INPUT_HANDLE);
DWORD dwMode = 0;
GetConsoleMode(hOut, &dwMode);
dwMode |= ENABLE_LINE_INPUT;
dwMode |= ENABLE_INSERT_MODE;
dwMode |= ENABLE_ECHO_INPUT;
dwMode &= ~ENABLE_VIRTUAL_TERMINAL_INPUT;
dwMode |= ENABLE_PROCESSED_INPUT;
SetConsoleMode(hOut, dwMode);
gbl_israwmode = 0;
}
static long write_console(const char *bytes, size_t n) {
DWORD nwritten = 0;
BOOL result = WriteConsole(GetStdHandle(STD_OUTPUT_HANDLE), bytes, (DWORD) n, &nwritten, NULL);
if (!result) return -1; /* error */
return (long)nwritten;
}
static long read_console(char *into, size_t n) {
DWORD numread;
BOOL result = ReadConsole(GetStdHandle(STD_INPUT_HANDLE), into, (DWORD) n, &numread, NULL);
if (!result) return -1; /* error */
return (long)numread;
}
static int check_simpleline(JanetBuffer *buffer) {
if (!_isatty(_fileno(stdin)) || rawmode()) {
simpleline(buffer);
return 1;
}
return 0;
}
/* Posix */
#else
@@ -125,24 +227,7 @@ https://github.com/antirez/linenoise/blob/master/linenoise.c
#include <string.h>
#include <signal.h>
/* static state */
#define JANET_LINE_MAX 1024
#define JANET_MATCH_MAX 256
#define JANET_HISTORY_MAX 100
static JANET_THREAD_LOCAL int gbl_israwmode = 0;
static JANET_THREAD_LOCAL const char *gbl_prompt = "> ";
static JANET_THREAD_LOCAL int gbl_plen = 2;
static JANET_THREAD_LOCAL char gbl_buf[JANET_LINE_MAX];
static JANET_THREAD_LOCAL int gbl_len = 0;
static JANET_THREAD_LOCAL int gbl_pos = 0;
static JANET_THREAD_LOCAL int gbl_cols = 80;
static JANET_THREAD_LOCAL char *gbl_history[JANET_HISTORY_MAX];
static JANET_THREAD_LOCAL int gbl_history_count = 0;
static JANET_THREAD_LOCAL int gbl_historyi = 0;
static JANET_THREAD_LOCAL struct termios gbl_termios_start;
static JANET_THREAD_LOCAL JanetByteView gbl_matches[JANET_MATCH_MAX];
static JANET_THREAD_LOCAL int gbl_match_count = 0;
static JANET_THREAD_LOCAL int gbl_lines_below = 0;
/* Unsupported terminal list from linenoise */
static const char *badterms[] = {
@@ -152,15 +237,6 @@ static const char *badterms[] = {
NULL
};
static char *sdup(const char *s) {
size_t len = strlen(s) + 1;
char *mem = janet_malloc(len);
if (!mem) {
return NULL;
}
return memcpy(mem, s, len);
}
/* Ansi terminal raw mode */
static int rawmode(void) {
struct termios t;
@@ -186,13 +262,54 @@ static void norawmode(void) {
gbl_israwmode = 0;
}
static int checktermsupport() {
const char *t = getenv("TERM");
int i;
if (!t) return 1;
for (i = 0; badterms[i]; i++)
if (!strcmp(t, badterms[i])) return 0;
return 1;
}
static long write_console(char *bytes, size_t n) {
return write(STDOUT_FILENO, bytes, n);
}
static long read_console(char *into, size_t n) {
return read(STDIN_FILENO, into, n);
}
static int check_simpleline(JanetBuffer *buffer) {
if (!isatty(STDIN_FILENO) || !checktermsupport()) {
simpleline(buffer);
return 1;
}
if (rawmode()) {
simpleline(buffer);
return 1;
}
return 0;
}
#endif
static char *sdup(const char *s) {
size_t len = strlen(s) + 1;
char *mem = janet_malloc(len);
if (!mem) {
return NULL;
}
return memcpy(mem, s, len);
}
#ifndef _WIN32
static int curpos(void) {
char buf[32];
int cols, rows;
unsigned int i = 0;
if (write(STDOUT_FILENO, "\x1b[6n", 4) != 4) return -1;
if (write_console("\x1b[6n", 4) != 4) return -1;
while (i < sizeof(buf) - 1) {
if (read(STDIN_FILENO, buf + i, 1) != 1) break;
if (read_console(buf + i, 1) != 1) break;
if (buf[i] == 'R') break;
i++;
}
@@ -201,20 +318,26 @@ static int curpos(void) {
if (sscanf(buf + 2, "%d;%d", &rows, &cols) != 2) return -1;
return cols;
}
#endif
static int getcols(void) {
#ifdef _WIN32
CONSOLE_SCREEN_BUFFER_INFO csbi;
GetConsoleScreenBufferInfo(GetStdHandle(STD_OUTPUT_HANDLE), &csbi);
return (int)(csbi.srWindow.Right - csbi.srWindow.Left + 1);
#else
struct winsize ws;
if (ioctl(1, TIOCGWINSZ, &ws) == -1 || ws.ws_col == 0) {
int start, cols;
start = curpos();
if (start == -1) goto failed;
if (write(STDOUT_FILENO, "\x1b[999C", 6) != 6) goto failed;
if (write_console("\x1b[999C", 6) != 6) goto failed;
cols = curpos();
if (cols == -1) goto failed;
if (cols > start) {
char seq[32];
snprintf(seq, 32, "\x1b[%dD", cols - start);
if (write(STDOUT_FILENO, seq, strlen(seq)) == -1) {
if (write_console(seq, strlen(seq)) == -1) {
exit(1);
}
}
@@ -224,10 +347,11 @@ static int getcols(void) {
}
failed:
return 80;
#endif
}
static void clear(void) {
if (write(STDOUT_FILENO, "\x1b[H\x1b[2J", 7) <= 0) {
if (write_console("\x1b[H\x1b[2J", 7) <= 0) {
exit(1);
}
}
@@ -259,7 +383,7 @@ static void refresh(void) {
/* Move cursor to original position. */
snprintf(seq, 64, "\r\x1b[%dC", (int)(_pos + gbl_plen));
janet_buffer_push_cstring(&b, seq);
if (write(STDOUT_FILENO, b.data, b.count) == -1) {
if (write_console((char *) b.data, b.count) == -1) {
exit(1);
}
janet_buffer_deinit(&b);
@@ -285,7 +409,7 @@ static int insert(char c, int draw) {
if (gbl_plen + gbl_len < gbl_cols) {
/* Avoid a full update of the line in the
* trivial case. */
if (write(STDOUT_FILENO, &c, 1) == -1) return -1;
if (write_console(&c, 1) == -1) return -1;
} else {
refresh();
}
@@ -312,7 +436,7 @@ static void historymove(int delta) {
gbl_historyi = gbl_history_count - 1;
}
strncpy(gbl_buf, gbl_history[gbl_historyi], JANET_LINE_MAX - 1);
gbl_pos = gbl_len = strlen(gbl_buf);
gbl_pos = gbl_len = (int) strlen(gbl_buf);
gbl_buf[gbl_len] = '\0';
refresh();
@@ -424,7 +548,6 @@ static void kdeletew(void) {
refresh();
}
/* See tools/symchargen.c */
static int is_symbol_char_gen(uint8_t c) {
if (c & 0x80) return 1;
@@ -527,6 +650,7 @@ static void check_specials(JanetByteView src) {
check_cmatch(src, "unquote");
check_cmatch(src, "var");
check_cmatch(src, "while");
check_cmatch(src, "upscope");
}
static void resolve_format(JanetTable *entry) {
@@ -740,14 +864,14 @@ static int line() {
addhistory();
if (write(STDOUT_FILENO, gbl_prompt, gbl_plen) == -1) return -1;
if (write_console((char *) gbl_prompt, gbl_plen) == -1) return -1;
for (;;) {
char c;
char seq[3];
int rc;
do {
rc = read(STDIN_FILENO, &c, 1);
rc = read_console(&c, 1);
} while (rc < 0 && errno == EINTR);
if (rc <= 0) return -1;
@@ -764,8 +888,13 @@ static int line() {
kleft();
break;
case 3: /* ctrl-c */
clearlines();
norawmode();
#ifdef _WIN32
ExitProcess(1);
#else
kill(getpid(), SIGINT);
#endif
/* fallthrough */
case 17: /* ctrl-q */
gbl_cancel_current_repl_form = 1;
@@ -826,23 +955,26 @@ static int line() {
case 23: /* ctrl-w */
kbackspacew();
break;
#ifndef _WIN32
case 26: /* ctrl-z */
clearlines();
norawmode();
kill(getpid(), SIGSTOP);
rawmode();
refresh();
break;
#endif
case 27: /* escape sequence */
/* Read the next two bytes representing the escape sequence.
* Use two calls to handle slow terminals returning the two
* chars at different times. */
if (read(STDIN_FILENO, seq, 1) == -1) break;
if (read_console(seq, 1) == -1) break;
/* Esc[ = Control Sequence Introducer (CSI) */
if (seq[0] == '[') {
if (read(STDIN_FILENO, seq + 1, 1) == -1) break;
if (read_console(seq + 1, 1) == -1) break;
if (seq[1] >= '0' && seq[1] <= '9') {
/* Extended escape, read additional byte. */
if (read(STDIN_FILENO, seq + 2, 1) == -1) break;
if (read_console(seq + 2, 1) == -1) break;
if (seq[2] == '~') {
switch (seq[1]) {
case '1': /* Home */
@@ -861,7 +993,7 @@ static int line() {
}
}
} else if (seq[0] == 'O') {
if (read(STDIN_FILENO, seq + 1, 1) == -1) break;
if (read_console(seq + 1, 1) == -1) break;
switch (seq[1]) {
default:
break;
@@ -944,28 +1076,12 @@ void janet_line_deinit() {
gbl_historyi = 0;
}
static int checktermsupport() {
const char *t = getenv("TERM");
int i;
if (!t) return 1;
for (i = 0; badterms[i]; i++)
if (!strcmp(t, badterms[i])) return 0;
return 1;
}
void janet_line_get(const char *p, JanetBuffer *buffer) {
gbl_prompt = p;
buffer->count = 0;
gbl_historyi = 0;
if (check_simpleline(buffer)) return;
FILE *out = janet_dynfile("err", stderr);
if (!isatty(STDIN_FILENO) || !checktermsupport()) {
simpleline(buffer);
return;
}
if (rawmode()) {
simpleline(buffer);
return;
}
if (line()) {
norawmode();
fputc('\n', out);
@@ -981,6 +1097,13 @@ void janet_line_get(const char *p, JanetBuffer *buffer) {
replacehistory();
}
static void clear_at_exit(void) {
if (!gbl_israwmode) {
clearlines();
norawmode();
}
}
#endif
/*
@@ -993,18 +1116,11 @@ int main(int argc, char **argv) {
JanetTable *env;
#ifdef _WIN32
/* Enable color console on windows 10 console and utf8 output. */
HANDLE hOut = GetStdHandle(STD_OUTPUT_HANDLE);
DWORD dwMode = 0;
GetConsoleMode(hOut, &dwMode);
dwMode |= ENABLE_VIRTUAL_TERMINAL_PROCESSING;
SetConsoleMode(hOut, dwMode);
SetConsoleOutputCP(65001);
setup_console_output();
#endif
#if !defined(JANET_WINDOWS) && !defined(JANET_SIMPLE_GETLINE)
/* Try and not leave the terminal in a bad state */
atexit(norawmode);
#if !defined(JANET_SIMPLE_GETLINE)
atexit(clear_at_exit);
#endif
#if defined(JANET_PRF)

View File

@@ -1,5 +1,5 @@
/*
* Copyright (c) 2021 Calvin Rose
* Copyright (c) 2023 Calvin Rose
*
* Permission is hereby granted, free of charge, to any person obtaining a copy
* of this software and associated documentation files (the "Software"), to

View File

@@ -2,7 +2,7 @@
(var num-tests-passed 0)
(var num-tests-run 0)
(var suite-num 0)
(var suite-name 0)
(var start-time 0)
(def is-verbose (os/getenv "VERBOSE"))
@@ -14,9 +14,12 @@
(++ num-tests-run)
(when x (++ num-tests-passed))
(def str (string e))
(def frame (last (debug/stack (fiber/current))))
(def line-info (string/format "%s:%d"
(frame :source) (frame :source-line)))
(if x
(when is-verbose (eprintf "\e[32m✔\e[0m %s: %v" (describe e) x))
(eprintf "\e[31m✘\e[0m %s: %v" (describe e) x))
(when is-verbose (eprintf "\e[32m✔\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
@@ -24,18 +27,30 @@
(def errsym (keyword (gensym)))
~(assert (= ,errsym (try (do ,;forms) ([_] ,errsym))) ,msg))
(defn check-compile-error
[form]
(def result (compile form))
(assert (table? result) (string/format "expected compilation error for %j, but compiled without error" form)))
(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 [x]
(set suite-num x)
(defn start-suite [&opt x]
(default x (dyn :current-file))
(set suite-name
(cond
(number? x) (string x)
(string x)))
(set start-time (os/clock))
(eprint "Starting suite " x "..."))
(eprint "Starting suite " suite-name "..."))
(defn end-suite []
(def delta (- (os/clock) start-time))
(eprinf "Finished suite %d in %.3f seconds - " suite-num delta)
(eprinf "Finished suite %s in %.3f seconds - " suite-name delta)
(eprint num-tests-passed " of " num-tests-run " tests passed.")
(if (not= num-tests-passed num-tests-run) (os/exit 1)))

81
test/suite-array.janet Normal file
View File

@@ -0,0 +1,81 @@
# Copyright (c) 2023 Calvin Rose
#
# Permission is hereby granted, free of charge, to any person obtaining a copy
# of this software and associated documentation files (the "Software"), to
# deal in the Software without restriction, including without limitation the
# rights to use, copy, modify, merge, publish, distribute, sublicense, and/or
# sell copies of the Software, and to permit persons to whom the Software is
# furnished to do so, subject to the following conditions:
#
# The above copyright notice and this permission notice shall be included in
# all copies or substantial portions of the Software.
#
# THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
# IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
# FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
# AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
# LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
# FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS
# IN THE SOFTWARE.
(import ./helper :prefix "" :exit true)
(start-suite)
# Array tests
# e05022f
(defn array=
"Check if two arrays are equal in an element by element comparison"
[a b]
(if (and (array? a) (array? b))
(= (apply tuple a) (apply tuple b))))
(assert (= (apply tuple @[1 2 3 4 5]) (tuple 1 2 3 4 5)) "array to tuple")
(def arr (array))
(array/push arr :hello)
(array/push arr :world)
(assert (array= arr @[:hello :world]) "array comparison")
(assert (array= @[1 2 3 4 5] @[1 2 3 4 5]) "array comparison 2")
(assert (array= @[:one :two :three :four :five]
@[:one :two :three :four :five]) "array comparison 3")
(assert (array= (array/slice @[1 2 3] 0 2) @[1 2]) "array/slice 1")
(assert (array= (array/slice @[0 7 3 9 1 4] 2 -2) @[3 9 1]) "array/slice 2")
# Array remove
# 687a3c9
(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] -2 200) @[1 2 3]) "array/remove 4")
# array/peek
(assert (nil? (array/peek @[])) "array/peek empty")
# array/fill
(assert (deep= (array/fill @[1 1] 2) @[2 2]) "array/fill 1")
# array/concat
(assert (deep= (array/concat @[1 2] @[3 4] 5 6) @[1 2 3 4 5 6]) "array/concat 1")
(def a @[1 2])
(assert (deep= (array/concat a a) @[1 2 1 2]) "array/concat self")
# array/insert
(assert (deep= (array/insert @[:a :a :a :a] 2 :b :b) @[:a :a :b :b :a :a]) "array/insert 1")
(assert (deep= (array/insert @[:a :b] -1 :c :d) @[:a :b :c :d]) "array/insert 2")
# array/remove
(assert-error "removal index 3 out of range [0,2]" (array/remove @[1 2] 3))
(assert-error "expected non-negative integer for argument n, got -1" (array/remove @[1 2] 1 -1))
# array/pop
(assert (= (array/pop @[1]) 1) "array/pop 1")
(assert (= (array/pop @[]) nil) "array/pop empty")
# Code coverage
(def a @[1])
(array/pop a)
(array/trim a)
(array/ensure @[1 1] 6 2)
(end-suite)

55
test/suite-asm.janet Normal file
View File

@@ -0,0 +1,55 @@
# Copyright (c) 2023 Calvin Rose
#
# Permission is hereby granted, free of charge, to any person obtaining a copy
# of this software and associated documentation files (the "Software"), to
# deal in the Software without restriction, including without limitation the
# rights to use, copy, modify, merge, publish, distribute, sublicense, and/or
# sell copies of the Software, and to permit persons to whom the Software is
# furnished to do so, subject to the following conditions:
#
# The above copyright notice and this permission notice shall be included in
# all copies or substantial portions of the Software.
#
# THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
# IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
# FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
# AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
# LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
# FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS
# IN THE SOFTWARE.
(import ./helper :prefix "" :exit true)
(start-suite)
# Assembly test
# Fibonacci sequence, implemented with naive recursion.
# a679f60
(def fibasm (asm '{
:arity 1
:bytecode [
(ltim 1 0 0x2) # $1 = $0 < 2
(jmpif 1 :done) # if ($1) goto :done
(lds 1) # $1 = self
(addim 0 0 -0x1) # $0 = $0 - 1
(push 0) # push($0), push argument for next function call
(call 2 1) # $2 = call($1)
(addim 0 0 -0x1) # $0 = $0 - 1
(push 0) # push($0)
(call 0 1) # $0 = call($1)
(add 0 0 2) # $0 = $0 + $2 (integers)
:done
(ret 0) # return $0
]
}))
(assert (= 0 (fibasm 0)) "fibasm 1")
(assert (= 1 (fibasm 1)) "fibasm 2")
(assert (= 55 (fibasm 10)) "fibasm 3")
(assert (= 6765 (fibasm 20)) "fibasm 4")
# dacbe29
(def f (asm (disasm (fn [x] (fn [y] (+ x y))))))
(assert (= ((f 10) 37) 47) "asm environment tables")
(end-suite)

954
test/suite-boot.janet Normal file
View File

@@ -0,0 +1,954 @@
# Copyright (c) 2023 Calvin Rose
#
# Permission is hereby granted, free of charge, to any person obtaining a copy
# of this software and associated documentation files (the "Software"), to
# deal in the Software without restriction, including without limitation the
# rights to use, copy, modify, merge, publish, distribute, sublicense, and/or
# sell copies of the Software, and to permit persons to whom the Software is
# furnished to do so, subject to the following conditions:
#
# The above copyright notice and this permission notice shall be included in
# all copies or substantial portions of the Software.
#
# THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
# IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
# FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
# AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
# LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
# FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS
# IN THE SOFTWARE.
(import ./helper :prefix "" :exit true)
(start-suite)
# Let
# 807f981
(assert (= (let [a 1 b 2] (+ a b)) 3) "simple let")
(assert (= (let [[a b] @[1 2]] (+ a b)) 3) "destructured let")
(assert (= (let [[a [c d] b] @[1 (tuple 4 3) 2]] (+ a b c d)) 10)
"double destructured let")
# Macros
# b305a7c
(defn dub [x] (+ x x))
(assert (= 2 (dub 1)) "defn macro")
(do
(defn trip [x] (+ x x x))
(assert (= 3 (trip 1)) "defn macro triple"))
(do
(var i 0)
(when true
(++ i)
(++ i)
(++ i)
(++ i)
(++ i)
(++ i))
(assert (= i 6) "when macro"))
# Add truthy? to core
# ded08b6
(assert (= true ;(map truthy? [0 "" true @{} {} [] '()])) "truthy values")
(assert (= false ;(map truthy? [nil false])) "non-truthy values")
## Polymorphic comparison -- Issue #272
# 81d301a42
# confirm polymorphic comparison delegation to primitive comparators:
(assert (= 0 (cmp 3 3)) "compare-primitive integers (1)")
(assert (= -1 (cmp 3 5)) "compare-primitive integers (2)")
(assert (= 1 (cmp "foo" "bar")) "compare-primitive strings")
(assert (= 0 (compare 1 1)) "compare integers (1)")
(assert (= -1 (compare 1 2)) "compare integers (2)")
(assert (= 1 (compare "foo" "bar")) "compare strings (1)")
(assert (compare< 1 2 3 4 5 6) "compare less than integers")
(assert (not (compare> 1 2 3 4 5 6)) "compare not greater than integers")
(assert (compare< 1.0 2.0 3.0 4.0 5.0 6.0) "compare less than reals")
(assert (compare> 6 5 4 3 2 1) "compare greater than integers")
(assert (compare> 6.0 5.0 4.0 3.0 2.0 1.0) "compare greater than reals")
(assert (not (compare< 6.0 5.0 4.0 3.0 2.0 1.0)) "compare less than reals")
(assert (compare<= 1 2 3 3 4 5 6) "compare less than or equal to integers")
(assert (compare<= 1.0 2.0 3.0 3.0 4.0 5.0 6.0)
"compare less than or equal to reals")
(assert (compare>= 6 5 4 4 3 2 1)
"compare greater than or equal to integers")
(assert (compare>= 6.0 5.0 4.0 4.0 3.0 2.0 1.0)
"compare greater than or equal to reals")
(assert (compare< 1.0 nil false true
(fiber/new (fn [] 1))
"hi"
(quote hello)
:hello
(array 1 2 3)
(tuple 1 2 3)
(table "a" "b" "c" "d")
(struct 1 2 3 4)
(buffer "hi")
(fn [x] (+ x x))
print) "compare type ordering")
# test polymorphic compare with 'objects' (table/setproto)
(def mynum
@{:type :mynum :v 0 :compare
(fn [self other]
(case (type other)
:number (cmp (self :v) other)
:table (when (= (get other :type) :mynum)
(cmp (self :v) (other :v)))))})
(let [n3 (table/setproto @{:v 3} mynum)]
(assert (= 0 (compare 3 n3)) "compare num to object (1)")
(assert (= -1 (compare n3 4)) "compare object to num (2)")
(assert (= 1 (compare (table/setproto @{:v 4} mynum) n3))
"compare object to object")
(assert (compare< 2 n3 4) "compare< poly")
(assert (compare> 4 n3 2) "compare> poly")
(assert (compare<= 2 3 n3 4) "compare<= poly")
(assert (compare= 3 n3 (table/setproto @{:v 3} mynum)) "compare= poly")
(assert (deep= (sorted @[4 5 n3 2] compare<) @[2 n3 4 5])
"polymorphic sort"))
# Add any? predicate to core
# 7478ad11
(assert (= nil (any? [])) "any? 1")
(assert (= nil (any? [false nil])) "any? 2")
(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])
(assert (= (if-let [x (get my-array 5)] x) 6) "if-let 1")
(assert (= (if-let [y (get @{} :key)] 10 nil) nil) "if-let 2")
(assert (= (if-let [a my-array k (next a)] :t :f) :t) "if-let 3")
(assert (= (if-let [a my-array k (next a 5)] :t :f) :f) "if-let 4")
(assert (= (if-let [[a b] my-array] a) 1) "if-let 5")
(assert (= (if-let [{:a a :b b} {:a 1 :b 2}] b) 2) "if-let 6")
(assert (= (if-let [[a b] nil] :t :f) :f) "if-let 7")
# #1191
(var cnt 0)
(defmacro upcnt [] (++ cnt))
(assert (= (if-let [a true b true c true] nil (upcnt)) nil) "issue #1191")
(assert (= cnt 1) "issue #1191")
(assert (= 14 (sum (map inc @[1 2 3 4]))) "sum map")
(def myfun (juxt + - * /))
(assert (= [2 -2 2 0.5] (myfun 2)) "juxt")
# Case statements
# 5249228
(assert
(= :six (case (+ 1 2 3)
1 :one
2 :two
3 :three
4 :four
5 :five
6 :six
7 :seven
8 :eight
9 :nine)) "case macro")
(assert (= 7 (case :a :b 5 :c 6 :u 10 7)) "case with default")
# Testing the seq, tabseq, catseq, and loop macros
# 547529e
(def xs (apply tuple (seq [x :range [0 10] :when (even? x)]
(tuple (/ x 2) x))))
(assert (= xs '((0 0) (1 2) (2 4) (3 6) (4 8))) "seq macro 1")
# 624be87c9
(def xs (apply tuple (seq [x :down [8 -2] :when (even? x)]
(tuple (/ x 2) x))))
(assert (= xs '((4 8) (3 6) (2 4) (1 2) (0 0))) "seq macro 2")
# Looping idea
# 45f8db0
(def xs
(seq [x :in [-1 0 1] y :in [-1 0 1] :when (not= x y 0)] (tuple x y)))
(def txs (apply tuple xs))
(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}))
(assert (deep= (tabseq [i :in (range 3)] i)
@{}))
# ccd874fe4
(def xs (catseq [x :range [0 3]] [x x]))
(assert (deep= xs @[0 0 1 1 2 2]) "catseq")
# :range-to and :down-to
# e0c9910d8
(assert (deep= (seq [x :range-to [0 10]] x) (seq [x :range [0 11]] x))
"loop :range-to")
(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}]
(put res k v))
(assert (and
(= (get res 1) 2)
(= (get res 3) 4)
(= (get res 5) 6)) "loop :pairs")
# Issue #428
# 08a3687eb
(var result nil)
(defn f [] (yield {:a :ok}))
(assert-no-error "issue 428 1"
(loop [{:a x} :in (fiber/new f)] (set result x)))
(assert (= result :ok) "issue 428 2")
# Generators
# 184fe31e0
(def gen (generate [x :range [0 100] :when (pos? (% x 4))] x))
(var gencount 0)
(loop [x :in gen]
(++ gencount)
(assert (pos? (% x 4)) "generate in loop"))
(assert (= gencount 75) "generate loop count")
# Even and odd
# ff163a5ae
(assert (odd? 9) "odd? 1")
(assert (odd? -9) "odd? 2")
(assert (not (odd? 10)) "odd? 3")
(assert (not (odd? 0)) "odd? 4")
(assert (not (odd? -10)) "odd? 5")
(assert (not (odd? 1.1)) "odd? 6")
(assert (not (odd? -0.1)) "odd? 7")
(assert (not (odd? -1.1)) "odd? 8")
(assert (not (odd? -1.6)) "odd? 9")
(assert (even? 10) "even? 1")
(assert (even? -10) "even? 2")
(assert (even? 0) "even? 3")
(assert (not (even? 9)) "even? 4")
(assert (not (even? -9)) "even? 5")
(assert (not (even? 0.1)) "even? 6")
(assert (not (even? -0.1)) "even? 7")
(assert (not (even? -10.1)) "even? 8")
(assert (not (even? -10.6)) "even? 9")
# Map arities
# 25ded775a
(assert (deep= (map inc [1 2 3]) @[2 3 4]))
(assert (deep= (map + [1 2 3] [10 20 30]) @[11 22 33]))
(assert (deep= (map + [1 2 3] [10 20 30] [100 200 300]) @[111 222 333]))
(assert (deep= (map + [1 2 3] [10 20 30] [100 200 300] [1000 2000 3000])
@[1111 2222 3333]))
(assert (deep= (map +
[1 2 3] [10 20 30] [100 200 300] [1000 2000 3000]
[10000 20000 30000])
@[11111 22222 33333]))
# 77e62a2
(assert (deep= (map +
[1 2 3] [10 20 30] [100 200 300] [1000 2000 3000]
[10000 20000 30000] [100000 200000 300000])
@[111111 222222 333333]))
# Mapping uses the shortest sequence
# a69799aa4
(assert (deep= (map + [1 2 3 4] [10 20 30]) @[11 22 33]))
(assert (deep= (map + [1 2 3 4] [10 20 30] [100 200]) @[111 222]))
(assert (deep= (map + [1 2 3 4] [10 20 30] [100 200] [1000]) @[1111]))
# 77e62a2
(assert (deep= (map + [1 2 3 4] [10 20 30] [100 200] [1000] []) @[]))
# Variadic arguments to map-like functions
# 77e62a2
(assert (deep= (mapcat tuple [1 2 3 4] [5 6 7 8]) @[1 5 2 6 3 7 4 8]))
(assert (deep= (keep |(if (> $1 0) (/ $0 $1)) [1 2 3 4 5] [1 2 1 0 1])
@[1 1 3 5]))
(assert (= (count = [1 3 2 4 3 5 4 2 1] [1 2 3 4 5 4 3 2 1]) 4))
(assert (= (some not= (range 5) (range 5)) nil))
(assert (= (some = [1 2 3 4 5] [5 4 3 2 1]) true))
(assert (= (all = (range 5) (range 5)) true))
(assert (= (all not= [1 2 3 4 5] [5 4 3 2 1]) false))
# 4194374
(assert (= false (deep-not= [1] [1])) "issue #1149")
# Merge sort
# f5b29b8
# Imperative (and verbose) merge sort merge
(defn merge-sort
[xs ys]
(def ret @[])
(def xlen (length xs))
(def ylen (length ys))
(var i 0)
(var j 0)
# Main merge
(while (if (< i xlen) (< j ylen))
(def xi (get xs i))
(def yj (get ys j))
(if (< xi yj)
(do (array/push ret xi) (set i (+ i 1)))
(do (array/push ret yj) (set j (+ j 1)))))
# Push rest of xs
(while (< i xlen)
(def xi (get xs i))
(array/push ret xi)
(set i (+ i 1)))
# Push rest of ys
(while (< j ylen)
(def yj (get ys j))
(array/push ret yj)
(set j (+ j 1)))
ret)
(assert (apply <= (merge-sort @[1 3 5] @[2 4 6])) "merge sort merge 1")
(assert (apply <= (merge-sort @[1 2 3] @[4 5 6])) "merge sort merge 2")
(assert (apply <= (merge-sort @[1 3 5] @[2 4 6 6 6 9])) "merge sort merge 3")
(assert (apply <= (merge-sort '(1 3 5) @[2 4 6 6 6 9])) "merge sort merge 4")
(assert (deep= @[1 2 3 4 5] (sort @[5 3 4 1 2])) "sort 1")
(assert (deep= @[{:a 1} {:a 4} {:a 7}]
(sort-by |($ :a) @[{:a 4} {:a 7} {:a 1}])) "sort 2")
(assert (deep= @[1 2 3 4 5] (sorted [5 3 4 1 2])) "sort 3")
(assert (deep= @[{:a 1} {:a 4} {:a 7}]
(sorted-by |($ :a) [{:a 4} {:a 7} {:a 1}])) "sort 4")
# Sort function
# 2ca9300bf
(assert (deep=
(range 99)
(sort (mapcat (fn [[x y z]] [z y x]) (partition 3 (range 99)))))
"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")
(assert (= (and true false) false) "and true false")
(assert (= (and false true) false) "and false true")
(assert (= (and true true true) true) "and true true true")
(assert (= (and 0 1 2) 2) "and 0 1 2")
(assert (= (and 0 1 nil) nil) "and 0 1 nil")
(assert (= (and 1) 1) "and 1")
(assert (= (and) true) "and with no arguments")
(assert (= (and 1 true) true) "and with trailing true")
(assert (= (and 1 true 2) 2) "and with internal true")
(assert (= (or true true) true) "or true true")
(assert (= (or true false) true) "or true false")
(assert (= (or false true) true) "or false true")
(assert (= (or false false) false) "or false true")
(assert (= (or true true false) true) "or true true false")
(assert (= (or 0 1 2) 0) "or 0 1 2")
(assert (= (or nil 1 2) 1) "or nil 1 2")
(assert (= (or 1) 1) "or 1")
(assert (= (or) nil) "or with no arguments")
# And/or checks
# 6123c41f1
(assert (= false (and false false)) "and 1")
(assert (= false (or false false)) "or 1")
# 11cd1279d
(assert (deep= @{:a 1 :b 2 :c 3} (zipcoll '[:a :b :c] '[1 2 3])) "zipcoll")
# bc8be266f
(def- a 100)
(assert (= a 100) "def-")
# bc8be266f
(assert (= :first
(match @[1 3 5]
@[x y z] :first
:second)) "match 1")
(def val1 :avalue)
(assert (= :second
(match val1
@[x y z] :first
:avalue :second
:third)) "match 2")
(assert (= 100
(match @[50 40]
@[x x] (* x 3)
@[x y] (+ x y 10)
0)) "match 3")
# Match checks
# 47e8f669f
(assert (= :hi (match nil nil :hi)) "match 1")
(assert (= :hi (match {:a :hi} {:a a} a)) "match 2")
(assert (= nil (match {:a :hi} {:a a :b b} a)) "match 3")
(assert (= nil (match [1 2] [a b c] a)) "match 4")
(assert (= 2 (match [1 2] [a b] b)) "match 5")
# db631097b
(assert (= [2 :a :b] (match [1 2 :a :b] [o & rest] rest)) "match 6")
(assert (= [] (match @[:a] @[x & r] r :fallback)) "match 7")
(assert (= :fallback (match @[1] @[x y & r] r :fallback)) "match 8")
(assert (= [1 2 3 4] (match @[1 2 3 4] @[x y z & r] [x y z ;r] :fallback))
"match 9")
# Test cases for #293
# d3b9b8d45
(assert (= :yes (match [1 2 3] [_ a _] :yes :no)) "match wildcard 1")
(assert (= :no (match [1 2 3] [__ a __] :yes :no)) "match wildcard 2")
(assert (= :yes (match [1 2 [1 2 3]] [_ a [_ _ _]] :yes :no))
"match wildcard 3")
(assert (= :yes (match [1 2 3] (_ (even? 2)) :yes :no)) "match wildcard 4")
(assert (= :yes (match {:a 1} {:a _} :yes :no)) "match wildcard 5")
(assert (= false (match {:a 1 :b 2 :c 3}
{:a a :b _ :c _ :d _} :no
{:a _ :b _ :c _} false
:no)) "match wildcard 6")
(assert (= nil (match {:a 1 :b 2 :c 3}
{:a a :b _ :c _ :d _} :no
{:a _ :b _ :c _} nil
:no)) "match wildcard 7")
# issue #529 - 602010600
(assert (= "t" (match [true nil] [true _] "t")) "match wildcard 8")
# quoted match test
# 425a0fcf0
(assert (= :yes (match 'john 'john :yes _ :nope)) "quoted literal match 1")
(assert (= :nope (match 'john ''john :yes _ :nope)) "quoted literal match 2")
# Some macros
# 7880d7320
(assert (= 2 (if-not 1 3 2)) "if-not 1")
(assert (= 3 (if-not false 3)) "if-not 2")
(assert (= 3 (if-not nil 3 2)) "if-not 3")
(assert (= nil (if-not true 3)) "if-not 4")
(assert (= 4 (unless false (+ 1 2 3) 4)) "unless")
# take
# 18da183ef
(assert (deep= (take 0 []) []) "take 1")
(assert (deep= (take 10 []) []) "take 2")
(assert (deep= (take 0 [1 2 3 4 5]) []) "take 3")
(assert (deep= (take 10 [1 2 3]) [1 2 3]) "take 4")
(assert (deep= (take -1 [:a :b :c]) [:c]) "take 5")
# 34019222c
(assert (deep= (take 3 (generate [x :in [1 2 3 4 5]] x)) @[1 2 3])
"take from fiber")
# NB: repeatedly resuming a fiber created with `generate` includes a `nil`
# as the final element. Thus a generate of 2 elements will create an array
# of 3.
(assert (= (length (take 4 (generate [x :in [1 2]] x))) 2)
"take from short fiber")
# take-until
# 18da183ef
(assert (deep= (take-until pos? @[]) []) "take-until 1")
(assert (deep= (take-until pos? @[1 2 3]) []) "take-until 2")
(assert (deep= (take-until pos? @[-1 -2 -3]) [-1 -2 -3]) "take-until 3")
(assert (deep= (take-until pos? @[-1 -2 3]) [-1 -2]) "take-until 4")
(assert (deep= (take-until pos? @[-1 1 -2]) [-1]) "take-until 5")
(assert (deep= (take-until |(= $ 115) "books") "book") "take-until 6")
(assert (deep= (take-until |(= $ 115) (generate [x :in "books"] x))
@[98 111 111 107]) "take-until from fiber")
# take-while
# 18da183ef
(assert (deep= (take-while neg? @[]) []) "take-while 1")
(assert (deep= (take-while neg? @[1 2 3]) []) "take-while 2")
(assert (deep= (take-while neg? @[-1 -2 -3]) [-1 -2 -3]) "take-while 3")
(assert (deep= (take-while neg? @[-1 -2 3]) [-1 -2]) "take-while 4")
(assert (deep= (take-while neg? @[-1 1 -2]) [-1]) "take-while 5")
(assert (deep= (take-while neg? (generate [x :in @[-1 1 -2]] x))
@[-1]) "take-while from fiber")
# drop
# 18da183ef
(assert (deep= (drop 0 []) []) "drop 1")
(assert (deep= (drop 10 []) []) "drop 2")
(assert (deep= (drop 0 [1 2 3 4 5]) [1 2 3 4 5]) "drop 3")
(assert (deep= (drop 10 [1 2 3]) []) "drop 4")
(assert (deep= (drop -1 [1 2 3]) [1 2]) "drop 5")
(assert (deep= (drop -10 [1 2 3]) []) "drop 6")
(assert (deep= (drop 1 "abc") "bc") "drop 7")
(assert (deep= (drop 10 "abc") "") "drop 8")
(assert (deep= (drop -1 "abc") "ab") "drop 9")
(assert (deep= (drop -10 "abc") "") "drop 10")
# drop-until
# 75dc08f
(assert (deep= (drop-until pos? @[]) []) "drop-until 1")
(assert (deep= (drop-until pos? @[1 2 3]) [1 2 3]) "drop-until 2")
(assert (deep= (drop-until pos? @[-1 -2 -3]) []) "drop-until 3")
(assert (deep= (drop-until pos? @[-1 -2 3]) [3]) "drop-until 4")
(assert (deep= (drop-until pos? @[-1 1 -2]) [1 -2]) "drop-until 5")
(assert (deep= (drop-until |(= $ 115) "books") "s") "drop-until 6")
# take-drop symmetry #1178
(def items-list ['abcde :abcde "abcde" @"abcde" [1 2 3 4 5] @[1 2 3 4 5]])
(each items items-list
(def len (length items))
(for i 0 (+ len 1)
(assert (deep= (take i items) (drop (- i len) items)) (string/format "take-drop symmetry %q %d" items i))
(assert (deep= (take (- i) items) (drop (- len i) items)) (string/format "take-drop symmetry %q %d" items i))))
(defn squares []
(coro
(var [a b] [0 1])
(forever (yield a) (+= a b) (+= b 2))))
(def sqr1 (squares))
(assert (deep= (take 10 sqr1) @[0 1 4 9 16 25 36 49 64 81]))
(assert (deep= (take 1 sqr1) @[100]) "take fiber next value")
(def sqr2 (drop 10 (squares)))
(assert (deep= (take 1 sqr2) @[100]) "drop fiber next value")
(def dict @{:a 1 :b 2 :c 3 :d 4 :e 5})
(def dict1 (take 2 dict))
(def dict2 (drop 2 dict))
(assert (= (length dict1) 2) "take dictionary")
(assert (= (length dict2) 3) "drop dictionary")
(assert (deep= (merge dict1 dict2) dict) "take-drop symmetry for dictionary")
# Comment macro
# issue #110 - 698e89aba
(comment 1)
(comment 1 2)
(comment 1 2 3)
(comment 1 2 3 4)
# comp should be variadic
# 5c83ebd75, 02ce3031
(assert (= 10 ((comp +) 1 2 3 4)) "variadic comp 1")
(assert (= 11 ((comp inc +) 1 2 3 4)) "variadic comp 2")
(assert (= 12 ((comp inc inc +) 1 2 3 4)) "variadic comp 3")
(assert (= 13 ((comp inc inc inc +) 1 2 3 4)) "variadic comp 4")
(assert (= 14 ((comp inc inc inc inc +) 1 2 3 4)) "variadic comp 5")
(assert (= 15 ((comp inc inc inc inc inc +) 1 2 3 4)) "variadic comp 6")
(assert (= 16 ((comp inc inc inc inc inc inc +) 1 2 3 4))
"variadic comp 7")
# Function shorthand
# 44e752d73
(assert (= (|(+ 1 2 3)) 6) "function shorthand 1")
(assert (= (|(+ 1 2 3 $) 4) 10) "function shorthand 2")
(assert (= (|(+ 1 2 3 $0) 4) 10) "function shorthand 3")
(assert (= (|(+ $0 $0 $0 $0) 4) 16) "function shorthand 4")
(assert (= (|(+ $ $ $ $) 4) 16) "function shorthand 5")
(assert (= (|4) 4) "function shorthand 6")
(assert (= (((|||4))) 4) "function shorthand 7")
(assert (= (|(+ $1 $1 $1 $1) 2 4) 16) "function shorthand 8")
(assert (= (|(+ $0 $1 $3 $2 $6) 0 1 2 3 4 5 6) 12) "function shorthand 9")
# 5f5147652
(assert (= (|(+ $0 $99) ;(range 100)) 99) "function shorthand 10")
# 655d4b3aa
(defn idx= [x y] (= (tuple/slice x) (tuple/slice y)))
# Simple take, drop, etc. tests.
(assert (idx= (take 10 (range 100)) (range 10)) "take 10")
(assert (idx= (drop 10 (range 100)) (range 10 100)) "drop 10")
# with-vars
# 6ceaf9d28
(var abc 123)
(assert (= 356 (with-vars [abc 456] (- abc 100))) "with-vars 1")
(assert-error "with-vars 2" (with-vars [abc 456] (error :oops)))
(assert (= abc 123) "with-vars 3")
# Top level unquote
# 2487162cc
(defn constantly
[]
(comptime (math/random)))
(assert (= (constantly) (constantly)) "comptime 1")
# issue #232 - b872ee024
(assert-error "arity issue in macro" (eval '(each [])))
# c6b639b93
(assert-error "comptime issue" (eval '(comptime (error "oops"))))
# 962cd7e5f
(var counter 0)
(when-with [x nil |$]
(++ counter))
(when-with [x 10 |$]
(+= counter 10))
(assert (= 10 counter) "when-with 1")
(if-with [x nil |$] (++ counter) (+= counter 10))
(if-with [x true |$] (+= counter 20) (+= counter 30))
(assert (= 40 counter) "if-with 1")
# a45509d28
(def a @[])
(eachk x [:a :b :c :d]
(array/push a x))
(assert (deep= (range 4) a) "eachk 1")
# issue 609 - 1fcaffe
(with-dyns [:err @""]
(tracev (def my-unique-var-name true))
(assert my-unique-var-name "tracev upscopes"))
# Prompts and Labels
# 59d288c
(assert (= 10 (label a (for i 0 10 (if (= i 5) (return a 10))))) "label 1")
(defn recur
[lab x y]
(when (= x y) (return lab :done))
(def res (label newlab (recur (or lab newlab) (+ x 1) y)))
(if lab :oops res))
(assert (= :done (recur nil 0 10)) "label 2")
(assert (= 10 (prompt :a (for i 0 10 (if (= i 5) (return :a 10)))))
"prompt 1")
(defn- inner-loop
[i]
(if (= i 5)
(return :a 10)))
(assert (= 10 (prompt :a (for i 0 10 (inner-loop i)))) "prompt 2")
(defn- inner-loop2
[i]
(try
(if (= i 5)
(error 10))
([err] (return :a err))))
(assert (= 10 (prompt :a (for i 0 10 (inner-loop2 i)))) "prompt 3")
# chr
# issue 304 - 77343e02e
(assert (= (chr "a") 97) "chr 1")
# Reduce2
# 3eb0927a2
(assert (= (reduce + 0 (range 1 10)) (reduce2 + (range 10))) "reduce2 1")
# 65379741f
(assert (= (reduce * 1 (range 2 10)) (reduce2 * (range 1 10))) "reduce2 2")
(assert (= nil (reduce2 * [])) "reduce2 3")
# Accumulate
# 3eb0927a2
(assert (deep= (accumulate + 0 (range 5)) @[0 1 3 6 10]) "accumulate 1")
(assert (deep= (accumulate2 + (range 5)) @[0 1 3 6 10]) "accumulate2 1")
# 65379741f
(assert (deep= @[] (accumulate2 + [])) "accumulate2 2")
(assert (deep= @[] (accumulate 0 + [])) "accumulate 2")
# in vs get regression
# issue #340 - b63a0796f
(assert (nil? (first @"")) "in vs get 1")
(assert (nil? (last @"")) "in vs get 1")
# index-of
# 259812314
(assert (= nil (index-of 10 [])) "index-of 1")
(assert (= nil (index-of 10 [1 2 3])) "index-of 2")
(assert (= 1 (index-of 2 [1 2 3])) "index-of 3")
(assert (= 0 (index-of :a [:a :b :c])) "index-of 4")
(assert (= nil (index-of :a {})) "index-of 5")
(assert (= :a (index-of :A {:a :A :b :B})) "index-of 6")
(assert (= :a (index-of :A @{:a :A :b :B})) "index-of 7")
(assert (= 0 (index-of (chr "a") "abc")) "index-of 8")
(assert (= nil (index-of (chr "a") "")) "index-of 9")
(assert (= nil (index-of 10 @[])) "index-of 10")
(assert (= nil (index-of 10 @[1 2 3])) "index-of 11")
# e78a3d1
# NOTE: These is a motivation for the has-value? and has-key? functions below
# returns false despite key present
(assert (= false (index-of 8 {true 7 false 8}))
"index-of corner key (false) 1")
(assert (= false (index-of 8 @{false 8}))
"index-of corner key (false) 2")
# still returns null
(assert (= nil (index-of 7 {false 8})) "index-of corner key (false) 3")
# has-value?
(assert (= false (has-value? [] "foo")) "has-value? 1")
(assert (= true (has-value? [4 7 1 3] 4)) "has-value? 2")
(assert (= false (has-value? [4 7 1 3] 22)) "has-value? 3")
(assert (= false (has-value? @[1 2 3] 4)) "has-value? 4")
(assert (= true (has-value? @[:a :b :c] :a)) "has-value? 5")
(assert (= false (has-value? {} :foo)) "has-value? 6")
(assert (= true (has-value? {:a :A :b :B} :A)) "has-value? 7")
(assert (= true (has-value? {:a :A :b :B} :A)) "has-value? 7")
(assert (= true (has-value? @{:a :A :b :B} :A)) "has-value? 8")
(assert (= true (has-value? "abc" (chr "a"))) "has-value? 9")
(assert (= false (has-value? "abc" "1")) "has-value? 10")
# weird true/false corner cases, should align with "index-of corner
# key {k}" cases
(assert (= true (has-value? {true 7 false 8} 8))
"has-value? corner key (false) 1")
(assert (= true (has-value? @{false 8} 8))
"has-value? corner key (false) 2")
(assert (= false (has-value? {false 8} 7))
"has-value? corner key (false) 3")
# has-key?
(do
(var test-has-key-auto 0)
(defn test-has-key [col key expected &keys {:name name}]
``Test that has-key has the outcome `expected`, and that if
the result is true, then ensure (in key) does not fail either``
(assert (boolean? expected))
(default name (string "has-key? " (++ test-has-key-auto)))
(assert (= expected (has-key? col key)) name)
(if
# guarenteed by `has-key?` to never fail
expected (in col key)
# if `has-key?` is false, then `in` should fail (for indexed types)
#
# For dictionary types, it should return nil
(let [[success retval] (protect (in col key))]
(def should-succeed (dictionary? col))
(assert
(= success should-succeed)
(string/format
"%s: expected (in col key) to %s, but got %q"
name (if expected "succeed" "fail") retval)))))
(test-has-key [] 0 false) # 1
(test-has-key [4 7 1 3] 2 true) # 2
(test-has-key [4 7 1 3] 22 false) # 3
(test-has-key @[1 2 3] 4 false) # 4
(test-has-key @[:a :b :c] 2 true) # 5
(test-has-key {} :foo false) # 6
(test-has-key {:a :A :b :B} :a true) # 7
(test-has-key {:a :A :b :B} :A false) # 8
(test-has-key @{:a :A :b :B} :a true) # 9
(test-has-key "abc" 1 true) # 10
(test-has-key "abc" 4 false) # 11
# weird true/false corner cases
#
# Tries to mimic the corresponding corner cases in has-value? and
# index-of, but with keys/values inverted
#
# in the first two cases (truthy? (get val col)) would have given false
# negatives
(test-has-key {7 true 8 false} 8 true :name
"has-key? corner value (false) 1")
(test-has-key @{8 false} 8 true :name
"has-key? corner value (false) 2")
(test-has-key @{8 false} 7 false :name
"has-key? corner value (false) 3"))
# Regression
# issue #463 - 7e7498350
(assert (= {:x 10} (|(let [x $] ~{:x ,x}) 10)) "issue 463")
# macex testing
# 7e7498350
(assert (deep= (macex1 '~{1 2 3 4}) '~{1 2 3 4}) "macex1 qq struct")
(assert (deep= (macex1 '~@{1 2 3 4}) '~@{1 2 3 4}) "macex1 qq table")
(assert (deep= (macex1 '~(1 2 3 4)) '~[1 2 3 4]) "macex1 qq tuple")
(assert (= :brackets (tuple/type (1 (macex1 '~[1 2 3 4]))))
"macex1 qq bracket tuple")
(assert (deep= (macex1 '~@[1 2 3 4 ,blah]) '~@[1 2 3 4 ,blah])
"macex1 qq array")
# Sourcemaps in threading macros
# b6175e429
(defn check-threading [macro expansion]
(def expanded (macex1 (tuple macro 0 '(x) '(y))))
(assert (= expanded expansion) (string macro " expansion value"))
(def smap-x (tuple/sourcemap (get expanded 1)))
(def smap-y (tuple/sourcemap expanded))
(def line first)
(defn column [t] (t 1))
(assert (not= smap-x [-1 -1]) (string macro " x sourcemap existence"))
(assert (not= smap-y [-1 -1]) (string macro " y sourcemap existence"))
(assert (or (< (line smap-x) (line smap-y))
(and (= (line smap-x) (line smap-y))
(< (column smap-x) (column smap-y))))
(string macro " relation between x and y sourcemap")))
(check-threading '-> '(y (x 0)))
(check-threading '->> '(y (x 0)))
# keep-syntax
# b6175e429
(let [brak '[1 2 3]
par '(1 2 3)]
(tuple/setmap brak 2 1)
(assert (deep= (keep-syntax brak @[1 2 3]) @[1 2 3])
"keep-syntax brackets ignore array")
(assert (= (keep-syntax! brak @[1 2 3]) '[1 2 3])
"keep-syntax! brackets replace array")
(assert (= (keep-syntax! par (map inc @[1 2 3])) '(2 3 4))
"keep-syntax! parens coerce array")
(assert (not= (keep-syntax! brak @[1 2 3]) '(1 2 3))
"keep-syntax! brackets not parens")
(assert (not= (keep-syntax! par @[1 2 3]) '[1 2 3])
"keep-syntax! parens not brackets")
(assert (= (tuple/sourcemap brak)
(tuple/sourcemap (keep-syntax! brak @[1 2 3])))
"keep-syntax! brackets source map")
(keep-syntax par brak)
(assert (not= (tuple/sourcemap brak) (tuple/sourcemap par))
"keep-syntax no mutate")
(assert (= (keep-syntax 1 brak) brak) "keep-syntax brackets ignore type"))
# Curenv
# 28439d822, f7c556e
(assert (= (curenv) (curenv 0)) "curenv 1")
(assert (= (table/getproto (curenv)) (curenv 1)) "curenv 2")
(assert (= nil (curenv 1000000)) "curenv 3")
(assert (= root-env (curenv 1)) "curenv 4")
# Import macro test
# a31e079f9
(assert-no-error "import macro 1" (macex '(import a :as b :fresh maybe)))
(assert (deep= ~(,import* "a" :as "b" :fresh maybe)
(macex '(import a :as b :fresh maybe))) "import macro 2")
# #477 walk preserving bracket type
# 0a1d902f4
(assert (= :brackets (tuple/type (postwalk identity '[])))
"walk square brackets 1")
(assert (= :brackets (tuple/type (walk identity '[])))
"walk square brackets 2")
# Issue #751
# 547fda6a4
(def t {:side false})
(assert (nil? (get-in t [:side :note])) "get-in with false value")
(assert (= (get-in t [:side :note] "dflt") "dflt")
"get-in with false value and default")
# Evaluate stream with `dofile`
# 9cc4e4812
(def [r w] (os/pipe))
(:write w "(setdyn :x 10)")
(:close w)
(def stream-env (dofile r))
(assert (= (stream-env :x) 10) "dofile stream 1")
# Test thaw and freeze
# 9cc0645a1
(def table-to-freeze @{:c 22 :b [1 2 3 4] :d @"test" :e "test2"})
(def table-to-freeze-with-inline-proto
@{:a @[1 2 3] :b @[1 2 3 4] :c 22 :d @"test" :e @"test2"})
(def struct-to-thaw
(struct/with-proto {:a [1 2 3]} :c 22 :b [1 2 3 4] :d "test" :e "test2"))
(table/setproto table-to-freeze @{:a @[1 2 3]})
(assert (deep= {:a [1 2 3] :b [1 2 3 4] :c 22 :d "test" :e "test2"}
(freeze table-to-freeze)))
(assert (deep= table-to-freeze-with-inline-proto (thaw table-to-freeze)))
(assert (deep= table-to-freeze-with-inline-proto (thaw struct-to-thaw)))
# Make sure Carriage Returns don't end up in doc strings
# e528b86
(assert (not (string/find "\r"
(get ((fiber/getenv (fiber/current)) 'cond)
:doc "")))
"no \\r in doc strings")
# cff718f37
(var counter 0)
(def thunk (delay (++ counter)))
(assert (= (thunk) 1) "delay 1")
(assert (= counter 1) "delay 2")
(assert (= (thunk) 1) "delay 3")
(assert (= counter 1) "delay 4")
# maclintf
(def env (table/clone (curenv)))
((compile '(defmacro foo [] (maclintf :strict "oops")) env :anonymous))
(def lints @[])
(compile (tuple/setmap '(foo) 1 2) env :anonymous lints)
(assert (deep= lints @[[:strict 1 2 "oops"]]) "maclintf 1")
(def env (table/clone (curenv)))
((compile '(defmacro foo [& body] (maclintf :strict "foo-oops") ~(do ,;body)) env :anonymous))
((compile '(defmacro bar [] (maclintf :strict "bar-oops")) env :anonymous))
(def lints @[])
# Compile (foo (bar)), but with explicit source map values
(def bar-invoke (tuple/setmap '(bar) 3 4))
(compile (tuple/setmap ~(foo ,bar-invoke) 1 2) env :anonymous lints)
(assert (deep= lints @[[:strict 1 2 "foo-oops"]
[: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)
# Debug bytecode of these functions
# (pp (disasm case-1))
# (pp (disasm case-2))
# (pp (disasm case-3))
(end-suite)

126
test/suite-buffer.janet Normal file
View File

@@ -0,0 +1,126 @@
# Copyright (c) 2023 Calvin Rose
#
# Permission is hereby granted, free of charge, to any person obtaining a copy
# of this software and associated documentation files (the "Software"), to
# deal in the Software without restriction, including without limitation the
# rights to use, copy, modify, merge, publish, distribute, sublicense, and/or
# sell copies of the Software, and to permit persons to whom the Software is
# furnished to do so, subject to the following conditions:
#
# The above copyright notice and this permission notice shall be included in
# all copies or substantial portions of the Software.
#
# THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
# IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
# FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
# AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
# LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
# FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS
# IN THE SOFTWARE.
(import ./helper :prefix "" :exit true)
(start-suite)
# Buffer blitting
# 16ebb1118
(def b (buffer/new-filled 100))
(buffer/bit-set b 100)
(buffer/bit-clear b 100)
(assert (zero? (sum b)) "buffer bit set and clear")
(assert (= false (buffer/bit b 101)) "bit get false")
(buffer/bit-toggle b 101)
(assert (= true (buffer/bit b 101)) "bit get true")
(assert (= 32 (sum b)) "buffer bit set and clear")
(assert-error "invalid bit index 1000" (buffer/bit-toggle b 1000))
(def b2 @"hello world")
(buffer/blit b2 "joyto ")
(assert (= (string b2) "joyto world") "buffer/blit 1")
(buffer/blit b2 "joyto" 6)
(assert (= (string b2) "joyto joyto") "buffer/blit 2")
(buffer/blit b2 "abcdefg" 5 6)
(assert (= (string b2) "joytogjoyto") "buffer/blit 3")
# buffer/push
(assert (deep= (buffer/push @"AA" @"BB") @"AABB") "buffer/push buffer")
(assert (deep= (buffer/push @"AA" 66 66) @"AABB") "buffer/push int")
(def b @"AA")
(assert (deep= (buffer/push b b) @"AAAA") "buffer/push buffer self")
# buffer/push-byte
(assert (deep= (buffer/push-byte @"AA" 66) @"AAB") "buffer/push-byte")
(assert-error "bad slot #1, expected 32 bit signed integer" (buffer/push-byte @"AA" :flap))
# Buffer push word
# e755f9830
(def b3 @"")
(buffer/push-word b3 0xFF 0x11)
(assert (= 8 (length b3)) "buffer/push-word 1")
(assert (= "\xFF\0\0\0\x11\0\0\0" (string b3)) "buffer/push-word 2")
(buffer/clear b3)
(buffer/push-word b3 0xFFFFFFFF 0x1100)
(assert (= 8 (length b3)) "buffer/push-word 3")
(assert (= "\xFF\xFF\xFF\xFF\0\x11\0\0" (string b3)) "buffer/push-word 4")
(assert-error "cannot convert 0.5 to machine word" (buffer/push-word @"" 0.5))
# Buffer push string
# 175925207
(def b4 (buffer/new-filled 10 0))
(buffer/push-string b4 b4)
(assert (= "\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0" (string b4))
"buffer/push-buffer 1")
(def b5 @"123")
(buffer/push-string b5 "456" @"789")
(assert (= "123456789" (string b5)) "buffer/push-buffer 2")
# 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")
"%6.3f")
(assert (= (string (buffer/format @"" "pi = %+6.3f" math/pi)) "pi = +3.142")
"%6.3f")
(assert (= (string (buffer/format @"" "pi = %40.20g" math/pi))
"pi = 3.141592653589793116") "%6.3f")
(assert (= (string (buffer/format @"" "🐼 = %6.3f" math/pi)) "🐼 = 3.142")
"UTF-8")
(assert (= (string (buffer/format @"" "π = %.8g" math/pi)) "π = 3.1415927")
"π")
(assert (= (string (buffer/format @"" "\xCF\x80 = %.8g" math/pi))
"\xCF\x80 = 3.1415927") "\xCF\x80")
# Regression #301
# a3d4ecddb
(def b (buffer/new-filled 128 0x78))
(assert (= 38 (length (buffer/blit @"" b -1 90))) "buffer/blit 1")
(def a @"abcdefghijklm")
(assert (deep= @"abcde" (buffer/blit @"" a -1 0 5)) "buffer/blit 2")
(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
(assert (deep= @"abc456" (buffer/push-at @"abc123" 3 "456"))
"buffer/push-at 1")
(assert (deep= @"abc456789" (buffer/push-at @"abc123" 3 "456789"))
"buffer/push-at 2")
(assert (deep= @"abc423" (buffer/push-at @"abc123" 3 "4"))
"buffer/push-at 3")
(end-suite)

44
test/suite-capi.janet Normal file
View File

@@ -0,0 +1,44 @@
# Copyright (c) 2023 Calvin Rose
#
# Permission is hereby granted, free of charge, to any person obtaining a copy
# of this software and associated documentation files (the "Software"), to
# deal in the Software without restriction, including without limitation the
# rights to use, copy, modify, merge, publish, distribute, sublicense, and/or
# sell copies of the Software, and to permit persons to whom the Software is
# furnished to do so, subject to the following conditions:
#
# The above copyright notice and this permission notice shall be included in
# all copies or substantial portions of the Software.
#
# THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
# IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
# FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
# AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
# LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
# FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS
# IN THE SOFTWARE.
(import ./helper :prefix "" :exit true)
(start-suite)
# Tuple types
# c6edf03ae
(assert (= (tuple/type '(1 2 3)) :parens) "normal tuple")
(assert (= (tuple/type [1 2 3]) :parens) "normal tuple 1")
(assert (= (tuple/type '[1 2 3]) :brackets) "bracketed tuple 2")
(assert (= (tuple/type (-> '(1 2 3) marshal unmarshal)) :parens)
"normal tuple marshalled/unmarshalled")
(assert (= (tuple/type (-> '[1 2 3] marshal unmarshal)) :brackets)
"normal tuple marshalled/unmarshalled")
# Dynamic bindings
# 7918add47, 513d551d
(setdyn :a 10)
(assert (= 40 (with-dyns [:a 25 :b 15] (+ (dyn :a) (dyn :b)))) "dyn usage 1")
(assert (= 10 (dyn :a)) "dyn usage 2")
(assert (= nil (dyn :b)) "dyn usage 3")
(setdyn :a 100)
(assert (= 100 (dyn :a)) "dyn usage 4")
(end-suite)

34
test/suite-cfuns.janet Normal file
View File

@@ -0,0 +1,34 @@
# Copyright (c) 2023 Calvin Rose
#
# Permission is hereby granted, free of charge, to any person obtaining a copy
# of this software and associated documentation files (the "Software"), to
# deal in the Software without restriction, including without limitation the
# rights to use, copy, modify, merge, publish, distribute, sublicense, and/or
# sell copies of the Software, and to permit persons to whom the Software is
# furnished to do so, subject to the following conditions:
#
# The above copyright notice and this permission notice shall be included in
# all copies or substantial portions of the Software.
#
# THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
# IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
# FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
# AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
# LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
# FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS
# IN THE SOFTWARE.
(import ./helper :prefix "" :exit true)
(start-suite)
# Inline 3 argument get
# a1ea62a
(assert (= 10 (do (var a 10) (set a (get '{} :a a)))) "inline get 1")
# Regression #24
# f28477649
(def t (put @{} :hi 1))
(assert (deep= t @{:hi 1}) "regression #24")
(end-suite)

77
test/suite-compile.janet Normal file
View File

@@ -0,0 +1,77 @@
# Copyright (c) 2023 Calvin Rose
#
# Permission is hereby granted, free of charge, to any person obtaining a copy
# of this software and associated documentation files (the "Software"), to
# deal in the Software without restriction, including without limitation the
# rights to use, copy, modify, merge, publish, distribute, sublicense, and/or
# sell copies of the Software, and to permit persons to whom the Software is
# furnished to do so, subject to the following conditions:
#
# The above copyright notice and this permission notice shall be included in
# all copies or substantial portions of the Software.
#
# THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
# IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
# FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
# AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
# LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
# FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS
# IN THE SOFTWARE.
(import ./helper :prefix "" :exit true)
(start-suite)
# Regression Test
# 0378ba78
(assert (= 1 (((compile '(fn [] 1) @{})))) "regression test")
# Fix a compiler bug in the do special form
# 3e1e2585
(defn myfun [x]
(var a 10)
(set a (do
(def y x)
(if x 8 9))))
(assert (= (myfun true) 8) "check do form regression")
(assert (= (myfun false) 9) "check do form regression")
# Check x:digits: works as symbol and not a hex number
# 5baf70f4
(def x1 100)
(assert (= x1 100) "x1 as symbol")
(def X1 100)
(assert (= X1 100) "X1 as symbol")
# Edge case should cause old compilers to fail due to
# if statement optimization
# 17283241
(var var-a 1)
(var var-b (if false 2 (string "hello")))
(assert (= var-b "hello") "regression 1")
# d28925fda
(assert (= (string '()) (string [])) "empty bracket tuple literal")
# Bracket tuple issue
# 340a6c4
(let [do 3]
(assert (= [3 1 2 3] [do 1 2 3]) "bracket tuples are never special forms"))
(assert (= ~(,defn 1 2 3) [defn 1 2 3]) "bracket tuples are never macros")
(assert (= ~(,+ 1 2 3) [+ 1 2 3]) "bracket tuples are never function calls")
# Crash issue #1174 - bad debug info
# e97299f
(defn crash []
(debug/stack (fiber/current)))
(do
(math/random)
(defn foo [_]
(crash)
1)
(foo 0)
10)
(end-suite)

181
test/suite-corelib.janet Normal file
View File

@@ -0,0 +1,181 @@
# Copyright (c) 2023 Calvin Rose
#
# Permission is hereby granted, free of charge, to any person obtaining a copy
# of this software and associated documentation files (the "Software"), to
# deal in the Software without restriction, including without limitation the
# rights to use, copy, modify, merge, publish, distribute, sublicense, and/or
# sell copies of the Software, and to permit persons to whom the Software is
# furnished to do so, subject to the following conditions:
#
# The above copyright notice and this permission notice shall be included in
# all copies or substantial portions of the Software.
#
# THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
# IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
# FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
# AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
# LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
# FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS
# IN THE SOFTWARE.
(import ./helper :prefix "" :exit true)
(start-suite)
# ac50f62
(assert (= 10 (+ 1 2 3 4)) "addition")
(assert (= -8 (- 1 2 3 4)) "subtraction")
(assert (= 24 (* 1 2 3 4)) "multiplication")
# d6967a5
(assert (= 4 (blshift 1 2)) "left shift")
(assert (= 1 (brshift 4 2)) "right shift")
# unsigned shift
(assert (= 32768 (brushift 0x80000000 16)) "right shift unsigned 1")
(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-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")
(assert (< 1.0 2.0 3.0 4.0 5.0 6.0) "less than reals")
(assert (> 6 5 4 3 2 1) "greater than integers")
(assert (> 6.0 5.0 4.0 3.0 2.0 1.0) "greater than reals")
(assert (<= 1 2 3 3 4 5 6) "less than or equal to integers")
(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)) "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))
"hi"
(quote hello)
:hello
(array 1 2 3)
(tuple 1 2 3)
(table "a" "b" "c" "d")
(struct 1 2 3 4)
(buffer "hi")
(fn [x] (+ x x))
print) "type ordering")
# b305a7c9b
(assert (= (string (buffer "123" "456")) (string @"123456")) "buffer literal")
# 277117165
(assert (= (get {} 1) nil) "get nil from empty struct")
(assert (= (get @{} 1) nil) "get nil from empty table")
(assert (= (get {:boop :bap} :boop) :bap) "get non nil from struct")
(assert (= (get @{:boop :bap} :boop) :bap) "get non nil from table")
(assert (= (get @"\0" 0) 0) "get non nil from buffer")
(assert (= (get @"\0" 1) nil) "get nil from buffer oob")
(assert (put @{} :boop :bap) "can add to empty table")
(assert (put @{1 3} :boop :bap) "can add to non-empty table")
# 7e46ead
(assert (= 7 (bor 3 4)) "bit or")
(assert (= 0 (band 3 4)) "bit and")
# f41dab8
(assert (= 0xFF (bxor 0x0F 0xF0)) "bit xor")
(assert (= 0xF0 (bxor 0xFF 0x0F)) "bit xor 2")
# Some testing for not=
# 08f6c642d
(assert (not= 1 1 0) "not= 1")
(assert (not= 0 1 1) "not= 2")
# Check if abstract test works
# d791077e2
(assert (abstract? stdout) "abstract? stdout")
(assert (abstract? stdin) "abstract? stdin")
(assert (abstract? stderr) "abstract? stderr")
(assert (not (abstract? nil)) "not abstract? nil")
(assert (not (abstract? 1)) "not abstract? 1")
(assert (not (abstract? 3)) "not abstract? 3")
(assert (not (abstract? 5)) "not abstract? 5")
# Module path expansion
# ff3bb6627
(setdyn :current-file "some-dir/some-file")
(defn test-expand [path temp]
(string (module/expand-path path temp)))
(assert (= (test-expand "abc" ":cur:/:all:") "some-dir/abc")
"module/expand-path 1")
(assert (= (test-expand "./abc" ":cur:/:all:") "some-dir/abc")
"module/expand-path 2")
(assert (= (test-expand "abc/def.txt" ":cur:/:name:") "some-dir/def.txt")
"module/expand-path 3")
(assert (= (test-expand "abc/def.txt" ":cur:/:dir:/sub/:name:")
"some-dir/abc/sub/def.txt") "module/expand-path 4")
# fc46030e7
(assert (= (test-expand "/abc/../def.txt" ":all:") "/def.txt")
"module/expand-path 5")
(assert (= (test-expand "abc/../def.txt" ":all:") "def.txt")
"module/expand-path 6")
(assert (= (test-expand "../def.txt" ":all:") "../def.txt")
"module/expand-path 7")
(assert (= (test-expand "../././././abcd/../def.txt" ":all:") "../def.txt")
"module/expand-path 8")
# module/expand-path regression
# issue #143 - e0fe8476a
(with-dyns [:syspath ".janet/.janet"]
(assert (= (string (module/expand-path "hello" ":sys:/:all:.janet"))
".janet/.janet/hello.janet") "module/expand-path 1"))
# int?
(assert (int? 1) "int? 1")
(assert (int? -1) "int? -1")
(assert (not (int? true)) "int? true")
(assert (not (int? 3.14)) "int? 3.14")
(assert (not (int? 8589934592)) "int? 8589934592")
# memcmp
(assert (= (memcmp "123helloabcd" "1234helloabc" 5 3 4) 0) "memcmp 1")
(assert (< (memcmp "123hellaabcd" "1234helloabc" 5 3 4) 0) "memcmp 2")
(assert (> (memcmp "123helloabcd" "1234hellaabc" 5 3 4) 0) "memcmp 3")
(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)

34
test/suite-debug.janet Normal file
View File

@@ -0,0 +1,34 @@
# Copyright (c) 2023 Calvin Rose
#
# Permission is hereby granted, free of charge, to any person obtaining a copy
# of this software and associated documentation files (the "Software"), to
# deal in the Software without restriction, including without limitation the
# rights to use, copy, modify, merge, publish, distribute, sublicense, and/or
# sell copies of the Software, and to permit persons to whom the Software is
# furnished to do so, subject to the following conditions:
#
# The above copyright notice and this permission notice shall be included in
# all copies or substantial portions of the Software.
#
# THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
# IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
# FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
# AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
# LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
# FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS
# IN THE SOFTWARE.
(import ./helper :prefix "" :exit true)
(start-suite)
# Simple function break
# a8afc5b81
(debug/fbreak map 1)
(def f (fiber/new (fn [] (map inc [1 2 3])) :a))
(resume f)
(assert (= :debug (fiber/status f)) "debug/fbreak")
(debug/unfbreak map 1)
(map inc [1 2 3])
(end-suite)

View File

@@ -1,4 +1,4 @@
# Copyright (c) 2021 Calvin Rose & contributors
# Copyright (c) 2023 Calvin Rose & contributors
#
# Permission is hereby granted, free of charge, to any person obtaining a copy
# of this software and associated documentation files (the "Software"), to
@@ -19,45 +19,58 @@
# IN THE SOFTWARE.
(import ./helper :prefix "" :exit true)
(start-suite 9)
(start-suite)
# 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."))
(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."))
(assert (deep= "hello" (string/trim x))
"capture stdout from os/spawn post close."))
(let [p (os/spawn [janet "-e" `(file/read stdin :line)`] :px {:in :pipe})]
(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 {:in :pipe :out :pipe})]
(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"))
# Parallel subprocesses
(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"))
# Parallel subprocesses
# 5e1a8c86f
(defn calc-1
"Run subprocess, read from stdout, then wait on subprocess."
[code]
(let [p (os/spawn [janet "-e" (string `(printf "%j" ` code `)`)] :px {:out :pipe})]
(let [p (os/spawn [;run janet "-e" (string `(printf "%j" ` code `)`)] :px
{:out :pipe})]
(os/proc-wait p)
(def output (:read (p :out) :all))
(parse output)))
@@ -71,9 +84,13 @@
@[10 26 42]) "parallel subprocesses 1")
(defn calc-2
"Run subprocess, wait on subprocess, then read from stdout. Read only up to 10 bytes instead of :all"
``
Run subprocess, wait on subprocess, then read from stdout. Read only up
to 10 bytes instead of :all
``
[code]
(let [p (os/spawn [janet "-e" (string `(printf "%j" ` code `)`)] :px {:out :pipe})]
(let [p (os/spawn [;run janet "-e" (string `(printf "%j" ` code `)`)] :px
{:out :pipe})]
(def output (:read (p :out) 10))
(os/proc-wait p)
(parse output)))
@@ -87,36 +104,54 @@
@[10 26 42]) "parallel subprocesses 2")
# File piping
# 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 {:out outfile})
(os/execute [;run janet "-e" "(pp (seq [i :range (1 10)] i))"] :p
{:out outfile})
(file/flush outfile)
(file/close outfile)
(os/rm "unique.txt"))
# Ensure that the stream created by os/open works
# each-line iterator
# 70f13f1
(assert-no-error "file/lines iterator"
(def outstream (os/open "unique.txt" :wct))
(def buf1 "123\n456\n")
(defer (:close outstream)
(:write outstream buf1))
(var buf2 "")
(with [f (file/open "unique.txt" :r)]
(each line (file/lines f)
(set buf2 (string buf2 line))))
(assert (= buf1 buf2) "file/lines iterator")
(os/rm "unique.txt"))
# Ensure that the stream created by os/open works
# e8a86013d
(assert-no-error "File writing 4.1"
(def outstream (os/open "unique.txt" :wct))
(defer (:close outstream)
(:write outstream "123\n")
(:write outstream "456\n"))
# Cast to string to enable comparison
(assert (= "123\n456\n" (string (slurp "unique.txt"))) "File writing 4.2")
(assert (= "123\n456\n" (string (slurp "unique.txt")))
"File writing 4.2")
(os/rm "unique.txt"))
# Test that the stream created by os/open can be read from
# 8d8a6534e
(comment
(assert-no-error "File reading 1.1"
(def outstream (os/open "unique.txt" :wct))
@@ -126,17 +161,25 @@
(def outstream (os/open "unique.txt" :r))
(defer (:close outstream)
(assert (= "123\n456\n" (string (:read outstream :all))) "File reading 1.2"))
(assert (= "123\n456\n" (string (:read outstream :all)))
"File reading 1.2"))
(os/rm "unique.txt")))
# ev/gather
# ev/gather
# 4f2d1cdc0
(assert (deep= @[1 2 3] (ev/gather 1 2 3)) "ev/gather 1")
(assert (deep= @[] (ev/gather)) "ev/gather 2")
(assert-error "ev/gather 3" (ev/gather 1 2 (error 3)))
# Net testing
(var cancel-counter 0)
(assert-error "ev/gather 4.1" (ev/gather
(defer (++ cancel-counter) (ev/take (ev/chan)))
(defer (++ cancel-counter) (ev/take (ev/chan)))
(error :oops)))
(assert (= cancel-counter 2) "ev/gather 4.2")
# Net testing
# 2904c19ed
(repeat 10
(defn handler
@@ -162,42 +205,35 @@
(test-echo "world")
(test-echo (string/repeat "abcd" 200))
(:close s))
(defn check-matching-names [stream]
(def ln (net/localname stream))
(def pn (net/peername stream))
(def [my-ip my-port] ln)
(def [remote-ip remote-port] pn)
(def msg (string my-ip " " my-port " " remote-ip " " remote-port))
(def buf @"")
(ev/gather
(net/write stream msg)
(net/read stream 1024 buf))
(def comparison (string/split " " buf))
(assert (and (= my-ip (get comparison 2))
(= (string my-port) (get comparison 3))
(= remote-ip (get comparison 0))
(= (string remote-port) (get comparison 1)))
(string/format "localname should match peername: msg=%j, buf=%j" msg buf)))
(:close s)
(gccollect))
# Test on both server and client
# 504411e
(defn names-handler
[stream]
(defer (:close stream)
(check-matching-names stream)))
# 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")))
# Test localname and peername
(repeat 20
# 077bf5eba
(repeat 10
(with [s (net/server "127.0.0.1" "8000" names-handler)]
(defn test-names []
(repeat 10
(with [conn (net/connect "127.0.0.1" "8000")]
(check-matching-names conn)))
(repeat 20 (test-names)))
(def [host port] (net/peername conn))
(assert (= host "127.0.0.1") "peername host client ")
(assert (= port 8000) "peername port client")
# let server close
(ev/write conn " "))))
(gccollect))
# Create pipe
# 12f09ad2d
(var pipe-counter 0)
(def chan (ev/chan 10))
(let [[reader writer] (os/pipe)]
@@ -213,6 +249,7 @@
(ev/close writer)
(ev/take chan))
# cff52ded5
(var result nil)
(var fiber nil)
(set fiber
@@ -222,10 +259,11 @@
(ev/sleep 0)
(ev/cancel fiber "boop")
(assert (os/execute [janet "-e" `(+ 1 2 3)`] :xp) "os/execute self")
# f0dbc2e
(assert (os/execute [;run janet "-e" `(+ 1 2 3)`] :xp) "os/execute self")
# Test some channel
# e76b8da26
(def c1 (ev/chan))
(def c2 (ev/chan))
(def arr @[])
@@ -267,12 +305,65 @@
(assert (= (slice arr) (slice (range 100))) "ev/chan-close 3")
# threaded channels
# 868cdb9
(def ch (ev/thread-chan 2))
(def att (ev/thread-chan 109))
(assert att "`att` was nil after creation")
(ev/give ch att)
(ev/do-thread
(assert (ev/take ch) "channel packing bug for threaded abstracts on threaded channels."))
(assert (ev/take ch)
"channel packing bug for threaded abstracts on threaded channels."))
# marshal channels
# 76be8006a
(def ch (ev/chan 10))
(ev/give ch "hello")
(ev/give ch "world")
(def ch2 (-> ch marshal unmarshal))
(def item1 (ev/take ch2))
(def item2 (ev/take ch2))
(assert (= item1 "hello"))
(assert (= item2 "world"))
# ev/take, suspended, channel closed
(def ch (ev/chan))
(ev/go |(ev/chan-close ch))
(assert (= (ev/take ch) nil))
# ev/give, suspended, channel closed
(def ch (ev/chan))
(ev/go |(ev/chan-close ch))
(assert (= (ev/give ch 1) nil))
# ev/select, suspended take operation, channel closed
(def ch (ev/chan))
(ev/go |(ev/chan-close ch))
(assert (= (ev/select ch) [:close ch]))
# ev/select, suspended give operation, channel closed
(def ch (ev/chan))
(ev/go |(ev/chan-close ch))
(assert (= (ev/select [ch 1]) [:close ch]))
# 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"))
(end-suite)

Some files were not shown because too many files have changed in this diff Show More