1
0
mirror of https://github.com/janet-lang/janet synced 2025-11-07 02:53:02 +00:00

Compare commits

..

312 Commits

Author SHA1 Message Date
Calvin Rose
2a950e4ce9 Fix patch release - (version info) 2022-04-01 21:59:01 -05:00
Calvin Rose
f05e5f908e Update SONAME in Makefile. 2022-04-01 21:41:07 -05:00
Calvin Rose
5811b47aad Merge pull request #942 from Techcable/patch-1
Correct version 1.21.1 in meson.build
2022-03-30 18:13:55 -05:00
Techcable
54e3db4d8c Correct version 1.21.1 in meson.build
This causes incorrect version meson compiles (including homebrew)
2022-03-29 23:13:09 -07:00
Calvin Rose
7491421c31 Release patch relase due to bad version bumping. 2022-03-27 11:21:24 -05:00
Calvin Rose
9d0da74347 Merge pull request #937 from cellularmitosis/clock1012
Mac clock shim not needed after 10.12
2022-03-23 13:02:03 -05:00
Jason Pepas
e9870b293f Remove unneeded includes 2022-03-21 21:28:13 -05:00
Jason Pepas
ab910d060b Move AvailabilityMacros.h import into util.c 2022-03-21 21:23:09 -05:00
Calvin Rose
b60ef68ac6 Prepare for 1.21.0 Release. 2022-03-21 20:30:32 -05:00
Jason Pepas
c9986936ed Mac clock shim not needed until 10.12 2022-03-21 20:20:20 -05:00
Calvin Rose
d77be46644 Fix master - check last change with stackn 2022-03-21 19:41:06 -05:00
Calvin Rose
3715d7a184 Auto update copyright date. 2022-03-21 18:22:59 -05:00
Calvin Rose
1c96c7163a Address #926 - enter the event loop from janet_dobytes or
janet_dostring.
2022-03-21 18:06:14 -05:00
Calvin Rose
9f733b25db Merge pull request #935 from jgarte/jgarte-patch-1
typo fix
2022-03-21 17:44:01 -05:00
Calvin Rose
1419a33b64 Merge pull request #936 from cellularmitosis/janetapple
Refactor __MACH__ to JANET_APPLE
2022-03-21 17:43:45 -05:00
Jason Pepas
f270739f9f Refactor __MACH__ to JANET_APPLE 2022-03-17 01:20:55 -05:00
jgart
e51a391286 typo fix 2022-03-12 17:54:44 -05:00
Calvin Rose
c815185574 Merge pull request #931 from saikyun/norm-neg
normalize zero without branching
2022-03-07 09:18:22 -06:00
Calvin Rose
8045e29a52 Merge pull request #932 from ishehadeh/feature/int-to-bytes
Add int/to-bytes: Serialize int/[su]64 to a buffer
2022-03-06 13:11:08 -06:00
Ian Shehadeh
bbb3e16fd1 int/to-bytes: return a buffer instead of a tuple
Buffers make more sense for this function because one of their primary
use cases is working with bytes.
The tuple implementation was an array of floats,  which is less
performant and ergonomic for common operations. (i.e: bit manipulation)

Buffers also have the advantage they are mutable, meaning the user
can write ints to an existing buffer.
2022-03-05 08:21:53 -05:00
Jona Ekenberg
3cd1657387 normalize zero without branching 2022-03-05 09:58:00 +01:00
Calvin Rose
d7ea122cf7 Fix #928 - Fix hashing of negative 0. 2022-03-04 21:20:20 -06:00
Ian Shehadeh
6aea7c7f70 add int/to-bytes
int/to-bytes unpacks the bytes of a 64-bit integer into a tuple.
2022-03-04 08:48:54 -05:00
Calvin Rose
56ba1d9cd3 Formatting cleanup. 2022-02-24 18:07:22 -06:00
Calvin Rose
408b03ae0d Merge pull request #924 from uvtc/patch-2
Update docs for `describe`
2022-02-24 18:04:51 -06:00
Calvin Rose
d94fd746af Merge pull request #923 from ishehadeh/feature/int64-unwrap
add `(int/to-number)`: convert int/s64 and int/u64 to a number
2022-02-24 18:03:48 -06:00
John Gabriele
dbd1316d1e Update docs for describe
closes #524
2022-02-23 00:36:24 -05:00
Ian Shehadeh
75845c0283 int/to-number: restrict input to JANET_INTMAX/MIN
Previously int/to-number would fail if the input was outside
the range of an int32.
Because Janet numbers are doubles,
they can safely store larger ints than an int32.
This commit updates int/to-number to restrict the
value to the range of integers a double can hold, instead of an int32.
2022-02-21 12:54:38 -05:00
Ian Shehadeh
88db9751d7 add int/to-number: converts s64 and u64 to numbers
(int/to-number value) converts an s64 or u64 to a number.
It restricts the value to the int32 range,
so that `int32?` will always suceeded when called on the result.
2022-02-20 16:16:52 -05:00
Calvin Rose
6f645c4cb7 Update CHANGELOG.md 2022-02-12 11:04:24 -06:00
Calvin Rose
4e31d85349 Address #804 - save and restore module cache when flychecking.
Calling flychecking cannot change the module cache.
2022-02-12 10:36:45 -06:00
Calvin Rose
de542a81c0 Merge branch 'master' of github.com:janet-lang/janet 2022-02-11 20:38:10 -06:00
Calvin Rose
461576e7a2 Add defdyn macro to allow docs and checking for dyns.
Using keywords for the names of dynamic bindings emphasized their
dynamic nature and how they actually work, but is opaque when it comes
to documentation and error detection. Janet uses early binding for name
resolution by default in most places, dyns should be no different.

The `defdyn` macro allows one to create aliases for keywords that can
have docstrings, be imported and exported, etc. The aliases _must_
follow the usual lisp convention of earmuffs - this is not
restricting since the underlying keyword lookup mechanism is still
completely accessible to users.

Example:

(defdyn *my-dynamic-binding* "Sends the plumbus to the thingamizer when
 enabled")

The above creates a normal binding (as created with `def`) for
`*my-dynamic-binding*` that is bound to the keyword
`:my-dynamic-binding`.

There is an optional prefix for defdyns that can be used to avoid name
collisions - *defdyn-prefix*

Example:

(setdyn *defdyn-prefix* "mylib/")
(defdyn *my-dynamic-binding* "Plumbus thingamizer")
(pp *my-dynamic-binding*)

> :mylib/my-dynamic-binding
2022-02-11 20:37:52 -06:00
Calvin Rose
21bd62b1ce Merge pull request #922 from paulsnar/paulsnar/ev-fix-timeout-pruning
ev: Fix timeout pruning logic
2022-02-11 20:07:51 -06:00
paulsnar
838cd1157c ev: Fix timeout pruning logic 2022-02-11 09:25:23 +02:00
Calvin Rose
2f068b91d8 Mark a fiber as a root fiber during scheduling, not resumption.
This is more intuitive and avoids the possibilty of strange code
to resume or cancel a fiber after it was scheduled but before it was
entered for the first time.
2022-02-10 17:40:08 -06:00
Calvin Rose
aba87bf1bd MSVC unwilling to concatenate strings across preprocessor directives. 2022-02-09 22:36:37 -06:00
Calvin Rose
e64da8ede4 Update CHANGELOG.md 2022-02-09 22:31:27 -06:00
Calvin Rose
a9f38dfce4 Address #920 - fiber cancellation can hang event loop.
The main issue was cancellation of fiber using `cancel` rather than
`ev/cancel` could cause issues with the event loop internal ref count.
Since this is almost certainly bad usage (and is not something I want to
encourage or support), we will warn against trying to resume or error
fibers that have already been suspended or scheduled on the event loop.
The distinction between "task" fibers and normal fibers is now kept by a
flag that is set when a fiber is resumed - if it is the outermost fiber
on the stack, it is considered a root fiber. All fibers scheduled with
ev/go or by the event loop are root fibers, and thus cannot be cancelled
or resumed with `cancel` or `resume` - instead, use `ev/cancel` or
`ev/go`.
2022-02-09 22:16:49 -06:00
Calvin Rose
a097537a03 Fix #919 - strange quasiquote behavior.
Nested expression in the quasiquote were being compiled with the "hint"
flag passed to the expression compilation, essentially telling the
compiler to put intermediates into the final slot, possibly overwriting
other intermediate values. This fix removes that flags on any recursive
calls to quasiquote.
2022-02-09 20:31:10 -06:00
Calvin Rose
66e0b53cf6 Merge pull request #918 from paulsnar/paulsnar/shell-read-intr
Handle interrupts during `read` properly in mainclient
2022-02-04 22:39:22 -06:00
paulsnar
06f2e81dd5 shell: Handle EINTR on long reads
Many system I/O operations can fail due to being interrupted by a
signal. In the REPL's case, this poses a problem because in most cases
it's assumed that a read error is not recoverable and is equivalent to
EOF. This, however, is not the case for EINTR, in which case the I/O
should be tried again.

This commit fixes the most egregious violations of this, notably the
line getters, which would otherwise make the REPL exit on any signal,
even if the signal was caught and processed outside the REPL's purview.
2022-02-04 02:31:40 +02:00
Calvin Rose
40ae2e812f Prepare for 1.20.0 release. 2022-01-27 21:38:07 -06:00
Calvin Rose
06f613e40b Update signature of :missing-symbol hook.
don't take env table as explicit argument - it is already available
as the env table of the fiber.
2022-01-27 21:24:01 -06:00
Calvin Rose
61c8c1e8d2 Merge pull request #914 from pyrmont/feature.missing-symbols
Support looking up missing symbols during compilation
2022-01-24 18:16:53 -06:00
Michael Camilleri
ee924ee310 Fix declaration error in switch statement 2022-01-24 11:16:35 +09:00
Michael Camilleri
fad0ce3ced Move missing symbol lookup to compiler 2022-01-24 11:08:33 +09:00
Michael Camilleri
d396180939 Avoid panicking when calling :missing-symbol lookup function 2022-01-23 17:29:52 +09:00
Calvin Rose
0d089abe67 Update CHANGELOG.md 2022-01-22 19:38:08 -06:00
Michael Camilleri
ed5c1dfc3c Remove :modules dynamic binding 2022-01-23 01:54:58 +09:00
Calvin Rose
6b949a7375 Merge branch 'master' of github.com:janet-lang/janet 2022-01-21 17:16:29 -06:00
Calvin Rose
3028e2908f Avoid possible infinite loop in rest destructuring. 2022-01-21 17:16:06 -06:00
Calvin Rose
578803b01f Merge pull request #915 from AlbertoGP/master
Add ppc64 to os/arch
2022-01-21 16:44:59 -06:00
Calvin Rose
46738825c0 Fix formating on master. 2022-01-21 16:44:11 -06:00
Calvin Rose
56357699cb Merge pull request #913 from ishehadeh/feature/destructuring-rest
Support for `& rest` pattern in destructure and match
2022-01-21 16:39:35 -06:00
Alberto González Palomo
fe8e718183 Add ppc64 to os/arch
Same as #431 (Add ppc to os/arch) but for the 64-bit version.
This is tested on a Power9 CPU in Little-Endian mode, on Linux.
2022-01-21 23:08:57 +01:00
Michael Camilleri
1eb34989d4 Support looking up missing symbols during compilation 2022-01-21 13:07:11 +09:00
Michael Camilleri
2f3b4c8bfb Consolidate related tests 2022-01-21 13:02:56 +09:00
Ian Shehadeh
6412768000 Add match documentation for & rest pattern 2022-01-20 09:19:21 -05:00
Ian Shehadeh
82688b9a44 add checks to & _ pattern in match macro
This commit adds 2 checks for & rest pattern in the match macro:
- & is followed by exactly 1 item
- & is followed by a symbol
2022-01-20 09:16:02 -05:00
Ian Shehadeh
651e12cfe4 test nested '& destructure and empty rest array
This commit adds two new tests for destructure patterns with '&:
- Test that the rest array can be empty
- Test that & can be nested
2022-01-20 08:54:56 -05:00
Ian Shehadeh
4118d581af error if '& is followed by 2+ items in destructure
The current destructure pattern ends when '& is encountered.
This commit adds an error if it is followed by more than
a symbol to bind the array to.

Although its not critical since the extra items can be ignored,
they're a sign of some kind of mistake so its best to complain.
2022-01-20 08:52:37 -05:00
Ian Shehadeh
62608bec03 use janet_checktype over janet_type and ==
In destructure janet_type(_) == JANET_SYMBOL was used to check if a
value was a symbol.
This commit replaces that with the janet_checktype function,
because that function is used for the same purpose in other places.
2022-01-20 08:12:05 -05:00
Ian Shehadeh
71cffc973d add test: destructure with a nested tuple before &
This test ensures rest patterns work when
preceded by a more complicated pattern.
2022-01-19 14:01:28 -05:00
Ian Shehadeh
a8e49d084b add checks for & _ destructuring pattern
This commit adds three checks to ensure & rest patterns are valid:
1. When checking for '& ensure the value is a symbol before unwrapping
2. Make sure '& is followed by a value
3. Make sure the value following '& is a symbol
2022-01-19 13:55:05 -05:00
Ian Shehadeh
db631097b1 add support for & _ to match macro
This commit adds support for using & _ syntax to bind the remaining
values in an array in the match macro.

The commit also adds a few tests for the new syntax in suite0008
2022-01-19 13:29:34 -05:00
Ian Shehadeh
0d31674166 remove debug print in test suite0001 2022-01-19 12:49:02 -05:00
Ian Shehadeh
cb5af974a4 POC "rest" pattern in destructuring
Add support for using [& rest] to match the remaining values
in an array or tuple when destructuring.

the rest pattern is implemented by pushing remaining values in the
rhs to the stack once & is found on the lhs.
Then tuple is called and the result is assigned
to the next symbol on the lhs.

This commit DOES NOT implement handling for malformed patterns.
2022-01-15 14:51:44 -05:00
Calvin Rose
f2f421a0a2 Merge pull request #910 from pyrmont/bugfix.redefinable-macros
Fix redefinable macros
2022-01-14 07:45:54 -06:00
Michael Camilleri
413c46e2ee Fix redefinable macros 2022-01-14 17:15:42 +09:00
Calvin Rose
3b412d51f0 Merge pull request #909 from ishehadeh/master
correct stack frame table keys in debug/stack doc
2022-01-09 12:01:05 -06:00
Ian Shehadeh
4931e2aee2 correct stack frame table keys in debug/stack doc
doc for debug/stack listed :column and :line as keys in the frame table.
But doframe actually sets :source-column and :source-line.
2022-01-08 16:25:43 -05:00
Calvin Rose
ffadf673cf Merge branch 'master' of github.com:janet-lang/janet 2022-01-08 11:27:48 -06:00
Calvin Rose
5b5a7e5a24 Make top level vars reuse ref cell when redefined at the top level.
This improves the repl experience while not messing with existing code
very much, if at all.
2022-01-08 11:27:08 -06:00
Calvin Rose
ab53208f47 Merge pull request #908 from ishehadeh/master
Windows: Fix `ev/read` hanging when called on stream from `os/open`
2022-01-08 11:26:48 -06:00
Calvin Rose
7c407705e8 Merge pull request #907 from pyrmont/bugfix.redefs-typo
Fix 'redefs' typo in test suite
2022-01-08 10:51:17 -06:00
Ian Shehadeh
60378ff941 windows: fix ev/read hang when called on fs stream
handles returned by CreateFileA and FILE_FLAG_OVERLAPPED
support reading from arbitrary offsets.
The offset is passed to ReadFile in through the OVERLAPPED structure.
Since state->overlapped is zeroed ev_machine_read
ReadFile would always read from the start of the file and never finish

This commit changes ev_machine_read to update the offset to
the number of bytes read before calling ReadFile.
2022-01-07 16:32:39 -05:00
Michael Camilleri
30a0c77d19 Fix 'redefs' typo in test suite 2022-01-07 13:28:22 +09:00
Calvin Rose
07ec89276b Disable file read test to help CI. 2022-01-06 20:52:21 -06:00
Calvin Rose
a37dc1af9d Merge branch 'redefs-work'
- Change the global binding name from :redefs to :redef
- Simplify internal representation of "redefinable bindings"
- Store "redefinable bindings in :ref rather than :value inside the
  environment entries. This makes such bindings more like vars that
  can't be set rather than defs.
2022-01-06 20:45:20 -06:00
Calvin Rose
03458df140 Merge pull request #898 from pyrmont/feature.redefs
Support redefinable `def` and `defmacro` bindings using `:redef`
2022-01-06 20:44:18 -06:00
Calvin Rose
164eb9659e Merge pull request #905 from ishehadeh/master
Fix typo in janet_epoll_sync_callback, add test for "async" read from normal fd
2022-01-06 20:43:48 -06:00
Calvin Rose
99cfbaa63b Tweaks on redef feature branch. 2022-01-06 20:38:15 -06:00
Ian Shehadeh
8d8a6534e3 add test for calling ev/read on normal fd
The test is almost identical to the os/open + :write test.
The only difference is the content is read back in with :read, not slurp
2022-01-06 19:35:30 -05:00
Ian Shehadeh
938c5013c9 fix typo in janet_epoll_sync_callback
JANET_ASYNC_LISTEN_WRITE was checked instead of JANET_ASYNC_EVENT_READ.
This caused ev/read to hang if it was called on a normal fd.
2022-01-06 19:33:34 -05:00
Michael Camilleri
ea9d5ec793 Change metadata keyword back to :redef 2022-01-02 12:35:22 +09:00
Michael Camilleri
ec65f038a8 Support :dynamic-defs dynamic binding 2021-12-29 16:39:00 +09:00
Calvin Rose
199ec36d40 Merge pull request #902 from sogaiu/tweak-match-doc
Tweak match docstring
2021-12-25 07:41:58 -06:00
sogaiu
1326ded048 Tweak match docstring 2021-12-25 16:56:10 +09:00
Michael Camilleri
8347439644 Support redefinable bindings 2021-12-18 13:05:16 +09:00
Calvin Rose
cddc2a8280 Merge pull request #896 from pyrmont/bugfix.run-context-current-file
Only set :current-file in run-context if source is a path
2021-12-16 17:19:48 -06:00
Michael Camilleri
97a8938407 Ensure value is of specified type or panic 2021-12-15 12:17:35 +09:00
Michael Camilleri
939d1dcae9 Only set :current-file in run-context if source is a path 2021-12-13 12:06:58 +09:00
Calvin Rose
9d5cc5c11f Proper locking on select. 2021-12-09 18:59:59 -06:00
Calvin Rose
d998f24d26 Merge branch 'master' of github.com:janet-lang/janet 2021-12-09 18:47:36 -06:00
Calvin Rose
d543f8857b Fix #892 - Remove racy ref counts for channels
Rather than manual reference counting for suspended fibers, we
automate the process by incrementing "extra_listeners" every time
we suspend a fiber in the event loop, and decrement when that fiber
is resumed. In this manner, we keep track of the number of suspending
fibers in a simpler, more correct way.
2021-12-09 18:44:55 -06:00
Calvin Rose
c48a942d22 Merge pull request #893 from pyrmont/docs.nested-loops
Clarify nested loop behaviour in loop macro
2021-12-09 14:09:59 -06:00
Calvin Rose
e1602618c3 Merge pull request #894 from pepe/fix-numarray-example
Improve numarray example
2021-12-09 14:09:11 -06:00
Calvin Rose
36be240623 Merge pull request #895 from pepe/add-path-to-async-execute-example
Add search on PATH for async execute example
2021-12-09 14:08:53 -06:00
Josef Pospíšil
04e499c97f Add search on PATH for async execute example 2021-12-09 11:57:21 +01:00
Josef Pospíšil
f586a8a9dc Add length to method and lib fn to numarray 2021-12-09 11:18:05 +01:00
Josef Pospíšil
5112ed77d6 Fix test import, and add sum as library fn too 2021-12-09 11:12:08 +01:00
Michael Camilleri
bf29a54272 Clarify nested loop behaviour in loop macro 2021-12-09 10:41:56 +09:00
Calvin Rose
6d9286a202 Add some more changes to hashing to improve pointer hashing. 2021-12-07 08:36:08 -06:00
Calvin Rose
92fdd07ca3 Address #889 - Switch high and low bits of part of number hash (Knuth's multiplicative hash)
Also make sure we weren't throwing away 3 bits of entropy.
2021-12-07 08:24:04 -06:00
Calvin Rose
1c937ad960 Prepare for 1.19.2 release. Update CHANGELOG.md 2021-12-06 17:27:09 -06:00
Calvin Rose
f9891a5c04 More improvements to hashing for #889 2021-12-06 17:23:00 -06:00
Calvin Rose
e8ad311d84 Don't use janet_stacktrace anymore.
Behavior of janet_stacktrace_ext is more consistent.
2021-12-06 08:51:40 -06:00
Calvin Rose
545c09e202 Update hash mixing behavior - address #889
Try to have better behavior when mixing sub-hashes that are not uniform and
randomly distributed. Premultiply by a large prime before mixing to
"spread entropy" if it is concentrated in a certain subset of bits.
2021-12-05 16:34:26 -06:00
Calvin Rose
4dc281a05f Prepare for 1.19.1 release. 2021-12-04 13:34:41 -06:00
Calvin Rose
3a0af8caad Update changelog.md 2021-12-04 13:28:35 -06:00
Calvin Rose
8ff2fecb26 Update readme. 2021-12-04 13:25:02 -06:00
Calvin Rose
1855c6aed5 Remove appveyor. 2021-12-04 13:23:34 -06:00
Calvin Rose
d4c6643311 Merge branch 'master' of github.com:janet-lang/janet 2021-12-04 13:03:33 -06:00
Calvin Rose
e8c738002b Add extra "prefix" parameter to debug/stacktrace. 2021-12-04 13:03:05 -06:00
Calvin Rose
309c3aaeb8 Merge pull request #867 from pyrmont/feature.custom-out-functions
Support sending output to a function
2021-12-04 11:17:58 -06:00
Calvin Rose
1f8bcadb3b Update changelog.md 2021-12-04 11:11:57 -06:00
Calvin Rose
6f4af5fef8 Merge branch 'master' of github.com:janet-lang/janet 2021-12-04 10:28:16 -06:00
Calvin Rose
868cdb9f8b Fix channel packing bug. 2021-12-04 10:28:00 -06:00
Calvin Rose
2f76a429ef Merge pull request #886 from Grazfather/patch-1
map: Fix indexing for 3+ data structures
2021-12-04 08:03:33 -06:00
Grazfather
a69799aa42 Add tests for mapping different length sequences 2021-12-03 20:47:48 -05:00
Grazfather
139bef2142 map: Fix indexing for 3+ data structures 2021-12-03 16:15:43 -05:00
Calvin Rose
8ba142bcf4 Merge branch 'master' of github.com:janet-lang/janet 2021-11-30 14:19:10 -06:00
Calvin Rose
c49e4966f6 Update to dev versions. 2021-11-30 14:19:03 -06:00
Calvin Rose
516fa4e49d Merge pull request #883 from pyrmont/feature.netrepl-relative-imports
Update location of current file in run-context
2021-11-30 14:17:34 -06:00
Michael Camilleri
6bf9f89429 Update location of current file in run-context 2021-11-29 10:05:04 +09:00
Calvin Rose
a0ddfcb109 Prepare for 1.19.0 release. 2021-11-27 10:00:36 -06:00
Calvin Rose
3df7921fdc Don't call wait twice when closing or gcing. 2021-11-27 09:05:43 -06:00
Calvin Rose
6172a9ca2d Merge branch 'master' of github.com:janet-lang/janet 2021-11-26 18:44:33 -06:00
Calvin Rose
4a40e57cf0 Fix leaking file descriptors to subprocess causing hangs. 2021-11-26 18:44:11 -06:00
Calvin Rose
cdedda4ca1 Merge pull request #880 from pepe/gamma-fix
Fix math/gamma and add math/log-gamma
2021-11-26 12:34:54 -06:00
Josef Pospíšil
e6babd84f7 Fix math/gamma and add math/log-gamma 2021-11-24 10:55:32 +01:00
Calvin Rose
868ec1a7e3 Add test case for missing struct proto 2021-11-23 23:17:24 -06:00
Calvin Rose
e08394c870 Fix struct proto missing when making a struct with a nil value. 2021-11-23 23:16:06 -06:00
Calvin Rose
a99500aebf Update suite0009 assert again. 2021-11-18 20:46:26 -06:00
Calvin Rose
aa5095c23b Update assert message in suite0009 2021-11-18 20:39:29 -06:00
Calvin Rose
9e0f36e5a7 Fix unused variable warnings. 2021-11-18 20:35:41 -06:00
Calvin Rose
d481d079ba Try bsd fix. 2021-11-18 20:30:06 -06:00
Calvin Rose
bc9ec7ac4a Fix unitialized memory access in net/ module. 2021-11-18 20:10:10 -06:00
Calvin Rose
6f7e81067c Address #876 Don't allow scheduling a fiber once it has been canceled already.
We were effectively cancelling the cancellation.
2021-11-18 20:06:29 -06:00
Calvin Rose
af946f398e Turn off raw mode in shell on ctrl-C. 2021-11-18 19:58:52 -06:00
Calvin Rose
c7ca26e9c7 Merge branch 'master' of github.com:janet-lang/janet 2021-11-18 19:04:43 -06:00
Calvin Rose
ef7129f45d Address #874 - Call waitpid on waiter thread with WNOWAIT.
This doesn't destory the pid until the original thread decides to
call waitpid again. Since the pid is exposed in the C API and now
in the Janet API, we don't want to destroy it until we are ready.
2021-11-18 19:03:08 -06:00
Calvin Rose
a20bdd334a Merge pull request #873 from andrewchambers/procsig
Use kill instead of raise for SIGINT.
2021-11-15 07:44:30 -06:00
Andrew Chambers
2ef49a92cc Use kill instead of raise for SIGINT.
Raise signals can only be handled by the current thread while
kill signals can be handled by background threads.
2021-11-15 20:38:23 +13:00
Calvin Rose
75f56b68c6 Merge pull request #872 from jgarte/jgarte-patch-aesthetics
Typo fix
2021-11-14 14:03:21 -06:00
jgart
d34d319d89 Typo fix 2021-11-14 14:19:04 -05:00
Calvin Rose
6660c1da38 Don't truncate test output on failures. 2021-11-12 20:06:28 -06:00
Michael Camilleri
4e263b8c39 Support using functions with :out dynamic binding 2021-11-13 01:42:44 +09:00
Calvin Rose
3cb604df02 Merge pull request #870 from andrewchambers/exposepid
Expose process :pid on unix like platforms.
2021-11-12 08:20:39 -06:00
Calvin Rose
af9dc7a69e Merge pull request #869 from andrewchambers/typo2
Fix os/proc-kill doc typo.
2021-11-12 08:20:00 -06:00
Calvin Rose
1247e69c78 Merge pull request #868 from andrewchambers/sigint
Allow C code to block SIGINT.
2021-11-12 08:19:43 -06:00
Andrew Chambers
aab0e4315d Expose process :pid on unix like platforms.
This at least means users can use something like jsys
or the kill command to signal processes when they want
to send unsupported signals (like SIGTERM).
2021-11-12 23:43:36 +13:00
Andrew Chambers
14f6517733 Fix os/proc-kill doc typo. 2021-11-12 23:29:13 +13:00
Andrew Chambers
5d75effb37 Allow C code to block SIGINT.
Previously the repl always exits on SIGINT, this change
means the repl will only exit on SIGINT if the SIGINT handler
causes it to exit.
2021-11-12 23:24:33 +13:00
Calvin Rose
ab4f18954b Merge pull request #866 from pyrmont/fix.example-urlloader
Fix URL loader example to use os/spawn
2021-11-11 14:55:24 -06:00
Michael Camilleri
e1460c65e8 Fix URL loader example to use os/spawn 2021-11-11 17:33:25 +09:00
Calvin Rose
425a0fcf07 Add quoted literal support in the match macro. 2021-11-08 15:33:11 -06:00
Calvin Rose
7205ee5e0a Update test output. 2021-11-06 19:29:15 -05:00
Calvin Rose
72c5db8910 Update test suite to better distinguish functional errors with
localname/peername.
2021-11-06 19:19:49 -05:00
bakpakin
3067f4be3a Address #815 - gc mark issue in windows accept state machine.
We were casting a pointer to the wrong type, which caused all sorts of
wonderful chaos, but only on windows and only when the garbage collector
ran after setting up a server in a specific configuration. We were
casting a closure pointer to an abstract type during the mark phase,
        which resulted in memory corruption.
2021-11-06 17:50:54 -05:00
Calvin Rose
2aa1ccdd76 Update test helper to be even les noisy. 2021-11-06 11:20:09 -05:00
Calvin Rose
0284df503f Make test output less verbose 2021-11-06 11:01:21 -05:00
Calvin Rose
2833a983d8 Merge pull request #860 from sogaiu/short-fn-docstring-tweak
Tweak short-fn docstring
2021-11-04 19:39:55 -05:00
Calvin Rose
39c6be7cb7 Fix #861 - parser/produce caused state to be invalid for parser/state.
parser/produce was leaving a counter in the root state undecremented.
2021-11-04 19:38:37 -05:00
sogaiu
fdc94c1353 Tweak short-fn docstring 2021-11-04 18:11:53 +09:00
Calvin Rose
9cc4e48124 Update changelog and allow evaluating streams with dofile. 2021-10-30 14:43:06 -05:00
Calvin Rose
34c7f15d6d Always return port in peername and localname 2021-10-30 10:56:40 -05:00
Calvin Rose
899a9b025e Merge branch 'struct-proto' 2021-10-30 09:31:22 -05:00
Calvin Rose
deb4315383 Fix parse.c parser/state :args 2021-10-30 09:30:56 -05:00
Calvin Rose
9a06660fdb fix call to table/proto-flatten 2021-10-30 09:15:23 -05:00
Calvin Rose
5c35d24e13 Fix nil check issue. 2021-10-29 19:29:54 -05:00
Calvin Rose
03f99752a7 Merge branch 'master' into struct-proto 2021-10-29 16:42:34 -05:00
Calvin Rose
fd37567c18 Docstring fix. 2021-10-29 11:13:07 -05:00
Calvin Rose
6e38bf1578 Use more inclusive check for the %j formatter for valid symbols.
We did not allow arbitrary utf8 to be printed with %j, even though the parser
allows. Thos changes uses the existing built in utf8 detectiotion to
exclude only unprintable symbols from the docstring.
2021-10-29 11:08:53 -05:00
Calvin Rose
8b2d278840 Add min-of and max-of. 2021-10-26 17:46:24 -05:00
Calvin Rose
06aa0a124d Add math/gcd and math/lcm to the core. 2021-10-24 11:43:07 -05:00
Calvin Rose
eb4595158d Allow compiling tables as peg grammars. 2021-10-23 09:59:36 -05:00
Calvin Rose
32103441f1 Merge pull request #850 from pyrmont/bugfix.anonymous-union
Use named union in JanetGCObject
2021-10-22 07:56:38 -05:00
Michael Camilleri
7ed0aa6630 Use named union in JanetGCObject 2021-10-22 09:52:57 +09:00
Calvin Rose
f690229f31 Merge pull request #848 from pyrmont/bugfix.uname-switches
Fix error for uname switch -o on macOS
2021-10-21 18:17:41 -05:00
Michael Camilleri
f3bab72a86 Add comment to explain Linux check in Makefile 2021-10-21 14:23:23 +09:00
Michael Camilleri
2bd63c2d27 Fix error for uname switch -o on macOS 2021-10-21 14:13:51 +09:00
Calvin Rose
545d9e85e9 Update CHANGELOG.md 2021-10-20 19:57:02 -05:00
Calvin Rose
21a4ab4ec7 Hang forever instead of exit early on channel deadlock.
While not technically needed, the behavior is more intuitive and will
prevent people from writing bad scripts.
2021-10-20 19:53:29 -05:00
Calvin Rose
66fbbeb5ec Why is the copyright gone... 2021-10-20 18:05:32 -05:00
Calvin Rose
55879c7b6d Fix checked for fiber being dead. 2021-10-19 09:03:24 -05:00
Calvin Rose
66c4e5a5e2 Prepare for patch release. 2021-10-16 15:05:48 -05:00
Calvin Rose
884139e246 Merge pull request #843 from jgarte/jgarte-patch-typo
Fix typo in docstring
2021-10-16 12:51:45 -05:00
Calvin Rose
c3d7b1541e Merge branch 'master' into jgarte-patch-typo 2021-10-16 12:51:38 -05:00
Calvin Rose
51ada4d70b Merge pull request #840 from bradms/android-termux
Support Android (termux)
2021-10-16 12:50:24 -05:00
jgart
e3a5d52c5e Fix typo in docstring 2021-10-16 11:48:59 -04:00
Brad Svercl
559fd70737 Add android-spawn to meson.build if found 2021-10-15 21:39:03 -05:00
Brad Svercl
e0dba85cbb Support Android (termux) 2021-10-14 21:18:35 -05:00
Calvin Rose
74c9cf03d0 Fix -r switch in repl 2021-10-14 17:25:12 -05:00
Calvin Rose
0774e79e4f Pass non-blocking pipes to subprocesses on non-windows platform. 2021-10-14 13:57:51 -05:00
Calvin Rose
a3ec37741a Merge pull request #835 from MorganPeterson/update-string-docs
Updated string/bytes docs to reflect return value as tuple
2021-10-12 00:22:50 -05:00
MorganPeterson
9bf5cd83c3 updated string/bytes docs to reflect return value as tuple 2021-10-11 13:45:31 -04:00
Calvin Rose
f0da793f99 Prepare for 1.18.0 release 2021-10-10 09:27:31 -05:00
Calvin Rose
684f3ac172 Add optional base to scan-number. 2021-10-10 09:07:56 -05:00
Calvin Rose
3e5bd460a5 Add line/col info to parse error in janet_[dobytes, dostring] 2021-10-08 09:25:00 -05:00
Calvin Rose
3b1d787fbe Address #829 - Set state->event inside linked list traversal for epoll. 2021-10-08 08:35:47 -05:00
Calvin Rose
980f55ff69 Merge pull request #828 from sogaiu/add-argument-to-janet-panicf-call
Add argument to some janet_panicf calls
2021-10-08 08:23:55 -05:00
sogaiu
52ed68bfeb Add argument to janet_panicf call (2) 2021-10-07 20:58:50 +09:00
sogaiu
be0d4c28e4 Add argument to janet_panicf call 2021-10-07 16:38:40 +09:00
Calvin Rose
79807bf2ab Merge pull request #827 from sogaiu/tweak-format-strings
Tweak format strings
2021-10-06 17:48:53 -05:00
Calvin Rose
e48ca1a03f Merge pull request #826 from rick2600/fix-uaf-cfun_array_concat
fix issue #825
2021-10-06 17:48:27 -05:00
sogaiu
eae18ce973 Tweak format strings 2021-10-06 20:34:33 +09:00
rick2600
591344ca9d fix issue #825 2021-10-05 01:45:59 -03:00
Calvin Rose
fbe067823e Merge pull request #824 from GrayJack/rnd-double-capi
Expose `janet_rng_double` to the C API
2021-10-04 13:54:10 -05:00
GrayJack
ffece911e6 Expose janet_rng_double to the C API 2021-10-03 00:52:34 -03:00
Calvin Rose
186afa9651 Merge pull request #823 from llmII/fix-kqueue-hang
Fix #822 - kqueue hang in suite 9.
2021-09-30 10:50:04 -05:00
llmII
6b3037106a Fix #822 - kqueue hang in suite 9.
Priorly we only checked exactly one state when an event was received.
This was incorrect. A state may have a next state, an action to take
after the first in the list of states has been taken. This change
acknowledges that and makes the code work with the state list vs just
the head of the list.
2021-09-30 06:56:09 -05:00
Calvin Rose
1bf22288ee Merge pull request #821 from llmII/fix-kqueue
Fix #819 timeouts under kqueue on FreeBSD broken
2021-09-29 15:51:46 -05:00
llmII
3cec470f25 Change the way timeouts work in kqueue.
Don't use a timer filter, just set the timeout on each call to kevent.
Should hopefully work around the 1ms minimum on NetBSD and be possibly
more performant.
2021-09-29 15:19:30 -05:00
llmII
e1ec0d13ae Fixing kqueue under the BSDs.
FreeBSD is the only BSD supporting ABSTIME timers, whereas the rest
demand intervals. Janet operates on timestamps, which are absolute
times, as per ABSTIME. The idea was to use that under FreeBSD but not
the other BSDs. This commit changes that since ABSTIME breaks when the
timeout supplied is for a time prior to whatever the time is
now (invalid argument). We now utilize the same logic we use on the
other BSDs with FreeBSD to effect interval timeouts since intervals are
absolutely sometime beyond now, be it now and less than a millisecond,
or more than a millisecond. This will hopefully unbreak BSD builds when
running the test suite.
2021-09-28 17:40:38 -05:00
bakpakin
924fe97fc3 Address #820 - ev/cancel to work on already scheduled fibers. 2021-09-28 15:42:16 -05:00
bakpakin
504411eade Update suite 009 to do read and write in parallel. 2021-09-28 12:05:28 -05:00
Calvin Rose
038ca1b9ca Update README.md 2021-09-27 21:20:06 -05:00
Calvin Rose
544b192f8c Fix bad docstring change. 2021-09-25 14:32:23 -05:00
Calvin Rose
7748ccdb8e Fix network byte order port. 2021-09-25 14:31:19 -05:00
Calvin Rose
64e29c6fce More simplification and removal of macros. 2021-09-25 13:53:27 -05:00
Calvin Rose
acdf097998 Refactor of peername and localname to be much more direct.
Also remove a lot of overly general code from cqueues. Janet has more
opinionated error handling so we can avoid a lot error propagation code.
2021-09-25 13:38:36 -05:00
Calvin Rose
ba3107c1fa Merge branch 'master' of github.com:janet-lang/janet 2021-09-21 18:03:25 -05:00
Calvin Rose
9985f787eb Add custom base option to number peg combinator.
Allows parsing custom bases without needed Janet specific prefixes.
2021-09-21 18:02:42 -05:00
Calvin Rose
d6f41bcf98 Merge pull request #811 from sogaiu/use-deprecation-mechanism-for-file-popen
Apply deprecation machinery to file/popen
2021-09-21 15:16:20 -05:00
Calvin Rose
50bced49ad Merge branch 'master' into use-deprecation-mechanism-for-file-popen 2021-09-21 15:15:36 -05:00
Calvin Rose
4fd7470bbf Remove accidental limit on max read size. 2021-09-21 09:55:40 -05:00
Calvin Rose
033c6f1fdb Add -i flag to run .jimage files as scripts. 2021-09-19 19:47:57 -05:00
Calvin Rose
6c58347916 Remove thread module.
Instead, use the more general and non-blocing `ev/` module.
2021-09-19 14:19:32 -05:00
Calvin Rose
cccbdc164c Add (number combinator to peg).
This allows using Janet's number parser without creating
intermediate strings.
2021-09-19 13:02:16 -05:00
Calvin Rose
cea14a6869 Fix typo in changelog. 2021-09-19 00:16:08 -05:00
Calvin Rose
9b4b24edf7 Prepare for 1.17.2 release. 2021-09-18 13:42:26 -05:00
Calvin Rose
8b10a5fb7c Format and update CHANGELOG.md 2021-09-18 13:40:32 -05:00
Calvin Rose
b0d0d9cad2 Address #809 - treat first docstring line different from others.
Only do this if the docstring starts with an open parentheses.
2021-09-18 12:41:11 -05:00
sogaiu
d5c8eb048a Apply deprecation machinery to file/popen 2021-09-18 17:08:56 +09:00
Calvin Rose
9abee3f29a Add semi-colon. 2021-09-17 19:20:59 -05:00
Calvin Rose
bf9b6b1301 Avoid including windows.h in janet.h for JanetOSMutex. 2021-09-17 16:59:50 -05:00
Calvin Rose
8cd57025a0 Add makefile var to fix jpm to a tag/branch 2021-09-17 16:38:11 -05:00
Calvin Rose
faf60b6b1f Pass DESTDIR directly to jpm bootstrap script. 2021-09-16 18:36:29 -05:00
Calvin Rose
da2c1be49c Fix #801 threaded abstract cyclic references in marshalling.
We forgot to mark threaded abstract types as "seen" when marshalling so
we would mistakenly marshal them twice. This messed up unmarshalling.
2021-09-14 21:12:02 -05:00
Calvin Rose
92c02449f4 Merge pull request #800 from marler8997/fixUbInGC
add NULL check in gc.c to avoid UB
2021-09-14 16:04:12 -05:00
Jonathan Marler
e381622a9a add NULL check in gc.c to avoid UB
After the UB was fixed in value.c, I tried running the build again and encoutered another instance of UB in gc.c.  With this fixed I can now build janet with ubsan enabled, meaning there's no more UB encountered in janet_boot during the build.
2021-09-11 19:50:52 -06:00
bakpakin
b799223ebc Merge branch 'master' of github.com:janet-lang/janet 2021-09-11 10:34:22 -05:00
bakpakin
40ef224a95 Update test code. 2021-09-11 10:34:08 -05:00
Calvin Rose
a4c20b6e1c Merge pull request #797 from sogaiu/math-nan-doc-tweak
Tweak math/nan docstring
2021-09-11 09:13:38 -05:00
sogaiu
e6ee867f72 Tweak math/nan docstring 2021-09-11 16:54:35 +09:00
bakpakin
468a31f515 Address #795 - add NULL check to avoid UB 2021-09-09 07:20:26 -05:00
bakpakin
4d746794cc Merge branch 'bindport' 2021-09-07 22:45:22 -05:00
bakpakin
02d2a66ef2 Merge branch 'master' of github.com:janet-lang/janet 2021-09-07 22:44:59 -05:00
Calvin Rose
4638baf545 Merge pull request #790 from llmII/feature-getsockname-getpeername
Work in progress - more socket functions
2021-09-07 22:44:40 -05:00
bakpakin
2be23d3768 Fix meson build. 2021-09-07 22:11:45 -05:00
bakpakin
b39b1746ba Support bindport. 2021-09-07 21:59:17 -05:00
bakpakin
24f97510b0 Fix incorrect code that created socket twice. 2021-09-07 20:51:33 -05:00
llmII
325d5399fa Code cleanup and attribution set.
All that is left is to test unix sockets.
2021-09-07 20:00:00 -05:00
Calvin Rose
d8f6fbf594 Merge pull request #789 from llmII/feature-bind-connect
Add bind option to net/connect
2021-09-07 18:47:17 -05:00
llmII
21b3e4052c Don't print stuff in tests, CI looks wacky 2021-09-07 17:21:10 -05:00
llmII
bf2928805e Had an extra plen definition, removed. 2021-09-07 17:03:34 -05:00
llmII
7d2bf334c8 Fix incorrect error when argv[3] is null
The `janet_get_addrinfo` function retained code that was meant for
compliance with 3 separate function signatures under a single function
name. Changing things to be a single function signature was broken until
the code pertaining to the aforementioned was stripped out.
2021-09-07 16:11:37 -05:00
llmII
7446802a70 Quit trying to make it 3 different functions
Prior commits was an attempt to make this one function adhere to 3
different function signatures! This puts an end to that and makes it
where it's a single function signature and if one wants to use the 4th
argument they'll need to explicitly set the 3rd argument (to nil for
default).
2021-09-07 14:56:13 -05:00
llmII
077bf5ebae Create test case for localname/peername 2021-09-07 07:12:43 -05:00
llmII
c9bef39f96 Make net/connect special
Keeps net/listen from being affected by changes necessary to make bind
on connect work (while keeping from breaking the API).
2021-09-07 05:40:48 -05:00
llmII
3740eadb7d Seeing if this fixes the last warnings for Windows 2021-09-06 19:57:56 -05:00
llmII
e29fa66a74 More Windows fixes 2021-09-06 19:42:45 -05:00
llmII
ca5406c8e4 More windows fixes
MSVC's output via appveyor is a little lacking in indication of all
issues so I'm hitting them as I can find them.
2021-09-06 19:31:16 -05:00
llmII
7217caacd1 Attempting some more windows related fixes. 2021-09-06 19:26:33 -05:00
Calvin Rose
8081082251 Merge pull request #785 from llmII/feature-kqueue
Add kqueue support to Janet
2021-09-06 18:42:05 -05:00
llmII
1597ca0de5 Cleanup code a bit
Inconsistent indentation and such fixed, superfluous newlines removed,
documentation of new functions.
2021-09-06 18:32:23 -05:00
llmII
8c938ceff9 Fix for Windows (possibly)
Windows does not have <arpa/inet.h> so only include it when not Windows.
2021-09-06 17:48:17 -05:00
llmII
65a6945ea5 Finalize peername and localname
Both now do the right thing and give back all information (host and
port) when possible as a tuple of (host port).
2021-09-06 17:35:49 -05:00
llmII
02640812af Add getsockname (net/localname) 2021-09-06 17:01:09 -05:00
llmII
ba761d5c35 Work in progress - more socket functions
When this is complete we'll have getpeername, getsockname and possibly
getpeerid in the net/* API.
2021-09-06 16:15:01 -05:00
llmII
48a3b1f07f Enable kqueue on MacOS
Make sure JANET_EV_KQUEUE is defined when JANET_APPLE is defined unless
disabled by configuration.
2021-09-06 16:01:06 -05:00
llmII
4370cb77e7 Update documentation.
Documenting the new bindhost parameter to net/connect.
2021-09-06 10:54:11 -05:00
llmII
470e8f6fc7 Reused address info struct incorrectly
Wrongly assumed that `ai` was done being used before binding, it's not,
so create a separate address info for binding...
2021-09-06 10:44:23 -05:00
llmII
b270d88427 More off by one error fixes 2021-09-06 10:12:36 -05:00
llmII
66ce247129 Fixing off by one indexing errors... 2021-09-06 10:01:16 -05:00
llmII
6ad016c587 Check type when getting socket type
janet_get_sockettype expects a keyword but we're making it optional that
the call to the functions that use it with arity >=3 will be guaranteed
to have it as a keyword value! If it's not a keyword then it's the same
as NULL.
2021-09-06 09:53:53 -05:00
llmII
532dac1b95 Check type instead of value
Primarily because trying to check the value results in a panic when the
value is not the type of value requested from the API. Also probably
cheaper and the previous idea of just getting the value then comparing
was pretty stupid (needed a string comparison... and was going to do
pointer comparison).
2021-09-06 09:48:29 -05:00
llmII
2a4bcc262f Don't bind when address info doesn't exist
Simple logic issue, something overlooked.
2021-09-06 09:06:40 -05:00
llmII
1ce2361daf Better error message in connect
Quick thing to help check when failing tests.
2021-09-06 09:02:56 -05:00
llmII
6e8584e8e0 Add bind option to net/connect
This will allow us to set the address we use for outgoing connections.

Builds, haven't checked it passes current tests, haven't checked it
actually works either.
2021-09-06 08:54:24 -05:00
llmII
121aa91139 Fixes for NetBSD (again)
Minimum interval for a timer must be 1 or more (or we get EINVAL) and
Janet fails tests and halts events that the programmer may still be
interested in.
2021-09-05 21:48:53 -05:00
llmII
bbc07c72d3 More NetBSD fixes
A comptime known value of 0 for data in EV_SET with EVFILT_TIMER causes
a complete compilation failure (fails to link). This fixes it by making
it a 1 instead of a 0 for amount of milliseconds in the interval to wait
under NetBSD.
2021-09-05 21:17:41 -05:00
llmII
43b48fdbea More fixes for NetBSD
Kills compiler warnings with regards to implicit conversion of intptr_t
to void*
2021-09-05 21:01:24 -05:00
llmII
604f97aba1 Fixes for BSD where BSD != FreeBSD
NetBSD and OpenBSD lack NOTE_ABSTIME and NOTE_MSECONDS, so we define
those and create a macro that we use for all timeout values in EV_TIMER
events that will on all BSD excepting FreeBSD change an absolute time
into an interval.
2021-09-05 20:48:42 -05:00
Calvin Rose
dc980081cd Fix #783 - change docstring for x86-64 to x64. 2021-09-05 12:32:33 -05:00
llmII
981f03fef3 Remove comments regarding NetBSD breakage
Since those no longer should apply, don't keep them around.
2021-09-05 10:45:45 -05:00
llmII
d40133dc72 NetBSD support
Checking throught NetBSD's man pages, excepting for NetBSD-current,
NetBSD uses `intptr_t` as the type for `.udata`. This change allows for
`.udata` to match whatever type (by cast) the underlying system uses.
2021-09-05 07:30:22 -05:00
llmII
c9fa586fce Code style fixes (pt 2).
Missed some.
2021-09-04 09:37:07 -05:00
llmII
b847a7d90b Code style fixes.
Pretty obvious I thought control statements were glued to their opening
parenthesis at first and then I realized not and voila, a bundle of
mixed style. Hopefully this fixes all of it.
2021-09-04 09:34:47 -05:00
llmII
8b67108dc8 Complete kqueue feature
From this point things should be bug fixes or code formatting most
likely.

Updated commentary (removed superfluous comments, and commented out
code). Refined commentary where it seemed important and may help whoever
comes behind me keep from making bad assumptions similar to the ones I
made.

All tests ran with `gmake test` now pass. `valgrind` with FreeBSD does
not support forking so `gmake valtest` fails once child processes are
started. Determined not an issue, can't fix valgrind.
2021-09-04 08:23:03 -05:00
llmII
b559f9625a Timeout is an absolute time, not an interval.
Fixes the wrong assumption, passing all tests at that point.
2021-09-04 08:02:50 -05:00
llmII
1736c9b0f8 Handle null state, don't read/write on error
Need to guard against errors when reading/writing probably, if there is
an error, forgo those events.

Guard against null state (and the byproduct, a segfault), check if the
state is null before utilizing it.
2021-09-03 23:22:07 -05:00
llmII
4fb2d8d318 Logical error regarding length fixed. 2021-09-03 22:41:59 -05:00
llmII
95891eb0a5 Fix incorrect use of EV_SET on pipes (part 2)
Forgot that we use nearly the same routine for adding and deletion...
can't go around deleting things we haven't put into the changeset!
2021-09-03 22:33:28 -05:00
llmII
c133443eb7 Fix incorrect use of EV_SET on pipes.
It would seem adding a read and a write event filter on a pipe which is
unidirectional might just be a bad idea.
2021-09-03 19:44:27 -05:00
llmII
8f0641f36c Disabling superfluous code
The code in question may be checking things in an erroneous manner?
2021-09-03 17:18:40 -05:00
llmII
f48dbde736 Better exit (error?) message
The prior calls to exit(-1) were wrong anyway and they may at this point
be hindering figuring out what's going on in suite 9.
2021-09-03 17:13:54 -05:00
llmII
f2e4c1ae9a Forgot a semicolon... 2021-09-03 16:31:20 -05:00
llmII
a4aef38cc0 More typo and syntax fixes. 2021-09-03 16:29:39 -05:00
llmII
b445ecde51 Add kqueue option to meson, janetconf, fix typoes 2021-09-03 16:23:15 -05:00
llmII
a209a01284 Add kqueue support to Janet
Note that this is a work in progress and simply a first attempt at
getting some code into place before being able to test it. This code
follows of sorts both the poll and epoll sections of the codebase hoping
to achieve the exact same.
2021-09-03 14:33:47 -05:00
Calvin Rose
7037532943 Errored threads always emit stacktrace or supervisor event.
That way, it is much harder to swallow errors. Error swallowing behavior
would have to be done explicitly by wrapping fibers with `protect` or
`try`.
2021-09-01 21:05:05 -05:00
Calvin Rose
bb405ee1aa Address #778
Relax check that number of closure environments in a function matches
that of the def.

The def could be partially constructed, and so there may be a false
negative. The runtime will check that this is consistent, and the
garbage collector should handle when this constraint is not kept.
2021-08-31 22:58:44 -05:00
Calvin Rose
ef23356309 Threaded supervisors return fiber->last_value instead
of the fiber itself.
2021-08-31 14:50:27 -05:00
Calvin Rose
1613e2593c Update CHANGELOG.md 2021-08-30 22:24:34 -05:00
Calvin Rose
5464a7a379 Allow passing a function to directly to ev/go.
Makes ev/call less useful but ev/go more useful. No need
to construct as many identical intermediate fibers.
2021-08-30 22:22:22 -05:00
Calvin Rose
bb1331e449 Update changelog. 2021-08-30 22:06:28 -05:00
Calvin Rose
acbebc5631 Allow passing function to ev/thread.
Convenient when there is no need to create an entire fiber.
2021-08-30 22:04:15 -05:00
Calvin Rose
fab65d6c40 Merge branch 'master' into struct-proto 2021-05-30 09:33:59 -05:00
Calvin Rose
4d983e54b5 Initial struct prototype code.
Also add a number of cfunctions for manipulating structs
with prototypes.
2021-05-29 11:43:18 -05:00
85 changed files with 2335 additions and 1403 deletions

View File

@@ -33,3 +33,23 @@ jobs:
build/janet.h
build/c/janet.c
build/c/shell.c
release-windows:
name: Build release binaries for windows
runs-on: windows-latest
steps:
- name: Checkout the repository
uses: actions/checkout@master
- name: Setup MSVC
uses: ilammy/msvc-dev-cmd@v1
- name: Build the project
shell: cmd
run: build_win all
- name: Draft the release
uses: softprops/action-gh-release@v1
with:
draft: true
files: |
./dist/*.zip
./*.zip
./*.msi

1
.gitignore vendored
View File

@@ -34,6 +34,7 @@ local
# Common test files I use.
temp.janet
temp*.janet
scratch.janet
# Emscripten

View File

@@ -1,10 +1,75 @@
# Changelog
All notable changes to this project will be documented in this file.
## 1.21.2 - 2022-04-01
- C functions `janet_dobytes` and `janet_dostring` will now enter the event loop if it is enabled.
- Fix hashing regression - hash of negative 0 must be the same as positive 0 since they are equal.
- The `flycheck` function no longer pollutes the module/cache
- Fix quasiquote bug in compiler
- Disallow use of `cancel` and `resume` on fibers scheduled or created with `ev/go`, as well as the root
fiber.
## 1.20.0 - 2022-1-27
- Add `:missing-symbol` hook to `compile` that will act as a catch-all macro for undefined symbols.
- Add `:redef` dynamic binding that will allow users to redefine top-level bindings with late binding. This
is intended for development use.
- Fix a bug with reading from a stream returned by `os/open` on Windows and Linux.
- Add `:ppc64` as a detectable OS type.
- Add `& more` support for destructuring in the match macro.
- Add `& more` support for destructuring in all binding forms (`def`).
## 1.19.2 - 2021-12-06
- Fix bug with missing status lines in some stack traces.
- Update hash function to have better statistical properties.
## 1.19.1 - 2021-12-04
- Add an optional `prefix` parameter to `debug/stacktrace` to allow printing prettier error messages.
- Remove appveyor for CI pipeline
- Fixed a bug that prevented sending threaded abstracts over threaded channels.
- Fix bug in the `map` function with arity at least 3.
## 1.19.0 - 2021-11-27
- Add `math/log-gamma` to replace `math/gamma`, and change `math/gamma` to be the expected gamma function.
- Fix leaking file-descriptors in os/spawn and os/execute.
- Ctrl-C will now raise SIGINT.
- Allow quoted literals in the `match` macro to behave as expected in patterns.
- Fix windows net related bug for TCP servers.
- Allow evaluating ev streams with dofile.
- Fix `ev` related bug with operations on already closed file descriptors.
- Add struct and table agnostic `getproto` function.
- Add a number of functions related to structs.
- Add prototypes to structs. Structs can now inherit from other structs, just like tables.
- Create a struct with a prototype with `struct/with-proto`.
- Deadlocked channels will no longer exit early - instead they will hang, which is more intuitive.
## 1.18.1 - 2021-10-16
- Fix some documentation typos
- Fix - Set pipes passed to subprocess to blocking mode.
- Fix `-r` switch in repl.
## 1.18.0 - 2021-10-10
- Allow `ev/cancel` to work on already scheduled fibers.
- Fix bugs with ev/ module.
- Add optional `base` argument to scan-number
- Add `-i` flag to janet binary to make it easier to run image files from the command line
- Remove `thread/` module.
- Add `(number ...)` pattern to peg for more efficient number parsing using Janet's
scan-number function without immediate string creation.
## 1.17.2 - 2021-09-18
- Remove include of windows.h from janet.h. This caused issues on certain projects.
- Fix formatting in doc-format to better handle special characters in signatures.
- Fix some marshalling bugs.
- Add optional Makefile target to install jpm as well.
- Supervisor channels in threads will no longer include a wasteful copy of the fiber in every
message across a thread.
- Allow passing a closure to `ev/thread` as well as a whole fiber.
- Allow passing a closure directly to `ev/go` to spawn fibers on the event loop.
## 1.17.1 - 2021-08-29
- Fix docstring typos
- Add `make install-jpm-git` to make jpm co-install simpler if using makefile.
- Fix bugs with starting ev/threads and fiber marshling.
- Add `make install-jpm-git` to make jpm co-install simpler if using the Makefile.
- Fix bugs with starting ev/threads and fiber marshaling.
## 1.17.0 - 2021-08-21
- Add the `-E` flag for one-liners with the `short-fn` syntax for argument passing.

View File

@@ -36,6 +36,7 @@ JANET_PATH?=$(LIBDIR)/janet
JANET_MANPATH?=$(PREFIX)/share/man/man1/
JANET_PKG_CONFIG_PATH?=$(LIBDIR)/pkgconfig
JANET_DIST_DIR?=janet-dist
JPM_TAG?=master
DEBUGGER=gdb
SONAME_SETTER=-Wl,-soname,
@@ -61,11 +62,18 @@ ifeq ($(UNAME), Darwin)
else ifeq ($(UNAME), Linux)
CLIBS:=$(CLIBS) -lrt -ldl
endif
# For other unix likes, add flags here!
ifeq ($(UNAME), Haiku)
LDCONFIG:=true
LDFLAGS=-Wl,--export-dynamic
endif
# For Android (termux)
ifeq ($(UNAME), Linux) # uname on Darwin doesn't recognise -o
ifeq ($(shell uname -o), Android)
CLIBS:=$(CLIBS) -landroid-spawn
endif
endif
$(shell mkdir -p build/core build/c build/boot)
all: $(JANET_TARGET) $(JANET_LIBRARY) $(JANET_STATIC_LIBRARY) build/janet.h
@@ -119,7 +127,6 @@ JANET_CORE_SOURCES=src/core/abstract.c \
src/core/struct.c \
src/core/symcache.c \
src/core/table.c \
src/core/thread.c \
src/core/tuple.c \
src/core/util.c \
src/core/value.c \
@@ -158,7 +165,7 @@ build/c/janet.c: build/janet_boot src/boot/boot.janet
##### Amalgamation #####
########################
SONAME=libjanet.so.1.17
SONAME=libjanet.so.1.21
build/c/shell.c: src/mainclient/shell.c
cp $< $@
@@ -231,6 +238,7 @@ build/janet-%.tar.gz: $(JANET_TARGET) \
mkdir -p build/$(JANET_DIST_DIR)/lib/
cp $(JANET_LIBRARY) $(JANET_STATIC_LIBRARY) build/$(JANET_DIST_DIR)/lib/
mkdir -p build/$(JANET_DIST_DIR)/man/man1/
cp janet.1 build/$(JANET_DIST_DIR)/man/man1/janet.1
mkdir -p build/$(JANET_DIST_DIR)/src/
cp build/c/janet.c build/c/shell.c build/$(JANET_DIST_DIR)/src/
cp CONTRIBUTING.md LICENSE README.md build/$(JANET_DIST_DIR)/
@@ -284,12 +292,13 @@ install: $(JANET_TARGET) $(JANET_LIBRARY) $(JANET_STATIC_LIBRARY) build/janet.pc
install-jpm-git: $(JANET_TARGET)
mkdir -p build
rm -rf build/jpm
git clone --depth=1 https://github.com/janet-lang/jpm.git build/jpm
cd build/jpm && PREFIX='$(DESTDIR)$(PREFIX)' \
JANET_MANPATH='$(DESTDIR)$(JANET_MANPATH)' \
JANET_HEADERPATH='$(DESTDIR)$(INCLUDEDIR)/janet' \
JANET_BINPATH='$(DESTDIR)$(BINDIR)' \
JANET_LIBPATH='$(DESTDIR)$(LIBDIR)' \
git clone --depth=1 --branch='$(JPM_TAG)' https://github.com/janet-lang/jpm.git build/jpm
cd build/jpm && PREFIX='$(PREFIX)' \
DESTDIR=$(DESTDIR) \
JANET_MANPATH='$(JANET_MANPATH)' \
JANET_HEADERPATH='$(INCLUDEDIR)/janet' \
JANET_BINPATH='$(BINDIR)' \
JANET_LIBPATH='$(LIBDIR)' \
../../$(JANET_TARGET) ./bootstrap.janet
uninstall:

View File

@@ -1,6 +1,5 @@
[![Join the chat](https://badges.gitter.im/janet-language/community.svg)](https://gitter.im/janet-language/community)
&nbsp;
[![Appveyor Status](https://ci.appveyor.com/api/projects/status/bjraxrxexmt3sxyv/branch/master?svg=true)](https://ci.appveyor.com/project/bakpakin/janet/branch/master)
[![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?)
[![Actions Status](https://github.com/janet-lang/janet/actions/workflows/test.yml/badge.svg)](https://github.com/janet-lang/janet/actions/workflows/test.yml)
@@ -30,6 +29,7 @@ Lua, but smaller than GNU Guile or Python.
## Features
* Configurable at build time - turn features on or off for a smaller or more featureful build
* Minimal setup - one binary and you are good to go!
* First-class closures
* Garbage collection
@@ -39,6 +39,8 @@ Lua, but smaller than GNU Guile or Python.
* Mutable and immutable hashtables (table/struct)
* Mutable and immutable strings (buffer/string)
* Macros
* Multithreading
* Per-thread event loop for efficient evented IO
* Byte code interpreter with an assembly interface, as well as bytecode verification
* Tail call Optimization
* Direct interop with C via abstract types and C functions
@@ -238,6 +240,52 @@ Gitter provides Matrix and irc bridges as well.
## FAQ
### Where is (favorite feature from other language)?
It may exist, it may not. If you want to propose major language features, go ahead and open an issue, but
they will likely by closed as "will not implement". Often, such features make one usecase simpler at the expense
of 5 others by making the language more complicated.
### Is there a language spec?
There is not currently a spec besides the documentation at https://janet-lang.org.
### Is this Scheme/Common Lisp? Where are the cons cells?
Nope. There are no cons cells here.
### Is this a Clojure port?
No. It's similar to Clojure superficially because I like Lisps and I like the aesthetics.
Internally, Janet is not at all like Clojure.
### Are the immutable data structures (tuples and structs) implemented as hash tries?
No. They are immutable arrays and hash tables. Don't try and use them like Clojure's vectors
and maps, instead they work well as table keys or other identifiers.
### Can I do Object Oriented programming with Janet?
To some extent, yes. However, it is not the recommended method of abstraction, and performance may suffer.
That said, tables can be used to make mutable objects with inheritance and polymorphism, where object
methods are implemeted with keywords.
```
(def Car @{:honk (fn [self msg] (print "car " self " goes " msg)) })
(def my-car (table/setproto @{} Car))
(:honk my-car "Beep!")
```
### Why can't we add (feature from Clojure) into the core?
Usually, one of a few reasons:
- Often, it already exists in a different form and the Clojure port would be redundant.
- Clojure programs often generate a lot of garbage and rely on the JVM to clean it up.
Janet does not run on the JVM, and has a more primitive garbage collector.
- We want to keep the Janet core small. With Lisps, usually a feature can be added as a library
without feeling "bolted on", especially when compared to ALGOL like languages. Adding features
to the core also makes it a bit more difficult to keep Janet maximally portable.
### Why is my terminal spitting out junk when I run the REPL?
Make sure your terminal supports ANSI escape codes. Most modern terminals will
@@ -246,35 +294,6 @@ 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.
### Where is (favorite feature from other language)?
It may exist, it may not. If you want to propose major language features, go ahead and open an issue, but
they will likely by closed as "will not implement". Often, such features make one usecase simpler at the expense
of 5 others by making the language more complicated.
### Where is the example code?
In the examples directory.
### Is this a Clojure port?
No. It's similar to Clojure superficially because I like Lisps and I like the asthetics.
Internally, Janet is not at all like Clojure.
### Are the immutable data structures (tuples and structs) implemented as hash tries?
No. They are immutable arrays and hash tables. Don't try and use them like Clojure's vectors
and maps, instead they work well as table keys or other identifiers.
### Why can't we add (feature from Clojure) into the core?
Usually, one of a few reasons:
- Often, it already exists in a different form and the Clojure port would be redundant.
- Clojure programs often generate a lot of garbage and rely on the JVM to clean it up.
Janet does not run on the JVM. We admittedly have a much more primitive GC.
- We want to keep the Janet core small. With Lisps, usually a feature can be added as a library
without feeling "bolted on", especially when compared to ALGOL like languages.
## Why is it called "Janet"?
Janet is named after the almost omniscient and friendly artificial being in [The Good Place](https://en.wikipedia.org/wiki/The_Good_Place).

View File

@@ -1,51 +0,0 @@
version: build-{build}
clone_folder: c:\projects\janet
image:
- Visual Studio 2019
configuration:
- Release
platform:
- x64
- x86
environment:
matrix:
- arch: Win64
matrix:
fast_finish: true
# skip unsupported combinations
init:
- call "C:\Program Files (x86)\Microsoft Visual Studio\2019\Community\VC\Auxiliary\Build\vcvarsall.bat" %platform%
install:
- set JANET_BUILD=%appveyor_repo_commit:~0,7%
- build_win all
- set janet_outname=%appveyor_repo_tag_name%
- if "%janet_outname%"=="" set /P janet_outname=<build\version.txt
build: off
artifacts:
- name: janet.c
path: dist\janet.c
type: File
- name: janet.h
path: dist\janet.h
type: File
- name: shell.c
path: dist\shell.c
type: File
- name: "janet-$(janet_outname)-windows-%platform%"
path: dist
type: Zip
- path: "janet-$(janet_outname)-windows-%platform%-installer.msi"
type: File
deploy:
description: 'The Janet Programming Language.'
provider: GitHub
auth_token:
secure: lwEXy09qhj2jSH9s1C/KvCkAUqJSma8phFR+0kbsfUc3rVxpNK5uD3z9Md0SjYRx
artifact: /(janet|shell).*/
draft: true
on:
APPVEYOR_REPO_TAG: true

