1
0
mirror of https://github.com/janet-lang/janet synced 2025-11-06 10:33:03 +00:00

Compare commits

..

276 Commits

Author SHA1 Message Date
Calvin Rose
d199c817dc Broken Pipe error on windows should just be end of stream. 2020-11-14 16:03:51 -06:00
Calvin Rose
dc51bd09f7 Make sure all test logs go to the same stream. 2020-11-14 15:56:48 -06:00
Calvin Rose
139e3fab25 Invert status check for (Read/Write)File 2020-11-14 15:52:01 -06:00
Calvin Rose
7a98f9aa02 Improve windows error messages on write failures. 2020-11-14 15:48:21 -06:00
Calvin Rose
b53dd67e74 Use custom pipe implementation for overlapped io. 2020-11-14 15:44:19 -06:00
Calvin Rose
e546731093 ev_lasterr -> janet_ev_lasterr 2020-11-14 15:24:13 -06:00
Calvin Rose
d50c4ef6da Try again for windows build. 2020-11-14 15:01:52 -06:00
Calvin Rose
7d0b1955a2 typo 2020-11-14 14:55:26 -06:00
Calvin Rose
16cf7681f0 Fix some windows issues. 2020-11-14 14:40:39 -06:00
Calvin Rose
12f09ad2d7 Add ev/pipe and move stream code into ev.c
Also adds a lot to the C API and changes things up.
2020-11-14 14:29:11 -06:00
Calvin Rose
b3e88a8d80 Move read/write functions into ev.c from net.c
This code can also be used for non-network streams.
2020-11-14 11:48:23 -06:00
Calvin Rose
761273bcc4 Add janet_thread_current() to C api. 2020-11-12 18:42:41 -06:00
Calvin Rose
1a75f68cb2 Fix windows build. 2020-11-12 14:52:02 -06:00
Calvin Rose
1b0edf54f1 Fix gc leak.
Rather than trying to be clever with pinning/unpinning, always
mark the root fiber and that should serve as thei singular common root in almost
all cases.
2020-11-12 14:29:38 -06:00
Calvin Rose
caa6576719 Fix formatting. 2020-11-11 15:35:44 -06:00
Calvin Rose
93bd2c11fa Merge pull request #502 from pepe/fix-net-server-fiber
Fix net server fiber
2020-11-11 15:33:42 -06:00
Josef Pospíšil
2be09790a9 Change fix with ev/call 2020-11-10 10:39:33 +01:00
Josef Pospíšil
bf6eae711a Fix adding handler to loop with fiber 2020-11-10 10:32:47 +01:00
Calvin Rose
69b68c0091 Update changelog. 2020-11-09 11:24:28 -06:00
Calvin Rose
6f1d5d3b73 Add net/listen and net/accept-loop.
These are the elements that make up net/server, which has been moved
into pure Janet instead.
2020-11-09 11:18:09 -06:00
Calvin Rose
099a912992 Fix posix regression. 2020-11-08 19:48:44 -06:00
Calvin Rose
56b1ea3726 Include math.h to fix some bugs on 32 bit windows. 2020-11-08 19:06:35 -06:00
Calvin Rose
d6391f2d70 Get windows IOCP working for accept.
This also changes the api of servers slightly -
in light of having support for ev tasks, it is probably better
to remove the "simple" server code and replace it with some Janet
or remove it all together. While convenient, it has issues with error
handling and rigidity.
2020-11-08 18:56:13 -06:00
Calvin Rose
07910272e2 Get socket reads and writes working with IOCP. 2020-11-08 10:38:28 -06:00
Calvin Rose
1092013c2b Merge branch 'master' into ev 2020-11-07 14:36:25 -06:00
Calvin Rose
0db83bd787 Merge pull request #498 from pepe/fix-asm-example
Fix asm example
2020-11-07 14:35:39 -06:00
Calvin Rose
f55316eabc Merge pull request #494 from harryvederci/patch-1
Fix typo
2020-11-07 14:34:43 -06:00
Calvin Rose
840f59934e Merge pull request #497 from ahungry/bugfix/Adjust-popen-doc
Fix function doc to match that of C POPEN
2020-11-07 14:34:11 -06:00
Calvin Rose
75a9c59ad8 Merge pull request #499 from sogaiu/disasm-doc-typo
Tweak disasm doc
2020-11-07 14:33:53 -06:00
sogaiu
adfccd33ae Tweak disasm doc 2020-11-05 13:56:42 +09:00
Josef Pospíšil
9d41243c15 Fix comments formating 2020-11-04 10:18:31 +01:00
Josef Pospíšil
e33e182eb0 Fix assembly example 2020-11-04 10:16:02 +01:00
Matthew Carter
4dffd662f0 Fix function doc to match that of C POPEN
It may be misleading to some user to believe it is taking a path to a
file, when it is executing an arbitrary shell command for the first argument.
2020-11-03 20:52:02 -05:00
Calvin Rose
5064d579d4 Add net header instead of ifdef check. 2020-11-03 17:49:09 -06:00
Calvin Rose
540425a41b Make docstring less confusing - Fix #493. 2020-11-02 09:09:22 -06:00
Calvin Rose
4d21b582c7 Improve reading and writing from streams.
Handle errors earlier, and allow 0 length packets from UDP
but not from TCP. This should more closely follow the exact specs
of send and recv calls.
2020-11-02 09:06:31 -06:00
Calvin Rose
f288bc1790 Merge pull request #492 from drkameleon/master
Copy editing & fixing typos
2020-11-02 08:29:49 -06:00
Calvin Rose
8942e348bd Small change to windows ev. 2020-11-02 08:27:45 -06:00
Calvin Rose
9f27336827 Update windows ev code. 2020-11-02 08:19:53 -06:00
Calvin Rose
f517cccf7b Fix unix domain sockets.
Also allow abstract unix domain sockets on Linux
(prefixed with '@' as is customary).
2020-11-02 08:16:28 -06:00
Harry Prins
3a937ace51 Fix typo 2020-10-29 08:45:04 +00:00
Yanis Zafirópulos
b8661f8bff Update README.md
Co-authored-by: Michael Camilleri <mike@inqk.net>
2020-10-26 16:21:06 +01:00
Yanis Zafirópulos
51828ab5f8 Copy editing :) 2020-10-26 14:46:31 +01:00
Yanis Zafirópulos
84fe5d7f34 Copy editing :) 2020-10-26 14:44:17 +01:00
Calvin Rose
2891d2b260 Address #489
Add gc pressure when resizing fiber stack.
2020-10-18 18:41:18 -05:00
Calvin Rose
edfb861a5f Disable epoll by default for evloop. 2020-10-11 15:05:27 -05:00
Calvin Rose
88c1cf3ee7 Reformat files. 2020-10-11 09:33:07 -05:00
Calvin Rose
813e3fdcfd Merge branch 'windows-ev' into ev 2020-10-11 09:32:17 -05:00
Calvin Rose
bbe10e4938 Add another select example. 2020-10-11 09:14:31 -05:00
Calvin Rose
cb4903fa86 Overhaul of poll loop, redo ev/select. 2020-10-11 09:14:14 -05:00
Calvin Rose
ea45165db8 Merge branch 'master' into ev 2020-10-10 09:04:05 -05:00
Calvin Rose
1fba699ed4 Merge branch 'master' of github.com:janet-lang/janet into master 2020-10-08 12:35:16 -05:00
Calvin Rose
ce3d574c41 Update docstring. 2020-10-08 12:34:08 -05:00
Calvin Rose
7a601a7eb2 Merge pull request #481 from sogaiu/remove-namespace-reference
Use "module" instead of "namespace" in docstring
2020-10-07 17:43:56 -05:00
sogaiu
9ec66ab826 Use "module" instead of "namespace" in docstring 2020-10-07 18:18:28 +09:00
Calvin Rose
ebfa07f8ce Registering an abstract type is idemptotent. 2020-10-06 19:11:29 -05:00
Calvin Rose
964a800d51 More work on windows event loop code. 2020-10-06 19:07:29 -05:00
Calvin Rose
5c05dec65a Merge pull request #479 from andrewchambers/mf
Add missing Makefile dependencies for install.
2020-10-06 18:26:16 -05:00
Andrew Chambers
bf6ebc4a68 Add missing Makefile dependencies for install. 2020-10-07 10:19:49 +13:00
Calvin Rose
2e944931b3 Update timestamp function to work on windows. 2020-10-04 15:18:31 -05:00
Calvin Rose
db67538311 Work on getting ev support on windows. 2020-10-04 12:46:15 -05:00
Calvin Rose
307c7e00e2 Merge branch 'master' into ev 2020-10-03 11:09:21 -05:00
Calvin Rose
45feb55483 Add integer parsing to pegs. 2020-09-27 12:19:00 -05:00
Calvin Rose
0a1d902f46 Fix #477
Make the walk function preserve bracket type, which should fix
threading macro behavior when threading into bracketed expressions.
2020-09-26 13:28:29 -05:00
Calvin Rose
959a577b5f Merge branch 'master' into ev 2020-09-26 11:50:13 -05:00
Calvin Rose
b91fe8be5a Update CHANGELOG.md 2020-09-20 12:03:59 -05:00
Calvin Rose
d1f0a13ddc janet_try macro and janet_restore function.
This allows catching panics without using pcall.
2020-09-19 18:47:47 -05:00
Calvin Rose
c455bdad11 Get ready for 1.12.2 release. 2020-09-19 16:54:56 -05:00
Calvin Rose
bc1ef813c2 Fix whitespace. 2020-09-19 16:53:35 -05:00
Calvin Rose
603791c0ba Add more help text to doc macro and default repl. 2020-09-19 16:40:07 -05:00
Calvin Rose
8091b1289f Merge branch 'master' of github.com:janet-lang/janet into master 2020-09-19 16:35:43 -05:00
Calvin Rose
cc0035b1d7 Add help text to repl line. 2020-09-19 16:35:32 -05:00
Calvin Rose
ceba1ba4ee Merge pull request #472 from uvtc/patch-1
fix jpm.1 typos
2020-09-18 20:19:22 -05:00
John Gabriele
468e13501c Update jpm.1
Fix some typos.
2020-09-15 00:06:09 -04:00
Calvin Rose
32bf70571a Fix os/spawn piping on windows and free handles on errors. 2020-09-13 20:49:38 -05:00
Calvin Rose
95f4bd8e23 Merge branch 'master' into ev 2020-09-13 11:24:27 -05:00
Calvin Rose
4c9624db64 Update CHANGELOG.md 2020-09-13 11:06:49 -05:00
Calvin Rose
2cbf4d8ad1 Update documentation for thread/send and thread/receive. 2020-09-13 08:38:37 -05:00
Calvin Rose
524c9b50d4 Add windows implementation for piping. 2020-09-12 19:56:48 -05:00
Calvin Rose
d3147b661b Add :pipe to os/spawn for piping to subprocess.
Similar to Python's subprocess.PIPE, this creates and manages pipes
automatically for the caller.
2020-09-12 19:48:12 -05:00
Calvin Rose
d3182dce51 Merge branch 'master' into ev 2020-09-12 10:02:01 -05:00
Calvin Rose
8763df1cd0 Fix some typos. 2020-09-12 09:38:29 -05:00
Calvin Rose
15e05b692c Windows CI remove those pesky carriage returns. 2020-09-07 16:32:31 -05:00
Calvin Rose
2bf5e341d3 Update for 1.12.1 2020-09-07 16:10:33 -05:00
Calvin Rose
b53890ddae Make some changes for WASM build. 2020-09-07 16:08:43 -05:00
Calvin Rose
93602ad9ea Prepare 1.12.0 Release. 2020-09-07 15:28:46 -05:00
Calvin Rose
191d0001f4 Add header on BSDs. 2020-09-07 15:22:18 -05:00
Calvin Rose
1a04ce33f1 Conditionally include epoll headers. 2020-09-07 13:13:28 -05:00
Calvin Rose
babfe50550 Merge branch 'master' into ev
Also add poll implementation for ev.
2020-09-07 12:52:50 -05:00
Calvin Rose
ff57b3eb72 Make zero?, one?, neg? and pos? polymorphic. 2020-09-06 19:05:58 -05:00
Calvin Rose
1837e89fe4 Address #470 - hyphen's in native module names. 2020-09-06 15:23:24 -05:00
Calvin Rose
24b8b0e382 Fix NaNboxing bug that cause flaky builds.
The macro janet_checktype(x, JANET_NUMBER) was incorrect when
x was NaN. This caused the initial unmarshalling dictionary to be missing
entries in certain cases.
2020-09-06 14:59:29 -05:00
Calvin Rose
321a758ab9 Change hash implementation for pointers. 2020-09-06 11:41:45 -05:00
Calvin Rose
1a9c14acde Add checksum to build/janet.c to check for inconsistent builds. 2020-09-06 11:04:07 -05:00
Calvin Rose
e8734c77b4 Fix bug by casting to unsigned char.
Higher unciode codepoints where being read as negative char values.
We need to cast to unsigned char before comparing to 0x20 to check
for unprintable characters.
2020-09-06 10:47:05 -05:00
Calvin Rose
1eb00a9f74 Remove restriction on bytes being input to getline. 2020-09-06 10:36:38 -05:00
Calvin Rose
922a21d359 Run make format. 2020-09-05 21:26:21 -05:00
Calvin Rose
4a4f314768 Update changelog. 2020-09-05 20:23:55 -05:00
Calvin Rose
3c64596ea1 Add %t formatter to janet.
Was not present in printf and family.
2020-09-05 20:21:49 -05:00
Calvin Rose
33283b1b6e Change linking process for standalone executables.
We separate compilation and linking so that mixed C/C++ binaries
will work.
2020-09-05 10:19:34 -05:00
Calvin Rose
2f89bdc672 Conditional compilation on some c99 syntax in header.
If the header is in a C++11 compilation unit, use C++11
aggregate initialization syntax instead.
2020-09-05 09:45:34 -05:00
Calvin Rose
2d275c4782 Enable exception handling for C++ with MSVC. 2020-09-04 21:43:34 -05:00
Calvin Rose
25156eb83e For #469 - Add support for C++ and mixed C/C++
WIP and for native modules. Required a few changes to headers and
some changes to JPM.
2020-09-04 17:41:36 -05:00
Calvin Rose
39032b45c9 Remove extra file. 2020-09-04 14:55:47 -05:00
Calvin Rose
821a8dca3b Fix os/spawn - os/execute switch. 2020-09-04 14:54:58 -05:00
Calvin Rose
0145b133a1 Add os/spawn instead of os/execute with :a 2020-09-04 08:09:05 -05:00
Calvin Rose
b0b137d7f0 Apply formatting to windows changes. 2020-09-02 19:12:27 -05:00
Calvin Rose
b0c09153c2 Allow IO redirection on windows. 2020-09-02 19:07:45 -05:00
Calvin Rose
0485078c6c Fix some issues on BSD and Windows. 2020-09-01 21:47:08 -05:00
Calvin Rose
7079cc43c9 Make some improvements and add os/proc-kill as well. 2020-09-01 21:36:49 -05:00
Calvin Rose
e7fca0051e Add :a option to os/execute, and allow redirecting stdio.
This should help cover a number of common cases for
use of subprocesses. This should also eventually work well
with the ev branch via
2020-09-01 20:06:35 -05:00
Calvin Rose
6273e56886 Add janet_getjfile to C API. 2020-08-29 17:36:14 -05:00
Calvin Rose
8b9ad2dce8 Add :x flag to os/execute. 2020-08-29 10:27:32 -05:00
Calvin Rose
301cbb0e68 Update changelog 2020-08-29 09:22:10 -05:00
Calvin Rose
5313963baf Don't run main when flychecking. 2020-08-29 09:05:18 -05:00
Calvin Rose
f60348eee4 Merge branch 'master' of github.com:janet-lang/janet into master 2020-08-27 08:20:31 -05:00
Calvin Rose
a31e079f93 Fix import macro to not coerce everything to string. 2020-08-27 08:19:41 -05:00
Calvin Rose
556edc9f0d Fix import macro to not coerce everything to string. 2020-08-27 07:46:51 -05:00
Calvin Rose
17d0b7a985 Improve import's handling of non constant args.
Be much more conservative about which arguments are cast to strings.
2020-08-27 07:40:51 -05:00
Calvin Rose
86e00e865e Merge branch 'master' into ev 2020-08-23 11:25:04 -05:00
Calvin Rose
5dda83dc73 Add second argument to disasm. 2020-08-22 16:18:10 -05:00
Calvin Rose
28439d822a Add cancel function.
This should allow better stack unwinding on a fiber that
no longer needs to complete.
2020-08-22 15:35:37 -05:00
Calvin Rose
b1d8ee19ca Enable mutliline paste in shell.c with TCSADRAIN.
Replaces TCSAFLUSH.
2020-08-22 11:39:57 -05:00
Calvin Rose
f7c556ed8d Add curenv to core. 2020-08-22 10:16:14 -05:00
Calvin Rose
5377e10532 Address #466?
Do not restore pc when returning from top most fiber frame.

Also add JANET_DEBUG config define for various debugging related
configurations. In fiber.c, when debug is enabled we reallocate the
entire stack everytime we push a frame to help uncover use after free
errors.
2020-08-17 07:01:58 -05:00
Calvin Rose
30522bbf7d Merge branch 'master' into ev 2020-08-16 17:52:36 -05:00
Calvin Rose
58374623b7 Add a vm_commit before JOP_NEXT. 2020-08-13 22:28:50 -05:00
Calvin Rose
7e7498350f Fix #463
Fix outdated code in macex1, such as checking for unquote-splicing,
    which no longer exists. Also fix macex1 for quasiquoted tables and
    structs. macex1 is not the macro expander used by the compiler, so
    these bugs only affected code which called macex manually, such as
    the short-fn macro.