View File

@@ -18,8 +18,14 @@
@rem Set compile and link options here
@setlocal
@rem Example use asan
@rem set JANET_COMPILE=cl /nologo /Isrc\include /Isrc\conf /c /O2 /W3 /D_CRT_SECURE_NO_WARNINGS /MD /fsanitize=address /Zi
@rem set JANET_LINK=link /nologo clang_rt.asan_dynamic-x86_64.lib clang_rt.asan_dynamic_runtime_thunk-x86_64.lib
@set JANET_COMPILE=cl /nologo /Isrc\include /Isrc\conf /c /O2 /W3 /D_CRT_SECURE_NO_WARNINGS /MD
@set JANET_LINK=link /nologo
@set JANET_LINK_STATIC=lib /nologo
@rem Add janet build tag
@@ -81,7 +87,7 @@ exit /b 1
@echo command prompt.
exit /b 0
@rem Clean build artifacts
@rem Clean build artifacts
:CLEAN
del *.exe *.lib *.exp
rd /s /q build

View File

@@ -1,6 +1,6 @@
(defn dowork [name n]
(print name " starting work...")
(os/execute [(dyn :executable) "-e" (string "(os/sleep " n ")")])
(os/execute [(dyn :executable) "-e" (string "(os/sleep " n ")")] :p)
(print name " finished work!"))
# Will be done in parallel

View File

@@ -10,3 +10,13 @@
(ev/call worker :b 5)
(ev/sleep 0.3)
(ev/call worker :c 12)
(defn worker2
[name]
(repeat 10
(ev/sleep 0.2)
(print name " working")))
(ev/go worker2 :bob)
(ev/go worker2 :joe)
(ev/go worker2 :sally)

View File

@@ -76,9 +76,16 @@ void num_array_put(void *p, Janet key, Janet value) {
}
}
static Janet num_array_length(int32_t argc, Janet *argv) {
janet_fixarity(argc, 1);
num_array *array = (num_array *)janet_getabstract(argv, 0, &num_array_type);
return janet_wrap_number(array->size);
}
static const JanetMethod methods[] = {
{"scale", num_array_scale},
{"sum", num_array_sum},
{"length", num_array_length},
{NULL, NULL}
};
@@ -109,6 +116,11 @@ static const JanetReg cfuns[] = {
"(numarray/scale numarray factor)\n\n"
"scale numarray by factor"
},
{
"sum", num_array_sum,
"(numarray/sum numarray)\n\n"
"sums numarray"
},
{NULL, NULL, NULL}
};

View File

@@ -1,4 +1,4 @@
(import build/numarray)
(import /build/numarray)
(def a (numarray/new 30))
(print (get a 20))

View File