2020-08-12 06:10:42 -05:00
Calvin Rose
06c268c274 Start working on throwing errors from async functions. 2020-08-11 08:33:24 -05:00
Calvin Rose
9b36e2b145 Be aggressive with setting SO_NOSIGPIPE on BSD/Apple. 2020-08-10 18:59:53 -05:00
Calvin Rose
ca75f8dc20 Address #463 - prevent sigpipe on client connections.
We erroneously did not set SO_NOSIGPIPE on connections aquired with
net/connect, only those quired thorugh net/server. This meant that
failed writes by a client could send sigpipe.
2020-08-10 18:45:44 -05:00
Calvin Rose
6f2f3fdb68 Return an error message if writes fail. Address #462. 2020-08-10 11:06:31 -05:00
Calvin Rose
c903e49a4f Change feature flags for BSD. 2020-08-10 10:42:56 -05:00
Calvin Rose
9121feb44f Update changelog.` 2020-08-09 11:39:40 -05:00
Calvin Rose
7b42ed66f2 Add xprint, xprin, xprintf, and xprinf. 2020-08-09 09:30:58 -05:00
Calvin Rose
fb26c9b2c4 Add ev/select and ev/rselect initial implementation.
Getting closer to a CSP implmententation. Probably
useful to move scheduling fields outside of fibers
and into an external table.
2020-08-09 00:20:27 -05:00
Calvin Rose
78ffb63429 Disallow mutlitple state machines waiting for a single fiber.
A 'select' operator will be channel based, not state machine based.
2020-08-08 07:51:46 -05:00
Calvin Rose
1213990b7d Merge branch 'master' into ev 2020-08-07 19:51:37 -05:00
Calvin Rose
c3af30d520 Fix broken links in README.md 2020-08-07 19:48:06 -05:00
Calvin Rose
2598123140 Rename test suites such that it is easier to add more of them. 2020-08-07 15:34:13 -05:00
Calvin Rose
40627191f3 Merge pull request #460 from andrewchambers/fix
Add missing JANET_API to janet_cryptorand.
2020-08-07 11:46:44 -05:00
Andrew Chambers
38dc844e85 Add missing JANET_API to janet_cryptorand. 2020-08-07 14:02:26 +12:00
Calvin Rose
abc4405a76 Address #459 - Update meson.build
Don't search for cross compilerUnless needed.
This should help prevent issues building Meson on debian. Also
fix issue using the wrong set of flags to build the native janet
interpreter vs. the cross compiled janet interpreter.
2020-08-06 20:45:18 -05:00
Calvin Rose
243c66442d Add PRF enabled build to sourcehut builds. 2020-08-04 10:30:54 -05:00
Calvin Rose
9afcec77f6 Disable PRF by default. 2020-08-03 21:52:57 -05:00
Calvin Rose
70ad98cc6f Fix arc4random_buf implementation. 2020-08-03 21:49:49 -05:00
Calvin Rose
76cfbde933 Add JANET_HASHSEED environment variable. 2020-08-03 20:56:11 -05:00
Calvin Rose
f200bd9594 Merge pull request #455 from andrewchambers/prfseed
Initialize PRF with random data when it is enabled.
2020-08-03 20:14:51 -05:00
Andrew Chambers
4d4ca7bb36 Initialize PRF with random data when it is enabled. 2020-08-04 12:13:36 +12:00
Calvin Rose
78c3c6dafa Merge branch 'master' of github.com:janet-lang/janet into master 2020-08-03 17:44:37 -05:00
Calvin Rose
6d859dec67 Exit with error code if jpm install fails. 2020-08-03 17:41:16 -05:00
Calvin Rose
3563e7e1aa Add -fPIC to default cflags when building boot image. 2020-08-03 17:32:41 -05:00
Calvin Rose
cb898fabf4 Set default channel size to 0. 2020-08-03 07:57:02 -05:00
Calvin Rose
5899671d96 Merge branch 'master' into ev 2020-08-03 07:54:53 -05:00
Calvin Rose
8c1eb23aa1 Add -fPIC to default cflags when building boot image. 2020-08-02 13:52:21 -05:00
Calvin Rose
b564087db0 Add index-of to core library. 2020-08-02 13:47:56 -05:00
Calvin Rose
1748e8510e Fix typo in docstring. 2020-08-02 13:27:49 -05:00
Calvin Rose
742c5bb639 Use a common queue implementation.
Queues occur in three places, so we use a single
implementation rather than three separate ones. This also
has the result that janet_vm_spawn will not overflow in the case
of channel-heavy, IO-light operation.
2020-08-01 14:20:58 -05:00
Calvin Rose
297de01d95 Add preliminary channel implementation. 2020-08-01 13:13:58 -05:00
Calvin Rose
fb31c3b46d Merge pull request #454 from soapdog/fix-windows-on-arm64
Make sure JANET_NO_NANBOX is defined for ARM targets
2020-07-29 13:13:47 -05:00
Andre Alves Garzia
ba2beffcd8 Make sure JANET_NO_NANBOX is defined for ARM targets 2020-07-28 16:51:19 +01:00
Calvin Rose
2eb2dddb59 Begin work on channels. 2020-07-26 23:45:25 -05:00
Calvin Rose
0601d851d0 Merge pull request #453 from niacat/master
Fix build on NetBSD.
2020-07-26 22:15:46 -05:00
nia
b731f6ab03 Fix build on NetBSD.
The NetBSD C library's headers do not expose extensions when
compiling with -std=c99 (as opposed to -std=gnu99 or no -std=
option), so define _NETBSD_SOURCE to get timegm, and functions
that would otherwise require an _XOPEN_SOURCE definition, e.g.
realpath.

Note that, as with FreeBSD, you need gmake to compile janet
on NetBSD, and can also install it from packages.
2020-07-27 00:21:15 +01:00
Calvin Rose
0403e306ed Silence warnings from some compilers. 2020-07-26 08:48:22 -05:00
Calvin Rose
d393fbf360 Merge branch 'master' into ev 2020-07-25 14:07:47 -05:00
Calvin Rose
4cc680965c Prepare for 1.11.1 release. 2020-07-25 13:48:43 -05:00
Calvin Rose
ba08e487cb Disable PRF by default.
Since it is not any better by default without initializing the key, we
disable it by default. It can be turned on with JANET_PRF in
janetconf.h.
2020-07-25 13:34:40 -05:00
Calvin Rose
d37eda4e9b Don't use x43bot to test install. 2020-07-25 13:23:57 -05:00
Calvin Rose
3960d0f6de Merge branch 'master' into ev 2020-07-25 13:17:05 -05:00
Calvin Rose
5be5e5b58f Update soname. 2020-07-25 13:11:52 -05:00
Calvin Rose
04ac9b8e32 Update README.md 2020-07-25 10:14:59 -05:00
Calvin Rose
409a8a3a43 Fix #452 - Bad file marshal
We forgot a call to janet_marshal_abstract, which corrupted the output.
2020-07-25 08:09:22 -05:00
Calvin Rose
1ba3f72e4c Update meson build. 2020-07-24 13:03:10 -05:00
Calvin Rose
3e5e9e57e9 Fix sourcehut builds yml file. 2020-07-24 12:29:31 -05:00
Calvin Rose
02e5e49de2 Fix buffer overflow. 2020-07-24 07:04:32 -05:00
Calvin Rose
43438d3824 Allow getting typed arrays from byte sequences.
Fix native importing for .so files in current directory.
2020-07-24 07:01:34 -05:00
Calvin Rose
8f82d19fd1 Merge branch 'master' of github.com:janet-lang/janet 2020-07-21 13:40:58 -05:00
Calvin Rose
ee450bcd77 Fix jpm on windows with multiple git binaries. 2020-07-21 13:40:23 -05:00
Calvin Rose
553b4d9428 Add timeouts to net functions.
Further debugging of the general timeout system, as well
as having a single fiber wait on multiple state machines (select).
2020-07-19 19:41:12 -05:00
Calvin Rose
df145f4bc9 Merge branch 'master' into ev 2020-07-19 17:20:43 -05:00
Calvin Rose
fa55283f62 Release 1.11.0 2020-07-18 16:21:01 -05:00
Calvin Rose
9e163db491 Test building binaries with jpm.
Test in CI with both meson and normal build.
Also test windows.
2020-07-18 15:50:58 -05:00
Calvin Rose
286230f477 Fix meson paths. 2020-07-18 15:44:04 -05:00
Calvin Rose
3ba2c7e7e8 Address #394 and #451 - Prepare for 1.11.0
Prefix MANPATH and PKG_CONFIG_PATH variables
with JANET_ to disassociate with standard env variables
that have a different format.
2020-07-18 13:09:53 -05:00
Calvin Rose
b4f5e5bc00 Update docs for -l option. 2020-07-06 21:25:41 -05:00
Calvin Rose
f580d2e41a Add forever macro and add names to anon fns.
Adding names to anon functions that may error improves
stack traces, especially for user visible traces.
2020-07-06 19:26:37 -05:00
Calvin Rose
cd197e8be3 Add ev/call.
This is a common operation, and making fibers manually can be tedious.
2020-07-06 19:13:32 -05:00
Calvin Rose
51cf6465ff Merge branch 'master' into ev 2020-07-06 17:22:38 -05:00
Calvin Rose
a1feb32a2f Update CHANGELOG.md 2020-07-06 17:21:55 -05:00
Calvin Rose
7478ad115f Add any? predicate to core.
This is the contrapositive to `every?`, and is analagous to `or` as
`every?` is to `and`.
2020-07-06 09:19:10 -05:00
Calvin Rose
9d8e338a11 Update default repl prompt to match errors. 2020-07-05 23:32:59 -05:00
Calvin Rose
ed4163cfde Replace copyright on boot with system information. 2020-07-05 23:24:07 -05:00
Calvin Rose
bd95f742c0 Merge branch 'master' into ev 2020-07-05 23:14:49 -05:00
Calvin Rose
463e6d9316 Merge pull request #448 from GrayJack/fix-table-remove
Fix janet_table_remove returning the key instead of the value
2020-07-05 18:36:54 -05:00
Calvin Rose
3358811788 Update changelog and sort listing. 2020-07-05 17:51:49 -05:00
Calvin Rose
a45509d28e Add list-pkgs and list-installed to jpm. 2020-07-05 17:43:39 -05:00
Calvin Rose
9ba94d2c6b More work on timeouts and racing listeners.
When two listeners are racing to resume the same fiber, the
first should cancel out the other.
2020-07-05 17:26:17 -05:00
Calvin Rose
a4de83b3a3 Merge branch 'master' into ev 2020-07-05 10:11:23 -05:00
Calvin Rose
68a12d1d17 Minor fixes for meson minimum build.
Also, fix regression that looses function name information.
2020-07-03 20:41:55 -05:00
Calvin Rose
c97d3cf359 Fix minimum meson build. 2020-07-03 20:30:09 -05:00
Calvin Rose
4721337c7c issues with gettime on mach kernel. 2020-07-03 20:19:36 -05:00
Calvin Rose
2b36ed967c Address some windows issues. 2020-07-03 20:13:49 -05:00
Calvin Rose
3bb8f1ac8d Don't use CLOCK_MONOTONIC for pthread stuff.
Also fix marshalling functions without full
sourcemapping information, as well as thread/receive
ignoring bad messages. Instead, thread/receive will error
on bad messages.
2020-07-03 19:54:58 -05:00
Calvin Rose
617ec7f565 Threading improvements.
- Add thread/exit to kill the current thread.
- Add global lock aroung custom getline and add atexit handler
- to prevent any possible issues when exiting program.
- Allow sending stderr, stdout, and stdin over thread.
2020-07-03 16:28:07 -05:00
Calvin Rose
dc259b9f8e Set fiber env for heavyweight threads.
Since you already incur the cost of creating the
core environment, this is probably what you want anyways.
This will make eval and other reflective code work as expected.
2020-07-03 15:20:19 -05:00
Calvin Rose
7b31a87b3c Update integer limits and printing. 2020-07-03 14:14:59 -05:00
Calvin Rose
37a430c97c Move declarations around. 2020-07-03 13:47:48 -05:00
Calvin Rose
f264cb0b18 Merge branch 'master' into ev 2020-07-03 12:26:01 -05:00
Calvin Rose
6ea530cc48 Address compilation warnings and errors. 2020-07-03 12:25:24 -05:00
Calvin Rose
a0abf307b4 Merge branch 'master' into ev 2020-07-03 12:14:48 -05:00
Calvin Rose
55cf9f5e1c Don't break reverse backwards compat.
Breaking backwards compatibiliy here is not worth it.
Also update changelog.
2020-07-03 10:17:50 -05:00
Calvin Rose
b89f0fac7b Move clock shims to util (Helps #430).
The thread module should also use these clock shims rather
than clock_gettime, which is not available on older mac systems.
2020-07-03 09:54:58 -05:00
GrayJack
8b3b3182bd Add tests to check janet_table_remove behaviour 2020-07-02 11:03:08 -03:00
Calvin Rose
97c64f27ff Remove duplicate code in loop macro.
Also evaluate for loop and range step exactly once.
Multiple evaluations can be inefficent and make infinite loop
detection impossible.
2020-07-01 22:37:04 -05:00
Calvin Rose
e548e1f6e0 Add peg/replace and peg/replace-all 2020-07-01 21:29:24 -05:00
GrayJack
7ea1c7d85a Fix janet_table_remove returning the key instead of the value 2020-07-01 20:05:07 -03:00
Calvin Rose
e08235b575 Merge pull request #436 from cellularmitosis/no_arc4random_buf
Add support for systems which are missing arc4random_buf
2020-07-01 15:54:15 -05:00
Calvin Rose
783c672130 Merge pull request #437 from pepe/add-peg-find-tests
Add tests for peg/find and peg/find-all
2020-07-01 15:48:43 -05:00
Calvin Rose
5351a6b2ed Merge pull request #447 from cellularmitosis/nan
math/nan
2020-07-01 15:47:13 -05:00
Jason Pepas
a110b103e8 math/nan 2020-07-01 15:35:36 -05:00
Josef Pospíšil
c26f573620 Add tests for peg/find and peg/find-all 2020-06-30 17:03:13 +02:00
Jason Pepas
f06e9ae30c Switch to using /dev/urandom for OS X prior to 10.7 2020-06-30 04:18:08 -05:00
Jason Pepas
f5d208d5d6 eliminate large stack allocation from arc4random_buf bodge 2020-06-30 04:06:20 -05:00
Calvin Rose
7fb8c4a68d Merge branch 'master' of github.com:janet-lang/janet 2020-06-29 22:57:46 -05:00
Calvin Rose
647fc56d47 Replace for with forv in most places in boot.janet
Generates slightly better bytecode with current compiler
(gets rid of a single extra move instruction per loop iteration).
2020-06-29 22:56:16 -05:00
Jason Pepas
597d84e263 Add support for systems missing arc4random_buf 2020-06-29 21:06:13 -05:00
Calvin Rose
977b0c3c0c Merge pull request #429 from pepe/fix-reverse-doc
Tune reverse[d] docstrings
2020-06-29 20:55:04 -05:00
Calvin Rose
1b0d6de735 Merge pull request #432 from cellularmitosis/no_cloexec
Support for systems missing O_CLOEXEC
2020-06-29 20:54:41 -05:00
Calvin Rose
2f5bb7774e Fix recursive post-deps. 2020-06-29 20:51:38 -05:00
Jason Pepas
5565f02dbd Simplifying workaround for missing O_CLOEXEC 2020-06-29 19:36:18 -05:00
Calvin Rose
17a131ac21 Add peg/find and peg/find-all.
These peg functions should make pegs a bit easier to use
and more efficient in some common cases.
2020-06-29 19:13:06 -05:00
Calvin Rose
9a5cfe9f75 Merge branch 'master' of github.com:janet-lang/janet 2020-06-29 13:47:02 -05:00
Calvin Rose
cc936d9977 Merge pull request #435 from pepe/add-keyword-symbol-slice-tests
Add keyword/slice and symbol/slice tests
2020-06-29 09:11:35 -05:00
Josef Pospíšil
e9911fee4d Add keyword/slice and symbol/slice tests 2020-06-29 09:18:26 +02:00
Calvin Rose
aefde67aa2 And lots of optimization functionality. 2020-06-28 18:16:57 -05:00
Calvin Rose
a1ea62a923 Fix optimization of do_get.
When the target slot (register) is the same as the default
register, do not clobber it.
2020-06-28 15:52:59 -05:00
Calvin Rose
7209ced446 Merge branch 'master' of github.com:janet-lang/janet 2020-06-28 15:09:01 -05:00
Calvin Rose
db63d352a2 Add specialization for 3 argument get.
This can be inlined with jmpnn instruction (jump if not nil) to
skip over the default value.

(get a b c)

can be exanded statically to

asm start:
    (get $0 $1 $2)
    (jmpnn $0 :label)
    ... Instructions to load default value to $0 - often a load.
    :label
asm end.
2020-06-28 15:03:01 -05:00
Josef Pospíšil
289de840fd Specify input types actions 2020-06-28 20:49:44 +02:00
Calvin Rose
cb34a8b620 Merge pull request #434 from elimisteve/master
Add .gitattributes: syntax highlight .janet files as Clojure
2020-06-27 17:01:45 -05:00
Calvin Rose
95c633914f Add auto-resizing of gc interval.
This should prevent over use of GC and O(n^2)
behavior.
2020-06-27 16:51:20 -05:00
Calvin Rose
d033412b1f Add symbol/slice and keyword/slice 2020-06-27 15:22:15 -05:00
Calvin Rose
9c5e97144d More small changes to help with cross compilation
via makefile. Add option to turn off built in
getline via janetconf.
2020-06-27 12:39:16 -05:00
Calvin Rose
8b96289e2f Merge branch 'master' of github.com:janet-lang/janet 2020-06-27 11:24:03 -05:00
Calvin Rose
51ff43e2f2 Update range checks for 64 bit integers. 2020-06-27 11:23:47 -05:00
Calvin Rose
1e30f4f973 Merge pull request #427 from pyrmont/nil-empty-string
Change default string representation of nil to empty string
2020-06-26 22:47:16 -05:00
Calvin Rose
36f66661f7 Merge pull request #431 from cellularmitosis/master
Add ppc to os/arch
2020-06-26 22:43:41 -05:00
Steve Phillips
de27fc15b6 Add .gitattributes: detect/syntax highlight .janet files as Clojure 2020-06-26 20:31:42 -07:00
Jason Pepas
f9f90ba1d6 Support for systems missing O_CLOEXEC 2020-06-26 14:44:57 -05:00
Jason Pepas
51bf8a3538 Add ppc to os/arch 2020-06-26 04:11:21 -05:00
Josef Pospíšil
7b033a48a3 Wrap both reverse and reversed docstring to 80 chr 2020-06-25 09:43:10 +02:00
Josef Pospíšil
1b420f69aa Fix reverse docstring 2020-06-25 09:35:03 +02:00
Calvin Rose
6a187a384b Make zipcoll more generic.
Work with any iterable (next) type.
2020-06-24 16:10:57 -05:00
Calvin Rose
ac5de1f96e Change compare-primitive to cmp.
cmp is implemented as a VM instruction rather than
a function.
2020-06-24 16:00:00 -05:00
Calvin Rose
6c917f686a Add :h default peg class, as well as ad \v to whitespace. 2020-06-24 08:40:23 -05:00
Calvin Rose
328ee94412 Merge branch 'master' into ev 2020-06-22 22:25:44 -05:00
Calvin Rose
de9951594e Allow setting dynamic bindings at C top level.
Before, these bindings we just ignored. However, it useful for
controlling janet_printf and janet_eprintf, for example. These can
be called from C code without being inside a call to janet_continue.
2020-06-22 08:56:04 -05:00
Calvin Rose
561fc15ae9 Address #426 parse errors in *out janet_dostring
This should make its use a little more robust for
simple usage. To avoid printing to stderr, use

janet_table_put(env, janet_ckeywordv("err"), janet_wrap_false());
2020-06-22 08:34:17 -05:00
Calvin Rose
d65814c53f Update changelog.md 2020-06-21 18:52:10 -05:00
Calvin Rose
803f17aa90 Add eachy and repeat to make looping easier.
Like eachk and eachp, use eachy and repeat to bring loop
verbs outside of the loop macro. These new macros are very simple
and easy to understand, in contrast to the loop macro which is of
medium complexity.
2020-06-21 18:48:06 -05:00
Calvin Rose
08a3687eb5 Fix #428
Add binding check for generate verb in loops. The check is present
in other loop verbs.
2020-06-21 15:57:55 -05:00
Michael Camilleri
c4035b2273 Change string representation of nil to empty string 2020-06-21 17:54:06 +09:00
Calvin Rose
5c364e0f7c Better roundtrip jdn.
Use the most precise format specifier, such that output jdn numbers
are more accurate.
2020-06-18 21:54:34 -05:00
Calvin Rose
b1a4f05b5a Explicitly disallow handler for datagram server. 2020-06-13 08:29:48 -05:00
Calvin Rose
ce2079104a Merge branch 'master' into ev 2020-06-11 19:20:51 -05:00
Calvin Rose
d64e9b6263 Remove snapcraft. 2020-06-06 10:31:16 -05:00
Calvin Rose
123710078d Add unix domain socket support to net.
Code is a bit messy, as getaddrinfo does not support
unix domain sockets directly. We require a keyword :unix
instead of the usual hostname string, and the port is the
path to unix domain socket. The UDS should support both stream
and datagram sockets.
2020-06-03 00:53:17 -05:00
Calvin Rose
ec0d0ba368 Initial UDP implementation. 2020-06-02 19:47:50 -05:00
Calvin Rose
3f434f2a44 Add backpressure capability to net. 2020-05-31 15:46:01 -05:00
Calvin Rose
71d8e6b4cd Merge branch 'master' into ev 2020-05-30 11:35:19 -05:00
Calvin Rose
a78af0a7fb Do not explicitly free state machines, instead return a status.
This makes it harder to have some kind of use after free issue.
2020-05-30 11:31:05 -05:00
Calvin Rose
117ae196fd Add net/flush.
Useful for simple TCP protocols (netrepl), which benefit from being able
to immediately send a message.
2020-05-28 19:22:38 -05:00
Calvin Rose
4c211c8dce More updates to the ev library. 2020-05-28 16:51:11 -05:00
Calvin Rose
c10d9b9d9d Merge branch 'master' into asyncio 2020-05-28 10:57:10 -05:00
Calvin Rose
b68b0a256e Start with ev module. 2020-05-28 10:39:40 -05:00
80 changed files with 5444 additions and 1309 deletions

View File

@@ -10,3 +10,5 @@ tasks:
cd build
ninja
ninja test
doas ninja install
doas jpm --verbose install circlet

15
.builds/meson2.yml Normal file
View File

@@ -0,0 +1,15 @@
image: openbsd/latest
sources:
- https://git.sr.ht/~bakpakin/janet
packages:
- meson
tasks:
- build: |
cd janet
meson setup build --buildtype=release
cd build
meson configure -Dprf=true
ninja
ninja test
doas ninja install
doas jpm --verbose install circlet

View File

@@ -17,7 +17,6 @@ tasks:
meson configure -Dpeg=false
meson configure -Dassembler=false
meson configure -Dint_types=false
meson configure -Dtyped_arrays=false
meson configure -Dtyped_array=false
meson configure -Dreduced_os=true
meson configure -Dprf=false
ninja # will not pass tests but should build

10
.gitattributes vendored Normal file
View File

@@ -0,0 +1,10 @@
*.janet linguist-language=Clojure
*.janet text eol=lf
*.c text eol=lf
*.h text eol=lf
*.md text eol=lf
*.yml text eol=lf
*.build text eol=lf
*.txt text eol=lf
*.sh text eol=lf

9
.gitignore vendored
View File

@@ -32,6 +32,9 @@ lockfile.janet
# Local directory for testing
local
# Common test file I use.
temp.janet
# Emscripten
*.bc
janet.js
@@ -43,6 +46,7 @@ janet.wasm
# Generate test files
*.out
.orig
# Tools
xxd
@@ -50,6 +54,7 @@ xxd.exe
# VSCode
.vs
.clangd
# Swap files
*.swp
@@ -61,6 +66,10 @@ tags
vgcore.*
*.out.*
# Wix artifacts
*.msi
*.wixpdb
# Created by https://www.gitignore.io/api/c
### C ###

View File

@@ -1,6 +1,87 @@
# Changelog
All notable changes to this project will be documented in this file.
## Unreleased - ???
- Add `janet_thread_current(void)` to C API
- Add integer parsing forms to pegs. This makes parsing many binary protocols easier.
- Lots of updates to networking code - now can use epoll (or poll) on linux and IOCP on windows.
- Add `ev/` module. This exposes a fiber scheduler, queues, timeouts, and other functionality to users
for single threaded cooperative scheduling and asynchornous IO.
- Add `net/accept-loop` and `net/listen`. These functions break down `net/server` into it's essential parts
and are more flexible. They also allow furter improvements to these utility functions.
## 1.12.2 - 2020-09-20
- Add janet\_try and janet\_restore to C API.
- Fix `os/execute` regression on windows.
- Add :pipe option to `os/spawn`.
- Fix docstring typos.
## 1.12.1 - 2020-09-07
- Make `zero?`, `one?`, `pos?`, and `neg?` polymorphic.
- Add C++ support to jpm and improve C++ interop in janet.h.
- Add `%t` formatter to `printf`, `string/format`, and other formatter functions.
- Expose `janet_cfuns_prefix` in C API.
- Add `os/proc-wait` and `os/proc-kill` for interacting with processes.
- Add `janet_getjfile` to C API.
- Allow redirection of stdin, stdout, and stderr by passing keywords in the env table in `os/spawn` and `os/execute`.
- Add `os/spawn` to get a core/process back instead of an exit code as in `os/execute`.
When called like this, `os/execute` returns immediately.
- Add `:x` flag to os/execute to raise error when exit code is non-zero.
- Don't run `main` when flychecking.
- Add `:n` flag to `file/open` to raise an error if file cannot be opened.
- Fix import macro to not try and coerce everything to a string.
- Allow passing a second argument to `disasm`.
- Add `cancel`. Resumes a fiber but makes it immediately error at the yield point.
- Allow multi-line paste into built in repl.
- Add `(curenv)`.
- Change `net/read`, `net/chunk`, and `net/write` to raise errors in the case of failures.
- Add `janet_continue_signal` to C API. This indirectly enables C functions that yield to the event loop
to raise errors or other signals.
- Update meson build script to fix bug on Debian's version of meson
- Add `xprint`, `xprin`, `xprintf`, and `xprinf`.
- `net/write` now raises an error message if write fails.
- Fix issue with SIGPIPE on macOS and BSDs.
## 1.11.3 - 2020-08-03
- Add `JANET_HASHSEED` environment variable when `JANET_PRF` is enabled.
- Expose `janet_cryptorand` in C API.
- Properly initialize PRF in default janet program
- Add `index-of` to core library.
- Add `-fPIC` back to core CFLAGS (non-optional when compiling default client with Makefile)
- Fix defaults on Windows for ARM
- Fix defaults on NetBSD.
## 1.11.1 - 2020-07-25
- Fix jpm and git with multiple git installs on Windows
- Fix importing a .so file in the current directory
- Allow passing byte sequence types directly to typed-array constructors.
- Fix bug sending files between threads.
- Disable PRF by default.
- Update the soname.
## 1.11.0 - 2020-07-18
- Add `forever` macro.
- Add `any?` predicate to core.
- Add `jpm list-pkgs` subcommand to see which package aliases are in the listing.
- Add `jpm list-installed` subcommand to see which packages are installed.
- Add `math/int-min`, `math/int-max`, `math/int32-min`, and `math/int32-max` for getting integer limits.
- The gc interval is now autotuned, to prevent very bad gc behavior.
- Improvements to the bytecode compiler, Janet will now generate more efficient bytecode.
- Add `peg/find`, `peg/find-all`, `peg/replace`, and `peg/replace-all`
- Add `math/nan`
- Add `forv` macro
- Add `symbol/slice`
- Add `keyword/slice`
- Allow cross compilation with Makefile.
- Change `compare-primitve` to `cmp` and make it more efficient.
- Add `reverse!` for reversing an array or buffer in place.
- `janet_dobytes` and `janet_dostring` return parse errors in \*out
- Add `repeat` macro for iterating something n times.
- Add `eachy` (each yield) macro for iterating a fiber.
- Fix `:generate` verb in loop macro to accept non symbols as bindings.
- Add `:h`, `:h+`, and `:h*` in `default-peg-grammar` for hexidecimal digits.
- Fix `%j` formatter to print numbers precisely (using the `%.17g` format string to printf).
## 1.10.1 - 2020-06-18
- Expose `janet_table_clear` in API.
- Respect `JANET_NO_PROCESSES` define when building

View File

@@ -33,13 +33,20 @@ JANET_TARGET=build/janet
JANET_LIBRARY=build/libjanet.so
JANET_STATIC_LIBRARY=build/libjanet.a
JANET_PATH?=$(LIBDIR)/janet
MANPATH?=$(PREFIX)/share/man/man1/
PKG_CONFIG_PATH?=$(LIBDIR)/pkgconfig
JANET_MANPATH?=$(PREFIX)/share/man/man1/
JANET_PKG_CONFIG_PATH?=$(LIBDIR)/pkgconfig
DEBUGGER=gdb
SONAME_SETTER=-Wl,-soname,
CFLAGS:=$(CFLAGS) -std=c99 -Wall -Wextra -Isrc/include -Isrc/conf -fPIC -O2 -fvisibility=hidden
LDFLAGS:=$(LDFLAGS) -rdynamic
# For cross compilation
HOSTCC?=$(CC)
HOSTAR?=$(AR)
CFLAGS?=-O2
LDFLAGS?=-rdynamic
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)
BUILD_CFLAGS:=$(CFLAGS) $(COMMON_CFLAGS)
# For installation
LDCONFIG:=ldconfig "$(LIBDIR)"
@@ -90,6 +97,7 @@ JANET_CORE_SOURCES=src/core/abstract.c \
src/core/corelib.c \
src/core/debug.c \
src/core/emit.c \
src/core/ev.c \
src/core/fiber.c \
src/core/gc.c \
src/core/inttypes.c \
@@ -131,11 +139,10 @@ JANET_BOOT_HEADERS=src/boot/tests.h
##########################################################
JANET_BOOT_OBJECTS=$(patsubst src/%.c,build/%.boot.o,$(JANET_CORE_SOURCES) $(JANET_BOOT_SOURCES))
BOOT_CFLAGS:=-DJANET_BOOTSTRAP -DJANET_BUILD=$(JANET_BUILD) $(CFLAGS)
$(JANET_BOOT_OBJECTS): $(JANET_BOOT_HEADERS)
build/%.boot.o: src/%.c $(JANET_HEADERS) $(JANET_LOCAL_HEADERS)
build/%.boot.o: src/%.c $(JANET_HEADERS) $(JANET_LOCAL_HEADERS) Makefile
$(CC) $(BOOT_CFLAGS) -o $@ -c $<
build/janet_boot: $(JANET_BOOT_OBJECTS)
@@ -143,13 +150,14 @@ build/janet_boot: $(JANET_BOOT_OBJECTS)
# Now the reason we bootstrap in the first place
build/janet.c: build/janet_boot src/boot/boot.janet
build/janet_boot . JANET_PATH '$(JANET_PATH)' JANET_HEADERPATH '$(INCLUDEDIR)/janet' > $@
build/janet_boot . JANET_PATH '$(JANET_PATH)' > $@
cksum $@
########################
##### Amalgamation #####
########################
SONAME=libjanet.so.1.10
SONAME=libjanet.so.1.12
build/shell.c: src/mainclient/shell.c
cp $< $@
@@ -161,24 +169,26 @@ build/janetconf.h: src/conf/janetconf.h
cp $< $@
build/janet.o: build/janet.c build/janet.h build/janetconf.h
$(CC) $(CFLAGS) -c $< -o $@ -I build
$(HOSTCC) $(BUILD_CFLAGS) -c $< -o $@ -I build
build/shell.o: build/shell.c build/janet.h build/janetconf.h
$(CC) $(CFLAGS) -c $< -o $@ -I build
$(HOSTCC) $(BUILD_CFLAGS) -c $< -o $@ -I build
$(JANET_TARGET): build/janet.o build/shell.o
$(CC) $(LDFLAGS) $(CFLAGS) -o $@ $^ $(CLIBS)
$(HOSTCC) $(LDFLAGS) $(BUILD_CFLAGS) -o $@ $^ $(CLIBS)
$(JANET_LIBRARY): build/janet.o build/shell.o
$(CC) $(LDFLAGS) $(CFLAGS) $(SONAME_SETTER)$(SONAME) -shared -o $@ $^ $(CLIBS)
$(HOSTCC) $(LDFLAGS) $(BUILD_CFLAGS) $(SONAME_SETTER)$(SONAME) -shared -o $@ $^ $(CLIBS)
$(JANET_STATIC_LIBRARY): build/janet.o build/shell.o
$(AR) rcs $@ $^
$(HOSTAR) rcs $@ $^
###################
##### Testing #####
###################
# Testing assumes HOSTCC=CC
TEST_SCRIPTS=$(wildcard test/suite*.janet)
repl: $(JANET_TARGET)
@@ -252,7 +262,7 @@ build/janet.pc: $(JANET_TARGET)
echo 'Libs: -L$${libdir} -ljanet' >> $@
echo 'Libs.private: $(CLIBS)' >> $@
install: $(JANET_TARGET) build/janet.pc build/jpm
install: $(JANET_TARGET) $(JANET_LIBRARY) $(JANET_STATIC_LIBRARY) build/janet.pc build/jpm
mkdir -p '$(DESTDIR)$(BINDIR)'
cp $(JANET_TARGET) '$(DESTDIR)$(BINDIR)/janet'
mkdir -p '$(DESTDIR)$(INCLUDEDIR)/janet'
@@ -264,11 +274,11 @@ install: $(JANET_TARGET) build/janet.pc build/jpm
ln -sf $(SONAME) '$(DESTDIR)$(LIBDIR)/libjanet.so'
ln -sf libjanet.so.$(shell $(JANET_TARGET) -e '(print janet/version)') $(DESTDIR)$(LIBDIR)/$(SONAME)
cp -rf build/jpm '$(DESTDIR)$(BINDIR)'
mkdir -p '$(DESTDIR)$(MANPATH)'
cp janet.1 '$(DESTDIR)$(MANPATH)'
cp jpm.1 '$(DESTDIR)$(MANPATH)'
mkdir -p '$(DESTDIR)$(PKG_CONFIG_PATH)'
cp build/janet.pc '$(DESTDIR)$(PKG_CONFIG_PATH)/janet.pc'
mkdir -p '$(DESTDIR)$(JANET_MANPATH)'
cp janet.1 '$(DESTDIR)$(JANET_MANPATH)'
cp jpm.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
uninstall:
@@ -276,9 +286,9 @@ uninstall:
-rm '$(DESTDIR)$(BINDIR)/jpm'
-rm -rf '$(DESTDIR)$(INCLUDEDIR)/janet'
-rm -rf '$(DESTDIR)$(LIBDIR)'/libjanet.*
-rm '$(DESTDIR)$(PKG_CONFIG_PATH)/janet.pc'
-rm '$(DESTDIR)$(MANPATH)/janet.1'
-rm '$(DESTDIR)$(MANPATH)/jpm.1'
-rm '$(DESTDIR)$(JANET_PKG_CONFIG_PATH)/janet.pc'
-rm '$(DESTDIR)$(JANET_MANPATH)/janet.1'
-rm '$(DESTDIR)$(JANET_MANPATH)/jpm.1'
# -rm -rf '$(DESTDIR)$(JANET_PATH)'/* - err on the side of correctness here
#################
@@ -292,6 +302,10 @@ grammar: build/janet.tmLanguage
build/janet.tmLanguage: tools/tm_lang_gen.janet $(JANET_TARGET)
$(JANET_TARGET) $< > $@
compile-commands:
# Requires pip install copmiledb
compiledb make
clean:
-rm -rf build vgcore.* callgrind.*
-rm -rf test/install/build test/install/modpath
@@ -333,4 +347,4 @@ help:
@echo
.PHONY: clean install repl debug valgrind test \
valtest dist uninstall docs grammar format help
valtest dist uninstall docs grammar format help compile-commands

View File

@@ -2,10 +2,10 @@
&nbsp;
[![Appveyor Status](https://ci.appveyor.com/api/projects/status/bjraxrxexmt3sxyv/branch/master?svg=true)](https://ci.appveyor.com/project/bakpakin/janet/branch/master)
[![Build Status](https://travis-ci.org/janet-lang/janet.svg?branch=master)](https://travis-ci.org/janet-lang/janet)
[![builds.sr.ht status](https://builds.sr.ht/~bakpakin/janet/freebsd.yml.svg)](https://builds.sr.ht/~bakpakin/janet/freebsd.yml?)
[![builds.sr.ht status](https://builds.sr.ht/~bakpakin/janet/openbsd.yml.svg)](https://builds.sr.ht/~bakpakin/janet/openbsd.yml?)
[![builds.sr.ht status](https://builds.sr.ht/~bakpakin/janet/meson.yml.svg)](https://builds.sr.ht/~bakpakin/janet/meson.yml?)
[![builds.sr.ht status](https://builds.sr.ht/~bakpakin/janet/meson_min.yml.svg)](https://builds.sr.ht/~bakpakin/janet/meson_min.yml?)
[![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/meson.yml.svg)](https://builds.sr.ht/~bakpakin/janet/commits/meson.yml?)
[![builds.sr.ht status](https://builds.sr.ht/~bakpakin/janet/commits/meson_min.yml.svg)](https://builds.sr.ht/~bakpakin/janet/commits/meson_min.yml?)
<img src="https://raw.githubusercontent.com/janet-lang/janet/master/assets/janet-w200.png" alt="Janet logo" width=200 align="left">
@@ -14,9 +14,9 @@ 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.
There is a repl for trying out the language, as well as the ability
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 into other programs. Try Janet in your browser at
Janet can be embedded in other programs. Try Janet in your browser at
[https://janet-lang.org](https://janet-lang.org).
<br>
@@ -30,23 +30,23 @@ Lua, but smaller than GNU Guile or Python.
## Features
* Minimal setup - one binary and you are good to go!
* First class closures
* First-class closures
* Garbage collection
* First class green threads (continuations)
* Python style generators (implemented as a plain macro)
* First-class green threads (continuations)
* 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
* Byte code interpreter with an assembly interface, as well as bytecode verification
* Tailcall Optimization
* 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 in to the core library
* 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
@@ -56,7 +56,7 @@ Lua, but smaller than GNU Guile or Python.
* 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)
Documentation is also available locally in the repl.
Documentation is also available locally in the REPL.
Use the `(doc symbol-name)` macro to get API
documentation for symbols in the core library. For example,
```
@@ -66,7 +66,7 @@ Shows documentation for the doc macro.
To get a list of all bindings in the default
environment, use the `(all-bindings)` function. You
can also use the `(doc)` macro with no arguments if you are in the repl
can also use the `(doc)` macro with no arguments if you are in the REPL
to show bound symbols.
## Source
@@ -92,7 +92,7 @@ Find out more about the available make targets by running `make help`.
### 32-bit Haiku
32-bit Haiku build instructions are the same as the unix-like build instructions,
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`.
```
@@ -104,7 +104,7 @@ make repl
### FreeBSD
FreeBSD build instructions are the same as the unix-like build instuctions,
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`.
@@ -115,6 +115,11 @@ gmake test
gmake repl
```
### NetBSD
NetBSD build instructions are the same as the FreeBSD build instructions.
Alternatively, install directly from packages, using `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#)
@@ -131,11 +136,11 @@ Now you should have an `.msi`. You can run `build_win install` to install the `.
### Meson
Janet also has a build file for [Meson](https://mesonbuild.com/), a cross platform build
system. Although Meson has a python dependency, Meson is a very complete build system that
Janet also has a build file for [Meson](https://mesonbuild.com/), a cross-platform build
system. Although Meson has a Python dependency, Meson is a very complete build system that
is maybe more convenient and flexible for integrating into existing pipelines.
Meson also provides much better IDE integration than Make or batch files, as well as support
for cross compilation.
for cross-compilation.
For the impatient, building with Meson is as follows. The options provided to
`meson setup` below emulate Janet's Makefile.
@@ -172,11 +177,11 @@ 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
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.
by entering the command `(all-bindings)` into the REPL.
```
$ janet
@@ -194,13 +199,13 @@ Options are:
-v : Print the version string
-s : Use raw stdin instead of getline like functionality
-e code : Execute a string of janet
-r : Enter the repl after running all scripts
-p : Keep on executing if there is a top level error (persistent)
-q : Hide prompt, logo, and repl output (quiet)
-r : Enter the REPL after running all scripts
-p : Keep on executing if there is a top-level error (persistent)
-q : Hide prompt, logo, and REPL output (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
-n : Disable ANSI color output in the repl
-n : Disable ANSI color output in the REPL
-l path : Execute code in a file before running the main script
-- : Stop handling options
```
@@ -227,16 +232,16 @@ See the examples directory for some example janet code.
## Discussion
Feel free to ask questions and join discussion on the [Janet Gitter Channel](https://gitter.im/janet-language/community).
Feel free to ask questions and join the discussion on the [Janet Gitter Channel](https://gitter.im/janet-language/community).
Alternatively, check out [the #janet channel on Freenode](https://webchat.freenode.net/)
## FAQ
### Why is my terminal spitting out junk when I run the repl?
### 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
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
ensue.

View File

@@ -102,6 +102,7 @@ exit /b 0
mkdir dist
janet.exe tools\gendoc.janet > dist\doc.html
janet.exe tools\removecr.janet dist\doc.html
janet.exe tools\removecr.janet build\janet.c
copy build\janet.c dist\janet.c
copy src\mainclient\shell.c dist\shell.c

View File

@@ -1,23 +1,22 @@
# Example of dst bytecode assembly
# Fibonacci sequence, implemented with naive recursion.
(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
]
}))
(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
]}))
# Test it

15
examples/channel.janet Normal file
View File

@@ -0,0 +1,15 @@
(def c (ev/chan 4))
(defn writer []
(for i 0 10
(ev/sleep 0.1)
(print "writer giving item " i "...")
(ev/give c (string "item " i))))
(defn reader [name]
(forever
(print "reader " name " got " (ev/take c))))
(ev/call writer)
(each letter [:a :b :c :d :e :f :g]
(ev/call reader letter))

View File

@@ -0,0 +1,5 @@
(with [conn (net/connect "127.0.0.1" 8000)]
(print "writing abcdefg...")
(:write conn "abcdefg")
(print "reading...")
(printf "got: %v" (:read conn 1024)))

15
examples/echoserve.janet Normal file
View File

@@ -0,0 +1,15 @@
(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)

12
examples/evsleep.janet Normal file
View File

@@ -0,0 +1,12 @@
(defn worker
"Run for a number of iterations."
[name iterations]
(for i 0 iterations
(ev/sleep 1)
(print "worker " name " iteration " i)))
(ev/call worker :a 10)
(ev/sleep 0.2)
(ev/call worker :b 5)
(ev/sleep 0.3)
(ev/call worker :c 12)

23
examples/select.janet Normal file
View File

@@ -0,0 +1,23 @@
(def channels
(seq [:repeat 5] (ev/chan 4)))
(defn writer [c]
(for i 0 3
(def item (string i ":" (mod (hash c) 999)))
(ev/sleep 0.1)
(print "writer giving item " item " to " c "...")
(ev/give c item))
(print "Done!"))
(defn reader [name]
(forever
(def [_ c x] (ev/rselect ;channels))
(print "reader " name " got " x " from " c)))
# Readers
(each letter [:a :b :c :d :e :f :g]
(ev/call reader letter))
# Writers
(each c channels
(ev/call writer c))

37
examples/select2.janet Normal file
View File

@@ -0,0 +1,37 @@
###
### examples/select2.janet
###
### Mix reads and writes in select.
###
(def c1 (ev/chan 40))
(def c2 (ev/chan 40))
(def c3 (ev/chan 40))
(def c4 (ev/chan 40))
(def c5 (ev/chan 4))
(defn worker
[c n x]
(forever
(ev/sleep n)
(ev/give c x)))
(defn writer-worker
[c]
(forever
(ev/sleep 0.2)
(print "writing " (ev/take c))))
(ev/call worker c1 1 :item1)
(ev/sleep 0.2)
(ev/call worker c2 1 :item2)
(ev/sleep 0.1)
(ev/call worker c3 1 :item3)
(ev/sleep 0.2)
(ev/call worker c4 1 :item4)
(ev/sleep 0.1)
(ev/call worker c4 1 :item5)
(ev/call writer-worker c5)
(forever (pp (ev/rselect c1 c2 c3 c4 [c5 :thing])))

View File

@@ -6,8 +6,15 @@
(def b @"")
(print "Connection " id "!")
(while (:read stream 1024 b)
(repeat 10 (print "work for " id " ...") (ev/sleep 0.1))
(:write stream b)
(buffer/clear b))
(printf "Done %v!" id)))
(net/server "127.0.0.1" "8000" handler)
# Run server.
(let [server (net/server "127.0.0.1" "8000")]
(print "Starting echo server on 127.0.0.1:8000")
(forever
(if-let [conn (:accept server)]
(ev/call handler conn)
(print "no new connections"))))

5
examples/udpclient.janet Normal file
View File

@@ -0,0 +1,5 @@
(def conn (net/connect "127.0.0.1" "8009" :datagram))
(:write conn (string/format "%q" (os/cryptorand 16)))
(def x (:read conn 1024))
(pp x)

6
examples/udpserver.janet Normal file
View File

@@ -0,0 +1,6 @@
(def server (net/server "127.0.0.1" "8009" nil :datagram))
(while true
(def buf @"")
(def who (:recv-from server 1024 buf))
(printf "got %q from %v, echoing!" buf who)
(:send-to server who buf))

12
janet.1
View File

@@ -194,8 +194,8 @@ Source should be a path to the Janet module to compile, and output should be the
resulting image. Output should usually end with the .jimage extension.
.TP
.BR \-l\ path
Load a Janet file before running a script or repl. Multiple files can be loaded
.BR \-l\ lib
Import a Janet module before running a script or repl. Multiple files can be loaded
in this manner, and exports from each file will be made available to the script
or repl.
@@ -213,5 +213,13 @@ find native and source code modules. If no JANET_PATH is set, Janet will look in
the default location set at compile time.
.RE
.B JANET_HASHSEED
.RS
To disable randomization of Janet's PRF on start up, one can set this variable. This can have the
effect of making programs deterministic that otherwise would depend on the random seed chosen at program start.
This variable does nothing in the default configuration of Janet, as PRF is disabled by default. Also, JANET_REDUCED_OS
cannot be defined for this variable to have an effect.
.RE
.SH AUTHOR
Written by Calvin Rose <calsrose@gmail.com>

230
jpm
View File

@@ -132,6 +132,15 @@
"Convert url with potential bad characters into a file path element."
(peg/compile ~(% (any (+ (/ '(set "<>:\"/\\|?*") "_") '1)))))
(def- entry-replacer
"Convert url with potential bad characters into an entry-name"
(peg/compile ~(% (any (+ '(range "AZ" "az" "09" "__") (/ '1 ,|(string "_" ($ 0) "_")))))))
(defn entry-replace
"Escape special characters in the entry-name"
[name]
(get (peg/match entry-replacer name) 0))
(defn filepath-replace
"Remove special characters from a string or path
to make it into a path segment."
@@ -323,7 +332,9 @@
#
(def default-compiler (or (os/getenv "CC") (if is-win "cl.exe" "cc")))
(def default-cpp-compiler (or (os/getenv "CXX") (if is-win "cl.exe" "c++")))
(def default-linker (or (os/getenv "CC") (if is-win "link.exe" "cc")))
(def default-cpp-linker (or (os/getenv "CXX") (if is-win "link.exe" "c++")))
(def default-archiver (or (os/getenv "AR") (if is-win "lib.exe" "ar")))
# Detect threads
@@ -352,6 +363,10 @@
(if is-win
["/nologo" "/MD"]
["-std=c99" "-Wall" "-Wextra"]))
(def default-cppflags
(if is-win
["/nologo" "/MD" "/EHsc"]
["-std=c++11" "-Wall" "-Wextra"]))
(def default-ldflags [])
# Required flags for dynamic libraries. These
@@ -424,29 +439,54 @@
(string "-I" (dyn :headerpath JANET_HEADERPATH))
(string "-O" (opt opts :optimize 2))])
(defn- getcppflags
"Generate the cpp flags from the input options."
[opts]
@[;(opt opts :cppflags default-cppflags)
(string "-I" (dyn :headerpath JANET_HEADERPATH))
(string "-O" (opt opts :optimize 2))])
(defn- entry-name
"Name of symbol that enters static compilation of a module."
[name]
(string "janet_module_entry_" (filepath-replace name)))
(string "janet_module_entry_" (entry-replace name)))
(defn- compile-c
"Compile a C file into an object file."
[opts src dest &opt static?]
(def cc (opt opts :compiler default-compiler))
(def cflags [;(getcflags opts) ;(if static? [] dynamic-cflags)])
(def entry-defines (if-let [n (opts :entry-name)]
(def entry-defines (if-let [n (and static? (opts :entry-name))]
[(make-define "JANET_ENTRY_NAME" n)]
[]))
(def defines [;(make-defines (opt opts :defines {})) ;entry-defines])
(def headers (or (opts :headers) []))
(rule dest [src ;headers]
(check-cc)
(print "compiling " dest "...")
(print "compiling " src " to " dest "...")
(create-dirs dest)
(if is-win
(shell cc ;defines "/c" ;cflags (string "/Fo" dest) src)
(shell cc "-c" src ;defines ;cflags "-o" dest))))
(defn- compile-cpp
"Compile a C++ file into an object file."
[opts src dest &opt static?]
(def cpp (opt opts :cpp-compiler default-cpp-compiler))
(def cflags [;(getcppflags opts) ;(if static? [] dynamic-cflags)])
(def entry-defines (if-let [n (and static? (opts :entry-name))]
[(make-define "JANET_ENTRY_NAME" n)]
[]))
(def defines [;(make-defines (opt opts :defines {})) ;entry-defines])
(def headers (or (opts :headers) []))
(rule dest [src ;headers]
(check-cc)
(print "compiling " src " to " dest "...")
(create-dirs dest)
(if is-win
(shell cpp ;defines "/c" ;cflags (string "/Fo" dest) src)
(shell cpp "-c" src ;defines ;cflags "-o" dest))))
(defn- libjanet
"Find libjanet.a (or libjanet.lib on windows) at compile time"
[]
@@ -466,7 +506,7 @@
(string hpath `\\janet.lib`))
(defn- link-c
"Link object files together to make a native module."
"Link C object files together to make a native module."
[opts target & objects]
(def linker (opt opts (if is-win :linker :compiler) default-linker))
(def cflags (getcflags opts))
@@ -481,6 +521,22 @@
(shell linker ;ldflags (string "/OUT:" target) ;objects (win-import-library) ;lflags)
(shell linker ;cflags ;ldflags `-o` target ;objects ;lflags))))
(defn- link-cpp
"Link C++ object files together to make a native module."
[opts target & objects]
(def linker (opt opts (if is-win :cpp-linker :cpp-compiler) default-cpp-linker))
(def cflags (getcppflags opts))
(def lflags [;(opt opts :lflags default-lflags)
;(if (opts :static) [] dynamic-lflags)])
(def ldflags [;(opt opts :ldflags [])])
(rule target objects
(check-cc)
(print "linking " target "...")
(create-dirs target)
(if is-win
(shell linker ;ldflags (string "/OUT:" target) ;objects (win-import-library) ;lflags)
(shell linker ;cflags ;ldflags `-o` target ;objects ;lflags))))
(defn- archive-c
"Link object files together to make a static library."
[opts target & objects]
@@ -535,6 +591,23 @@
```
int main(int argc, const char **argv) {
#if defined(JANET_PRF)
uint8_t hash_key[JANET_HASH_KEY_SIZE + 1];
#ifdef JANET_REDUCED_OS
char *envvar = NULL;
#else
char *envvar = getenv("JANET_HASHSEED");
#endif
if (NULL != envvar) {
strncpy((char *) hash_key, envvar, sizeof(hash_key) - 1);
} else if (janet_cryptorand(hash_key, JANET_HASH_KEY_SIZE) != 0) {
fputs("unable to initialize janet PRF hash function.\n", stderr);
return 1;
}
janet_init_hash_key(hash_key);
#endif
janet_init();
/* Get core env */
@@ -638,10 +711,12 @@ int main(int argc, const char **argv) {
(table/setproto m oldproto))
# Find static modules
(var has-cpp false)
(def declarations @"")
(def lookup-into-invocations @"")
(loop [[prefix name] :pairs prefixes]
(def meta (eval-string (slurp (modpath-to-meta name))))
(if (meta :cpp) (set has-cpp true))
(buffer/push-string lookup-into-invocations
" temptab = janet_table(0);\n"
" temptab->proto = env;\n"
@@ -664,17 +739,33 @@ int main(int argc, const char **argv) {
(create-buffer-c-impl image cimage_dest "janet_payload_image")
# Append main function
(spit cimage_dest (make-bin-source declarations lookup-into-invocations) :ab)
(def oimage_dest (out-path cimage_dest ".c" ".o"))
# Compile and link final exectable
(unless no-compile
(def cc (opt opts :compiler default-compiler))
(def ldflags [;dep-ldflags ;(opt opts :ldflags []) ;janet-ldflags])
(def lflags [;static-libs (libjanet) ;dep-lflags ;(opt opts :lflags default-lflags) ;janet-lflags])
(def cflags [;(getcflags opts) ;janet-cflags])
(def defines (make-defines (opt opts :defines {})))
(print "compiling and linking " dest "...")
(def cc (opt opts :compiler default-compiler))
(def cflags [;(getcflags opts) ;janet-cflags])
(check-cc)
(print "compiling " cimage_dest " to " oimage_dest "...")
(create-dirs oimage_dest)
(if is-win
(shell cc ;cflags ;ldflags cimage_dest ;lflags `/link` (string "/OUT:" dest))
(shell cc ;cflags ;ldflags `-o` dest cimage_dest ;lflags)))))
(shell cc ;defines "/c" ;cflags (string "/Fo" oimage_dest) cimage_dest)
(shell cc "-c" cimage_dest ;defines ;cflags "-o" oimage_dest))
(if has-cpp
(let [linker (opt opts (if is-win :cpp-linker :cpp-compiler) default-cpp-linker)
cppflags [;(getcppflags opts) ;janet-cflags]]
(print "linking " dest "...")
(if is-win
(shell linker ;ldflags (string "/OUT:" dest) oimage_dest ;lflags)
(shell linker ;cppflags ;ldflags `-o` dest oimage_dest ;lflags)))
(let [linker (opt opts (if is-win :linker :compiler) default-linker)]
(print "linking " dest "...")
(create-dirs dest)
(if is-win
(shell linker ;ldflags (string "/OUT:" dest) oimage_dest ;lflags)
(shell linker ;cflags ;ldflags `-o` dest oimage_dest ;lflags)))))))
#
# Installation and Dependencies
@@ -688,7 +779,7 @@ int main(int argc, const char **argv) {
(if stored-git-path (break stored-git-path))
(set stored-git-path
(if is-win
(or (os/getenv "JANET_GIT") (pslurp "where git"))
(or (os/getenv "JANET_GIT") (first (string/split "\n" (pslurp "where git"))))
(os/getenv "JANET_GIT" "git"))))
(defn uninstall
@@ -757,11 +848,11 @@ int main(int argc, const char **argv) {
(os/execute [(git-path) "reset" "--hard" tag] :p))
(unless (dyn :offline)
(os/execute [(git-path) "submodule" "update" "--init" "--recursive"] :p))
(import-rules "./project.janet")
(import-rules "./project.janet" true)
(unless no-deps (do-rule "install-deps"))
(do-rule "build")
(do-rule "install"))
([err] (print "Error building git repository dependency: " err)))
([err f] (print "Error building git repository dependency: " err) (propagate err f)))
(os/cd olddir))
(defn install-rule
@@ -836,9 +927,23 @@ int main(int argc, const char **argv) {
# Make dynamic module
(def lname (string "build" sep name modext))
(loop [src :in sources]
(compile-c opts src (out-path src ".c" objext)))
(def objects (map (fn [path] (out-path path ".c" objext)) sources))
# Get objects to build with
(var has-cpp false)
(def objects
(seq [src :in sources]
(cond
(string/has-suffix? ".cpp" src)
(let [op (out-path src ".cpp" objext)]
(compile-cpp opts src op)
(set has-cpp true)
op)
(string/has-suffix? ".c" src)
(let [op (out-path src ".c" objext)]
(compile-c opts src op)
op)
(errorf "unknown source file type: %s, expected .c or .cpp"))))
(when-let [embedded (opts :embedded)]
(loop [src :in embedded]
(def c-src (out-path src ".janet" ".janet.c"))
@@ -846,7 +951,7 @@ int main(int argc, const char **argv) {
(array/push objects o-src)
(create-buffer-c src c-src (embed-name src))
(compile-c opts c-src o-src)))
(link-c opts lname ;objects)
((if has-cpp link-cpp link-c) opts lname ;objects)
(add-dep "build" lname)
(install-rule lname path)
@@ -859,6 +964,7 @@ int main(int argc, const char **argv) {
"# Metadata for static library %s\n\n%.20p"
(string name statext)
{:static-entry ename
:cpp has-cpp
:ldflags ~',(opts :ldflags)
:lflags ~',(opts :lflags)})))
(add-dep "build" metaname)
@@ -870,9 +976,21 @@ int main(int argc, const char **argv) {
(def opts (merge @{:entry-name ename} opts))
(def sobjext (string ".static" objext))
(def sjobjext (string ".janet" sobjext))
(loop [src :in sources]
(compile-c opts src (out-path src ".c" sobjext) true))
(def sobjects (map (fn [path] (out-path path ".c" sobjext)) sources))
# Get static objects
(def sobjects
(seq [src :in sources]
(cond
(string/has-suffix? ".cpp" src)
(let [op (out-path src ".cpp" sobjext)]
(compile-cpp opts src op true)
op)
(string/has-suffix? ".c" src)
(let [op (out-path src ".c" sobjext)]
(compile-c opts src op true)
op)
(errorf "unknown source file type: %s, expected .c or .cpp"))))
(when-let [embedded (opts :embedded)]
(loop [src :in embedded]
(def c-src (out-path src ".janet" ".janet.c"))
@@ -1069,36 +1187,50 @@ usage: jpm [--key=value, --flag] ... [subcommand] [args] ...
Run from a directory containing a project.janet file to perform operations
on a project, or from anywhere to do operations on the global module cache (modpath).
Commands that need write permission to the modpath are considered privileged commands - in
some environments they may require super user privileges.
Other project-level commands need to have a ./project.janet file in the current directory.
Subcommands are:
build : build all artifacts
Unprivileged global subcommands:
help : show this help text
show-paths : prints the paths that will be used to install things.
quickbin entry executable : Create an executable from a janet script with a main function.
Privileged global subcommands:
install (repo or name)... : install artifacts. If a repo is given, install the contents of that
git repository, assuming that the repository is a jpm project. If not, build
and install the current project.
uninstall (module)... : uninstall a module. If no module is given, uninstall the module
defined by the current directory.
show-paths : prints the paths that will be used to install things.
clean : remove any generated files or artifacts
test : run tests. Tests should be .janet files in the test/ directory relative to project.janet.
deps : install dependencies for the current project.
clear-cache : clear the git cache. Useful for updating dependencies.
clear-manifest : clear the manifest. Useful for fixing broken installs.
run rule : run a rule. Can also run custom rules added via (phony "task" [deps...] ...)
or (rule "ouput.file" [deps...] ...).
rules : list rules available with run.
rule-tree (root rule) (depth) : Print a nice tree to see what rules depend on other rules.
Optinally provide a root rule to start printing from, and a
max depth to print. Without these options, all rules will print
their full dependency tree.
update-pkgs : Update the current package listing from the remote git repository selected.
quickbin entry executable : Create an executable from a janet script with a main function.
make-lockfile (lockfile) : Create a lockfile based on repositories in the cache. The
lockfile will record the exact versions of dependencies used to ensure a reproducible
build. Lockfiles are best used with applications, not libraries. The default lockfile
name is lockfile.jdn.
load-lockfile (lockfile) : Install modules from a lockfile in a reproducible way. The
default lockfile name is lockfile.jdn.
update-pkgs : Update the current package listing from the remote git repository selected.
Privileged project subcommands:
deps : install dependencies for the current project.
install : install artifacts of the current project.
uninstall : uninstall the current project's artifacts.
Unprivileged project subcommands:
build : build all artifacts
clean : remove any generated files or artifacts
test : run tests. Tests should be .janet files in the test/ directory relative to project.janet.
run rule : run a rule. Can also run custom rules added via (phony "task" [deps...] ...)
or (rule "ouput.file" [deps...] ...).
rules : list rules available with run.
list-installed : list installed packages in the current syspath.
list-pkgs (search) : list packages in the package listing that the contain the string search.
If no search pattern is given, prints the entire package listing.
rule-tree (root rule) (depth) : Print a nice tree to see what rules depend on other rules.
Optionally provide a root rule to start printing from, and a
max depth to print. Without these options, all rules will print
their full dependency tree.
debug-repl : Run a repl in the context of the current project.janet file. This lets you run rules and
otherwise debug the current project.janet file.
@@ -1108,7 +1240,8 @@ Keys are:
--binpath : The directory to install binaries and scripts. Defaults to $JANET_BINPATH.
--libpath : The directory containing janet C libraries (libjanet.*). Defaults to $JANET_LIBPATH.
--compiler : C compiler to use for natives. Defaults to $CC or cc (cl.exe on windows).
--archiver : C compiler to use for static libraries. Defaults to $AR ar (lib.exe on windows).
--cpp-compiler : C++ compiler to use for natives. Defaults to $CXX or c++ (cl.exe on windows).
--archiver : C archiver to use for static libraries. Defaults to $AR ar (lib.exe on windows).
--linker : C linker to use for linking natives. Defaults to link.exe on windows, not used on
other platforms.
--pkglist : URL of git repository for package listing. Defaults to $JANET_PKGLIST or https://github.com/janet-lang/pkgs.git
@@ -1171,10 +1304,33 @@ Flags are:
(defn list-rules
[&opt ctx]
(import-rules "./project.janet" true)
(import-rules "./project.janet")
(def ks (sort (seq [k :keys (dyn :rules)] k)))
(each k ks (print k)))
(defn list-installed
[]
(def xs
(seq [x :in (os/dir (find-manifest-dir))
:when (string/has-suffix? ".jdn" x)]
(string/slice x 0 -5)))
(sort xs)
(each x xs (print x)))
(defn list-pkgs
[&opt search]
(def [ok _] (module/find "pkgs"))
(unless ok
(eprint "no local package listing found. Run `jpm update-pkgs` to get listing.")
(os/exit 1))
(def pkgs-mod (require "pkgs"))
(def ps
(seq [p :keys (get-in pkgs-mod ['packages :value] [])
:when (if search (string/find search p) true)]
p))
(sort ps)
(each p ps (print p)))
(defn update-pkgs
[]
(install-git (dyn :pkglist default-pkglist)))
@@ -1216,6 +1372,8 @@ Flags are:
"debug-repl" jpm-debug-repl
"rule-tree" show-rule-tree
"show-paths" show-paths
"list-installed" list-installed
"list-pkgs" list-pkgs
"clear-cache" clear-cache
"clear-manifest" clear-manifest
"run" local-rule

29
jpm.1
View File

@@ -71,9 +71,14 @@ $JANET_LIBPATH, or a reasonable default. See JANET_LIBPATH for more.
.TP
.BR \-\-compiler=$CC
Sets the compiler used for compiling native modules and standalone executables. Defaults
Sets the C compiler used for compiling native modules and standalone executables. Defaults
to cc.
.TP
.BR \-\-cpp\-compiler=$CXX
Sets the C++ compiler used for compiling native modules and standalone executables. Defaults
to c++..
.TP
.BR \-\-linker
Sets the linker used to create native modules and executables. Only used on windows, where
@@ -101,7 +106,6 @@ be created in the ./build/ directory.
.TP
.BR install\ [\fBrepo...\fR]
When run with no arguments, installs all installable artifacts in the current project to
the current JANET_MODPATH for modules and JANET_BINPATH for executables and scripts. Can also
take an optional git repository URL and will install all artifacts in that repository instead.
@@ -111,7 +115,7 @@ install multiple dependencies in one command.
.TP
.BR uninstall\ [\fBname...\fR]
Uninstall a project installed with install. uninstall expects the name of the project, not the
repository url, path to installed file or executable name. The name of the project must be specified
repository url, path to installed file, or executable name. The name of the project must be specified
at the top of the project.janet file in the declare-project form. If no name is given, uninstalls
the current project if installed. Will also uninstall multiple packages in one command.
@@ -139,6 +143,15 @@ date or too large, clear-cache will remove the cache and jpm will rebuild it
when needed. clear-cache is a global command, so a project.janet is not
required.
.TP
.BR list-installed
List all installed packages in the current syspath.
.TP
.BR list-pkgs\ [\fBsearch\fR]
List all package aliases in the current package listing that contain the given search string.
If no search string is given, prints the entire listing.
.TP
.BR clear-manifest
jpm creates a manifest directory that contains a list of all installed files.
@@ -159,7 +172,7 @@ like make. run will run a single rule or build a single file.
List all rules that can be run via run. This is useful for exploring rules in the project.
.TP
.BR rule-tree\ [\fBroot\fR] [\fdepth\fR]
.BR rule-tree\ [\fBroot\fR]\ [\fBdepth\fR]
Show rule dependency tree in a pretty format. Optionally provide a rule to use as the tree
root, as well as a max depth to print. By default, prints the full tree for all rules. This
can be quite long, so it is recommended to give a root rule.
@@ -173,7 +186,7 @@ Show all of the paths used when installing and building artifacts.
Update the package listing by installing the 'pkgs' package. Same as jpm install pkgs
.TP
.BR quickbin [\fBentry\fR] [\fBexecutable\fR]
.BR quickbin\ [\fBentry\fR]\ [\fBexecutable\fR]
Create a standalone, statically linked executable from a Janet source file that contains a main function.
The main function is the entry point of the program and will receive command line arguments
as function arguments. The entry file can import other modules, including native C modules, and
@@ -209,7 +222,7 @@ the default location set at compile time, which can be determined with (dyn :sys
.RS
The location that jpm will use to install libraries to. Defaults to JANET_PATH, but you could
set this to a different directory if you want to. Doing so would let you import Janet modules
on the normal system path (JANET_PATH or (dyn :syspath)), but install to a different directory. It is also a more reliable way to install
on the normal system path (JANET_PATH or (dyn :syspath)), but install to a different directory. It is also a more reliable way to install.
This variable is overwritten by the --modpath=/some/path if it is provided.
.RE
@@ -225,7 +238,7 @@ variable.
.B JANET_LIBPATH
.RS
Similar to JANET_HEADERPATH, this path is where jpm will look for
libjanet.a for creating standalong executables. This does not need to be
libjanet.a for creating standalone executables. This does not need to be
set on a normal install.
If not provided, this will default to <jpm script location>/../lib.
The --libpath=/some/path option will override this variable.
@@ -244,11 +257,13 @@ The --binpath=/some/path will override this variable.
The git repository URL that contains a listing of packages. This allows installing packages with shortnames, which
is mostly a convenience. However, package dependencies can use short names, package listings
can be used to choose a particular set of dependency versions for a whole project.
.RE
.B JANET_GIT
.RS
An optional path to a git executable to use to clone git dependencies. By default, uses "git" on the current $PATH. You shouldn't need to set this
if you have a normal install of git.
.RE
.SH AUTHOR
Written by Calvin Rose <calsrose@gmail.com>

View File

@@ -20,7 +20,7 @@
project('janet', 'c',
default_options : ['c_std=c99', 'b_lundef=false', 'default_library=both'],
version : '1.10.1')
version : '1.13.0')
# Global settings
janet_path = join_paths(get_option('prefix'), get_option('libdir'), 'janet')
@@ -60,10 +60,11 @@ conf.set('JANET_NO_SOURCEMAPS', not get_option('sourcemaps'))
conf.set('JANET_NO_ASSEMBLER', not get_option('assembler'))
conf.set('JANET_NO_PEG', not get_option('peg'))
conf.set('JANET_NO_NET', not get_option('net'))
conf.set('JANET_NO_EV', not get_option('ev'))
conf.set('JANET_REDUCED_OS', get_option('reduced_os'))
conf.set('JANET_NO_TYPED_ARRAY', not get_option('typed_array'))
conf.set('JANET_NO_INT_TYPES', not get_option('int_types'))
conf.set('JANET_NO_PRF', not get_option('prf'))
conf.set('JANET_PRF', get_option('prf'))
conf.set('JANET_RECURSION_GUARD', get_option('recursion_guard'))
conf.set('JANET_MAX_PROTO_DEPTH', get_option('max_proto_depth'))
conf.set('JANET_MAX_MACRO_EXPAND', get_option('max_macro_expand'))
@@ -71,6 +72,7 @@ conf.set('JANET_STACK_MAX', get_option('stack_max'))
conf.set('JANET_NO_UMASK', not get_option('umask'))
conf.set('JANET_NO_REALPATH', not get_option('realpath'))
conf.set('JANET_NO_PROCESSES', not get_option('processes'))
conf.set('JANET_SIMPLE_GETLINE', get_option('simple_getline'))
if get_option('os_name') != ''
conf.set('JANET_OS_NAME', get_option('os_name'))
endif
@@ -110,6 +112,7 @@ core_src = [
'src/core/corelib.c',
'src/core/debug.c',
'src/core/emit.c',
'src/core/ev.c',
'src/core/fiber.c',
'src/core/gc.c',
'src/core/inttypes.c',
@@ -178,30 +181,28 @@ libjanet = library('janet', janetc,
# Extra c flags - adding -fvisibility=hidden matches the Makefile and
# shaves off about 10k on linux x64, likely similar on other platforms.
native_cc = meson.get_compiler('c', native: true)
cross_cc = meson.get_compiler('c', native: false)
if native_cc.has_argument('-fvisibility=hidden')
extra_native_cflags = ['-fvisibility=hidden']
if cc.has_argument('-fvisibility=hidden')
extra_cflags = ['-fvisibility=hidden']
else
extra_native_cflags = []
extra_cflags = []
endif
if cross_cc.has_argument('-fvisibility=hidden')
extra_cross_cflags = ['-fvisibility=hidden']
else
extra_cross_cflags = []
endif
janet_mainclient = executable('janet', janetc, mainclient_src,
include_directories : incdir,
dependencies : [m_dep, dl_dep, thread_dep],
c_args : extra_native_cflags,
c_args : extra_cflags,
install : true)
if meson.is_cross_build()
native_cc = meson.get_compiler('c', native: true)
if native_cc.has_argument('-fvisibility=hidden')
extra_native_cflags = ['-fvisibility=hidden']
else
extra_native_cflags = []
endif
janet_nativeclient = executable('janet-native', janetc, mainclient_src,
include_directories : incdir,
dependencies : [m_dep, dl_dep, thread_dep],
c_args : extra_cross_cflags,
c_args : extra_native_cflags,
native : true)
else
janet_nativeclient = janet_mainclient
@@ -216,16 +217,17 @@ docs = custom_target('docs',
# Tests
test_files = [
'test/suite0.janet',
'test/suite1.janet',
'test/suite2.janet',
'test/suite3.janet',
'test/suite4.janet',
'test/suite5.janet',
'test/suite6.janet',
'test/suite7.janet',
'test/suite8.janet',
'test/suite9.janet'
'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'
]
foreach t : test_files
test(t, janet_nativeclient, args : files([t]), workdir : meson.current_source_dir())
@@ -257,6 +259,6 @@ if get_option('peg') and not get_option('reduced_os') and get_option('processes'
output : ['jpm'],
command : [janet_nativeclient, '@INPUT@', '@OUTPUT@',
'--binpath=' + join_paths(get_option('prefix'), get_option('bindir')),
'--libpath=' + join_paths(get_option('prefix'), get_option('libdir'), 'janet'),
'--libpath=' + join_paths(get_option('prefix'), get_option('libdir')),
'--headerpath=' + join_paths(get_option('prefix'), get_option('includedir'))])
endif

View File

@@ -10,11 +10,13 @@ option('assembler', type : 'boolean', value : true)
option('peg', type : 'boolean', value : true)
option('typed_array', type : 'boolean', value : true)
option('int_types', type : 'boolean', value : true)
option('prf', type : 'boolean', value : true)
option('prf', type : 'boolean', value : false)
option('net', type : 'boolean', value : true)
option('ev', type : 'boolean', value : true)
option('processes', type : 'boolean', value : true)
option('umask', type : 'boolean', value : true)
option('realpath', type : 'boolean', value : true)
option('simple_getline', type : 'boolean', value : false)
option('recursion_guard', type : 'integer', min : 10, max : 8000, value : 1024)
option('max_proto_depth', type : 'integer', min : 10, max : 8000, value : 200)

View File

@@ -7,6 +7,8 @@
###
###
(def root-env "The root environment used to create environments with (make-env)" _env)
(def defn :macro
"(defn name & more)\n\nDefine a function. Equivalent to (def name (fn name [args] ...))."
(fn defn [name & more]
@@ -81,10 +83,6 @@
(defn nan? "Check if x is NaN" [x] (not= x x))
(defn even? "Check if x is even." [x] (= 0 (mod x 2)))
(defn odd? "Check if x is odd." [x] (= 1 (mod x 2)))
(defn zero? "Check if x is zero." [x] (= x 0))
(defn pos? "Check if x is greater than 0." [x] (> x 0))
(defn neg? "Check if x is less than 0." [x] (< x 0))
(defn one? "Check if x is equal to 1." [x] (= x 1))
(defn number? "Check if x is a number." [x] (= (type x) :number))
(defn fiber? "Check if x is a fiber." [x] (= (type x) :fiber))
(defn string? "Check if x is a string." [x] (= (type x) :string))
@@ -99,7 +97,7 @@
(defn array? "Check if x is an array." [x] (= (type x) :array))
(defn tuple? "Check if x is a tuple." [x] (= (type x) :tuple))
(defn boolean? "Check if x is a boolean." [x] (= (type x) :boolean))
(defn bytes? "Check if x is a string, symbol, or buffer." [x]
(defn bytes? "Check if x is a string, symbol, keyword, or buffer." [x]
(def t (type x))
(if (= t :string) true (if (= t :symbol) true (if (= t :keyword) true (= t :buffer)))))
(defn dictionary? "Check if x a table or struct." [x]
@@ -112,7 +110,7 @@
(defn true? "Check if x is true." [x] (= x true))
(defn false? "Check if x is false." [x] (= x false))
(defn nil? "Check if x is nil." [x] (= x nil))
(defn empty? "Check if xs is empty." [xs] (= 0 (length xs)))
(defn empty? "Check if xs is empty." [xs] (= (length xs) 0))
(def idempotent?
"(idempotent? x)\n\nCheck if x is a value that evaluates to itself when compiled."
@@ -379,16 +377,27 @@
,(apply defer [(or dtor :close) binding] [truthy])
,falsey))
(defn- for-template
[binding start stop step comparison delta body]
(with-syms [i s]
(defn- for-var-template
[i start stop step comparison delta body]
(with-syms [s]
(def st (if (idempotent? step) step (gensym)))
(def loop-body
~(while (,comparison ,i ,s)
,;body
(set ,i (,delta ,i ,st))))
~(do
(var ,i ,start)
(def ,s ,stop)
(while (,comparison ,i ,s)
(def ,binding ,i)
,;body
(set ,i (,delta ,i ,step))))))
,;(if (= st step) [] [~(def ,st ,step)])
,(if (and (number? st) (> st 0))
loop-body
~(if (,> ,st 0) ,loop-body)))))
(defn- for-template
[binding start stop step comparison delta body]
(def i (gensym))
(for-var-template i start stop step comparison delta
[~(def ,binding ,i) ;body]))
(defn- check-indexed [x]
(if (indexed? x)
@@ -401,26 +410,18 @@
(for-template binding start stop (or step 1) comparison op [rest])))
(defn- each-template
[binding inx body]
[binding inx kind body]
(with-syms [k]
(def ds (if (idempotent? inx) inx (gensym)))
~(do
,(unless (= ds inx) ~(def ,ds ,inx))
(var ,k (,next ,ds nil))
(while (,not= nil ,k)
(def ,binding (,in ,ds ,k))
,;body
(set ,k (,next ,ds ,k))))))
(defn- keys-template
[binding in pair? body]
(with-syms [k]
(def ds (if (idempotent? in) in (gensym)))
~(do
,(unless (= ds in) ~(def ,ds ,in))
(var ,k (,next ,ds nil))
(while (,not= nil ,k)
(def ,binding ,(if pair? ~(tuple ,k (in ,ds ,k)) k))
(def ,binding
,(case kind
:each ~(,in ,ds ,k)
:keys k
:pairs ~(,tuple ,k (,in ,ds ,k))))
,;body
(set ,k (,next ,ds ,k))))))
@@ -433,6 +434,17 @@
(def ,binding ,i)
,body))))
(defn- loop-fiber-template
[binding expr body]
(with-syms [f s]
(def ds (if (idempotent? binding) binding (gensym)))
~(let [,f ,expr]
(while true
(def ,ds (,resume ,f))
(if (= :dead (,fiber/status ,f)) (break))
,;(if (= ds binding) [] [~(def ,binding ,ds)])
,;body))))
(defn- loop1
[body head i]
@@ -466,18 +478,19 @@
:range-to (range-template binding object rest + <=)
:down (range-template binding object rest - >)
:down-to (range-template binding object rest - >=)
:keys (keys-template binding object false [rest])
:pairs (keys-template binding object true [rest])
:in (each-template binding object [rest])
:keys (each-template binding object :keys [rest])
:pairs (each-template binding object :pairs [rest])
:in (each-template binding object :each [rest])
:iterate (iterate-template binding object rest)
:generate (with-syms [f s]
~(let [,f ,object]
(while true
(def ,binding (,resume ,f))
(if (= :dead (,fiber/status ,f)) (break))
,rest)))
:generate (loop-fiber-template binding object [rest])
(error (string "unexpected loop verb " verb)))))
(defmacro forv
"Do a c style for loop for side effects. The iteration variable i
can be mutated in the loop, unlike normal for. Returns nil."
[i start stop & body]
(for-var-template i start stop 1 < + body))
(defmacro for
"Do a c style for loop for side effects. Returns nil."
[i start stop & body]
@@ -486,17 +499,34 @@
(defmacro eachk
"Loop over each key in ds. Returns nil."
[x ds & body]
(keys-template x ds false body))
(each-template x ds :keys body))
(defmacro eachp
"Loop over each (key, value) pair in ds. Returns nil."
[x ds & body]
(keys-template x ds true body))
(each-template x ds :pairs body))
(defmacro eachy
"Resume a fiber in a loop until it has errored or died. Evaluate the body
of the loop with binding set to the yielded value."
[x fiber & body]
(loop-fiber-template x fiber body))
(defmacro repeat
"Evaluate body n times. If n is negative, body will be evaluated 0 times. Evaluates to nil."
[n & body]
(with-syms [iter]
~(do (var ,iter ,n) (while (> ,iter 0) ,;body (-- ,iter)))))
(defmacro forever
"Evaluate body forever in a loop, or until a break statement."
[& body]
~(while true ,;body))
(defmacro each
"Loop over each value in ds. Returns nil."
[x ds & body]
(each-template x ds body))
(each-template x ds :each body))
(defmacro loop
"A general purpose loop macro. This macro is similar to the Common Lisp
@@ -535,14 +565,6 @@
[head & body]
(loop1 body head 0))
(put _env 'loop1 nil)
(put _env 'check-indexed nil)
(put _env 'for-template nil)
(put _env 'iterate-template nil)
(put _env 'each-template nil)
(put _env 'keys-template nil)
(put _env 'range-template nil)
(defmacro seq
"Similar to loop, but accumulates the loop body into an array and returns that.
See loop for details."
@@ -561,6 +583,16 @@
[& body]
(tuple fiber/new (tuple 'fn '[] ;body) :yi))
(defmacro- undef
"Remove binding from root-env"
[& syms]
~(do ,;(seq [s :in syms] ~(put root-env ',s nil))))
(undef _env)
(undef loop1 check-indexed for-template for-var-template iterate-template
each-template range-template loop-fiber-template)
(defn sum
"Returns the sum of xs. If xs is empty, returns 0."
[xs]
@@ -586,7 +618,7 @@
the fal form. Bindings have the same syntax as the let macro."
[bindings tru &opt fal]
(def len (length bindings))
(if (zero? len) (error "expected at least 1 binding"))
(if (= 0 len) (error "expected at least 1 binding"))
(if (odd? len) (error "expected an even number of bindings"))
(defn aux [i]
(if (>= i len)
@@ -669,28 +701,17 @@
## Polymorphic comparisons
(defn compare-primitive
"Compare x and y using primitive operators.
Returns -1,0,1 for x < y, x = y, x > y respectively.
Present mostly for constructing 'compare' methods in prototypes."
[x y]
(cond
(= x y) 0
(< x y) -1
(> x y) 1))
(defn compare
"Polymorphic compare. Returns -1,0,1 for x < y, x = y, x > y respectively.
"Polymorphic compare. Returns -1, 0, 1 for x < y, x = y, x > y respectively.
Differs from the primitive comparators in that it first checks to
see whether either x or y implement a 'compare' method which can
compare x and y. If so it uses that compare method. If not, it
compare x and y. If so it uses that compare method. If not, it
delegates to the primitive comparators."
[x y]
(or
(when-let [f (get x :compare)] (f x y))
(when-let [f (get y :compare)
fyx (f y x)] (- fyx))
(compare-primitive x y)))
(when-let [f (get y :compare)] (- (f y x)))
(cmp x y)))
(defn- compare-reduce [op xs]
(var r true)
@@ -727,7 +748,12 @@
[& xs]
(compare-reduce >= xs))
(put _env 'compare-reduce nil)
(defn zero? "Check if x is zero." [x] (= (compare x 0) 0))
(defn pos? "Check if x is greater than 0." [x] (= (compare x 0) 1))
(defn neg? "Check if x is less than 0." [x] (= (compare x 0) -1))
(defn one? "Check if x is equal to 1." [x] (= (compare x 1) 0))
(undef compare-reduce)
###
###
@@ -739,7 +765,7 @@
[a lo hi by]
(def pivot (in a hi))
(var i lo)
(for j lo hi
(forv j lo hi
(def aj (in a j))
(when (by aj pivot)
(def ai (in a i))
@@ -763,8 +789,8 @@
[a &opt by]
(sort-help a 0 (- (length a) 1) (or by <)))
(put _env 'sort-part nil)
(put _env 'sort-help nil)
(undef sort-part)
(undef sort-help)
(defn sort-by
"Returns a new sorted array that compares elements by invoking
@@ -837,19 +863,19 @@
(def ninds (length inds))
(if (= 0 ninds) (error "expected at least 1 indexed collection"))
(var limit (length (in inds 0)))
(for i 0 ninds
(forv i 0 ninds
(def l (length (in inds i)))
(if (< l limit) (set limit l)))
(def [i1 i2 i3 i4] inds)
(def res (array/new limit))
(case ninds
1 (for i 0 limit (set (res i) (f (in i1 i))))
2 (for i 0 limit (set (res i) (f (in i1 i) (in i2 i))))
3 (for i 0 limit (set (res i) (f (in i1 i) (in i2 i) (in i3 i))))
4 (for i 0 limit (set (res i) (f (in i1 i) (in i2 i) (in i3 i) (in i4 i))))
(for i 0 limit
1 (forv i 0 limit (set (res i) (f (in i1 i))))
2 (forv i 0 limit (set (res i) (f (in i1 i) (in i2 i))))
3 (forv i 0 limit (set (res i) (f (in i1 i) (in i2 i) (in i3 i))))
4 (forv i 0 limit (set (res i) (f (in i1 i) (in i2 i) (in i3 i) (in i4 i))))
(forv i 0 limit
(def args (array/new ninds))
(for j 0 ninds (set (args j) (in (in inds j) i)))
(forv j 0 ninds (set (args j) (in (in inds j) i)))
(set (res i) (f ;args))))
res)
@@ -901,12 +927,12 @@
1 (do
(def [n] args)
(def arr (array/new n))
(for i 0 n (put arr i i))
(forv i 0 n (put arr i i))
arr)
2 (do
(def [n m] args)
(def arr (array/new (- m n)))
(for i n m (put arr (- i n) i))
(forv i n m (put arr (- i n) i))
arr)
3 (do
(def [n m s] args)
@@ -935,6 +961,18 @@
(def i (find-index pred ind))
(if (= i nil) nil (in ind i)))
(defn index-of
"Find the first key associated with a value x in a data structure, acting like a reverse lookup.
Will not look at table prototypes.
Returns dflt if not found."
[x ind &opt dflt]
(var k (next ind nil))
(var ret dflt)
(while (not= nil k)
(when (= (in ind k) x) (set ret k) (break))
(set k (next ind k)))
ret)
(defn take
"Take first n elements in an indexed type. Returns new indexed instance."
[n ind]
@@ -1103,11 +1141,14 @@
:table (walk-dict f form)
:struct (table/to-struct (walk-dict f form))
:array (walk-ind f form)
:tuple (tuple/slice (walk-ind f form))
:tuple (let [x (walk-ind f form)]
(if (= :parens (tuple/type form))
(tuple/slice x)
(tuple/brackets ;x)))
form))
(put _env 'walk-ind nil)
(put _env 'walk-dict nil)
(undef walk-ind)
(undef walk-dict)
(defn postwalk
"Do a post-order traversal of a data structure and call (f x)
@@ -1189,19 +1230,43 @@
(if x nil (set res x)))
res)
(defn any?
"Returns the first truthy value in ind, otherwise nil.
falsey value."
[ind]
(var res nil)
(loop [x :in ind :until res]
(if x (set res x)))
res)
(defn reverse!
"Reverses the order of the elements in a given array or buffer and returns it
mutated."
[t]
(def len-1 (- (length t) 1))
(def half (/ len-1 2))
(forv i 0 half
(def j (- len-1 i))
(def l (in t i))
(def r (in t j))
(put t i r)
(put t j l))
t)
(defn reverse
"Reverses the order of the elements in a given array or tuple and returns a new array."
"Reverses the order of the elements in a given array or tuple and returns
a new array. If string or buffer is provided function returns array of chars reversed."
[t]
(def len (length t))
(var n (- len 1))
(def reversed (array/new len))
(def ret (array/new len))
(while (>= n 0)
(array/push reversed (in t n))
(array/push ret (in t n))
(-- n))
reversed)
ret)
(defn invert
"Returns a table of where the keys of an associative data structure
"Returns a table where the keys of an associative data structure
are the values, and the values of the keys. If multiple keys have the same
value, one key will be ignored."
[ds]
@@ -1215,11 +1280,14 @@
Returns a new table."
[ks vs]
(def res @{})
(def lk (length ks))
(def lv (length vs))
(def len (if (< lk lv) lk lv))
(for i 0 len
(put res (in ks i) (in vs i)))
(var kk nil)
(var vk nil)
(while true
(set kk (next ks kk))
(if (= nil kk) (break))
(set vk (next vs vk))
(if (= nil vk) (break))
(put res (in ks kk) (in vs vk)))
res)
(defn get-in
@@ -1239,7 +1307,7 @@
(var d ds)
(def len-1 (- (length ks) 1))
(if (< len-1 0) (error "expected at least 1 key in ks"))
(for i 0 len-1
(forv i 0 len-1
(def k (get ks i))
(def v (get d k))
(if (= nil v)
@@ -1261,7 +1329,7 @@
(var d ds)
(def len-1 (- (length ks) 1))
(if (< len-1 0) (error "expected at least 1 key in ks"))
(for i 0 len-1
(forv i 0 len-1
(def k (get ks i))
(def v (get d k))
(if (= nil v)
@@ -1289,7 +1357,7 @@
[tab & colls]
(loop [c :in colls
key :keys c]
(set (tab key) (in c key)))
(put tab key (in c key)))
tab)
(defn merge
@@ -1300,7 +1368,7 @@
(def container @{})
(loop [c :in colls
key :keys c]
(set (container key) (in c key)))
(put container key (in c key)))
container)
(defn keys
@@ -1324,7 +1392,7 @@
arr)
(defn pairs
"Get the values of an associative data structure."
"Get the key-value pairs of an associative data structure."
[x]
(def arr (array/new (length x)))
(var k (next x nil))
@@ -1554,9 +1622,9 @@
,(aux (+ 2 i))
,$res)))) 0)))
(put _env 'sentinel nil)
(put _env 'match-1 nil)
(put _env 'with-idemp nil)
(undef sentinel)
(undef match-1)
(undef with-idemp)
###
###
@@ -1637,7 +1705,7 @@
(print (doc-format (string "Bindings:\n\n" (string/join bindings " "))))
(print)
(print (doc-format (string "Dynamics:\n\n" (string/join dynamics " "))))
(print))
(print "\n Use (doc sym) for more information on a binding.\n"))
(defn doc*
"Get the documentation for a symbol in a given environment. Function form of doc."
@@ -1681,8 +1749,8 @@
[&opt sym]
~(,doc* ',sym))
(put _env 'env-walk nil)
(put _env 'print-index nil)
(undef env-walk)
(undef print-index)
###
###
@@ -1743,14 +1811,16 @@
(defn expandqq [t]
(defn qq [x]
(case (type x)
:tuple (do
(def x0 (in x 0))
(if (or (= 'unquote x0) (= 'unquote-splicing x0))
(tuple x0 (recur (in x 1)))
(tuple/slice (map qq x))))
:tuple (if (= :brackets (tuple/type x))
~[,;(map qq x)]
(do
(def x0 (get x 0))
(if (= 'unquote x0)
(tuple x0 (recur (get x 1)))
(tuple/slice (map qq x)))))
:array (map qq x)
:table (table (map qq (kvs x)))
:struct (struct (map qq (kvs x)))
:table (table ;(map qq (kvs x)))
:struct (struct ;(map qq (kvs x)))
x))
(tuple (in t 0) (qq (in t 1))))
@@ -1814,7 +1884,7 @@
(case tx
:tuple (or (not= (length x) (length y)) (some identity (map deep-not= x y)))
:array (or (not= (length x) (length y)) (some identity (map deep-not= x y)))
:struct (deep-not= (pairs x) (pairs y))
:struct (deep-not= (kvs x) (kvs y))
:table (deep-not= (table/to-struct x) (table/to-struct y))
:buffer (not= (string x) (string y))
(not= x y))))
@@ -1934,20 +2004,24 @@
that should make it easier to write more complex patterns."
~@{:d (range "09")
:a (range "az" "AZ")
:s (set " \t\r\n\0\f")
:s (set " \t\r\n\0\f\v")
:w (range "az" "AZ" "09")
:h (range "09" "af")
:S (if-not :s 1)
:W (if-not :w 1)
:A (if-not :a 1)
:D (if-not :d 1)
:H (if-not :h 1)
:d+ (some :d)
:a+ (some :a)
:s+ (some :s)
:w+ (some :w)
:h+ (some :h)
:d* (any :d)
:a* (any :a)
:w* (any :w)
:s* (any :s)})
:s* (any :s)
:h* (any :h)})
###
###
@@ -1965,7 +2039,7 @@
will inherit bindings from the parent environment, but new
bindings will not pollute the parent environment."
[&opt parent]
(def parent (if parent parent _env))
(def parent (if parent parent root-env))
(def newenv (table/setproto @{} parent))
newenv)
@@ -2002,6 +2076,14 @@
(if ec "\e[0m" "")))
(eflush))
(defn curenv
"Get the current environment table. Same as (fiber/getenv (fiber/current)). If n
is provided, gets the nth prototype of the environment table."
[&opt n]
(var e (fiber/getenv (fiber/current)))
(if n (repeat n (if (= nil e) (break)) (set e (table/getproto e))))
e)
(defn run-context
"Run a context. This evaluates expressions in an environment,
and is encapsulates the parsing, compilation, and evaluation.
@@ -2129,12 +2211,12 @@
(buffer/push-string buf "\n")))
(var returnval nil)
(run-context {:chunks chunks
:on-compile-error (fn [msg errf &]
:on-compile-error (fn compile-error [msg errf &]
(error (string "compile error: " msg)))
:on-parse-error (fn [p x]
:on-parse-error (fn parse-error [p x]
(error (string "parse error: " (parser/error p))))
:fiber-flags :i
:on-status (fn [f val]
:on-status (fn on-status [f val]
(if-not (= (fiber/status f) :dead)
(error val))
(set returnval val))
@@ -2173,10 +2255,11 @@
by make-image, such that (load-image bytes) is the same as (unmarshal bytes load-image-dict)."
@{})
(def comptime
(defmacro comptime
"(comptime x)\n\n
Evals x at compile time and returns the result. Similar to a top level unquote."
:macro eval)
[x]
(eval x))
(defn make-image
"Create an image from an environment returned by require.
@@ -2230,7 +2313,7 @@
(module/add-paths ".jimage" :image)
# Version of fexists that works even with a reduced OS
(if-let [has-stat (_env 'os/stat)]
(if-let [has-stat (root-env 'os/stat)]
(let [stat (has-stat :value)]
(defglobal "fexists" (fn fexists [path] (= :file (stat path :mode)))))
(defglobal "fexists"
@@ -2277,10 +2360,10 @@
str-parts (interpose "\n " paths)]
[nil (string "could not find module " path ":\n " ;str-parts)])))
(put _env 'fexists nil)
(put _env 'mod-filter nil)
(put _env 'check-. nil)
(put _env 'not-check-. nil)
(undef fexists)
(undef mod-filter)
(undef check-.)
(undef not-check-.)
(def module/cache
"Table mapping loaded module identifiers to their environments."
@@ -2388,7 +2471,7 @@
(def newv (table/setproto @{:private (not ep)} v))
(put env (symbol prefix k) newv)))
(put _env 'require-1 nil)
(undef require-1)
(defmacro import
"Import a module. First requires the module, and then merges its
@@ -2400,11 +2483,12 @@
to be called. Dynamic bindings will NOT be imported. Use :fresh to bypass the
module cache."
[path & args]
(def argm (map |(if (keyword? $) $ (string $)) args))
(def ps (partition 2 args))
(def argm (mapcat (fn [[k v]] [k (if (= k :as) (string v) v)]) ps))
(tuple import* (string path) ;argm))
(defmacro use
"Similar to import, but imported bindings are not prefixed with a namespace
"Similar to import, but imported bindings are not prefixed with a module
identifier. Can also import multiple modules in one shot."
[& modules]
~(do ,;(map |~(,import* ,(string $) :prefix "") modules)))
@@ -2454,7 +2538,7 @@
(in (.slots frame-idx) (or nth 0)))
# Conditional compilation for disasm
(def disasm-alias (if-let [x (_env 'disasm)] (x :value)))
(def disasm-alias (if-let [x (root-env 'disasm)] (x :value)))
(defn .disasm
"Gets the assembly for the current function."
@@ -2503,7 +2587,7 @@
[&opt n]
(def fun (.fn n))
(def bytecode (.bytecode n))
(for i 0 (length bytecode)
(forv i 0 (length bytecode)
(debug/fbreak fun i))
(print "Set " (length bytecode) " breakpoints in " fun))
@@ -2512,17 +2596,13 @@
[&opt n]
(def fun (.fn n))
(def bytecode (.bytecode n))
(for i 0 (length bytecode)
(forv i 0 (length bytecode)
(debug/unfbreak fun i))
(print "Cleared " (length bytecode) " breakpoints in " fun))
(unless (get _env 'disasm)
(put _env '.disasm nil)
(put _env '.bytecode nil)
(put _env '.breakall nil)
(put _env '.clearall nil)
(put _env '.ppasm nil))
(put _env 'disasm-alias nil)
(unless (get root-env 'disasm)
(undef .disasm .bytecode .breakall .clearall .ppasm))
(undef disasm-alias)
(defn .source
"Show the source code for the function being debugged."
@@ -2554,7 +2634,7 @@
"Go to the next breakpoint."
[&opt n]
(var res nil)
(for i 0 (or n 1)
(forv i 0 (or n 1)
(set res (resume (.fiber))))
res)
@@ -2568,7 +2648,7 @@
"Execute the next n instructions."
[&opt n]
(var res nil)
(for i 0 (or n 1)
(forv i 0 (or n 1)
(set res (debug/step (.fiber))))
res)
@@ -2576,9 +2656,9 @@
"An environment that contains dot prefixed functions for debugging."
@{})
(def- debugger-keys (filter (partial string/has-prefix? ".") (keys _env)))
(each k debugger-keys (put debugger-env k (_env k)) (put _env k nil))
(put _env 'debugger-keys nil)
(def- debugger-keys (filter (partial string/has-prefix? ".") (keys root-env)))
(each k debugger-keys (put debugger-env k (root-env k)) (put root-env k nil))
(undef debugger-keys)
###
###
@@ -2642,6 +2722,37 @@
:on-status (or onsignal (make-onsignal env 1))
:source "repl"}))
###
###
### Extras
###
###
(defmacro- guarddef
[sym form]
(if (dyn sym)
form))
(guarddef ev/go
(defmacro ev/spawn
"Run some code in a new fiber. This is shorthand for (ev/call (fn [] ;body))."
[& body]
~(,ev/call (fn [] ,;body))))
(guarddef net/listen
(defn net/server
"Start a server asynchornously with net/listen and net/accept-loop. Returns the new server stream."
[host port &opt handler type]
(def s (net/listen host port type))
(if handler
(ev/call (fn [] (net/accept-loop s handler))))
s))
(guarddef ev/close
(defn net/close "Alias for ev/close." [stream] (ev/close stream)))
(undef guarddef)
###
###
### CLI Tool Main
@@ -2649,7 +2760,7 @@
###
(defn- no-side-effects
"Check if form may have side effects. If returns true, then the src
"Check if form may have side effects. If rturns true, then the src
must not have side effects, such as calling a C function."
[src]
(cond
@@ -2674,7 +2785,7 @@
(each a args (import* (string a) :prefix "" :evaluator evaluator)))
# conditional compilation for reduced os
(def- getenv-alias (if-let [entry (in _env 'os/getenv)] (entry :value) (fn [&])))
(def- getenv-alias (if-let [entry (in root-env 'os/getenv)] (entry :value) (fn [&])))
(defn cli-main
"Entrance for the Janet CLI tool. Call this functions with the command line
@@ -2706,15 +2817,15 @@
-v : Print the version string
-s : Use raw stdin instead of getline like functionality
-e code : Execute a string of janet
-d : Set the debug flag in the repl
-r : Enter the repl after running all scripts
-p : Keep on executing if there is a top level error (persistent)
-d : Set the debug flag in the REPL
-r : Enter the REPL after running all scripts
-p : Keep on executing if there is a top-level error (persistent)
-q : Hide logo (quiet)
-k : Compile scripts but do not execute (flycheck)
-m syspath : Set system path for loading global modules
-c source output : Compile janet source code into an image
-n : Disable ANSI color output in the repl
-l path : Execute code in a file before running the main script
-n : Disable ANSI color output in the REPL
-l lib : Import a module before processing more arguments
-- : Stop handling options`)
(os/exit 0)
1)
@@ -2726,17 +2837,17 @@
"k" (fn [&] (set *compile-only* true) (set *exit-on-error* false) 1)
"n" (fn [&] (set *colorize* false) 1)
"m" (fn [i &] (setdyn :syspath (in args (+ i 1))) 2)
"c" (fn [i &]
"c" (fn c-switch [i &]
(def e (dofile (in args (+ i 1))))
(spit (in args (+ i 2)) (make-image e))
(set *no-file* false)
3)
"-" (fn [&] (set *handleopts* false) 1)
"l" (fn [i &]
"l" (fn l-switch [i &]
(import* (in args (+ i 1))
:prefix "" :exit *exit-on-error*)
2)
"e" (fn [i &]
"e" (fn e-switch [i &]
(set *no-file* false)
(eval-string (in args (+ i 1)))
2)
@@ -2783,18 +2894,19 @@
(def subargs (array/slice args i))
(put env :args subargs)
(dofile arg :prefix "" :exit *exit-on-error* :evaluator evaluator :env env)
(if-let [main (get (in env 'main) :value)]
(let [thunk (compile [main ;(tuple/slice args i)] env arg)]
(if (function? thunk) (thunk) (error (thunk :error)))))
(unless *compile-only*
(if-let [main (get (in env 'main) :value)]
(let [thunk (compile [main ;(tuple/slice args i)] env arg)]
(if (function? thunk) (thunk) (error (thunk :error))))))
(set i lenargs))))
(when (and (not *compile-only*) (or *should-repl* *no-file*))
(if-not *quiet*
(print "Janet " janet/version "-" janet/build " Copyright (C) 2017-2020 Calvin Rose"))
(print "Janet " janet/version "-" janet/build " " (os/which) "/" (os/arch) " - '(doc)' for help"))
(flush)
(defn getprompt [p]
(def [line] (parser/where p))
(string "janet:" line ":" (parser/state p :delimiters) "> "))
(string "repl:" line ":" (parser/state p :delimiters) "> "))
(defn getstdin [prompt buf _]
(file/write stdout prompt)
(file/flush stdout)
@@ -2808,12 +2920,7 @@
(setdyn :err-color (if *colorize* true))
(repl getchunk nil env)))
(put _env 'no-side-effects nil)
(put _env 'is-safe-def nil)
(put _env 'safe-forms nil)
(put _env 'importers nil)
(put _env 'use-2 nil)
(put _env 'getenv-alias nil)
(undef no-side-effects is-safe-def safe-forms importers use-2 getenv-alias)
###
###
@@ -2821,12 +2928,13 @@
###
###
(def root-env "The root environment used to create environments with (make-env)" _env)
(do
(put _env 'boot/opts nil)
(put _env '_env nil)
(def load-dict (env-lookup _env))
(undef boot/opts undef)
(def load-dict (env-lookup root-env))
(put load-dict 'boot/config nil)
(put load-dict 'boot/args nil)
(each [k v] (pairs load-dict)
(if (number? v) (put load-dict k nil)))
(merge-into load-image-dict load-dict)
(merge-into make-image-dict (invert load-dict)))
@@ -2847,25 +2955,29 @@
(put into k (x k))))
into)
(def env (fiber/getenv (fiber/current)))
# Modify env based on some options.
(loop [[k v] :pairs env
(loop [[k v] :pairs root-env
:when (symbol? k)]
(def flat (proto-flatten @{} v))
(when (boot/config :no-docstrings)
(put flat :doc nil))
(when (boot/config :no-sourcemaps)
(put flat :source-map nil))
(put env k flat))
(put root-env k flat))
(put env 'boot/config nil)
(put env 'boot/args nil)
(def image (let [env-pairs (pairs (env-lookup env))
(put root-env 'boot/config nil)
(put root-env 'boot/args nil)
(def image (let [env-pairs (pairs (env-lookup root-env))
essential-pairs (filter (fn [[k v]] (or (cfunction? v) (abstract? v))) env-pairs)
lookup (table ;(mapcat identity essential-pairs))
reverse-lookup (invert lookup)]
(marshal env reverse-lookup)))
# Check no duplicate values
(def temp @{})
(eachp [k v] lookup
(if (in temp v) (errorf "duplicate value: %v" v))
(put temp v k))
(marshal root-env reverse-lookup)))
# Create amalgamation
@@ -2894,6 +3006,7 @@
"src/core/corelib.c"
"src/core/debug.c"
"src/core/emit.c"
"src/core/ev.c"
"src/core/fiber.c"
"src/core/gc.c"
"src/core/inttypes.c"

View File

@@ -23,6 +23,7 @@
#include <janet.h>
#include <assert.h>
#include <stdio.h>
#include <math.h>
#include "tests.h"
@@ -44,6 +45,11 @@ int system_test() {
assert(janet_equals(janet_wrap_integer(INT32_MIN), janet_wrap_integer(INT32_MIN)));
assert(janet_equals(janet_wrap_number(1.4), janet_wrap_number(1.4)));
assert(janet_equals(janet_wrap_number(3.14159265), janet_wrap_number(3.14159265)));
#ifdef NAN
assert(janet_checktype(janet_wrap_number(NAN), JANET_NUMBER));
#else
assert(janet_checktype(janet_wrap_number(0.0 / 0.0), JANET_NUMBER));
#endif
assert(NULL != &janet_wrap_nil);

View File

@@ -61,5 +61,11 @@ int table_test() {
assert(janet_equals(janet_table_get(t2, janet_csymbolv("t2key1")), janet_wrap_integer(10)));
assert(janet_equals(janet_table_get(t2, janet_csymbolv("t2key2")), janet_wrap_integer(100)));
assert(t2->count == 4);
assert(janet_equals(janet_table_remove(t2, janet_csymbolv("t2key1")), janet_wrap_integer(10)));
assert(t2->count == 3);
assert(janet_equals(janet_table_remove(t2, janet_csymbolv("t2key2")), janet_wrap_integer(100)));
assert(t2->count == 2);
return 0;
}

View File

@@ -27,10 +27,10 @@
#define JANETCONF_H
#define JANET_VERSION_MAJOR 1
#define JANET_VERSION_MINOR 10
#define JANET_VERSION_PATCH 1
#define JANET_VERSION_EXTRA ""
#define JANET_VERSION "1.10.1"
#define JANET_VERSION_MINOR 13
#define JANET_VERSION_PATCH 0
#define JANET_VERSION_EXTRA "-dev"
#define JANET_VERSION "1.13.0-dev"
/* #define JANET_BUILD "local" */
@@ -41,7 +41,8 @@
/* #define JANET_API __attribute__((visibility ("default"))) */
/* These settings should be specified before amalgamation is
* built. */
* built. Any build with these set should be considered non-standard, and
* certain Janet libraries should be expected not to work. */
/* #define JANET_NO_DOCSTRINGS */
/* #define JANET_NO_SOURCEMAPS */
/* #define JANET_REDUCED_OS */
@@ -51,13 +52,15 @@
/* #define JANET_NO_NET */
/* #define JANET_NO_TYPED_ARRAY */
/* #define JANET_NO_INT_TYPES */
/* Other settings */
/* #define JANET_NO_PRF */
/* #define JANET_NO_UTC_MKTIME */
/* #define JANET_NO_EV */
/* #define JANET_NO_REALPATH */
/* #define JANET_NO_SYMLINKS */
/* #define JANET_NO_UMASK */
/* Other settings */
/* #define JANET_DEBUG */
/* #define JANET_PRF */
/* #define JANET_NO_UTC_MKTIME */
/* #define JANET_OUT_OF_MEMORY do { printf("janet out of memory\n"); exit(1); } while (0) */
/* #define JANET_EXIT(msg) do { printf("C assert failed executing janet: %s\n", msg); exit(1); } while (0) */
/* #define JANET_TOP_LEVEL_SIGNAL(msg) call_my_function((msg), stderr) */
@@ -67,5 +70,9 @@
/* #define JANET_STACK_MAX 16384 */
/* #define JANET_OS_NAME my-custom-os */
/* #define JANET_ARCH_NAME pdp-8 */
/* #define JANET_EV_EPOLL */
/* Main client settings, does not affect library code */
/* #define JANET_SIMPLE_GETLINE */
#endif /* end of include guard: JANETCONF_H */

View File

@@ -344,16 +344,16 @@ static const JanetReg array_cfuns[] = {
{
"array/concat", cfun_array_concat,
JDOC("(array/concat arr & parts)\n\n"
"Concatenates a variadic number of arrays (and tuples) into the first argument "
"which must an array. If any of the parts are arrays or tuples, their elements will "
"Concatenates a variable number of arrays (and tuples) into the first argument "
"which must be an array. If any of the parts are arrays or tuples, their elements will "
"be inserted into the array. Otherwise, each part in parts will be appended to arr in order. "
"Return the modified array arr.")
},
{
"array/insert", cfun_array_insert,
JDOC("(array/insert arr at & xs)\n\n"
"Insert all of xs into array arr at index at. at should be an integer "
"0 and the length of the array. A negative value for at will index from "
"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.")
},

View File

@@ -73,6 +73,7 @@ static const JanetInstructionDef janet_ops[] = {
{"call", JOP_CALL},
{"clo", JOP_CLOSURE},
{"cmp", JOP_COMPARE},
{"cncl", JOP_CANCEL},
{"div", JOP_DIVIDE},
{"divim", JOP_DIVIDE_IMMEDIATE},
{"eq", JOP_EQUALS},
@@ -112,6 +113,8 @@ static const JanetInstructionDef janet_ops[] = {
{"movn", JOP_MOVE_NEAR},
{"mul", JOP_MULTIPLY},
{"mulim", JOP_MULTIPLY_IMMEDIATE},
{"neq", JOP_NOT_EQUALS},
{"neqim", JOP_NOT_EQUALS_IMMEDIATE},
{"next", JOP_NEXT},
{"noop", JOP_NOOP},
{"prop", JOP_PROPAGATE},
@@ -718,6 +721,9 @@ static JanetAssembleResult janet_asm1(JanetAssembler *parent, Janet source, int
janet_asm_error(&a, "invalid assembly");
}
/* Add final flags */
janet_def_addflags(def);
/* Finish everything and return funcdef */
janet_asm_deinit(&a);
result.error = NULL;
@@ -835,85 +841,110 @@ Janet janet_asm_decode_instruction(uint32_t instr) {
return janet_wrap_nil();
}
Janet janet_disasm(JanetFuncDef *def) {
int32_t i;
/*
* Disasm sections
*/
static Janet janet_disasm_arity(JanetFuncDef *def) {
return janet_wrap_integer(def->arity);
}
static Janet janet_disasm_min_arity(JanetFuncDef *def) {
return janet_wrap_integer(def->min_arity);
}
static Janet janet_disasm_max_arity(JanetFuncDef *def) {
return janet_wrap_integer(def->max_arity);
}
static Janet janet_disasm_slotcount(JanetFuncDef *def) {
return janet_wrap_integer(def->slotcount);
}
static Janet janet_disasm_bytecode(JanetFuncDef *def) {
JanetArray *bcode = janet_array(def->bytecode_length);
JanetArray *constants;
JanetTable *ret = janet_table(10);
janet_table_put(ret, janet_ckeywordv("arity"), janet_wrap_integer(def->arity));
janet_table_put(ret, janet_ckeywordv("min-arity"), janet_wrap_integer(def->min_arity));
janet_table_put(ret, janet_ckeywordv("max-arity"), janet_wrap_integer(def->max_arity));
janet_table_put(ret, janet_ckeywordv("bytecode"), janet_wrap_array(bcode));
if (NULL != def->source) {
janet_table_put(ret, janet_ckeywordv("source"), janet_wrap_string(def->source));
}
if (def->flags & JANET_FUNCDEF_FLAG_VARARG) {
janet_table_put(ret, janet_ckeywordv("vararg"), janet_wrap_true());
}
if (NULL != def->name) {
janet_table_put(ret, janet_ckeywordv("name"), janet_wrap_string(def->name));
}
/* Add constants */
if (def->constants_length > 0) {
constants = janet_array(def->constants_length);
janet_table_put(ret, janet_ckeywordv("constants"), janet_wrap_array(constants));
for (i = 0; i < def->constants_length; i++) {
constants->data[i] = def->constants[i];
}
constants->count = def->constants_length;
}
/* Add bytecode */
for (i = 0; i < def->bytecode_length; i++) {
for (int32_t i = 0; i < def->bytecode_length; i++) {
bcode->data[i] = janet_asm_decode_instruction(def->bytecode[i]);
}
bcode->count = def->bytecode_length;
return janet_wrap_array(bcode);
}
/* Add source map */
if (NULL != def->sourcemap) {
JanetArray *sourcemap = janet_array(def->bytecode_length);
for (i = 0; i < def->bytecode_length; i++) {
Janet *t = janet_tuple_begin(2);
JanetSourceMapping mapping = def->sourcemap[i];
t[0] = janet_wrap_integer(mapping.line);
t[1] = janet_wrap_integer(mapping.column);
sourcemap->data[i] = janet_wrap_tuple(janet_tuple_end(t));
}
sourcemap->count = def->bytecode_length;
janet_table_put(ret, janet_ckeywordv("sourcemap"), janet_wrap_array(sourcemap));
static Janet janet_disasm_source(JanetFuncDef *def) {
if (def->source != NULL) return janet_wrap_string(def->source);
return janet_wrap_nil();
}
static Janet janet_disasm_name(JanetFuncDef *def) {
if (def->name != NULL) return janet_wrap_string(def->name);
return janet_wrap_nil();
}
static Janet janet_disasm_vararg(JanetFuncDef *def) {
return janet_wrap_boolean(def->flags & JANET_FUNCDEF_FLAG_VARARG);
}
static Janet janet_disasm_constants(JanetFuncDef *def) {
JanetArray *constants = janet_array(def->constants_length);
for (int32_t i = 0; i < def->constants_length; i++) {
constants->data[i] = def->constants[i];
}
constants->count = def->constants_length;
return janet_wrap_array(constants);
}
/* Add environments */
if (NULL != def->environments) {
JanetArray *envs = janet_array(def->environments_length);
for (i = 0; i < def->environments_length; i++) {
envs->data[i] = janet_wrap_integer(def->environments[i]);
}
envs->count = def->environments_length;
janet_table_put(ret, janet_ckeywordv("environments"), janet_wrap_array(envs));
static Janet janet_disasm_sourcemap(JanetFuncDef *def) {
if (NULL == def->sourcemap) return janet_wrap_nil();
JanetArray *sourcemap = janet_array(def->bytecode_length);
for (int32_t i = 0; i < def->bytecode_length; i++) {
Janet *t = janet_tuple_begin(2);
JanetSourceMapping mapping = def->sourcemap[i];
t[0] = janet_wrap_integer(mapping.line);
t[1] = janet_wrap_integer(mapping.column);
sourcemap->data[i] = janet_wrap_tuple(janet_tuple_end(t));
}
sourcemap->count = def->bytecode_length;
return janet_wrap_array(sourcemap);
}
/* Add closures */
/* Funcdefs cannot be recursive */
if (NULL != def->defs) {
JanetArray *defs = janet_array(def->defs_length);
for (i = 0; i < def->defs_length; i++) {
defs->data[i] = janet_disasm(def->defs[i]);
}
defs->count = def->defs_length;
janet_table_put(ret, janet_ckeywordv("defs"), janet_wrap_array(defs));
static Janet janet_disasm_environments(JanetFuncDef *def) {
JanetArray *envs = janet_array(def->environments_length);
for (int32_t i = 0; i < def->environments_length; i++) {
envs->data[i] = janet_wrap_integer(def->environments[i]);
}
envs->count = def->environments_length;
return janet_wrap_array(envs);
}
/* Add slotcount */
janet_table_put(ret, janet_ckeywordv("slotcount"), janet_wrap_integer(def->slotcount));
static Janet janet_disasm_defs(JanetFuncDef *def) {
JanetArray *defs = janet_array(def->defs_length);
for (int32_t i = 0; i < def->defs_length; i++) {
defs->data[i] = janet_disasm(def->defs[i]);
}
defs->count = def->defs_length;
return janet_wrap_array(defs);
}
Janet janet_disasm(JanetFuncDef *def) {
JanetTable *ret = janet_table(10);
janet_table_put(ret, janet_ckeywordv("arity"), janet_disasm_arity(def));
janet_table_put(ret, janet_ckeywordv("min-arity"), janet_disasm_min_arity(def));
janet_table_put(ret, janet_ckeywordv("max-arity"), janet_disasm_max_arity(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("name"), janet_disasm_name(def));
janet_table_put(ret, janet_ckeywordv("slotcount"), janet_disasm_slotcount(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));
janet_table_put(ret, janet_ckeywordv("defs"), janet_disasm_defs(def));
return janet_wrap_struct(janet_table_to_struct(ret));
}
/* C Function for assembly */
static Janet cfun_asm(int32_t argc, Janet *argv) {
janet_arity(argc, 1, 1);
janet_fixarity(argc, 1);
JanetAssembleResult res;
res = janet_asm(argv[0], 0);
if (res.status != JANET_ASSEMBLE_OK) {
@@ -923,9 +954,26 @@ static Janet cfun_asm(int32_t argc, Janet *argv) {
}
static Janet cfun_disasm(int32_t argc, Janet *argv) {
janet_arity(argc, 1, 1);
janet_arity(argc, 1, 2);
JanetFunction *f = janet_getfunction(argv, 0);
return janet_disasm(f->def);
if (argc == 2) {
JanetKeyword kw = janet_getkeyword(argv, 1);
if (!janet_cstrcmp(kw, "arity")) return janet_disasm_arity(f->def);
if (!janet_cstrcmp(kw, "min-arity")) return janet_disasm_min_arity(f->def);
if (!janet_cstrcmp(kw, "max-arity")) return janet_disasm_max_arity(f->def);
if (!janet_cstrcmp(kw, "bytecode")) return janet_disasm_bytecode(f->def);
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, "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);
if (!janet_cstrcmp(kw, "environments")) return janet_disasm_environments(f->def);
if (!janet_cstrcmp(kw, "defs")) return janet_disasm_defs(f->def);
janet_panicf("unknown disasm key %v", argv[1]);
} else {
return janet_disasm(f->def);
}
}
static const JanetReg asm_cfuns[] = {
@@ -933,15 +981,29 @@ static const JanetReg asm_cfuns[] = {
"asm", cfun_asm,
JDOC("(asm assembly)\n\n"
"Returns a new function that is the compiled result of the assembly.\n"
"The syntax for the assembly can be found on the Janet website. Will throw an\n"
"The syntax for the assembly can be found on the Janet website, and should correspond\n"
"to the return value of disasm. Will throw an\n"
"error on invalid assembly.")
},
{
"disasm", cfun_disasm,
JDOC("(disasm func)\n\n"
"Returns assembly that could be used be compile the given function.\n"
JDOC("(disasm func &opt field)\n\n"
"Returns assembly that could be used to compile the given function.\n"
"func must be a function, not a c function. Will throw on error on a badly\n"
"typed argument.")
"typed argument. If given a field name, will only return that part of the function assembly.\n"
"Possible fields are:\n\n"
"\t:arity - number of required and optional arguments.\n"
"\t:min-arity - minimum number of arguments function can be called with.\n"
"\t:max-arity - maximum number of arguments function can be called with.\n"
"\t:vararg - true if function can take a variable number of arguments.\n"
"\t:bytecode - array of parsed bytecode instructions. Each instruction is a tuple.\n"
"\t:source - name of source file that this function was compiled from.\n"
"\t:name - name of function.\n"
"\t:slotcount - how many virtual registers, or slots, this function uses. Corresponds to stack space used by function.\n"
"\t:constants - an array of constants referenced by this function.\n"
"\t:sourcemap - a mapping of each bytecode instruction to a line and column in the source file.\n"
"\t:environments - an internal mapping of which enclosing functions are referenced for bindings.\n"
"\t:defs - other function definitions that this function may instantiate.\n")
},
{NULL, NULL, NULL}
};

View File

@@ -101,10 +101,13 @@ enum JanetInstructionType janet_instructions[JOP_INSTRUCTION_COUNT] = {
JINT_SSS, /* JOP_GREATER_THAN_EQUAL */
JINT_SSS, /* JOP_LESS_THAN_EQUAL */
JINT_SSS, /* JOP_NEXT */
JINT_SSS, /* JOP_NOT_EQUALS, */
JINT_SSI, /* JOP_NOT_EQUALS_IMMEDIATE, */
JINT_SSS /* JOP_CANCEL, */
};
/* Verify some bytecode */
int32_t janet_verify(JanetFuncDef *def) {
int janet_verify(JanetFuncDef *def) {
int vargs = !!(def->flags & JANET_FUNCDEF_FLAG_VARARG);
int32_t i;
int32_t maxslot = def->arity + vargs;

View File

@@ -27,12 +27,26 @@
#include "fiber.h"
#endif
#ifndef JANET_SINGLE_THREADED
#ifndef JANET_WINDOWS
#include <pthread.h>
#else
#include <windows.h>
#endif
#endif
JANET_NO_RETURN static void janet_top_level_signal(const char *msg) {
#ifdef JANET_TOP_LEVEL_SIGNAL
JANET_TOP_LEVEL_SIGNAL(msg);
#else
fputs(msg, stdout);
exit(1);
# ifdef JANET_SINGLE_THREADED
exit(-1);
# elif defined(JANET_WINDOWS)
ExitThread(-1);
# else
pthread_exit(NULL);
# endif
#endif
}
@@ -325,7 +339,10 @@ JanetRange janet_getslice(int32_t argc, const Janet *argv) {
}
Janet janet_dyn(const char *name) {
if (!janet_vm_fiber) return janet_wrap_nil();
if (!janet_vm_fiber) {
if (!janet_vm_top_dyns) return janet_wrap_nil();
return janet_table_get(janet_vm_top_dyns, janet_ckeywordv(name));
}
if (janet_vm_fiber->env) {
return janet_table_get(janet_vm_fiber->env, janet_ckeywordv(name));
} else {
@@ -334,11 +351,15 @@ Janet janet_dyn(const char *name) {
}
void janet_setdyn(const char *name, Janet value) {
if (!janet_vm_fiber) return;
if (!janet_vm_fiber->env) {
janet_vm_fiber->env = janet_table(1);
if (!janet_vm_fiber) {
if (!janet_vm_top_dyns) janet_vm_top_dyns = janet_table(10);
janet_table_put(janet_vm_top_dyns, janet_ckeywordv(name), value);
} else {
if (!janet_vm_fiber->env) {
janet_vm_fiber->env = janet_table(1);
}
janet_table_put(janet_vm_fiber->env, janet_ckeywordv(name), value);
}
janet_table_put(janet_vm_fiber->env, janet_ckeywordv(name), value);
}
uint64_t janet_getflags(const Janet *argv, int32_t n, const char *flags) {

View File

@@ -33,6 +33,11 @@ static int arity1or2(JanetFopts opts, JanetSlot *args) {
int32_t arity = janet_v_count(args);
return arity == 1 || arity == 2;
}
static int arity2or3(JanetFopts opts, JanetSlot *args) {
(void) opts;
int32_t arity = janet_v_count(args);
return arity == 2 || arity == 3;
}
static int fixarity1(JanetFopts opts, JanetSlot *args) {
(void) opts;
return janet_v_count(args) == 1;
@@ -90,34 +95,67 @@ static JanetSlot opfunction(
return t;
}
/* Check if a value can be coerced to an immediate value */
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;
*out = (int8_t) integer;
return 1;
}
/* Check if a slot can be coerced to an immediate value */
static int can_slot_be_imm(JanetSlot s, int8_t *out) {
if (!(s.flags & JANET_SLOT_CONSTANT)) return 0;
return can_be_imm(s.constant, out);
}
/* Emit a series of instructions instead of a function call to a math op */
static JanetSlot opreduce(
JanetFopts opts,
JanetSlot *args,
int op,
int opim,
Janet nullary) {
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) {
return janetc_cslot(nullary);
} else if (len == 1) {
t = janetc_gettarget(opts);
janetc_emit_sss(c, op, t, janetc_cslot(nullary), args[0], 1);
/* Special case subtract to be times -1 */
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);
}
return t;
}
t = janetc_gettarget(opts);
janetc_emit_sss(c, op, t, args[0], args[1], 1);
for (i = 2; i < len; i++)
janetc_emit_sss(c, op, t, t, args[i], 1);
if (opim && can_slot_be_imm(args[1], &imm)) {
janetc_emit_ssi(c, opim, t, args[0], neg ? -imm : 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);
} else {
janetc_emit_sss(c, op, t, t, args[i], 1);
}
}
return t;
}
/* Function optimizers */
static JanetSlot do_propagate(JanetFopts opts, JanetSlot *args) {
return opreduce(opts, args, JOP_PROPAGATE, janet_wrap_nil());
return opreduce(opts, args, JOP_PROPAGATE, 0, janet_wrap_nil());
}
static JanetSlot do_error(JanetFopts opts, JanetSlot *args) {
janetc_emit_s(opts.compiler, JOP_ERROR, args[0], 0);
@@ -134,19 +172,40 @@ static JanetSlot do_debug(JanetFopts opts, JanetSlot *args) {
return t;
}
static JanetSlot do_in(JanetFopts opts, JanetSlot *args) {
return opreduce(opts, args, JOP_IN, janet_wrap_nil());
return opreduce(opts, args, JOP_IN, 0, janet_wrap_nil());
}
static JanetSlot do_get(JanetFopts opts, JanetSlot *args) {
return opreduce(opts, args, JOP_GET, janet_wrap_nil());
if (janet_v_count(args) == 3) {
JanetCompiler *c = opts.compiler;
JanetSlot t = janetc_gettarget(opts);
int target_is_default = janetc_sequal(t, args[2]);
JanetSlot dflt_slot = args[2];
if (target_is_default) {
dflt_slot = janetc_farslot(c);
janetc_copy(c, dflt_slot, t);
}
janetc_emit_sss(c, JOP_GET, t, args[0], args[1], 1);
int32_t label = janetc_emit_si(c, JOP_JUMP_IF_NOT_NIL, t, 0, 0);
janetc_copy(c, t, dflt_slot);
if (target_is_default) janetc_freeslot(c, dflt_slot);
int32_t current = janet_v_count(c->buffer);
c->buffer[label] |= (current - label) << 16;
return t;
} else {
return opreduce(opts, args, JOP_GET, 0, 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, janet_wrap_nil());
return opreduce(opts, args, JOP_MODULO, 0, janet_wrap_nil());
}
static JanetSlot do_remainder(JanetFopts opts, JanetSlot *args) {
return opreduce(opts, args, JOP_REMAINDER, janet_wrap_nil());
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());
}
static JanetSlot do_put(JanetFopts opts, JanetSlot *args) {
if (opts.flags & JANET_FOPTS_DROP) {
@@ -172,6 +231,9 @@ static JanetSlot do_yield(JanetFopts opts, JanetSlot *args) {
static JanetSlot do_resume(JanetFopts opts, JanetSlot *args) {
return opfunction(opts, args, JOP_RESUME, janet_wrap_nil());
}
static JanetSlot do_cancel(JanetFopts opts, JanetSlot *args) {
return opfunction(opts, args, JOP_CANCEL, janet_wrap_nil());
}
static JanetSlot do_apply(JanetFopts opts, JanetSlot *args) {
/* Push phase */
JanetCompiler *c = opts.compiler;
@@ -200,34 +262,34 @@ 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, janet_wrap_integer(0));
return opreduce(opts, args, JOP_ADD, JOP_ADD_IMMEDIATE, janet_wrap_integer(0));
}
static JanetSlot do_sub(JanetFopts opts, JanetSlot *args) {
return opreduce(opts, args, JOP_SUBTRACT, janet_wrap_integer(0));
return opreduce(opts, args, JOP_SUBTRACT, -JOP_ADD_IMMEDIATE, janet_wrap_integer(0));
}
static JanetSlot do_mul(JanetFopts opts, JanetSlot *args) {
return opreduce(opts, args, JOP_MULTIPLY, janet_wrap_integer(1));
return opreduce(opts, args, JOP_MULTIPLY, JOP_MULTIPLY_IMMEDIATE, janet_wrap_integer(1));
}
static JanetSlot do_div(JanetFopts opts, JanetSlot *args) {
return opreduce(opts, args, JOP_DIVIDE, janet_wrap_integer(1));
return opreduce(opts, args, JOP_DIVIDE, JOP_DIVIDE_IMMEDIATE, janet_wrap_integer(1));
}
static JanetSlot do_band(JanetFopts opts, JanetSlot *args) {
return opreduce(opts, args, JOP_BAND, janet_wrap_integer(-1));
return opreduce(opts, args, JOP_BAND, 0, janet_wrap_integer(-1));
}
static JanetSlot do_bor(JanetFopts opts, JanetSlot *args) {
return opreduce(opts, args, JOP_BOR, janet_wrap_integer(0));
return opreduce(opts, args, JOP_BOR, 0, janet_wrap_integer(0));
}
static JanetSlot do_bxor(JanetFopts opts, JanetSlot *args) {
return opreduce(opts, args, JOP_BXOR, janet_wrap_integer(0));
return opreduce(opts, args, JOP_BXOR, 0, janet_wrap_integer(0));
}
static JanetSlot do_lshift(JanetFopts opts, JanetSlot *args) {
return opreduce(opts, args, JOP_SHIFT_LEFT, janet_wrap_integer(1));
return opreduce(opts, args, JOP_SHIFT_LEFT, JOP_SHIFT_LEFT_IMMEDIATE, janet_wrap_integer(1));
}
static JanetSlot do_rshift(JanetFopts opts, JanetSlot *args) {
return opreduce(opts, args, JOP_SHIFT_RIGHT, janet_wrap_integer(1));
return opreduce(opts, args, JOP_SHIFT_RIGHT, JOP_SHIFT_RIGHT_IMMEDIATE, janet_wrap_integer(1));
}
static JanetSlot do_rshiftu(JanetFopts opts, JanetSlot *args) {
return opreduce(opts, args, JOP_SHIFT_RIGHT, janet_wrap_integer(1));
return opreduce(opts, args, JOP_SHIFT_RIGHT_UNSIGNED, JOP_SHIFT_RIGHT_UNSIGNED_IMMEDIATE, janet_wrap_integer(1));
}
static JanetSlot do_bnot(JanetFopts opts, JanetSlot *args) {
return genericSS(opts, JOP_BNOT, args[0]);
@@ -238,9 +300,11 @@ static JanetSlot compreduce(
JanetFopts opts,
JanetSlot *args,
int op,
int opim,
int invert) {
JanetCompiler *c = opts.compiler;
int32_t i, len;
int8_t imm = 0;
len = janet_v_count(args);
int32_t *labels = NULL;
JanetSlot t;
@@ -251,19 +315,17 @@ static JanetSlot compreduce(
}
t = janetc_gettarget(opts);
for (i = 1; i < len; i++) {
janetc_emit_sss(c, op, t, args[i - 1], args[i], 1);
if (opim && can_slot_be_imm(args[i], &imm)) {
janetc_emit_ssi(c, opim, t, args[i - 1], imm, 1);
} else {
janetc_emit_sss(c, op, t, args[i - 1], args[i], 1);
}
if (i != (len - 1)) {
int32_t label = janetc_emit_si(c, JOP_JUMP_IF_NOT, t, 0, 1);
int32_t label = janetc_emit_si(c, invert ? JOP_JUMP_IF : JOP_JUMP_IF_NOT, t, 0, 1);
janet_v_push(labels, label);
}
}
int32_t end = janet_v_count(c->buffer);
if (invert) {
janetc_emit_si(c, JOP_JUMP_IF, t, 3, 0);
janetc_emit_s(c, JOP_LOAD_TRUE, t, 1);
janetc_emit(c, JOP_JUMP | (2 << 8));
janetc_emit_s(c, JOP_LOAD_FALSE, t, 1);
}
for (i = 0; i < janet_v_count(labels); i++) {
int32_t label = labels[i];
c->buffer[label] |= ((end - label) << 16);
@@ -273,22 +335,22 @@ static JanetSlot compreduce(
}
static JanetSlot do_gt(JanetFopts opts, JanetSlot *args) {
return compreduce(opts, args, JOP_GREATER_THAN, 0);
return compreduce(opts, args, JOP_GREATER_THAN, JOP_GREATER_THAN_IMMEDIATE, 0);
}
static JanetSlot do_lt(JanetFopts opts, JanetSlot *args) {
return compreduce(opts, args, JOP_LESS_THAN, 0);
return compreduce(opts, args, JOP_LESS_THAN, JOP_LESS_THAN_IMMEDIATE, 0);
}
static JanetSlot do_gte(JanetFopts opts, JanetSlot *args) {
return compreduce(opts, args, JOP_GREATER_THAN_EQUAL, 0);
return compreduce(opts, args, JOP_GREATER_THAN_EQUAL, 0, 0);
}
static JanetSlot do_lte(JanetFopts opts, JanetSlot *args) {
return compreduce(opts, args, JOP_LESS_THAN_EQUAL, 0);
return compreduce(opts, args, JOP_LESS_THAN_EQUAL, 0, 0);
}
static JanetSlot do_eq(JanetFopts opts, JanetSlot *args) {
return compreduce(opts, args, JOP_EQUALS, 0);
return compreduce(opts, args, JOP_EQUALS, JOP_EQUALS_IMMEDIATE, 0);
}
static JanetSlot do_neq(JanetFopts opts, JanetSlot *args) {
return compreduce(opts, args, JOP_EQUALS, 1);
return compreduce(opts, args, JOP_NOT_EQUALS, JOP_NOT_EQUALS_IMMEDIATE, 1);
}
/* Arranged by tag */
@@ -319,10 +381,12 @@ static const JanetFunOptimizer optimizers[] = {
{NULL, do_eq},
{NULL, do_neq},
{fixarity2, do_propagate},
{fixarity2, do_get},
{arity2or3, do_get},
{arity1or2, do_next},
{fixarity2, do_modulo},
{fixarity2, do_remainder},
{fixarity2, do_cmp},
{fixarity2, do_cancel},
};
const JanetFunOptimizer *janetc_funopt(uint32_t flags) {

View File

@@ -698,7 +698,32 @@ JanetSlot janetc_value(JanetFopts opts, Janet x) {
return ret;
}
/* Add function flags to janet functions */
void janet_def_addflags(JanetFuncDef *def) {
int32_t set_flags = 0;
int32_t unset_flags = 0;
/* pos checks */
if (def->name) set_flags |= JANET_FUNCDEF_FLAG_HASNAME;
if (def->source) set_flags |= JANET_FUNCDEF_FLAG_HASSOURCE;
if (def->defs) set_flags |= JANET_FUNCDEF_FLAG_HASDEFS;
if (def->environments) set_flags |= JANET_FUNCDEF_FLAG_HASENVS;
if (def->sourcemap) set_flags |= JANET_FUNCDEF_FLAG_HASSOURCEMAP;
if (def->closure_bitset) set_flags |= JANET_FUNCDEF_FLAG_HASCLOBITSET;
/* negative checks */
if (!def->name) unset_flags |= JANET_FUNCDEF_FLAG_HASNAME;
if (!def->source) unset_flags |= JANET_FUNCDEF_FLAG_HASSOURCE;
if (!def->defs) unset_flags |= JANET_FUNCDEF_FLAG_HASDEFS;
if (!def->environments) unset_flags |= JANET_FUNCDEF_FLAG_HASENVS;
if (!def->sourcemap) unset_flags |= JANET_FUNCDEF_FLAG_HASSOURCEMAP;
if (!def->closure_bitset) unset_flags |= JANET_FUNCDEF_FLAG_HASCLOBITSET;
/* Update flags */
def->flags |= set_flags;
def->flags &= ~unset_flags;
}
/* Compile a funcdef */
/* Once the various other settings of the FuncDef have been tweaked,
* call janet_def_addflags to set the proper flags for the funcdef */
JanetFuncDef *janetc_pop_funcdef(JanetCompiler *c) {
JanetScope *scope = c->scope;
JanetFuncDef *def = janet_funcdef_alloc();
@@ -761,7 +786,6 @@ JanetFuncDef *janetc_pop_funcdef(JanetCompiler *c) {
/* Register allocator preallocates some registers [240-255, high 16 bits of chunk index 7], we can ignore those. */
if (scope->ua.count > 7) chunks[7] &= 0xFFFFU;
def->closure_bitset = chunks;
def->flags |= JANET_FUNCDEF_FLAG_HASCLOBITSET;
}
/* Pop the scope */
@@ -818,6 +842,7 @@ JanetCompileResult janet_compile(Janet source, JanetTable *env, const uint8_t *w
if (c.result.status == JANET_COMPILE_OK) {
JanetFuncDef *def = janetc_pop_funcdef(&c);
def->name = janet_cstring("_thunk");
janet_def_addflags(def);
c.result.funcdef = def;
} else {
c.result.error_mapping = c.current_mapping;

View File

@@ -60,6 +60,8 @@
#define JANET_FUN_NEXT 28
#define JANET_FUN_MODULO 29
#define JANET_FUN_REMAINDER 30
#define JANET_FUN_CMP 31
#define JANET_FUN_CANCEL 32
/* Compiler typedefs */
typedef struct JanetCompiler JanetCompiler;

View File

@@ -63,10 +63,29 @@ typedef void *Clib;
#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 = 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) {
Clib lib = load_clib(name);
char *processed_name = get_processed_name(name);
Clib lib = load_clib(processed_name);
JanetModule init;
JanetModconf getter;
if (name != processed_name) free(processed_name);
if (!lib) {
*error = janet_cstring(error_clib());
return NULL;
@@ -404,9 +423,11 @@ static Janet janet_core_gcsetinterval(int32_t argc, Janet *argv) {
janet_fixarity(argc, 1);
size_t s = janet_getsize(argv, 0);
/* limit interval to 48 bits */
if (s > 0xFFFFFFFFFFFFUl) {
#ifdef JANET_64
if (s >> 48) {
janet_panic("interval too large");
}
#endif
janet_vm_gc_interval = s;
return janet_wrap_nil();
}
@@ -739,6 +760,7 @@ static void janet_quick_asm(
JANET_OUT_OF_MEMORY;
}
memcpy(def->bytecode, bytecode, bytecode_size);
janet_def_addflags(def);
janet_def(env, name, janet_wrap_function(janet_thunk(def)), doc);
}
@@ -924,6 +946,10 @@ static const uint32_t resume_asm[] = {
JOP_RESUME | (1 << 24),
JOP_RETURN
};
static const uint32_t cancel_asm[] = {
JOP_CANCEL | (1 << 24),
JOP_RETURN
};
static const uint32_t in_asm[] = {
JOP_IN | (1 << 24),
JOP_LOAD_NIL | (3 << 8),
@@ -968,6 +994,10 @@ static const uint32_t remainder_asm[] = {
JOP_REMAINDER | (1 << 24),
JOP_RETURN
};
static const uint32_t cmp_asm[] = {
JOP_COMPARE | (1 << 24),
JOP_RETURN
};
#endif /* ifdef JANET_BOOTSTRAP */
/*
@@ -1004,6 +1034,9 @@ static void janet_load_libs(JanetTable *env) {
#ifdef JANET_THREADS
janet_lib_thread(env);
#endif
#ifdef JANET_EV
janet_lib_ev(env);
#endif
#ifdef JANET_NET
janet_lib_net(env);
#endif
@@ -1021,6 +1054,11 @@ JanetTable *janet_core_env(JanetTable *replacements) {
"%", 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"
"Returns -1 if x is strictly less than y, 1 if y is strictly greater "
"than x, and 0 otherwise. To return 0, x and y must be the exact same type."));
janet_quick_asm(env, JANET_FUN_NEXT,
"next", 2, 1, 2, 2, next_asm, sizeof(next_asm),
JDOC("(next ds &opt key)\n\n"
@@ -1052,6 +1090,11 @@ JanetTable *janet_core_env(JanetTable *replacements) {
"Yield a value to a parent fiber. When a fiber yields, its execution is paused until "
"another thread resumes it. The fiber will then resume, and the last yield call will "
"return the value that was passed to resume."));
janet_quick_asm(env, JANET_FUN_CANCEL,
"cancel", 2, 2, 2, 2, cancel_asm, sizeof(cancel_asm),
JDOC("(cancel fiber err)\n\n"
"Resume a fiber but have it immediately raise an error. This lets a programmer unwind a pending fiber. "
"Returns the same result as resume."));
janet_quick_asm(env, JANET_FUN_RESUME,
"resume", 2, 1, 2, 2, resume_asm, sizeof(resume_asm),
JDOC("(resume fiber &opt x)\n\n"
@@ -1178,7 +1221,7 @@ JanetTable *janet_core_env(JanetTable *replacements) {
}
/* Load core cfunctions (and some built in janet assembly functions) */
JanetTable *dict = janet_table(300);
JanetTable *dict = janet_table(512);
janet_load_libs(dict);
/* Add replacements */

View File

@@ -37,7 +37,7 @@ int32_t janetc_allocfar(JanetCompiler *c) {
return reg;
}
/* Get a register less than 256 */
/* Get a register less than 256 for temporary use. */
int32_t janetc_allocnear(JanetCompiler *c, JanetcRegisterTemp tag) {
return janetc_regalloc_temp(&c->scope->ra, tag);
}
@@ -205,7 +205,7 @@ static int32_t janetc_regnear(JanetCompiler *c, JanetSlot s, JanetcRegisterTemp
}
/* Check if two slots are equal */
static int janetc_sequal(JanetSlot lhs, JanetSlot rhs) {
int janetc_sequal(JanetSlot lhs, JanetSlot rhs) {
if ((lhs.flags & ~JANET_SLOTTYPE_ANY) == (rhs.flags & ~JANET_SLOTTYPE_ANY) &&
lhs.index == rhs.index &&
lhs.envindex == rhs.envindex) {
@@ -245,8 +245,8 @@ void janetc_copy(
janetc_moveback(c, dest, nearreg);
/* Cleanup */
janetc_regalloc_freetemp(&c->scope->ra, nearreg, JANETC_REGTEMP_3);
}
/* Instruction templated emitters */
static int32_t emit1s(JanetCompiler *c, uint8_t op, JanetSlot s, int32_t rest, int wr) {

View File

@@ -42,6 +42,9 @@ int32_t janetc_emit_ssi(JanetCompiler *c, uint8_t op, JanetSlot s1, JanetSlot s2
int32_t janetc_emit_ssu(JanetCompiler *c, uint8_t op, JanetSlot s1, JanetSlot s2, uint8_t immediate, int wr);
int32_t janetc_emit_sss(JanetCompiler *c, uint8_t op, JanetSlot s1, JanetSlot s2, JanetSlot s3, int wr);
/* Check if two slots are equivalent */
int janetc_sequal(JanetSlot x, JanetSlot y);
/* Move value from one slot to another. Cannot copy to constant slots. */
void janetc_copy(JanetCompiler *c, JanetSlot dest, JanetSlot src);

1843
src/core/ev.c Normal file

File diff suppressed because it is too large Load Diff

View File

@@ -25,8 +25,15 @@
#ifndef JANET_FEATURES_H_defined
#define JANET_FEATURES_H_defined
#ifndef _POSIX_C_SOURCE
#define _POSIX_C_SOURCE 200809L
#if defined(__NetBSD__) || defined(__APPLE__) || defined(__OpenBSD__) \
|| defined(__bsdi__) || defined(__DragonFly__)
/* Use BSD soucre on any BSD systems, include OSX */
# define _BSD_SOURCE
#else
/* Use POSIX feature flags */
# ifndef _POSIX_C_SOURCE
# define _POSIX_C_SOURCE 200809L
# endif
#endif
#if defined(WIN32) || defined(_WIN32)
@@ -38,4 +45,11 @@
#define _XOPEN_SOURCE 500
#endif
/* Needed for timegm and other extensions when building with -std=c99.
* It also defines realpath, etc, which would normally require
* _XOPEN_SOURCE >= 500. */
#if !defined(_NETBSD_SOURCE) && defined(__NetBSD__)
#define _NETBSD_SOURCE
#endif
#endif

View File

@@ -37,6 +37,10 @@ static void fiber_reset(JanetFiber *fiber) {
fiber->child = NULL;
fiber->flags = JANET_FIBER_MASK_YIELD | JANET_FIBER_RESUME_NO_USEVAL | JANET_FIBER_RESUME_NO_SKIP;
fiber->env = NULL;
#ifdef JANET_EV
fiber->waiting = NULL;
fiber->sched_id = 0;
#endif
janet_fiber_set_status(fiber, JANET_STATUS_NEW);
}
@@ -77,6 +81,7 @@ JanetFiber *janet_fiber_reset(JanetFiber *fiber, JanetFunction *callee, int32_t
}
if (janet_fiber_funcframe(fiber, callee)) return NULL;
janet_fiber_frame(fiber)->flags |= JANET_STACKFRAME_ENTRANCE;
fiber->waiting = NULL;
return fiber;
}
@@ -85,14 +90,33 @@ JanetFiber *janet_fiber(JanetFunction *callee, int32_t capacity, int32_t argc, c
return janet_fiber_reset(fiber_alloc(capacity), callee, argc, argv);
}
#ifdef JANET_DEBUG
/* Test for memory issues by reallocating fiber every time we push a stack frame */
static void janet_fiber_refresh_memory(JanetFiber *fiber) {
int32_t n = fiber->capacity;
if (n) {
Janet *newData = malloc(sizeof(Janet) * n);
if (NULL == newData) {
JANET_OUT_OF_MEMORY;
}
memcpy(newData, fiber->data, fiber->capacity * sizeof(Janet));
free(fiber->data);
fiber->data = newData;
}
}
#endif
/* Ensure that the fiber has enough extra capacity */
void janet_fiber_setcapacity(JanetFiber *fiber, int32_t n) {
int32_t old_size = fiber->capacity;
int32_t diff = n - old_size;
Janet *newData = realloc(fiber->data, sizeof(Janet) * n);
if (NULL == newData) {
JANET_OUT_OF_MEMORY;
}
fiber->data = newData;
fiber->capacity = n;
janet_vm_next_collection += sizeof(Janet) * diff;
}
/* Grow fiber if needed */
@@ -173,6 +197,10 @@ int janet_fiber_funcframe(JanetFiber *fiber, JanetFunction *func) {
if (fiber->capacity < nextstacktop) {
janet_fiber_setcapacity(fiber, 2 * nextstacktop);
#ifdef JANET_DEBUG
} else {
janet_fiber_refresh_memory(fiber);
#endif
}
/* Nil unset stack arguments (Needed for gc correctness) */
@@ -305,6 +333,10 @@ int janet_fiber_funcframe_tail(JanetFiber *fiber, JanetFunction *func) {
if (fiber->capacity < nextstacktop) {
janet_fiber_setcapacity(fiber, 2 * nextstacktop);
#ifdef JANET_DEBUG
} else {
janet_fiber_refresh_memory(fiber);
#endif
}
Janet *stack = fiber->data + fiber->frame;
@@ -367,6 +399,10 @@ void janet_fiber_cframe(JanetFiber *fiber, JanetCFunction cfun) {
if (fiber->capacity < nextstacktop) {
janet_fiber_setcapacity(fiber, 2 * nextstacktop);
#ifdef JANET_DEBUG
} else {
janet_fiber_refresh_memory(fiber);
#endif
}
/* Set the next frame */

View File

@@ -46,7 +46,9 @@
#define JANET_FIBER_MASK_USERN(N) (16 << (N))
#define JANET_FIBER_MASK_USER 0x3FF0
#define JANET_FIBER_STATUS_MASK 0xFF0000
#define JANET_FIBER_STATUS_MASK 0x3F0000
#define JANET_FIBER_FLAG_SCHEDULED 0x800000
#define JANET_FIBER_RESUME_SIGNAL 0x400000
#define JANET_FIBER_STATUS_OFFSET 16
#define JANET_FIBER_BREAKPOINT 0x1000000
@@ -76,4 +78,8 @@ void janet_fiber_popframe(JanetFiber *fiber);
void janet_env_maybe_detach(JanetFuncEnv *env);
int janet_env_valid(JanetFuncEnv *env);
#ifdef JANET_EV
void janet_fiber_did_resume(JanetFiber *fiber);
#endif
#endif

View File

@@ -28,6 +28,7 @@
#include "gc.h"
#include "util.h"
#include "fiber.h"
#include "vector.h"
#endif
struct JanetScratch {
@@ -39,6 +40,7 @@ struct JanetScratch {
JANET_THREAD_LOCAL void *janet_vm_blocks;
JANET_THREAD_LOCAL size_t janet_vm_gc_interval;
JANET_THREAD_LOCAL size_t janet_vm_next_collection;
JANET_THREAD_LOCAL size_t janet_vm_block_count;
JANET_THREAD_LOCAL int janet_vm_gc_suspend = 0;
/* Roots */
@@ -327,6 +329,7 @@ void janet_sweep() {
previous = current;
current->flags &= ~JANET_MEM_REACHABLE;
} else {
janet_vm_block_count--;
janet_deinit_block(current);
if (NULL != previous) {
previous->next = next;
@@ -359,6 +362,7 @@ void *janet_gcalloc(enum JanetMemoryType type, size_t size) {
janet_vm_next_collection += size;
mem->next = janet_vm_blocks;
janet_vm_blocks = mem;
janet_vm_block_count++;
return (void *)mem;
}
@@ -388,10 +392,19 @@ 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.
* 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
* heuristic for automatically changing the gc interval */
if (janet_vm_block_count * 8 > janet_vm_gc_interval) {
janet_vm_gc_interval = janet_vm_block_count * sizeof(JanetGCObject);
}
orig_rootcount = janet_vm_root_count;
#ifdef JANET_NET
janet_net_markloop();
#ifdef JANET_EV
janet_ev_mark();
#endif
janet_mark_fiber(janet_vm_root_fiber);
for (i = 0; i < orig_rootcount; i++)
janet_mark(janet_vm_roots[i]);
while (orig_rootcount < janet_vm_root_count) {

View File

@@ -20,18 +20,18 @@
* IN THE SOFTWARE.
*/
#include <errno.h>
#include <stdlib.h>
#include <limits.h>
#include <inttypes.h>
#include <math.h>
#ifndef JANET_AMALG
#include "features.h"
#include <janet.h>
#include "util.h"
#endif
#include <errno.h>
#include <stdlib.h>
#include <limits.h>
#include <inttypes.h>
#include <math.h>
/* Conditional compilation */
#ifdef JANET_INT_TYPES

View File

@@ -37,22 +37,27 @@
static int cfun_io_gc(void *p, size_t len);
static int io_file_get(void *p, Janet key, Janet *out);
static void io_file_marshal(void *p, JanetMarshalContext *ctx);
static void *io_file_unmarshal(JanetMarshalContext *ctx);
const JanetAbstractType janet_file_type = {
"core/file",
cfun_io_gc,
NULL,
io_file_get,
JANET_ATEND_GET
NULL,
io_file_marshal,
io_file_unmarshal,
JANET_ATEND_UNMARSHAL
};
/* Check arguments to fopen */
static int checkflags(const uint8_t *str) {
int flags = 0;
static int32_t checkflags(const uint8_t *str) {
int32_t flags = 0;
int32_t i;
int32_t len = janet_string_length(str);
if (!len || len > 3)
janet_panic("file mode must have a length between 1 and 3");
if (!len || len > 10)
janet_panic("file mode must have a length between 1 and 10");
switch (*str) {
default:
janet_panicf("invalid flag %c, expected w, a, or r", *str);
@@ -70,7 +75,7 @@ static int checkflags(const uint8_t *str) {
for (i = 1; i < len; i++) {
switch (str[i]) {
default:
janet_panicf("invalid flag %c, expected + or b", str[i]);
janet_panicf("invalid flag %c, expected +, b, or n", str[i]);
break;
case '+':
if (flags & JANET_FILE_UPDATE) return -1;
@@ -80,12 +85,16 @@ static int checkflags(const uint8_t *str) {
if (flags & JANET_FILE_BINARY) return -1;
flags |= JANET_FILE_BINARY;
break;
case 'n':
if (flags & JANET_FILE_NONIL) return -1;
flags |= JANET_FILE_NONIL;
break;
}
}
return flags;
}
static Janet makef(FILE *f, int flags) {
static void *makef(FILE *f, int32_t flags) {
JanetFile *iof = (JanetFile *) janet_abstract(&janet_file_type, sizeof(JanetFile));
iof->file = f;
iof->flags = flags;
@@ -95,7 +104,7 @@ static Janet makef(FILE *f, int flags) {
if (!(flags & JANET_FILE_NOT_CLOSEABLE))
fcntl(fileno(f), F_SETFD, FD_CLOEXEC);
#endif
return janet_wrap_abstract(iof);
return iof;
}
/* Open a process */
@@ -104,14 +113,14 @@ static Janet cfun_io_popen(int32_t argc, Janet *argv) {
janet_arity(argc, 1, 2);
const uint8_t *fname = janet_getstring(argv, 0);
const uint8_t *fmode = NULL;
int flags;
int32_t flags;
if (argc == 2) {
fmode = janet_getkeyword(argv, 1);
if (janet_string_length(fmode) != 1 ||
!(fmode[0] == 'r' || fmode[0] == 'w')) {
janet_panicf("invalid file mode :%S, expected :r or :w", fmode);
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);
}
flags = JANET_FILE_PIPED | (fmode[0] == 'r' ? JANET_FILE_READ : JANET_FILE_WRITE);
fmode = (const uint8_t *)((fmode[0] == 'r') ? "r" : "w");
} else {
fmode = (const uint8_t *)"r";
flags = JANET_FILE_PIPED | JANET_FILE_READ;
@@ -121,9 +130,11 @@ static Janet cfun_io_popen(int32_t argc, Janet *argv) {
#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 makef(f, flags);
return janet_makefile(f, flags);
}
#endif
@@ -141,7 +152,7 @@ static Janet cfun_io_fopen(int32_t argc, Janet *argv) {
janet_arity(argc, 1, 2);
const uint8_t *fname = janet_getstring(argv, 0);
const uint8_t *fmode;
int flags;
int32_t flags;
if (argc == 2) {
fmode = janet_getkeyword(argv, 1);
flags = checkflags(fmode);
@@ -150,7 +161,9 @@ static Janet cfun_io_fopen(int32_t argc, Janet *argv) {
flags = JANET_FILE_READ;
}
FILE *f = fopen((const char *)fname, (const char *)fmode);
return f ? makef(f, flags) : janet_wrap_nil();
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();
}
/* Read up to n bytes into buffer. */
@@ -277,6 +290,8 @@ static Janet cfun_io_fclose(int32_t argc, Janet *argv) {
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)) {
@@ -284,8 +299,8 @@ static Janet cfun_io_fclose(int32_t argc, Janet *argv) {
janet_panic("could not close file");
}
iof->flags |= JANET_FILE_CLOSED;
return janet_wrap_nil();
}
return janet_wrap_nil();
}
/* Seek a file */
@@ -331,6 +346,50 @@ static int io_file_get(void *p, Janet key, Janet *out) {
return janet_getmethod(janet_unwrap_keyword(key), io_file_methods, out);
}
static void io_file_marshal(void *p, JanetMarshalContext *ctx) {
JanetFile *iof = (JanetFile *)p;
if (ctx->flags & JANET_MARSHAL_UNSAFE) {
janet_marshal_abstract(ctx, p);
#ifdef JANET_WINDOWS
janet_marshal_int(ctx, _fileno(iof->file));
#else
janet_marshal_int(ctx, fileno(iof->file));
#endif
janet_marshal_int(ctx, iof->flags);
} else {
janet_panic("cannot marshal file in safe mode");
}
}
static void *io_file_unmarshal(JanetMarshalContext *ctx) {
if (ctx->flags & JANET_MARSHAL_UNSAFE) {
JanetFile *iof = janet_unmarshal_abstract(ctx, sizeof(JanetFile));
int32_t fd = janet_unmarshal_int(ctx);
int32_t flags = janet_unmarshal_int(ctx);
char fmt[4] = {0};
int index = 0;
if (flags & JANET_FILE_READ) fmt[index++] = 'r';
if (flags & JANET_FILE_APPEND) {
fmt[index++] = 'a';
} else if (flags & JANET_FILE_WRITE) {
fmt[index++] = 'w';
}
#ifdef JANET_WINDOWS
iof->file = _fdopen(fd, fmt);
#else
iof->file = fdopen(fd, fmt);
#endif
if (iof->file == NULL) {
iof->flags = JANET_FILE_CLOSED;
} else {
iof->flags = flags;
}
return iof;
} else {
janet_panic("cannot unmarshal file in safe mode");
}
}
FILE *janet_dynfile(const char *name, FILE *def) {
Janet x = janet_dyn(name);
if (!janet_checktype(x, JANET_ABSTRACT)) return def;
@@ -340,18 +399,16 @@ FILE *janet_dynfile(const char *name, FILE *def) {
return iofile->file;
}
static Janet cfun_io_print_impl(int32_t argc, Janet *argv,
int newline, const char *name, FILE *dflt_file) {
static Janet cfun_io_print_impl_x(int32_t argc, Janet *argv, int newline,
FILE *dflt_file, int32_t offset, Janet x) {
FILE *f;
Janet x = janet_dyn(name);
switch (janet_type(x)) {
default:
/* Other values simply do nothing */
return janet_wrap_nil();
janet_panicf("cannot print to %v", x);
case JANET_BUFFER: {
/* Special case buffer */
JanetBuffer *buf = janet_unwrap_buffer(x);
for (int32_t i = 0; i < argc; ++i) {
for (int32_t i = offset; i < argc; ++i) {
janet_to_string_b(buf, argv[i]);
}
if (newline)
@@ -360,6 +417,7 @@ static Janet cfun_io_print_impl(int32_t argc, Janet *argv,
}
case JANET_NIL:
f = dflt_file;
if (f == NULL) janet_panic("cannot print to nil");
break;
case JANET_ABSTRACT: {
void *abstract = janet_unwrap_abstract(x);
@@ -370,7 +428,7 @@ static Janet cfun_io_print_impl(int32_t argc, Janet *argv,
break;
}
}
for (int32_t i = 0; i < argc; ++i) {
for (int32_t i = offset; i < argc; ++i) {
int32_t len;
const uint8_t *vstr;
if (janet_checktype(argv[i], JANET_BUFFER)) {
@@ -383,7 +441,11 @@ static Janet cfun_io_print_impl(int32_t argc, Janet *argv,
}
if (len) {
if (1 != fwrite(vstr, len, 1, f)) {
janet_panicf("could not print %d bytes to (dyn :%s)", len, name);
if (f == dflt_file) {
janet_panicf("cannot print %d bytes", len);
} else {
janet_panicf("cannot print %d bytes to %v", len, x);
}
}
}
}
@@ -392,6 +454,13 @@ static Janet cfun_io_print_impl(int32_t argc, Janet *argv,
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);
return cfun_io_print_impl_x(argc, argv, newline, dflt_file, 0, x);
}
static Janet cfun_io_print(int32_t argc, Janet *argv) {
return cfun_io_print_impl(argc, argv, 1, "out", stdout);
}
@@ -408,25 +477,33 @@ static Janet cfun_io_eprin(int32_t argc, Janet *argv) {
return cfun_io_print_impl(argc, argv, 0, "err", stderr);
}
static Janet cfun_io_printf_impl(int32_t argc, Janet *argv, int newline,
const char *name, FILE *dflt_file) {
FILE *f;
static Janet cfun_io_xprint(int32_t argc, Janet *argv) {
janet_arity(argc, 1, -1);
const char *fmt = janet_getcstring(argv, 0);
Janet x = janet_dyn(name);
return cfun_io_print_impl_x(argc, argv, 1, NULL, 1, argv[0]);
}
static Janet cfun_io_xprin(int32_t argc, Janet *argv) {
janet_arity(argc, 1, -1);
return cfun_io_print_impl_x(argc, argv, 0, NULL, 1, argv[0]);
}
static Janet cfun_io_printf_impl_x(int32_t argc, Janet *argv, int newline,
FILE *dflt_file, int32_t offset, Janet x) {
FILE *f;
const char *fmt = janet_getcstring(argv, offset);
switch (janet_type(x)) {
default:
/* Other values simply do nothing */
return janet_wrap_nil();
janet_panicf("cannot print to %v", x);
case JANET_BUFFER: {
/* Special case buffer */
JanetBuffer *buf = janet_unwrap_buffer(x);
janet_buffer_format(buf, fmt, 0, argc, argv);
janet_buffer_format(buf, fmt, offset, argc, argv);
if (newline) janet_buffer_push_u8(buf, '\n');
return janet_wrap_nil();
}
case JANET_NIL:
f = dflt_file;
if (f == NULL) janet_panic("cannot print to nil");
break;
case JANET_ABSTRACT: {
void *abstract = janet_unwrap_abstract(x);
@@ -438,11 +515,11 @@ static Janet cfun_io_printf_impl(int32_t argc, Janet *argv, int newline,
}
}
JanetBuffer *buf = janet_buffer(10);
janet_buffer_format(buf, fmt, 0, argc, argv);
janet_buffer_format(buf, fmt, offset, argc, argv);
if (newline) janet_buffer_push_u8(buf, '\n');
if (buf->count) {
if (1 != fwrite(buf->data, buf->count, 1, f)) {
janet_panicf("could not print %d bytes to file", buf->count, name);
janet_panicf("could not print %d bytes to file", buf->count);
}
}
/* Clear buffer to make things easier for GC */
@@ -453,6 +530,14 @@ static Janet cfun_io_printf_impl(int32_t argc, Janet *argv, int newline,
return janet_wrap_nil();
}
static Janet cfun_io_printf_impl(int32_t argc, Janet *argv, int newline,
const char *name, FILE *dflt_file) {
janet_arity(argc, 1, -1);
Janet x = janet_dyn(name);
return cfun_io_printf_impl_x(argc, argv, newline, dflt_file, 0, x);
}
static Janet cfun_io_printf(int32_t argc, Janet *argv) {
return cfun_io_printf_impl(argc, argv, 1, "out", stdout);
}
@@ -469,6 +554,16 @@ static Janet cfun_io_eprinf(int32_t argc, Janet *argv) {
return cfun_io_printf_impl(argc, argv, 0, "err", stderr);
}
static Janet cfun_io_xprintf(int32_t argc, Janet *argv) {
janet_arity(argc, 2, -1);
return cfun_io_printf_impl_x(argc, argv, 1, NULL, 1, argv[0]);
}
static Janet cfun_io_xprinf(int32_t argc, Janet *argv) {
janet_arity(argc, 2, -1);
return cfun_io_printf_impl_x(argc, argv, 0, NULL, 1, argv[0]);
}
static void janet_flusher(const char *name, FILE *dflt_file) {
Janet x = janet_dyn(name);
switch (janet_type(x)) {
@@ -582,6 +677,29 @@ static const JanetReg io_cfuns[] = {
JDOC("(eprinf fmt & xs)\n\n"
"Like eprintf but with no trailing newline.")
},
{
"xprint", cfun_io_xprint,
JDOC("(xprint to & xs)\n\n"
"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.")
},
{
"xprin", cfun_io_xprin,
JDOC("(xprin to & xs)\n\n"
"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.")
},
{
"xprintf", cfun_io_xprintf,
JDOC("(xprint to fmt & xs)\n\n"
"Like printf but prints to an explicit file or value to. Returns nil.")
},
{
"xprinf", cfun_io_xprinf,
JDOC("(xprin to fmt & xs)\n\n"
"Like prinf but prints to an explicit file or value to. Returns nil.")
},
{
"flush", cfun_io_flush,
JDOC("(flush)\n\n"
@@ -610,7 +728,8 @@ static const JanetReg io_cfuns[] = {
"\tw - allow writing to the file\n"
"\ta - append to the file\n"
"\tb - open the file in binary mode (rather than text mode)\n"
"\t+ - append to the file instead of overwriting it")
"\t+ - append to the file instead of overwriting it\n"
"\tn - error if the file cannot be opened instead of returning nil")
},
{
"file/close", cfun_io_fclose,
@@ -658,7 +777,7 @@ static const JanetReg io_cfuns[] = {
#ifndef JANET_NO_PROCESSES
{
"file/popen", cfun_io_popen,
JDOC("(file/popen path &opt mode)\n\n"
JDOC("(file/popen command &opt mode)\n\n"
"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 "
@@ -670,16 +789,24 @@ static const JanetReg io_cfuns[] = {
/* C API */
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) {
JanetFile *iof = janet_getabstract(argv, n, &janet_file_type);
if (NULL != flags) *flags = iof->flags;
return iof->file;
}
Janet janet_makefile(FILE *f, int flags) {
JanetFile *janet_makejfile(FILE *f, int flags) {
return makef(f, flags);
}
Janet janet_makefile(FILE *f, int flags) {
return janet_wrap_abstract(makef(f, flags));
}
JanetAbstract janet_checkfile(Janet j) {
return janet_checkabstract(j, &janet_file_type);
}
@@ -693,18 +820,19 @@ FILE *janet_unwrapfile(Janet j, int *flags) {
/* Module entry point */
void janet_lib_io(JanetTable *env) {
janet_core_cfuns(env, NULL, io_cfuns);
janet_register_abstract_type(&janet_file_type);
int default_flags = JANET_FILE_NOT_CLOSEABLE | JANET_FILE_SERIALIZABLE;
/* stdout */
janet_core_def(env, "stdout",
makef(stdout, JANET_FILE_APPEND | JANET_FILE_NOT_CLOSEABLE | JANET_FILE_SERIALIZABLE),
janet_makefile(stdout, JANET_FILE_APPEND | default_flags),
JDOC("The standard output file."));
/* stderr */
janet_core_def(env, "stderr",
makef(stderr, JANET_FILE_APPEND | JANET_FILE_NOT_CLOSEABLE | JANET_FILE_SERIALIZABLE),
janet_makefile(stderr, JANET_FILE_APPEND | default_flags),
JDOC("The standard error file."));
/* stdin */
janet_core_def(env, "stdin",
makef(stdin, JANET_FILE_READ | JANET_FILE_NOT_CLOSEABLE | JANET_FILE_SERIALIZABLE),
janet_makefile(stdin, JANET_FILE_READ | default_flags),
JDOC("The standard input file."));
}

View File

@@ -214,15 +214,6 @@ static void marshal_one_env(MarshalState *st, JanetFuncEnv *env, int flags) {
}
}
/* Add function flags to janet functions */
static void janet_func_addflags(JanetFuncDef *def) {
if (def->name) def->flags |= JANET_FUNCDEF_FLAG_HASNAME;
if (def->source) def->flags |= JANET_FUNCDEF_FLAG_HASSOURCE;
if (def->defs) def->flags |= JANET_FUNCDEF_FLAG_HASDEFS;
if (def->environments) def->flags |= JANET_FUNCDEF_FLAG_HASENVS;
if (def->sourcemap) def->flags |= JANET_FUNCDEF_FLAG_HASSOURCEMAP;
}
/* Marshal a sequence of u32s */
static void janet_marshal_u32s(MarshalState *st, const uint32_t *u32s, int32_t n) {
for (int32_t i = 0; i < n; i++) {
@@ -243,7 +234,6 @@ static void marshal_one_def(MarshalState *st, JanetFuncDef *def, int flags) {
return;
}
}
janet_func_addflags(def);
/* Add to lookup */
janet_v_push(st->seen_defs, def);
pushint(st, def->flags);
@@ -295,8 +285,8 @@ static void marshal_one_def(MarshalState *st, JanetFuncDef *def, int flags) {
}
#define JANET_FIBER_FLAG_HASCHILD (1 << 29)
#define JANET_FIBER_FLAG_HASENV (1 << 28)
#define JANET_STACKFRAME_HASENV (1 << 30)
#define JANET_FIBER_FLAG_HASENV (1 << 30)
#define JANET_STACKFRAME_HASENV (1 << 31)
/* Marshal a fiber */
static void marshal_one_fiber(MarshalState *st, JanetFiber *fiber, int flags) {
@@ -900,7 +890,7 @@ static const uint8_t *unmarshal_one_def(
for (int32_t i = 0; i < bytecode_length; i++) {
current += readint(st, &data);
def->sourcemap[i].line = current;
def->sourcemap[i].column = readnat(st, &data);
def->sourcemap[i].column = readint(st, &data);
}
} else {
def->sourcemap = NULL;
@@ -908,11 +898,12 @@ static const uint8_t *unmarshal_one_def(
/* Unmarshal closure bitset if needed */
if (def->flags & JANET_FUNCDEF_FLAG_HASCLOBITSET) {
def->closure_bitset = malloc(sizeof(uint32_t) * def->slotcount);
int32_t n = (def->slotcount + 31) >> 5;
def->closure_bitset = malloc(sizeof(uint32_t) * (size_t) n);
if (NULL == def->closure_bitset) {
JANET_OUT_OF_MEMORY;
}
data = janet_unmarshal_u32s(st, data, def->closure_bitset, (def->slotcount + 31) >> 5);
data = janet_unmarshal_u32s(st, data, def->closure_bitset, n);
}
/* Validate */
@@ -943,6 +934,10 @@ static const uint8_t *unmarshal_one_fiber(
fiber->data = NULL;
fiber->child = NULL;
fiber->env = NULL;
#ifdef JANET_EV
fiber->waiting = NULL;
fiber->sched_id = 0;
#endif
/* Push fiber to seen stack */
janet_v_push(st->lookup, janet_wrap_fiber(fiber));
@@ -1057,6 +1052,11 @@ static const uint8_t *unmarshal_one_fiber(
fiber->maxstack = fiber_maxstack;
fiber->env = fiber_env;
int status = janet_fiber_status(fiber);
if (status < 0 || status > JANET_STATUS_ALIVE) {
janet_panic("invalid fiber status");
}
/* Return data */
*out = fiber;
return data;

View File

@@ -499,5 +499,19 @@ void janet_lib_math(JanetTable *env) {
JDOC("The number representing positive infinity"));
janet_def(env, "math/-inf", janet_wrap_number(-INFINITY),
JDOC("The number representing negative infinity"));
janet_def(env, "math/int32-min", janet_wrap_number(INT32_MIN),
JDOC("The maximum contiguous integer representable by a 32 bit signed integer"));
janet_def(env, "math/int32-max", janet_wrap_number(INT32_MAX),
JDOC("The minimum contiguous integer represtenable by a 32 bit signed integer"));
janet_def(env, "math/int-min", janet_wrap_number(JANET_INTMIN_DOUBLE),
JDOC("The maximum contiguous integer representable by a double (2^53)"));
janet_def(env, "math/int-max", janet_wrap_number(JANET_INTMAX_DOUBLE),
JDOC("The minimum contiguous integer represtenable by a double (-(2^53))"));
#ifdef NAN
janet_def(env, "math/nan", janet_wrap_number(NAN),
#else
janet_def(env, "math/nan", janet_wrap_number(0.0 / 0.0),
#endif
JDOC("Not a number (IEEE-754 NaN)"));
#endif
}

File diff suppressed because it is too large Load Diff

View File

@@ -24,6 +24,7 @@
#include "features.h"
#include <janet.h>
#include "util.h"
#include "gc.h"
#endif
#ifndef JANET_REDUCED_OS
@@ -36,8 +37,11 @@
#include <stdio.h>
#include <string.h>
#include <sys/stat.h>
#include <signal.h>
#define RETRY_EINTR(RC, CALL) do { (RC) = CALL; } while((RC) < 0 && errno == EINTR)
#ifdef JANET_APPLE
#include <AvailabilityMacros.h>
#endif
#ifdef JANET_WINDOWS
#include <windows.h>
@@ -64,12 +68,6 @@ extern char **environ;
#include <mach/mach.h>
#endif
/* Setting C99 standard makes this not available, but it should
* work/link properly if we detect a BSD */
#if defined(JANET_BSD) || defined(JANET_APPLE)
void arc4random_buf(void *buf, size_t nbytes);
#endif
/* Not POSIX, but all Unixes but Solaris have this function. */
#if defined(JANET_POSIX) && !defined(__sun)
time_t timegm(struct tm *tm);
@@ -159,6 +157,8 @@ static Janet os_arch(int32_t argc, Janet *argv) {
return janet_ckeywordv("arm");
#elif (defined(__sparc__))
return janet_ckeywordv("sparc");
#elif (defined(__ppc__))
return janet_ckeywordv("ppc");
#else
return janet_ckeywordv("unknown");
#endif
@@ -221,7 +221,8 @@ static char **os_execute_env(int32_t argc, const Janet *argv) {
return envp;
}
/* Free memory from os_execute */
/* Free memory from os_execute. Not actually needed, but doesn't pressure the GC
in the happy path. */
static void os_execute_cleanup(char **envp, const char **child_argv) {
#ifdef JANET_WINDOWS
(void) child_argv;
@@ -314,16 +315,216 @@ static JanetBuffer *os_exec_escape(JanetView args) {
}
#endif
static Janet os_execute(int32_t argc, Janet *argv) {
/* Process type for when running a subprocess and not immediately waiting */
static const JanetAbstractType ProcAT;
#define JANET_PROC_CLOSED 1
#define JANET_PROC_WAITED 2
typedef struct {
int flags;
#ifdef JANET_WINDOWS
HANDLE pHandle;
HANDLE tHandle;
#else
int pid;
#endif
int return_code;
JanetFile *in;
JanetFile *out;
JanetFile *err;
} JanetProc;
static int janet_proc_gc(void *p, size_t s) {
(void) s;
JanetProc *proc = (JanetProc *) p;
#ifdef JANET_WINDOWS
if (!(proc->flags & JANET_PROC_CLOSED)) {
CloseHandle(proc->pHandle);
CloseHandle(proc->tHandle);
}
#else
if (!(proc->flags & JANET_PROC_WAITED)) {
/* Kill and wait to prevent zombies */
kill(proc->pid, SIGKILL);
int status;
waitpid(proc->pid, &status, 0);
}
#endif
return 0;
}
static int janet_proc_mark(void *p, size_t s) {
(void) s;
JanetProc *proc = (JanetProc *)p;
if (NULL != proc->in) janet_mark(janet_wrap_abstract(proc->in));
if (NULL != proc->out) janet_mark(janet_wrap_abstract(proc->out));
if (NULL != proc->err) janet_mark(janet_wrap_abstract(proc->err));
return 0;
}
static Janet os_proc_wait_impl(JanetProc *proc) {
if (proc->flags & JANET_PROC_WAITED) {
janet_panicf("cannot wait on process that has already finished");
}
proc->flags |= JANET_PROC_WAITED;
int status = 0;
#ifdef JANET_WINDOWS
WaitForSingleObject(proc->pHandle, INFINITE);
GetExitCodeProcess(proc->pHandle, &status);
if (!(proc->flags & JANET_PROC_CLOSED)) {
proc->flags |= JANET_PROC_CLOSED;
CloseHandle(proc->pHandle);
CloseHandle(proc->tHandle);
}
#else
waitpid(proc->pid, &status, 0);
#endif
proc->return_code = (int32_t) status;
return janet_wrap_integer(proc->return_code);
}
static Janet os_proc_wait(int32_t argc, Janet *argv) {
janet_fixarity(argc, 1);
JanetProc *proc = janet_getabstract(argv, 0, &ProcAT);
return os_proc_wait_impl(proc);
}
static Janet os_proc_kill(int32_t argc, Janet *argv) {
janet_arity(argc, 1, 2);
JanetProc *proc = janet_getabstract(argv, 0, &ProcAT);
if (proc->flags & JANET_PROC_WAITED) {
janet_panicf("cannot kill process that has already finished");
}
#ifdef JANET_WINDOWS
if (proc->flags & JANET_PROC_CLOSED) {
janet_panicf("cannot close process handle that is already closed");
}
proc->flags |= JANET_PROC_CLOSED;
CloseHandle(proc->pHandle);
CloseHandle(proc->tHandle);
#else
int status = kill(proc->pid, SIGKILL);
if (status) {
janet_panic(strerror(errno));
}
#endif
/* After killing process we wait on it. */
if (argc > 1 && janet_truthy(argv[1])) {
return os_proc_wait_impl(proc);
} else {
return argv[0];
}
}
static void swap_handles(JanetHandle *handles) {
JanetHandle temp = handles[0];
handles[0] = handles[1];
handles[1] = temp;
}
static void close_handle(JanetHandle handle) {
#ifdef JANET_WINDOWS
CloseHandle(handle);
#else
close(handle);
#endif
}
/* Create piped file for os/execute and os/spawn. Need to be careful that we mark
the error flag if we can't create pipe and don't leak handles. *handle will be cleaned
up by the calling function. If everything goes well, *handle is owned by the calling function,
(if it is set) and the returned JanetFile owns the other end of the pipe, which will be closed
on GC or fclose. */
static JanetFile *make_pipes(JanetHandle *handle, int reverse, int *errflag) {
JanetHandle handles[2];
#ifdef JANET_WINDOWS
SECURITY_ATTRIBUTES saAttr;
memset(&saAttr, 0, sizeof(saAttr));
saAttr.nLength = sizeof(saAttr);
saAttr.bInheritHandle = TRUE;
if (!CreatePipe(handles, handles + 1, &saAttr, 0)) goto error_pipe;
if (reverse) swap_handles(handles);
/* Don't inherit the side of the pipe owned by this process */
if (!SetHandleInformation(handles[0], HANDLE_FLAG_INHERIT, 0)) goto error_set_handle_info;
*handle = handles[1];
int fd = _open_osfhandle((intptr_t) handles[0], reverse ? _O_WRONLY : _O_RDONLY);
if (fd == -1) goto error_open_osfhandle;
FILE *f = _fdopen(fd, reverse ? "w" : "r");
if (NULL == f) goto error_fdopen;
return janet_makejfile(f, reverse ? JANET_FILE_WRITE : JANET_FILE_READ);
error_fdopen:
_close(fd); /* we need to close the fake file descriptor instead of the handle, as ownership has been transfered. */
*errflag = 1;
return NULL;
error_set_handle_info:
error_open_osfhandle:
close_handle(handles[0]);
/* fallthrough */
error_pipe:
*errflag = 1;
return NULL;
#else
if (pipe(handles)) goto error_pipe;
if (reverse) swap_handles(handles);
*handle = handles[1];
FILE *f = fdopen(handles[0], reverse ? "w" : "r");
if (NULL == f) goto error_fdopen;
return janet_makejfile(f, reverse ? JANET_FILE_WRITE : JANET_FILE_READ);
error_fdopen:
close_handle(handles[0]);
/* fallthrough */
error_pipe:
*errflag = 1;
return NULL;
#endif
}
static const JanetMethod proc_methods[] = {
{"wait", os_proc_wait},
{"kill", os_proc_kill},
{NULL, NULL}
};
static int janet_proc_get(void *p, Janet key, Janet *out) {
JanetProc *proc = (JanetProc *)p;
if (janet_keyeq(key, "in")) {
*out = (NULL == proc->in) ? janet_wrap_nil() : janet_wrap_abstract(proc->in);
return 1;
}
if (janet_keyeq(key, "out")) {
*out = (NULL == proc->out) ? janet_wrap_nil() : janet_wrap_abstract(proc->out);
return 1;
}
if (janet_keyeq(key, "err")) {
*out = (NULL == proc->out) ? janet_wrap_nil() : janet_wrap_abstract(proc->err);
return 1;
}
if ((-1 != proc->return_code) && janet_keyeq(key, "return-code")) {
*out = janet_wrap_integer(proc->return_code);
return 1;
}
if (!janet_checktype(key, JANET_KEYWORD)) return 0;
return janet_getmethod(janet_unwrap_keyword(key), proc_methods, out);
}
static const JanetAbstractType ProcAT = {
"core/process",
janet_proc_gc,
janet_proc_mark,
janet_proc_get,
JANET_ATEND_GET
};
static Janet os_execute_impl(int32_t argc, Janet *argv, int is_async) {
janet_arity(argc, 1, 3);
/* Get flags */
uint64_t flags = 0;
if (argc > 1) {
flags = janet_getflags(argv, 1, "ep");
flags = janet_getflags(argv, 1, "epx");
}
/* Get environment */
int use_environ = !janet_flag_at(flags, 0);
char **envp = os_execute_env(argc, argv);
/* Get arguments */
@@ -332,43 +533,132 @@ static Janet os_execute(int32_t argc, Janet *argv) {
janet_panic("expected at least 1 command line argument");
}
/* Optional stdio redirections */
JanetFile *new_in = NULL, *new_out = NULL, *new_err = NULL;
JanetHandle pipe_in = JANET_HANDLE_NONE, pipe_out = JANET_HANDLE_NONE, pipe_err = JANET_HANDLE_NONE;
int pipe_errflag = 0; /* Track errors setting up pipes */
/* Get optional redirections */
if (argc > 2) {
JanetDictView tab = janet_getdictionary(argv, 2);
Janet maybe_stdin = janet_dictionary_get(tab.kvs, tab.cap, janet_ckeywordv("in"));
Janet maybe_stdout = janet_dictionary_get(tab.kvs, tab.cap, janet_ckeywordv("out"));
Janet maybe_stderr = janet_dictionary_get(tab.kvs, tab.cap, janet_ckeywordv("err"));
if (janet_keyeq(maybe_stdin, "pipe")) {
new_in = make_pipes(&pipe_in, 1, &pipe_errflag);
} else if (!janet_checktype(maybe_stdin, JANET_NIL)) {
new_in = janet_getjfile(&maybe_stdin, 0);
}
if (janet_keyeq(maybe_stdout, "pipe")) {
new_out = make_pipes(&pipe_out, 0, &pipe_errflag);
} else if (!janet_checktype(maybe_stdout, JANET_NIL)) {
new_out = janet_getjfile(&maybe_stdout, 0);
}
if (janet_keyeq(maybe_stderr, "err")) {
new_err = make_pipes(&pipe_err, 0, &pipe_errflag);
} else if (!janet_checktype(maybe_stderr, JANET_NIL)) {
new_err = janet_getjfile(&maybe_stderr, 0);
}
}
/* Clean up if any of the pipes have any issues */
if (pipe_errflag) {
if (pipe_in != JANET_HANDLE_NONE) close_handle(pipe_in);
if (pipe_out != JANET_HANDLE_NONE) close_handle(pipe_out);
if (pipe_err != JANET_HANDLE_NONE) close_handle(pipe_err);
janet_panic("failed to create pipes");
}
/* Result */
int status = 0;
#ifdef JANET_WINDOWS
HANDLE pHandle, tHandle;
SECURITY_ATTRIBUTES saAttr;
PROCESS_INFORMATION processInfo;
STARTUPINFO startupInfo;
memset(&saAttr, 0, sizeof(saAttr));
memset(&processInfo, 0, sizeof(processInfo));
memset(&startupInfo, 0, sizeof(startupInfo));
startupInfo.cb = sizeof(startupInfo);
startupInfo.dwFlags |= STARTF_USESTDHANDLES;
saAttr.nLength = sizeof(saAttr);
saAttr.bInheritHandle = TRUE;
JanetBuffer *buf = os_exec_escape(exargs);
if (buf->count > 8191) {
janet_panic("command line string too long (max 8191 characters)");
}
const char *path = (const char *) janet_unwrap_string(exargs.items[0]);
char *cargv[2] = {(char *) buf->data, NULL};
/* Do IO redirection */
if (pipe_in != JANET_HANDLE_NONE) {
startupInfo.hStdInput = pipe_in;
} else if (new_in != NULL) {
startupInfo.hStdInput = (HANDLE) _get_osfhandle(_fileno(new_in->file));
} else {
startupInfo.hStdInput = (HANDLE) _get_osfhandle(0);
}
if (pipe_out != JANET_HANDLE_NONE) {
startupInfo.hStdOutput = pipe_out;
} else if (new_out != NULL) {
startupInfo.hStdOutput = (HANDLE) _get_osfhandle(_fileno(new_out->file));
} else {
startupInfo.hStdOutput = (HANDLE) _get_osfhandle(1);
}
if (pipe_err != JANET_HANDLE_NONE) {
startupInfo.hStdError = pipe_err;
} else if (new_err != NULL) {
startupInfo.hStdError = (HANDLE) _get_osfhandle(_fileno(new_err->file));
} else {
startupInfo.hStdError = (HANDLE) _get_osfhandle(2);
}
/* Use _spawn family of functions. */
/* Windows docs say do this before any spawns. */
_flushall();
/* Use an empty env instead when envp is NULL to be consistent with other implementation. */
char *empty_env[1] = {NULL};
char **envp1 = (NULL == envp) ? empty_env : envp;
if (janet_flag_at(flags, 1) && janet_flag_at(flags, 0)) {
status = (int) _spawnvpe(_P_WAIT, path, cargv, envp1);
} else if (janet_flag_at(flags, 1)) {
status = (int) _spawnvp(_P_WAIT, path, cargv);
} else if (janet_flag_at(flags, 0)) {
status = (int) _spawnve(_P_WAIT, path, cargv, envp1);
} else {
status = (int) _spawnv(_P_WAIT, path, cargv);
int cp_failed = 0;
if (!CreateProcess(janet_flag_at(flags, 1) ? NULL : path,
(char *) buf->data, /* Single CLI argument */
&saAttr, /* no proc inheritance */
&saAttr, /* no thread inheritance */
TRUE, /* handle inheritance */
0, /* flags */
use_environ ? NULL : envp, /* pass in environment */
NULL, /* use parents starting directory */
&startupInfo,
&processInfo)) {
cp_failed = 1;
}
if (pipe_in != JANET_HANDLE_NONE) CloseHandle(pipe_in);
if (pipe_out != JANET_HANDLE_NONE) CloseHandle(pipe_out);
if (pipe_err != JANET_HANDLE_NONE) CloseHandle(pipe_err);
os_execute_cleanup(envp, NULL);
/* Check error */
if (-1 == status) {
janet_panicf("%p: %s", argv[0], strerror(errno));
if (cp_failed) {
janet_panic("failed to create process");
}
return janet_wrap_integer(status);
pHandle = processInfo.hProcess;
tHandle = processInfo.hThread;
/* Wait and cleanup immedaitely */
if (!is_async) {
DWORD code;
WaitForSingleObject(pHandle, INFINITE);
GetExitCodeProcess(pHandle, &code);
status = (int) code;
CloseHandle(pHandle);
CloseHandle(tHandle);
}
#else
const char **child_argv = janet_smalloc(sizeof(char *) * ((size_t) exargs.len + 1));
@@ -381,23 +671,46 @@ static Janet os_execute(int32_t argc, Janet *argv) {
/* Use posix_spawn to spawn new process */
int use_environ = !janet_flag_at(flags, 0);
if (use_environ) {
janet_lock_environ();
}
/* Posix spawn setup */
posix_spawn_file_actions_t actions;
posix_spawn_file_actions_init(&actions);
if (pipe_in != JANET_HANDLE_NONE) {
posix_spawn_file_actions_adddup2(&actions, pipe_in, 0);
} else if (new_in != NULL) {
posix_spawn_file_actions_adddup2(&actions, fileno(new_in->file), 0);
}
if (pipe_out != JANET_HANDLE_NONE) {
posix_spawn_file_actions_adddup2(&actions, pipe_out, 1);
} else if (new_out != NULL) {
posix_spawn_file_actions_adddup2(&actions, fileno(new_out->file), 1);
}
if (pipe_err != JANET_HANDLE_NONE) {
posix_spawn_file_actions_adddup2(&actions, pipe_err, 2);
} else if (new_err != NULL) {
posix_spawn_file_actions_adddup2(&actions, fileno(new_err->file), 2);
}
pid_t pid;
if (janet_flag_at(flags, 1)) {
status = posix_spawnp(&pid,
child_argv[0], NULL, NULL, cargv,
child_argv[0], &actions, NULL, cargv,
use_environ ? environ : envp);
} else {
status = posix_spawn(&pid,
child_argv[0], NULL, NULL, cargv,
child_argv[0], &actions, NULL, cargv,
use_environ ? environ : envp);
}
posix_spawn_file_actions_destroy(&actions);
if (pipe_in != JANET_HANDLE_NONE) close(pipe_in);
if (pipe_out != JANET_HANDLE_NONE) close(pipe_out);
if (pipe_err != JANET_HANDLE_NONE) close(pipe_err);
if (use_environ) {
janet_unlock_environ();
}
@@ -406,22 +719,51 @@ static Janet os_execute(int32_t argc, Janet *argv) {
if (status) {
os_execute_cleanup(envp, child_argv);
janet_panicf("%p: %s", argv[0], strerror(errno));
} else if (is_async) {
/* Get process handle */
os_execute_cleanup(envp, child_argv);
} else {
/* Wait to complete */
waitpid(pid, &status, 0);
os_execute_cleanup(envp, child_argv);
/* Use POSIX shell semantics for interpreting signals */
if (WIFEXITED(status)) {
status = WEXITSTATUS(status);
} else if (WIFSTOPPED(status)) {
status = WSTOPSIG(status) + 128;
} else {
status = WTERMSIG(status) + 128;
}
}
os_execute_cleanup(envp, child_argv);
/* Use POSIX shell semantics for interpreting signals */
int ret;
if (WIFEXITED(status)) {
ret = WEXITSTATUS(status);
} else if (WIFSTOPPED(status)) {
ret = WSTOPSIG(status) + 128;
} else {
ret = WTERMSIG(status) + 128;
}
return janet_wrap_integer(ret);
#endif
if (is_async) {
JanetProc *proc = janet_abstract(&ProcAT, sizeof(JanetProc));
proc->return_code = -1;
#ifdef JANET_WINDOWS
proc->pHandle = pHandle;
proc->tHandle = tHandle;
#else
proc->pid = pid;
#endif
proc->in = new_in;
proc->out = new_out;
proc->err = new_err;
proc->flags = 0;
return janet_wrap_abstract(proc);
} else if (janet_flag_at(flags, 2) && status) {
janet_panicf("command failed with non-zero exit code %d", status);
} else {
return janet_wrap_integer(status);
}
}
static Janet os_execute(int32_t argc, Janet *argv) {
return os_execute_impl(argc, argv, 0);
}
static Janet os_spawn(int32_t argc, Janet *argv) {
return os_execute_impl(argc, argv, 1);
}
static Janet os_shell(int32_t argc, Janet *argv) {
@@ -508,39 +850,11 @@ static Janet os_time(int32_t argc, Janet *argv) {
return janet_wrap_number(dtime);
}
/* Clock shims */
#ifdef JANET_WINDOWS
static int 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;
return 0;
}
#elif defined(__MACH__)
static int 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;
return 0;
}
#else
#define gettime(TV) clock_gettime(CLOCK_MONOTONIC, (TV))
#endif
static Janet os_clock(int32_t argc, Janet *argv) {
janet_fixarity(argc, 0);
(void) argv;
struct timespec tv;
if (gettime(&tv)) janet_panic("could not get time");
if (janet_gettime(&tv)) janet_panic("could not get time");
double dtime = tv.tv_sec + (tv.tv_nsec / 1E9);
return janet_wrap_number(dtime);
}
@@ -579,7 +893,6 @@ static Janet os_cwd(int32_t argc, Janet *argv) {
static Janet os_cryptorand(int32_t argc, Janet *argv) {
JanetBuffer *buffer;
const char *genericerr = "unable to get sufficient random data";
janet_arity(argc, 1, 2);
int32_t offset;
int32_t n = janet_getinteger(argv, 0);
@@ -594,43 +907,9 @@ static Janet os_cryptorand(int32_t argc, Janet *argv) {
/* We could optimize here by adding setcount_uninit */
janet_buffer_setcount(buffer, offset + n);
#ifdef JANET_WINDOWS
for (int32_t i = offset; i < buffer->count; i += sizeof(unsigned int)) {
unsigned int v;
if (rand_s(&v))
janet_panic(genericerr);
for (int32_t j = 0; (j < sizeof(unsigned int)) && (i + j < buffer->count); j++) {
buffer->data[i + j] = v & 0xff;
v = v >> 8;
}
}
#elif defined(JANET_LINUX)
/* We should be able to call getrandom on linux, but it doesn't seem
to be uniformly supported on linux distros.
In both cases, use this fallback path for now... */
int rc;
int randfd;
RETRY_EINTR(randfd, open("/dev/urandom", O_RDONLY | O_CLOEXEC));
if (randfd < 0)
janet_panic(genericerr);
while (n > 0) {
ssize_t nread;
RETRY_EINTR(nread, read(randfd, buffer->data + offset, n));
if (nread <= 0) {
RETRY_EINTR(rc, close(randfd));
janet_panic(genericerr);
}
offset += nread;
n -= nread;
}
RETRY_EINTR(rc, close(randfd));
#elif defined(JANET_BSD) || defined(JANET_APPLE)
(void) genericerr;
arc4random_buf(buffer->data + offset, n);
#else
(void) genericerr;
janet_panic("cryptorand currently unsupported on this platform");
#endif
if (janet_cryptorand(buffer->data + offset, n) != 0)
janet_panic("unable to get sufficient random data");
return janet_wrap_buffer(buffer);
}
@@ -1399,15 +1678,41 @@ static const JanetReg os_cfuns[] = {
"\t:e - enables passing an environment to the program. Without :e, the "
"current environment is inherited.\n"
"\t:p - allows searching the current PATH for the binary to execute. "
"Without this flag, binaries must use absolute paths.\n\n"
"env is a table or struct mapping environment variables to values. "
"Without this flag, binaries must use absolute paths.\n"
"\t:x - raise error if exit code is non-zero.\n"
"env is a table or struct mapping environment variables to values. It can also "
"contain the keys :in, :out, and :err, which allow redirecting stdio in the subprocess. "
"These arguments should be core/file values. "
"One can also pass in the :pipe keyword "
"for these arguments to create files that will read (for :err and :out) or write (for :in) "
"to the file descriptor of the subprocess. This is only useful in os/spawn, which takes "
"the same parameters as os/execute, but will return an object that contains references to these "
"files via (return-value :in), (return-value :out), and (return-value :err). "
"Returns the exit status of the program.")
},
{
"os/spawn", os_spawn,
JDOC("(os/spawn args &opts flags env)\n\n"
"Execute a program on the system and return a handle to the process. Otherwise, the "
"same arguments as os/execute. Does not wait for the process.")
},
{
"os/shell", os_shell,
JDOC("(os/shell str)\n\n"
"Pass a command string str directly to the system shell.")
},
{
"os/proc-wait", os_proc_wait,
JDOC("(os/proc-wait proc)\n\n"
"Block until the subprocess completes. Returns the subprocess return code.")
},
{
"os/proc-kill", os_proc_kill,
JDOC("(os/proc-kill proc &opt wait)\n\n"
"Kill a subprocess by sending SIGKILL to it on posix systems, or by closing the process "
"handle on windows. If wait is truthy, will wait for the process to finsih and "
"returns the exit code. Otherwise, returns proc.")
},
#endif
{
"os/setenv", os_setenv,
@@ -1438,8 +1743,8 @@ static const JanetReg os_cfuns[] = {
},
{
"os/sleep", os_sleep,
JDOC("(os/sleep nsec)\n\n"
"Suspend the program for nsec seconds. 'nsec' can be a real number. Returns "
JDOC("(os/sleep n)\n\n"
"Suspend the program for n seconds. 'nsec' can be a real number. Returns "
"nil.")
},
{

View File

@@ -87,6 +87,12 @@ static void pushcap(PegState *s, Janet capture, uint32_t tag) {
}
}
/* Convert a uint64_t to a int64_t by wrapping to a maximum number of bytes */
static int64_t peg_convert_u64_s64(uint64_t from, int width) {
int shift = 8 * (8 - width);
return ((int64_t)(from << shift)) >> shift;
}
/* Prevent stack overflow */
#define down1(s) do { \
if (0 == --((s)->depth)) janet_panic("peg/match recursed too deeply"); \
@@ -469,6 +475,47 @@ tail:
return next_text;
}
case RULE_READINT: {
uint32_t tag = rule[2];
uint32_t signedness = rule[1] & 0x10;
uint32_t endianess = rule[1] & 0x20;
int width = (int)(rule[1] & 0xF);
if (text + width > s->text_end) return NULL;
uint64_t accum = 0;
if (endianess) {
/* BE */
for (int i = 0; i < width; i++) accum = (accum << 8) | text[i];
} else {
/* LE */
for (int i = width - 1; i >= 0; i--) accum = (accum << 8) | text[i];
}
Janet capture_value;
/* We can only parse integeres of greater than 6 bytes reliable if int-types are enabled.
* Otherwise, we may lose precision, so 6 is the maximum size when int-types are disabled. */
#ifdef JANET_INT_TYPES
if (width > 6) {
if (signedness) {
capture_value = janet_wrap_s64(peg_convert_u64_s64(accum, width));
} else {
capture_value = janet_wrap_u64(accum);
}
} else
#endif
{
double double_value;
if (signedness) {
double_value = (double)(peg_convert_u64_s64(accum, width));
} else {
double_value = (double)accum;
}
capture_value = janet_wrap_number(double_value);
}
pushcap(s, capture_value, tag);
return text + width;
}
}
}
@@ -876,6 +923,36 @@ static void spec_matchtime(Builder *b, int32_t argc, const Janet *argv) {
emit_3(r, RULE_MATCHTIME, subrule, cindex, tag);
}
#ifdef JANET_INT_TYPES
#define JANET_MAX_READINT_WIDTH 8
#else
#define JANET_MAX_READINT_WIDTH 6
#endif
static void spec_readint(Builder *b, int32_t argc, const Janet *argv, uint32_t mask) {
peg_arity(b, argc, 1, 2);
Reserve r = reserve(b, 3);
uint32_t tag = (argc == 2) ? emit_tag(b, argv[3]) : 0;
int32_t width = peg_getnat(b, argv[0]);
if ((width < 0) || (width > JANET_MAX_READINT_WIDTH)) {
peg_panicf(b, "width must be between 0 and %d, got %d", JANET_MAX_READINT_WIDTH, width);
}
emit_2(r, RULE_READINT, mask | ((uint32_t) width), tag);
}
static void spec_uint_le(Builder *b, int32_t argc, const Janet *argv) {
spec_readint(b, argc, argv, 0x0u);
}
static void spec_int_le(Builder *b, int32_t argc, const Janet *argv) {
spec_readint(b, argc, argv, 0x10u);
}
static void spec_uint_be(Builder *b, int32_t argc, const Janet *argv) {
spec_readint(b, argc, argv, 0x20u);
}
static void spec_int_be(Builder *b, int32_t argc, const Janet *argv) {
spec_readint(b, argc, argv, 0x30u);
}
/* Special compiler form */
typedef void (*Special)(Builder *b, int32_t argc, const Janet *argv);
typedef struct {
@@ -912,6 +989,8 @@ static const SpecialPair peg_specials[] = {
{"group", spec_group},
{"if", spec_if},
{"if-not", spec_ifnot},
{"int", spec_int_le},
{"int-be", spec_int_be},
{"lenprefix", spec_lenprefix},
{"look", spec_look},
{"not", spec_not},
@@ -926,6 +1005,8 @@ static const SpecialPair peg_specials[] = {
{"some", spec_some},
{"thru", spec_thru},
{"to", spec_to},
{"uint", spec_uint_le},
{"uint-be", spec_uint_be},
};
/* Compile a janet value into a rule and return the rule index. */
@@ -1226,6 +1307,11 @@ static void *peg_unmarshal(JanetMarshalContext *ctx) {
op_flags[rule[1]] |= 0x01;
i += 2;
break;
case RULE_READINT:
/* [ width | (endianess << 5) | (signedness << 6), tag ] */
if (rule[1] > JANET_MAX_READINT_WIDTH) goto bad;
i += 3;
break;
default:
goto bad;
}
@@ -1308,47 +1394,136 @@ static Janet cfun_peg_compile(int32_t argc, Janet *argv) {
return janet_wrap_abstract(peg);
}
static Janet cfun_peg_match(int32_t argc, Janet *argv) {
janet_arity(argc, 2, -1);
/* Common data for peg cfunctions */
typedef struct {
JanetPeg *peg;
PegState s;
JanetByteView bytes;
JanetByteView repl;
int32_t start;
} PegCall;
/* Initialize state for peg cfunctions */
static PegCall peg_cfun_init(int32_t argc, Janet *argv, int get_replace) {
PegCall ret;
int32_t min = get_replace ? 3 : 2;
janet_arity(argc, get_replace, -1);
if (janet_checktype(argv[0], JANET_ABSTRACT) &&
janet_abstract_type(janet_unwrap_abstract(argv[0])) == &janet_peg_type) {
peg = janet_unwrap_abstract(argv[0]);
ret.peg = janet_unwrap_abstract(argv[0]);
} else {
peg = compile_peg(argv[0]);
ret.peg = compile_peg(argv[0]);
}
JanetByteView bytes = janet_getbytes(argv, 1);
int32_t start;
PegState s;
if (argc > 2) {
start = janet_gethalfrange(argv, 2, bytes.len, "offset");
s.extrac = argc - 3;
s.extrav = janet_tuple_n(argv + 3, argc - 3);
if (get_replace) {
ret.repl = janet_getbytes(argv, 1);
ret.bytes = janet_getbytes(argv, 2);
} else {
start = 0;
s.extrac = 0;
s.extrav = NULL;
ret.bytes = janet_getbytes(argv, 1);
}
s.mode = PEG_MODE_NORMAL;
s.text_start = bytes.bytes;
s.text_end = bytes.bytes + bytes.len;
s.depth = JANET_RECURSION_GUARD;
s.captures = janet_array(0);
s.scratch = janet_buffer(10);
s.tags = janet_buffer(10);
s.constants = peg->constants;
s.bytecode = peg->bytecode;
const uint8_t *result = peg_rule(&s, s.bytecode, bytes.bytes + start);
return result ? janet_wrap_array(s.captures) : janet_wrap_nil();
if (argc > min) {
ret.start = janet_gethalfrange(argv, min, ret.bytes.len, "offset");
ret.s.extrac = argc - min - 1;
ret.s.extrav = janet_tuple_n(argv + min + 1, argc - min - 1);
} else {
ret.start = 0;
ret.s.extrac = 0;
ret.s.extrav = NULL;
}
ret.s.mode = PEG_MODE_NORMAL;
ret.s.text_start = ret.bytes.bytes;
ret.s.text_end = ret.bytes.bytes + ret.bytes.len;
ret.s.depth = JANET_RECURSION_GUARD;
ret.s.captures = janet_array(0);
ret.s.scratch = janet_buffer(10);
ret.s.tags = janet_buffer(10);
ret.s.constants = ret.peg->constants;
ret.s.bytecode = ret.peg->bytecode;
return ret;
}
static void peg_call_reset(PegCall *c) {
c->s.captures->count = 0;
c->s.scratch->count = 0;
c->s.tags->count = 0;
}
static Janet cfun_peg_match(int32_t argc, Janet *argv) {
PegCall c = peg_cfun_init(argc, argv, 0);
const uint8_t *result = peg_rule(&c.s, c.s.bytecode, c.bytes.bytes + c.start);
return result ? janet_wrap_array(c.s.captures) : janet_wrap_nil();
}
static Janet cfun_peg_find(int32_t argc, Janet *argv) {
PegCall c = peg_cfun_init(argc, argv, 0);
for (int32_t i = c.start; i < c.bytes.len; i++) {
peg_call_reset(&c);
if (peg_rule(&c.s, c.s.bytecode, c.bytes.bytes + i))
return janet_wrap_integer(i);
}
return janet_wrap_nil();
}
static Janet cfun_peg_find_all(int32_t argc, Janet *argv) {
PegCall c = peg_cfun_init(argc, argv, 0);
JanetArray *ret = janet_array(0);
for (int32_t i = c.start; i < c.bytes.len; i++) {
peg_call_reset(&c);
if (peg_rule(&c.s, c.s.bytecode, c.bytes.bytes + i))
janet_array_push(ret, janet_wrap_integer(i));
}
return janet_wrap_array(ret);
}
static Janet cfun_peg_replace_generic(int32_t argc, Janet *argv, int only_one) {
PegCall c = peg_cfun_init(argc, argv, 1);
JanetBuffer *ret = janet_buffer(0);
int32_t trail = 0;
for (int32_t i = c.start; i < c.bytes.len;) {
peg_call_reset(&c);
const uint8_t *result = peg_rule(&c.s, c.s.bytecode, c.bytes.bytes + i);
if (NULL != result) {
if (trail < i) {
janet_buffer_push_bytes(ret, c.bytes.bytes + trail, (i - trail));
trail = i;
}
int32_t nexti = (int32_t)(result - c.bytes.bytes);
janet_buffer_push_bytes(ret, c.repl.bytes, c.repl.len);
trail = nexti;
if (nexti == i) nexti++;
i = nexti;
if (only_one) break;
} else {
i++;
}
}
if (trail < c.bytes.len) {
janet_buffer_push_bytes(ret, c.bytes.bytes + trail, (c.bytes.len - trail));
}
return janet_wrap_buffer(ret);
}
static Janet cfun_peg_replace_all(int32_t argc, Janet *argv) {
return cfun_peg_replace_generic(argc, argv, 0);
}
static Janet cfun_peg_replace(int32_t argc, Janet *argv) {
return cfun_peg_replace_generic(argc, argv, 1);
}
static JanetMethod peg_methods[] = {
{"match", cfun_peg_match},
{"find", cfun_peg_find},
{"find-all", cfun_peg_find_all},
{"replace", cfun_peg_replace},
{"replace-all", cfun_peg_replace_all},
{NULL, NULL}
};
static int cfun_peg_getter(JanetAbstract a, Janet key, Janet *out) {
(void) a;
if (janet_keyeq(key, "match")) {
*out = janet_wrap_cfunction(cfun_peg_match);
return 1;
}
return 0;
if (!janet_checktype(key, JANET_KEYWORD))
return 0;
return janet_getmethod(janet_unwrap_keyword(key), peg_methods, out);
}
static const JanetReg peg_cfuns[] = {
@@ -1364,6 +1539,27 @@ static const JanetReg peg_cfuns[] = {
"Match a Parsing Expression Grammar to a byte string and return an array of captured values. "
"Returns nil if text does not match the language defined by peg. The syntax of PEGs is documented on the Janet website.")
},
{
"peg/find", cfun_peg_find,
JDOC("(peg/find peg text &opt start & args)\n\n"
"Find first index where the peg matches in text. Returns an integer, or nil if not found.")
},
{
"peg/find-all", cfun_peg_find_all,
JDOC("(peg/find-all peg text &opt start & args)\n\n"
"Find all indexes where the peg matches in text. Returns an array of integers.")
},
{
"peg/replace", cfun_peg_replace,
JDOC("(peg/replace peg repl text &opt start & args)\n\n"
"Replace first match of peg in text with repl, returning a new buffer. The peg does not need to make captures to do replacement. "
"If no matches are found, returns the input string in a new buffer.")
},
{
"peg/replace-all", cfun_peg_replace_all,
JDOC("(peg/replace-all peg repl text &opt start & args)\n\n"
"Replace all matches of peg in text with repl, returning a new buffer. The peg does not need to make captures to do replacement.")
},
{NULL, NULL, NULL}
};

View File

@@ -39,11 +39,9 @@
static void number_to_string_b(JanetBuffer *buffer, double x) {
janet_buffer_ensure(buffer, buffer->count + BUFSIZE, 2);
/* Use int32_t range for valid integers because that is the
* range most integer-expecting functions in the C api use. */
const char *fmt = (x == floor(x) &&
x <= ((double) INT32_MAX) &&
x >= ((double) INT32_MIN)) ? "%.0f" : "%g";
x <= JANET_INTMAX_DOUBLE &&
x >= JANET_INTMIN_DOUBLE) ? "%.0f" : "%g";
int count = snprintf((char *) buffer->data + buffer->count, BUFSIZE, fmt, x);
buffer->count += count;
}
@@ -123,9 +121,6 @@ static void string_description_b(JanetBuffer *buffer, const char *title, void *p
#undef POINTSIZE
}
#undef HEX
#undef BUFSIZE
static void janet_escape_string_impl(JanetBuffer *buffer, const uint8_t *str, int32_t len) {
janet_buffer_push_u8(buffer, '"');
for (int32_t i = 0; i < len; ++i) {
@@ -191,7 +186,7 @@ static void janet_escape_buffer_b(JanetBuffer *buffer, JanetBuffer *bx) {
void janet_to_string_b(JanetBuffer *buffer, Janet x) {
switch (janet_type(x)) {
case JANET_NIL:
janet_buffer_push_cstring(buffer, "nil");
janet_buffer_push_cstring(buffer, "");
break;
case JANET_BOOLEAN:
janet_buffer_push_cstring(buffer,
@@ -280,6 +275,9 @@ void janet_description_b(JanetBuffer *buffer, Janet x) {
switch (janet_type(x)) {
default:
break;
case JANET_NIL:
janet_buffer_push_cstring(buffer, "nil");
return;
case JANET_KEYWORD:
janet_buffer_push_u8(buffer, ':');
break;
@@ -354,12 +352,16 @@ static int print_jdn_one(struct pretty *S, Janet x, int depth) {
if (depth == 0) return 1;
switch (janet_type(x)) {
case JANET_NIL:
case JANET_NUMBER:
case JANET_BOOLEAN:
case JANET_BUFFER:
case JANET_STRING:
janet_description_b(S->buffer, x);
break;
case JANET_NUMBER:
janet_buffer_ensure(S->buffer, S->buffer->count + BUFSIZE, 2);
int count = snprintf((char *) S->buffer->data + S->buffer->count, BUFSIZE, "%.17g", janet_unwrap_number(x));
S->buffer->count += count;
break;
case JANET_SYMBOL:
case JANET_KEYWORD:
if (contains_bad_chars(janet_unwrap_keyword(x), janet_type(x) == JANET_SYMBOL)) return 1;
@@ -452,7 +454,7 @@ static const char *janet_pretty_colors[] = {
"\x1B[36m",
"\x1B[36m",
"\x1B[36m",
"\x1B[36m"
"\x1B[36m",
"\x1B[35m",
"\x1B[36m",
"\x1B[36m",
@@ -953,6 +955,9 @@ void janet_buffer_format(
janet_description_b(b, argv[arg]);
break;
}
case 't':
janet_buffer_push_cstring(b, typestr(argv[arg]));
break;
case 'M':
case 'm':
case 'N':
@@ -994,3 +999,6 @@ void janet_buffer_format(
}
}
}
#undef HEX
#undef BUFSIZE

View File

@@ -23,7 +23,6 @@
#ifndef JANET_AMALG
#include "features.h"
#include <janet.h>
#include "state.h"
#endif
/* Run a string */
@@ -56,9 +55,10 @@ int janet_dobytes(JanetTable *env, const uint8_t *bytes, int32_t len, const char
done = 1;
}
} else {
ret = janet_wrap_string(cres.error);
if (cres.macrofiber) {
janet_eprintf("compile error in %s: ", sourcePath);
janet_stacktrace(cres.macrofiber, janet_wrap_string(cres.error));
janet_stacktrace(cres.macrofiber, ret);
} else {
janet_eprintf("compile error in %s: %s\n", sourcePath,
(const char *)cres.error);
@@ -68,25 +68,23 @@ int janet_dobytes(JanetTable *env, const uint8_t *bytes, int32_t len, const char
}
}
if (done) break;
/* Dispatch based on parse state */
switch (janet_parser_status(&parser)) {
case JANET_PARSE_DEAD:
done = 1;
break;
case JANET_PARSE_ERROR:
case JANET_PARSE_ERROR: {
const char *e = janet_parser_error(&parser);
errflags |= 0x04;
janet_eprintf("parse error in %s: %s\n",
sourcePath, janet_parser_error(&parser));
ret = janet_cstringv(e);
janet_eprintf("parse error in %s: %s\n", sourcePath, e);
done = 1;
break;
case JANET_PARSE_PENDING:
if (index == len) {
janet_parser_eof(&parser);
} else {
janet_parser_consume(&parser, bytes[index++]);
}
break;
}
case JANET_PARSE_ROOT:
case JANET_PARSE_PENDING:
if (index >= len) {
janet_parser_eof(&parser);
} else {

View File

@@ -649,6 +649,7 @@ static JanetSlot janetc_while(JanetFopts opts, int32_t argn, const Janet *argv)
/* Compile function */
JanetFuncDef *def = janetc_pop_funcdef(c);
def->name = janet_cstring("_while");
janet_def_addflags(def);
int32_t defindex = janetc_addfuncdef(c, def);
/* And then load the closure and call it. */
int32_t cloreg = janetc_regalloc_temp(&c->scope->ra, JANETC_REGTEMP_0);
@@ -823,6 +824,7 @@ static JanetSlot janetc_fn(JanetFopts opts, int32_t argn, const Janet *argv) {
if (structarg) def->flags |= JANET_FUNCDEF_FLAG_STRUCTARG;
if (selfref) def->name = janet_unwrap_symbol(head);
janet_def_addflags(def);
defindex = janetc_addfuncdef(c, def);
/* Ensure enough slots for vararg function. */

View File

@@ -34,6 +34,9 @@
typedef struct JanetScratch JanetScratch;
/* Top level dynamic bindings */
extern JANET_THREAD_LOCAL JanetTable *janet_vm_top_dyns;
/* Cache the core environment */
extern JANET_THREAD_LOCAL JanetTable *janet_vm_core_env;
@@ -68,6 +71,7 @@ extern JANET_THREAD_LOCAL uint32_t janet_vm_cache_deleted;
extern JANET_THREAD_LOCAL void *janet_vm_blocks;
extern JANET_THREAD_LOCAL size_t janet_vm_gc_interval;
extern JANET_THREAD_LOCAL size_t janet_vm_next_collection;
extern JANET_THREAD_LOCAL size_t janet_vm_block_count;
extern JANET_THREAD_LOCAL int janet_vm_gc_suspend;
/* GC roots */
@@ -97,4 +101,14 @@ void janet_threads_init(void);
void janet_threads_deinit(void);
#endif
#ifdef JANET_NET
void janet_net_init(void);
void janet_net_deinit(void);
#endif
#ifdef JANET_EV
void janet_ev_init(void);
void janet_ev_deinit(void);
#endif
#endif /* JANET_STATE_H_defined */

View File

@@ -62,7 +62,7 @@ int janet_string_compare(const uint8_t *lhs, const uint8_t *rhs) {
int32_t ylen = janet_string_length(rhs);
int32_t len = xlen > ylen ? ylen : xlen;
int res = memcmp(lhs, rhs, len);
if (res) return res;
if (res) return res > 0 ? 1 : -1;
if (xlen == ylen) return 0;
return xlen < ylen ? -1 : 1;
}
@@ -176,6 +176,18 @@ static Janet cfun_string_slice(int32_t argc, Janet *argv) {
return janet_stringv(view.bytes + range.start, range.end - range.start);
}
static Janet cfun_symbol_slice(int32_t argc, Janet *argv) {
JanetByteView view = janet_getbytes(argv, 0);
JanetRange range = janet_getslice(argc, argv);
return janet_symbolv(view.bytes + range.start, range.end - range.start);
}
static Janet cfun_keyword_slice(int32_t argc, Janet *argv) {
JanetByteView view = janet_getbytes(argv, 0);
JanetRange range = janet_getslice(argc, argv);
return janet_keywordv(view.bytes + range.start, range.end - range.start);
}
static Janet cfun_string_repeat(int32_t argc, Janet *argv) {
janet_fixarity(argc, 2);
JanetByteView view = janet_getbytes(argv, 0);
@@ -529,6 +541,16 @@ static const JanetReg string_cfuns[] = {
"from the end of the string. Note that index -1 is synonymous with "
"index (length bytes) to allow a full negative slice range. ")
},
{
"keyword/slice", cfun_keyword_slice,
JDOC("(keyword/slice bytes &opt start end)\n\n"
"Same a string/slice, but returns a keyword.")
},
{
"symbol/slice", cfun_symbol_slice,
JDOC("(symbol/slice bytes &opt start end)\n\n"
"Same a string/slice, but returns a symbol.")
},
{
"string/repeat", cfun_string_repeat,
JDOC("(string/repeat bytes n)\n\n"

View File

@@ -173,7 +173,7 @@ Janet janet_table_rawget(JanetTable *t, Janet key) {
Janet janet_table_remove(JanetTable *t, Janet key) {
JanetKV *bucket = janet_table_find(t, key);
if (NULL != bucket && !janet_checktype(bucket->key, JANET_NIL)) {
Janet ret = bucket->key;
Janet ret = bucket->value;
t->count--;
t->deleted++;
bucket->key = janet_wrap_nil();
@@ -256,7 +256,7 @@ static void janet_table_mergekv(JanetTable *table, const JanetKV *kvs, int32_t c
}
}
/* Merge a table other into another table */
/* Merge a table into another table */
void janet_table_merge_table(JanetTable *table, JanetTable *other) {
janet_table_mergekv(table, other->data, other->capacity);
}

View File

@@ -234,7 +234,7 @@ static void janet_waiter_init(JanetWaiter *waiter, double sec) {
if (waiter->timedwait) {
/* N seconds -> timespec of (now + sec) */
struct timespec now;
clock_gettime(CLOCK_REALTIME, &now);
janet_gettime(&now);
time_t tvsec = (time_t) floor(sec);
long tvnsec = (long) floor(1000000000.0 * (sec - ((double) tvsec)));
tvsec += now.tv_sec;
@@ -375,8 +375,12 @@ int janet_thread_receive(Janet *msg_out, double timeout) {
/* Handle errors */
if (setjmp(buf)) {
/* Cleanup jmp_buf, keep lock */
/* Cleanup jmp_buf, return error.
* Do not ignore bad messages as before. */
janet_vm_jmp_buf = old_buf;
*msg_out = *janet_vm_return_reg;
janet_mailbox_unlock(mailbox);
return 2;
} else {
JanetBuffer *msgbuf = mailbox->messages + mailbox->messageFirst;
mailbox->messageCount--;
@@ -411,7 +415,6 @@ int janet_thread_receive(Janet *msg_out, double timeout) {
return 1;
}
}
}
static int janet_thread_getter(void *p, Janet key, Janet *out);
@@ -499,6 +502,10 @@ static int thread_worker(JanetMailboxPair *pair) {
/* Call function */
Janet argv[1] = { parentv };
fiber = janet_fiber(func, 64, 1, argv);
if (pair->flags & JANET_THREAD_HEAVYWEIGHT) {
fiber->env = janet_table(0);
fiber->env->proto = janet_core_env(NULL);
}
JanetSignal sig = janet_continue(fiber, janet_wrap_nil(), &out);
if (sig != JANET_SIGNAL_OK && sig < JANET_SIGNAL_USER0) {
janet_eprintf("in thread %v: ", janet_wrap_abstract(janet_make_thread(pair->newbox, encode)));
@@ -578,6 +585,14 @@ void janet_threads_deinit(void) {
janet_vm_thread_decode = NULL;
}
JanetThread *janet_thread_current(void) {
if (NULL == janet_vm_thread_current) {
janet_vm_thread_current = janet_make_thread(janet_vm_mailbox, janet_get_core_table("make-image-dict"));
janet_gcroot(janet_wrap_abstract(janet_vm_thread_current));
}
return janet_vm_thread_current;
}
/*
* Cfuns
*/
@@ -585,11 +600,7 @@ void janet_threads_deinit(void) {
static Janet cfun_thread_current(int32_t argc, Janet *argv) {
(void) argv;
janet_fixarity(argc, 0);
if (NULL == janet_vm_thread_current) {
janet_vm_thread_current = janet_make_thread(janet_vm_mailbox, janet_get_core_table("make-image-dict"));
janet_gcroot(janet_wrap_abstract(janet_vm_thread_current));
}
return janet_wrap_abstract(janet_vm_thread_current);
return janet_wrap_abstract(janet_thread_current());
}
static Janet cfun_thread_new(int32_t argc, Janet *argv) {
@@ -660,6 +671,8 @@ static Janet cfun_thread_receive(int32_t argc, Janet *argv) {
break;
case 1:
janet_panicf("timeout after %f seconds", wait);
case 2:
janet_panicf("failed to receive message: %v", out);
}
return out;
}
@@ -671,6 +684,18 @@ static Janet cfun_thread_close(int32_t argc, Janet *argv) {
return janet_wrap_nil();
}
static Janet cfun_thread_exit(int32_t argc, Janet *argv) {
(void) argv;
janet_arity(argc, 0, 1);
#if defined(JANET_WINDOWS)
int32_t flag = janet_optinteger(argv, argc, 0, 0);
ExitThread(flag);
#else
pthread_exit(NULL);
#endif
return janet_wrap_nil();
}
static const JanetMethod janet_thread_methods[] = {
{"send", cfun_thread_send},
{"close", cfun_thread_close},
@@ -703,15 +728,18 @@ static const JanetReg threadlib_cfuns[] = {
},
{
"thread/send", cfun_thread_send,
JDOC("(thread/send thread msg)\n\n"
"Send a message to the thread. This will never block and returns thread immediately. "
JDOC("(thread/send thread msgi &opt timeout)\n\n"
"Send a message to the thread. By default, the timeout is 1 second, but an optional timeout "
"in seconds can be provided. Use math/inf for no timeout. "
"Will throw an error if there is a problem sending the message.")
},
{
"thread/receive", cfun_thread_receive,
JDOC("(thread/receive &opt timeout)\n\n"
"Get a message sent to this thread. If timeout is provided, an error will be thrown after the timeout has elapsed but "
"no messages are received.")
"Get a message sent to this thread. If timeout (in seconds) is provided, an error "
"will be thrown after the timeout has elapsed but "
"no messages are received. The default timeout is 1 second, and math/inf cam be passed to "
"turn off the timeout.")
},
{
"thread/close", cfun_thread_close,
@@ -719,6 +747,12 @@ static const JanetReg threadlib_cfuns[] = {
"Close a thread, unblocking it and ending communication with it. Note that closing "
"a thread is idempotent and does not cancel the thread's operation. Returns nil.")
},
{
"thread/exit", cfun_thread_exit,
JDOC("(thread/exit &opt code)\n\n"
"Exit from the current thread. If no more threads are running, ends the process, but otherwise does "
"not end the current process.")
},
{NULL, NULL, NULL}
};

View File

@@ -376,21 +376,29 @@ static Janet cfun_typed_array_new(int32_t argc, Janet *argv) {
if (argc > 3)
offset = janet_getsize(argv, 3);
if (argc > 4) {
if (!janet_checktype(argv[4], JANET_ABSTRACT)) {
janet_panicf("bad slot #%d, expected ta/view|ta/buffer, got %v",
4, argv[4]);
}
void *p = janet_unwrap_abstract(argv[4]);
if (janet_abstract_type(p) == &janet_ta_view_type) {
JanetTArrayView *view = (JanetTArrayView *)p;
offset = (view->buffer->data - view->as.u8) + offset * ta_type_sizes[view->type];
stride *= view->stride;
buffer = view->buffer;
} else if (janet_abstract_type(p) == &janet_ta_buffer_type) {
buffer = p;
int32_t blen;
const uint8_t *bytes;
if (janet_bytes_view(argv[4], &bytes, &blen)) {
buffer = janet_abstract(&janet_ta_buffer_type, sizeof(JanetTArrayBuffer));
ta_buffer_init(buffer, (size_t) blen);
memcpy(buffer->data, bytes, blen);
} else {
janet_panicf("bad slot #%d, expected ta/view|ta/buffer, got %v",
4, argv[4]);
if (!janet_checktype(argv[4], JANET_ABSTRACT)) {
janet_panicf("bad slot #%d, expected ta/view|ta/buffer, got %v",
4, argv[4]);
}
void *p = janet_unwrap_abstract(argv[4]);
if (janet_abstract_type(p) == &janet_ta_view_type) {
JanetTArrayView *view = (JanetTArrayView *)p;
offset = (view->buffer->data - view->as.u8) + offset * ta_type_sizes[view->type];
stride *= view->stride;
buffer = view->buffer;
} else if (janet_abstract_type(p) == &janet_ta_buffer_type) {
buffer = p;
} else {
janet_panicf("bad slot #%d, expected ta/view|ta/buffer, got %v",
4, argv[4]);
}
}
}
JanetTArrayView *view = janet_tarray_view(type, size, stride, offset, buffer);

View File

@@ -26,6 +26,14 @@
#include "util.h"
#include "state.h"
#include "gc.h"
#ifdef JANET_WINDOWS
#include <windows.h>
#else
#include <unistd.h>
#include <sys/types.h>
#include <sys/stat.h>
#include <fcntl.h>
#endif
#endif
#include <inttypes.h>
@@ -94,7 +102,7 @@ const char *const janet_status_names[16] = {
"alive"
};
#ifdef JANET_NO_PRF
#ifndef JANET_PRF
int32_t janet_string_calchash(const uint8_t *str, int32_t len) {
const uint8_t *end = str + len;
@@ -441,7 +449,8 @@ void janet_cfuns(JanetTable *env, const char *regprefix, const JanetReg *cfuns)
void janet_register_abstract_type(const JanetAbstractType *at) {
Janet sym = janet_csymbolv(at->name);
if (!(janet_checktype(janet_table_get(janet_vm_abstract_registry, sym), JANET_NIL))) {
Janet check = janet_table_get(janet_vm_abstract_registry, sym);
if (!janet_checktype(check, JANET_NIL) && at != janet_unwrap_pointer(check)) {
janet_panicf("cannot register abstract type %s, "
"a type with the same name exists", at->name);
}
@@ -574,8 +583,12 @@ int janet_checksize(Janet x) {
if (!janet_checktype(x, JANET_NUMBER))
return 0;
double dval = janet_unwrap_number(x);
return dval == (double)((size_t) dval) &&
dval <= SIZE_MAX;
if (dval != (double)((size_t) dval)) return 0;
if (SIZE_MAX > JANET_INTMAX_INT64) {
return dval <= JANET_INTMAX_INT64;
} else {
return dval <= SIZE_MAX;
}
}
JanetTable *janet_get_core_table(const char *name) {
@@ -586,3 +599,90 @@ JanetTable *janet_get_core_table(const char *name) {
if (!janet_checktype(out, JANET_TABLE)) return NULL;
return janet_unwrap_table(out);
}
/* Clock shims for various platforms */
#ifdef JANET_GETTIME
/* For macos */
#ifdef __MACH__
#include <mach/clock.h>
#include <mach/mach.h>
#endif
#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;
return 0;
}
#elif defined(__MACH__)
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;
return 0;
}
#else
int janet_gettime(struct timespec *spec) {
return clock_gettime(CLOCK_REALTIME, spec);
}
#endif
#endif
/* Setting C99 standard makes this not available, but it should
* work/link properly if we detect a BSD */
#if defined(JANET_BSD) || defined(MAC_OS_X_VERSION_10_7)
void arc4random_buf(void *buf, size_t nbytes);
#endif
int janet_cryptorand(uint8_t *out, size_t n) {
#ifdef JANET_WINDOWS
for (size_t i = 0; i < n; i += sizeof(unsigned int)) {
unsigned int v;
if (rand_s(&v))
return -1;
for (int32_t j = 0; (j < 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) )
/* 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.
In these cases, use this fallback path for now... */
int rc;
int randfd;
RETRY_EINTR(randfd, open("/dev/urandom", O_RDONLY | O_CLOEXEC));
if (randfd < 0)
return -1;
while (n > 0) {
ssize_t nread;
RETRY_EINTR(nread, read(randfd, out, n));
if (nread <= 0) {
RETRY_EINTR(rc, close(randfd));
return -1;
}
out += nread;
n -= nread;
}
RETRY_EINTR(rc, close(randfd));
return 0;
#elif defined(JANET_BSD) || defined(MAC_OS_X_VERSION_10_7)
arc4random_buf(out, n);
return 0;
#else
(void) n;
(void) out;
return -1;
#endif
}

View File

@@ -31,6 +31,11 @@
#include <stdio.h>
#include <errno.h>
#if !defined(JANET_REDUCED_OS) || !defined(JANET_SINGLE_THREADED)
#include <time.h>
#define JANET_GETTIME
#endif
/* Handle runtime errors */
#ifndef JANET_EXIT
#include <stdio.h>
@@ -71,10 +76,10 @@ int32_t janet_tablen(int32_t n);
void safe_memcpy(void *dest, const void *src, size_t len);
void janet_buffer_push_types(JanetBuffer *buffer, int types);
const JanetKV *janet_dict_find(const JanetKV *buckets, int32_t cap, Janet key);
Janet janet_dict_get(const JanetKV *buckets, int32_t cap, Janet key);
void janet_memempty(JanetKV *mem, int32_t count);
void *janet_memalloc_empty(int32_t count);
JanetTable *janet_get_core_table(const char *name);
void janet_def_addflags(JanetFuncDef *def);
const void *janet_strbinsearch(
const void *tab,
size_t tabcount,
@@ -97,6 +102,13 @@ void janet_core_def(JanetTable *env, const char *name, Janet x, const void *p);
void janet_core_cfuns(JanetTable *env, const char *regprefix, const JanetReg *cfuns);
#endif
/* Clock gettime */
#ifdef JANET_GETTIME
int janet_gettime(struct timespec *spec);
#endif
#define RETRY_EINTR(RC, CALL) do { (RC) = CALL; } while((RC) < 0 && errno == EINTR)
/* Initialize builtin libraries */
void janet_lib_io(JanetTable *env);
void janet_lib_math(JanetTable *env);
@@ -128,8 +140,11 @@ void janet_lib_thread(JanetTable *env);
#endif
#ifdef JANET_NET
void janet_lib_net(JanetTable *env);
void janet_net_deinit(void);
void janet_net_markloop(void);
extern const JanetAbstractType janet_address_type;
#endif
#ifdef JANET_EV
void janet_lib_ev(JanetTable *env);
void janet_ev_mark(void);
#endif
#endif

View File

@@ -271,14 +271,12 @@ int32_t janet_hash(Janet x) {
}
/* fallthrough */
default:
/* TODO - test performance with different hash functions */
if (sizeof(double) == sizeof(void *)) {
/* Assuming 8 byte pointer */
uint64_t i = janet_u64(x);
hash = (int32_t)(i & 0xFFFFFFFF);
/* Get a bit more entropy by shifting the low bits out */
hash >>= 3;
hash ^= (int32_t)(i >> 32);
uint32_t lo = (uint32_t)(i & 0xFFFFFFFF);
uint32_t hi = (uint32_t)(i >> 32);
hash = (int32_t)(hi ^ (lo >> 3));
} else {
/* Assuming 4 byte pointer (or smaller) */
hash = (int32_t)((char *)janet_unwrap_pointer(x) - (char *)0);

View File

@@ -33,6 +33,7 @@
#include <math.h>
/* VM state */
JANET_THREAD_LOCAL JanetTable *janet_vm_top_dyns;
JANET_THREAD_LOCAL JanetTable *janet_vm_core_env;
JANET_THREAD_LOCAL JanetTable *janet_vm_registry;
JANET_THREAD_LOCAL JanetTable *janet_vm_abstract_registry;
@@ -94,6 +95,10 @@ JANET_THREAD_LOCAL jmp_buf *janet_vm_jmp_buf = NULL;
vm_commit(); \
return (sig); \
} while (0)
#define vm_return_no_restore(sig, val) do { \
janet_vm_return_reg[0] = (val); \
return (sig); \
} while (0)
/* Next instruction variations */
#define maybe_collect() do {\
@@ -373,9 +378,9 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in) {
&&label_JOP_GREATER_THAN_EQUAL,
&&label_JOP_LESS_THAN_EQUAL,
&&label_JOP_NEXT,
&&label_unknown_op,
&&label_unknown_op,
&&label_unknown_op,
&&label_JOP_NOT_EQUALS,
&&label_JOP_NOT_EQUALS_IMMEDIATE,
&&label_JOP_CANCEL,
&&label_unknown_op,
&&label_unknown_op,
&&label_unknown_op,
@@ -563,6 +568,15 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in) {
register Janet *stack;
register uint32_t *pc;
register JanetFunction *func;
if (fiber->flags & JANET_FIBER_RESUME_SIGNAL) {
JanetSignal sig = (fiber->gc.flags & JANET_FIBER_STATUS_MASK) >> JANET_FIBER_STATUS_OFFSET;
fiber->gc.flags &= ~JANET_FIBER_STATUS_MASK;
fiber->flags &= ~(JANET_FIBER_RESUME_SIGNAL | JANET_FIBER_FLAG_MASK);
janet_vm_return_reg[0] = in;
return sig;
}
vm_restore();
if (fiber->flags & JANET_FIBER_DID_LONGJUMP) {
@@ -613,7 +627,7 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in) {
Janet retval = stack[D];
int entrance_frame = janet_stack_frame(stack)->flags & JANET_STACKFRAME_ENTRANCE;
janet_fiber_popframe(fiber);
if (entrance_frame) vm_return(JANET_SIGNAL_OK, retval);
if (entrance_frame) vm_return_no_restore(JANET_SIGNAL_OK, retval);
vm_restore();
stack[A] = retval;
vm_checkgc_pcnext();
@@ -623,7 +637,7 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in) {
Janet retval = janet_wrap_nil();
int entrance_frame = janet_stack_frame(stack)->flags & JANET_STACKFRAME_ENTRANCE;
janet_fiber_popframe(fiber);
if (entrance_frame) vm_return(JANET_SIGNAL_OK, retval);
if (entrance_frame) vm_return_no_restore(JANET_SIGNAL_OK, retval);
vm_restore();
stack[A] = retval;
vm_checkgc_pcnext();
@@ -787,11 +801,20 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in) {
stack[A] = janet_wrap_boolean(janet_unwrap_integer(stack[B]) == CS);
vm_pcnext();
VM_OP(JOP_NOT_EQUALS)
stack[A] = janet_wrap_boolean(!janet_equals(stack[B], stack[C]));
vm_pcnext();
VM_OP(JOP_NOT_EQUALS_IMMEDIATE)
stack[A] = janet_wrap_boolean(janet_unwrap_integer(stack[B]) != CS);
vm_pcnext();
VM_OP(JOP_COMPARE)
stack[A] = janet_wrap_integer(janet_compare(stack[B], stack[C]));
vm_pcnext();
VM_OP(JOP_NEXT)
vm_commit();
stack[A] = janet_next(stack[B], stack[C]);
vm_pcnext();
@@ -992,8 +1015,9 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in) {
retreg = call_nonfn(fiber, callee);
}
janet_fiber_popframe(fiber);
if (entrance_frame)
vm_return(JANET_SIGNAL_OK, retreg);
if (entrance_frame) {
vm_return_no_restore(JANET_SIGNAL_OK, retreg);
}
vm_restore();
stack[A] = retreg;
vm_checkgc_pcnext();
@@ -1040,6 +1064,25 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in) {
vm_return((int) sub_status, stack[B]);
}
VM_OP(JOP_CANCEL) {
Janet retreg;
vm_assert_type(stack[B], JANET_FIBER);
JanetFiber *child = janet_unwrap_fiber(stack[B]);
if (janet_check_can_resume(child, &retreg)) {
vm_commit();
janet_panicv(retreg);
}
fiber->child = child;
JanetSignal sig = janet_continue_signal(child, stack[C], &retreg, JANET_SIGNAL_ERROR);
if (sig != JANET_SIGNAL_OK && !(child->flags & (1 << sig))) {
vm_return(sig, retreg);
}
fiber->child = NULL;
stack = fiber->data + fiber->frame;
stack[A] = retreg;
vm_checkgc_pcnext();
}
VM_OP(JOP_PUT)
vm_commit();
fiber->flags |= JANET_FIBER_RESUME_NO_USEVAL;
@@ -1272,11 +1315,32 @@ static JanetSignal janet_check_can_resume(JanetFiber *fiber, Janet *out) {
return JANET_SIGNAL_OK;
}
void janet_try_init(JanetTryState *state) {
state->stackn = janet_vm_stackn++;
state->gc_handle = janet_vm_gc_suspend;
state->vm_fiber = janet_vm_fiber;
state->vm_jmp_buf = janet_vm_jmp_buf;
state->vm_return_reg = janet_vm_return_reg;
janet_vm_return_reg = &(state->payload);
janet_vm_jmp_buf = &(state->buf);
}
void janet_restore(JanetTryState *state) {
janet_vm_stackn = state->stackn;
janet_vm_gc_suspend = state->gc_handle;
janet_vm_fiber = state->vm_fiber;
janet_vm_jmp_buf = state->vm_jmp_buf;
janet_vm_return_reg = state->vm_return_reg;
}
static JanetSignal janet_continue_no_check(JanetFiber *fiber, Janet in, Janet *out) {
jmp_buf buf;
JanetFiberStatus old_status = janet_fiber_status(fiber);
#ifdef JANET_EV
janet_fiber_did_resume(fiber);
#endif
/* Continue child fiber if it exists */
if (fiber->child) {
if (janet_vm_root_fiber == NULL) janet_vm_root_fiber = fiber;
@@ -1306,45 +1370,21 @@ static JanetSignal janet_continue_no_check(JanetFiber *fiber, Janet in, Janet *o
}
/* Save global state */
int32_t oldn = janet_vm_stackn++;
int handle = janet_vm_gc_suspend;
JanetFiber *old_vm_fiber = janet_vm_fiber;
jmp_buf *old_vm_jmp_buf = janet_vm_jmp_buf;
Janet *old_vm_return_reg = janet_vm_return_reg;
/* Setup fiber */
if (janet_vm_root_fiber == NULL) janet_vm_root_fiber = fiber;
janet_vm_fiber = fiber;
janet_gcroot(janet_wrap_fiber(fiber));
janet_fiber_set_status(fiber, JANET_STATUS_ALIVE);
janet_vm_return_reg = out;
janet_vm_jmp_buf = &buf;
/* Run loop */
JanetSignal signal;
int jmpsig;
#if defined(JANET_BSD) || defined(JANET_APPLE)
jmpsig = _setjmp(buf);
#else
jmpsig = setjmp(buf);
#endif
if (jmpsig) {
signal = (JanetSignal) jmpsig;
} else {
JanetTryState tstate;
JanetSignal signal = janet_try(&tstate);
if (!signal) {
/* Normal setup */
if (janet_vm_root_fiber == NULL) janet_vm_root_fiber = fiber;
janet_vm_fiber = fiber;
janet_fiber_set_status(fiber, JANET_STATUS_ALIVE);
signal = run_vm(fiber, in);
}
/* Tear down fiber */
janet_fiber_set_status(fiber, signal);
janet_gcunroot(janet_wrap_fiber(fiber));
/* Restore global state */
/* Restore */
if (janet_vm_root_fiber == fiber) janet_vm_root_fiber = NULL;
janet_vm_gc_suspend = handle;
janet_vm_fiber = old_vm_fiber;
janet_vm_stackn = oldn;
janet_vm_return_reg = old_vm_return_reg;
janet_vm_jmp_buf = old_vm_jmp_buf;
janet_fiber_set_status(fiber, signal);
janet_restore(&tstate);
*out = tstate.payload;
return signal;
}
@@ -1357,6 +1397,20 @@ JanetSignal janet_continue(JanetFiber *fiber, Janet in, Janet *out) {
return janet_continue_no_check(fiber, in, out);
}
/* Enter the main vm loop but immediately raise a signal */
JanetSignal janet_continue_signal(JanetFiber *fiber, Janet in, Janet *out, JanetSignal sig) {
JanetSignal tmp_signal = janet_check_can_resume(fiber, out);
if (tmp_signal) return tmp_signal;
if (sig != JANET_SIGNAL_OK) {
JanetFiber *child = fiber;
while (child->child) child = child->child;
child->gc.flags &= ~JANET_FIBER_STATUS_MASK;
child->gc.flags |= sig << JANET_FIBER_STATUS_OFFSET;
child->flags |= JANET_FIBER_RESUME_SIGNAL;
}
return janet_continue_no_check(fiber, in, out);
}
JanetSignal janet_pcall(
JanetFunction *fun,
int32_t argc,
@@ -1394,11 +1448,8 @@ int janet_init(void) {
/* Garbage collection */
janet_vm_blocks = NULL;
janet_vm_next_collection = 0;
/* Setting memoryInterval to zero forces
* a collection pretty much every cycle, which is
* incredibly horrible for performance, but can help ensure
* there are no memory bugs during development */
janet_vm_gc_interval = 0x10000;
janet_vm_gc_interval = 0x400000;
janet_vm_block_count = 0;
janet_symcache_init();
/* Initialize gc roots */
janet_vm_roots = NULL;
@@ -1419,6 +1470,8 @@ int janet_init(void) {
janet_vm_traversal_top = NULL;
/* Core env */
janet_vm_core_env = NULL;
/* Dynamic bindings */
janet_vm_top_dyns = NULL;
/* Seed RNG */
janet_rng_seed(janet_default_rng(), 0);
/* Fibers */
@@ -1428,6 +1481,12 @@ int janet_init(void) {
/* Threads */
#ifdef JANET_THREADS
janet_threads_init();
#endif
#ifdef JANET_EV
janet_ev_init();
#endif
#ifdef JANET_NET
janet_net_init();
#endif
return 0;
}
@@ -1443,12 +1502,16 @@ void janet_deinit(void) {
janet_vm_registry = NULL;
janet_vm_abstract_registry = NULL;
janet_vm_core_env = NULL;
janet_vm_top_dyns = NULL;
free(janet_vm_traversal_base);
janet_vm_fiber = NULL;
janet_vm_root_fiber = NULL;
#ifdef JANET_THREADS
janet_threads_deinit();
#endif
#ifdef JANET_EV
janet_ev_deinit();
#endif
#ifdef JANET_NET
janet_net_deinit();
#endif

View File

@@ -127,6 +127,12 @@ extern "C" {
#define JANET_LITTLE_ENDIAN 1
#endif
/* Limits for converting doubles to 64 bit integers */
#define JANET_INTMAX_DOUBLE 9007199254740992.0
#define JANET_INTMIN_DOUBLE (-9007199254740992.0)
#define JANET_INTMAX_INT64 9007199254740992
#define JANET_INTMIN_INT64 (-9007199254740992)
/* Check emscripten */
#ifdef __EMSCRIPTEN__
#define JANET_NO_DYNAMIC_MODULES
@@ -171,8 +177,13 @@ extern "C" {
#define JANET_TYPED_ARRAY
#endif
/* Enable or disable event loop */
#if !defined(JANET_NO_EV) && !defined(__EMSCRIPTEN__)
#define JANET_EV
#endif
/* Enable or disable networking */
#if !defined(JANET_NO_NET) && !defined(__EMSCRIPTEN__)
#if defined(JANET_EV) && !defined(JANET_NO_NET) && !defined(__EMSCRIPTEN__)
#define JANET_NET
#endif
@@ -195,7 +206,7 @@ extern "C" {
#ifdef JANET_WINDOWS
#define JANET_NO_RETURN __declspec(noreturn)
#else
#define JANET_NO_RETURN __attribute__ ((noreturn))
#define JANET_NO_RETURN __attribute__((noreturn))
#endif
#endif
@@ -219,6 +230,11 @@ extern "C" {
* To turn of nanboxing, for debugging purposes or for certain
* architectures (Nanboxing only tested on x86 and x64), comment out
* the JANET_NANBOX define.*/
#if defined(_M_ARM64) || defined(_M_ARM) || defined(__aarch64__)
#define JANET_NO_NANBOX
#endif
#ifndef JANET_NO_NANBOX
#ifdef JANET_32
#define JANET_NANBOX_32
@@ -256,11 +272,22 @@ typedef struct {
} JanetBuildConfig;
/* Get config of current compilation unit. */
#ifdef __cplusplus
/* C++11 syntax */
#define janet_config_current() (JanetBuildConfig { \
JANET_VERSION_MAJOR, \
JANET_VERSION_MINOR, \
JANET_VERSION_PATCH, \
JANET_CURRENT_CONFIG_BITS })
#else
/* C99 syntax */
#define janet_config_current() ((JanetBuildConfig){ \
JANET_VERSION_MAJOR, \
JANET_VERSION_MINOR, \
JANET_VERSION_PATCH, \
JANET_CURRENT_CONFIG_BITS })
#endif
/***** END SECTION CONFIG *****/
@@ -288,6 +315,15 @@ JANET_API extern const char *const janet_type_names[16];
JANET_API extern const char *const janet_signal_names[14];
JANET_API extern const char *const janet_status_names[16];
/* For various IO routines, we want to use an int on posix and HANDLE on windows */
#ifdef JANET_WINDOWS
typedef void *JanetHandle;
#define JANET_HANDLE_NONE NULL
#else
typedef int JanetHandle;
#define JANET_HANDLE_NONE (-1)
#endif
/* Fiber signals */
typedef enum {
JANET_SIGNAL_OK,
@@ -461,6 +497,75 @@ typedef void *JanetAbstract;
#define JANET_TFLAG_CALLABLE (JANET_TFLAG_FUNCTION | JANET_TFLAG_CFUNCTION | \
JANET_TFLAG_LENGTHABLE | JANET_TFLAG_ABSTRACT)
/* Event Loop Types */
#ifdef JANET_EV
#define JANET_STREAM_CLOSED 0x1
#define JANET_STREAM_SOCKET 0x2
#define JANET_STREAM_IOCP 0x4
#define JANET_STREAM_READABLE 0x200
#define JANET_STREAM_WRITABLE 0x400
#define JANET_STREAM_ACCEPTABLE 0x800
#define JANET_STREAM_UDPSERVER 0x1000
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_TIMEOUT,
JANET_ASYNC_EVENT_COMPLETE, /* Used on windows for IOCP */
JANET_ASYNC_EVENT_USER
} 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;
/* 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;
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. */
#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 */
int _index; /* not used in all implementations */
int _mask;
JanetListenerState *_next;
};
#endif
/* 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
* application must interact through exposed interface. */
@@ -550,14 +655,14 @@ JANET_API Janet janet_wrap_integer(int32_t x);
#define janet_nanbox_tag(type) (janet_nanbox_lowtag(type) << 47)
#define janet_type(x) \
(isnan((x).number) \
? (((x).u64 >> 47) & 0xF) \
? (JanetType) (((x).u64 >> 47) & 0xF) \
: JANET_NUMBER)
#define janet_nanbox_checkauxtype(x, type) \
(((x).u64 & JANET_NANBOX_TAGBITS) == janet_nanbox_tag((type)))
#define janet_nanbox_isnumber(x) \
(!isnan((x).number) || janet_nanbox_checkauxtype((x), JANET_NUMBER))
(!isnan((x).number) || ((((x).u64 >> 47) & 0xF) == JANET_NUMBER))
#define janet_checktype(x, t) \
(((t) == JANET_NUMBER) \
@@ -629,7 +734,7 @@ JANET_API Janet janet_nanbox_from_bits(uint64_t bits);
#define JANET_DOUBLE_OFFSET 0xFFFF
#define janet_u64(x) ((x).u64)
#define janet_type(x) (((x).tagged.type < JANET_DOUBLE_OFFSET) ? (x).tagged.type : JANET_NUMBER)
#define janet_type(x) (((x).tagged.type < JANET_DOUBLE_OFFSET) ? (JanetType)((x).tagged.type) : JANET_NUMBER)
#define janet_checktype(x, t) ((t) == JANET_NUMBER \
? (x).tagged.type >= JANET_DOUBLE_OFFSET \
: (x).tagged.type == (t))
@@ -706,7 +811,7 @@ JANET_API int janet_checkint64(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_checkint64range(x) ((x) >= INT64_MIN && (x) <= INT64_MAX && (x) == (int64_t)(x))
#define janet_checkint64range(x) ((x) >= JANET_INTMIN_DOUBLE && (x) <= JANET_INTMAX_DOUBLE && (x) == (int64_t)(x))
#define janet_unwrap_integer(x) ((int32_t) janet_unwrap_number(x))
#define janet_wrap_integer(x) janet_wrap_number((int32_t)(x))
@@ -728,11 +833,15 @@ struct JanetFiber {
int32_t frame; /* Index of the stack frame */
int32_t stackstart; /* Beginning of next args */
int32_t stacktop; /* Top of stack. Where values are pushed and popped from. */
int32_t capacity;
int32_t capacity; /* How big is the stack memory */
int32_t maxstack; /* Arbitrary defined limit for stack overflow */
JanetTable *env; /* Dynamic bindings table (usually current environment). */
Janet *data;
Janet *data; /* Dynamically resized stack memory */
JanetFiber *child; /* Keep linked list of fibers for restarting pending fibers */
#ifdef JANET_EV
JanetListenerState *waiting;
uint32_t sched_id; /* Increment everytime fiber is scheduled by event loop */
#endif
};
/* Mark if a stack frame is a tail call for debugging */
@@ -996,9 +1105,22 @@ struct JanetRNG {
typedef struct JanetFile JanetFile;
struct JanetFile {
FILE *file;
int flags;
int32_t flags;
};
/* For janet_try and janet_restore */
typedef struct {
/* old state */
int32_t stackn;
int gc_handle;
JanetFiber *vm_fiber;
jmp_buf *vm_jmp_buf;
Janet *vm_return_reg;
/* new state */
jmp_buf buf;
Janet payload;
} JanetTryState;
/* Thread types */
#ifdef JANET_THREADS
typedef struct JanetThread JanetThread;
@@ -1118,6 +1240,9 @@ enum JanetOpCode {
JOP_GREATER_THAN_EQUAL,
JOP_LESS_THAN_EQUAL,
JOP_NEXT,
JOP_NOT_EQUALS,
JOP_NOT_EQUALS_IMMEDIATE,
JOP_CANCEL,
JOP_INSTRUCTION_COUNT
};
@@ -1128,9 +1253,59 @@ extern enum JanetInstructionType janet_instructions[JOP_INSTRUCTION_COUNT];
/***** START SECTION MAIN *****/
/* Event Loop */
#ifdef JANET_NET
#ifdef JANET_EV
extern JANET_API const JanetAbstractType janet_stream_type;
/* Run the event loop */
JANET_API void janet_loop(void);
/* Wrapper around streams */
JANET_API JanetStream *janet_stream(JanetHandle handle, uint32_t flags, const JanetMethod *methods);
JANET_API void janet_stream_close(JanetStream *stream);
JANET_API Janet janet_cfun_stream_close(int32_t argc, Janet *argv);
JANET_API Janet janet_cfun_stream_read(int32_t argc, Janet *argv);
JANET_API Janet janet_cfun_stream_chunk(int32_t argc, Janet *argv);
JANET_API Janet janet_cfun_stream_write(int32_t argc, Janet *argv);
JANET_API void janet_stream_flags(JanetStream *stream, uint32_t flags);
/* Queue a fiber to run on the event loop */
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);
/* Shorthand for yielding to event loop in C */
JANET_NO_RETURN JANET_API void janet_await(void);
/* For use inside listeners - adds a timeout to the current fiber, such that
* it will be resumed after sec seconds if no other event schedules the current fiber. */
JANET_API void janet_addtimeout(double sec);
/* Get last error from a an IO operation */
JANET_API Janet janet_ev_lasterr(void);
/* 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);
#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);
#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);
#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);
#endif
#endif
/* Parsing */
@@ -1373,10 +1548,17 @@ JANET_API int janet_verify(JanetFuncDef *def);
JANET_API JanetBuffer *janet_pretty(JanetBuffer *buffer, int depth, int flags, Janet x);
/* Misc */
#ifndef JANET_NO_PRF
#ifdef JANET_PRF
#define JANET_HASH_KEY_SIZE 16
JANET_API void janet_init_hash_key(uint8_t key[JANET_HASH_KEY_SIZE]);
#endif
JANET_API void janet_try_init(JanetTryState *state);
#if defined(JANET_BSD) || defined(JANET_APPLE)
#define janet_try(state) (janet_try_init(state), (JanetSignal) _setjmp((state)->buf))
#else
#define janet_try(state) (janet_try_init(state), (JanetSignal) setjmp((state)->buf))
#endif
JANET_API void janet_restore(JanetTryState *state);
JANET_API int janet_equals(Janet x, Janet y);
JANET_API int32_t janet_hash(Janet x);
JANET_API int janet_compare(Janet x, Janet y);
@@ -1399,6 +1581,7 @@ JANET_API int janet_symeq(Janet x, const char *cstring);
JANET_API int janet_init(void);
JANET_API void janet_deinit(void);
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);
JANET_API JanetSignal janet_step(JanetFiber *fiber, Janet in, Janet *out);
JANET_API Janet janet_call(JanetFunction *fun, int32_t argc, const Janet *argv);
@@ -1424,6 +1607,7 @@ typedef enum {
JANET_API void janet_def(JanetTable *env, const char *name, Janet val, const char *documentation);
JANET_API void janet_var(JanetTable *env, const char *name, Janet val, const char *documentation);
JANET_API void janet_cfuns(JanetTable *env, const char *regprefix, const JanetReg *cfuns);
JANET_API void janet_cfuns_prefix(JanetTable *env, const char *regprefix, const JanetReg *cfuns);
JANET_API JanetBindingType janet_resolve(JanetTable *env, JanetSymbol sym, Janet *out);
JANET_API void janet_register(const char *name, JanetCFunction cfun);
@@ -1432,15 +1616,23 @@ JANET_API Janet janet_resolve_core(const char *name);
/* New C API */
/* Shorthand for janet C function declarations */
#define JANET_CFUN(name) Janet name (int32_t argc, Janet *argv)
/* Allow setting entry name for static libraries */
#ifdef __cplusplus
#define JANET_MODULE_PREFIX extern "C"
#else
#define JANET_MODULE_PREFIX
#endif
#ifndef JANET_ENTRY_NAME
#define JANET_MODULE_ENTRY \
JANET_API JanetBuildConfig _janet_mod_config(void) { \
JANET_MODULE_PREFIX JANET_API JanetBuildConfig _janet_mod_config(void) { \
return janet_config_current(); \
} \
JANET_API void _janet_init
JANET_MODULE_PREFIX JANET_API void _janet_init
#else
#define JANET_MODULE_ENTRY JANET_API void JANET_ENTRY_NAME
#define JANET_MODULE_ENTRY JANET_MODULE_PREFIX JANET_API void JANET_ENTRY_NAME
#endif
JANET_NO_RETURN JANET_API void janet_signalv(JanetSignal signal, Janet message);
@@ -1525,12 +1717,17 @@ extern JANET_API const JanetAbstractType janet_file_type;
#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, int flags);
JANET_API FILE *janet_getfile(const Janet *argv, int32_t n, int *flags);
JANET_API Janet janet_makefile(FILE *f, int32_t flags);
JANET_API JanetFile *janet_makejfile(FILE *f, int32_t flags);
JANET_API FILE *janet_getfile(const Janet *argv, int32_t n, int32_t *flags);
JANET_API FILE *janet_dynfile(const char *name, FILE *def);
JANET_API JanetFile *janet_getjfile(const Janet *argv, int32_t n);
JANET_API JanetAbstract janet_checkfile(Janet j);
JANET_API FILE *janet_unwrapfile(Janet j, int *flags);
JANET_API FILE *janet_unwrapfile(Janet j, int32_t *flags);
JANET_API int janet_cryptorand(uint8_t *out, size_t n);
/* Marshal API */
JANET_API void janet_marshal_size(JanetMarshalContext *ctx, size_t value);
@@ -1586,6 +1783,7 @@ typedef enum {
RULE_TO, /* [rule] */
RULE_THRU, /* [rule] */
RULE_LENPREFIX, /* [rule_a, rule_b (repeat rule_b rule_a times)] */
RULE_READINT, /* [(signedness << 4) | (endianess << 5) | bytewidth, tag] */
} JanetPegOpcode;
typedef struct {

View File

@@ -84,7 +84,7 @@ static void simpleline(JanetBuffer *buffer) {
}
/* Windows */
#ifdef JANET_WINDOWS
#if defined(JANET_WINDOWS) || defined(JANET_SIMPLE_GETLINE)
void janet_line_init() {
;
@@ -126,21 +126,28 @@ https://github.com/antirez/linenoise/blob/master/linenoise.c
#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 int gbl_sigint_flag = 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;
static int gbl_israwmode = 0;
static const char *gbl_prompt = "> ";
static int gbl_plen = 2;
static char gbl_buf[JANET_LINE_MAX];
static int gbl_len = 0;
static int gbl_pos = 0;
static int gbl_cols = 80;
static char *gbl_history[JANET_HISTORY_MAX];
static int gbl_history_count = 0;
static int gbl_historyi = 0;
static int gbl_sigint_flag = 0;
static struct termios gbl_termios_start;
static JanetByteView gbl_matches[JANET_MATCH_MAX];
static int gbl_match_count = 0;
static int gbl_lines_below = 0;
/* Put a lock around this global state so we don't screw up
* the terminal in a multithreaded situation */
#ifndef JANET_SINGLE_THREADED
#include <pthread.h>
static pthread_mutex_t gbl_lock = PTHREAD_MUTEX_INITIALIZER;
#endif
/* Unsupported terminal list from linenoise */
static const char *badterms[] = {
@@ -162,6 +169,9 @@ static char *sdup(const char *s) {
/* Ansi terminal raw mode */
static int rawmode(void) {
struct termios t;
#ifndef JANET_SINGLE_THREADED
pthread_mutex_lock(&gbl_lock);
#endif
if (!isatty(STDIN_FILENO)) goto fatal;
if (tcgetattr(STDIN_FILENO, &gbl_termios_start) == -1) goto fatal;
t = gbl_termios_start;
@@ -170,18 +180,24 @@ static int rawmode(void) {
t.c_lflag &= ~(ECHO | ICANON | IEXTEN | ISIG);
t.c_cc[VMIN] = 1;
t.c_cc[VTIME] = 0;
if (tcsetattr(STDIN_FILENO, TCSAFLUSH, &t) < 0) goto fatal;
if (tcsetattr(STDIN_FILENO, TCSADRAIN, &t) < 0) goto fatal;
gbl_israwmode = 1;
return 0;
fatal:
errno = ENOTTY;
#ifndef JANET_SINGLE_THREADED
pthread_mutex_unlock(&gbl_lock);
#endif
return -1;
}
/* Disable raw mode */
static void norawmode(void) {
if (gbl_israwmode && tcsetattr(STDIN_FILENO, TCSAFLUSH, &gbl_termios_start) != -1)
if (gbl_israwmode && tcsetattr(STDIN_FILENO, TCSADRAIN, &gbl_termios_start) != -1)
gbl_israwmode = 0;
#ifndef JANET_SINGLE_THREADED
pthread_mutex_unlock(&gbl_lock);
#endif
}
static int curpos(void) {
@@ -747,7 +763,7 @@ static int line() {
switch (c) {
default:
if (c < 0x20) break;
if ((unsigned char) c < 0x20) break;
if (insert(c, 1)) return -1;
break;
case 1: /* ctrl-a */
@@ -996,6 +1012,28 @@ int main(int argc, char **argv) {
SetConsoleOutputCP(65001);
#endif
#if !defined(JANET_WINDOWS) && !defined(JANET_SIMPLE_GETLINE)
/* Try and not leave the terminal in a bad state */
atexit(norawmode);
#endif
#if defined(JANET_PRF)
uint8_t hash_key[JANET_HASH_KEY_SIZE + 1];
#ifdef JANET_REDUCED_OS
char *envvar = NULL;
#else
char *envvar = getenv("JANET_HASHSEED");
#endif
if (NULL != envvar) {
strncpy((char *) hash_key, envvar, sizeof(hash_key) - 1);
} else if (janet_cryptorand(hash_key, JANET_HASH_KEY_SIZE) != 0) {
fputs("unable to initialize janet PRF hash function.\n", stderr);
return 1;
}
janet_init_hash_key(hash_key);
#endif
/* Set up VM */
janet_init();
@@ -1026,7 +1064,7 @@ int main(int argc, char **argv) {
janet_stacktrace(fiber, out);
}
#ifdef JANET_NET
#ifdef JANET_EV
status = JANET_SIGNAL_OK;
janet_loop();
#endif

View File

@@ -3,7 +3,6 @@
(var num-tests-passed 0)
(var num-tests-run 0)
(var suite-num 0)
(var numchecks 0)
(var start-time 0)
(defn assert
@@ -12,17 +11,12 @@
(default e "assert error")
(++ num-tests-run)
(when x (++ num-tests-passed))
(def str (string e))
(def truncated
(if (> (length e) 40) (string (string/slice e 0 35) "...") (string e)))
(if x
(do
(when (= numchecks 25)
(set numchecks 0)
(print))
(++ numchecks)
(file/write stdout "\e[32m✔\e[0m"))
(do
(file/write stdout "\n\e[31m✘\e[0m ")
(set numchecks 0)
(print e)))
(eprintf "\e[32m✔\e[0m %s: %v" truncated x)
(eprintf "\n\e[31m✘\e[0m %s: %v" truncated x))
x)
(defmacro assert-error
@@ -38,10 +32,10 @@
(defn start-suite [x]
(set suite-num x)
(set start-time (os/clock))
(print "\nRunning test suite " x " tests...\n "))
(eprint "\nRunning test suite " x " tests...\n "))
(defn end-suite []
(def delta (- (os/clock) start-time))
(printf "\n\nTest suite %d finished in %.3f seconds" suite-num delta)
(print num-tests-passed " of " num-tests-run " tests passed.\n")
(eprintf "\n\nTest suite %d finished in %.3f seconds" suite-num delta)
(eprint num-tests-passed " of " num-tests-run " tests passed.\n")
(if (not= num-tests-passed num-tests-run) (os/exit 1)))

View File

@@ -9,6 +9,14 @@
:name "testmod2"
:source @["testmod2.c"])
(declare-native
:name "testmod3"
:source @["testmod3.cpp"])
(declare-native
:name "test-mod-4"
:source @["testmod4.c"])
(declare-executable
:name "testexec"
:entry "testexec.janet")

View File

@@ -1,6 +1,8 @@
(use build/testmod)
(use build/testmod2)
(use build/testmod3)
(use build/test-mod-4)
(defn main [&]
(print "Hello from executable!")
(print (+ (get5) (get6))))
(print (+ (get5) (get6) (get7) (get8))))

42
test/install/testmod3.cpp Normal file
View File

@@ -0,0 +1,42 @@
/*
* Copyright (c) 2020 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 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.
*/
/* A very simple native module */
#include <janet.h>
#include <iostream>
static Janet cfun_get_seven(int32_t argc, Janet *argv) {
(void) argv;
janet_fixarity(argc, 0);
std::cout << "Hello!" << std::endl;
return janet_wrap_number(7.0);
}
static const JanetReg array_cfuns[] = {
{"get7", cfun_get_seven, NULL},
{NULL, NULL, NULL}
};
JANET_MODULE_ENTRY(JanetTable *env) {
janet_cfuns(env, NULL, array_cfuns);
}

40
test/install/testmod4.c Normal file
View File

@@ -0,0 +1,40 @@
/*
* Copyright (c) 2020 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 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.
*/
/* A very simple native module */
#include <janet.h>
static Janet cfun_get_eight(int32_t argc, Janet *argv) {
(void) argv;
janet_fixarity(argc, 0);
return janet_wrap_number(8.0);
}
static const JanetReg array_cfuns[] = {
{"get8", cfun_get_eight, NULL},
{NULL, NULL, NULL}
};
JANET_MODULE_ENTRY(JanetTable *env) {
janet_cfuns(env, NULL, array_cfuns);
}

View File

@@ -337,9 +337,9 @@
## Polymorphic comparison -- Issue #272
# confirm polymorphic comparison delegation to primitive comparators:
(assert (= 0 (compare-primitive 3 3)) "compare-primitive integers (1)")
(assert (= -1 (compare-primitive 3 5)) "compare-primitive integers (2)")
(assert (= 1 (compare-primitive "foo" "bar")) "compare-primitive strings")
(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)")
@@ -372,9 +372,9 @@
@{:type :mynum :v 0 :compare
(fn [self other]
(case (type other)
:number (compare-primitive (self :v) other)
:number (cmp (self :v) other)
:table (when (= (get other :type) :mynum)
(compare-primitive (self :v) (other :v)))))})
(cmp (self :v) (other :v)))))})
(let [n3 (table/setproto @{:v 3} mynum)]
(assert (= 0 (compare 3 n3)) "compare num to object (1)")
@@ -386,17 +386,14 @@
(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"))
(let [
MAX_INT_64_STRING "9223372036854775807"
(let [MAX_INT_64_STRING "9223372036854775807"
MAX_UINT_64_STRING "18446744073709551615"
MAX_INT_IN_DBL_STRING "9007199254740991"
NAN (math/log -1)
INF (/ 1 0)
MINUS_INF (/ -1 0)
compare-poly-tests
[
[(int/s64 3) (int/u64 3) 0]
[[(int/s64 3) (int/u64 3) 0]
[(int/s64 -3) (int/u64 3) -1]
[(int/s64 3) (int/u64 2) 1]
[(int/s64 3) 3 0] [(int/s64 3) 4 -1] [(int/s64 3) -9 1]
@@ -409,11 +406,16 @@
[(+ 1 (int/u64 MAX_INT_IN_DBL_STRING)) (scan-number MAX_INT_IN_DBL_STRING) 1]
[(int/s64 0) INF -1] [(int/u64 0) INF -1]
[MINUS_INF (int/u64 0) -1] [MINUS_INF (int/s64 0) -1]
[(int/s64 1) NAN 0] [NAN (int/u64 1) 0]
]]
[(int/s64 1) NAN 0] [NAN (int/u64 1) 0]]]
(each [x y c] compare-poly-tests
(assert (= c (compare x y)) (string/format "compare polymorphic %q %q %d" x y c)))
)
(assert (= c (compare x y)) (string/format "compare polymorphic %q %q %d" x y c))))
(assert (= nil (any? [])) "any? 1")
(assert (= nil (any? [false nil])) "any? 2")
(assert (= nil (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")
(end-suite)

View File

@@ -443,4 +443,26 @@
(check-match redef-b "aabeef" false)
(check-match redef-b "aaaaaa" false)
# Integer parsing
(check-deep '(int 1) "a" @[(chr "a")])
(check-deep '(uint 1) "a" @[(chr "a")])
(check-deep '(int-be 1) "a" @[(chr "a")])
(check-deep '(uint-be 1) "a" @[(chr "a")])
(check-deep '(int 1) "\xFF" @[-1])
(check-deep '(uint 1) "\xFF" @[255])
(check-deep '(int-be 1) "\xFF" @[-1])
(check-deep '(uint-be 1) "\xFF" @[255])
(check-deep '(int 2) "\xFF\x7f" @[0x7fff])
(check-deep '(int-be 2) "\x7f\xff" @[0x7fff])
(check-deep '(uint 2) "\xff\x7f" @[0x7fff])
(check-deep '(uint-be 2) "\x7f\xff" @[0x7fff])
(check-deep '(uint-be 2) "\x7f\xff" @[0x7fff])
(check-deep '(uint 8) "\xff\x7f\x00\x00\x00\x00\x00\x00" @[(int/u64 0x7fff)])
(check-deep '(int 8) "\xff\x7f\x00\x00\x00\x00\x00\x00" @[(int/s64 0x7fff)])
(check-deep '(uint 7) "\xff\x7f\x00\x00\x00\x00\x00" @[(int/u64 0x7fff)])
(check-deep '(int 7) "\xff\x7f\x00\x00\x00\x00\x00" @[(int/s64 0x7fff)])
(check-deep '(* (int 2) -1) "123" nil)
(end-suite)

View File

@@ -48,7 +48,9 @@
(defn check-image
"Run a marshaling test using the make-image and load-image functions."
[x msg]
(assert-no-error msg (load-image (make-image x))))
(def im (make-image x))
# (printf "\nimage-hash: %d" (-> im string hash))
(assert-no-error msg (load-image im)))
(check-image (fn [] (fn [] 1)) "marshal nested functions")
(check-image (fiber/new (fn [] (fn [] 1))) "marshal nested functions in fiber")

View File

@@ -315,4 +315,9 @@
(assert (= 40 counter) "if-with 1")
(def a @[])
(eachk x [:a :b :c :d]
(array/push a x))
(assert (deep= (range 4) a) "eachk 1")
(end-suite)

View File

@@ -36,7 +36,7 @@
:loop (/ (* "[" :main "]") ,(fn [& captures]
~(while (not= (get DATA POS) 0)
,;captures)))
:main (any (+ :s :loop :+ :- :> :< :.)) }))
:main (any (+ :s :loop :+ :- :> :< :.))}))
(defn bf
"Run brainfuck."
@@ -224,7 +224,7 @@ neldb\0\0\0\xD8\x05printG\x01\0\xDE\xDE\xDE'\x03\0marshal_tes/\x02
# No segfault, valgrind clean.
(def x @"\xCC\xCD.nd\x80\0\r\x1C\xCDg!\0\x07\xCC\xCD\r\x1Ce\x10\0\r;\xCDb\x04\xFF9\xFF\x80\x04\x04\x04\x04\x04\x04\x04\x04\x04\x04\x04uu\x04\x04\x04\x04\x04\x04\x04\x04\x04\x04\x04\x04\x04\x04\0\x04\x04\x04\x04\x04\x04\x04\x04\x04\x04\x04\x04\x04\x04\x04\x04\x04\x04}\x04\x04\x04\x04\x04\x04\x04\x04#\x04\x04\x04\x04\x04\x04\x04\x04\x04\x04\x04\0\x01\0\0\x03\x04\x04\x04\xE2\x03\x04\x04\x04\x04\x04\x04\x04\x04\x04\x14\x1A\x04\x04\x04\x04\x04\x18\x04\x04!\x04\xE2\x03\x04\x04\x04\x04\x04\x04$\x04\x04\x04\x04\x04\x04\x04\x04\x04\x80\x04\x04\x04\x04\x04\x04\x04\x04\x04\x04\x04\x04\x04A\0\0\0\x03\0\0!\xBF\xFF")
(unmarshal x load-image-dict)
(assert-error "bad fiber status" (unmarshal x load-image-dict))
(gccollect)
(marshal x make-image-dict)
@@ -233,8 +233,8 @@ neldb\0\0\0\xD8\x05printG\x01\0\xDE\xDE\xDE'\x03\0marshal_tes/\x02
(gccollect)
(def v (unmarshal
@"\xD7\xCD0\xD4000000\0\x03\x01\xCE\00\0\x01\0\0000\x03\0\0\0000000000\xCC0\0000"
load-image-dict))
@"\xD7\xCD0\xD4000000\0\x03\x01\xCE\00\0\x01\0\0000\x03\0\0\0000000000\xCC0\0000"
load-image-dict))
(gccollect)
# in vs get regression
@@ -271,7 +271,7 @@ neldb\0\0\0\xD8\x05printG\x01\0\xDE\xDE\xDE'\x03\0marshal_tes/\x02
:packet-body '(lenprefix (-> :header-len) 1)
# header, followed by body, and drop the :header-len capture
:packet (/ (* :packet-header :packet-body) ,|$1)
:packet (/ (* :packet-header :packet-body) ,|$1)
# any exact seqence of packets (no extra characters)
:main (* (any :packet) -1)}))
@@ -307,4 +307,46 @@ neldb\0\0\0\xD8\x05printG\x01\0\xDE\xDE\xDE'\x03\0marshal_tes/\x02
(assert (:match peg5 "abcabcabcac") "repeat alias 2")
(assert (not (:match peg5 "abcabc")) "repeat alias 3")
(defn check-jdn [x]
(assert (deep= (parse (string/format "%j" x)) x) "round trip jdn"))
(check-jdn 0)
(check-jdn nil)
(check-jdn [])
(check-jdn @[[] [] 1231 9.123123 -123123 0.1231231230001])
(check-jdn -0.123123123123)
(check-jdn 12837192371923)
(check-jdn "a string")
(check-jdn @"a buffer")
# Issue 428
(var result nil)
(defn f [] (yield {:a :ok}))
(assert-no-error "issue 428 1" (loop [{:a x} :generate (fiber/new f)] (set result x)))
(assert (= result :ok) "issue 428 2")
# Inline 3 argument get
(assert (= 10 (do (var a 10) (set a (get '{} :a a)))) "inline get 1")
# Keyword and Symbol slice
(assert (= :keyword (keyword/slice "some_keyword_slice" 5 12)) "keyword slice")
(assert (= 'symbol (symbol/slice "some_symbol_slice" 5 11)) "symbol slice")
# Peg find and find-all
(def p "/usr/local/bin/janet")
(assert (= (peg/find '"n/" p) 13) "peg find 1")
(assert (not (peg/find '"t/" p)) "peg find 2")
(assert (deep= (peg/find-all '"/" p) @[0 4 10 14]) "peg find-all")
# Peg replace and replace-all
(var ti 0)
(defn check-replacer
[x y z]
(assert (= (string/replace x y z) (string (peg/replace x y z))) "replacer test replace")
(assert (= (string/replace-all x y z) (string (peg/replace-all x y z))) "replacer test replace-all"))
(check-replacer "abc" "Z" "abcabcabcabasciabsabc")
(check-replacer "abc" "Z" "")
(check-replacer "aba" "ZZZZZZ" "ababababababa")
(check-replacer "aba" "" "ababababababa")
(end-suite)

View File

@@ -48,4 +48,19 @@
(:close s)
# Create pipe
(var pipe-counter 0)
(def [reader writer] (ev/pipe))
(ev/spawn
(while (ev/read reader 3)
(++ pipe-counter))
(assert (= 20 pipe-counter) "ev/pipe 1"))
(for i 0 10
(ev/write writer "xxx---"))
(ev/close writer)
(ev/sleep 0.1)
(end-suite)

68
test/suite0010.janet Normal file
View File

@@ -0,0 +1,68 @@
# Copyright (c) 2020 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
# 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 10)
# index-of
(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")
# Regression
(assert (= {:x 10} (|(let [x $] ~{:x ,x}) 10)) "issue 463")
# macex testing
(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")
# Cancel test
(def f (fiber/new (fn [&] (yield 1) (yield 2) (yield 3) 4) :yti))
(assert (= 1 (resume f)) "cancel resume 1")
(assert (= 2 (resume f)) "cancel resume 2")
(assert (= :hi (cancel f :hi)) "cancel resume 3")
(assert (= :error (fiber/status f)) "cancel resume 4")
# Curenv
(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
(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
(assert (= :brackets (tuple/type (postwalk identity '[]))) "walk square brackets 1")
(assert (= :brackets (tuple/type (walk identity '[]))) "walk square brackets 2")
(end-suite)