@@ -1,10 +1,10 @@
# An example of using Janet's extensible module system
# to import files from URL. To try this, run `janet -l examples/urlloader.janet`
# from the repl, and then:
# An example of using Janet's extensible module system to import files from
# URL. To try this, run `janet -l ./examples/urlloader.janet` from the command
# line, and then at the REPL type:
#
# (import https://raw.githubusercontent.com/janet-lang/janet/master/examples/colors.janet :as c)
#
# This will import a file using curl. You can then try
# This will import a file using curl. You can then try:
#
# (print (c/color :green "Hello!"))
#
@@ -13,9 +13,9 @@
(defn- load-url
[url args]
(def f (file/popen (string "curl " url)))
(def res (dofile f :source url ;args))
(try (file/close f) ([err] nil))
(def p (os/spawn ["curl" url "-s"] :p {:out :pipe}))
(def res (dofile (p :out) :source url ;args))
(:wait p)
res)
(defn- check-http-url

View File

@@ -3,7 +3,7 @@
janet \- run the Janet language abstract machine
.SH SYNOPSIS
.B janet
[\fB\-hvsrpnqk\fR]
[\fB\-hvsrpnqik\fR]
[\fB\-e\fR \fISOURCE\fR]
[\fB\-E\fR \fISOURCE ...ARGUMENTS\fR]
[\fB\-l\fR \fIMODULE\fR]
@@ -213,6 +213,11 @@ Precompiles Janet source code into an image, a binary dump that can be efficient
Source should be a path to the Janet module to compile, and output should be the file path of
resulting image. Output should usually end with the .jimage extension.
.TP
.BR \-i
When this flag is passed, a script passed to the interpreter will be treated as a janet image file
rather than a janet source file.
.TP
.BR \-l\ lib
Import a Janet module before running a script or repl. Multiple files can be loaded

View File

@@ -20,7 +20,7 @@
project('janet', 'c',
default_options : ['c_std=c99', 'build.c_std=c99', 'b_lundef=false', 'default_library=both'],
version : '1.17.1')
version : '1.21.2')
# Global settings
janet_path = join_paths(get_option('prefix'), get_option('libdir'), 'janet')
@@ -30,6 +30,7 @@ header_path = join_paths(get_option('prefix'), get_option('includedir'), 'janet'
cc = meson.get_compiler('c')
m_dep = cc.find_library('m', required : false)
dl_dep = cc.find_library('dl', required : false)
android_spawn_dep = cc.find_library('android-spawn', required : false)
thread_dep = dependency('threads')
# Link options
@@ -73,7 +74,7 @@ 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'))
conf.set('JANET_EV_NO_EPOLL', not get_option('epoll'))
conf.set('JANET_NO_THREADS', get_option('threads'))
conf.set('JANET_EV_NO_KQUEUE', not get_option('kqueue'))
conf.set('JANET_NO_INTERPRETER_INTERRUPT', not get_option('interpreter_interrupt'))
if get_option('os_name') != ''
conf.set('JANET_OS_NAME', get_option('os_name'))
@@ -135,7 +136,6 @@ core_src = [
'src/core/struct.c',
'src/core/symcache.c',
'src/core/table.c',
'src/core/thread.c',
'src/core/tuple.c',
'src/core/util.c',
'src/core/value.c',
@@ -161,7 +161,7 @@ mainclient_src = [
janet_boot = executable('janet-boot', core_src, boot_src,
include_directories : incdir,
c_args : '-DJANET_BOOTSTRAP',
dependencies : [m_dep, dl_dep, thread_dep],
dependencies : [m_dep, dl_dep, thread_dep, android_spawn_dep],
native : true)
# Build janet.c
@@ -174,7 +174,7 @@ janetc = custom_target('janetc',
'JANET_PATH', janet_path
])
janet_dependencies = [m_dep, dl_dep]
janet_dependencies = [m_dep, dl_dep, android_spawn_dep]
if not get_option('single_threaded')
janet_dependencies += thread_dep
endif

View File

@@ -1,7 +1,6 @@
option('git_hash', type : 'string', value : 'meson')
option('single_threaded', type : 'boolean', value : false)
option('threads', type : 'boolean', value : true)
option('nanbox', type : 'boolean', value : true)
option('dynamic_modules', type : 'boolean', value : true)
option('docstrings', type : 'boolean', value : true)
@@ -18,6 +17,7 @@ option('umask', type : 'boolean', value : true)
option('realpath', type : 'boolean', value : true)
option('simple_getline', type : 'boolean', value : false)
option('epoll', type : 'boolean', value : false)
option('kqueue', type : 'boolean', value : false)
option('interpreter_interrupt', type : 'boolean', value : false)
option('recursion_guard', type : 'integer', min : 10, max : 8000, value : 1024)

View File

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

View File

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

View File

@@ -51,7 +51,7 @@
``Use a function or macro literal `f` as a macro. This lets
any function be used as a macro. Inside a quasiquote, the
idiom `(as-macro ,my-custom-macro arg1 arg2...)` can be used
to avoid unwanted variable capture.``
to avoid unwanted variable capture of `my-custom-macro`.``
[f & args]
(f ;args))
@@ -532,16 +532,19 @@
(defmacro loop
```
A general purpose loop macro. This macro is similar to the Common Lisp
loop macro, although intentionally much smaller in scope.
The head of the loop should be a tuple that contains a sequence of
either bindings or conditionals. A binding is a sequence of three values
that define something to loop over. They are formatted like:
A general purpose loop macro. This macro is similar to the Common Lisp loop
macro, although intentionally much smaller in scope. The head of the loop
should be a tuple that contains a sequence of either bindings or
conditionals. A binding is a sequence of three values that define something
to loop over. Bindings are written in the format:
binding :verb object/expression
Where `binding` is a binding as passed to def, `:verb` is one of a set of
keywords, and `object` is any expression. The available verbs are:
where `binding` is a binding as passed to def, `:verb` is one of a set of
keywords, and `object` is any expression. Each subsequent binding creates a
nested loop within the loop created by the previous binding.
The available verbs are:
* `:iterate` - repeatedly evaluate and bind to the expression while it is
truthy.
@@ -565,14 +568,19 @@
where `:modifier` is one of a set of keywords, and `argument` is keyword-dependent.
`:modifier` can be one of:
* `:while expression` - breaks from the loop if `expression` is falsey.
* `:until expression` - breaks from the loop if `expression` is truthy.
* `:let bindings` - defines bindings inside the loop as passed to the `let` macro.
* `:before form` - evaluates a form for a side effect before the next inner loop.
* `:after form` - same as `:before`, but the side effect happens after the next inner loop.
* `:while expression` - breaks from the current loop if `expression` is
falsey.
* `:until expression` - breaks from the current loop if `expression` is
truthy.
* `:let bindings` - defines bindings inside the current loop as passed to the
`let` macro.
* `:before form` - evaluates a form for a side effect before the next inner
loop.
* `:after form` - same as `:before`, but the side effect happens after the
next inner loop.
* `:repeat n` - repeats the next inner loop `n` times.
lets try putting a loop item on multiple lines.
* `:when condition` - only evaluates the loop body when condition is true.
* `:when condition` - only evaluates the current loop body when `condition`
is true.
The `loop` macro always evaluates to nil.
```
@@ -698,6 +706,14 @@
"Returns the numeric minimum of the arguments."
[& args] (extreme < args))
(defn max-of
"Returns the numeric maximum of the argument sequence."
[args] (extreme > args))
(defn min-of
"Returns the numeric minimum of the argument sequence."
[args] (extreme < args))
(defn first
"Get the first element from an indexed data structure."
[xs]
@@ -900,7 +916,7 @@
(while true
(if (= nil (set k1 (next i1 k1))) (break))
(if (= nil (set k2 (next i2 k2))) (break))
(if (= nil (set k3 (next i2 k3))) (break))
(if (= nil (set k3 (next i3 k3))) (break))
(array/push res (f (in i1 k1) (in i2 k2) (in i3 k3)))))
4 (do
(var k1 nil)
@@ -910,8 +926,8 @@
(while true
(if (= nil (set k1 (next i1 k1))) (break))
(if (= nil (set k2 (next i2 k2))) (break))
(if (= nil (set k3 (next i2 k3))) (break))
(if (= nil (set k4 (next i2 k4))) (break))
(if (= nil (set k3 (next i3 k3))) (break))
(if (= nil (set k4 (next i4 k4))) (break))
(array/push res (f (in i1 k1) (in i2 k2) (in i3 k3) (in i4 k4)))))
(do
(def iterkeys (array/new-filled ninds))
@@ -1139,12 +1155,36 @@
(array/push parts (tuple apply f $args)))
(tuple 'fn (tuple '& $args) (tuple/slice parts 0)))
(defmacro defdyn
``Define an alias for a keyword that is used as a dynamic binding. The
alias is a normal, lexically scoped binding that can be used instead of
a keyword to prevent typos. Defdyn does not set dynamic bindings or otherwise
replace `dyn` and `setdyn`. The alias _must_ start and end with the `*` character, usually
called "earmuffs".``
[alias & more]
(assert (symbol? alias) "alias must be a symbol")
(assert (and (> (length alias) 2) (= 42 (first alias) (last alias))) "name must have leading and trailing '*' characters")
(def prefix (dyn :defdyn-prefix))
(def kw (keyword prefix (slice alias 1 -2)))
~(def ,alias :dyn ,;more ,kw))
(defdyn *defdyn-prefix* "Optional namespace prefix to add to keywords declared with `defdyn`.
Use this to prevent keyword collisions between dynamic bindings.")
(defdyn *out* "Where normal print functions print output to.")
(defdyn *err* "Where error printing prints output to.")
(defdyn *macro-form*
"Inside a macro, is bound to the source form that invoked the macro")
(defdyn *current-file*
"Bound to the name of the currently compiling file.")
(defmacro tracev
`Print a value and a description of the form that produced that value to
stderr. Evaluates to x.`
[x]
(def [l c] (tuple/sourcemap (dyn :macro-form ())))
(def cf (dyn :current-file))
(def [l c] (tuple/sourcemap (dyn *macro-form* ())))
(def cf (dyn *current-file*))
(def fmt-1 (if cf (string/format "trace [%s]" cf) "trace"))
(def fmt-2 (if (or (neg? l) (neg? c)) ":" (string/format " on line %d, column %d:" l c)))
(def fmt (string fmt-1 fmt-2 " %j is "))
@@ -1639,10 +1679,13 @@
(file/close f)
nil)
(defdyn *pretty-format*
"Format specifier for the `pp` function")
(defn pp
`Pretty print to stdout or (dyn :out). The format string used is (dyn :pretty-format "%q").`
`Pretty print to stdout or (dyn *out*). The format string used is (dyn *pretty-format* "%q").`
[x]
(printf (dyn :pretty-format "%q") x)
(printf (dyn *pretty-format* "%q") x)
(flush))
###
@@ -1660,8 +1703,9 @@
* symbol -- a pattern that is a symbol will match anything, binding `x`'s
value to that symbol.
* array -- an array will match only if all of its elements match the
corresponding elements in `x`.
* array or bracket tuple -- an array or bracket tuple will match only if
all of its elements match the corresponding elements in `x`.
Use `& rest` at the end of an array or bracketed tuple to bind all remaining values to `rest`.
* table or struct -- a table or struct will match if all values match with
the corresponding values in `x`.
@@ -1677,6 +1721,8 @@
already bound to `<sym>`, rather than matching and rebinding it.
Any other value pattern will only match if it is equal to `x`.
Quoting a pattern with `'` will also treat the value as a literal value to match against.
```
[x & cases]
@@ -1728,11 +1774,31 @@
(array/push x s)
(put b2g pattern @[s]))
# match quoted literal
(and (= t :tuple) (= 2 (length pattern)) (= 'quote (pattern 0)))
(break)
# match data structure template
(or isarr (= t :struct) (= t :table))
(or (= t :struct) (= t :table))
(eachp [i sub-pattern] pattern
(visit-pattern-1 b2g s i sub-pattern))
isarr
(do
(when isarr (get-length-sym s))
(get-length-sym s)
(eachp [i sub-pattern] pattern
(when (= sub-pattern '&)
(when (<= (length pattern) (inc i))
(errorf "expected symbol following & in pattern"))
(when (< (+ i 2) (length pattern))
(errorf "expected a single symbol follow '& in pattern, found %q" (slice pattern (inc i))))
(when (not= (type (pattern (inc i))) :symbol)
(errorf "expected symbol following & in pattern, found %q" (pattern (inc i))))
(put b2g (pattern (inc i)) @[[slice s i]])
(break))
(visit-pattern-1 b2g s i sub-pattern)))
# match global unification
@@ -1752,19 +1818,33 @@
(def isarr (or (= t :array) (and (= t :tuple) (= (tuple/type pattern) :brackets))))
(when isarr
(array/push anda (get-length-sym s))
(array/push anda [<= (length pattern) (get-length-sym s)]))
(def pattern-len
(if-let [ rest-idx (find-index (fn [x] (= x '&)) pattern) ]
rest-idx
(length pattern)))
(array/push anda [<= pattern-len (get-length-sym s)]))
(cond
# match data structure template
(or isarr (= t :struct) (= t :table))
(or (= t :struct) (= t :table))
(eachp [i sub-pattern] pattern
(when (not isarr)
(array/push anda [not= nil (get-sym s i)]))
(array/push anda [not= nil (get-sym s i)])
(visit-pattern-2 anda gun preds s i sub-pattern))
isarr
(eachp [i sub-pattern] pattern
# stop recursing to sub-patterns if the rest sigil is found
(when (= sub-pattern '&)
(break))
(visit-pattern-2 anda gun preds s i sub-pattern))
# match local binding
(= t :symbol) (break)
# match quoted literal
(and (= t :tuple) (= 2 (length pattern)) (= 'quote (pattern 0)))
(array/push anda ['= s pattern])
# match global unification
(and (= t :tuple) (= 2 (length pattern)) (= '@ (pattern 0)))
(if-let [x (in gun (pattern 1))]
@@ -1829,13 +1909,17 @@
###
###
(defdyn *macro-lints*
"Bound to an array of lint messgae that will be reported by the compiler inside a macro.
To indicate an error or warning, a macro author should use `maclintf`.")
(defn maclintf
``When inside a macro, call this function to add a linter warning. Takes
a `fmt` argument like `string/format` which is used to format the message.``
[level fmt & args]
(def lints (dyn :macro-lints))
(def lints (dyn *macro-lints*))
(when lints
(def form (dyn :macro-form))
(def form (dyn *macro-form*))
(def [l c] (if (tuple? form) (tuple/sourcemap form) [nil nil]))
(def l (if-not (= -1 l) l))
(def c (if-not (= -1 c) c))
@@ -1926,11 +2010,11 @@
(def h (in t 0))
(def s (in specs h))
(def entry (or (dyn h) {}))
(def m (entry :value))
(def m? (entry :macro))
(def m (do (def r (get entry :ref)) (if r (in r 0) (get entry :value))))
(def m? (in entry :macro))
(cond
s (s t)
m? (do (setdyn :macro-form t) (m ;(tuple/slice t 1)))
m? (do (setdyn *macro-form* t) (m ;(tuple/slice t 1)))
(tuple/slice (map recur t))))
(def ret
@@ -2047,7 +2131,7 @@
```
Shorthand for fn. Arguments are given as $n, where n is the 0-indexed
argument of the function. $ is also an alias for the first (index 0) argument.
The $& symbol will make the anonymous function variadic if it apears in the
The $& symbol will make the anonymous function variadic if it appears in the
body of the function - it can be combined with positional arguments.
Example usage:
@@ -2138,10 +2222,13 @@
(def newenv (table/setproto @{} parent))
newenv)
(defdyn *err-color*
"Whether or not to turn on error coloring in stacktraces and other error messages.")
(defn bad-parse
"Default handler for a parse error."
[p where]
(def ec (dyn :err-color))
(def ec (dyn *err-color*))
(def [line col] (:where p))
(eprint
(if ec "\e[31m" "")
@@ -2160,24 +2247,25 @@
the file, prints nothing."
[where line col]
(if-not line (break))
(unless (string? where) (break))
(when-with [f (file/open where :r)]
(def source-code (file/read f :all))
(var index 0)
(repeat (dec line)
(if-not index (break))
(set index (inc (string/find "\n" source-code index))))
(set index (string/find "\n" source-code index))
(if index (++ index)))
(when index
(def line-end (string/find "\n" source-code index))
(eprint " " (string/slice source-code index line-end))
(when col
(+= index col)
(eprint (string/repeat " " (inc col)) "^"))
(eflush))))
(eprint (string/repeat " " (inc col)) "^")))))
(defn warn-compile
"Default handler for a compile warning"
[msg level where &opt line col]
(def ec (dyn :err-color))
(def ec (dyn *err-color*))
(eprin
(if ec "\e[33m" "")
where
@@ -2195,7 +2283,7 @@
(defn bad-compile
"Default handler for a compile error."
[msg macrof where &opt line col]
(def ec (dyn :err-color))
(def ec (dyn *err-color*))
(eprin
(if ec "\e[31m" "")
where
@@ -2205,7 +2293,7 @@
col
": compile error: ")
(if macrof
(debug/stacktrace macrof msg)
(debug/stacktrace macrof msg "")
(eprint msg))
(when ec
(print-line-col where line col)
@@ -2237,7 +2325,7 @@
* `:chunks` - callback to read into a buffer - default is getline
* `:on-parse-error` - callback when parsing fails - default is bad-parse
* `:env` - the environment to compile against - default is the current env
* `:source` - string path of source for better errors - default is "<anonymous>"
* `:source` - source path for better errors (use keywords for non-paths) - default is :<anonymous>
* `:on-compile-error` - callback when compilation fails - default is bad-compile
* `:on-compile-warning` - callback for any linting error - default is warn-compile
* `:evaluator` - callback that executes thunks. Signature is (evaluator thunk source env where)
@@ -2269,11 +2357,14 @@
(default on-compile-warning warn-compile)
(default on-parse-error bad-parse)
(default evaluator (fn evaluate [x &] (x)))
(default default-where "<anonymous>")
(default default-where :<anonymous>)
(default guard :ydt)
(var where default-where)
(if (string? where)
(put env *current-file* where))
# Evaluate 1 source form in a protected manner
(def lints @[])
(defn eval1 [source &opt l c]
@@ -2351,9 +2442,10 @@
(buffer/clear buf))
[:source new-where]
(if (string? new-where)
(do
(set where new-where)
(set where default-where))
(if (string? new-where)
(put env *current-file* new-where)))
(do
(var pindex 0)
@@ -2414,14 +2506,14 @@
(if-not (= (fiber/status f) :dead)
(error val))
(set returnval val))
:source "eval-string"})
:source :eval-string})
returnval)
(defn eval
``Evaluates a form in the current environment. If more control over the
environment is needed, use `run-context`.``
[form]
(def res (compile form (fiber/getenv (fiber/current)) "eval"))
(def res (compile form (fiber/getenv (fiber/current)) :eval))
(if (= (type res) :function)
(res)
(error (get res :error))))
@@ -2582,8 +2674,8 @@
@{})
(defn dofile
`Evaluate a file and return the resulting environment. :env, :expander,
:evaluator, :read, and :parser are passed through to the underlying
`Evaluate a file, file path, or stream and return the resulting environment. :env, :expander,
:source, :evaluator, :read, and :parser are passed through to the underlying
run-context call. If exit is true, any top level errors will trigger a
call to (os/exit 1) after printing the error.`
[path &keys
@@ -2594,24 +2686,24 @@
:evaluator evaluator
:read read
:parser parser}]
(def f (if (= (type path) :core/file)
path
(def f (case (type path)
:core/file path
:core/stream path
(file/open path :rb)))
(def path-is-file (= f path))
(default env (make-env))
(def spath (string path))
(put env :current-file (or src (if-not path-is-file spath)))
(put env :source (or src (if-not path-is-file spath path)))
(var exit-error nil)
(var exit-fiber nil)
(defn chunks [buf _] (file/read f 4096 buf))
(defn chunks [buf _] (:read f 4096 buf))
(defn bp [&opt x y]
(when exit
(bad-parse x y)
(os/exit 1))
(put env :exit true)
(def buf @"")
(with-dyns [:err buf :err-color false]
(with-dyns [*err* buf *err-color* false]
(bad-parse x y))
(set exit-error (string/slice buf 0 -2)))
(defn bc [&opt x y z a b]
@@ -2620,7 +2712,7 @@
(os/exit 1))
(put env :exit true)
(def buf @"")
(with-dyns [:err buf :err-color false]
(with-dyns [*err* buf *err-color* false]
(bad-compile x nil z a b))
(set exit-error (string/slice buf 0 -2))
(set exit-fiber y))
@@ -2634,8 +2726,7 @@
:on-status (fn [f x]
(when (not= (fiber/status f) :dead)
(when exit
(eprint x)
(debug/stacktrace f)
(debug/stacktrace f x "")
(eflush)
(os/exit 1))
(put env :exit true)
@@ -2645,8 +2736,8 @@
:expander expander
:read read
:parser parser
:source (or src (if path-is-file "<anonymous>" spath))}))
(if-not path-is-file (file/close f))
:source (or src (if path-is-file :<anonymous> spath))}))
(if-not path-is-file (:close f))
(when exit-error
(if exit-fiber
(propagate exit-error exit-fiber)
@@ -2770,6 +2861,12 @@
[&opt env local]
(env-walk keyword? env local))
(defdyn *doc-width*
"Width in columns to print documentation printed with `doc-format`")
(defdyn *doc-color*
"Whether or not to colorize documentation printed with `doc-format`.")
(defn doc-format
`Reformat a docstring to wrap a certain width. Docstrings can either be plaintext
or a subset of markdown. This allows a long single line of prose or formatted text to be
@@ -2777,17 +2874,17 @@
[str &opt width indent colorize]
(default indent 4)
(def max-width (- (or width (dyn :doc-width 80)) 8))
(def max-width (- (or width (dyn *doc-width* 80)) 8))
(def has-color (if (not= nil colorize)
colorize
(dyn :doc-color)))
(dyn *doc-color*)))
# Terminal codes for emission/tokenization
(def delimiters
(if has-color
{:underline ["\e[4m" "\e[24m"]
:code ["\e[3;97m" "\e[39;23m"]
:italics ["\e[3m" "\e[23m"]
:code ["\e[97m" "\e[39m"]
:italics ["\e[4m" "\e[24m"]
:bold ["\e[1m" "\e[22m"]}
{:underline ["_" "_"]
:code ["`" "`"]
@@ -2820,7 +2917,7 @@
(c++)
(- cursor x))
# Detection helpers - return number of characters natched
# Detection helpers - return number of characters matched
(defn ul? []
(let [x (c) x1 (cn 1)]
(and
@@ -2954,6 +3051,14 @@
(finish-p)
new-indent))
# Handle first line specially for defn, defmacro, etc.
(when (= (chr "(") (in str 0))
(skipline)
(def first-line (string/slice str 0 (- cursor 1)))
(def fl-open (if has-color "\e[97m" ""))
(def fl-close (if has-color "\e[39m" ""))
(push [[(string fl-open first-line fl-close) (length first-line)]]))
(parse-blocks 0)
# Emission state
@@ -3040,6 +3145,7 @@
(def bind-type
(string " "
(cond
(x :redef) (type (in (x :ref) 0))
(x :ref) (string :var " (" (type (in (x :ref) 0)) ")")
(x :macro) :macro
(x :module) (string :module " (" (x :kind) ")")
@@ -3048,7 +3154,7 @@
(def sm (x :source-map))
(def d (x :doc))
(print "\n\n"
(when d bind-type)
bind-type
(when-let [[path line col] sm]
(string " " path (when (and line col) (string " on line " line ", column " col))))
(when sm "\n")
@@ -3134,7 +3240,7 @@
"Print the current fiber stack"
[]
(print)
(with-dyns [:err-color false] (debug/stacktrace (.fiber) (.signal)))
(with-dyns [*err-color* false] (debug/stacktrace (.fiber) (.signal) ""))
(print))
(defn .frame
@@ -3331,9 +3437,7 @@
(printf (get e :pretty-format "%q") x)
(flush))
(do
(def ec (dyn :err-color))
(eprint (if ec "\e[31m" "") fs ": " x)
(debug/stacktrace f)
(debug/stacktrace f x "")
(eflush)
(if (e :debug) (enter-debugger f x))))))
@@ -3342,7 +3446,7 @@
:on-status (or onsignal (make-onsignal env 1))
:parser parser
:read read
:source "repl"}))
:source :repl}))
###
###
@@ -3360,23 +3464,23 @@
Returns a fiber that is scheduled to run the function.
```
[f & args]
(ev/go (fiber/new (fn [&] (f ;args)) :tp)))
(ev/go (fn _call [&] (f ;args))))
(defmacro ev/spawn
"Run some code in a new fiber. This is shorthand for (ev/call (fn [] ;body))."
[& body]
~(,ev/go (fiber/new (fn _spawn [&] ,;body) :tp)))
~(,ev/go (fn _spawn [&] ,;body)))
(defmacro ev/do-thread
``Run some code in a new thread. Suspends the current fiber until the thread is complete, and
evaluates to nil.``
[& body]
~(,ev/thread (fiber/new (fn _thread [&] ,;body) :t)))
~(,ev/thread (fn _do-thread [&] ,;body)))
(defmacro ev/spawn-thread
``Run some code in a new thread. Like `ev/do-thread`, but returns nil immediately.``
[& body]
~(,ev/thread (fiber/new (fn _thread [&] ,;body) :t) nil :n))
~(,ev/thread (fn _spawn-thread [&] ,;body) nil :n))
(defmacro ev/with-deadline
`Run a body of code with a deadline, such that if the code does not complete before
@@ -3407,7 +3511,7 @@
(def ,res @[])
(,wait-for-fibers ,chan
,(seq [[i body] :pairs bodies]
~(,ev/go (,fiber/new (fn [] (put ,res ,i ,body)) :tp) nil ,chan)))
~(,ev/go (fn [] (put ,res ,i ,body)) nil ,chan)))
,res))))
(compwhen (dyn 'net/listen)
@@ -3484,13 +3588,17 @@
arbitrary execution is possible. Other arguments are the same as dofile. `path` can also be
a file value such as stdin. Returns nil.``
[path &keys kwargs]
(def old-modcache (table/clone module/cache))
(table/clear module/cache)
(try
(dofile path :evaluator flycheck-evaluator ;(kvs kwargs))
([e f]
(eprint e)
(debug/stacktrace f)))
(debug/stacktrace f e "")))
(table/clear module/cache)
(merge-into module/cache old-modcache)
nil)
###
###
### CLI Tool Main
@@ -3500,27 +3608,45 @@
# conditional compilation for reduced os
(def- getenv-alias (if-let [entry (in root-env 'os/getenv)] (entry :value) (fn [&])))
(defn- run-main
[env subargs arg]
(if-let [entry (in env 'main)
main (or (get entry :value) (in (get entry :ref) 0))]
(let [thunk (compile [main ;subargs] env arg)]
(if (function? thunk) (thunk) (error (thunk :error))))))
(defdyn *args*
"Dynamic bindings that will contain command line arguments at program start")
(defdyn *executable*
"Name of the interpreter executable used to execute this program. Corresponds to argv[0] in the call to
int main(int argc, char **argv);")
(defdyn *profilepath*
"Path to profile file loaded when starting up the repl.")
(defn cli-main
`Entrance for the Janet CLI tool. Call this function with the command line
arguments as an array or tuple of strings to invoke the CLI interface.`
[args]
(setdyn :args args)
(setdyn *args* args)
(var *should-repl* false)
(var *no-file* true)
(var *quiet* false)
(var *raw-stdin* false)
(var *handleopts* true)
(var *exit-on-error* true)
(var *colorize* true)
(var *debug* false)
(var *compile-only* false)
(var *warn-level* nil)
(var *error-level* nil)
(var should-repl false)
(var no-file true)
(var quiet false)
(var raw-stdin false)
(var handleopts true)
(var exit-on-error true)
(var colorize true)
(var debug-flag false)
(var compile-only false)
(var warn-level nil)
(var error-level nil)
(var expect-image false)
(if-let [jp (getenv-alias "JANET_PATH")] (setdyn :syspath jp))
(if-let [jprofile (getenv-alias "JANET_PROFILE")] (setdyn :profilepath jprofile))
(if-let [jprofile (getenv-alias "JANET_PROFILE")] (setdyn *profilepath* jprofile))
(defn- get-lint-level
[i]
@@ -3530,7 +3656,7 @@
# Flag handlers
(def handlers
{"h" (fn [&]
(print "usage: " (dyn :executable "janet") " [options] script args...")
(print "usage: " (dyn *executable* "janet") " [options] script args...")
(print
```
Options are:
@@ -3547,8 +3673,9 @@
-k : Compile scripts but do not execute (flycheck)
-m syspath : Set system path for loading global modules
-c source output : Compile janet source code into an image
-i : Load the script argument as an image file instead of source code
-n : Disable ANSI color output in the REPL
-l lib : Import a module before processing more arguments
-l lib : Use a module before processing more arguments
-w level : Set the lint warning level - default is "normal"
-x level : Set the lint error level - default is "none"
-- : Stop handling options
@@ -3556,29 +3683,31 @@
(os/exit 0)
1)
"v" (fn [&] (print janet/version "-" janet/build) (os/exit 0) 1)
"s" (fn [&] (set *raw-stdin* true) (set *should-repl* true) 1)
"r" (fn [&] (set *should-repl* true) 1)
"p" (fn [&] (set *exit-on-error* false) 1)
"q" (fn [&] (set *quiet* true) 1)
"k" (fn [&] (set *compile-only* true) (set *exit-on-error* false) 1)
"n" (fn [&] (set *colorize* false) 1)
"s" (fn [&] (set raw-stdin true) (set should-repl true) 1)
"r" (fn [&] (set should-repl true) 1)
"p" (fn [&] (set exit-on-error false) 1)
"q" (fn [&] (set quiet true) 1)
"i" (fn [&] (set expect-image true) 1)
"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 c-switch [i &]
(def e (dofile (in args (+ i 1))))
(def path (in args (+ i 1)))
(def e (dofile path))
(spit (in args (+ i 2)) (make-image e))
(set *no-file* false)
(set no-file false)
3)
"-" (fn [&] (set *handleopts* false) 1)
"-" (fn [&] (set handleopts false) 1)
"l" (fn l-switch [i &]
(import* (in args (+ i 1))
:prefix "" :exit *exit-on-error*)
:prefix "" :exit exit-on-error)
2)
"e" (fn e-switch [i &]
(set *no-file* false)
(set no-file false)
(eval-string (in args (+ i 1)))
2)
"E" (fn E-switch [i &]
(set *no-file* false)
(set no-file false)
(def subargs (array/slice args (+ i 2)))
(def src ~|,(parse (in args (+ i 1))))
(def thunk (compile src))
@@ -3586,10 +3715,10 @@
((thunk) ;subargs)
(error (get thunk :error)))
math/inf)
"d" (fn [&] (set *debug* true) 1)
"w" (fn [i &] (set *warn-level* (get-lint-level i)) 2)
"x" (fn [i &] (set *error-level* (get-lint-level i)) 2)
"R" (fn [&] (setdyn :profilepath nil) 1)})
"d" (fn [&] (set debug-flag true) 1)
"w" (fn [i &] (set warn-level (get-lint-level i)) 2)
"x" (fn [i &] (set error-level (get-lint-level i)) 2)
"R" (fn [&] (setdyn *profilepath* nil) 1)})
(defn- dohandler [n i &]
(def h (in handlers n))
@@ -3600,29 +3729,41 @@
(def lenargs (length args))
(while (< i lenargs)
(def arg (in args i))
(if (and *handleopts* (= "-" (string/slice arg 0 1)))
(if (and handleopts (= "-" (string/slice arg 0 1)))
(+= i (dohandler (string/slice arg 1) i))
(do
(set *no-file* false)
(def env (make-env))
(def subargs (array/slice args i))
(put env :args subargs)
(put env :lint-error *error-level*)
(put env :lint-warn *warn-level*)
(if *compile-only*
(flycheck arg :exit *exit-on-error* :env env)
(set no-file false)
(if expect-image
(do
(dofile arg :exit *exit-on-error* :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)))))))
(def env (load-image (slurp arg)))
(put env :args subargs)
(put env :lint-error error-level)
(put env :lint-warn warn-level)
(when debug-flag
(put env :debug true)
(put env :redef true))
(run-main env subargs arg))
(do
(def env (make-env))
(put env :args subargs)
(put env :lint-error error-level)
(put env :lint-warn warn-level)
(when debug-flag
(put env :debug true)
(put env :redef true))
(if compile-only
(flycheck arg :exit exit-on-error :env env)
(do
(dofile arg :exit exit-on-error :env env)
(run-main env subargs arg)))))
(set i lenargs))))
(if (or *should-repl* *no-file*)
(if (or should-repl no-file)
(if
*compile-only* (flycheck stdin :source "stdin" :exit *exit-on-error*)
compile-only (flycheck stdin :source :stdin :exit exit-on-error)
(do
(if-not *quiet*
(if-not quiet
(print "Janet " janet/version "-" janet/build " " (os/which) "/" (os/arch) " - '(doc)' for help"))
(flush)
(defn getprompt [p]
@@ -3633,18 +3774,20 @@
(file/flush stdout)
(file/read stdin :line buf))
(def env (make-env))
(when-let [profile.janet (dyn :profilepath)]
(when-let [profile.janet (dyn *profilepath*)]
(def new-env (dofile profile.janet :exit true))
(merge-module env new-env "" false))
(if *debug* (put env :debug true))
(def getter (if *raw-stdin* getstdin getline))
(when debug-flag
(put env :debug true)
(put env :redef true))
(def getter (if raw-stdin getstdin getline))
(defn getchunk [buf p]
(getter (getprompt p) buf env))
(setdyn :pretty-format (if *colorize* "%.20Q" "%.20q"))
(setdyn :err-color (if *colorize* true))
(setdyn :doc-color (if *colorize* true))
(setdyn :lint-error *error-level*)
(setdyn :lint-warn *error-level*)
(setdyn :pretty-format (if colorize "%.20Q" "%.20q"))
(setdyn :err-color (if colorize true))
(setdyn :doc-color (if colorize true))
(setdyn :lint-error error-level)
(setdyn :lint-warn error-level)
(repl getchunk nil env)))))
###
@@ -3655,26 +3798,15 @@
(do
(defn proto-flatten
"Flatten a table and its prototypes into a single table."
[into x]
(when x
(proto-flatten into (table/getproto x))
(loop [k :keys x]
(put into k (x k))))
into)
# Deprecate thread library
(loop [[k v] :in (pairs root-env)
:when (symbol? k)
:when (string/has-prefix? "thread/" k)]
# Deprecate file/popen
(when-let [v (get root-env 'file/popen)]
(put v :deprecated true))
# Modify root-env to remove private symbols and
# flatten nested tables.
(loop [[k v] :in (pairs root-env)
:when (symbol? k)]
(def flat (proto-flatten @{} v))
(def flat (table/proto-flatten v))
(when (boot/config :no-docstrings)
(put flat :doc nil))
(when (boot/config :no-sourcemaps)
@@ -3754,7 +3886,6 @@
"src/core/struct.c"
"src/core/symcache.c"
"src/core/table.c"
"src/core/thread.c"
"src/core/tuple.c"
"src/core/util.c"
"src/core/value.c"

View File

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

View File

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

View File

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

View File

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

View File

@@ -4,10 +4,10 @@
#define JANETCONF_H
#define JANET_VERSION_MAJOR 1
#define JANET_VERSION_MINOR 17
#define JANET_VERSION_PATCH 1
#define JANET_VERSION_MINOR 21
#define JANET_VERSION_PATCH 2
#define JANET_VERSION_EXTRA ""
#define JANET_VERSION "1.17.1"
#define JANET_VERSION "1.21.2"
/* #define JANET_BUILD "local" */
@@ -48,6 +48,7 @@
/* #define JANET_OS_NAME my-custom-os */
/* #define JANET_ARCH_NAME pdp-8 */
/* #define JANET_EV_NO_EPOLL */
/* #define JANET_EV_NO_KQUEUE */
/* #define JANET_NO_INTERPRETER_INTERRUPT */
/* Custom vm allocator support */

View File

@@ -1,5 +1,5 @@
/*
* Copyright (c) 2021 Calvin Rose
* Copyright (c) 2022 Calvin Rose
*
* Permission is hereby granted, free of charge, to any person obtaining a copy
* of this software and associated documentation files (the "Software"), to
@@ -63,8 +63,8 @@ void *janet_abstract_begin_threaded(const JanetAbstractType *atype, size_t size)
}
janet_vm.next_collection += size + sizeof(JanetAbstractHead);
header->gc.flags = JANET_MEMORY_THREADED_ABSTRACT;
header->gc.next = NULL; /* Clear memory for address sanitizers */
header->gc.refcount = 1;
header->gc.data.next = NULL; /* Clear memory for address sanitizers */
header->gc.data.refcount = 1;
header->size = size;
header->type = atype;
void *abstract = (void *) & (header->data);
@@ -86,37 +86,37 @@ void *janet_abstract_threaded(const JanetAbstractType *atype, size_t size) {
#ifdef JANET_WINDOWS
static int32_t janet_incref(JanetAbstractHead *ab) {
return InterlockedIncrement(&ab->gc.refcount);
return InterlockedIncrement(&ab->gc.data.refcount);
}
static int32_t janet_decref(JanetAbstractHead *ab) {
return InterlockedDecrement(&ab->gc.refcount);
return InterlockedDecrement(&ab->gc.data.refcount);
}
void janet_os_mutex_init(JanetOSMutex *mutex) {
InitializeCriticalSection(mutex);
InitializeCriticalSection((CRITICAL_SECTION *) mutex);
}
void janet_os_mutex_deinit(JanetOSMutex *mutex) {
DeleteCriticalSection(mutex);
DeleteCriticalSection((CRITICAL_SECTION *) mutex);
}
void janet_os_mutex_lock(JanetOSMutex *mutex) {
EnterCriticalSection(mutex);
EnterCriticalSection((CRITICAL_SECTION *) mutex);
}
void janet_os_mutex_unlock(JanetOSMutex *mutex) {
LeaveCriticalSection(mutex);
LeaveCriticalSection((CRITICAL_SECTION *) mutex);
}
#else
static int32_t janet_incref(JanetAbstractHead *ab) {
return __atomic_add_fetch(&ab->gc.refcount, 1, __ATOMIC_RELAXED);
return __atomic_add_fetch(&ab->gc.data.refcount, 1, __ATOMIC_RELAXED);
}
static int32_t janet_decref(JanetAbstractHead *ab) {
return __atomic_add_fetch(&ab->gc.refcount, -1, __ATOMIC_RELAXED);
return __atomic_add_fetch(&ab->gc.data.refcount, -1, __ATOMIC_RELAXED);
}
void janet_os_mutex_init(JanetOSMutex *mutex) {

View File

@@ -1,5 +1,5 @@
/*
* Copyright (c) 2021 Calvin Rose
* Copyright (c) 2022 Calvin Rose
*
* Permission is hereby granted, free of charge, to any person obtaining a copy
* of this software and associated documentation files (the "Software"), to
@@ -241,6 +241,11 @@ JANET_CORE_FN(cfun_array_concat,
int32_t j, len = 0;
const Janet *vals = NULL;
janet_indexed_view(argv[i], &vals, &len);
if (array->data == vals) {
int32_t newcount = array->count + len;
janet_array_ensure(array, newcount, 2);
janet_indexed_view(argv[i], &vals, &len);
}
for (j = 0; j < len; j++)
janet_array_push(array, vals[j]);
}

View File

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

View File

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

View File

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

View File

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

View File

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

View File

@@ -1,5 +1,5 @@
/*
* Copyright (c) 2021 Calvin Rose
* Copyright (c) 2022 Calvin Rose
*
* Permission is hereby granted, free of charge, to any person obtaining a copy
* of this software and associated documentation files (the "Software"), to
@@ -197,6 +197,39 @@ void janetc_popscope_keepslot(JanetCompiler *c, JanetSlot retslot) {
}
}
static int lookup_missing(
JanetCompiler *c,
const uint8_t *sym,
JanetFunction *handler,
JanetBinding *out) {
int32_t minar = handler->def->min_arity;
int32_t maxar = handler->def->max_arity;
if (minar > 1 || maxar < 1) {
janetc_error(c, janet_cstring("missing symbol lookup handler must take 1 argument"));
return 0;
}
Janet args[1] = { janet_wrap_symbol(sym) };
JanetFiber *fiberp = janet_fiber(handler, 64, 1, args);
if (NULL == fiberp) {
janetc_error(c, janet_cstring("failed to call missing symbol lookup handler"));
return 0;
}
fiberp->env = c->env;
int lock = janet_gclock();
Janet tempOut;
JanetSignal status = janet_continue(fiberp, janet_wrap_nil(), &tempOut);
janet_gcunlock(lock);
if (status != JANET_SIGNAL_OK) {
janetc_error(c, janet_formatc("(lookup) %V", tempOut));
return 0;
}
/* Convert return value as entry. */
/* Alternative could use janet_resolve_ext(c->env, sym) to read result from environment. */
*out = janet_binding_from_entry(tempOut);
return 1;
}
/* Allow searching for symbols. Return information about the symbol */
JanetSlot janetc_resolve(
JanetCompiler *c,
@@ -230,6 +263,21 @@ JanetSlot janetc_resolve(
/* Symbol not found - check for global */
{
JanetBinding binding = janet_resolve_ext(c->env, sym);
if (binding.type == JANET_BINDING_NONE) {
Janet handler = janet_table_get(c->env, janet_ckeywordv("missing-symbol"));
switch (janet_type(handler)) {
case JANET_NIL:
break;
case JANET_FUNCTION:
if (!lookup_missing(c, sym, janet_unwrap_function(handler), &binding))
return janetc_cslot(janet_wrap_nil());
break;
default:
janetc_error(c, janet_formatc("invalid lookup handler %V", handler));
return janetc_cslot(janet_wrap_nil());
}
}
switch (binding.type) {
default:
case JANET_BINDING_NONE:
@@ -239,6 +287,12 @@ JanetSlot janetc_resolve(
case JANET_BINDING_MACRO: /* Macro should function like defs when not in calling pos */
ret = janetc_cslot(binding.value);
break;
case JANET_BINDING_DYNAMIC_DEF:
case JANET_BINDING_DYNAMIC_MACRO:
ret = janetc_cslot(binding.value);
ret.flags |= JANET_SLOT_REF | JANET_SLOT_NAMED | JANET_SLOTTYPE_ANY;
ret.flags &= ~JANET_SLOT_CONSTANT;
break;
case JANET_BINDING_VAR: {
ret = janetc_cslot(binding.value);
ret.flags |= JANET_SLOT_REF | JANET_SLOT_NAMED | JANET_SLOT_MUTABLE | JANET_SLOTTYPE_ANY;
@@ -651,7 +705,7 @@ static int macroexpand1(
}
Janet macroval;
JanetBindingType btype = janet_resolve(c->env, name, &macroval);
if (btype != JANET_BINDING_MACRO ||
if (!(btype == JANET_BINDING_MACRO || btype == JANET_BINDING_DYNAMIC_MACRO) ||
!janet_checktype(macroval, JANET_FUNCTION))
return 0;
@@ -958,7 +1012,14 @@ JANET_CORE_FN(cfun,
}
const uint8_t *source = NULL;
if (argc >= 3) {
source = janet_getstring(argv, 2);
Janet x = argv[2];
if (janet_checktype(x, JANET_STRING)) {
source = janet_unwrap_string(x);
} else if (janet_checktype(x, JANET_KEYWORD)) {
source = janet_unwrap_keyword(x);
} else {
janet_panic_type(x, 2, JANET_TFLAG_STRING | JANET_TFLAG_KEYWORD);
}
}
JanetArray *lints = (argc >= 4) ? janet_getarray(argv, 3) : NULL;
JanetCompileResult res = janet_compile_lint(argv[0], env, source, lints);

View File

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

View File

@@ -1,5 +1,5 @@
/*
* Copyright (c) 2021 Calvin Rose
* Copyright (c) 2022 Calvin Rose
*
* Permission is hereby granted, free of charge, to any person obtaining a copy
* of this software and associated documentation files (the "Software"), to
@@ -137,7 +137,7 @@ static const char *janet_dyncstring(const char *name, const char *dflt) {
const uint8_t *jstr = janet_unwrap_string(x);
const char *cstr = (const char *)jstr;
if (strlen(cstr) != (size_t) janet_string_length(jstr)) {
janet_panicf("string %v contains embedded 0s");
janet_panicf("string %v contains embedded 0s", x);
}
return cstr;
}
@@ -339,7 +339,10 @@ JANET_CORE_FN(janet_core_native,
JANET_CORE_FN(janet_core_describe,
"(describe x)",
"Returns a string that is a human-readable description of a value x.") {
"Returns a string that is a human-readable description of `x`. "
"For recursive data structures, the string returned contains a "
"pointer value from which the identity of `x` "
"can be determined.") {
JanetBuffer *b = janet_buffer(0);
for (int32_t i = 0; i < argc; ++i)
janet_description_b(b, argv[i]);
@@ -398,15 +401,21 @@ JANET_CORE_FN(janet_core_is_abstract,
}
JANET_CORE_FN(janet_core_scannumber,
"(scan-number str)",
"Parse a number from a byte sequence an return that number, either and integer "
"(scan-number str &opt base)",
"Parse a number from a byte sequence and return that number, either an integer "
"or a real. The number "
"must be in the same format as numbers in janet source code. Will return nil "
"on an invalid number.") {
"on an invalid number. Optionally provide a base - if a base is provided, no "
"radix specifier is expected at the beginning of the number.") {
double number;
janet_fixarity(argc, 1);
janet_arity(argc, 1, 2);
JanetByteView view = janet_getbytes(argv, 0);
if (janet_scan_number(view.bytes, view.len, &number))
int32_t base = janet_optinteger(argv, argc, 1, 0);
int valid = base == 0 || (base >= 2 && base <= 36);
if (!valid) {
janet_panicf("expected base between 2 and 36, got %d", base);
}
if (janet_scan_number_base(view.bytes, view.len, base, &number))
return janet_wrap_nil();
return janet_wrap_number(number);
}
@@ -459,6 +468,25 @@ JANET_CORE_FN(janet_core_table,
return janet_wrap_table(table);
}
JANET_CORE_FN(janet_core_getproto,
"(getproto x)",
"Get the prototype of a table or struct. Will return nil if `x` has no prototype.") {
janet_fixarity(argc, 1);
if (janet_checktype(argv[0], JANET_TABLE)) {
JanetTable *t = janet_unwrap_table(argv[0]);
return t->proto
? janet_wrap_table(t->proto)
: janet_wrap_nil();
}
if (janet_checktype(argv[0], JANET_STRUCT)) {
JanetStruct st = janet_unwrap_struct(argv[0]);
return janet_struct_proto(st)
? janet_wrap_struct(janet_struct_proto(st))
: janet_wrap_nil();
}
janet_panicf("expected struct|table, got %v", argv[0]);
}
JANET_CORE_FN(janet_core_struct,
"(struct & kvs)",
"Create a new struct from a sequence of key value pairs. "
@@ -466,8 +494,9 @@ JANET_CORE_FN(janet_core_struct,
"an odd number of elements, an error will be thrown. Returns the "
"new struct.") {
int32_t i;
if (argc & 1)
if (argc & 1) {
janet_panic("expected even number of arguments");
}
JanetKV *st = janet_struct_begin(argc >> 1);
for (i = 0; i < argc; i += 2) {
janet_struct_put(st, argv[i], argv[i + 1]);
@@ -954,6 +983,7 @@ static void janet_load_libs(JanetTable *env) {
JANET_CORE_REG("nat?", janet_core_check_nat),
JANET_CORE_REG("slice", janet_core_slice),
JANET_CORE_REG("signal", janet_core_signal),
JANET_CORE_REG("getproto", janet_core_getproto),
JANET_REG_END
};
janet_core_cfuns_ext(env, NULL, corelib_cfuns);
@@ -963,6 +993,7 @@ static void janet_load_libs(JanetTable *env) {
janet_lib_tuple(env);
janet_lib_buffer(env);
janet_lib_table(env);
janet_lib_struct(env);
janet_lib_fiber(env);
janet_lib_os(env);
janet_lib_parse(env);
@@ -979,9 +1010,6 @@ static void janet_load_libs(JanetTable *env) {
#ifdef JANET_INT_TYPES
janet_lib_inttypes(env);
#endif
#ifdef JANET_THREADS
janet_lib_thread(env);
#endif
#ifdef JANET_EV
janet_lib_ev(env);
#endif

View File

@@ -1,5 +1,5 @@
/*
* Copyright (c) 2021 Calvin Rose
* Copyright (c) 2022 Calvin Rose
*
* Permission is hereby granted, free of charge, to any person obtaining a copy
* of this software and associated documentation files (the "Software"), to
@@ -86,7 +86,7 @@ void janet_debug_find(
}
}
}
current = current->next;
current = current->data.next;
}
if (best_def) {
*def_out = best_def;
@@ -96,15 +96,19 @@ void janet_debug_find(
}
}
void janet_stacktrace(JanetFiber *fiber, Janet err) {
const char *prefix = janet_checktype(err, JANET_NIL) ? NULL : "";
janet_stacktrace_ext(fiber, err, prefix);
}
/* Error reporting. This can be emulated from within Janet, but for
* consitency with the top level code it is defined once. */
void janet_stacktrace(JanetFiber *fiber, Janet err) {
void janet_stacktrace_ext(JanetFiber *fiber, Janet err, const char *prefix) {
int32_t fi;
const char *errstr = (const char *)janet_to_string(err);
JanetFiber **fibers = NULL;
/* Don't print error line if it is nil. */
int wrote_error = janet_checktype(err, JANET_NIL);
int wrote_error = !prefix;
int print_color = janet_truthy(janet_dyn("err-color"));
if (print_color) janet_eprintf("\x1b[31m");
@@ -126,7 +130,6 @@ void janet_stacktrace(JanetFiber *fiber, Janet err) {
/* Print prelude to stack frame */
if (!wrote_error) {
JanetFiberStatus status = janet_fiber_status(fiber);
const char *prefix = status == JANET_STATUS_ERROR ? "" : "status ";
janet_eprintf("%s%s: %s\n",
prefix,
janet_status_names[status],
@@ -337,9 +340,9 @@ JANET_CORE_FN(cfun_debug_stack,
"stack frame is the first table in the array, and the bottom-most stack frame "
"is the last value. Each stack frame contains some of the following attributes:\n\n"
"* :c - true if the stack frame is a c function invocation\n\n"
"* :column - the current source column of the stack frame\n\n"
"* :source-column - the current source column of the stack frame\n\n"
"* :function - the function that the stack frame represents\n\n"
"* :line - the current source line of the stack frame\n\n"
"* :source-line - the current source line of the stack frame\n\n"
"* :name - the human-friendly name of the function\n\n"
"* :pc - integer indicating the location of the program counter\n\n"
"* :source - string with the file path or other identifier for the source code\n\n"
@@ -361,14 +364,15 @@ JANET_CORE_FN(cfun_debug_stack,
}
JANET_CORE_FN(cfun_debug_stacktrace,
"(debug/stacktrace fiber &opt err)",
"(debug/stacktrace fiber &opt err prefix)",
"Prints a nice looking stacktrace for a fiber. Can optionally provide "
"an error value to print the stack trace with. If `err` is nil or not "
"provided, will skip the error line. Returns the fiber.") {
janet_arity(argc, 1, 2);
"provided, and no prefix is given, will skip the error line. Returns the fiber.") {
janet_arity(argc, 1, 3);
JanetFiber *fiber = janet_getfiber(argv, 0);
Janet x = argc == 1 ? janet_wrap_nil() : argv[1];
janet_stacktrace(fiber, x);
const char *prefix = janet_optcstring(argv, argc, 2, NULL);
janet_stacktrace_ext(fiber, x, prefix);
return argv[0];
}

View File

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

View File

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

View File

@@ -1,4 +1,14 @@
/* The above copyright notice and this permission notice shall be included in
/*
* Copyright (c) 2022 Calvin Rose
*
* Permission is hereby granted, free of charge, to any person obtaining a copy
* of this software and associated documentation files (the "Software"), to
* deal in the Software without restriction, including without limitation the
* rights to use, copy, modify, merge, publish, distribute, sublicense, and/or
* sell copies of the Software, and to permit persons to whom the Software is
* furnished to do so, subject to the following conditions:
*
* The above copyright notice and this permission notice shall be included in
* all copies or substantial portions of the Software.
*
* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
@@ -10,6 +20,7 @@
* IN THE SOFTWARE.
*/
#ifndef JANET_AMALG
#include "features.h"
#include <janet.h>
@@ -43,6 +54,9 @@
#include <sys/epoll.h>
#include <sys/timerfd.h>
#endif
#ifdef JANET_EV_KQUEUE
#include <sys/event.h>
#endif
#endif
typedef struct {
@@ -72,6 +86,7 @@ typedef struct {
JanetFiber *fiber;
Janet value;
JanetSignal sig;
uint32_t expected_sched_id; /* If the fiber has been rescheduled this loop, don't run first scheduling. */
} JanetTask;
/* Wrap return value by pairing it with the callback used to handle it
@@ -219,6 +234,9 @@ static void add_timeout(JanetTimeout to) {
/* Create a new event listener */
static JanetListenerState *janet_listen_impl(JanetStream *stream, JanetListener behavior, int mask, size_t size, void *user) {
if (stream->flags & JANET_STREAM_CLOSED) {
janet_panic("cannot listen on closed stream");
}
if (stream->_mask & mask) {
janet_panic("cannot listen for duplicate event on stream");
}
@@ -329,8 +347,10 @@ static void janet_stream_close_impl(JanetStream *stream, int is_gc) {
{
CloseHandle(stream->handle);
}
stream->handle = INVALID_HANDLE_VALUE;
#else
close(stream->handle);
stream->handle = -1;
#endif
}
@@ -444,10 +464,10 @@ const JanetAbstractType janet_stream_type = {
/* Register a fiber to resume with value */
void janet_schedule_signal(JanetFiber *fiber, Janet value, JanetSignal sig) {
if (fiber->flags & JANET_FIBER_FLAG_SCHEDULED) return;
fiber->flags |= JANET_FIBER_FLAG_SCHEDULED;
fiber->sched_id++;
JanetTask t = { fiber, value, sig };
if (fiber->gc.flags & JANET_FIBER_EV_FLAG_CANCELED) return;
fiber->gc.flags |= JANET_FIBER_FLAG_ROOT;
JanetTask t = { fiber, value, sig, ++fiber->sched_id };
if (sig == JANET_SIGNAL_ERROR) fiber->gc.flags |= JANET_FIBER_EV_FLAG_CANCELED;
janet_q_push(&janet_vm.spawn, &t, sizeof(t));
}
@@ -510,10 +530,10 @@ void janet_ev_mark(void) {
static int janet_channel_push(JanetChannel *channel, Janet x, int mode);
static int janet_channel_pop(JanetChannel *channel, Janet *item, int is_choice);
static Janet make_supervisor_event(const char *name, JanetFiber *fiber) {
static Janet make_supervisor_event(const char *name, JanetFiber *fiber, int threaded) {
Janet tup[2];
tup[0] = janet_ckeywordv(name);
tup[1] = janet_wrap_fiber(fiber);
tup[1] = threaded ? fiber->last_value : janet_wrap_fiber(fiber) ;
return janet_wrap_tuple(janet_tuple_n(tup, 2));
}
@@ -601,7 +621,7 @@ static int janet_chan_unpack(JanetChannel *chan, Janet *x, int is_cleanup) {
return 1;
case JANET_BUFFER: {
JanetBuffer *buf = janet_unwrap_buffer(*x);
int flags = is_cleanup ? JANET_MARSHAL_UNSAFE : (JANET_MARSHAL_UNSAFE | JANET_MARSHAL_DECREF);
int flags = is_cleanup ? (JANET_MARSHAL_UNSAFE | JANET_MARSHAL_DECREF) : JANET_MARSHAL_UNSAFE;
*x = janet_unmarshal(buf->data, buf->count, flags, NULL, NULL);
janet_buffer_deinit(buf);
janet_free(buf);
@@ -725,7 +745,6 @@ static void janet_thread_chan_cb(JanetEVGenericMessage msg) {
int mode = msg.tag;
JanetChannel *channel = (JanetChannel *) msg.argp;
Janet x = msg.argj;
janet_ev_dec_refcount();
if (fiber->sched_id == sched_id) {
if (mode == JANET_CP_MODE_CHOICE_READ) {
janet_assert(!janet_chan_unpack(channel, &x, 0), "packing error");
@@ -819,7 +838,6 @@ static int janet_channel_push(JanetChannel *channel, Janet x, int mode) {
janet_q_push(&channel->write_pending, &pending, sizeof(pending));
janet_chan_unlock(channel);
if (is_threaded) {
janet_ev_inc_refcount();
janet_gcroot(janet_wrap_fiber(pending.fiber));
}
return 1;
@@ -869,7 +887,6 @@ static int janet_channel_pop(JanetChannel *channel, Janet *item, int is_choice)
janet_q_push(&channel->read_pending, &pending, sizeof(pending));
janet_chan_unlock(channel);
if (is_threaded) {
janet_ev_inc_refcount();
janet_gcroot(janet_wrap_fiber(pending.fiber));
}
return 0;
@@ -958,23 +975,30 @@ JANET_CORE_FN(cfun_channel_choice,
JanetChannel *chan = janet_getchannel(data, 0);
janet_chan_lock(chan);
if (chan->closed) {
janet_chan_unlock(chan);
return make_close_result(chan);
}
if (janet_q_count(&chan->items) < chan->limit) {
janet_chan_unlock(chan);
janet_channel_push(chan, data[1], 1);
return make_write_result(chan);
}
janet_chan_unlock(chan);
} else {
/* Read */
JanetChannel *chan = janet_getchannel(argv, i);
janet_chan_lock(chan);
if (chan->closed) {
janet_chan_unlock(chan);
return make_close_result(chan);
}
if (chan->items.head != chan->items.tail) {
Janet item;
janet_chan_unlock(chan);
janet_channel_pop(chan, &item, 1);
return make_read_result(chan, item);
}
janet_chan_unlock(chan);
}
}
@@ -983,13 +1007,11 @@ JANET_CORE_FN(cfun_channel_choice,
if (janet_indexed_view(argv[i], &data, &len) && len == 2) {
/* Write */
JanetChannel *chan = janet_getchannel(data, 0);
if (chan->closed) continue;
janet_channel_push(chan, data[1], 1);
} else {
/* Read */
Janet item;
JanetChannel *chan = janet_getchannel(argv, i);
if (chan->closed) continue;
janet_channel_pop(chan, &item, 1);
}
}
@@ -1179,13 +1201,13 @@ JanetFiber *janet_loop1(void) {
if (to.curr_fiber != NULL) {
/* This is a deadline (for a fiber, not a function call) */
JanetFiberStatus s = janet_fiber_status(to.curr_fiber);
int isFinished = s == (JANET_STATUS_DEAD ||
s == JANET_STATUS_ERROR ||
s == JANET_STATUS_USER0 ||
s == JANET_STATUS_USER1 ||
s == JANET_STATUS_USER2 ||
s == JANET_STATUS_USER3 ||
s == JANET_STATUS_USER4);
int isFinished = (s == JANET_STATUS_DEAD ||
s == JANET_STATUS_ERROR ||
s == JANET_STATUS_USER0 ||
s == JANET_STATUS_USER1 ||
s == JANET_STATUS_USER2 ||
s == JANET_STATUS_USER3 ||
s == JANET_STATUS_USER4);
if (!isFinished) {
janet_cancel(to.fiber, janet_cstringv("deadline expired"));
}
@@ -1203,19 +1225,29 @@ JanetFiber *janet_loop1(void) {
/* Run scheduled fibers */
while (janet_vm.spawn.head != janet_vm.spawn.tail) {
JanetTask task = {NULL, janet_wrap_nil(), JANET_SIGNAL_OK};
JanetTask task = {NULL, janet_wrap_nil(), JANET_SIGNAL_OK, 0};
janet_q_pop(&janet_vm.spawn, &task, sizeof(task));
task.fiber->flags &= ~JANET_FIBER_FLAG_SCHEDULED;
if (task.fiber->gc.flags & JANET_FIBER_EV_FLAG_SUSPENDED) janet_ev_dec_refcount();
task.fiber->gc.flags &= ~(JANET_FIBER_EV_FLAG_CANCELED | JANET_FIBER_EV_FLAG_SUSPENDED);
if (task.expected_sched_id != task.fiber->sched_id) continue;
Janet res;
JanetSignal sig = janet_continue_signal(task.fiber, task.value, &res, task.sig);
void *sv = task.fiber->supervisor_channel;
int is_suspended = sig == JANET_SIGNAL_EVENT || sig == JANET_SIGNAL_YIELD || sig == JANET_SIGNAL_INTERRUPT;
if (is_suspended) {
task.fiber->gc.flags |= JANET_FIBER_EV_FLAG_SUSPENDED;
janet_ev_inc_refcount();
}
if (NULL == sv) {
if (sig != JANET_SIGNAL_EVENT && sig != JANET_SIGNAL_YIELD && sig != JANET_SIGNAL_INTERRUPT) {
janet_stacktrace(task.fiber, res);
if (!is_suspended) {
janet_stacktrace_ext(task.fiber, res, "");
}
} else if (sig == JANET_SIGNAL_OK || (task.fiber->flags & (1 << sig))) {
JanetChannel *chan = janet_channel_unwrap(sv);
janet_channel_push(chan, make_supervisor_event(janet_signal_names[sig], task.fiber), 2);
janet_channel_push(chan, make_supervisor_event(janet_signal_names[sig],
task.fiber, chan->is_threaded), 2);
} else if (!is_suspended) {
janet_stacktrace_ext(task.fiber, res, "");
}
if (sig == JANET_SIGNAL_INTERRUPT) {
/* On interrupts, return the interrupted fiber immediately */
@@ -1229,8 +1261,25 @@ JanetFiber *janet_loop1(void) {
memset(&to, 0, sizeof(to));
int has_timeout;
/* Drop timeouts that are no longer needed */
while ((has_timeout = peek_timeout(&to)) && (to.curr_fiber == NULL) && to.fiber->sched_id != to.sched_id) {
pop_timeout(0);
while ((has_timeout = peek_timeout(&to))) {
if (to.curr_fiber != NULL) {
JanetFiberStatus s = janet_fiber_status(to.curr_fiber);
int is_finished = (s == JANET_STATUS_DEAD ||
s == JANET_STATUS_ERROR ||
s == JANET_STATUS_USER0 ||
s == JANET_STATUS_USER1 ||
s == JANET_STATUS_USER2 ||
s == JANET_STATUS_USER3 ||
s == JANET_STATUS_USER4);
if (is_finished) {
pop_timeout(0);
continue;
}
} else if (to.fiber->sched_id != to.sched_id) {
pop_timeout(0);
continue;
}
break;
}
/* Run polling implementation only if pending timeouts or pending events */
if (janet_vm.tq_count || janet_vm.listener_count || janet_vm.extra_listeners) {
@@ -1403,7 +1452,7 @@ static void janet_epoll_sync_callback(JanetEVGenericMessage msg) {
JanetAsyncStatus status2 = JANET_ASYNC_STATUS_NOT_DONE;
if (state->stream->_mask & JANET_ASYNC_LISTEN_WRITE)
status1 = state->machine(state, JANET_ASYNC_EVENT_WRITE);
if (state->stream->_mask & JANET_ASYNC_LISTEN_WRITE)
if (state->stream->_mask & JANET_ASYNC_LISTEN_READ)
status2 = state->machine(state, JANET_ASYNC_EVENT_READ);
if (status1 == JANET_ASYNC_STATUS_DONE ||
status2 == JANET_ASYNC_STATUS_DONE) {
@@ -1506,8 +1555,8 @@ void janet_loop1_impl(int has_timeout, JanetTimestamp timeout) {
JanetStream *stream = p;
int mask = events[i].events;
JanetListenerState *state = stream->state;
state->event = events + i;
while (NULL != state) {
state->event = events + i;
JanetListenerState *next_state = state->_next;
JanetAsyncStatus status1 = JANET_ASYNC_STATUS_NOT_DONE;
JanetAsyncStatus status2 = JANET_ASYNC_STATUS_NOT_DONE;
@@ -1563,6 +1612,194 @@ void janet_ev_deinit(void) {
* End epoll implementation
*/
#elif defined(JANET_EV_KQUEUE)
/* Definition from:
* https://github.com/wahern/cqueues/blob/master/src/lib/kpoll.c
* NetBSD uses intptr_t while others use void * for .udata */
#define EV_SETx(ev, a, b, c, d, e, f) EV_SET((ev), (a), (b), (c), (d), (e), ((__typeof__((ev)->udata))(f)))
#define JANET_KQUEUE_TF (EV_ADD | EV_ENABLE | EV_CLEAR | EV_ONESHOT)
#define JANET_KQUEUE_MIN_INTERVAL 0
/* NOTE:
* NetBSD and OpenBSD expect things are always intervals, and FreeBSD doesn't
* like an ABSTIME in the past so just use intervals always. Introduces a
* calculation to determine the minimum timeout per timeout requested of
* kqueue. Also note that NetBSD doesn't accept timeout intervals less than 1
* millisecond, so correct all intervals on that platform to be at least 1
* millisecond.*/
JanetTimestamp to_interval(const JanetTimestamp ts) {
return ts >= JANET_KQUEUE_MIN_INTERVAL ? ts : JANET_KQUEUE_MIN_INTERVAL;
}
#define JANET_KQUEUE_INTERVAL(timestamp) (to_interval((timestamp - ts_now())))
static JanetTimestamp ts_now(void) {
struct timespec now;
janet_assert(-1 != clock_gettime(CLOCK_MONOTONIC, &now), "failed to get time");
uint64_t res = 1000 * now.tv_sec;
res += now.tv_nsec / 1000000;
return res;
}
/* NOTE: Assumes Janet's timestamp precision is in milliseconds. */
static void timestamp2timespec(struct timespec *t, JanetTimestamp ts) {
t->tv_sec = ts == 0 ? 0 : ts / 1000;
t->tv_nsec = ts == 0 ? 0 : (ts % 1000) * 1000000;
}
void add_kqueue_events(const struct kevent *events, int length) {
/* NOTE: Status should be equal to the amount of events added, which isn't
* always known since deletions or modifications occur. Can't use the
* eventlist argument for it to report to us what failed otherwise we may
* poll in events to handle! This code assumes atomicity, that kqueue can
* either succeed or fail, but never partially (which is seemingly how it
* works in practice). When encountering an "inbetween" state we currently
* just panic!
*
* The FreeBSD man page kqueue(2) shows a check through the change list to
* check if kqueue had an error with any of the events being pushed to
* change. Maybe we should do this, even tho the man page also doesn't
* note that kqueue actually does this. We do not do this at this time. */
int status;
status = kevent(janet_vm.kq, events, length, NULL, 0, NULL);
if (status == -1 && errno != EINTR)
janet_panicv(janet_ev_lasterr());
}
JanetListenerState *janet_listen(JanetStream *stream, JanetListener behavior, int mask, size_t size, void *user) {
JanetListenerState *state = janet_listen_impl(stream, behavior, mask, size, user);
struct kevent kev[2];
int length = 0;
if (state->stream->_mask & JANET_ASYNC_LISTEN_READ) {
EV_SETx(&kev[length], stream->handle, EVFILT_READ, EV_ADD | EV_ENABLE, 0, 0, stream);
length++;
}
if (state->stream->_mask & JANET_ASYNC_LISTEN_WRITE) {
EV_SETx(&kev[length], stream->handle, EVFILT_WRITE, EV_ADD | EV_ENABLE, 0, 0, stream);
length++;
}
if (length > 0) {
add_kqueue_events(kev, length);
}
return state;
}
static void janet_unlisten(JanetListenerState *state, int is_gc) {
JanetStream *stream = state->stream;
if (!(stream->flags & JANET_STREAM_CLOSED)) {
/* Use flag to indicate state is not registered in kqueue */
if (!(state->_mask & (1 << JANET_ASYNC_EVENT_COMPLETE))) {
int is_last = (state->_next == NULL && stream->state == state);
int op = is_last ? EV_DELETE : EV_DISABLE | EV_ADD;
struct kevent kev[2];
EV_SETx(&kev[1], stream->handle, EVFILT_WRITE, op, 0, 0, stream);
int length = 0;
if (stream->_mask & JANET_ASYNC_EVENT_WRITE) {
EV_SETx(&kev[length], stream->handle, EVFILT_WRITE, op, 0, 0, stream);
length++;
}
if (stream->_mask & JANET_ASYNC_EVENT_READ) {
EV_SETx(&kev[length], stream->handle, EVFILT_READ, op, 0, 0, stream);
length++;
}
add_kqueue_events(kev, length);
}
}
janet_unlisten_impl(state, is_gc);
}
#define JANET_KQUEUE_MAX_EVENTS 64
void janet_loop1_impl(int has_timeout, JanetTimestamp timeout) {
/* Poll for events */
/* NOTE:
* We calculate the timeout interval per iteration. When the interval
* drops to 0 or negative, we effect a timeout of 0. Effecting a timeout
* of infinity will not work and could make other fibers with timeouts
* miss their timeouts if we did so.
* JANET_KQUEUE_INTERVAL insures we have a timeout of no less than 0. */
int status;
struct timespec ts;
struct kevent events[JANET_KQUEUE_MAX_EVENTS];
do {
if (janet_vm.timer_enabled || has_timeout) {
timestamp2timespec(&ts, JANET_KQUEUE_INTERVAL(timeout));
status = kevent(janet_vm.kq, NULL, 0, events,
JANET_KQUEUE_MAX_EVENTS, &ts);
} else {
status = kevent(janet_vm.kq, NULL, 0, events,
JANET_KQUEUE_MAX_EVENTS, NULL);
}
} while (status == -1 && errno == EINTR);
if (status == -1)
JANET_EXIT("failed to poll events");
/* Make sure timer is set accordingly. */
janet_vm.timer_enabled = has_timeout;
/* Step state machines */
for (int i = 0; i < status; i++) {
void *p = (void *) events[i].udata;
if (janet_vm.selfpipe == p) {
/* Self-pipe handling */
janet_ev_handle_selfpipe();
} else {
JanetStream *stream = p;
JanetListenerState *state = stream->state;
while (NULL != state) {
JanetListenerState *next_state = state->_next;
state->event = events + i;
JanetAsyncStatus statuses[4];
for (int i = 0; i < 4; i++)
statuses[i] = JANET_ASYNC_STATUS_NOT_DONE;
if (!(events[i].flags & EV_ERROR)) {
if (events[i].filter == EVFILT_WRITE)
statuses[0] = state->machine(state, JANET_ASYNC_EVENT_WRITE);
if (events[i].filter == EVFILT_READ)
statuses[1] = state->machine(state, JANET_ASYNC_EVENT_READ);
if ((events[i].flags & EV_EOF) && !(events[i].data > 0))
statuses[3] = state->machine(state, JANET_ASYNC_EVENT_HUP);
} else {
statuses[2] = state->machine(state, JANET_ASYNC_EVENT_ERR);
}
if (statuses[0] == JANET_ASYNC_STATUS_DONE ||
statuses[1] == JANET_ASYNC_STATUS_DONE ||
statuses[2] == JANET_ASYNC_STATUS_DONE ||
statuses[3] == JANET_ASYNC_STATUS_DONE)
janet_unlisten(state, 0);
state = next_state;
}
}
}
}
void janet_ev_init(void) {
janet_ev_init_common();
janet_ev_setup_selfpipe();
janet_vm.kq = kqueue();
janet_vm.timer_enabled = 0;
if (janet_vm.kq == -1) goto error;
struct kevent event;
EV_SETx(&event, janet_vm.selfpipe[0], EVFILT_READ, EV_ADD | EV_ENABLE, 0, 0, janet_vm.selfpipe);
add_kqueue_events(&event, 1);
return;
error:
JANET_EXIT("failed to initialize event loop");
}
void janet_ev_deinit(void) {
janet_ev_deinit_common();
close(janet_vm.kq);
janet_ev_cleanup_selfpipe();
janet_vm.kq = 0;
}
#else
#include <poll.h>
@@ -1997,6 +2234,10 @@ JanetAsyncStatus ev_machine_read(JanetListenerState *s, JanetAsyncEvent event) {
} else
#endif
{
/* Some handles (not all) read from the offset in lopOverlapped
* if its not set before calling `ReadFile` these streams will always read from offset 0 */
state->overlapped.Offset = (DWORD) state->bytes_read;
status = ReadFile(s->stream->handle, state->chunk_buf, chunk_size, NULL, &state->overlapped);
if (!status && (ERROR_IO_PENDING != WSAGetLastError())) {
if (WSAGetLastError() == ERROR_BROKEN_PIPE) {
@@ -2026,7 +2267,7 @@ JanetAsyncStatus ev_machine_read(JanetListenerState *s, JanetAsyncEvent event) {
case JANET_ASYNC_EVENT_READ: {
JanetBuffer *buffer = state->buf;
int32_t bytes_left = state->bytes_left;
int32_t read_limit = bytes_left > 4096 ? 4096 : bytes_left;
int32_t read_limit = state->is_chunk ? (bytes_left > 4096 ? 4096 : bytes_left) : bytes_left;
janet_buffer_extra(buffer, read_limit);
ssize_t nread;
#ifdef JANET_NET
@@ -2362,15 +2603,16 @@ void janet_ev_sendto_string(JanetStream *stream, JanetString str, void *dest, in
static volatile long PipeSerialNumber;
#endif
/*
* mode = 0: both sides non-blocking.
* mode = 1: only read side non-blocking: write side sent to subprocess
* mode = 2: only write side non-blocking: read side sent to subprocess
*/
int janet_make_pipe(JanetHandle handles[2], int mode) {
#ifdef JANET_WINDOWS
/*
* On windows, the built in CreatePipe function doesn't support overlapped IO
* so we lift from the windows source code and modify for our own version.
*
* mode = 0: both sides non-blocking.
* mode = 1: only read side non-blocking: write side sent to subprocess
* mode = 2: only write side non-blocking: read side sent to subprocess
*/
JanetHandle shandle, chandle;
UCHAR PipeNameBuffer[MAX_PATH];
@@ -2420,10 +2662,11 @@ int janet_make_pipe(JanetHandle handles[2], int mode) {
}
return 0;
#else
(void) mode;
if (pipe(handles)) return -1;
if (fcntl(handles[0], F_SETFL, O_NONBLOCK)) goto error;
if (fcntl(handles[1], F_SETFL, O_NONBLOCK)) goto error;
if (mode != 2 && fcntl(handles[0], F_SETFD, FD_CLOEXEC)) goto error;
if (mode != 1 && fcntl(handles[1], F_SETFD, FD_CLOEXEC)) goto error;
if (mode != 2 && fcntl(handles[0], F_SETFL, O_NONBLOCK)) goto error;
if (mode != 1 && fcntl(handles[1], F_SETFL, O_NONBLOCK)) goto error;
return 0;
error:
close(handles[0]);
@@ -2442,12 +2685,34 @@ JANET_CORE_FN(cfun_ev_go,
"events occur in the newly scheduled fiber, an event will be pushed to the supervisor. "
"If not provided, the new fiber will inherit the current supervisor.") {
janet_arity(argc, 1, 3);
JanetFiber *fiber = janet_getfiber(argv, 0);
Janet value = argc >= 2 ? argv[1] : janet_wrap_nil();
void *supervisor = janet_optabstract(argv, argc, 2, &janet_channel_type, janet_vm.root_fiber->supervisor_channel);
JanetFiber *fiber;
if (janet_checktype(argv[0], JANET_FUNCTION)) {
/* Create a fiber for the user */
JanetFunction *func = janet_unwrap_function(argv[0]);
if (func->def->min_arity > 1) {
janet_panicf("task function must accept 0 or 1 arguments");
}
fiber = janet_fiber(func, 64, func->def->min_arity, &value);
fiber->flags |=
JANET_FIBER_MASK_ERROR |
JANET_FIBER_MASK_USER0 |
JANET_FIBER_MASK_USER1 |
JANET_FIBER_MASK_USER2 |
JANET_FIBER_MASK_USER3 |
JANET_FIBER_MASK_USER4;
if (!janet_vm.fiber->env) {
janet_vm.fiber->env = janet_table(0);
}
fiber->env = janet_table(0);
fiber->env->proto = janet_vm.fiber->env;
} else {
fiber = janet_getfiber(argv, 0);
}
fiber->supervisor_channel = supervisor;
janet_schedule(fiber, value);
return argv[0];
return janet_wrap_fiber(fiber);
}
/* For ev/thread - Run an interpreter in the new thread. */
@@ -2504,8 +2769,26 @@ static JanetEVGenericMessage janet_go_thread_subr(JanetEVGenericMessage args) {
JANET_MARSHAL_UNSAFE, NULL, &nextbytes);
Janet value = janet_unmarshal(nextbytes, endbytes - nextbytes,
JANET_MARSHAL_UNSAFE, NULL, &nextbytes);
if (!janet_checktype(fiberv, JANET_FIBER)) janet_panicf("expected fiber, got %v", fiberv);
JanetFiber *fiber = janet_unwrap_fiber(fiberv);
JanetFiber *fiber;
if (!janet_checktype(fiberv, JANET_FIBER)) {
if (!janet_checktype(fiberv, JANET_FUNCTION)) {
janet_panicf("expected function|fiber, got %v", fiberv);
}
JanetFunction *func = janet_unwrap_function(fiberv);
if (func->def->min_arity > 1) {
janet_panicf("thread function must accept 0 or 1 arguments");
}
fiber = janet_fiber(func, 64, func->def->min_arity, &value);
fiber->flags |=
JANET_FIBER_MASK_ERROR |
JANET_FIBER_MASK_USER0 |
JANET_FIBER_MASK_USER1 |
JANET_FIBER_MASK_USER2 |
JANET_FIBER_MASK_USER3 |
JANET_FIBER_MASK_USER4;
} else {
fiber = janet_unwrap_fiber(fiberv);
}
fiber->supervisor_channel = janet_vm.user;
janet_schedule(fiber, value);
janet_loop();
@@ -2542,9 +2825,10 @@ static JanetEVGenericMessage janet_go_thread_subr(JanetEVGenericMessage args) {
}
JANET_CORE_FN(cfun_ev_thread,
"(ev/thread fiber &opt value flags supervisor)",
"Resume a (copy of a) `fiber` in a new operating system thread, optionally passing `value` "
"to resume with. "
"(ev/thread main &opt value flags supervisor)",
"Run `main` in a new operating system thread, optionally passing `value` "
"to resume with. The parameter `main` can either be a fiber, or a function that accepts "
"0 or 1 arguments. "
"Unlike `ev/go`, this function will suspend the current fiber until the thread is complete. "
"If you want to run the thread without waiting for a result, pass the `:n` flag to return nil immediately. "
"Otherwise, returns nil. Available flags:\n\n"
@@ -2552,8 +2836,8 @@ JANET_CORE_FN(cfun_ev_thread,
"* `:a` - don't copy abstract registry to new thread (performance optimization)\n"
"* `:c` - don't copy cfunction registry to new thread (performance optimization)") {
janet_arity(argc, 1, 4);
janet_getfiber(argv, 0);
Janet value = argc >= 2 ? argv[1] : janet_wrap_nil();
if (!janet_checktype(argv[0], JANET_FUNCTION)) janet_getfiber(argv, 0);
uint64_t flags = 0;
if (argc >= 3) {
flags = janet_getflags(argv, 2, "nac");
@@ -2653,7 +2937,7 @@ JANET_CORE_FN(cfun_ev_deadline,
JANET_CORE_FN(cfun_ev_cancel,
"(ev/cancel fiber err)",
"Cancel a suspended fiber in the event loop. Differs from cancel in that it returns the canceled fiber immediately") {
"Cancel a suspended fiber in the event loop. Differs from cancel in that it returns the canceled fiber immediately.") {
janet_fixarity(argc, 2);
JanetFiber *fiber = janet_getfiber(argv, 0);
Janet err = argv[1];

View File

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

View File

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

View File

@@ -1,5 +1,5 @@
/*
* Copyright (c) 2021 Calvin Rose
* Copyright (c) 2022 Calvin Rose
*
* Permission is hereby granted, free of charge, to any person obtaining a copy
* of this software and associated documentation files (the "Software"), to
@@ -47,7 +47,6 @@
#define JANET_FIBER_MASK_USER 0x3FF0
#define JANET_FIBER_STATUS_MASK 0x3F0000
#define JANET_FIBER_FLAG_SCHEDULED 0x800000
#define JANET_FIBER_RESUME_SIGNAL 0x400000
#define JANET_FIBER_STATUS_OFFSET 16
@@ -57,6 +56,10 @@
#define JANET_FIBER_DID_LONGJUMP 0x8000000
#define JANET_FIBER_FLAG_MASK 0xF000000
#define JANET_FIBER_EV_FLAG_CANCELED 0x10000
#define JANET_FIBER_EV_FLAG_SUSPENDED 0x20000
#define JANET_FIBER_FLAG_ROOT 0x40000
#define janet_fiber_set_status(f, s) do {\
(f)->flags &= ~JANET_FIBER_STATUS_MASK;\
(f)->flags |= (s) << JANET_FIBER_STATUS_OFFSET;\

View File

@@ -1,5 +1,5 @@
/*
* Copyright (c) 2021 Calvin Rose
* Copyright (c) 2022 Calvin Rose
*
* Permission is hereby granted, free of charge, to any person obtaining a copy
* of this software and associated documentation files (the "Software"), to
@@ -123,6 +123,8 @@ static void janet_mark_abstract(void *adata) {
/* Mark a bunch of items in memory */
static void janet_mark_many(const Janet *values, int32_t n) {
if (values == NULL)
return;
const Janet *end = values + n;
while (values < end) {
janet_mark(*values);
@@ -160,10 +162,13 @@ recur: /* Manual tail recursion */
}
static void janet_mark_struct(const JanetKV *st) {
recur:
if (janet_gc_reachable(janet_struct_head(st)))
return;
janet_gc_mark(janet_struct_head(st));
janet_mark_kvs(st, janet_struct_capacity(st));
st = janet_struct_proto(st);
if (st) goto recur;
}
static void janet_mark_tuple(const Janet *tuple) {
@@ -321,7 +326,7 @@ void janet_sweep() {
JanetGCObject *current = janet_vm.blocks;
JanetGCObject *next;
while (NULL != current) {
next = current->next;
next = current->data.next;
if (current->flags & (JANET_MEM_REACHABLE | JANET_MEM_DISABLED)) {
previous = current;
current->flags &= ~JANET_MEM_REACHABLE;
@@ -329,7 +334,7 @@ void janet_sweep() {
janet_vm.block_count--;
janet_deinit_block(current);
if (NULL != previous) {
previous->next = next;
previous->data.next = next;
} else {
janet_vm.blocks = next;
}
@@ -393,7 +398,7 @@ void *janet_gcalloc(enum JanetMemoryType type, size_t size) {
/* Prepend block to heap list */
janet_vm.next_collection += size;
mem->next = janet_vm.blocks;
mem->data.next = janet_vm.blocks;
janet_vm.blocks = mem;
janet_vm.block_count++;
@@ -530,7 +535,7 @@ void janet_clear_memory(void) {
JanetGCObject *current = janet_vm.blocks;
while (NULL != current) {
janet_deinit_block(current);
JanetGCObject *next = current->next;
JanetGCObject *next = current->data.next;
janet_free(current);
current = next;
}

View File

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

View File

@@ -1,5 +1,5 @@
/*
* Copyright (c) 2021 Calvin Rose & contributors
* Copyright (c) 2022 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
@@ -207,6 +207,92 @@ JANET_CORE_FN(cfun_it_u64_new,
return janet_wrap_u64(janet_unwrap_u64(argv[0]));
}
JANET_CORE_FN(cfun_to_number,
"(int/to-number value)",
"Convert an int/u64 or int/s64 to a number. Fails if the number is out of range for an int32.") {
janet_fixarity(argc, 1);
if (janet_type(argv[0]) == JANET_ABSTRACT) {
void *abst = janet_unwrap_abstract(argv[0]);
if (janet_abstract_type(abst) == &janet_s64_type) {
int64_t value = *((int64_t *)abst);
if (value > JANET_INTMAX_INT64) {
janet_panicf("cannot convert %q to a number, must be in the range [%q, %q]", argv[0], janet_wrap_number(JANET_INTMIN_DOUBLE), janet_wrap_number(JANET_INTMAX_DOUBLE));
}
if (value < -JANET_INTMAX_INT64) {
janet_panicf("cannot convert %q to a number, must be in the range [%q, %q]", argv[0], janet_wrap_number(JANET_INTMIN_DOUBLE), janet_wrap_number(JANET_INTMAX_DOUBLE));
}
return janet_wrap_number((double)value);
}
if (janet_abstract_type(abst) == &janet_u64_type) {
uint64_t value = *((uint64_t *)abst);
if (value > JANET_INTMAX_INT64) {
janet_panicf("cannot convert %q to a number, must be in the range [%q, %q]", argv[0], janet_wrap_number(JANET_INTMIN_DOUBLE), janet_wrap_number(JANET_INTMAX_DOUBLE));
}
return janet_wrap_number((double)value);
}
}
janet_panicf("expected int/u64 or int/s64, got %q", argv[0]);
}
JANET_CORE_FN(cfun_to_bytes,
"(int/to-bytes value &opt endianness buffer)",
"Write the bytes of an `int/s64` or `int/u64` into a buffer.\n"
"The `buffer` parameter specifies an existing buffer to write to, if unset a new buffer will be created.\n"
"Returns the modified buffer.\n"
"The `endianness` paramater indicates the byte order:\n"
"- `nil` (unset): system byte order\n"
"- `:le`: little-endian, least significant byte first\n"
"- `:be`: big-endian, most significant byte first\n") {
janet_arity(argc, 1, 3);
if (janet_is_int(argv[0]) == JANET_INT_NONE) {
janet_panicf("int/to-bytes: expected an int/s64 or int/u64, got %q", argv[0]);
}
int reverse = 0;
if (argc > 1 && !janet_checktype(argv[1], JANET_NIL)) {
JanetKeyword endianness_kw = janet_getkeyword(argv, 1);
if (!janet_cstrcmp(endianness_kw, "le")) {
#if JANET_BIG_ENDIAN
reverse = 1;
#endif
} else if (!janet_cstrcmp(endianness_kw, "be")) {
#if JANET_LITTLE_ENDIAN
reverse = 1;
#endif
} else {
janet_panicf("int/to-bytes: expected endianness :le, :be or nil, got %v", argv[1]);
}
}
JanetBuffer *buffer = NULL;
if (argc > 2 && !janet_checktype(argv[2], JANET_NIL)) {
if (!janet_checktype(argv[2], JANET_BUFFER)) {
janet_panicf("int/to-bytes: expected buffer or nil, got %q", argv[2]);
}
buffer = janet_unwrap_buffer(argv[2]);
janet_buffer_extra(buffer, 8);
} else {
buffer = janet_buffer(8);
}
uint8_t *bytes = janet_unwrap_abstract(argv[0]);
if (reverse) {
for (int i = 0; i < 8; ++i) {
buffer->data[buffer->count + 7 - i] = bytes[i];
}
} else {
memcpy(buffer->data + buffer->count, bytes, 8);
}
buffer->count += 8;
return janet_wrap_buffer(buffer);
}
/*
* Code to support polymorphic comparison.
* int/u64 and int/s64 support a "compare" method that allows
@@ -514,6 +600,8 @@ void janet_lib_inttypes(JanetTable *env) {
JanetRegExt it_cfuns[] = {
JANET_CORE_REG("int/s64", cfun_it_s64_new),
JANET_CORE_REG("int/u64", cfun_it_u64_new),
JANET_CORE_REG("int/to-number", cfun_to_number),
JANET_CORE_REG("int/to-bytes", cfun_to_bytes),
JANET_REG_END
};
janet_core_cfuns_ext(env, NULL, it_cfuns);

View File

@@ -1,5 +1,5 @@
/*
* Copyright (c) 2021 Calvin Rose
* Copyright (c) 2022 Calvin Rose
*
* Permission is hereby granted, free of charge, to any person obtaining a copy
* of this software and associated documentation files (the "Software"), to
@@ -483,6 +483,19 @@ static Janet cfun_io_print_impl_x(int32_t argc, Janet *argv, int newline,
janet_buffer_push_u8(buf, '\n');
return janet_wrap_nil();
}
case JANET_FUNCTION: {
/* Special case function */
JanetFunction *fun = janet_unwrap_function(x);
JanetBuffer *buf = janet_buffer(0);
for (int32_t i = offset; i < argc; ++i) {
janet_to_string_b(buf, argv[i]);
}
if (newline)
janet_buffer_push_u8(buf, '\n');
Janet args[1] = { janet_wrap_buffer(buf) };
janet_call(fun, 1, args);
return janet_wrap_nil();
}
case JANET_NIL:
f = dflt_file;
if (f == NULL) janet_panic("cannot print to nil");

View File

@@ -1,5 +1,5 @@
/*
* Copyright (c) 2021 Calvin Rose
* Copyright (c) 2022 Calvin Rose
*
* Permission is hereby granted, free of charge, to any person obtaining a copy
* of this software and associated documentation files (the "Software"), to
@@ -64,8 +64,9 @@ enum {
LB_FUNCDEF_REF, /* 220 */
LB_UNSAFE_CFUNCTION, /* 221 */
LB_UNSAFE_POINTER, /* 222 */
LB_STRUCT_PROTO, /* 223 */
#ifdef JANET_EV
LB_THREADED_ABSTRACT/* 223 */
LB_THREADED_ABSTRACT/* 224 */
#endif
} LeadBytes;
@@ -384,6 +385,7 @@ static void marshal_one_abstract(MarshalState *st, Janet x, int flags) {
janet_abstract_incref(abstract);
pushbyte(st, LB_THREADED_ABSTRACT);
pushbytes(st, (uint8_t *) &abstract, sizeof(abstract));
MARK_SEEN();
return;
}
#endif
@@ -541,8 +543,10 @@ static void marshal_one(MarshalState *st, Janet x, int flags) {
int32_t count;
const JanetKV *struct_ = janet_unwrap_struct(x);
count = janet_struct_length(struct_);
pushbyte(st, LB_STRUCT);
pushbyte(st, janet_struct_proto(struct_) ? LB_STRUCT_PROTO : LB_STRUCT);
pushint(st, count);
if (janet_struct_proto(struct_))
marshal_one(st, janet_wrap_struct(janet_struct_proto(struct_)), flags + 1);
for (int32_t i = 0; i < janet_struct_capacity(struct_); i++) {
if (janet_checktype(struct_[i].key, JANET_NIL))
continue;
@@ -560,9 +564,9 @@ static void marshal_one(MarshalState *st, Janet x, int flags) {
case JANET_FUNCTION: {
pushbyte(st, LB_FUNCTION);
JanetFunction *func = janet_unwrap_function(x);
pushint(st, func->def->environments_length);
/* Mark seen before reading def */
MARK_SEEN();
pushint(st, func->def->environments_length);
marshal_one_def(st, func->def, flags);
for (int32_t i = 0; i < func->def->environments_length; i++)
marshal_one_env(st, func->envs[i], flags + 1);
@@ -1262,15 +1266,12 @@ static const uint8_t *unmarshal_one(
}
func = janet_gcalloc(JANET_MEMORY_FUNCTION, sizeof(JanetFunction) +
len * sizeof(JanetFuncEnv));
func->def = NULL;
*out = janet_wrap_function(func);
janet_v_push(st->lookup, *out);
data = unmarshal_one_def(st, data, &def, flags + 1);
if (def->environments_length != len) {
janet_panicf("invalid function - env count does not match def (%d != %d)",
len, def->environments_length);
}
func->def = def;
for (int32_t i = 0; i < def->environments_length; i++) {
for (int32_t i = 0; i < len; i++) {
data = unmarshal_one_env(st, data, &(func->envs[i]), flags + 1);
}
return data;
@@ -1283,6 +1284,7 @@ static const uint8_t *unmarshal_one(
case LB_ARRAY:
case LB_TUPLE:
case LB_STRUCT:
case LB_STRUCT_PROTO:
case LB_TABLE:
case LB_TABLE_PROTO:
/* Things that open with integers */
@@ -1312,9 +1314,15 @@ static const uint8_t *unmarshal_one(
}
*out = janet_wrap_tuple(janet_tuple_end(tup));
janet_v_push(st->lookup, *out);
} else if (lead == LB_STRUCT) {
} else if (lead == LB_STRUCT || lead == LB_STRUCT_PROTO) {
/* Struct */
JanetKV *struct_ = janet_struct_begin(len);
if (lead == LB_STRUCT_PROTO) {
Janet proto;
data = unmarshal_one(st, data, &proto, flags + 1);
janet_asserttype(proto, JANET_STRUCT);
janet_struct_proto(struct_) = janet_unwrap_struct(proto);
}
for (int32_t i = 0; i < len; i++) {
Janet key, value;
data = unmarshal_one(st, data, &key, flags + 1);

View File

@@ -1,5 +1,5 @@
/*
* Copyright (c) 2021 Calvin Rose
* Copyright (c) 2022 Calvin Rose
*
* Permission is hereby granted, free of charge, to any person obtaining a copy
* of this software and associated documentation files (the "Software"), to
@@ -286,7 +286,8 @@ JANET_DEFINE_MATHOP(fabs, fabs, "Return the absolute value of x.")
JANET_DEFINE_MATHOP(floor, floor, "Returns the largest integer value number that is not greater than x.")
JANET_DEFINE_MATHOP(trunc, trunc, "Returns the integer between x and 0 nearest to x.")
JANET_DEFINE_MATHOP(round, round, "Returns the integer nearest to x.")
JANET_DEFINE_MATHOP(gamma, lgamma, "Returns gamma(x).")
JANET_DEFINE_MATHOP(gamma, tgamma, "Returns gamma(x).")
JANET_DEFINE_MATHOP(lgamma, lgamma, "Returns log-gamma(x).")
JANET_DEFINE_MATHOP(log1p, log1p, "Returns (log base e of x) + 1 more accurately than (+ (math/log x) 1)")
JANET_DEFINE_MATHOP(erf, erf, "Returns the error function of x.")
JANET_DEFINE_MATHOP(erfc, erfc, "Returns the complementary error function of x.")
@@ -309,6 +310,42 @@ JANET_CORE_FN(janet_not, "(not x)", "Returns the boolean inverse of x.") {
return janet_wrap_boolean(!janet_truthy(argv[0]));
}
static double janet_gcd(double x, double y) {
if (isnan(x) || isnan(y)) {
#ifdef NAN
return NAN;
#else
return 0.0 \ 0.0;
#endif
}
if (isinf(x) || isinf(y)) return INFINITY;
while (y != 0) {
double temp = y;
y = fmod(x, y);
x = temp;
}
return x;
}
static double janet_lcm(double x, double y) {
return (x / janet_gcd(x, y)) * y;
}
JANET_CORE_FN(janet_cfun_gcd, "(math/gcd x y)",
"Returns the greatest common divisor between x and y.") {
janet_fixarity(argc, 2);
double x = janet_getnumber(argv, 0);
double y = janet_getnumber(argv, 1);
return janet_wrap_number(janet_gcd(x, y));
}
JANET_CORE_FN(janet_cfun_lcm, "(math/lcm x y)",
"Returns the least common multiple of x and y.") {
janet_fixarity(argc, 2);
double x = janet_getnumber(argv, 0);
double y = janet_getnumber(argv, 1);
return janet_wrap_number(janet_lcm(x, y));
}
/* Module entry point */
void janet_lib_math(JanetTable *env) {
@@ -347,12 +384,15 @@ void janet_lib_math(JanetTable *env) {
JANET_CORE_REG("math/exp2", janet_exp2),
JANET_CORE_REG("math/log1p", janet_log1p),
JANET_CORE_REG("math/gamma", janet_gamma),
JANET_CORE_REG("math/log-gamma", janet_lgamma),
JANET_CORE_REG("math/erfc", janet_erfc),
JANET_CORE_REG("math/erf", janet_erf),
JANET_CORE_REG("math/expm1", janet_expm1),
JANET_CORE_REG("math/trunc", janet_trunc),
JANET_CORE_REG("math/round", janet_round),
JANET_CORE_REG("math/next", janet_nextafter),
JANET_CORE_REG("math/gcd", janet_cfun_gcd),
JANET_CORE_REG("math/lcm", janet_cfun_lcm),
JANET_REG_END
};
janet_core_cfuns_ext(env, NULL, math_cfuns);
@@ -375,7 +415,7 @@ void janet_lib_math(JanetTable *env) {
JANET_CORE_DEF(env, "math/int-max", janet_wrap_number(JANET_INTMAX_DOUBLE),
"The maximum contiguous integer represtenable by a double (-(2^53))");
#ifdef NAN
JANET_CORE_DEF(env, "math/nan", janet_wrap_number(NAN), "Not a number (IEEE-754 NaN");
JANET_CORE_DEF(env, "math/nan", janet_wrap_number(NAN), "Not a number (IEEE-754 NaN)");
#else
JANET_CORE_DEF(env, "math/nan", janet_wrap_number(0.0 / 0.0), "Not a number (IEEE-754 NaN)");
#endif

View File

@@ -1,5 +1,5 @@
/*
* Copyright (c) 2021 Calvin Rose and contributors.
* Copyright (c) 2022 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
@@ -38,6 +38,7 @@
#pragma comment (lib, "Mswsock.lib")
#pragma comment (lib, "Advapi32.lib")
#else
#include <arpa/inet.h>
#include <unistd.h>
#include <signal.h>
#include <sys/ioctl.h>
@@ -73,6 +74,15 @@ const JanetAbstractType janet_address_type = {
#endif
#endif
/* maximum number of bytes in a socket address host (post name resolution) */
#ifdef JANET_WINDOWS
#define SA_ADDRSTRLEN (INET6_ADDRSTRLEN + 1)
typedef unsigned short in_port_t;
#else
#define JANET_SA_MAX(a, b) (((a) > (b))? (a) : (b))
#define SA_ADDRSTRLEN JANET_SA_MAX(INET6_ADDRSTRLEN + 1, (sizeof ((struct sockaddr_un *)0)->sun_path) + 1)
#endif
static JanetStream *make_stream(JSock handle, uint32_t flags);
/* We pass this flag to all send calls to prevent sigpipe */
@@ -122,22 +132,20 @@ JanetAsyncStatus net_machine_accept(JanetListenerState *s, JanetAsyncEvent event
case JANET_ASYNC_EVENT_MARK: {
if (state->lstream) janet_mark(janet_wrap_abstract(state->lstream));
if (state->astream) janet_mark(janet_wrap_abstract(state->astream));
if (state->function) janet_mark(janet_wrap_abstract(state->function));
if (state->function) janet_mark(janet_wrap_function(state->function));
break;
}
case JANET_ASYNC_EVENT_CLOSE:
janet_schedule(s->fiber, janet_wrap_nil());
return JANET_ASYNC_STATUS_DONE;
case JANET_ASYNC_EVENT_COMPLETE: {
int seconds;
int bytes = sizeof(seconds);
if (NO_ERROR != getsockopt((SOCKET) state->astream->handle, SOL_SOCKET, SO_CONNECT_TIME,
(char *)&seconds, &bytes)) {
if (state->astream->flags & JANET_STREAM_CLOSED) {
janet_cancel(s->fiber, janet_cstringv("failed to accept connection"));
return JANET_ASYNC_STATUS_DONE;
}
SOCKET lsock = (SOCKET) state->lstream->handle;
if (NO_ERROR != setsockopt((SOCKET) state->astream->handle, SOL_SOCKET, SO_UPDATE_ACCEPT_CONTEXT,
(char *) & (state->lstream->handle), sizeof(SOCKET))) {
(char *) &lsock, sizeof(lsock))) {
janet_cancel(s->fiber, janet_cstringv("failed to accept connection"));
return JANET_ASYNC_STATUS_DONE;
}
@@ -259,7 +267,8 @@ static int janet_get_sockettype(Janet *argv, int32_t argc, int32_t n) {
}
/* Needs argc >= offset + 2 */
/* For unix paths, just rertuns a single sockaddr and sets *is_unix to 1, otherwise 0 */
/* For unix paths, just rertuns a single sockaddr and sets *is_unix to 1,
* otherwise 0. Also, ignores is_bind when is a unix socket. */
static struct addrinfo *janet_get_addrinfo(Janet *argv, int32_t offset, int socktype, int passive, int *is_unix) {
/* Unix socket support - not yet supported on windows. */
#ifndef JANET_WINDOWS
@@ -285,12 +294,12 @@ static struct addrinfo *janet_get_addrinfo(Janet *argv, int32_t offset, int sock
}
#endif
/* Get host and port */
const char *host = janet_getcstring(argv, offset);
const char *port;
char *host = (char *)janet_getcstring(argv, offset);
char *port = NULL;
if (janet_checkint(argv[offset + 1])) {
port = (const char *)janet_to_string(argv[offset + 1]);
port = (char *)janet_to_string(argv[offset + 1]);
} else {
port = janet_optcstring(argv, offset + 2, offset + 1, NULL);
port = (char *)janet_optcstring(argv, offset + 2, offset + 1, NULL);
}
/* getaddrinfo */
struct addrinfo *ai = NULL;
@@ -312,12 +321,13 @@ static struct addrinfo *janet_get_addrinfo(Janet *argv, int32_t offset, int sock
*/
JANET_CORE_FN(cfun_net_sockaddr,
"(net/address host port &opt type)",
"(net/address host port &opt type multi)",
"Look up the connection information for a given hostname, port, and connection type. Returns "
"a handle that can be used to send datagrams over network without establishing a connection. "
"On Posix platforms, you can use :unix for host to connect to a unix domain socket, where the name is "
"given in the port argument. On Linux, abstract "
"unix domain sockets are specified with a leading '@' character in port.") {
"unix domain sockets are specified with a leading '@' character in port. If `multi` is truthy, will "
"return all address that match in an array instead of just the first.") {
janet_arity(argc, 2, 4);
int socktype = janet_get_sockettype(argv, argc, 2);
int is_unix = 0;
@@ -357,16 +367,49 @@ JANET_CORE_FN(cfun_net_sockaddr,
}
JANET_CORE_FN(cfun_net_connect,
"(net/connect host port &opt type)",
"(net/connect host port &opt type bindhost bindport)",
"Open a connection to communicate with a server. Returns a duplex stream "
"that can be used to communicate with the server. Type is an optional keyword "
"to specify a connection type, either :stream or :datagram. The default is :stream. ") {
janet_arity(argc, 2, 3);
"to specify a connection type, either :stream or :datagram. The default is :stream. "
"Bindhost is an optional string to select from what address to make the outgoing "
"connection, with the default being the same as using the OS's preferred address. ") {
janet_arity(argc, 2, 5);
/* Check arguments */
int socktype = janet_get_sockettype(argv, argc, 2);
int is_unix = 0;
char *bindhost = (char *) janet_optcstring(argv, argc, 3, NULL);
char *bindport = NULL;
if (argc >= 5 && janet_checkint(argv[4])) {
bindport = (char *)janet_to_string(argv[4]);
} else {
bindport = (char *)janet_optcstring(argv, argc, 4, NULL);
}
/* Where we're connecting to */
struct addrinfo *ai = janet_get_addrinfo(argv, 0, socktype, 0, &is_unix);
/* Check if we're binding address */
struct addrinfo *binding = NULL;
if (bindhost != NULL) {
if (is_unix) {
freeaddrinfo(ai);
janet_panic("bindhost not supported for unix domain sockets");
}
/* getaddrinfo */
struct addrinfo hints;
memset(&hints, 0, sizeof(hints));
hints.ai_family = AF_UNSPEC;
hints.ai_socktype = socktype;
hints.ai_flags = 0;
int status = getaddrinfo(bindhost, bindport, &hints, &binding);
if (status) {
freeaddrinfo(ai);
janet_panicf("could not get address info for bindhost: %s", gai_strerror(status));
}
}
/* Create socket */
JSock sock = JSOCKDEFAULT;
void *addr = NULL;
@@ -375,7 +418,9 @@ JANET_CORE_FN(cfun_net_connect,
if (is_unix) {
sock = socket(AF_UNIX, socktype | JSOCKFLAGS, 0);
if (!JSOCKVALID(sock)) {
janet_panicf("could not create socket: %V", janet_ev_lasterr());
Janet v = janet_ev_lasterr();
janet_free(ai);
janet_panicf("could not create socket: %V", v);
}
addr = (void *) ai;
addrlen = sizeof(struct sockaddr_un);
@@ -385,7 +430,7 @@ JANET_CORE_FN(cfun_net_connect,
struct addrinfo *rp = NULL;
for (rp = ai; rp != NULL; rp = rp->ai_next) {
#ifdef JANET_WINDOWS
sock = WSASocketW(rp->ai_family, rp->ai_socktype | JSOCKFLAGS, rp->ai_protocol, NULL, 0, WSA_FLAG_OVERLAPPED);
sock = WSASocketW(rp->ai_family, rp->ai_socktype, rp->ai_protocol, NULL, 0, WSA_FLAG_OVERLAPPED);
#else
sock = socket(rp->ai_family, rp->ai_socktype | JSOCKFLAGS, rp->ai_protocol);
#endif
@@ -396,17 +441,42 @@ JANET_CORE_FN(cfun_net_connect,
}
}
if (NULL == addr) {
Janet v = janet_ev_lasterr();
if (binding) freeaddrinfo(binding);
freeaddrinfo(ai);
janet_panicf("could not create socket: %V", janet_ev_lasterr());
janet_panicf("could not create socket: %V", v);
}
}
/* Bind to bindhost and bindport if given */
if (binding) {
struct addrinfo *rp = NULL;
int did_bind = 0;
for (rp = ai; rp != NULL; rp = rp->ai_next) {
if (bind(sock, rp->ai_addr, (int) rp->ai_addrlen) == 0) {
did_bind = 1;
break;
}
}
if (!did_bind) {
Janet v = janet_ev_lasterr();
freeaddrinfo(binding);
freeaddrinfo(ai);
JSOCKCLOSE(sock);
janet_panicf("could not bind outgoing address: %V", v);
} else {
freeaddrinfo(binding);
}
}
/* Connect to socket */
#ifdef JANET_WINDOWS
int status = WSAConnect(sock, addr, addrlen, NULL, NULL, NULL, NULL);
Janet lasterr = janet_ev_lasterr();
freeaddrinfo(ai);
#else
int status = connect(sock, addr, addrlen);
Janet lasterr = janet_ev_lasterr();
if (is_unix) {
janet_free(ai);
} else {
@@ -416,7 +486,7 @@ JANET_CORE_FN(cfun_net_connect,
if (status == -1) {
JSOCKCLOSE(sock);
janet_panicf("could not connect to socket: %V", janet_ev_lasterr());
janet_panicf("could not connect socket: %V", lasterr);
}
/* Set up the socket for non-blocking IO after connect - TODO - non-blocking connect? */
@@ -570,6 +640,96 @@ JANET_CORE_FN(cfun_net_listen,
}
}
/* Types of socket's we need to deal with - relevant type puns below.
struct sockaddr *sa; // Common base structure
struct sockaddr_storage *ss; // Size of largest socket address type
struct sockaddr_in *sin; // IPv4 address + port
struct sockaddr_in6 *sin6; // IPv6 address + port
struct sockaddr_un *sun; // Unix Domain Socket Address
*/
/* Turn a socket address into a host, port pair.
* For unix domain sockets, returned tuple will have only a single element, the path string. */
static Janet janet_so_getname(const void *sa_any) {
const struct sockaddr *sa = sa_any;
char buffer[SA_ADDRSTRLEN];
switch (sa->sa_family) {
default:
janet_panic("unknown address family");
case AF_INET: {
const struct sockaddr_in *sai = sa_any;
if (!inet_ntop(AF_INET, &(sai->sin_addr), buffer, sizeof(buffer))) {
janet_panic("unable to decode ipv4 host address");
}
Janet pair[2] = {janet_cstringv(buffer), janet_wrap_integer(ntohs(sai->sin_port))};
return janet_wrap_tuple(janet_tuple_n(pair, 2));
}
case AF_INET6: {
const struct sockaddr_in6 *sai6 = sa_any;
if (!inet_ntop(AF_INET6, &(sai6->sin6_addr), buffer, sizeof(buffer))) {
janet_panic("unable to decode ipv4 host address");
}
Janet pair[2] = {janet_cstringv(buffer), janet_wrap_integer(ntohs(sai6->sin6_port))};
return janet_wrap_tuple(janet_tuple_n(pair, 2));
}
#ifndef JANET_WINDOWS
case AF_UNIX: {
const struct sockaddr_un *sun = sa_any;
Janet pathname;
if (sun->sun_path[0] == '\0') {
memcpy(buffer, sun->sun_path, sizeof(sun->sun_path));
buffer[0] = '@';
pathname = janet_cstringv(buffer);
} else {
pathname = janet_cstringv(sun->sun_path);
}
return janet_wrap_tuple(janet_tuple_n(&pathname, 1));
}
#endif
}
}
JANET_CORE_FN(cfun_net_getsockname,
"(net/localname stream)",
"Gets the local address and port in a tuple in that order.") {
janet_fixarity(argc, 1);
JanetStream *js = janet_getabstract(argv, 0, &janet_stream_type);
if (js->flags & JANET_STREAM_CLOSED) janet_panic("stream closed");
struct sockaddr_storage ss;
socklen_t slen = sizeof(ss);
memset(&ss, 0, slen);
if (getsockname((JSock)js->handle, (struct sockaddr *) &ss, &slen)) {
janet_panicf("Failed to get localname on %v: %V", argv[0], janet_ev_lasterr());
}
janet_assert(slen <= sizeof(ss), "socket address truncated");
return janet_so_getname(&ss);
}
JANET_CORE_FN(cfun_net_getpeername,
"(net/peername stream)",
"Gets the remote peer's address and port in a tuple in that order.") {
janet_fixarity(argc, 1);
JanetStream *js = janet_getabstract(argv, 0, &janet_stream_type);
if (js->flags & JANET_STREAM_CLOSED) janet_panic("stream closed");
struct sockaddr_storage ss;
socklen_t slen = sizeof(ss);
memset(&ss, 0, slen);
if (getpeername((JSock)js->handle, (struct sockaddr *)&ss, &slen)) {
janet_panicf("Failed to get peername on %v: %V", argv[0], janet_ev_lasterr());
}
janet_assert(slen <= sizeof(ss), "socket address truncated");
return janet_so_getname(&ss);
}
JANET_CORE_FN(cfun_net_address_unpack,
"(net/address-unpack address)",
"Given an address returned by net/adress, return a host, port pair. Unix domain sockets "
"will have only the path in the returned tuple.") {
janet_fixarity(argc, 1);
struct sockaddr *sa = janet_getabstract(argv, 0, &janet_address_type);
return janet_so_getname(sa);
}
JANET_CORE_FN(cfun_stream_accept_loop,
"(net/accept-loop stream handler)",
"Shorthand for running a server stream that will continuously accept new connections. "
@@ -739,6 +899,9 @@ void janet_lib_net(JanetTable *env) {
JANET_CORE_REG("net/flush", cfun_stream_flush),
JANET_CORE_REG("net/connect", cfun_net_connect),
JANET_CORE_REG("net/shutdown", cfun_net_shutdown),
JANET_CORE_REG("net/peername", cfun_net_getpeername),
JANET_CORE_REG("net/localname", cfun_net_getsockname),
JANET_CORE_REG("net/address-unpack", cfun_net_address_unpack),
JANET_REG_END
};
janet_core_cfuns_ext(env, NULL, net_cfuns);

View File

@@ -1,5 +1,5 @@
/*
* Copyright (c) 2021 Calvin Rose and contributors.
* Copyright (c) 2022 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
@@ -39,10 +39,6 @@
#include <sys/stat.h>
#include <signal.h>
#ifdef JANET_APPLE
#include <AvailabilityMacros.h>
#endif
#ifdef JANET_WINDOWS
#include <windows.h>
#include <direct.h>
@@ -67,12 +63,6 @@ extern char **environ;
#endif
#endif
/* For macos */
#ifdef __MACH__
#include <mach/clock.h>
#include <mach/mach.h>
#endif
/* Not POSIX, but all Unixes but Solaris have this function. */
#if defined(JANET_POSIX) && !defined(__sun)
time_t timegm(struct tm *tm);
@@ -158,7 +148,7 @@ JANET_CORE_FN(os_arch,
"(os/arch)",
"Check the ISA that janet was compiled for. Returns one of:\n\n"
"* :x86\n\n"
"* :x86-64\n\n"
"* :x64\n\n"
"* :arm\n\n"
"* :aarch64\n\n"
"* :sparc\n\n"
@@ -183,6 +173,8 @@ JANET_CORE_FN(os_arch,
return janet_ckeywordv("sparc");
#elif (defined(__ppc__))
return janet_ckeywordv("ppc");
#elif (defined(__ppc64__) || defined(_ARCH_PPC64) || defined(_M_PPC))
return janet_ckeywordv("ppc64");
#else
return janet_ckeywordv("unknown");
#endif
@@ -409,15 +401,13 @@ static JanetEVGenericMessage janet_proc_wait_subr(JanetEVGenericMessage args) {
#else /* windows check */
/* Function that is called in separate thread to wait on a pid */
static JanetEVGenericMessage janet_proc_wait_subr(JanetEVGenericMessage args) {
JanetProc *proc = (JanetProc *) args.argp;
pid_t result;
static int proc_get_status(JanetProc *proc) {
/* Use POSIX shell semantics for interpreting signals */
int status = 0;
pid_t result;
do {
result = waitpid(proc->pid, &status, 0);
} while (result == -1 && errno == EINTR);
/* Use POSIX shell semantics for interpreting signals */
if (WIFEXITED(status)) {
status = WEXITSTATUS(status);
} else if (WIFSTOPPED(status)) {
@@ -425,7 +415,21 @@ static JanetEVGenericMessage janet_proc_wait_subr(JanetEVGenericMessage args) {
} else {
status = WTERMSIG(status) + 128;
}
args.argi = status;
return status;
}
/* Function that is called in separate thread to wait on a pid */
static JanetEVGenericMessage janet_proc_wait_subr(JanetEVGenericMessage args) {
JanetProc *proc = (JanetProc *) args.argp;
#ifdef WNOWAIT
pid_t result;
int status = 0;
do {
result = waitpid(proc->pid, &status, WNOWAIT);
} while (result == -1 && errno == EINTR);
#else
args.tag = proc_get_status(proc);
#endif
return args;
}
@@ -434,9 +438,13 @@ static JanetEVGenericMessage janet_proc_wait_subr(JanetEVGenericMessage args) {
/* Callback that is called in main thread when subroutine completes. */
static void janet_proc_wait_cb(JanetEVGenericMessage args) {
janet_ev_dec_refcount();
int status = args.argi;
JanetProc *proc = (JanetProc *) args.argp;
if (NULL != proc) {
#ifdef WNOWAIT
int status = proc_get_status(proc);
#else
int status = args.tag;
#endif
proc->return_code = (int32_t) status;
proc->flags |= JANET_PROC_WAITED;
proc->flags &= ~JANET_PROC_WAITING;
@@ -469,7 +477,9 @@ static int janet_proc_gc(void *p, size_t s) {
/* Kill and wait to prevent zombies */
kill(proc->pid, SIGKILL);
int status;
waitpid(proc->pid, &status, 0);
if (!(proc->flags & JANET_PROC_WAITING)) {
waitpid(proc->pid, &status, 0);
}
}
#endif
return 0;
@@ -540,7 +550,7 @@ JANET_CORE_FN(os_proc_wait,
JANET_CORE_FN(os_proc_kill,
"(os/proc-kill proc &opt wait)",
"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 "
"handle on windows. If wait is truthy, will wait for the process to finish and "
"returns the exit code. Otherwise, returns proc.") {
janet_arity(argc, 1, 2);
JanetProc *proc = janet_getabstract(argv, 0, &ProcAT);
@@ -685,6 +695,12 @@ static int janet_proc_get(void *p, Janet key, Janet *out) {
*out = (NULL == proc->err) ? janet_wrap_nil() : janet_wrap_abstract(proc->err);
return 1;
}
#ifndef JANET_WINDOWS
if (janet_keyeq(key, "pid")) {
*out = janet_wrap_number(proc->pid);
return 1;
}
#endif
if ((-1 != proc->return_code) && janet_keyeq(key, "return-code")) {
*out = janet_wrap_integer(proc->return_code);
return 1;
@@ -948,18 +964,24 @@ static Janet os_execute_impl(int32_t argc, Janet *argv, int is_spawn) {
posix_spawn_file_actions_init(&actions);
if (pipe_in != JANET_HANDLE_NONE) {
posix_spawn_file_actions_adddup2(&actions, pipe_in, 0);
posix_spawn_file_actions_addclose(&actions, pipe_in);
} else if (new_in != JANET_HANDLE_NONE) {
posix_spawn_file_actions_adddup2(&actions, new_in, 0);
posix_spawn_file_actions_addclose(&actions, new_in);
}
if (pipe_out != JANET_HANDLE_NONE) {
posix_spawn_file_actions_adddup2(&actions, pipe_out, 1);
posix_spawn_file_actions_addclose(&actions, pipe_out);
} else if (new_out != JANET_HANDLE_NONE) {
posix_spawn_file_actions_adddup2(&actions, new_out, 1);
posix_spawn_file_actions_addclose(&actions, new_out);
}
if (pipe_err != JANET_HANDLE_NONE) {
posix_spawn_file_actions_adddup2(&actions, pipe_err, 2);
posix_spawn_file_actions_addclose(&actions, pipe_err);
} else if (new_err != JANET_HANDLE_NONE) {
posix_spawn_file_actions_adddup2(&actions, new_err, 2);
posix_spawn_file_actions_addclose(&actions, new_err);
}
pid_t pid;
@@ -1053,7 +1075,9 @@ JANET_CORE_FN(os_execute,
JANET_CORE_FN(os_spawn,
"(os/spawn args &opt flags env)",
"Execute a program on the system and return a handle to the process. Otherwise, the "
"same arguments as os/execute. Does not wait for the process.") {
"same arguments as os/execute. Does not wait for the process. "
"The returned value has the fields :in, :out, :err, :return-code and "
"the additional field :pid on unix like platforms.") {
return os_execute_impl(argc, argv, 1);
}

View File

@@ -1,5 +1,5 @@
/*
* Copyright (c) 2021 Calvin Rose
* Copyright (c) 2022 Calvin Rose
*
* Permission is hereby granted, free of charge, to any person obtaining a copy
* of this software and associated documentation files (the "Software"), to
@@ -51,15 +51,15 @@ static const uint32_t symchars[8] = {
};
/* Check if a character is a valid symbol character
* symbol chars are A-Z, a-z, 0-9, or one of !$&*+-./:<=>@\^_~| */
static int is_symbol_char(uint8_t c) {
* symbol chars are A-Z, a-z, 0-9, or one of !$&*+-./:<=>@\^_| */
int janet_is_symbol_char(uint8_t c) {
return symchars[c >> 5] & ((uint32_t)1 << (c & 0x1F));
}
/* Validate some utf8. Useful for identifiers. Only validates
* the encoding, does not check for valid code points (they
* are less well defined than the encoding). */
static int valid_utf8(const uint8_t *str, int32_t len) {
int janet_valid_utf8(const uint8_t *str, int32_t len) {
int32_t i = 0;
int32_t j;
while (i < len) {
@@ -411,7 +411,7 @@ static int tokenchar(JanetParser *p, JanetParseState *state, uint8_t c) {
Janet ret;
double numval;
int32_t blen;
if (is_symbol_char(c)) {
if (janet_is_symbol_char(c)) {
push_buf(p, (uint8_t) c);
if (c > 127) state->argn = 1; /* Use to indicate non ascii */
return 1;
@@ -422,7 +422,7 @@ static int tokenchar(JanetParser *p, JanetParseState *state, uint8_t c) {
int start_num = start_dig || p->buf[0] == '-' || p->buf[0] == '+' || p->buf[0] == '.';
if (p->buf[0] == ':') {
/* Don't do full utf-8 check unless we have seen non ascii characters. */
int valid = (!state->argn) || valid_utf8(p->buf + 1, blen - 1);
int valid = (!state->argn) || janet_valid_utf8(p->buf + 1, blen - 1);
if (!valid) {
p->error = "invalid utf-8 in keyword";
return 0;
@@ -442,7 +442,7 @@ static int tokenchar(JanetParser *p, JanetParseState *state, uint8_t c) {
return 0;
} else {
/* Don't do full utf-8 check unless we have seen non ascii characters. */
int valid = (!state->argn) || valid_utf8(p->buf, blen);
int valid = (!state->argn) || janet_valid_utf8(p->buf, blen);
if (!valid) {
p->error = "invalid utf-8 in symbol";
return 0;
@@ -582,7 +582,7 @@ static int root(JanetParser *p, JanetParseState *state, uint8_t c) {
switch (c) {
default:
if (is_whitespace(c)) return 1;
if (!is_symbol_char(c)) {
if (!janet_is_symbol_char(c)) {
p->error = "unexpected character";
return 1;
}
@@ -746,6 +746,7 @@ Janet janet_parser_produce(JanetParser *parser) {
}
parser->pending--;
parser->argcount--;
parser->states[0].argn--;
return ret;
}
@@ -759,6 +760,7 @@ Janet janet_parser_produce_wrapped(JanetParser *parser) {
}
parser->pending--;
parser->argcount--;
parser->states[0].argn--;
return ret;
}
@@ -1093,8 +1095,9 @@ static Janet janet_wrap_parse_state(JanetParseState *s, Janet *args,
if (s->flags & PFLAG_CONTAINER) {
JanetArray *container_args = janet_array(s->argn);
container_args->count = s->argn;
safe_memcpy(container_args->data, args, sizeof(args[0])*s->argn);
for (int32_t i = 0; i < s->argn; i++) {
janet_array_push(container_args, args[i]);
}
janet_table_put(state, janet_ckeywordv("args"),
janet_wrap_array(container_args));
}
@@ -1189,11 +1192,14 @@ static Janet parser_state_frames(const JanetParser *p) {
JanetArray *states = janet_array(count);
states->count = count;
uint8_t *buf = p->buf;
Janet *args = p->args;
/* Iterate arg stack backwards */
Janet *args = p->args + p->argcount;
for (int32_t i = count - 1; i >= 0; --i) {
JanetParseState *s = p->states + i;
if (s->flags & PFLAG_CONTAINER) {
args -= s->argn;
}
states->data[i] = janet_wrap_parse_state(s, args, buf, (uint32_t) p->bufcount);
args -= s->argn;
}
return janet_wrap_array(states);
}

View File

@@ -1,5 +1,5 @@
/*
* Copyright (c) 2021 Calvin Rose
* Copyright (c) 2022 Calvin Rose
*
* Permission is hereby granted, free of charge, to any person obtaining a copy
* of this software and associated documentation files (the "Software"), to
@@ -387,6 +387,25 @@ tail:
return result;
}
case RULE_CAPTURE_NUM: {
down1(s);
const uint8_t *result = peg_rule(s, s->bytecode + rule[1], text);
up1(s);
if (!result) return NULL;
/* check number parsing */
double x = 0.0;
int32_t base = (int32_t) rule[2];
if (janet_scan_number_base(text, (int32_t)(result - text), base, &x)) return NULL;
/* Specialized pushcap - avoid intermediate string creation */
if (!s->has_backref && s->mode == PEG_MODE_ACCUMULATE) {
janet_buffer_push_bytes(s->scratch, text, (int32_t)(result - text));
} else {
uint32_t tag = rule[3];
pushcap(s, janet_wrap_number(x), tag);
}
return result;
}
case RULE_ACCUMULATE: {
uint32_t tag = rule[2];
int oldmode = s->mode;
@@ -975,6 +994,25 @@ static void spec_unref(Builder *b, int32_t argc, const Janet *argv) {
spec_cap1(b, argc, argv, RULE_UNREF);
}
static void spec_capture_number(Builder *b, int32_t argc, const Janet *argv) {
peg_arity(b, argc, 1, 3);
Reserve r = reserve(b, 4);
uint32_t base = 0;
if (argc >= 2) {
if (!janet_checktype(argv[1], JANET_NIL)) {
if (!janet_checkint(argv[1])) goto error;
base = (uint32_t) janet_unwrap_integer(argv[1]);
if (base < 2 || base > 36) goto error;
}
}
uint32_t tag = (argc == 3) ? emit_tag(b, argv[2]) : 0;
uint32_t rule = peg_compile1(b, argv[0]);
emit_3(r, RULE_CAPTURE_NUM, rule, base, tag);
return;
error:
peg_panicf(b, "expected integer between 2 and 36, got %v", argv[2]);
}
static void spec_reference(Builder *b, int32_t argc, const Janet *argv) {
peg_arity(b, argc, 1, 2);
Reserve r = reserve(b, 3);
@@ -1118,6 +1156,7 @@ static const SpecialPair peg_specials[] = {
{"line", spec_line},
{"look", spec_look},
{"not", spec_not},
{"number", spec_capture_number},
{"opt", spec_opt},
{"position", spec_position},
{"quote", spec_capture},
@@ -1214,6 +1253,18 @@ static uint32_t peg_compile1(Builder *b, Janet peg) {
emit_bytes(b, RULE_LITERAL, len, str);
break;
}
case JANET_TABLE: {
/* Build grammar table */
JanetTable *new_grammar = janet_table_clone(janet_unwrap_table(peg));
new_grammar->proto = grammar;
b->grammar = grammar = new_grammar;
/* Run the main rule */
Janet main_rule = janet_table_rawget(grammar, janet_ckeywordv("main"));
if (janet_checktype(main_rule, JANET_NIL))
peg_panic(b, "grammar requires :main rule");
rule = peg_compile1(b, main_rule);
break;
}
case JANET_STRUCT: {
/* Build grammar table */
const JanetKV *st = janet_unwrap_struct(peg);
@@ -1419,6 +1470,12 @@ static void *peg_unmarshal(JanetMarshalContext *ctx) {
if (rule[1] >= clen) goto bad;
i += 3;
break;
case RULE_CAPTURE_NUM:
/* [rule, base, tag] */
if (rule[1] >= blen) goto bad;
op_flags[rule[1]] |= 0x01;
i += 4;
break;
case RULE_ACCUMULATE:
case RULE_GROUP:
case RULE_CAPTURE:

View File

@@ -1,5 +1,5 @@
/*
* Copyright (c) 2021 Calvin Rose
* Copyright (c) 2022 Calvin Rose
*
* Permission is hereby granted, free of charge, to any person obtaining a copy
* of this software and associated documentation files (the "Software"), to
@@ -261,21 +261,13 @@ void janet_to_string_b(JanetBuffer *buffer, Janet x) {
/* See parse.c for full table */
static const uint32_t pp_symchars[8] = {
0x00000000, 0xf7ffec72, 0xc7ffffff, 0x07fffffe,
0x00000000, 0x00000000, 0x00000000, 0x00000000
};
static int pp_is_symbol_char(uint8_t c) {
return pp_symchars[c >> 5] & ((uint32_t)1 << (c & 0x1F));
}
/* Check if a symbol or keyword contains no symbol characters */
static int contains_bad_chars(const uint8_t *sym, int issym) {
int32_t len = janet_string_length(sym);
if (len && issym && sym[0] >= '0' && sym[0] <= '9') return 1;
if (!janet_valid_utf8(sym, len)) return 1;
for (int32_t i = 0; i < len; i++) {
if (!pp_is_symbol_char(sym[i])) return 1;
if (!janet_is_symbol_char(sym[i])) return 1;
}
return 0;
}
@@ -570,12 +562,12 @@ static void janet_pretty_one(struct pretty *S, Janet x, int is_dict_value) {
case JANET_STRUCT:
case JANET_TABLE: {
int istable = janet_checktype(x, JANET_TABLE);
janet_buffer_push_cstring(S->buffer, istable ? "@" : "{");
/* For object-like tables, print class name */
if (istable) {
JanetTable *t = janet_unwrap_table(x);
JanetTable *proto = t->proto;
janet_buffer_push_cstring(S->buffer, "@");
if (NULL != proto) {
Janet name = janet_table_get(proto, janet_ckeywordv("_name"));
const uint8_t *n;
@@ -590,8 +582,25 @@ static void janet_pretty_one(struct pretty *S, Janet x, int is_dict_value) {
}
}
}
janet_buffer_push_cstring(S->buffer, "{");
} else {
JanetStruct st = janet_unwrap_struct(x);
JanetStruct proto = janet_struct_proto(st);
if (NULL != proto) {
Janet name = janet_struct_get(proto, janet_ckeywordv("_name"));
const uint8_t *n;
int32_t len;
if (janet_bytes_view(name, &n, &len)) {
if (S->flags & JANET_PRETTY_COLOR) {
janet_buffer_push_cstring(S->buffer, janet_class_color);
}
janet_buffer_push_bytes(S->buffer, n, len);
if (S->flags & JANET_PRETTY_COLOR) {
janet_buffer_push_cstring(S->buffer, "\x1B[0m");
}
}
}
}
janet_buffer_push_cstring(S->buffer, "{");
S->depth--;
S->indent += 2;

View File

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

View File

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

View File

@@ -1,5 +1,5 @@
/*
* Copyright (c) 2021 Calvin Rose
* Copyright (c) 2022 Calvin Rose
*
* Permission is hereby granted, free of charge, to any person obtaining a copy
* of this software and associated documentation files (the "Software"), to
@@ -23,6 +23,7 @@
#ifndef JANET_AMALG
#include "features.h"
#include <janet.h>
#include "state.h"
#endif
/* Run a string */
@@ -50,7 +51,7 @@ int janet_dobytes(JanetTable *env, const uint8_t *bytes, int32_t len, const char
fiber->env = env;
JanetSignal status = janet_continue(fiber, janet_wrap_nil(), &ret);
if (status != JANET_SIGNAL_OK && status != JANET_SIGNAL_EVENT) {
janet_stacktrace(fiber, ret);
janet_stacktrace_ext(fiber, ret, "");
errflags |= 0x01;
done = 1;
}
@@ -58,7 +59,7 @@ int janet_dobytes(JanetTable *env, const uint8_t *bytes, int32_t len, const char
ret = janet_wrap_string(cres.error);
if (cres.macrofiber) {
janet_eprintf("compile error in %s: ", sourcePath);
janet_stacktrace(cres.macrofiber, ret);
janet_stacktrace_ext(cres.macrofiber, ret, "");
} else {
janet_eprintf("compile error in %s: %s\n", sourcePath,
(const char *)cres.error);
@@ -79,7 +80,9 @@ int janet_dobytes(JanetTable *env, const uint8_t *bytes, int32_t len, const char
const char *e = janet_parser_error(&parser);
errflags |= 0x04;
ret = janet_cstringv(e);
janet_eprintf("parse error in %s: %s\n", sourcePath, e);
size_t line = parser.line;
size_t col = parser.column;
janet_eprintf("%s:%lu:%lu: parse error: %s\n", sourcePath, line, col, e);
done = 1;
break;
}
@@ -98,6 +101,14 @@ int janet_dobytes(JanetTable *env, const uint8_t *bytes, int32_t len, const char
/* Clean up and return errors */
janet_parser_deinit(&parser);
if (where) janet_gcunroot(janet_wrap_string(where));
#ifdef JANET_EV
/* Enter the event loop if we are not already in it */
if (janet_vm.stackn == 0) {
janet_gcroot(ret);
janet_loop();
janet_gcunroot(ret);
}
#endif
if (out) *out = ret;
return errflags;
}
@@ -119,7 +130,7 @@ int janet_loop_fiber(JanetFiber *fiber) {
Janet out;
status = janet_continue(fiber, janet_wrap_nil(), &out);
if (status != JANET_SIGNAL_OK && status != JANET_SIGNAL_EVENT) {
janet_stacktrace(fiber, out);
janet_stacktrace_ext(fiber, out, "");
}
#endif
return status;

View File

@@ -1,5 +1,5 @@
/*
* Copyright (c) 2021 Calvin Rose
* Copyright (c) 2022 Calvin Rose
*
* Permission is hereby granted, free of charge, to any person obtaining a copy
* of this software and associated documentation files (the "Software"), to
@@ -62,6 +62,8 @@ static JanetSlot quasiquote(JanetFopts opts, Janet x, int depth, int level) {
return janetc_cslot(janet_wrap_nil());
}
JanetSlot *slots = NULL;
JanetFopts subopts = opts;
subopts.flags &= ~JANET_FOPTS_HINT;
switch (janet_type(x)) {
default:
return janetc_cslot(x);
@@ -82,7 +84,7 @@ static JanetSlot quasiquote(JanetFopts opts, Janet x, int depth, int level) {
}
}
for (i = 0; i < len; i++)
janet_v_push(slots, quasiquote(opts, tup[i], depth - 1, level));
janet_v_push(slots, quasiquote(subopts, tup[i], depth - 1, level));
return qq_slots(opts, slots, (janet_tuple_flag(tup) & JANET_TUPLE_FLAG_BRACKETCTOR)
? JOP_MAKE_BRACKET_TUPLE
: JOP_MAKE_TUPLE);
@@ -91,7 +93,7 @@ static JanetSlot quasiquote(JanetFopts opts, Janet x, int depth, int level) {
int32_t i;
JanetArray *array = janet_unwrap_array(x);
for (i = 0; i < array->count; i++)
janet_v_push(slots, quasiquote(opts, array->data[i], depth - 1, level));
janet_v_push(slots, quasiquote(subopts, array->data[i], depth - 1, level));
return qq_slots(opts, slots, JOP_MAKE_ARRAY);
}
case JANET_TABLE:
@@ -100,8 +102,8 @@ static JanetSlot quasiquote(JanetFopts opts, Janet x, int depth, int level) {
int32_t len, cap = 0;
janet_dictionary_view(x, &kvs, &len, &cap);
while ((kv = janet_dictionary_next(kvs, cap, kv))) {
JanetSlot key = quasiquote(opts, kv->key, depth - 1, level);
JanetSlot value = quasiquote(opts, kv->value, depth - 1, level);
JanetSlot key = quasiquote(subopts, kv->key, depth - 1, level);
JanetSlot value = quasiquote(subopts, kv->value, depth - 1, level);
key.flags &= ~JANET_SLOT_SPLICED;
value.flags &= ~JANET_SLOT_SPLICED;
janet_v_push(slots, key);
@@ -154,6 +156,67 @@ static int destructure(JanetCompiler *c,
for (int32_t i = 0; i < len; i++) {
JanetSlot nextright = janetc_farslot(c);
Janet subval = values[i];
if (janet_checktype(subval, JANET_SYMBOL) && !janet_cstrcmp(janet_unwrap_symbol(subval), "&")) {
if (i + 1 >= len) {
janetc_cerror(c, "expected symbol following '& in destructuring pattern");
return 1;
}
if (i + 2 < len) {
int32_t num_extra = len - i - 1;
Janet *extra = janet_tuple_begin(num_extra);
janet_tuple_flag(extra) |= JANET_TUPLE_FLAG_BRACKETCTOR;
for (int32_t j = 0; j < num_extra; ++j) {
extra[j] = values[j + i + 1];
}
janetc_error(c, janet_formatc("expected a single symbol follow '& in destructuring pattern, found %q", janet_wrap_tuple(janet_tuple_end(extra))));
return 1;
}
if (!janet_checktype(values[i + 1], JANET_SYMBOL)) {
janetc_error(c, janet_formatc("expected symbol following '& in destructuring pattern, found %q", values[i + 1]));
return 1;
}
JanetSlot argi = janetc_farslot(c);
JanetSlot arg = janetc_farslot(c);
JanetSlot len = janetc_farslot(c);
janetc_emit_si(c, JOP_LOAD_INTEGER, argi, i, 0);
janetc_emit_ss(c, JOP_LENGTH, len, right, 0);
/* loop condition - reuse arg slot for the condition result */
int32_t label_loop_start = janetc_emit_sss(c, JOP_LESS_THAN, arg, argi, len, 0);
int32_t label_loop_cond_jump = janetc_emit_si(c, JOP_JUMP_IF_NOT, arg, 0, 0);
/* loop body */
janetc_emit_sss(c, JOP_GET, arg, right, argi, 0);
janetc_emit_s(c, JOP_PUSH, arg, 0);
janetc_emit_ssi(c, JOP_ADD_IMMEDIATE, argi, argi, 1, 0);
/* loop - jump back to the start of the loop */
int32_t label_loop_loop = janet_v_count(c->buffer);
janetc_emit(c, JOP_JUMP);
int32_t label_loop_exit = janet_v_count(c->buffer);
c->buffer[label_loop_cond_jump] |= (label_loop_exit - label_loop_cond_jump) << 16;
c->buffer[label_loop_loop] |= (label_loop_start - label_loop_loop) << 8;
janetc_freeslot(c, argi);
janetc_freeslot(c, arg);
janetc_freeslot(c, len);
janetc_emit_s(c, JOP_MAKE_TUPLE, nextright, 1);
leaf(c, janet_unwrap_symbol(values[i + 1]), nextright, attr);
janetc_freeslot(c, nextright);
break;
}
if (i < 0x100) {
janetc_emit_ssu(c, JOP_GET_INDEX, nextright, right, (uint8_t) i, 1);
} else {
@@ -298,8 +361,20 @@ static int varleaf(
/* Global var, generate var */
JanetSlot refslot;
JanetTable *entry = janet_table_clone(reftab);
JanetArray *ref = janet_array(1);
janet_array_push(ref, janet_wrap_nil());
Janet redef_kw = janet_ckeywordv("redef");
int is_redef = janet_truthy(janet_table_get(c->env, redef_kw));
JanetArray *ref;
JanetBinding old_binding;
if (is_redef && (old_binding = janet_resolve_ext(c->env, sym),
old_binding.type == JANET_BINDING_VAR)) {
ref = janet_unwrap_array(old_binding.value);
} else {
ref = janet_array(1);
janet_array_push(ref, janet_wrap_nil());
}
janet_table_put(entry, janet_ckeywordv("ref"), janet_wrap_array(ref));
janet_table_put(entry, janet_ckeywordv("source-map"),
janet_wrap_tuple(janetc_make_sourcemap(c)));
@@ -331,14 +406,31 @@ static int defleaf(
JanetTable *entry = janet_table_clone(tab);
janet_table_put(entry, janet_ckeywordv("source-map"),
janet_wrap_tuple(janetc_make_sourcemap(c)));
JanetSlot valsym = janetc_cslot(janet_ckeywordv("value"));
JanetSlot tabslot = janetc_cslot(janet_wrap_table(entry));
Janet redef_kw = janet_ckeywordv("redef");
int is_redef = janet_truthy(janet_table_get(c->env, redef_kw));
if (is_redef) janet_table_put(entry, redef_kw, janet_wrap_true());
if (is_redef) {
JanetBinding binding = janet_resolve_ext(c->env, sym);
JanetArray *ref;
if (binding.type == JANET_BINDING_DYNAMIC_DEF || binding.type == JANET_BINDING_DYNAMIC_MACRO) {
ref = janet_unwrap_array(binding.value);
} else {
ref = janet_array(1);
janet_array_push(ref, janet_wrap_nil());
}
janet_table_put(entry, janet_ckeywordv("ref"), janet_wrap_array(ref));
JanetSlot refslot = janetc_cslot(janet_wrap_array(ref));
janetc_emit_ssu(c, JOP_PUT_INDEX, refslot, s, 0, 0);
} else {
JanetSlot valsym = janetc_cslot(janet_ckeywordv("value"));
JanetSlot tabslot = janetc_cslot(janet_wrap_table(entry));
janetc_emit_sss(c, JOP_PUT, tabslot, valsym, s, 0);
}
/* Add env entry to env */
janet_table_put(c->env, janet_wrap_symbol(sym), janet_wrap_table(entry));
/* Put value in table when evaulated */
janetc_emit_sss(c, JOP_PUT, tabslot, valsym, s, 0);
}
return namelocal(c, sym, 0, s);
}

View File

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

View File

@@ -1,5 +1,5 @@
/*
* Copyright (c) 2021 Calvin Rose
* Copyright (c) 2022 Calvin Rose
*
* Permission is hereby granted, free of charge, to any person obtaining a copy
* of this software and associated documentation files (the "Software"), to
@@ -54,14 +54,6 @@ typedef struct {
int is_error;
} JanetTimeout;
#ifdef JANET_THREADS
typedef struct {
JanetMailbox *original;
JanetMailbox *newbox;
uint64_t flags;
} JanetMailboxPair;
#endif
/* Registry table for C functions - containts metadata that can
* be looked up by cfunction pointer. All strings here are pointing to
* static memory not managed by Janet. */
@@ -145,13 +137,6 @@ struct JanetVM {
JanetTraversalNode *traversal_top;
JanetTraversalNode *traversal_base;
/* Threading */
#ifdef JANET_THREADS
JanetMailbox *mailbox;
JanetThread *thread_current;
JanetTable *thread_decode;
#endif
/* Event loop and scheduler globals */
#ifdef JANET_EV
size_t tq_count;
@@ -171,6 +156,11 @@ struct JanetVM {
int epoll;
int timerfd;
int timer_enabled;
#elif defined(JANET_EV_KQUEUE)
JanetHandle selfpipe[2];
int kq;
int timer;
int timer_enabled;
#else
JanetHandle selfpipe[2];
struct pollfd *fds;
@@ -181,12 +171,6 @@ struct JanetVM {
extern JANET_THREAD_LOCAL JanetVM janet_vm;
/* Setup / teardown */
#ifdef JANET_THREADS
void janet_threads_init(void);
void janet_threads_deinit(void);
#endif
#ifdef JANET_NET
void janet_net_init(void);
void janet_net_deinit(void);

View File

@@ -1,5 +1,5 @@
/*
* Copyright (c) 2021 Calvin Rose
* Copyright (c) 2022 Calvin Rose
*
* Permission is hereby granted, free of charge, to any person obtaining a copy
* of this software and associated documentation files (the "Software"), to
@@ -218,7 +218,7 @@ JANET_CORE_FN(cfun_string_repeat,
JANET_CORE_FN(cfun_string_bytes,
"(string/bytes str)",
"Returns an array of integers that are the byte values of the string.") {
"Returns a tuple of integers that are the byte values of the string.") {
janet_fixarity(argc, 1);
JanetByteView view = janet_getbytes(argv, 0);
Janet *tup = janet_tuple_begin(view.len);

View File

@@ -1,5 +1,5 @@
/*
* Copyright (c) 2021 Calvin Rose
* Copyright (c) 2022 Calvin Rose
*
* Permission is hereby granted, free of charge, to any person obtaining a copy
* of this software and associated documentation files (the "Software"), to
@@ -246,15 +246,15 @@ static double convert(
}
/* Scan a real (double) from a string. If the string cannot be converted into
* and integer, set *err to 1 and return 0. */
int janet_scan_number(
* and integer, return 0. */
int janet_scan_number_base(
const uint8_t *str,
int32_t len,
int32_t base,
double *out) {
const uint8_t *end = str + len;
int seenadigit = 0;
int ex = 0;
int base = 10;
int seenpoint = 0;
int foundexp = 0;
int neg = 0;
@@ -278,21 +278,28 @@ int janet_scan_number(
}
/* Check for leading 0x or digit digit r */
if (str + 1 < end && str[0] == '0' && str[1] == 'x') {
base = 16;
str += 2;
} else if (str + 1 < end &&
str[0] >= '0' && str[0] <= '9' &&
str[1] == 'r') {
base = str[0] - '0';
str += 2;
} else if (str + 2 < end &&
str[0] >= '0' && str[0] <= '9' &&
str[1] >= '0' && str[1] <= '9' &&
str[2] == 'r') {
base = 10 * (str[0] - '0') + (str[1] - '0');
if (base < 2 || base > 36) goto error;
str += 3;
if (base == 0) {
if (str + 1 < end && str[0] == '0' && str[1] == 'x') {
base = 16;
str += 2;
} else if (str + 1 < end &&
str[0] >= '0' && str[0] <= '9' &&
str[1] == 'r') {
base = str[0] - '0';
str += 2;
} else if (str + 2 < end &&
str[0] >= '0' && str[0] <= '9' &&
str[1] >= '0' && str[1] <= '9' &&
str[2] == 'r') {
base = 10 * (str[0] - '0') + (str[1] - '0');
if (base < 2 || base > 36) goto error;
str += 3;
}
}
/* If still base is 0, set to default (10) */
if (base == 0) {
base = 10;
}
/* Skip leading zeros */
@@ -376,6 +383,13 @@ error:
return 1;
}
int janet_scan_number(
const uint8_t *str,
int32_t len,
double *out) {
return janet_scan_number_base(str, len, 0, out);
}
#ifdef JANET_INT_TYPES
static int scan_uint64(

View File

@@ -1,5 +1,5 @@
/*
* Copyright (c) 2021 Calvin Rose
* Copyright (c) 2022 Calvin Rose
*
* Permission is hereby granted, free of charge, to any person obtaining a copy
* of this software and associated documentation files (the "Software"), to
@@ -39,13 +39,14 @@ JanetKV *janet_struct_begin(int32_t count) {
head->length = count;
head->capacity = capacity;
head->hash = 0;
head->proto = NULL;
JanetKV *st = (JanetKV *)(head->data);
janet_memempty(st, capacity);
return st;
}
/* Find an item in a struct. Should be similar to janet_dict_find, but
/* Find an item in a struct without looking for prototypes. Should be similar to janet_dict_find, but
* specialized to structs (slightly more compact). */
const JanetKV *janet_struct_find(const JanetKV *st, Janet key) {
int32_t cap = janet_struct_capacity(st);
@@ -68,7 +69,7 @@ const JanetKV *janet_struct_find(const JanetKV *st, Janet key) {
* preforms an in-place insertion sort. This ensures the internal structure of the
* hash map is independent of insertion order.
*/
void janet_struct_put(JanetKV *st, Janet key, Janet value) {
void janet_struct_put_ext(JanetKV *st, Janet key, Janet value, int replace) {
int32_t cap = janet_struct_capacity(st);
int32_t hash = janet_hash(key);
int32_t index = janet_maphash(cap, hash);
@@ -123,13 +124,19 @@ void janet_struct_put(JanetKV *st, Janet key, Janet value) {
dist = otherdist;
hash = otherhash;
} else if (status == 0) {
/* A key was added to the struct more than once - replace old value */
kv->value = value;
if (replace) {
/* A key was added to the struct more than once - replace old value */
kv->value = value;
}
return;
}
}
}
void janet_struct_put(JanetKV *st, Janet key, Janet value) {
janet_struct_put_ext(st, key, value, 1);
}
/* Finish building a struct */
const JanetKV *janet_struct_end(JanetKV *st) {
if (janet_struct_hash(st) != janet_struct_length(st)) {
@@ -143,16 +150,43 @@ const JanetKV *janet_struct_end(JanetKV *st) {
janet_struct_put(newst, kv->key, kv->value);
}
}
janet_struct_proto(newst) = janet_struct_proto(st);
st = newst;
}
janet_struct_hash(st) = janet_kv_calchash(st, janet_struct_capacity(st));
if (janet_struct_proto(st)) {
janet_struct_hash(st) += 2654435761u * janet_struct_hash(janet_struct_proto(st));
}
return (const JanetKV *)st;
}
/* Get an item from a struct without looking into prototypes. */
Janet janet_struct_rawget(const JanetKV *st, Janet key) {
const JanetKV *kv = janet_struct_find(st, key);
return kv ? kv->value : janet_wrap_nil();
}
/* Get an item from a struct */
Janet janet_struct_get(const JanetKV *st, Janet key) {
const JanetKV *kv = janet_struct_find(st, key);
return kv ? kv->value : janet_wrap_nil();
for (int i = JANET_MAX_PROTO_DEPTH; st && i; --i, st = janet_struct_proto(st)) {
const JanetKV *kv = janet_struct_find(st, key);
if (NULL != kv && !janet_checktype(kv->key, JANET_NIL)) {
return kv->value;
}
}
return janet_wrap_nil();
}
/* Get an item from a struct, and record which prototype the item came from. */
Janet janet_struct_get_ex(const JanetKV *st, Janet key, JanetStruct *which) {
for (int i = JANET_MAX_PROTO_DEPTH; st && i; --i, st = janet_struct_proto(st)) {
const JanetKV *kv = janet_struct_find(st, key);
if (NULL != kv && !janet_checktype(kv->key, JANET_NIL)) {
*which = st;
return kv->value;
}
}
return janet_wrap_nil();
}
/* Convert struct to table */
@@ -167,3 +201,107 @@ JanetTable *janet_struct_to_table(const JanetKV *st) {
}
return table;
}
/* C Functions */
JANET_CORE_FN(cfun_struct_with_proto,
"(struct/with-proto proto & kvs)",
"Create a structure, as with the usual struct constructor but set the "
"struct prototype as well.") {
janet_arity(argc, 1, -1);
JanetStruct proto = janet_optstruct(argv, argc, 0, NULL);
if (!(argc & 1))
janet_panic("expected odd number of arguments");
JanetKV *st = janet_struct_begin(argc / 2);
for (int32_t i = 1; i < argc; i += 2) {
janet_struct_put(st, argv[i], argv[i + 1]);
}
janet_struct_proto(st) = proto;
return janet_wrap_struct(janet_struct_end(st));
}
JANET_CORE_FN(cfun_struct_getproto,
"(struct/getproto st)",
"Return the prototype of a struct, or nil if it doesn't have one.") {
janet_fixarity(argc, 1);
JanetStruct st = janet_getstruct(argv, 0);
return janet_struct_proto(st)
? janet_wrap_struct(janet_struct_proto(st))
: janet_wrap_nil();
}
JANET_CORE_FN(cfun_struct_flatten,
"(struct/proto-flatten st)",
"Convert a struct with prototypes to a struct with no prototypes by merging "
"all key value pairs from recursive prototypes into one new struct.") {
janet_fixarity(argc, 1);
JanetStruct st = janet_getstruct(argv, 0);
/* get an upper bounds on the number of items in the final struct */
int64_t pair_count = 0;
JanetStruct cursor = st;
while (cursor) {
pair_count += janet_struct_length(cursor);
cursor = janet_struct_proto(cursor);
}
if (pair_count > INT32_MAX) {
janet_panic("struct too large");
}
JanetKV *accum = janet_struct_begin((int32_t) pair_count);
cursor = st;
while (cursor) {
for (int32_t i = 0; i < janet_struct_capacity(cursor); i++) {
const JanetKV *kv = cursor + i;
if (!janet_checktype(kv->key, JANET_NIL)) {
janet_struct_put_ext(accum, kv->key, kv->value, 0);
}
}
cursor = janet_struct_proto(cursor);
}
return janet_wrap_struct(janet_struct_end(accum));
}
JANET_CORE_FN(cfun_struct_to_table,
"(struct/to-table st &opt recursive)",
"Convert a struct to a table. If recursive is true, also convert the "
"table's prototypes into the new struct's prototypes as well.") {
janet_arity(argc, 1, 2);
JanetStruct st = janet_getstruct(argv, 0);
int recursive = argc > 1 && janet_truthy(argv[1]);
JanetTable *tab = NULL;
JanetStruct cursor = st;
JanetTable *tab_cursor = tab;
do {
if (tab) {
tab_cursor->proto = janet_table(janet_struct_length(cursor));
tab_cursor = tab_cursor->proto;
} else {
tab = janet_table(janet_struct_length(cursor));
tab_cursor = tab;
}
/* TODO - implement as memcpy since struct memory should be compatible
* with table memory */
for (int32_t i = 0; i < janet_struct_capacity(cursor); i++) {
const JanetKV *kv = cursor + i;
if (!janet_checktype(kv->key, JANET_NIL)) {
janet_table_put(tab_cursor, kv->key, kv->value);
}
}
cursor = janet_struct_proto(cursor);
} while (recursive && cursor);
return janet_wrap_table(tab);
}
/* Load the struct module */
void janet_lib_struct(JanetTable *env) {
JanetRegExt struct_cfuns[] = {
JANET_CORE_REG("struct/with-proto", cfun_struct_with_proto),
JANET_CORE_REG("struct/getproto", cfun_struct_getproto),
JANET_CORE_REG("struct/proto-flatten", cfun_struct_flatten),
JANET_CORE_REG("struct/to-table", cfun_struct_to_table),
JANET_REG_END
};
janet_core_cfuns_ext(env, NULL, struct_cfuns);
}

View File

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

View File

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

View File

@@ -1,5 +1,5 @@
/*
* Copyright (c) 2021 Calvin Rose
* Copyright (c) 2022 Calvin Rose
*
* Permission is hereby granted, free of charge, to any person obtaining a copy
* of this software and associated documentation files (the "Software"), to
@@ -132,37 +132,21 @@ static void janet_table_rehash(JanetTable *t, int32_t size) {
/* Get a value out of the table */
Janet janet_table_get(JanetTable *t, Janet key) {
JanetKV *bucket = janet_table_find(t, key);
if (NULL != bucket && !janet_checktype(bucket->key, JANET_NIL))
return bucket->value;
/* Check prototypes */
{
int i;
for (i = JANET_MAX_PROTO_DEPTH, t = t->proto; t && i; t = t->proto, --i) {
bucket = janet_table_find(t, key);
if (NULL != bucket && !janet_checktype(bucket->key, JANET_NIL))
return bucket->value;
}
for (int i = JANET_MAX_PROTO_DEPTH; t && i; t = t->proto, --i) {
JanetKV *bucket = janet_table_find(t, key);
if (NULL != bucket && !janet_checktype(bucket->key, JANET_NIL))
return bucket->value;
}
return janet_wrap_nil();
}
/* Get a value out of the table, and record which prototype it was from. */
Janet janet_table_get_ex(JanetTable *t, Janet key, JanetTable **which) {
JanetKV *bucket = janet_table_find(t, key);
if (NULL != bucket && !janet_checktype(bucket->key, JANET_NIL)) {
*which = t;
return bucket->value;
}
/* Check prototypes */
{
int i;
for (i = JANET_MAX_PROTO_DEPTH, t = t->proto; t && i; t = t->proto, --i) {
bucket = janet_table_find(t, key);
if (NULL != bucket && !janet_checktype(bucket->key, JANET_NIL)) {
*which = t;
return bucket->value;
}
for (int i = JANET_MAX_PROTO_DEPTH; t && i; t = t->proto, --i) {
JanetKV *bucket = janet_table_find(t, key);
if (NULL != bucket && !janet_checktype(bucket->key, JANET_NIL)) {
*which = t;
return bucket->value;
}
}
return janet_wrap_nil();
@@ -217,6 +201,23 @@ void janet_table_put(JanetTable *t, Janet key, Janet value) {
}
}
/* Used internally so don't check arguments
* Put into a table, but if the key already exists do nothing. */
static void janet_table_put_no_overwrite(JanetTable *t, Janet key, Janet value) {
JanetKV *bucket = janet_table_find(t, key);
if (NULL != bucket && !janet_checktype(bucket->key, JANET_NIL))
return;
if (NULL == bucket || 2 * (t->count + t->deleted + 1) > t->capacity) {
janet_table_rehash(t, janet_tablen(2 * t->count + 2));
}
bucket = janet_table_find(t, key);
if (janet_checktype(bucket->value, JANET_BOOLEAN))
--t->deleted;
bucket->key = key;
bucket->value = value;
++t->count;
}
/* Clear a table */
void janet_table_clear(JanetTable *t) {
int32_t capacity = t->capacity;
@@ -226,19 +227,6 @@ void janet_table_clear(JanetTable *t) {
t->deleted = 0;
}
/* Convert table to struct */
const JanetKV *janet_table_to_struct(JanetTable *t) {
JanetKV *st = janet_struct_begin(t->count);
JanetKV *kv = t->data;
JanetKV *end = t->data + t->capacity;
while (kv < end) {
if (!janet_checktype(kv->key, JANET_NIL))
janet_struct_put(st, kv->key, kv->value);
kv++;
}
return janet_struct_end(st);
}
/* Clone a table. */
JanetTable *janet_table_clone(JanetTable *table) {
JanetTable *newTable = janet_gcalloc(JANET_MEMORY_TABLE, sizeof(JanetTable));
@@ -275,6 +263,34 @@ void janet_table_merge_struct(JanetTable *table, const JanetKV *other) {
janet_table_mergekv(table, other, janet_struct_capacity(other));
}
/* Convert table to struct */
const JanetKV *janet_table_to_struct(JanetTable *t) {
JanetKV *st = janet_struct_begin(t->count);
JanetKV *kv = t->data;
JanetKV *end = t->data + t->capacity;
while (kv < end) {
if (!janet_checktype(kv->key, JANET_NIL))
janet_struct_put(st, kv->key, kv->value);
kv++;
}
return janet_struct_end(st);
}
JanetTable *janet_table_proto_flatten(JanetTable *t) {
JanetTable *newTable = janet_table(0);
while (t) {
JanetKV *kv = t->data;
JanetKV *end = t->data + t->capacity;
while (kv < end) {
if (!janet_checktype(kv->key, JANET_NIL))
janet_table_put_no_overwrite(newTable, kv->key, kv->value);
kv++;
}
t = t->proto;
}
return newTable;
}
/* C Functions */
JANET_CORE_FN(cfun_table_new,
@@ -349,6 +365,14 @@ JANET_CORE_FN(cfun_table_clear,
return janet_wrap_table(table);
}
JANET_CORE_FN(cfun_table_proto_flatten,
"(table/proto-flatten tab)",
"Create a new table that is the result of merging all prototypes into a new table.") {
janet_fixarity(argc, 1);
JanetTable *table = janet_gettable(argv, 0);
return janet_wrap_table(janet_table_proto_flatten(table));
}
/* Load the table module */
void janet_lib_table(JanetTable *env) {
JanetRegExt table_cfuns[] = {
@@ -359,6 +383,7 @@ void janet_lib_table(JanetTable *env) {
JANET_CORE_REG("table/rawget", cfun_table_rawget),
JANET_CORE_REG("table/clone", cfun_table_clone),
JANET_CORE_REG("table/clear", cfun_table_clear),
JANET_CORE_REG("table/proto-flatten", cfun_table_proto_flatten),
JANET_REG_END
};
janet_core_cfuns_ext(env, NULL, table_cfuns);

View File

@@ -1,739 +0,0 @@
/*
* Copyright (c) 2021 Calvin Rose
*
* Permission is hereby granted, free of charge, to any person obtaining a copy
* of this software and associated documentation files (the "Software"), to
* deal in the Software without restriction, including without limitation the
* rights to use, copy, modify, merge, publish, distribute, sublicense, and/or
* sell copies of the Software, and to permit persons to whom the Software is
* furnished to do so, subject to the following conditions:
*
* The above copyright notice and this permission notice shall be included in
* all copies or substantial portions of the Software.
*
* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
* AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS
* IN THE SOFTWARE.
*/
#ifndef JANET_AMALG
#include "features.h"
#include <janet.h>
#include "gc.h"
#include "util.h"
#include "state.h"
#endif
#ifdef JANET_THREADS
#include <math.h>
#ifdef JANET_WINDOWS
#include <windows.h>
#else
#include <setjmp.h>
#include <time.h>
#include <pthread.h>
#endif
/* typedefed in janet.h */
struct JanetMailbox {
/* Synchronization */
#ifdef JANET_WINDOWS
CRITICAL_SECTION lock;
CONDITION_VARIABLE cond;
#else
pthread_mutex_t lock;
pthread_cond_t cond;
#endif
/* Memory management - reference counting */
int refCount;
int closed;
/* Store messages */
uint16_t messageCapacity;
uint16_t messageCount;
uint16_t messageFirst;
uint16_t messageNext;
/* Buffers to store messages. These buffers are manually allocated, so
* are not owned by any thread's GC. */
JanetBuffer messages[];
};
#define JANET_THREAD_HEAVYWEIGHT 0x1
#define JANET_THREAD_ABSTRACTS 0x2
#define JANET_THREAD_CFUNCTIONS 0x4
static const char janet_thread_flags[] = "hac";
static JanetTable *janet_thread_get_decode(void) {
if (janet_vm.thread_decode == NULL) {
janet_vm.thread_decode = janet_get_core_table("load-image-dict");
if (NULL == janet_vm.thread_decode) {
janet_vm.thread_decode = janet_table(0);
}
janet_gcroot(janet_wrap_table(janet_vm.thread_decode));
}
return janet_vm.thread_decode;
}
static JanetMailbox *janet_mailbox_create(int refCount, uint16_t capacity) {
JanetMailbox *mailbox = janet_malloc(sizeof(JanetMailbox) + sizeof(JanetBuffer) * (size_t) capacity);
if (NULL == mailbox) {
JANET_OUT_OF_MEMORY;
}
#ifdef JANET_WINDOWS
InitializeCriticalSection(&mailbox->lock);
InitializeConditionVariable(&mailbox->cond);
#else
pthread_mutex_init(&mailbox->lock, NULL);
pthread_cond_init(&mailbox->cond, NULL);
#endif
mailbox->refCount = refCount;
mailbox->closed = 0;
mailbox->messageCount = 0;
mailbox->messageCapacity = capacity;
mailbox->messageFirst = 0;
mailbox->messageNext = 0;
for (uint16_t i = 0; i < capacity; i++) {
janet_buffer_init(mailbox->messages + i, 0);
}
return mailbox;
}
static void janet_mailbox_destroy(JanetMailbox *mailbox) {
#ifdef JANET_WINDOWS
DeleteCriticalSection(&mailbox->lock);
#else
pthread_mutex_destroy(&mailbox->lock);
pthread_cond_destroy(&mailbox->cond);
#endif
for (uint16_t i = 0; i < mailbox->messageCapacity; i++) {
janet_buffer_deinit(mailbox->messages + i);
}
janet_free(mailbox);
}
static void janet_mailbox_lock(JanetMailbox *mailbox) {
#ifdef JANET_WINDOWS
EnterCriticalSection(&mailbox->lock);
#else
pthread_mutex_lock(&mailbox->lock);
#endif
}
static void janet_mailbox_unlock(JanetMailbox *mailbox) {
#ifdef JANET_WINDOWS
LeaveCriticalSection(&mailbox->lock);
#else
pthread_mutex_unlock(&mailbox->lock);
#endif
}
/* Assumes you have the mailbox lock already */
static void janet_mailbox_ref_with_lock(JanetMailbox *mailbox, int delta) {
mailbox->refCount += delta;
if (mailbox->refCount <= 0) {
janet_mailbox_unlock(mailbox);
janet_mailbox_destroy(mailbox);
} else {
janet_mailbox_unlock(mailbox);
}
}
static void janet_mailbox_ref(JanetMailbox *mailbox, int delta) {
janet_mailbox_lock(mailbox);
janet_mailbox_ref_with_lock(mailbox, delta);
}
static void janet_close_thread(JanetThread *thread) {
if (thread->mailbox) {
janet_mailbox_ref(thread->mailbox, -1);
thread->mailbox = NULL;
}
}
static int thread_gc(void *p, size_t size) {
(void) size;
JanetThread *thread = (JanetThread *)p;
janet_close_thread(thread);
return 0;
}
static int thread_mark(void *p, size_t size) {
(void) size;
JanetThread *thread = (JanetThread *)p;
if (thread->encode) {
janet_mark(janet_wrap_table(thread->encode));
}
return 0;
}
static JanetMailboxPair *make_mailbox_pair(JanetMailbox *original, uint64_t flags) {
JanetMailboxPair *pair = janet_malloc(sizeof(JanetMailboxPair));
if (NULL == pair) {
JANET_OUT_OF_MEMORY;
}
pair->original = original;
janet_mailbox_ref(original, 1);
pair->newbox = janet_mailbox_create(1, 16);
pair->flags = flags;
return pair;
}
static void destroy_mailbox_pair(JanetMailboxPair *pair) {
janet_mailbox_ref(pair->original, -1);
janet_mailbox_ref(pair->newbox, -1);
janet_free(pair);
}
/* Abstract waiting for timeout across windows/posix */
typedef struct {
int timedwait;
int nowait;
#ifdef JANET_WINDOWS
DWORD interval;
DWORD ticksLeft;
#else
struct timespec ts;
#endif
} JanetWaiter;
static void janet_waiter_init(JanetWaiter *waiter, double sec) {
waiter->timedwait = 0;
waiter->nowait = 0;
if (sec <= 0.0 || isnan(sec)) {
waiter->nowait = 1;
return;
}
waiter->timedwait = sec > 0.0 && !isinf(sec);
/* Set maximum wait time to 30 days */
if (sec > (60.0 * 60.0 * 24.0 * 30.0)) {
sec = 60.0 * 60.0 * 24.0 * 30.0;
}
#ifdef JANET_WINDOWS
if (waiter->timedwait) {
waiter->ticksLeft = waiter->interval = (DWORD) floor(1000.0 * sec);
}
#else
if (waiter->timedwait) {
/* N seconds -> timespec of (now + sec) */
struct timespec now;
janet_gettime(&now);
time_t tvsec = (time_t) floor(sec);
long tvnsec = (long) floor(1000000000.0 * (sec - ((double) tvsec)));
tvsec += now.tv_sec;
tvnsec += now.tv_nsec;
if (tvnsec >= 1000000000L) {
tvnsec -= 1000000000L;
tvsec += 1;
}
waiter->ts.tv_sec = tvsec;
waiter->ts.tv_nsec = tvnsec;
}
#endif
}
static int janet_waiter_wait(JanetWaiter *wait, JanetMailbox *mailbox) {
if (wait->nowait) return 1;
#ifdef JANET_WINDOWS
if (wait->timedwait) {
if (wait->ticksLeft == 0) return 1;
DWORD startTime = GetTickCount();
int status = !SleepConditionVariableCS(&mailbox->cond, &mailbox->lock, wait->ticksLeft);
DWORD dTick = GetTickCount() - startTime;
/* Be careful about underflow */
wait->ticksLeft = dTick > wait->ticksLeft ? 0 : dTick;
return status;
} else {
SleepConditionVariableCS(&mailbox->cond, &mailbox->lock, INFINITE);
return 0;
}
#else
if (wait->timedwait) {
return pthread_cond_timedwait(&mailbox->cond, &mailbox->lock, &wait->ts);
} else {
pthread_cond_wait(&mailbox->cond, &mailbox->lock);
return 0;
}
#endif
}
static void janet_mailbox_wakeup(JanetMailbox *mailbox) {
#ifdef JANET_WINDOWS
WakeConditionVariable(&mailbox->cond);
#else
pthread_cond_signal(&mailbox->cond);
#endif
}
static int mailbox_at_capacity(JanetMailbox *mailbox) {
return mailbox->messageCount >= mailbox->messageCapacity;
}
/* Returns 1 if could not send (encode error or timeout), 2 for mailbox closed, and
* 0 otherwise. Will not panic. */
int janet_thread_send(JanetThread *thread, Janet msg, double timeout) {
/* Ensure mailbox is not closed. */
JanetMailbox *mailbox = thread->mailbox;
if (NULL == mailbox) return 2;
janet_mailbox_lock(mailbox);
if (mailbox->closed) {
janet_mailbox_ref_with_lock(mailbox, -1);
thread->mailbox = NULL;
return 2;
}
/* Back pressure */
if (mailbox_at_capacity(mailbox)) {
JanetWaiter wait;
janet_waiter_init(&wait, timeout);
if (wait.nowait) {
janet_mailbox_unlock(mailbox);
return 1;
}
/* Retry loop, as there can be multiple writers */
while (mailbox_at_capacity(mailbox)) {
if (janet_waiter_wait(&wait, mailbox)) {
janet_mailbox_unlock(mailbox);
janet_mailbox_wakeup(mailbox);
return 1;
}
}
}
/* Hack to capture all panics from marshalling. This works because
* we know janet_marshal won't mess with other essential global state. */
jmp_buf buf;
jmp_buf *old_buf = janet_vm.signal_buf;
janet_vm.signal_buf = &buf;
int32_t oldmcount = mailbox->messageCount;
int ret = 0;
if (setjmp(buf)) {
ret = 1;
mailbox->messageCount = oldmcount;
} else {
JanetBuffer *msgbuf = mailbox->messages + mailbox->messageNext;
msgbuf->count = 0;
/* Start panic zone */
janet_marshal(msgbuf, msg, thread->encode, JANET_MARSHAL_UNSAFE);
/* End panic zone */
mailbox->messageNext = (mailbox->messageNext + 1) % mailbox->messageCapacity;
mailbox->messageCount++;
}
/* Cleanup */
janet_vm.signal_buf = old_buf;
janet_mailbox_unlock(mailbox);
/* Potentially wake up a blocked thread */
janet_mailbox_wakeup(mailbox);
return ret;
}
/* Returns 0 on successful message. Returns 1 if timedout */
int janet_thread_receive(Janet *msg_out, double timeout) {
JanetMailbox *mailbox = janet_vm.mailbox;
janet_mailbox_lock(mailbox);
/* For timeouts */
JanetWaiter wait;
janet_waiter_init(&wait, timeout);
for (;;) {
/* Check for messages waiting for us */
if (mailbox->messageCount > 0) {
/* Hack to capture all panics from marshalling. This works because
* we know janet_marshal won't mess with other essential global state. */
jmp_buf buf;
jmp_buf *old_buf = janet_vm.signal_buf;
janet_vm.signal_buf = &buf;
/* Handle errors */
if (setjmp(buf)) {
/* Cleanup jmp_buf, return error.
* Do not ignore bad messages as before. */
janet_vm.signal_buf = old_buf;
*msg_out = *janet_vm.return_reg;
janet_mailbox_unlock(mailbox);
return 2;
} else {
JanetBuffer *msgbuf = mailbox->messages + mailbox->messageFirst;
mailbox->messageCount--;
mailbox->messageFirst = (mailbox->messageFirst + 1) % mailbox->messageCapacity;
/* Read from beginning of channel */
const uint8_t *nextItem = NULL;
Janet item = janet_unmarshal(
msgbuf->data, msgbuf->count,
JANET_MARSHAL_UNSAFE, janet_thread_get_decode(), &nextItem);
*msg_out = item;
/* Cleanup */
janet_vm.signal_buf = old_buf;
janet_mailbox_unlock(mailbox);
/* Potentially wake up pending threads */
janet_mailbox_wakeup(mailbox);
return 0;
}
}
if (wait.nowait) {
janet_mailbox_unlock(mailbox);
return 1;
}
/* Wait for next message */
if (janet_waiter_wait(&wait, mailbox)) {
janet_mailbox_unlock(mailbox);
return 1;
}
}
}
static int janet_thread_getter(void *p, Janet key, Janet *out);
static Janet janet_thread_next(void *p, Janet key);
const JanetAbstractType janet_thread_type = {
"core/thread",
thread_gc,
thread_mark,
janet_thread_getter,
NULL, /* put */
NULL, /* marshal */
NULL, /* unmarshal */
NULL, /* tostring */
NULL, /* compare */
NULL, /* hash */
janet_thread_next,
JANET_ATEND_NEXT
};
static JanetThread *janet_make_thread(JanetMailbox *mailbox, JanetTable *encode) {
JanetThread *thread = janet_abstract(&janet_thread_type, sizeof(JanetThread));
janet_mailbox_ref(mailbox, 1);
thread->mailbox = mailbox;
thread->encode = encode;
return thread;
}
JanetThread *janet_getthread(const Janet *argv, int32_t n) {
return (JanetThread *) janet_getabstract(argv, n, &janet_thread_type);
}
/* Runs in new thread */
static int thread_worker(JanetMailboxPair *pair) {
JanetFiber *fiber = NULL;
Janet out;
/* Init VM */
janet_init();
/* Use the mailbox we were given */
janet_vm.mailbox = pair->newbox;
janet_mailbox_ref(pair->newbox, 1);
/* Get dictionaries for default encode/decode */
JanetTable *encode;
if (pair->flags & JANET_THREAD_HEAVYWEIGHT) {
encode = janet_get_core_table("make-image-dict");
} else {
encode = NULL;
janet_vm.thread_decode = janet_table(0);
janet_gcroot(janet_wrap_table(janet_vm.thread_decode));
}
/* Create parent thread */
JanetThread *parent = janet_make_thread(pair->original, encode);
Janet parentv = janet_wrap_abstract(parent);
/* Unmarshal the abstract registry */
if (pair->flags & JANET_THREAD_ABSTRACTS) {
Janet reg;
int status = janet_thread_receive(&reg, INFINITY);
if (status) goto error;
if (!janet_checktype(reg, JANET_TABLE)) goto error;
janet_gcunroot(janet_wrap_table(janet_vm.abstract_registry));
janet_vm.abstract_registry = janet_unwrap_table(reg);
janet_gcroot(janet_wrap_table(janet_vm.abstract_registry));
}
/* Unmarshal the function */
Janet funcv;
int status = janet_thread_receive(&funcv, INFINITY);
if (status) goto error;
if (!janet_checktype(funcv, JANET_FUNCTION)) goto error;
JanetFunction *func = janet_unwrap_function(funcv);
/* Arity check */
if (func->def->min_arity > 1 || func->def->max_arity < 1) {
goto error;
}
/* 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)));
janet_stacktrace(fiber, out);
}
#ifdef JANET_EV
janet_loop();
#endif
/* Normal exit */
destroy_mailbox_pair(pair);
janet_deinit();
return 0;
/* Fail to set something up */
error:
destroy_mailbox_pair(pair);
janet_eprintf("\nthread failed to start\n");
janet_deinit();
return 1;
}
#ifdef JANET_WINDOWS
static DWORD WINAPI janet_create_thread_wrapper(LPVOID param) {
thread_worker((JanetMailboxPair *)param);
return 0;
}
static int janet_thread_start_child(JanetMailboxPair *pair) {
HANDLE handle = CreateThread(NULL, 0, janet_create_thread_wrapper, pair, 0, NULL);
int ret = NULL == handle;
/* Does not kill thread, simply detatches */
if (!ret) CloseHandle(handle);
return ret;
}
#else
static void *janet_pthread_wrapper(void *param) {
thread_worker((JanetMailboxPair *)param);
return NULL;
}
static int janet_thread_start_child(JanetMailboxPair *pair) {
pthread_t handle;
int error = pthread_create(&handle, NULL, janet_pthread_wrapper, pair);
if (error) {
return 1;
} else {
pthread_detach(handle);
return 0;
}
}
#endif
/*
* Setup/Teardown
*/
void janet_threads_init(void) {
janet_vm.mailbox = janet_mailbox_create(1, 10);
janet_vm.thread_decode = NULL;
janet_vm.thread_current = NULL;
}
void janet_threads_deinit(void) {
janet_mailbox_lock(janet_vm.mailbox);
janet_vm.mailbox->closed = 1;
janet_mailbox_ref_with_lock(janet_vm.mailbox, -1);
janet_vm.mailbox = NULL;
janet_vm.thread_current = NULL;
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
*/
JANET_CORE_FN(cfun_thread_current,
"(thread/current)",
"Get the current running thread.") {
(void) argv;
janet_fixarity(argc, 0);
return janet_wrap_abstract(janet_thread_current());
}
JANET_CORE_FN(cfun_thread_new,
"(thread/new func &opt capacity flags)",
"Start a new thread that will start immediately. "
"If capacity is provided, that is how many messages can be stored in the thread's mailbox before blocking senders. "
"The capacity must be between 1 and 65535 inclusive, and defaults to 10. "
"Can optionally provide flags to the new thread - supported flags are:\n\n"
"* `:h` - Start a heavyweight thread. This loads the core environment by default, so may use more memory initially. Messages may compress better, though.\n"
"* `:a` - Allow sending over registered abstract types to the new thread\n"
"* `:c` - Send over cfunction information to the new thread (no longer supported).\n"
"Returns a handle to the new thread.") {
janet_arity(argc, 1, 3);
/* Just type checking */
janet_getfunction(argv, 0);
int32_t cap = janet_optinteger(argv, argc, 1, 10);
if (cap < 1 || cap > UINT16_MAX) {
janet_panicf("bad slot #1, expected integer in range [1, 65535], got %d", cap);
}
uint64_t flags = argc >= 3 ? janet_getflags(argv, 2, janet_thread_flags) : JANET_THREAD_ABSTRACTS;
JanetTable *encode;
if (flags & JANET_THREAD_HEAVYWEIGHT) {
encode = janet_get_core_table("make-image-dict");
} else {
encode = NULL;
}
JanetMailboxPair *pair = make_mailbox_pair(janet_vm.mailbox, flags);
JanetThread *thread = janet_make_thread(pair->newbox, encode);
if (janet_thread_start_child(pair)) {
destroy_mailbox_pair(pair);
janet_panic("could not start thread");
}
if (flags & JANET_THREAD_ABSTRACTS) {
if (janet_thread_send(thread, janet_wrap_table(janet_vm.abstract_registry), INFINITY)) {
janet_panic("could not send abstract registry to thread");
}
}
/* If thread started, send the worker function. */
if (janet_thread_send(thread, argv[0], INFINITY)) {
janet_panicf("could not send worker function %v to thread", argv[0]);
}
return janet_wrap_abstract(thread);
}
JANET_CORE_FN(cfun_thread_send,
"(thread/send thread msgi &opt timeout)",
"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.") {
janet_arity(argc, 2, 3);
JanetThread *thread = janet_getthread(argv, 0);
int status = janet_thread_send(thread, argv[1], janet_optnumber(argv, argc, 2, 1.0));
switch (status) {
default:
break;
case 1:
janet_panicf("failed to send message %v", argv[1]);
case 2:
janet_panic("thread mailbox is closed");
}
return argv[0];
}
JANET_CORE_FN(cfun_thread_receive,
"(thread/receive &opt timeout)",
"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.") {
janet_arity(argc, 0, 1);
double wait = janet_optnumber(argv, argc, 0, 1.0);
Janet out;
int status = janet_thread_receive(&out, wait);
switch (status) {
default:
break;
case 1:
janet_panicf("timeout after %f seconds", wait);
case 2:
janet_panicf("failed to receive message: %v", out);
}
return out;
}
JANET_CORE_FN(cfun_thread_close,
"(thread/close thread)",
"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.") {
janet_fixarity(argc, 1);
JanetThread *thread = janet_getthread(argv, 0);
janet_close_thread(thread);
return janet_wrap_nil();
}
JANET_CORE_FN(cfun_thread_exit,
"(thread/exit &opt code)",
"Exit from the current thread. If no more threads are running, ends the process, but otherwise does "
"not end the current process.") {
(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},
{NULL, NULL}
};
static int janet_thread_getter(void *p, Janet key, Janet *out) {
(void) p;
if (!janet_checktype(key, JANET_KEYWORD)) return 0;
return janet_getmethod(janet_unwrap_keyword(key), janet_thread_methods, out);
}
static Janet janet_thread_next(void *p, Janet key) {
(void) p;
return janet_nextmethod(janet_thread_methods, key);
}
/* Module entry point */
void janet_lib_thread(JanetTable *env) {
JanetRegExt threadlib_cfuns[] = {
JANET_CORE_REG("thread/current", cfun_thread_current),
JANET_CORE_REG("thread/new", cfun_thread_new),
JANET_CORE_REG("thread/send", cfun_thread_send),
JANET_CORE_REG("thread/receive", cfun_thread_receive),
JANET_CORE_REG("thread/close", cfun_thread_close),
JANET_CORE_REG("thread/exit", cfun_thread_exit),
JANET_REG_END
};
janet_core_cfuns_ext(env, NULL, threadlib_cfuns);
janet_register_abstract_type(&janet_thread_type);
}
#endif

View File

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

View File

@@ -1,5 +1,5 @@
/*
* Copyright (c) 2021 Calvin Rose
* Copyright (c) 2022 Calvin Rose
*
* Permission is hereby granted, free of charge, to any person obtaining a copy
* of this software and associated documentation files (the "Software"), to
@@ -36,6 +36,10 @@
#endif
#endif
#ifdef JANET_APPLE
#include <AvailabilityMacros.h>
#endif
#include <inttypes.h>
/* Base 64 lookup table for digits */
@@ -224,13 +228,17 @@ int32_t janet_string_calchash(const uint8_t *str, int32_t len) {
#endif
uint32_t janet_hash_mix(uint32_t input, uint32_t more) {
uint32_t mix1 = (more + 0x9e3779b9 + (input << 6) + (input >> 2));
return input ^ (0x9e3779b9 + (mix1 << 6) + (mix1 >> 2));
}
/* Computes hash of an array of values */
int32_t janet_array_calchash(const Janet *array, int32_t len) {
const Janet *end = array + len;
uint32_t hash = 0;
uint32_t hash = 33;
while (array < end) {
uint32_t elem = janet_hash(*array++);
hash ^= elem + 0x9e3779b9 + (hash << 6) + (hash >> 2);
hash = janet_hash_mix(hash, janet_hash(*array++));
}
return (int32_t) hash;
}
@@ -238,10 +246,10 @@ int32_t janet_array_calchash(const Janet *array, int32_t len) {
/* Computes hash of an array of values */
int32_t janet_kv_calchash(const JanetKV *kvs, int32_t len) {
const JanetKV *end = kvs + len;
uint32_t hash = 0;
uint32_t hash = 33;
while (kvs < end) {
hash ^= janet_hash(kvs->key) + 0x9e3779b9 + (hash << 6) + (hash >> 2);
hash ^= janet_hash(kvs->value) + 0x9e3779b9 + (hash << 6) + (hash >> 2);
hash = janet_hash_mix(hash, janet_hash(kvs->key));
hash = janet_hash_mix(hash, janet_hash(kvs->value));
kvs++;
}
return (int32_t) hash;
@@ -593,10 +601,8 @@ void janet_core_cfuns_ext(JanetTable *env, const char *regprefix, const JanetReg
}
#endif
JanetBinding janet_resolve_ext(JanetTable *env, const uint8_t *sym) {
Janet ref;
JanetBinding janet_binding_from_entry(Janet entry) {
JanetTable *entry_table;
Janet entry = janet_table_get(env, janet_wrap_symbol(sym));
JanetBinding binding = {
JANET_BINDING_NONE,
janet_wrap_nil(),
@@ -623,29 +629,41 @@ JanetBinding janet_resolve_ext(JanetTable *env, const uint8_t *sym) {
binding.deprecation = JANET_BINDING_DEP_NORMAL;
}
if (!janet_checktype(
janet_table_get(entry_table, janet_ckeywordv("macro")),
JANET_NIL)) {
binding.value = janet_table_get(entry_table, janet_ckeywordv("value"));
binding.type = JANET_BINDING_MACRO;
int macro = janet_truthy(janet_table_get(entry_table, janet_ckeywordv("macro")));
Janet value = janet_table_get(entry_table, janet_ckeywordv("value"));
Janet ref = janet_table_get(entry_table, janet_ckeywordv("ref"));
int ref_is_valid = janet_checktype(ref, JANET_ARRAY);
int redef = ref_is_valid && janet_truthy(janet_table_get(entry_table, janet_ckeywordv("redef")));
if (macro) {
binding.value = redef ? ref : value;
binding.type = redef ? JANET_BINDING_DYNAMIC_MACRO : JANET_BINDING_MACRO;
return binding;
}
ref = janet_table_get(entry_table, janet_ckeywordv("ref"));
if (janet_checktype(ref, JANET_ARRAY)) {
if (ref_is_valid) {
binding.value = ref;
binding.type = JANET_BINDING_VAR;
return binding;
binding.type = redef ? JANET_BINDING_DYNAMIC_DEF : JANET_BINDING_VAR;
} else {
binding.value = value;
binding.type = JANET_BINDING_DEF;
}
binding.value = janet_table_get(entry_table, janet_ckeywordv("value"));
binding.type = JANET_BINDING_DEF;
return binding;
}
JanetBinding janet_resolve_ext(JanetTable *env, const uint8_t *sym) {
Janet entry = janet_table_get(env, janet_wrap_symbol(sym));
return janet_binding_from_entry(entry);
}
JanetBindingType janet_resolve(JanetTable *env, const uint8_t *sym, Janet *out) {
JanetBinding binding = janet_resolve_ext(env, sym);
*out = binding.value;
if (binding.type == JANET_BINDING_DYNAMIC_DEF || binding.type == JANET_BINDING_DYNAMIC_MACRO) {
*out = janet_array_peek(janet_unwrap_array(binding.value));
} else {
*out = binding.value;
}
return binding.type;
}
@@ -775,11 +793,6 @@ int32_t janet_sorted_keys(const JanetKV *dict, int32_t cap, int32_t *index_buffe
/* 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;
@@ -792,7 +805,10 @@ int janet_gettime(struct timespec *spec) {
spec->tv_nsec = wintime % 10000000LL * 100;
return 0;
}
#elif defined(__MACH__)
/* clock_gettime() wasn't available on Mac until 10.12. */
#elif defined(JANET_APPLE) && !defined(MAC_OS_X_VERSION_10_12)
#include <mach/clock.h>
#include <mach/mach.h>
int janet_gettime(struct timespec *spec) {
clock_serv_t cclock;
mach_timespec_t mts;

View File

@@ -1,5 +1,5 @@
/*
* Copyright (c) 2021 Calvin Rose
* Copyright (c) 2022 Calvin Rose
*
* Permission is hereby granted, free of charge, to any person obtaining a copy
* of this software and associated documentation files (the "Software"), to
@@ -56,7 +56,10 @@
} while (0)
/* Utils */
uint32_t janet_hash_mix(uint32_t input, uint32_t more);
#define janet_maphash(cap, hash) ((uint32_t)(hash) & (cap - 1))
int janet_valid_utf8(const uint8_t *str, int32_t len);
int janet_is_symbol_char(uint8_t c);
extern const char janet_base64[65];
int32_t janet_array_calchash(const Janet *array, int32_t len);
int32_t janet_kv_calchash(const JanetKV *kvs, int32_t len);
@@ -81,6 +84,7 @@ void janet_buffer_format(
int32_t argc,
Janet *argv);
Janet janet_next_impl(Janet ds, Janet key, int is_interpreter);
JanetBinding janet_binding_from_entry(Janet entry);
/* Registry functions */
void janet_registry_put(
@@ -126,6 +130,7 @@ void janet_lib_array(JanetTable *env);
void janet_lib_tuple(JanetTable *env);
void janet_lib_buffer(JanetTable *env);
void janet_lib_table(JanetTable *env);
void janet_lib_struct(JanetTable *env);
void janet_lib_fiber(JanetTable *env);
void janet_lib_os(JanetTable *env);
void janet_lib_string(JanetTable *env);
@@ -145,9 +150,6 @@ void janet_lib_typed_array(JanetTable *env);
#ifdef JANET_INT_TYPES
void janet_lib_inttypes(JanetTable *env);
#endif
#ifdef JANET_THREADS
void janet_lib_thread(JanetTable *env);
#endif
#ifdef JANET_NET
void janet_lib_net(JanetTable *env);
extern const JanetAbstractType janet_address_type;

View File

@@ -1,5 +1,5 @@
/*
* Copyright (c) 2021 Calvin Rose
* Copyright (c) 2022 Calvin Rose
*
* Permission is hereby granted, free of charge, to any person obtaining a copy
* of this software and associated documentation files (the "Software"), to
@@ -37,8 +37,9 @@ static void push_traversal_node(void *lhs, void *rhs, int32_t index2) {
node.other = (JanetGCObject *) rhs;
node.index = 0;
node.index2 = index2;
if (janet_vm.traversal + 1 >= janet_vm.traversal_top) {
size_t oldsize = janet_vm.traversal - janet_vm.traversal_base;
int is_new = janet_vm.traversal_base == NULL;
if (is_new || (janet_vm.traversal + 1 >= janet_vm.traversal_top)) {
size_t oldsize = is_new ? 0 : (janet_vm.traversal - janet_vm.traversal_base);
size_t newsize = 2 * oldsize + 1;
if (newsize < 128) {
newsize = 128;
@@ -100,6 +101,17 @@ static int traversal_next(Janet *x, Janet *y) {
janet_vm.traversal = t;
return 0;
}
/* Traverse prototype */
JanetStruct sproto = sself->proto;
JanetStruct oproto = sother->proto;
if (sproto && !oproto) return 3;
if (!sproto && oproto) return 1;
if (oproto && sproto) {
*x = janet_wrap_struct(sproto);
*y = janet_wrap_struct(oproto);
janet_vm.traversal = t - 1;
return 0;
}
}
t--;
}
@@ -272,6 +284,8 @@ int janet_equals(Janet x, Janet y) {
if (s1 == s2) break;
if (janet_struct_hash(s1) != janet_struct_hash(s2)) return 0;
if (janet_struct_length(s1) != janet_struct_length(s2)) return 0;
if (janet_struct_proto(s1) && !janet_struct_proto(s2)) return 0;
if (!janet_struct_proto(s1) && janet_struct_proto(s2)) return 0;
push_traversal_node(janet_struct_head(s1), janet_struct_head(s2), 0);
break;
}
@@ -308,9 +322,11 @@ int32_t janet_hash(Janet x) {
uint64_t u;
} as;
as.d = janet_unwrap_number(x);
as.d += 0.0; /* normalize negative 0 */
uint32_t lo = (uint32_t)(as.u & 0xFFFFFFFF);
uint32_t hi = (uint32_t)(as.u >> 32);
hash = (int32_t)(hi ^ (lo >> 3));
uint32_t hilo = (hi ^ lo) * 2654435769u;
hash = (int32_t)((hilo << 16) | (hilo >> 16));
break;
}
case JANET_ABSTRACT: {
@@ -324,15 +340,17 @@ int32_t janet_hash(Janet x) {
/* fallthrough */
default:
if (sizeof(double) == sizeof(void *)) {
/* Assuming 8 byte pointer */
/* Assuming 8 byte pointer (8 byte aligned) */
uint64_t i = janet_u64(x);
uint32_t lo = (uint32_t)(i & 0xFFFFFFFF);
uint32_t hi = (uint32_t)(i >> 32);
hash = (int32_t)(hi ^ (lo >> 3));
uint32_t hilo = (hi ^ lo) * 2654435769u;
hash = (int32_t)((hilo << 16) | (hilo >> 16));
} else {
/* Assuming 4 byte pointer (or smaller) */
hash = (int32_t)((char *)janet_unwrap_pointer(x) - (char *)0);
hash >>= 2;
ptrdiff_t diff = ((char *)janet_unwrap_pointer(x) - (char *)0);
uint32_t hilo = (uint32_t) diff * 2654435769u;
hash = (int32_t)((hilo << 16) | (hilo >> 16));
}
break;
}

View File

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

View File

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

View File

@@ -1,5 +1,5 @@
/*
* Copyright (c) 2021 Calvin Rose
* Copyright (c) 2022 Calvin Rose
*
* Permission is hereby granted, free of charge, to any person obtaining a copy
* of this software and associated documentation files (the "Software"), to
@@ -315,7 +315,7 @@ static Janet janet_binop_call(const char *lmethod, const char *rmethod, Janet lh
}
/* Forward declaration */
static JanetSignal janet_check_can_resume(JanetFiber *fiber, Janet *out);
static JanetSignal janet_check_can_resume(JanetFiber *fiber, Janet *out, int is_cancel);
static JanetSignal janet_continue_no_check(JanetFiber *fiber, Janet in, Janet *out);
/* Interpreter main loop */
@@ -1056,7 +1056,7 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in) {
vm_maybe_auto_suspend(1);
vm_assert_type(stack[B], JANET_FIBER);
JanetFiber *child = janet_unwrap_fiber(stack[B]);
if (janet_check_can_resume(child, &retreg)) {
if (janet_check_can_resume(child, &retreg, 0)) {
vm_commit();
janet_panicv(retreg);
}
@@ -1096,7 +1096,7 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in) {
Janet retreg;
vm_assert_type(stack[B], JANET_FIBER);
JanetFiber *child = janet_unwrap_fiber(stack[B]);
if (janet_check_can_resume(child, &retreg)) {
if (janet_check_can_resume(child, &retreg, 1)) {
vm_commit();
janet_panicv(retreg);
}
@@ -1330,7 +1330,7 @@ Janet janet_call(JanetFunction *fun, int32_t argc, const Janet *argv) {
return *janet_vm.return_reg;
}
static JanetSignal janet_check_can_resume(JanetFiber *fiber, Janet *out) {
static JanetSignal janet_check_can_resume(JanetFiber *fiber, Janet *out, int is_cancel) {
/* Check conditions */
JanetFiberStatus old_status = janet_fiber_status(fiber);
if (janet_vm.stackn >= JANET_RECURSION_GUARD) {
@@ -1338,6 +1338,20 @@ static JanetSignal janet_check_can_resume(JanetFiber *fiber, Janet *out) {
*out = janet_cstringv("C stack recursed too deeply");
return JANET_SIGNAL_ERROR;
}
/* If a "task" fiber is trying to be used as a normal fiber, detect that. See bug #920.
* Fibers must be marked as root fibers manually, or by the ev scheduler. */
if (janet_vm.fiber != NULL && (fiber->gc.flags & JANET_FIBER_FLAG_ROOT)) {
#ifdef JANET_EV
*out = janet_cstringv(is_cancel
? "cannot cancel root fiber, use ev/cancel"
: "cannot resume root fiber, use ev/go");
#else
*out = janet_cstringv(is_cancel
? "cannot cancel root fiber"
: "cannot resume root fiber");
#endif
return JANET_SIGNAL_ERROR;
}
if (old_status == JANET_STATUS_ALIVE ||
old_status == JANET_STATUS_DEAD ||
(old_status >= JANET_STATUS_USER0 && old_status <= JANET_STATUS_USER4) ||
@@ -1452,14 +1466,14 @@ static JanetSignal janet_continue_no_check(JanetFiber *fiber, Janet in, Janet *o
/* Enter the main vm loop */
JanetSignal janet_continue(JanetFiber *fiber, Janet in, Janet *out) {
/* Check conditions */
JanetSignal tmp_signal = janet_check_can_resume(fiber, out);
JanetSignal tmp_signal = janet_check_can_resume(fiber, out, 0);
if (tmp_signal) return tmp_signal;
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);
JanetSignal tmp_signal = janet_check_can_resume(fiber, out, sig != JANET_SIGNAL_OK);
if (tmp_signal) return tmp_signal;
if (sig != JANET_SIGNAL_OK) {
JanetFiber *child = fiber;
@@ -1493,7 +1507,9 @@ JanetSignal janet_pcall(
Janet janet_mcall(const char *name, int32_t argc, Janet *argv) {
/* At least 1 argument */
if (argc < 1) janet_panicf("method :%s expected at least 1 argument");
if (argc < 1) {
janet_panicf("method :%s expected at least 1 argument", name);
}
/* Find method */
Janet method = janet_method_lookup(argv[0], name);
if (janet_checktype(method, JANET_NIL)) {
@@ -1557,9 +1573,6 @@ int janet_init(void) {
janet_vm.root_fiber = NULL;
janet_vm.stackn = 0;
#ifdef JANET_THREADS
janet_threads_init();
#endif
#ifdef JANET_EV
janet_ev_init();
#endif
@@ -1586,9 +1599,6 @@ void janet_deinit(void) {
janet_vm.root_fiber = NULL;
janet_free(janet_vm.registry);
janet_vm.registry = NULL;
#ifdef JANET_THREADS
janet_threads_deinit();
#endif
#ifdef JANET_EV
janet_ev_deinit();
#endif

View File

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

View File

@@ -1,5 +1,5 @@
/*
* Copyright (c) 2021 Calvin Rose
* Copyright (c) 2022 Calvin Rose
*
* Permission is hereby granted, free of charge, to any person obtaining a copy
* of this software and associated documentation files (the "Software"), to
@@ -57,8 +57,8 @@ extern "C" {
#define JANET_BSD 1
#endif
/* Check for Mac */
#ifdef __APPLE__
/* Check for macOS or OS X */
#if defined(__APPLE__) && defined(__MACH__)
#define JANET_APPLE 1
#endif
@@ -144,11 +144,6 @@ extern "C" {
#define JANET_NO_UTC_MKTIME
#endif
/* Check thread library */
#ifndef JANET_NO_THREADS
#define JANET_THREADS
#endif
/* Define how global janet state is declared */
/* Also enable the thread library only if not single-threaded */
#ifdef JANET_SINGLE_THREADED
@@ -198,6 +193,16 @@ extern "C" {
#define JANET_EV_EPOLL
#endif
/* Enable or disable kqueue on BSD */
#if defined(JANET_BSD) && !defined(JANET_EV_NO_KQUEUE)
#define JANET_EV_KQUEUE
#endif
/* Enable or disable kqueue on Apple */
#if defined(JANET_APPLE) && !defined(JANET_EV_NO_KQUEUE)
#define JANET_EV_KQUEUE
#endif
/* How to export symbols */
#ifndef JANET_API
#ifdef JANET_WINDOWS
@@ -320,11 +325,16 @@ typedef struct {
/* Some extra includes if EV is enabled */
#ifdef JANET_EV
#ifdef JANET_WINDOWS
#ifdef JANET_NET
#include <winsock2.h>
#endif
#include <windows.h>
typedef CRITICAL_SECTION JanetOSMutex;
typedef struct JanetDudCriticalSection {
/* Avoid including windows.h here - instead, create a structure of the same size */
/* Needs to be same size as crtical section see WinNT.h for CRITCIAL_SECTION definition */
void *debug_info;
long lock_count;
long recursion_count;
void *owning_thread;
void *lock_semaphore;
unsigned long spin_count;
} JanetOSMutex;
#else
#include <pthread.h>
typedef pthread_mutex_t JanetOSMutex;
@@ -856,7 +866,7 @@ struct JanetGCObject {
union {
JanetGCObject *next;
int32_t refcount; /* For threaded abstract types */
};
} data;
};
/* A lightweight green thread in janet. Does not correspond to
@@ -951,6 +961,7 @@ struct JanetStructHead {
int32_t length;
int32_t hash;
int32_t capacity;
const JanetKV *proto;
const JanetKV data[];
};
@@ -1512,6 +1523,7 @@ JANET_API int janet_loop_fiber(JanetFiber *fiber);
/* Number scanning */
JANET_API int janet_scan_number(const uint8_t *str, int32_t len, double *out);
JANET_API int janet_scan_number_base(const uint8_t *str, int32_t len, int32_t base, double *out);
JANET_API int janet_scan_int64(const uint8_t *str, int32_t len, int64_t *out);
JANET_API int janet_scan_uint64(const uint8_t *str, int32_t len, uint64_t *out);
@@ -1528,6 +1540,7 @@ JANET_API JanetRNG *janet_default_rng(void);
JANET_API void janet_rng_seed(JanetRNG *rng, uint32_t seed);
JANET_API void janet_rng_longseed(JanetRNG *rng, const uint8_t *bytes, int32_t len);
JANET_API uint32_t janet_rng_u32(JanetRNG *rng);
JANET_API double janet_rng_double(JanetRNG *rng);
/* Array functions */
JANET_API JanetArray *janet_array(int32_t capacity);
@@ -1608,10 +1621,13 @@ JANET_API JanetSymbol janet_symbol_gen(void);
#define janet_struct_length(t) (janet_struct_head(t)->length)
#define janet_struct_capacity(t) (janet_struct_head(t)->capacity)
#define janet_struct_hash(t) (janet_struct_head(t)->hash)
#define janet_struct_proto(t) (janet_struct_head(t)->proto)
JANET_API JanetKV *janet_struct_begin(int32_t count);
JANET_API void janet_struct_put(JanetKV *st, Janet key, Janet value);
JANET_API JanetStruct janet_struct_end(JanetKV *st);
JANET_API Janet janet_struct_get(JanetStruct st, Janet key);
JANET_API Janet janet_struct_rawget(JanetStruct st, Janet key);
JANET_API Janet janet_struct_get_ex(JanetStruct st, Janet key, JanetStruct *which);
JANET_API JanetTable *janet_struct_to_table(JanetStruct st);
JANET_API const JanetKV *janet_struct_find(JanetStruct st, Janet key);
@@ -1747,6 +1763,7 @@ JANET_API JanetSignal janet_step(JanetFiber *fiber, Janet in, Janet *out);
JANET_API Janet janet_call(JanetFunction *fun, int32_t argc, const Janet *argv);
JANET_API Janet janet_mcall(const char *name, int32_t argc, Janet *argv);
JANET_API void janet_stacktrace(JanetFiber *fiber, Janet err);
JANET_API void janet_stacktrace_ext(JanetFiber *fiber, Janet err, const char *prefix);
/* Scratch Memory API */
typedef void (*JanetScratchFinalizer)(void *);
@@ -1762,7 +1779,9 @@ typedef enum {
JANET_BINDING_NONE,
JANET_BINDING_DEF,
JANET_BINDING_VAR,
JANET_BINDING_MACRO
JANET_BINDING_MACRO,
JANET_BINDING_DYNAMIC_DEF,
JANET_BINDING_DYNAMIC_MACRO
} JanetBindingType;
typedef struct {
@@ -2025,7 +2044,8 @@ typedef enum {
RULE_READINT, /* [(signedness << 4) | (endianess << 5) | bytewidth, tag] */
RULE_LINE, /* [tag] */
RULE_COLUMN, /* [tag] */
RULE_UNREF /* [rule, tag] */
RULE_UNREF, /* [rule, tag] */
RULE_CAPTURE_NUM /* [rule, tag] */
} JanetPegOpcod;
typedef struct {

View File

@@ -1,5 +1,5 @@
/*
* Copyright (c) 2021 Calvin Rose
* Copyright (c) 2022 Calvin Rose
*
* Permission is hereby granted, free of charge, to any person obtaining a copy
* of this software and associated documentation files (the "Software"), to
@@ -25,6 +25,7 @@
#endif
#include <janet.h>
#include <errno.h>
#ifdef _WIN32
#include <windows.h>
@@ -75,6 +76,9 @@ static void simpleline(JanetBuffer *buffer) {
int c;
for (;;) {
c = fgetc(in);
if (c < 0 && !feof(in) && errno == EINTR) {
continue;
}
if (feof(in) || c < 0) {
break;
}
@@ -112,7 +116,6 @@ https://github.com/antirez/linenoise/blob/master/linenoise.c
#include <unistd.h>
#include <stdlib.h>
#include <stdio.h>
#include <errno.h>
#include <stdlib.h>
#include <ctype.h>
#include <sys/stat.h>
@@ -136,7 +139,6 @@ 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;
@@ -743,7 +745,11 @@ static int line() {
char c;
char seq[3];
if (read(STDIN_FILENO, &c, 1) <= 0) return -1;
int rc;
do {
rc = read(STDIN_FILENO, &c, 1);
} while (rc < 0 && errno == EINTR);
if (rc <= 0) return -1;
switch (c) {
default:
@@ -758,9 +764,9 @@ static int line() {
kleft();
break;
case 3: /* ctrl-c */
clearlines();
gbl_sigint_flag = 1;
return -1;
norawmode();
kill(getpid(), SIGINT);
/* fallthrough */
case 17: /* ctrl-q */
gbl_cancel_current_repl_form = 1;
clearlines();
@@ -962,11 +968,7 @@ void janet_line_get(const char *p, JanetBuffer *buffer) {
}
if (line()) {
norawmode();
if (gbl_sigint_flag) {
raise(SIGINT);
} else {
fputc('\n', out);
}
fputc('\n', out);
return;
}
fflush(stdin);

View File

@@ -5,6 +5,8 @@
(var suite-num 0)
(var start-time 0)
(def is-verbose (os/getenv "VERBOSE"))
(defn assert
"Override's the default assert with some nice error handling."
[x &opt e]
@@ -12,11 +14,9 @@
(++ num-tests-run)
(when x (++ num-tests-passed))
(def str (string e))
(def truncated
(if (> (length e) 40) (string (string/slice e 0 35) "...") (describe e)))
(if x
(eprintf "\e[32m✔\e[0m %s: %v" truncated x)
(eprintf "\n\e[31m✘\e[0m %s: %v" truncated x))
(when is-verbose (eprintf "\e[32m✔\e[0m %s: %v" (describe e) x))
(eprintf "\e[31m✘\e[0m %s: %v" (describe e) x))
x)
(defmacro assert-error
@@ -32,10 +32,10 @@
(defn start-suite [x]
(set suite-num x)
(set start-time (os/clock))
(eprint "\nRunning test suite " x " tests...\n "))
(eprint "Starting suite " x "..."))
(defn end-suite []
(def delta (- (os/clock) start-time))
(eprintf "\n\nTest suite %d finished in %.3f seconds" suite-num delta)
(eprint num-tests-passed " of " num-tests-run " tests passed.\n")
(eprinf "Finished suite %d in %.3f seconds - " suite-num delta)
(eprint num-tests-passed " of " num-tests-run " tests passed.")
(if (not= num-tests-passed num-tests-run) (os/exit 1)))

View File

@@ -202,6 +202,7 @@
#🐙🐙🐙🐙
(defn foo [Θa Θb Θc] 0)
(def 🦊 :fox)
(def 🐮 :cow)
(assert (= (string "🐼" 🦊 🐮) "🐼foxcow") "emojis 🙉 :)")
@@ -294,6 +295,21 @@
(++ i))
(assert (= i 6) "when macro"))
# Dynamic defs
(def staticdef1 0)
(defn staticdef1-inc [] (+ 1 staticdef1))
(assert (= 1 (staticdef1-inc)) "before redefinition without :redef")
(def staticdef1 1)
(assert (= 1 (staticdef1-inc)) "after redefinition without :redef")
(setdyn :redef true)
(def dynamicdef2 0)
(defn dynamicdef2-inc [] (+ 1 dynamicdef2))
(assert (= 1 (dynamicdef2-inc)) "before redefinition with dyn :redef")
(def dynamicdef2 1)
(assert (= 2 (dynamicdef2-inc)) "after redefinition with dyn :redef")
(setdyn :redef nil)
# Denormal tables and structs
(assert (= (length {1 2 nil 3}) 1) "nil key struct literal")
@@ -395,7 +411,7 @@
compare-poly-tests
[[(int/s64 3) (int/u64 3) 0]
[(int/s64 -3) (int/u64 3) -1]
[(int/s64 3) (int/u64 2) 1]
[(int/s64 3) (int/u64 2) 1]
[(int/s64 3) 3 0] [(int/s64 3) 4 -1] [(int/s64 3) -9 1]
[(int/u64 3) 3 0] [(int/u64 3) 4 -1] [(int/u64 3) -9 1]
[3 (int/s64 3) 0] [3 (int/s64 4) -1] [3 (int/s64 -5) 1]
@@ -405,7 +421,7 @@
[(int/u64 MAX_INT_IN_DBL_STRING) (scan-number MAX_INT_IN_DBL_STRING) 0]
[(+ 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]
[MINUS_INF (int/u64 0) -1] [MINUS_INF (int/s64 0) -1]
[(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))))

View File

@@ -137,6 +137,39 @@
(assert (= a 1) "dictionary destructuring 3")
(assert (= b 2) "dictionary destructuring 4")
(assert (= c 4) "dictionary destructuring 5 - expression as key"))
(let [test-tuple [:a :b 1 2]]
(def [a b one two] test-tuple)
(assert (= a :a) "tuple destructuring 1")
(assert (= b :b) "tuple destructuring 2")
(assert (= two 2) "tuple destructuring 3"))
(let [test-tuple [:a :b 1 2]]
(def [a & rest] test-tuple)
(assert (= a :a) "tuple destructuring 4 - rest")
(assert (= rest [:b 1 2]) "tuple destructuring 5 - rest"))
(do
(def [a b & rest] [:a :b nil :d])
(assert (= a :a) "tuple destructuring 6 - rest")
(assert (= b :b) "tuple destructuring 7 - rest")
(assert (= rest [nil :d]) "tuple destructuring 8 - rest"))
(do
(def [[a b] x & rest] [[1 2] :a :c :b :a])
(assert (= a 1) "tuple destructuring 9 - rest")
(assert (= b 2) "tuple destructuring 10 - rest")
(assert (= x :a) "tuple destructuring 11 - rest")
(assert (= rest [:c :b :a]) "tuple destructuring 12 - rest"))
(do
(def [a b & rest] [:a :b])
(assert (= a :a) "tuple destructuring 13 - rest")
(assert (= b :b) "tuple destructuring 14 - rest")
(assert (= rest []) "tuple destructuring 15 - rest"))
(do
(def [[a b & r1] c & r2] [[:a :b 1 2] :c 3 4])
(assert (= a :a) "tuple destructuring 16 - rest")
(assert (= b :b) "tuple destructuring 17 - rest")
(assert (= c :c) "tuple destructuring 18 - rest")
(assert (= r1 [1 2]) "tuple destructuring 19 - rest")
(assert (= r2 [3 4]) "tuple destructuring 20 - rest"))
# Marshal
@@ -288,6 +321,11 @@
(assert (deep= (map + [1 2 3] [10 20 30] [100 200 300] [1000 2000 3000]) @[1111 2222 3333]))
(assert (deep= (map + [1 2 3] [10 20 30] [100 200 300] [1000 2000 3000] [10000 20000 30000]) @[11111 22222 33333]))
# Mapping uses the shortest sequence
(assert (deep= (map + [1 2 3 4] [10 20 30]) @[11 22 33]))
(assert (deep= (map + [1 2 3 4] [10 20 30] [100 200]) @[111 222]))
(assert (deep= (map + [1 2 3 4] [10 20 30] [100 200] [1000]) @[1111]))
# Sort function
(assert (deep=
(range 99)

View File

@@ -39,6 +39,25 @@
(def c (u64 "32rvv_vv_vv_vv"))
(def d (u64 "123456789"))))
# Conversion back to an int32
(assert (= (int/to-number (u64 0xFaFa)) 0xFaFa))
(assert (= (int/to-number (i64 0xFaFa)) 0xFaFa))
(assert (= (int/to-number (u64 9007199254740991)) 9007199254740991))
(assert (= (int/to-number (i64 9007199254740991)) 9007199254740991))
(assert (= (int/to-number (i64 -9007199254740991)) -9007199254740991))
(assert-error
"u64 out of bounds for safe integer"
(int/to-number (u64 "9007199254740993"))
(assert-error
"s64 out of bounds for safe integer"
(int/to-number (i64 "-9007199254740993"))))
(assert-error
"int/to-number fails on non-abstract types"
(int/to-number 1))
(assert-no-error
"create some int64 bigints"
(do
@@ -72,6 +91,39 @@
"trap INT64_MIN / -1"
(:/ (int/s64 "-0x8000_0000_0000_0000") -1))
# int/s64 and int/u64 serialization
(assert (deep= (int/to-bytes (u64 0)) @"\x00\x00\x00\x00\x00\x00\x00\x00"))
(assert (deep= (int/to-bytes (i64 1) :le) @"\x01\x00\x00\x00\x00\x00\x00\x00"))
(assert (deep= (int/to-bytes (i64 1) :be) @"\x00\x00\x00\x00\x00\x00\x00\x01"))
(assert (deep= (int/to-bytes (i64 -1)) @"\xFF\xFF\xFF\xFF\xFF\xFF\xFF\xFF"))
(assert (deep= (int/to-bytes (i64 -5) :be) @"\xFF\xFF\xFF\xFF\xFF\xFF\xFF\xFB"))
(assert (deep= (int/to-bytes (u64 1) :le) @"\x01\x00\x00\x00\x00\x00\x00\x00"))
(assert (deep= (int/to-bytes (u64 1) :be) @"\x00\x00\x00\x00\x00\x00\x00\x01"))
(assert (deep= (int/to-bytes (u64 300) :be) @"\x00\x00\x00\x00\x00\x00\x01\x2C"))
# int/s64 int/u64 to existing buffer
(let [buf1 @""
buf2 @"abcd"]
(assert (deep= (int/to-bytes (i64 1) :le buf1) @"\x01\x00\x00\x00\x00\x00\x00\x00"))
(assert (deep= buf1 @"\x01\x00\x00\x00\x00\x00\x00\x00"))
(assert (deep= (int/to-bytes (u64 300) :be buf2) @"abcd\x00\x00\x00\x00\x00\x00\x01\x2C")))
# int/s64 and int/u64 paramater type checking
(assert-error
"bad value passed to int/to-bytes"
(int/to-bytes 1))
(assert-error
"invalid endianness passed to int/to-bytes"
(int/to-bytes (u64 0) :little))
(assert-error
"invalid buffer passed to int/to-bytes"
(int/to-bytes (u64 0) :little :buffer))
# Dynamic bindings
(setdyn :a 10)
(assert (= 40 (with-dyns [:a 25 :b 15] (+ (dyn :a) (dyn :b)))) "dyn usage 1")

View File

@@ -168,6 +168,16 @@
(assert (= (string out-buf) "Hello\nhi") "print and prin to buffer 1")
(assert (= (string err-buf) "Sup\nnot much.") "eprint and eprin to buffer 1")
# Printing to functions
(def out-buf @"")
(defn prepend [x]
(with-dyns [:out out-buf]
(prin "> " x)))
(with-dyns [:out prepend]
(print "Hello world"))
(assert (= (string out-buf) "> Hello world\n") "print to buffer via function")
(assert (= (string '()) (string [])) "empty bracket tuple literal")
# with-vars
@@ -308,8 +318,9 @@
(assert (deep= (range 4) a) "eachk 1")
(tracev (def my-unique-var-name true))
(assert my-unique-var-name "tracev upscopes")
(with-dyns [:err @""]
(tracev (def my-unique-var-name true))
(assert my-unique-var-name "tracev upscopes"))
(assert (pos? (length (gensym))) "gensym not empty, regression #753")

View File

@@ -106,6 +106,10 @@
(assert (= nil (match {:a :hi} {:a a :b b} a)) "match 3")
(assert (= nil (match [1 2] [a b c] a)) "match 4")
(assert (= 2 (match [1 2] [a b] b)) "match 5")
(assert (= [2 :a :b] (match [1 2 :a :b] [o & rest] rest)) "match 6")
(assert (= [] (match @[:a] @[x & r] r :fallback)) "match 7")
(assert (= :fallback (match @[1] @[x y & r] r :fallback)) "match 8")
(assert (= [1 2 3 4] (match @[1 2 3 4] @[x y z & r] [x y z ;r] :fallback)) "match 9")
# And/or checks
@@ -344,4 +348,12 @@ neldb\0\0\0\xD8\x05printG\x01\0\xDE\xDE\xDE'\x03\0marshal_tes/\x02
(assert (deep= @[] (peg/match '(* "test" (any 1)) @"test")) "peg empty pattern 5")
(assert (deep= @[] (peg/match '(* "test" (any 1)) (buffer "test"))) "peg empty pattern 6")
# number pattern
(assert (deep= @[111] (peg/match '(number :d+) "111")) "simple number capture 1")
(assert (deep= @[255] (peg/match '(number :w+) "0xff")) "simple number capture 2")
# quoted match test
(assert (= :yes (match 'john 'john :yes _ :nope)) "quoted literal match 1")
(assert (= :nope (match 'john ''john :yes _ :nope)) "quoted literal match 2")
(end-suite)

View File

@@ -115,8 +115,21 @@
# Cast to string to enable comparison
(assert (= "123\n456\n" (string (slurp "unique.txt"))) "File writing 4.2")
(os/rm "unique.txt"))
# ev/gather
# Test that the stream created by os/open can be read from
(comment
(assert-no-error "File reading 1.1"
(def outstream (os/open "unique.txt" :wct))
(defer (:close outstream)
(:write outstream "123\n")
(:write outstream "456\n"))
(def outstream (os/open "unique.txt" :r))
(defer (:close outstream)
(assert (= "123\n456\n" (string (:read outstream :all))) "File reading 1.2"))
(os/rm "unique.txt")))
# ev/gather
(assert (deep= @[1 2 3] (ev/gather 1 2 3)) "ev/gather 1")
(assert (deep= @[] (ev/gather)) "ev/gather 2")
@@ -151,6 +164,38 @@
(:close s))
(defn check-matching-names [stream]
(def ln (net/localname stream))
(def pn (net/peername stream))
(def [my-ip my-port] ln)
(def [remote-ip remote-port] pn)
(def msg (string my-ip " " my-port " " remote-ip " " remote-port))
(def buf @"")
(ev/gather
(net/write stream msg)
(net/read stream 1024 buf))
(def comparison (string/split " " buf))
(assert (and (= my-ip (get comparison 2))
(= (string my-port) (get comparison 3))
(= remote-ip (get comparison 0))
(= (string remote-port) (get comparison 1)))
(string/format "localname should match peername: msg=%j, buf=%j" msg buf)))
# Test on both server and client
(defn names-handler
[stream]
(defer (:close stream)
(check-matching-names stream)))
# Test localname and peername
(repeat 20
(with [s (net/server "127.0.0.1" "8000" names-handler)]
(defn test-names []
(with [conn (net/connect "127.0.0.1" "8000")]
(check-matching-names conn)))
(repeat 20 (test-names)))
(gccollect))
# Create pipe
(var pipe-counter 0)
@@ -221,4 +266,13 @@
(ev/rselect c2)
(assert (= (slice arr) (slice (range 100))) "ev/chan-close 3")
# threaded channels
(def ch (ev/thread-chan 2))
(def att (ev/thread-chan 109))
(assert att "`att` was nil after creation")
(ev/give ch att)
(ev/do-thread
(assert (ev/take ch) "channel packing bug for threaded abstracts on threaded channels."))
(end-suite)

View File

@@ -161,10 +161,59 @@
([err] :caught))))
"regression #638"))
# Struct prototypes
(def x (struct/with-proto {1 2 3 4} 5 6))
(def y (-> x marshal unmarshal))
(def z {1 2 3 4})
(assert (= 2 (get x 1)) "struct get proto value 1")
(assert (= 4 (get x 3)) "struct get proto value 2")
(assert (= 6 (get x 5)) "struct get proto value 3")
(assert (= x y) "struct proto marshal equality 1")
(assert (= (getproto x) (getproto y)) "struct proto marshal equality 2")
(assert (= 0 (cmp x y)) "struct proto comparison 1")
(assert (= 0 (cmp (getproto x) (getproto y))) "struct proto comparison 2")
(assert (not= (cmp x z) 0) "struct proto comparison 3")
(assert (not= (cmp y z) 0) "struct proto comparison 4")
(assert (not= x z) "struct proto comparison 5")
(assert (not= y z) "struct proto comparison 6")
(assert (= (x 5) 6) "struct proto get 1")
(assert (= (y 5) 6) "struct proto get 1")
(assert (deep= x y) "struct proto deep= 1")
(assert (deep-not= x z) "struct proto deep= 2")
(assert (deep-not= y z) "struct proto deep= 3")
# Issue #751
(def t {:side false})
(assert (nil? (get-in t [:side :note])) "get-in with false value")
(assert (= (get-in t [:side :note] "dflt") "dflt")
"get-in with false value and default")
(assert (= (math/gcd 462 1071) 21) "math/gcd 1")
(assert (= (math/lcm 462 1071) 23562) "math/lcm 1")
# Evaluate stream with `dofile`
(def [r w] (os/pipe))
(:write w "(setdyn :x 10)")
(:close w)
(def stream-env (dofile r))
(assert (= (stream-env :x) 10) "dofile stream 1")
# Issue #861 - should be valgrind clean
(def step1 "(a b c d)\n")
(def step2 "(a b)\n")
(def p1 (parser/new))
(parser/state p1)
(parser/consume p1 step1)
(loop [v :iterate (parser/produce p1)])
(parser/state p1)
(def p2 (parser/clone p1))
(parser/state p2)
(parser/consume p2 step2)
(loop [v :iterate (parser/produce p2)])
(parser/state p2)
# Check missing struct proto bug.
(assert (struct/getproto (struct/with-proto {:a 1} :b 2 :c nil)) "missing struct proto")
(end-suite)

54
test/suite0011.janet Normal file
View File

@@ -0,0 +1,54 @@
# Copyright (c) 2021 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 11)
# math gamma
(assert (< 11899423.08 (math/gamma 11.5) 11899423.085) "math/gamma")
(assert (< 2605.1158 (math/log-gamma 500) 2605.1159) "math/log-gamma")
# missing symbols
(defn lookup-symbol [sym] (defglobal sym 10) (dyn sym))
(setdyn :missing-symbol lookup-symbol)
(assert (= (eval-string "(+ a 5)") 15) "lookup missing symbol")
(setdyn :missing-symbol nil)
(setdyn 'a nil)
(assert-error "compile error" (eval-string "(+ a 5)"))
# 919
(defn test
[]
(var x 1)
(set x ~(,x ()))
x)
(assert (= (test) '(1 ())) "issue #919")
(assert (= (hash 0) (hash (* -1 0))) "hash -0 same as hash 0")
(end-suite)

View File

@@ -3,8 +3,11 @@
# Format all code with astyle
STYLEOPTS="--style=attach --indent-switches --convert-tabs \
--align-pointer=name --pad-header --pad-oper --unpad-paren --indent-labels"
--align-pointer=name --pad-header --pad-oper --unpad-paren --indent-labels --formatted"
astyle $STYLEOPTS */*.c
astyle $STYLEOPTS */*/*.c
astyle $STYLEOPTS */*/*.h
rm -f */*.c.orig
rm -f */*/*.c.orig
rm -f */*/*.h.orig

View File

@@ -0,0 +1,24 @@
(def f @{})
(var collisions 0)
(loop [x :range [0 300] y :range [0 300]]
(def key (hash (+ (* x 1000) y)))
(if (in f key)
(++ collisions))
(put f key true))
(print "ints 1 collisions: " collisions)
(def f @{})
(var collisions 0)
(loop [x :range [100000 101000] y :range [100000 101000]]
(def key (hash [x y]))
(if (in f key) (++ collisions))
(put f key true))
(print "int pair 1 collisions: " collisions)
(def f @{})
(var collisions 0)
(loop [x :range [10000 11000] y :range [10000 11000]]
(def key (hash [x y]))
(if (in f key) (++ collisions))
(put f key true))
(print "int pair 2 collisions: " collisions)