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

Compare commits

...

145 Commits

Author SHA1 Message Date
Calvin Rose
d19db30f3d Fix meson install test. 2023-09-27 00:19:35 -05:00
Calvin Rose
d12464fc0e Make poll work by going back to array of listeners for gc keeping. 2023-09-26 23:02:06 -05:00
Calvin Rose
a96971c8a7 More work on epoll implementation. 2023-09-26 12:05:06 -05:00
Calvin Rose
f6f769503a Fix up ev.c to pass tests. 2023-09-26 11:11:29 -05:00
Calvin Rose
82917ac6e3 Kqueue fix. 2023-09-25 19:17:51 -07:00
Calvin Rose
a6ffafb1a2 Patches to kqueue implementation. 2023-09-25 19:07:18 -07:00
Calvin Rose
fb8c529f2e Partial work updating epoll reimplentation. 2023-09-25 18:52:15 -07:00
Calvin Rose
1ee98e1e66 Get IOCP reworked event loop passing tests. 2023-09-25 15:19:39 -07:00
Calvin Rose
81f35f5dd1 Redo state management for Janet listeners.
Make more use of the built in GC code for abstracts to
be sure things are more correct. Issue before was streams could
be freed before IOCP events arrived.
2023-09-25 00:43:36 -07:00
Calvin Rose
1b402347cd Work on debugging issue with server spawning. 2023-09-24 18:15:58 -07:00
Calvin Rose
dccb60ba35 Ignore IOCP where the event failed to deque. 2023-09-24 12:53:06 -07:00
Calvin Rose
ae642ceca0 Don't hide windows segfaults in build_win.bat. 2023-09-24 12:36:15 -07:00
Calvin Rose
471b6f9966 Add TOCLOSE back. 2023-09-24 12:28:35 -07:00
Calvin Rose
5dd18bac2c More fixups to gc.c 2023-09-24 11:51:22 -07:00
Calvin Rose
018f4e0891 Remove some old code. 2023-09-24 10:30:58 -07:00
Calvin Rose
e85809a98a Remove remains of gc instrumentation code. 2023-09-24 10:11:24 -07:00
Calvin Rose
e6e9bd8147 Redo async connect code to be moved out of ev.c.
Async connect is different than write.
2023-09-24 10:08:40 -07:00
Calvin Rose
221645d2ce More refinement of meson build. 2023-09-23 14:16:13 -07:00
Calvin Rose
2f4a6214a2 Make meson build work on windows.
By default, use more traditional linking pattern with meson.
The janet.exe will now link to janet-x.x.dll on windows (and
similar for linux/posix) when built with meson. This is slightly
less efficient and means that janet.exe built this way is no longer
standalone (you would need to move the dll along with the exe), but
plays better with most build systems.
2023-09-23 08:53:37 -07:00
Calvin Rose
e00a461c26 Add optional buffer-size to file/open.
This calls setvbuf to change FILE buffering. A goal is
to be able to use the existing file/* functions for blocking
IO analogous to `read` and `write` system calls.
2023-09-23 09:40:17 -05:00
Calvin Rose
c31314be38 Merge pull request #1296 from Andriamanitra/doc-loop-unless
add :unless modifier to (doc loop)
2023-09-22 05:41:06 -07:00
Andriamanitra
ee142c4be0 truthy/falsey is more accurate than true/false 2023-09-22 03:04:41 +03:00
Andriamanitra
aeacc0b31b add :unless modifier to (doc loop) 2023-09-21 19:23:40 +03:00
Calvin Rose
7b4c3bdbcc Address issues from #1294 on non-nanboxed platforms.
Underlying bug was obscured by nanbox implementation.
2023-09-21 07:36:53 -07:00
Calvin Rose
910b9cf1fd Distinguish between JANET_API and JANET_EXPORT
One is a way to export symbols, the other a way to reference
API functions. Also include prebuilt dlljanet.dll and dlljanet.lib
for windows to save people the trouble of compiling janet.c themselves.
2023-09-20 20:07:03 -07:00
Calvin Rose
b10aaceab0 Work on dllimport option for janet. 2023-09-20 17:34:42 -07:00
Calvin Rose
169bd812c9 Update state.h to #include <windows.h>
Should fix usage with msvc in some pipelines.
2023-09-18 23:51:15 -05:00
Calvin Rose
34767f1e13 Merge pull request #1292 from sogaiu/tweak-janetconf-h 2023-09-18 18:50:46 -07:00
sogaiu
4f642c0843 Tweak janetconf.h 2023-09-19 10:34:50 +09:00
Calvin Rose
4e5889ed59 Prepare for 1.31.0 release. 2023-09-17 14:53:03 -05:00
Calvin Rose
a1b848ad76 Merge pull request #1288 from sogaiu/more-error-loc-info-in-dobytes
Report line and col more in janet_dobytes
2023-09-14 08:21:52 -07:00
Calvin Rose
dbcc1fad3e Merge pull request #1289 from primo-ppcg/loop-unless
Add `:unless` loop modifier
2023-09-13 11:56:33 -07:00
primo-ppcg
db366558e7 add :unless loop modifier 2023-09-13 15:21:46 +07:00
sogaiu
a23c03fbd0 Report line and col more in janet_dobytes 2023-09-13 15:41:14 +09:00
Calvin Rose
ff18b92eb0 Merge pull request #1287 from pepe/fix-arr-push-doc
Document array/push variadic argument
2023-09-12 07:07:42 -07:00
Josef Pospíšil
7f148522ab Document array/push variadic argument 2023-09-12 09:34:21 +02:00
Calvin Rose
159c612924 Update changelog.md 2023-09-09 11:03:14 -05:00
Calvin Rose
b95dfd4bdf Update docstring. 2023-09-09 10:58:20 -05:00
Calvin Rose
e69954af2f Merge pull request #1283 from primo-ppcg/mean-partition
Update `partition`, `mean`
2023-09-09 10:30:11 -05:00
primo-ppcg
a5ff26f602 add more test cases for partition and mean 2023-09-08 16:30:44 +07:00
primo-ppcg
a7536268e1 update partition 2023-09-08 12:38:58 +07:00
primo-ppcg
541469371a update mean 2023-09-08 11:35:37 +07:00
Calvin Rose
a13aeaf955 Merge pull request #1281 from primo-ppcg/interleave-interpose
Update `interleave`, `interpose`
2023-09-04 10:27:27 -05:00
primo-ppcg
9cf674cdcb update interleave, interpose 2023-09-04 17:09:53 +07:00
Calvin Rose
51c0cf97bc Merge pull request #1280 from primo-ppcg/lengthable
Add `lengthable?`
2023-09-01 17:41:25 -05:00
primo-ppcg
4cb1f616c5 allow reverse on non-lengthable 2023-09-01 16:04:21 +07:00
primo-ppcg
645109048b update keys, values, pairs 2023-09-01 13:18:31 +07:00
primo-ppcg
f969fb69e1 add lengthable? 2023-09-01 13:04:53 +07:00
Calvin Rose
bfb60fdb84 Merge pull request #1278 from primo-ppcg/loop-range
Allow one-term `:range` and `:down` forms
2023-08-29 08:23:36 -05:00
primo-ppcg
2f43cb843e Allow one-term :range and :down forms 2023-08-29 10:59:16 +07:00
Calvin Rose
874fd2aba7 don't crash repl if someone sets a bad *pretty-format* 2023-08-27 13:09:22 -05:00
Calvin Rose
33d1371186 Update specials.c for formatting. 2023-08-25 16:28:41 -05:00
Calvin Rose
d2dd241e6b Merge pull request #1269 from primo-ppcg/check-nil-form
Optimize nil conditions for while and if
2023-08-24 09:30:58 -05:00
Calvin Rose
4ecadfabf4 Fix atomics - warnings on windows 2023-08-24 08:00:50 -05:00
Calvin Rose
ffd79c6097 Allow multiple simultaneous interrupts cleanly for #1262
Instead of setting a flag, each interrupt increments an atomic
counter. When the interrupt is finally handled, either by scheduling
code to run on the event loop or executing some out of band code, the
user must now decrement the interrupt counter with
janet_interpreter_interrupt_handled. While this counter is non-zero, the
event loop will not enter the interpreter. This changes the API a bit but
makes it possible and easy to handle signals without race conditions
or scheduler hacks, as the runtime can ensure that high priority code is
run before re-entering possibly blocking interpreter code again.

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

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

    Distinguish between subprocess when testing.

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

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

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

    Revert "Test removing 32bit ptr marshalling."

    This reverts commit 566b45ea44.

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

    Test removing 32bit ptr marshalling.

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

    Conditionally compile marshal_ptr code.

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

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

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

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

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

    Quiet some build warnings.

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

    Add marshal utilities for pointers.

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

    Merge branch 'master' into armtest

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

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

View File

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

View File

@@ -1,6 +1,27 @@
# Changelog
All notable changes to this project will be documented in this file.
## 1.31.0 - 2023-09-17
- Report line and column when using `janet_dobytes`
- Add `:unless` loop modifier
- Allow calling `reverse` on generators.
- Improve performance of a number of core functions including `partition`, `mean`, `keys`, `values`, `pairs`, `interleave`.
- Add `lengthable?`
- Add `os/sigaction`
- Change `every?` and `any?` to behave like the functional versions of the `and` and `or` macros.
- Fix bug with garbage collecting threaded abstract types.
- Add `:signal` to the `sandbox` function to allow intercepting signals.
## 1.30.0 - 2023-08-05
- Change indexing of `array/remove` to start from -1 at the end instead of -2.
- Add new string escape sequences `\\a`, `\\b`, `\\?`, and `\\'`.
- Fix bug with marshalling channels
- Add `div` for floored division
- Make `div` and `mod` variadic
- Support `bnot` for integer types.
- Define `(mod x 0)` as `x`
- Add `ffi/pointer-cfunction` to convert pointers to cfunctions
## 1.29.1 - 2023-06-19
- Add support for passing booleans to PEGs for "always" and "never" matching.
- Allow dictionary types for `take` and `drop`

View File

@@ -48,6 +48,7 @@ SONAME_SETTER=-Wl,-soname,
# For cross compilation
HOSTCC?=$(CC)
HOSTAR?=$(AR)
# Symbols are (optionally) removed later, keep -g as default!
CFLAGS?=-O2 -g
LDFLAGS?=-rdynamic
RUN:=$(RUN)
@@ -195,9 +196,9 @@ build/%.bin.o: src/%.c $(JANET_HEADERS) $(JANET_LOCAL_HEADERS) Makefile
########################
ifeq ($(UNAME), Darwin)
SONAME=libjanet.1.29.dylib
SONAME=libjanet.1.31.dylib
else
SONAME=libjanet.so.1.29
SONAME=libjanet.so.1.31
endif
build/c/shell.c: src/mainclient/shell.c
@@ -266,6 +267,7 @@ build/janet-%.tar.gz: $(JANET_TARGET) \
README.md build/c/janet.c build/c/shell.c
mkdir -p build/$(JANET_DIST_DIR)/bin
cp $(JANET_TARGET) build/$(JANET_DIST_DIR)/bin/
strip -x -S 'build/$(JANET_DIST_DIR)/bin/janet'
mkdir -p build/$(JANET_DIST_DIR)/include
cp build/janet.h build/$(JANET_DIST_DIR)/include/
mkdir -p build/$(JANET_DIST_DIR)/lib/
@@ -308,7 +310,7 @@ build/janet.pc: $(JANET_TARGET)
install: $(JANET_TARGET) $(JANET_LIBRARY) $(JANET_STATIC_LIBRARY) build/janet.pc build/janet.h
mkdir -p '$(DESTDIR)$(BINDIR)'
cp $(JANET_TARGET) '$(DESTDIR)$(BINDIR)/janet'
strip '$(DESTDIR)$(BINDIR)/janet'
strip -x -S '$(DESTDIR)$(BINDIR)/janet'
mkdir -p '$(DESTDIR)$(INCLUDEDIR)/janet'
cp -r build/janet.h '$(DESTDIR)$(INCLUDEDIR)/janet'
ln -sf ./janet/janet.h '$(DESTDIR)$(INCLUDEDIR)/janet.h'
@@ -357,14 +359,14 @@ uninstall:
#################
format:
tools/format.sh
sh tools/format.sh
grammar: build/janet.tmLanguage
build/janet.tmLanguage: tools/tm_lang_gen.janet $(JANET_TARGET)
$(RUN) $(JANET_TARGET) $< > $@
compile-commands:
# Requires pip install copmiledb
# Requires pip install compiledb
compiledb make
clean:

View File

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

41
examples/sigaction.janet Normal file
View File

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

View File

@@ -20,7 +20,7 @@
project('janet', 'c',
default_options : ['c_std=c99', 'build.c_std=c99', 'b_lundef=false', 'default_library=both'],
version : '1.29.1')
version : '1.31.0')
# Global settings
janet_path = join_paths(get_option('prefix'), get_option('libdir'), 'janet')
@@ -169,7 +169,7 @@ janet_boot = executable('janet-boot', core_src, boot_src,
# Build janet.c
janetc = custom_target('janetc',
input : [janet_boot],
input : [janet_boot, 'src/boot/boot.janet'],
output : 'janet.c',
capture : true,
command : [
@@ -182,23 +182,30 @@ if not get_option('single_threaded')
janet_dependencies += thread_dep
endif
if cc.has_argument('-fvisibility=hidden')
lib_cflags = ['-fvisibility=hidden']
else
lib_cflags = []
endif
libjanet = library('janet', janetc,
include_directories : incdir,
dependencies : janet_dependencies,
version: meson.project_version(),
soversion: version_parts[0] + '.' + version_parts[1],
c_args : lib_cflags,
install : true)
# Extra c flags - adding -fvisibility=hidden matches the Makefile and
# shaves off about 10k on linux x64, likely similar on other platforms.
if cc.has_argument('-fvisibility=hidden')
extra_cflags = ['-fvisibility=hidden']
extra_cflags = ['-fvisibility=hidden', '-DJANET_DLL_IMPORT']
else
extra_cflags = []
extra_cflags = ['-DJANET_DLL_IMPORT']
endif
janet_mainclient = executable('janet', janetc, mainclient_src,
janet_mainclient = executable('janet', mainclient_src,
include_directories : incdir,
dependencies : janet_dependencies,
link_with: [libjanet],
c_args : extra_cflags,
install : true)
@@ -281,11 +288,12 @@ patched_janet = custom_target('patched-janeth',
install : true,
install_dir : join_paths(get_option('includedir'), 'janet'),
build_by_default : true,
output : ['janet.h'],
output : ['janet_' + meson.project_version() + '.h'],
command : [janet_nativeclient, '@INPUT@', '@OUTPUT@'])
# Create a version of the janet.h header that matches what jpm often expects
if meson.version().version_compare('>=0.61')
install_symlink('janet.h', pointing_to: 'janet/janet.h', install_dir: get_option('includedir'))
install_symlink('janet.h', pointing_to: 'janet_' + meson.project_version() + '.h', install_dir: join_paths(get_option('includedir'), 'janet'))
endif

View File

@@ -18,7 +18,7 @@ option('realpath', type : 'boolean', value : true)
option('simple_getline', type : 'boolean', value : false)
option('epoll', type : 'boolean', value : false)
option('kqueue', type : 'boolean', value : false)
option('interpreter_interrupt', type : 'boolean', value : false)
option('interpreter_interrupt', type : 'boolean', value : true)
option('ffi', type : 'boolean', value : true)
option('ffi_jit', type : 'boolean', value : true)

View File

@@ -103,23 +103,13 @@
(defn symbol? "Check if x is a symbol." [x] (= (type x) :symbol))
(defn keyword? "Check if x is a keyword." [x] (= (type x) :keyword))
(defn buffer? "Check if x is a buffer." [x] (= (type x) :buffer))
(defn function? "Check if x is a function (not a cfunction)." [x]
(= (type x) :function))
(defn function? "Check if x is a function (not a cfunction)." [x] (= (type x) :function))
(defn cfunction? "Check if x a cfunction." [x] (= (type x) :cfunction))
(defn table? "Check if x a table." [x] (= (type x) :table))
(defn struct? "Check if x a struct." [x] (= (type x) :struct))
(defn array? "Check if x is an array." [x] (= (type x) :array))
(defn tuple? "Check if x is a tuple." [x] (= (type x) :tuple))
(defn boolean? "Check if x is a boolean." [x] (= (type x) :boolean))
(defn bytes? "Check if x is a string, symbol, keyword, or buffer." [x]
(def t (type x))
(if (= t :string) true (if (= t :symbol) true (if (= t :keyword) true (= t :buffer)))))
(defn dictionary? "Check if x is a table or struct." [x]
(def t (type x))
(if (= t :table) true (= t :struct)))
(defn indexed? "Check if x is an array or tuple." [x]
(def t (type x))
(if (= t :array) true (= t :tuple)))
(defn truthy? "Check if x is truthy." [x] (if x true false))
(defn true? "Check if x is true." [x] (= x true))
(defn false? "Check if x is false." [x] (= x false))
@@ -151,7 +141,7 @@
(defmacro -= "Decrements the var x by n." [x & ns] ~(set ,x (,- ,x ,;ns)))
(defmacro *= "Shorthand for (set x (\\* x n))." [x & ns] ~(set ,x (,* ,x ,;ns)))
(defmacro /= "Shorthand for (set x (/ x n))." [x & ns] ~(set ,x (,/ ,x ,;ns)))
(defmacro %= "Shorthand for (set x (% x n))." [x n] ~(set ,x (,% ,x ,n)))
(defmacro %= "Shorthand for (set x (% x n))." [x & ns] ~(set ,x (,% ,x ,;ns)))
(defmacro assert
"Throw an error if x is not truthy. Will not evaluate `err` if x is truthy."
@@ -429,9 +419,11 @@
(error (string "expected tuple for range, got " x))))
(defn- range-template
[binding object rest op comparison]
[binding object kind rest op comparison]
(let [[start stop step] (check-indexed object)]
(for-template binding start stop (or step 1) comparison op [rest])))
(case kind
:range (for-template binding (if stop start 0) (or stop start) (or step 1) comparison op [rest])
:down (for-template binding start (or stop 0) (or step 1) comparison op [rest]))))
(defn- each-template
[binding inx kind body]
@@ -446,8 +438,8 @@
:each ~(,in ,ds ,k)
:keys k
:pairs ~[,k (,in ,ds ,k)]))
,;body
(set ,k (,next ,ds ,k))))))
(set ,k (,next ,ds ,k))
,;body))))
(defn- iterate-template
[binding expr body]
@@ -481,16 +473,17 @@
:repeat (with-syms [iter]
~(do (var ,iter ,verb) (while (> ,iter 0) ,rest (-- ,iter))))
:when ~(when ,verb ,rest)
:unless ~(unless ,verb ,rest)
(error (string "unexpected loop modifier " binding))))))
# 3 term expression
(def {(+ i 2) object} head)
(let [rest (loop1 body head (+ i 3))]
(case verb
:range (range-template binding object rest + <)
:range-to (range-template binding object rest + <=)
:down (range-template binding object rest - >)
:down-to (range-template binding object rest - >=)
:range (range-template binding object :range rest + <)
:range-to (range-template binding object :range rest + <=)
:down (range-template binding object :down rest - >)
:down-to (range-template binding object :down rest - >=)
:keys (each-template binding object :keys [rest])
:pairs (each-template binding object :pairs [rest])
:in (each-template binding object :each [rest])
@@ -597,7 +590,10 @@
* `:repeat n` -- repeats the next inner loop `n` times.
* `:when condition` -- only evaluates the current loop body when `condition`
is true.
is truthy.
* `:unless condition` -- only evaluates the current loop body when `condition`
is falsey.
The `loop` macro always evaluates to nil.
```
@@ -651,7 +647,12 @@
(defn mean
"Returns the mean of xs. If empty, returns NaN."
[xs]
(/ (sum xs) (length xs)))
(if (lengthable? xs)
(/ (sum xs) (length xs))
(do
(var [accum total] [0 0])
(each x xs (+= accum x) (++ total))
(/ accum total))))
(defn product
"Returns the product of xs. If xs is empty, returns 1."
@@ -712,30 +713,38 @@
[f]
(fn [x] (not (f x))))
(defmacro- do-extreme
[order args]
~(do
(def ds ,args)
(var k (next ds nil))
(var ret (get ds k))
(while (,not= nil (set k (next ds k)))
(def x (in ds k))
(if (,order x ret) (set ret x)))
ret))
(defn extreme
``Returns the most extreme value in `args` based on the function `order`.
`order` should take two values and return true or false (a comparison).
Returns nil if `args` is empty.``
[order args]
(var [ret] args)
(each x args (if (order x ret) (set ret x)))
ret)
[order args] (do-extreme order args))
(defn max
"Returns the numeric maximum of the arguments."
[& args] (extreme > args))
[& args] (do-extreme > args))
(defn min
"Returns the numeric minimum of the arguments."
[& args] (extreme < args))
[& args] (do-extreme < args))
(defn max-of
"Returns the numeric maximum of the argument sequence."
[args] (extreme > args))
[args] (do-extreme > args))
(defn min-of
"Returns the numeric minimum of the argument sequence."
[args] (extreme < args))
[args] (do-extreme < args))
(defn first
"Get the first element from an indexed data structure."
@@ -749,6 +758,14 @@
## Polymorphic comparisons
(defmacro- do-compare
[x y]
~(if (def f (get ,x :compare))
(f ,x ,y)
(if (def f (get ,y :compare))
(- (f ,y ,x))
(cmp ,x ,y))))
(defn compare
``Polymorphic compare. Returns -1, 0, 1 for x < y, x = y, x > y respectively.
Differs from the primitive comparators in that it first checks to
@@ -756,20 +773,18 @@
compare x and y. If so, it uses that method. If not, it
delegates to the primitive comparators.``
[x y]
(or
(when-let [f (get x :compare)] (f x y))
(when-let [f (get y :compare)] (- (f y x)))
(cmp x y)))
(do-compare x y))
(defn- compare-reduce [op xs]
(var r true)
(loop [i :range [0 (- (length xs) 1)]
:let [c (compare (xs i) (xs (+ i 1)))
ok (op c 0)]
:when (not ok)]
(set r false)
(break))
r)
(defmacro- compare-reduce [op xs]
~(do
(var res true)
(var x (get ,xs 0))
(forv i 1 (length ,xs)
(let [y (in ,xs i)]
(if (,op (do-compare x y) 0)
(set x y)
(do (set res false) (break)))))
res))
(defn compare=
``Equivalent of `=` but using polymorphic `compare` instead of primitive comparator.``
@@ -809,21 +824,31 @@
###
###
(defn- median-of-three [a b c]
(if (not= (> a b) (> a c))
a
(if (not= (> b a) (> b c)) b c)))
(defmacro- median-of-three
[x y z]
~(if (<= ,x ,y)
(if (<= ,y ,z) ,y (if (<= ,z ,x) ,x ,z))
(if (<= ,z ,y) ,y (if (<= ,x ,z) ,x ,z))))
(defmacro- sort-partition-template
[ind before? left right pivot]
~(do
(while (,before? (in ,ind ,left) ,pivot) (++ ,left))
(while (,before? ,pivot (in ,ind ,right)) (-- ,right))))
(defn- sort-help [a lo hi before?]
(when (< lo hi)
(def pivot
(median-of-three (in a hi) (in a lo)
(in a (math/floor (/ (+ lo hi) 2)))))
(def [x y z] [(in a lo)
(in a (div (+ lo hi) 2))
(in a hi)])
(def pivot (median-of-three x y z))
(var left lo)
(var right hi)
(while true
(while (before? (in a left) pivot) (++ left))
(while (before? pivot (in a right)) (-- right))
(case before?
< (sort-partition-template a < left right pivot)
> (sort-partition-template a > left right pivot)
(sort-partition-template a before? left right pivot))
(when (<= left right)
(def tmp (in a left))
(set (a left) (in a right))
@@ -831,8 +856,10 @@
(++ left)
(-- right))
(if (>= left right) (break)))
(sort-help a lo right before?)
(sort-help a left hi before?))
(if (< lo right)
(sort-help a lo right before?))
(if (< left hi)
(sort-help a left hi before?)))
a)
(defn sort
@@ -840,7 +867,8 @@
If a `before?` comparator function is provided, sorts elements using that,
otherwise uses `<`.``
[ind &opt before?]
(sort-help ind 0 (- (length ind) 1) (or before? <)))
(default before? <)
(sort-help ind 0 (- (length ind) 1) before?))
(defn sort-by
``Sorts `ind` in-place by calling a function `f` on each element and
@@ -947,7 +975,6 @@
1 (map-n 1 ,maptype ,res ,f ,ind ,inds)
2 (map-n 2 ,maptype ,res ,f ,ind ,inds)
3 (map-n 3 ,maptype ,res ,f ,ind ,inds)
4 (map-n 4 ,maptype ,res ,f ,ind ,inds)
(do
(def iter-keys (array/new-filled ninds))
(def call-buffer (array/new-filled ninds))
@@ -1007,30 +1034,6 @@
(map-template :keep res pred ind inds)
res)
(defn range
`Create an array of values [start, end) with a given step.
With one argument, returns a range [0, end). With two arguments, returns
a range [start, end). With three, returns a range with optional step size.`
[& args]
(case (length args)
1 (do
(def [n] args)
(def arr (array/new n))
(forv i 0 n (put arr i i))
arr)
2 (do
(def [n m] args)
(def arr (array/new (- m n)))
(forv i n m (put arr (- i n) i))
arr)
3 (do
(def [n m s] args)
(cond
(zero? s) @[]
(neg? s) (seq [i :down [n m (- s)]] i)
(seq [i :range [n m s]] i)))
(error "expected 1 to 3 arguments to range")))
(defn find-index
``Find the index of indexed type for which `pred` is true. Returns `dflt` if not found.``
[pred ind &opt dflt]
@@ -1439,48 +1442,50 @@
(fn [& r] (f ;more ;r))))
(defn every?
``Returns true if each value in `ind` is truthy, otherwise returns the first
falsey value.``
``Evaluates to the last element of `ind` if all preceding elements are truthy,
otherwise evaluates to the first falsey element.``
[ind]
(var res true)
(loop [x :in ind :while res]
(if x nil (set res x)))
(set res x))
res)
(defn any?
``Returns the first truthy value in `ind`, otherwise nil.``
``Evaluates to the last element of `ind` if all preceding elements are falsey,
otherwise evaluates to the first truthy element.``
[ind]
(var res nil)
(loop [x :in ind :until res]
(if x (set res x)))
(set res x))
res)
(defn reverse!
`Reverses the order of the elements in a given array or buffer and returns it
mutated.`
[t]
(def len-1 (- (length t) 1))
(def half (/ len-1 2))
(forv i 0 half
(def j (- len-1 i))
(def l (in t i))
(def r (in t j))
(put t i r)
(put t j l))
(var i 0)
(var j (length t))
(while (< i (-- j))
(def ti (in t i))
(put t i (in t j))
(put t j ti)
(++ i))
t)
(defn reverse
`Reverses the order of the elements in a given array or tuple and returns
a new array. If a string or buffer is provided, returns an array of its
byte values, reversed.`
a new array. If a string or buffer is provided, returns a buffer instead.`
[t]
(def len (length t))
(var n (- len 1))
(def ret (array/new len))
(while (>= n 0)
(array/push ret (in t n))
(-- n))
ret)
(if (lengthable? t)
(do
(var n (length t))
(def ret (if (bytes? t)
(buffer/new-filled n)
(array/new-filled n)))
(each v t
(put ret (-- n) v))
ret)
(reverse! (seq [v :in t] v))))
(defn invert
``Given an associative data structure `ds`, returns a new table where the
@@ -1590,32 +1595,41 @@
(defn keys
"Get the keys of an associative data structure."
[x]
(def arr @[])
(var k (next x nil))
(while (not= nil k)
(array/push arr k)
(set k (next x k)))
arr)
(if (lengthable? x)
(do
(def arr (array/new-filled (length x)))
(var i 0)
(eachk k x
(put arr i k)
(++ i))
arr)
(seq [k :keys x] k)))
(defn values
"Get the values of an associative data structure."
[x]
(def arr @[])
(var k (next x nil))
(while (not= nil k)
(array/push arr (in x k))
(set k (next x k)))
arr)
(if (lengthable? x)
(do
(def arr (array/new-filled (length x)))
(var i 0)
(each v x
(put arr i v)
(++ i))
arr)
(seq [v :in x] v)))
(defn pairs
"Get the key-value pairs of an associative data structure."
[x]
(def arr @[])
(var k (next x nil))
(while (not= nil k)
(array/push arr (tuple k (in x k)))
(set k (next x k)))
arr)
(if (lengthable? x)
(do
(def arr (array/new-filled (length x)))
(var i 0)
(eachp p x
(put arr i p)
(++ i))
arr)
(seq [p :pairs x] p)))
(defn frequencies
"Get the number of occurrences of each value in an indexed data structure."
@@ -1660,14 +1674,7 @@
(defn interleave
"Returns an array of the first elements of each col, then the second elements, etc."
[& cols]
(def res @[])
(def ncol (length cols))
(when (> ncol 0)
(def len (min ;(map length cols)))
(loop [i :range [0 len]
ci :range [0 ncol]]
(array/push res (in (in cols ci) i))))
res)
(mapcat tuple ;cols))
(defn distinct
"Returns an array of the deduplicated values in `xs`."
@@ -1714,29 +1721,46 @@
``Returns a sequence of the elements of `ind` separated by
`sep`. Returns a new array.``
[sep ind]
(var k (next ind nil))
(if (not= nil k)
(if (lengthable? ind)
(do
(def ret (array/new-filled (- (* 2 (length ind)) 1) sep))
(var i 0)
(while (not= nil k)
(put ret i (in ind k))
(set k (next ind k))
(+= i 2))
ret)
(do
(def ret @[(in ind k)])
(while (not= nil (set k (next ind k)))
(array/push ret sep (in ind k)))
ret))
@[]))
(defn- partition-slice
[f n ind]
(var [start end] [0 n])
(def len (length ind))
(def ret (array/new (- (* 2 len) 1)))
(if (> len 0) (put ret 0 (in ind 0)))
(var i 1)
(while (< i len)
(array/push ret sep (in ind i))
(++ i))
(def parts (div len n))
(def ret (array/new-filled parts))
(forv k 0 parts
(put ret k (f ind start end))
(set start end)
(+= end n))
(if (< start len)
(array/push ret (f ind start)))
ret)
(defn partition
``Partition an indexed data structure `ind` into tuples
of size `n`. Returns a new array.``
[n ind]
(var i 0) (var nextn n)
(def len (length ind))
(def ret (array/new (math/ceil (/ len n))))
(def slicer (if (bytes? ind) string/slice tuple/slice))
(while (<= nextn len)
(array/push ret (slicer ind i nextn))
(set i nextn)
(+= nextn n))
(if (not= i len) (array/push ret (slicer ind i)))
ret)
(cond
(indexed? ind) (partition-slice tuple/slice n ind)
(bytes? ind) (partition-slice string/slice n ind)
(partition-slice tuple/slice n (values ind))))
###
###
@@ -2883,7 +2907,12 @@
(if (= :dead fs)
(when is-repl
(put env '_ @{:value x})
(printf (get env *pretty-format* "%q") x)
(def pf (get env *pretty-format* "%q"))
(try
(printf pf x)
([e]
(eprintf "bad pretty format %v: %v" pf e)
(eflush)))
(flush))
(do
(debug/stacktrace f x "")
@@ -3520,6 +3549,24 @@
(when-let [constants (dasm :constants)]
(eprintf " constants: %.4q" constants))
(eprintf " slots: %.4q\n" (frame :slots))
(when-let [src-path (in dasm :source)]
(when (and (fexists src-path)
sourcemap)
(defn dump
[src cur]
(def offset 5)
(def beg (max 1 (- cur offset)))
(def lines (array/concat @[""] (string/split "\n" src)))
(def end (min (+ cur offset) (length lines)))
(def digits (inc (math/floor (math/log10 end))))
(def fmt-str (string "%" digits "d: %s"))
(for i beg end
(eprin " ") # breakpoint someday?
(eprin (if (= i cur) "> " " "))
(eprintf fmt-str i (get lines i))))
(let [[sl _] (sourcemap pc)]
(dump (slurp src-path) sl)
(eprint))))
(def padding (string/repeat " " 20))
(loop [i :range [0 (length bytecode)]
:let [instr (bytecode i)]]
@@ -3719,7 +3766,7 @@
[host port &opt handler type]
(def s (net/listen host port type))
(if handler
(ev/call (fn [] (net/accept-loop s handler))))
(ev/go (fn [] (net/accept-loop s handler))))
s))
###

View File

@@ -4,10 +4,10 @@
#define JANETCONF_H
#define JANET_VERSION_MAJOR 1
#define JANET_VERSION_MINOR 29
#define JANET_VERSION_PATCH 1
#define JANET_VERSION_MINOR 31
#define JANET_VERSION_PATCH 0
#define JANET_VERSION_EXTRA ""
#define JANET_VERSION "1.29.1"
#define JANET_VERSION "1.31.0"
/* #define JANET_BUILD "local" */

View File

@@ -177,8 +177,8 @@ JANET_CORE_FN(cfun_array_peek,
}
JANET_CORE_FN(cfun_array_push,
"(array/push arr x)",
"Insert an element in the end of an array. Modifies the input array and returns it.") {
"(array/push arr & xs)",
"Push all the elements of xs to the end of an array. Modifies the input array and returns it.") {
janet_arity(argc, 1, -1);
JanetArray *array = janet_getarray(argv, 0);
if (INT32_MAX - argc + 1 <= array->count) {
@@ -211,7 +211,7 @@ JANET_CORE_FN(cfun_array_slice,
"Takes a slice of array or tuple from `start` to `end`. The range is half open, "
"[start, end). Indexes can also be negative, indicating indexing from the "
"end of the array. By default, `start` is 0 and `end` is the length of the array. "
"Note that index -1 is synonymous with index `(length arrtup)` to allow a full "
"Note that if the range is negative, it is taken as (start, end] to allow a full "
"negative slice range. Returns a new array.") {
JanetView view = janet_getindexed(argv, 0);
JanetRange range = janet_getslice(argc, argv);
@@ -259,8 +259,8 @@ JANET_CORE_FN(cfun_array_insert,
"(array/insert arr at & xs)",
"Insert all `xs` into array `arr` at index `at`. `at` should be an integer between "
"0 and the length of the array. A negative value for `at` will index backwards from "
"the end of the array, such that inserting at -1 appends to the array. "
"Returns the array.") {
"the end of the array, inserting after the index such that inserting at -1 appends to "
"the array. Returns the array.") {
size_t chunksize, restsize;
janet_arity(argc, 2, -1);
JanetArray *array = janet_getarray(argv, 0);
@@ -297,7 +297,7 @@ JANET_CORE_FN(cfun_array_remove,
int32_t at = janet_getinteger(argv, 1);
int32_t n = 1;
if (at < 0) {
at = array->count + at + 1;
at = array->count + at;
}
if (at < 0 || at > array->count)
janet_panicf("removal index %d out of range [0,%d]", at, array->count);

View File

@@ -75,6 +75,7 @@ static const JanetInstructionDef janet_ops[] = {
{"cmp", JOP_COMPARE},
{"cncl", JOP_CANCEL},
{"div", JOP_DIVIDE},
{"divf", JOP_DIVIDE_FLOOR},
{"divim", JOP_DIVIDE_IMMEDIATE},
{"eq", JOP_EQUALS},
{"eqim", JOP_EQUALS_IMMEDIATE},
@@ -137,6 +138,7 @@ static const JanetInstructionDef janet_ops[] = {
{"sru", JOP_SHIFT_RIGHT_UNSIGNED},
{"sruim", JOP_SHIFT_RIGHT_UNSIGNED_IMMEDIATE},
{"sub", JOP_SUBTRACT},
{"subim", JOP_SUBTRACT_IMMEDIATE},
{"tcall", JOP_TAILCALL},
{"tchck", JOP_TYPECHECK}
};

View File

@@ -221,6 +221,20 @@ JANET_CORE_FN(cfun_buffer_new_filled,
return janet_wrap_buffer(buffer);
}
JANET_CORE_FN(cfun_buffer_frombytes,
"(buffer/from-bytes & byte-vals)",
"Creates a buffer from integer parameters with byte values. All integers "
"will be coerced to the range of 1 byte 0-255.") {
int32_t i;
JanetBuffer *buffer = janet_buffer(argc);
for (i = 0; i < argc; i++) {
int32_t c = janet_getinteger(argv, i);
buffer->data[i] = c & 0xFF;
}
buffer->count = argc;
return janet_wrap_buffer(buffer);
}
JANET_CORE_FN(cfun_buffer_fill,
"(buffer/fill buffer &opt byte)",
"Fill up a buffer with bytes, defaulting to 0s. Does not change the buffer's length. "
@@ -462,13 +476,15 @@ JANET_CORE_FN(cfun_buffer_blit,
int same_buf = src.bytes == dest->data;
int32_t offset_dest = 0;
int32_t offset_src = 0;
if (argc > 2)
if (argc > 2 && !janet_checktype(argv[2], JANET_NIL))
offset_dest = janet_gethalfrange(argv, 2, dest->count, "dest-start");
if (argc > 3)
if (argc > 3 && !janet_checktype(argv[3], JANET_NIL))
offset_src = janet_gethalfrange(argv, 3, src.len, "src-start");
int32_t length_src;
if (argc > 4) {
int32_t src_end = janet_gethalfrange(argv, 4, src.len, "src-end");
int32_t src_end = src.len;
if (!janet_checktype(argv[4], JANET_NIL))
src_end = janet_gethalfrange(argv, 4, src.len, "src-end");
length_src = src_end - offset_src;
if (length_src < 0) length_src = 0;
} else {
@@ -507,6 +523,7 @@ void janet_lib_buffer(JanetTable *env) {
JanetRegExt buffer_cfuns[] = {
JANET_CORE_REG("buffer/new", cfun_buffer_new),
JANET_CORE_REG("buffer/new-filled", cfun_buffer_new_filled),
JANET_CORE_REG("buffer/from-bytes", cfun_buffer_frombytes),
JANET_CORE_REG("buffer/fill", cfun_buffer_fill),
JANET_CORE_REG("buffer/trim", cfun_buffer_trim),
JANET_CORE_REG("buffer/push-byte", cfun_buffer_u8),

View File

@@ -37,11 +37,13 @@ enum JanetInstructionType janet_instructions[JOP_INSTRUCTION_COUNT] = {
JINT_0, /* JOP_RETURN_NIL, */
JINT_SSI, /* JOP_ADD_IMMEDIATE, */
JINT_SSS, /* JOP_ADD, */
JINT_SSI, /* JOP_SUBTRACT_IMMEDIATE, */
JINT_SSS, /* JOP_SUBTRACT, */
JINT_SSI, /* JOP_MULTIPLY_IMMEDIATE, */
JINT_SSS, /* JOP_MULTIPLY, */
JINT_SSI, /* JOP_DIVIDE_IMMEDIATE, */
JINT_SSS, /* JOP_DIVIDE, */
JINT_SSS, /* JOP_DIVIDE_FLOOR */
JINT_SSS, /* JOP_MODULO, */
JINT_SSS, /* JOP_REMAINDER, */
JINT_SSS, /* JOP_BAND, */
@@ -250,6 +252,7 @@ void janet_bytecode_movopt(JanetFuncDef *def) {
case JOP_SIGNAL:
/* Write A, Read B */
case JOP_ADD_IMMEDIATE:
case JOP_SUBTRACT_IMMEDIATE:
case JOP_MULTIPLY_IMMEDIATE:
case JOP_DIVIDE_IMMEDIATE:
case JOP_SHIFT_LEFT_IMMEDIATE:
@@ -301,6 +304,7 @@ void janet_bytecode_movopt(JanetFuncDef *def) {
case JOP_SUBTRACT:
case JOP_MULTIPLY:
case JOP_DIVIDE:
case JOP_DIVIDE_FLOOR:
case JOP_MODULO:
case JOP_REMAINDER:
case JOP_SHIFT_LEFT:

View File

@@ -216,12 +216,32 @@ const char *janet_getcstring(const Janet *argv, int32_t n) {
}
const char *janet_getcbytes(const Janet *argv, int32_t n) {
/* Ensure buffer 0-padded */
if (janet_checktype(argv[n], JANET_BUFFER)) {
JanetBuffer *b = janet_unwrap_buffer(argv[n]);
if ((b->gc.flags & JANET_BUFFER_FLAG_NO_REALLOC) && b->count == b->capacity) {
/* Make a copy with janet_smalloc in the rare case we have a buffer that
* cannot be realloced and pushing a 0 byte would panic. */
char *new_string = janet_smalloc(b->count + 1);
memcpy(new_string, b->data, b->count);
new_string[b->count] = 0;
if (strlen(new_string) != (size_t) b->count) goto badzeros;
return new_string;
} else {
/* Ensure trailing 0 */
janet_buffer_push_u8(b, 0);
b->count--;
if (strlen((char *)b->data) != (size_t) b->count) goto badzeros;
return (const char *) b->data;
}
}
JanetByteView view = janet_getbytes(argv, n);
const char *cstr = (const char *)view.bytes;
if (strlen(cstr) != (size_t) view.len) {
janet_panic("bytes contain embedded 0s");
}
if (strlen(cstr) != (size_t) view.len) goto badzeros;
return cstr;
badzeros:
janet_panic("bytes contain embedded 0s");
}
const char *janet_optcbytes(const Janet *argv, int32_t argc, int32_t n, const char *dflt) {
@@ -273,6 +293,14 @@ int32_t janet_getinteger(const Janet *argv, int32_t n) {
return janet_unwrap_integer(x);
}
uint32_t janet_getuinteger(const Janet *argv, int32_t n) {
Janet x = argv[n];
if (!janet_checkuint(x)) {
janet_panicf("bad slot #%d, expected 32 bit signed integer, got %v", n, x);
}
return janet_unwrap_integer(x);
}
int64_t janet_getinteger64(const Janet *argv, int32_t n) {
#ifdef JANET_INT_TYPES
return janet_unwrap_s64(argv[n]);
@@ -290,7 +318,7 @@ uint64_t janet_getuinteger64(const Janet *argv, int32_t n) {
return janet_unwrap_u64(argv[n]);
#else
Janet x = argv[n];
if (!janet_checkint64(x)) {
if (!janet_checkuint64(x)) {
janet_panicf("bad slot #%d, expected 64 bit unsigned integer, got %v", n, x);
}
return (uint64_t) janet_unwrap_number(x);
@@ -314,6 +342,20 @@ int32_t janet_gethalfrange(const Janet *argv, int32_t n, int32_t length, const c
return not_raw;
}
int32_t janet_getstartrange(const Janet *argv, int32_t argc, int32_t n, int32_t length) {
if (n >= argc || janet_checktype(argv[n], JANET_NIL)) {
return 0;
}
return janet_gethalfrange(argv, n, length, "start");
}
int32_t janet_getendrange(const Janet *argv, int32_t argc, int32_t n, int32_t length) {
if (n >= argc || janet_checktype(argv[n], JANET_NIL)) {
return length;
}
return janet_gethalfrange(argv, n, length, "end");
}
int32_t janet_getargindex(const Janet *argv, int32_t n, int32_t length, const char *which) {
int32_t raw = janet_getinteger(argv, n);
int32_t not_raw = raw;
@@ -366,24 +408,10 @@ JanetRange janet_getslice(int32_t argc, const Janet *argv) {
janet_arity(argc, 1, 3);
JanetRange range;
int32_t length = janet_length(argv[0]);
if (argc == 1) {
range.start = 0;
range.end = length;
} else if (argc == 2) {
range.start = janet_checktype(argv[1], JANET_NIL)
? 0
: janet_gethalfrange(argv, 1, length, "start");
range.end = length;
} else {
range.start = janet_checktype(argv[1], JANET_NIL)
? 0
: janet_gethalfrange(argv, 1, length, "start");
range.end = janet_checktype(argv[2], JANET_NIL)
? length
: janet_gethalfrange(argv, 2, length, "end");
if (range.end < range.start)
range.end = range.start;
}
range.start = janet_getstartrange(argv, argc, 1, length);
range.end = janet_getendrange(argv, argc, 2, length);
if (range.end < range.start)
range.end = range.start;
return range;
}
@@ -465,7 +493,7 @@ void *janet_optabstract(const Janet *argv, int32_t argc, int32_t n, const JanetA
/* Some definitions for function-like macros */
JANET_API JanetStructHead *(janet_struct_head)(const JanetKV *st) {
JANET_API JanetStructHead *(janet_struct_head)(JanetStruct st) {
return janet_struct_head(st);
}
@@ -473,10 +501,10 @@ JANET_API JanetAbstractHead *(janet_abstract_head)(const void *abstract) {
return janet_abstract_head(abstract);
}
JANET_API JanetStringHead *(janet_string_head)(const uint8_t *s) {
JANET_API JanetStringHead *(janet_string_head)(JanetString s) {
return janet_string_head(s);
}
JANET_API JanetTupleHead *(janet_tuple_head)(const Janet *tuple) {
JANET_API JanetTupleHead *(janet_tuple_head)(JanetTuple tuple) {
return janet_tuple_head(tuple);
}

View File

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

View File

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

View File

@@ -426,6 +426,36 @@ JANET_CORE_FN(janet_core_slice,
}
}
JANET_CORE_FN(janet_core_range,
"(range & args)",
"Create an array of values [start, end) with a given step. "
"With one argument, returns a range [0, end). With two arguments, returns "
"a range [start, end). With three, returns a range with optional step size.") {
janet_arity(argc, 1, 3);
int32_t start = 0, stop = 0, step = 1, count = 0;
if (argc == 3) {
start = janet_getinteger(argv, 0);
stop = janet_getinteger(argv, 1);
step = janet_getinteger(argv, 2);
count = (step > 0) ? (stop - start - 1) / step + 1 :
((step < 0) ? (stop - start + 1) / step + 1 : 0);
} else if (argc == 2) {
start = janet_getinteger(argv, 0);
stop = janet_getinteger(argv, 1);
count = stop - start;
} else {
stop = janet_getinteger(argv, 0);
count = stop;
}
count = (count > 0) ? count : 0;
JanetArray *array = janet_array(count);
for (int32_t i = 0; i < count; i++) {
array->data[i] = janet_wrap_number(start + i * step);
}
array->count = count;
return janet_wrap_array(array);
}
JANET_CORE_FN(janet_core_table,
"(table & kvs)",
"Creates a new table from a variadic number of keys and values. "
@@ -629,6 +659,34 @@ ret_false:
return janet_wrap_false();
}
JANET_CORE_FN(janet_core_is_bytes,
"(bytes? x)",
"Check if x is a string, symbol, keyword, or buffer.") {
janet_fixarity(argc, 1);
return janet_wrap_boolean(janet_checktypes(argv[0], JANET_TFLAG_BYTES));
}
JANET_CORE_FN(janet_core_is_indexed,
"(indexed? x)",
"Check if x is an array or tuple.") {
janet_fixarity(argc, 1);
return janet_wrap_boolean(janet_checktypes(argv[0], JANET_TFLAG_INDEXED));
}
JANET_CORE_FN(janet_core_is_dictionary,
"(dictionary? x)",
"Check if x is a table or struct.") {
janet_fixarity(argc, 1);
return janet_wrap_boolean(janet_checktypes(argv[0], JANET_TFLAG_DICTIONARY));
}
JANET_CORE_FN(janet_core_is_lengthable,
"(lengthable? x)",
"Check if x is a bytes, indexed, or dictionary.") {
janet_fixarity(argc, 1);
return janet_wrap_boolean(janet_checktypes(argv[0], JANET_TFLAG_LENGTHABLE));
}
JANET_CORE_FN(janet_core_signal,
"(signal what x)",
"Raise a signal with payload x. ") {
@@ -690,6 +748,7 @@ static const SandboxOption sandbox_options[] = {
{"net-connect", JANET_SANDBOX_NET_CONNECT},
{"net-listen", JANET_SANDBOX_NET_LISTEN},
{"sandbox", JANET_SANDBOX_SANDBOX},
{"signal", JANET_SANDBOX_SIGNAL},
{"subprocess", JANET_SANDBOX_SUBPROCESS},
{NULL, 0}
};
@@ -714,6 +773,7 @@ JANET_CORE_FN(janet_core_sandbox,
"* :net-connect - disallow making outbound network connections\n"
"* :net-listen - disallow accepting inbound network connections\n"
"* :sandbox - disallow calling this function\n"
"* :signal - disallow adding or removing signal handlers\n"
"* :subprocess - disallow running subprocesses") {
uint32_t flags = 0;
for (int32_t i = 0; i < argc; i++) {
@@ -985,14 +1045,6 @@ static const uint32_t next_asm[] = {
JOP_NEXT | (1 << 24),
JOP_RETURN
};
static const uint32_t modulo_asm[] = {
JOP_MODULO | (1 << 24),
JOP_RETURN
};
static const uint32_t remainder_asm[] = {
JOP_REMAINDER | (1 << 24),
JOP_RETURN
};
static const uint32_t cmp_asm[] = {
JOP_COMPARE | (1 << 24),
JOP_RETURN
@@ -1031,7 +1083,12 @@ static void janet_load_libs(JanetTable *env) {
JANET_CORE_REG("module/expand-path", janet_core_expand_path),
JANET_CORE_REG("int?", janet_core_check_int),
JANET_CORE_REG("nat?", janet_core_check_nat),
JANET_CORE_REG("bytes?", janet_core_is_bytes),
JANET_CORE_REG("indexed?", janet_core_is_indexed),
JANET_CORE_REG("dictionary?", janet_core_is_dictionary),
JANET_CORE_REG("lengthable?", janet_core_is_lengthable),
JANET_CORE_REG("slice", janet_core_slice),
JANET_CORE_REG("range", janet_core_range),
JANET_CORE_REG("signal", janet_core_signal),
JANET_CORE_REG("memcmp", janet_core_memcmp),
JANET_CORE_REG("getproto", janet_core_getproto),
@@ -1077,14 +1134,6 @@ static void janet_load_libs(JanetTable *env) {
JanetTable *janet_core_env(JanetTable *replacements) {
JanetTable *env = (NULL != replacements) ? replacements : janet_table(0);
janet_quick_asm(env, JANET_FUN_MODULO,
"mod", 2, 2, 2, 2, modulo_asm, sizeof(modulo_asm),
JDOC("(mod dividend divisor)\n\n"
"Returns the modulo of dividend / divisor."));
janet_quick_asm(env, JANET_FUN_REMAINDER,
"%", 2, 2, 2, 2, remainder_asm, sizeof(remainder_asm),
JDOC("(% dividend divisor)\n\n"
"Returns the remainder of dividend / divisor."));
janet_quick_asm(env, JANET_FUN_CMP,
"cmp", 2, 2, 2, 2, cmp_asm, sizeof(cmp_asm),
JDOC("(cmp x y)\n\n"
@@ -1183,6 +1232,18 @@ JanetTable *janet_core_env(JanetTable *replacements) {
"Returns the quotient of xs. If xs is empty, returns 1. If xs has one value x, returns "
"the reciprocal of x. Otherwise return the first value of xs repeatedly divided by the remaining "
"values."));
templatize_varop(env, JANET_FUN_DIVIDE_FLOOR, "div", 1, 1, JOP_DIVIDE_FLOOR,
JDOC("(div & xs)\n\n"
"Returns the floored division of xs. If xs is empty, returns 1. If xs has one value x, returns "
"the reciprocal of x. Otherwise return the first value of xs repeatedly divided by the remaining "
"values."));
templatize_varop(env, JANET_FUN_MODULO, "mod", 0, 1, JOP_MODULO,
JDOC("(mod & xs)\n\n"
"Returns the result of applying the modulo operator on the first value of xs with each remaining value. "
"`(mod x 0)` is defined to be `x`."));
templatize_varop(env, JANET_FUN_REMAINDER, "%", 0, 1, JOP_REMAINDER,
JDOC("(% & xs)\n\n"
"Returns the remainder of dividing the first value of xs by each remaining value."));
templatize_varop(env, JANET_FUN_BAND, "band", -1, -1, JOP_BAND,
JDOC("(band & xs)\n\n"
"Returns the bit-wise and of all values in xs. Each x in xs must be an integer."));

View File

@@ -127,7 +127,7 @@ static int32_t janet_q_count(JanetQueue *q) {
: (q->tail - q->head);
}
static int janet_q_push(JanetQueue *q, void *item, size_t itemsize) {
static int janet_q_maybe_resize(JanetQueue *q, size_t itemsize) {
int32_t count = janet_q_count(q);
/* Resize if needed */
if (count + 1 >= q->capacity) {
@@ -151,11 +151,27 @@ static int janet_q_push(JanetQueue *q, void *item, size_t itemsize) {
}
q->capacity = newcap;
}
return 0;
}
static int janet_q_push(JanetQueue *q, void *item, size_t itemsize) {
if (janet_q_maybe_resize(q, itemsize)) return 1;
memcpy((char *) q->data + itemsize * q->tail, item, itemsize);
q->tail = q->tail + 1 < q->capacity ? q->tail + 1 : 0;
return 0;
}
static int janet_q_push_head(JanetQueue *q, void *item, size_t itemsize) {
if (janet_q_maybe_resize(q, itemsize)) return 1;
int32_t newhead = q->head - 1;
if (newhead < 0) {
newhead += q->capacity;
}
memcpy((char *) q->data + itemsize * newhead, item, itemsize);
q->head = newhead;
return 0;
}
static int janet_q_pop(JanetQueue *q, void *out, size_t itemsize) {
if (q->head == q->tail) return 1;
memcpy(out, (char *) q->data + itemsize * q->head, itemsize);
@@ -164,7 +180,7 @@ static int janet_q_pop(JanetQueue *q, void *out, size_t itemsize) {
}
/* Forward declaration */
static void janet_unlisten(JanetListenerState *state, int is_gc);
static void janet_unlisten(JanetListenerState *state);
/* Get current timestamp (millisecond precision) */
static JanetTimestamp ts_now(void);
@@ -238,76 +254,100 @@ static void add_timeout(JanetTimeout to) {
}
}
static int janet_listener_gc(void *p, size_t s);
static int janet_listener_mark(void *p, size_t s);
static const JanetAbstractType janet_listener_AT = {
"core/ev-listener",
janet_listener_gc,
janet_listener_mark,
JANET_ATEND_GCMARK
};
/* 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");
}
if (janet_vm.root_fiber->waiting != NULL) {
janet_panic("current fiber is already waiting for event");
}
if (size < sizeof(JanetListenerState))
size = sizeof(JanetListenerState);
JanetListenerState *state = janet_malloc(size);
if (NULL == state) {
JANET_OUT_OF_MEMORY;
}
if ((mask & JANET_ASYNC_LISTEN_READ) && stream->read_state) goto bad_listen_read;
if ((mask & JANET_ASYNC_LISTEN_WRITE) && stream->write_state) goto bad_listen_write;
janet_assert(size >= sizeof(JanetListenerState), "bad size");
JanetListenerState *state = janet_abstract(&janet_listener_AT, size);
state->machine = behavior;
state->fiber = janet_vm.root_fiber;
state->flags = 0;
janet_vm.root_fiber->waiting = state;
if (mask & JANET_ASYNC_LISTEN_READ) stream->read_state = state;
if (mask & JANET_ASYNC_LISTEN_WRITE) stream->write_state = state;
state->stream = stream;
state->_mask = mask;
stream->_mask |= mask;
state->_next = stream->state;
stream->state = state;
/* Keep track of a listener for GC purposes */
int resize = janet_vm.listener_cap == janet_vm.listener_count;
if (resize) {
size_t newcap = janet_vm.listener_count ? janet_vm.listener_cap * 2 : 16;
janet_vm.listeners = janet_realloc(janet_vm.listeners, newcap * sizeof(JanetListenerState *));
if (NULL == janet_vm.listeners) {
JANET_OUT_OF_MEMORY;
}
janet_vm.listener_cap = newcap;
}
size_t index = janet_vm.listener_count++;
janet_vm.listeners[index] = state;
state->_index = index;
/* Emit INIT event for convenience */
state->event = user;
state->machine(state, JANET_ASYNC_EVENT_INIT);
janet_ev_inc_refcount();
state->index = janet_vm.listeners->count;
janet_array_push(janet_vm.listeners, janet_wrap_abstract(state));
return state;
bad_listen_write:
janet_panic("cannot listen for duplicate write event on stream");
bad_listen_read:
janet_panic("cannot listen for duplicate read event on stream");
}
/* Indicate we are no longer listening for an event. This
* frees the memory of the state machine as well. */
static void janet_unlisten_impl(JanetListenerState *state, int is_gc) {
state->machine(state, JANET_ASYNC_EVENT_DEINIT);
/* Remove state machine from poll list */
JanetListenerState **iter = &(state->stream->state);
while (*iter && *iter != state)
iter = &((*iter)->_next);
janet_assert(*iter, "failed to remove listener");
*iter = state->_next;
/* Remove mask */
state->stream->_mask &= ~(state->_mask);
/* Ensure fiber does not reference this state */
if (!is_gc) {
JanetFiber *fiber = state->fiber;
if (NULL != fiber && fiber->waiting == state) {
fiber->waiting = NULL;
}
void janet_fiber_did_resume(JanetFiber *fiber) {
if (fiber->waiting) {
janet_unlisten(fiber->waiting);
fiber->waiting = NULL;
}
}
static void janet_unlisten_impl(JanetListenerState *state) {
/* Move last listener to position of this listener - O(1) removal and keep things densely packed. */
if (state->stream) {
Janet popped = janet_array_pop(janet_vm.listeners);
janet_assert(janet_checktype(popped, JANET_ABSTRACT), "pop check");
JanetListenerState *popped_state = (JanetListenerState *) janet_unwrap_abstract(popped);
janet_vm.listeners->data[state->index] = popped;
popped_state->index = state->index;
state->index = UINT32_MAX; /* just in case */
janet_ev_dec_refcount();
if (state->stream->read_state == state) {
state->stream->read_state = NULL;
}
if (state->stream->write_state == state) {
state->stream->write_state = NULL;
}
state->stream = NULL;
}
}
static int janet_listener_gc(void *p, size_t size) {
(void) size;
JanetListenerState *state = (JanetListenerState *)p;
if (state->stream) {
janet_ev_dec_refcount();
}
if (state->machine) {
state->machine(state, JANET_ASYNC_EVENT_DEINIT);
}
return 0;
}
static int janet_listener_mark(void *p, size_t size) {
(void) size;
JanetListenerState *state = (JanetListenerState *)p;
if (state->stream) {
janet_mark(janet_wrap_abstract(state->stream));
}
if (state->fiber) {
janet_mark(janet_wrap_fiber(state->fiber));
}
state->machine(state, JANET_ASYNC_EVENT_MARK);
return 0;
}
static void janet_stream_checktoclose(JanetStream *stream) {
if ((stream->flags & JANET_STREAM_TOCLOSE) && !stream->read_state && !stream->write_state) {
janet_stream_close(stream);
}
/* Untrack a listener for gc purposes */
size_t index = state->_index;
janet_vm.listeners[index] = janet_vm.listeners[--janet_vm.listener_count];
janet_vm.listeners[index]->_index = index;
janet_free(state);
}
static const JanetMethod ev_default_stream_methods[] = {
@@ -323,52 +363,52 @@ JanetStream *janet_stream(JanetHandle handle, uint32_t flags, const JanetMethod
JanetStream *stream = janet_abstract(&janet_stream_type, sizeof(JanetStream));
stream->handle = handle;
stream->flags = flags;
stream->state = NULL;
stream->_mask = 0;
stream->read_state = NULL;
stream->write_state = NULL;
if (methods == NULL) methods = ev_default_stream_methods;
stream->methods = methods;
return stream;
}
/* Close a stream */
static void janet_stream_close_impl(JanetStream *stream, int is_gc) {
if (stream->flags & JANET_STREAM_CLOSED) return;
JanetListenerState *state = stream->state;
while (NULL != state) {
if (!is_gc) {
state->machine(state, JANET_ASYNC_EVENT_CLOSE);
}
JanetListenerState *next_state = state->_next;
janet_unlisten(state, is_gc);
state = next_state;
}
stream->state = NULL;
static void janet_stream_close_impl(JanetStream *stream) {
stream->flags |= JANET_STREAM_CLOSED;
#ifdef JANET_WINDOWS
if (stream->handle != INVALID_HANDLE_VALUE) {
#ifdef JANET_NET
if (stream->flags & JANET_STREAM_SOCKET) {
closesocket((SOCKET) stream->handle);
} else
if (stream->flags & JANET_STREAM_SOCKET) {
closesocket((SOCKET) stream->handle);
} else
#endif
{
CloseHandle(stream->handle);
{
CloseHandle(stream->handle);
}
stream->handle = INVALID_HANDLE_VALUE;
}
stream->handle = INVALID_HANDLE_VALUE;
#else
close(stream->handle);
stream->handle = -1;
if (stream->handle != -1) {
close(stream->handle);
stream->handle = -1;
}
#endif
}
void janet_stream_close(JanetStream *stream) {
janet_stream_close_impl(stream, 0);
if (stream->read_state) {
stream->read_state->machine(stream->read_state, JANET_ASYNC_EVENT_CLOSE);
janet_unlisten(stream->read_state);
}
if (stream->write_state) {
stream->write_state->machine(stream->write_state, JANET_ASYNC_EVENT_CLOSE);
janet_unlisten(stream->write_state);
}
janet_stream_close_impl(stream);
}
/* Called to clean up a stream */
static int janet_stream_gc(void *p, size_t s) {
(void) s;
JanetStream *stream = (JanetStream *)p;
janet_stream_close_impl(stream, 1);
janet_stream_close_impl(stream);
return 0;
}
@@ -376,13 +416,11 @@ static int janet_stream_gc(void *p, size_t s) {
static int janet_stream_mark(void *p, size_t s) {
(void) s;
JanetStream *stream = (JanetStream *) p;
JanetListenerState *state = stream->state;
while (NULL != state) {
if (NULL != state->fiber) {
janet_mark(janet_wrap_fiber(state->fiber));
}
(state->machine)(state, JANET_ASYNC_EVENT_MARK);
state = state->_next;
if (NULL != stream->read_state) {
janet_mark(janet_wrap_abstract(stream->read_state));
}
if (NULL != stream->write_state) {
janet_mark(janet_wrap_abstract(stream->write_state));
}
return 0;
}
@@ -401,11 +439,11 @@ static void janet_stream_marshal(void *p, JanetMarshalContext *ctx) {
}
janet_marshal_abstract(ctx, p);
janet_marshal_int(ctx, (int32_t) s->flags);
janet_marshal_int64(ctx, (intptr_t) s->methods);
janet_marshal_ptr(ctx, s->methods);
#ifdef JANET_WINDOWS
/* TODO - ref counting to avoid situation where a handle is closed or GCed
* while in transit, and it's value gets reused. DuplicateHandle does not work
* for network sockets, and in general for winsock it is better to nipt duplicate
* for network sockets, and in general for winsock it is better to not duplicate
* unless there is a need to. */
HANDLE duph = INVALID_HANDLE_VALUE;
if (s->flags & JANET_STREAM_SOCKET) {
@@ -435,10 +473,10 @@ static void *janet_stream_unmarshal(JanetMarshalContext *ctx) {
}
JanetStream *p = janet_unmarshal_abstract(ctx, sizeof(JanetStream));
/* Can't share listening state and such across threads */
p->_mask = 0;
p->state = NULL;
p->read_state = NULL;
p->write_state = NULL;
p->flags = (uint32_t) janet_unmarshal_int(ctx);
p->methods = (void *) janet_unmarshal_int64(ctx);
p->methods = janet_unmarshal_ptr(ctx);
#ifdef JANET_WINDOWS
p->handle = (JanetHandle) janet_unmarshal_int64(ctx);
#else
@@ -468,7 +506,7 @@ const JanetAbstractType janet_stream_type = {
};
/* Register a fiber to resume with value */
void janet_schedule_signal(JanetFiber *fiber, Janet value, JanetSignal sig) {
static void janet_schedule_general(JanetFiber *fiber, Janet value, JanetSignal sig, int soon) {
if (fiber->gc.flags & JANET_FIBER_EV_FLAG_CANCELED) return;
if (!(fiber->gc.flags & JANET_FIBER_FLAG_ROOT)) {
Janet task_element = janet_wrap_fiber(fiber);
@@ -477,7 +515,19 @@ void janet_schedule_signal(JanetFiber *fiber, Janet value, JanetSignal sig) {
JanetTask t = { fiber, value, sig, ++fiber->sched_id };
fiber->gc.flags |= JANET_FIBER_FLAG_ROOT;
if (sig == JANET_SIGNAL_ERROR) fiber->gc.flags |= JANET_FIBER_EV_FLAG_CANCELED;
janet_q_push(&janet_vm.spawn, &t, sizeof(t));
if (soon) {
janet_q_push_head(&janet_vm.spawn, &t, sizeof(t));
} else {
janet_q_push(&janet_vm.spawn, &t, sizeof(t));
}
}
void janet_schedule_signal(JanetFiber *fiber, Janet value, JanetSignal sig) {
janet_schedule_general(fiber, value, sig, 0);
}
void janet_schedule_soon(JanetFiber *fiber, Janet value, JanetSignal sig) {
janet_schedule_general(fiber, value, sig, 1);
}
void janet_cancel(JanetFiber *fiber, Janet value) {
@@ -488,14 +538,6 @@ void janet_schedule(JanetFiber *fiber, Janet value) {
janet_schedule_signal(fiber, value, JANET_SIGNAL_OK);
}
void janet_fiber_did_resume(JanetFiber *fiber) {
/* Cancel any pending fibers */
if (fiber->waiting) {
fiber->waiting->machine(fiber->waiting, JANET_ASYNC_EVENT_CANCEL);
janet_unlisten(fiber->waiting, 0);
}
}
/* Mark all pending tasks */
void janet_ev_mark(void) {
@@ -524,16 +566,6 @@ void janet_ev_mark(void) {
janet_mark(janet_wrap_fiber(janet_vm.tq[i].curr_fiber));
}
}
/* Pending listeners */
for (size_t i = 0; i < janet_vm.listener_count; i++) {
JanetListenerState *state = janet_vm.listeners[i];
if (NULL != state->fiber) {
janet_mark(janet_wrap_fiber(state->fiber));
}
janet_stream_mark(state->stream, sizeof(JanetStream));
(state->machine)(state, JANET_ASYNC_EVENT_MARK);
}
}
static int janet_channel_push(JanetChannel *channel, Janet x, int mode);
@@ -554,15 +586,15 @@ static Janet make_supervisor_event(const char *name, JanetFiber *fiber, int thre
/* Common init code */
void janet_ev_init_common(void) {
janet_q_init(&janet_vm.spawn);
janet_vm.listener_count = 0;
janet_vm.listener_cap = 0;
janet_vm.listeners = NULL;
janet_vm.tq = NULL;
janet_vm.tq_count = 0;
janet_vm.tq_capacity = 0;
janet_table_init_raw(&janet_vm.threaded_abstracts, 0);
janet_table_init_raw(&janet_vm.active_tasks, 0);
janet_table_init_raw(&janet_vm.signal_handlers, 0);
janet_rng_seed(&janet_vm.ev_rng, 0);
janet_vm.listeners = janet_array(0);
janet_gcroot(janet_wrap_array(janet_vm.listeners));
#ifndef JANET_WINDOWS
pthread_attr_init(&janet_vm.new_thread_attr);
pthread_attr_setdetachstate(&janet_vm.new_thread_attr, PTHREAD_CREATE_DETACHED);
@@ -573,10 +605,10 @@ void janet_ev_init_common(void) {
void janet_ev_deinit_common(void) {
janet_q_deinit(&janet_vm.spawn);
janet_free(janet_vm.tq);
janet_free(janet_vm.listeners);
janet_vm.listeners = NULL;
janet_table_deinit(&janet_vm.threaded_abstracts);
janet_table_deinit(&janet_vm.active_tasks);
janet_table_deinit(&janet_vm.signal_handlers);
janet_vm.listeners = NULL;
#ifndef JANET_WINDOWS
pthread_attr_destroy(&janet_vm.new_thread_attr);
#endif
@@ -601,11 +633,27 @@ void janet_addtimeout(double sec) {
}
void janet_ev_inc_refcount(void) {
janet_vm.extra_listeners++;
#ifdef JANET_WINDOWS
#ifdef JANET_64
InterlockedIncrement64((int64_t volatile *) &janet_vm.extra_listeners);
#else
InterlockedIncrement((int32_t volatile *) &janet_vm.extra_listeners);
#endif
#else
__atomic_add_fetch(&janet_vm.extra_listeners, 1, __ATOMIC_RELAXED);
#endif
}
void janet_ev_dec_refcount(void) {
janet_vm.extra_listeners--;
#ifdef JANET_WINDOWS
#ifdef JANET_64
InterlockedDecrement64((int64_t volatile *) &janet_vm.extra_listeners);
#else
InterlockedDecrement((int32_t volatile *) &janet_vm.extra_listeners);
#endif
#else
__atomic_add_fetch(&janet_vm.extra_listeners, -1, __ATOMIC_RELAXED);
#endif
}
/* Channels */
@@ -1224,6 +1272,8 @@ static Janet janet_chanat_next(void *p, Janet key) {
static void janet_chanat_marshal(void *p, JanetMarshalContext *ctx) {
JanetChannel *channel = (JanetChannel *)p;
janet_marshal_byte(ctx, channel->is_threaded);
janet_marshal_abstract(ctx, channel);
janet_marshal_byte(ctx, channel->closed);
janet_marshal_int(ctx, channel->limit);
int32_t count = janet_q_count(&channel->items);
@@ -1242,7 +1292,13 @@ static void janet_chanat_marshal(void *p, JanetMarshalContext *ctx) {
}
static void *janet_chanat_unmarshal(JanetMarshalContext *ctx) {
JanetChannel *abst = janet_unmarshal_abstract(ctx, sizeof(JanetChannel));
uint8_t is_threaded = janet_unmarshal_byte(ctx);
JanetChannel *abst;
if (is_threaded) {
abst = janet_unmarshal_abstract_threaded(ctx, sizeof(JanetChannel));
} else {
abst = janet_unmarshal_abstract(ctx, sizeof(JanetChannel));
}
uint8_t is_closed = janet_unmarshal_byte(ctx);
int32_t limit = janet_unmarshal_int(ctx);
int32_t count = janet_unmarshal_int(ctx);
@@ -1276,8 +1332,7 @@ const JanetAbstractType janet_channel_type = {
void janet_loop1_impl(int has_timeout, JanetTimestamp timeout);
int janet_loop_done(void) {
return !(janet_vm.listener_count ||
(janet_vm.spawn.head != janet_vm.spawn.tail) ||
return !((janet_vm.spawn.head != janet_vm.spawn.tail) ||
janet_vm.tq_count ||
janet_vm.extra_listeners);
}
@@ -1304,8 +1359,10 @@ JanetFiber *janet_loop1(void) {
}
}
/* Run scheduled fibers */
/* Run scheduled fibers unless interrupts need to be handled. */
while (janet_vm.spawn.head != janet_vm.spawn.tail) {
/* Don't run until all interrupts have been marked as handled by calling janet_interpreter_interrupt_handled */
if (janet_vm.auto_suspend) break;
JanetTask task = {NULL, janet_wrap_nil(), JANET_SIGNAL_OK, 0};
janet_q_pop(&janet_vm.spawn, &task, sizeof(task));
if (task.fiber->gc.flags & JANET_FIBER_EV_FLAG_SUSPENDED) janet_ev_dec_refcount();
@@ -1334,13 +1391,12 @@ JanetFiber *janet_loop1(void) {
janet_stacktrace_ext(task.fiber, res, "");
}
if (sig == JANET_SIGNAL_INTERRUPT) {
/* On interrupts, return the interrupted fiber immediately */
return task.fiber;
}
}
/* Poll for events */
if (janet_vm.listener_count || janet_vm.tq_count || janet_vm.extra_listeners) {
if (janet_vm.tq_count || janet_vm.extra_listeners) {
JanetTimeout to;
memset(&to, 0, sizeof(to));
int has_timeout;
@@ -1359,7 +1415,7 @@ JanetFiber *janet_loop1(void) {
break;
}
/* Run polling implementation only if pending timeouts or pending events */
if (janet_vm.tq_count || janet_vm.listener_count || janet_vm.extra_listeners) {
if (janet_vm.tq_count || janet_vm.extra_listeners) {
janet_loop1_impl(has_timeout, to.when);
}
}
@@ -1451,8 +1507,8 @@ JanetListenerState *janet_listen(JanetStream *stream, JanetListener behavior, in
return state;
}
static void janet_unlisten(JanetListenerState *state, int is_gc) {
janet_unlisten_impl(state, is_gc);
static void janet_unlisten(JanetListenerState *state) {
janet_unlisten_impl(state);
}
void janet_loop1_impl(int has_timeout, JanetTimestamp to) {
@@ -1474,7 +1530,11 @@ void janet_loop1_impl(int has_timeout, JanetTimestamp to) {
}
BOOL result = GetQueuedCompletionStatus(janet_vm.iocp, &num_bytes_transfered, &completionKey, &overlapped, (DWORD) waittime);
if (result || overlapped) {
if (!result) {
return;
}
if (overlapped) {
if (0 == completionKey) {
/* Custom event */
JanetSelfPipeEvent *response = (JanetSelfPipeEvent *)(overlapped);
@@ -1485,24 +1545,22 @@ void janet_loop1_impl(int has_timeout, JanetTimestamp to) {
} else {
/* Normal event */
JanetStream *stream = (JanetStream *) completionKey;
JanetListenerState *state = stream->state;
while (state != NULL) {
if (state->tag == overlapped) {
state->event = overlapped;
state->bytes = num_bytes_transfered;
JanetAsyncStatus status = state->machine(state, JANET_ASYNC_EVENT_COMPLETE);
if (status == JANET_ASYNC_STATUS_DONE) {
janet_unlisten(state, 0);
}
break;
} else {
state = state->_next;
janet_assert(stream->handle != INVALID_HANDLE_VALUE, "got closed stream event");
JanetListenerState *state = NULL;
if (stream->read_state && stream->read_state->tag == overlapped) {
state = stream->read_state;
} else if (stream->write_state && stream->write_state->tag == overlapped) {
state = stream->write_state;
}
if (state != NULL) {
state->event = overlapped;
state->bytes = num_bytes_transfered;
JanetAsyncStatus status = state->machine(state, JANET_ASYNC_EVENT_COMPLETE);
if (status == JANET_ASYNC_STATUS_DONE) {
janet_unlisten(state);
}
}
/* Close the stream if requested and no more listeners are left */
if ((stream->flags & JANET_STREAM_TOCLOSE) && !stream->state) {
janet_stream_close(stream);
}
janet_stream_checktoclose(stream);
}
}
}
@@ -1517,26 +1575,17 @@ static JanetTimestamp ts_now(void) {
return res;
}
static int make_epoll_events(int mask) {
int events = 0;
if (mask & JANET_ASYNC_LISTEN_READ)
events |= EPOLLIN;
if (mask & JANET_ASYNC_LISTEN_WRITE)
events |= EPOLLOUT;
return events;
}
static void janet_epoll_sync_callback(JanetEVGenericMessage msg) {
JanetListenerState *state = msg.argp;
JanetAsyncStatus status1 = JANET_ASYNC_STATUS_NOT_DONE;
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_READ)
status2 = state->machine(state, JANET_ASYNC_EVENT_READ);
if (state == state->stream->read_state)
status1 = state->machine(state, JANET_ASYNC_EVENT_READ);
if (state == state->stream->write_state)
status2 = state->machine(state, JANET_ASYNC_EVENT_WRITE);
if (status1 == JANET_ASYNC_STATUS_DONE ||
status2 == JANET_ASYNC_STATUS_DONE) {
janet_unlisten(state, 0);
janet_unlisten(state);
} else {
/* Repost event */
janet_ev_post_event(NULL, janet_epoll_sync_callback, msg);
@@ -1545,11 +1594,13 @@ static void janet_epoll_sync_callback(JanetEVGenericMessage msg) {
/* Wait for the next event */
JanetListenerState *janet_listen(JanetStream *stream, JanetListener behavior, int mask, size_t size, void *user) {
int is_first = !(stream->state);
int is_first = !stream->read_state && !stream->write_state;
int op = is_first ? EPOLL_CTL_ADD : EPOLL_CTL_MOD;
JanetListenerState *state = janet_listen_impl(stream, behavior, mask, size, user);
struct epoll_event ev;
ev.events = make_epoll_events(state->stream->_mask);
ev.events = 0;
if (stream->read_state) ev.events |= EPOLLIN;
if (stream->write_state) ev.events |= EPOLLOUT;
ev.data.ptr = stream;
int status;
do {
@@ -1563,13 +1614,13 @@ JanetListenerState *janet_listen(JanetStream *stream, JanetListener behavior, in
* event to a file. So we just post a custom event to do the read/write
* asap. */
/* Use flag to indicate state is not registered in epoll */
state->_mask |= (1 << JANET_ASYNC_EVENT_COMPLETE);
state->flags = 1;
JanetEVGenericMessage msg = {0};
msg.argp = state;
janet_ev_post_event(NULL, janet_epoll_sync_callback, msg);
} else {
/* Unexpected error */
janet_unlisten_impl(state, 0);
janet_unlisten_impl(state);
janet_panicv(janet_ev_lasterr());
}
}
@@ -1577,15 +1628,19 @@ JanetListenerState *janet_listen(JanetStream *stream, JanetListener behavior, in
}
/* Tell system we are done listening for a certain event */
static void janet_unlisten(JanetListenerState *state, int is_gc) {
static void janet_unlisten(JanetListenerState *state) {
JanetStream *stream = state->stream;
if (!(stream->flags & JANET_STREAM_CLOSED)) {
if (stream && (stream->handle != -1)) {
/* Use flag to indicate state is not registered in epoll */
if (!(state->_mask & (1 << JANET_ASYNC_EVENT_COMPLETE))) {
int is_last = (state->_next == NULL && stream->state == state);
if (!state->flags) {
int is_read = (stream->read_state != state) && stream->read_state;
int is_write = (stream->write_state != state) && stream->write_state;
int is_last = !is_read && !is_write;
int op = is_last ? EPOLL_CTL_DEL : EPOLL_CTL_MOD;
struct epoll_event ev;
ev.events = make_epoll_events(stream->_mask & ~state->_mask);
ev.events = 0;
if (is_read) ev.events |= EPOLLIN;
if (is_write) ev.events |= EPOLLOUT;
ev.data.ptr = stream;
int status;
do {
@@ -1597,7 +1652,7 @@ static void janet_unlisten(JanetListenerState *state, int is_gc) {
}
}
/* Destroy state machine and free memory */
janet_unlisten_impl(state, is_gc);
janet_unlisten_impl(state);
}
#define JANET_EPOLL_MAX_EVENTS 64
@@ -1634,10 +1689,11 @@ void janet_loop1_impl(int has_timeout, JanetTimestamp timeout) {
} else {
JanetStream *stream = p;
int mask = events[i].events;
JanetListenerState *state = stream->state;
while (NULL != state) {
JanetListenerState *states[2] = {stream->read_state, stream->write_state};
for (int j = 0; j < 2; j++) {
JanetListenerState *state = states[j];
if (!state) continue;
state->event = events + i;
JanetListenerState *next_state = state->_next;
JanetAsyncStatus status1 = JANET_ASYNC_STATUS_NOT_DONE;
JanetAsyncStatus status2 = JANET_ASYNC_STATUS_NOT_DONE;
JanetAsyncStatus status3 = JANET_ASYNC_STATUS_NOT_DONE;
@@ -1653,14 +1709,11 @@ void janet_loop1_impl(int has_timeout, JanetTimestamp timeout) {
if (status1 == JANET_ASYNC_STATUS_DONE ||
status2 == JANET_ASYNC_STATUS_DONE ||
status3 == JANET_ASYNC_STATUS_DONE ||
status4 == JANET_ASYNC_STATUS_DONE)
janet_unlisten(state, 0);
state = next_state;
}
/* Close the stream if requested and no more listeners are left */
if ((stream->flags & JANET_STREAM_TOCLOSE) && !stream->state) {
janet_stream_close(stream);
status4 == JANET_ASYNC_STATUS_DONE) {
janet_unlisten(state);
}
}
janet_stream_checktoclose(stream);
}
}
}
@@ -1754,46 +1807,44 @@ JanetListenerState *janet_listen(JanetStream *stream, JanetListener behavior, in
struct kevent kev[2];
int length = 0;
if (state->stream->_mask & JANET_ASYNC_LISTEN_READ) {
if (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) {
if (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);
}
janet_assert(length, "expected to add kqueue events");
add_kqueue_events(kev, length);
return state;
}
static void janet_unlisten(JanetListenerState *state, int is_gc) {
static void janet_unlisten(JanetListenerState *state) {
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);
if (stream && (stream->handle != -1)) {
int is_read = (stream->read_state != state) && stream->read_state;
int is_write = (stream->write_state != state) && stream->write_state;
int is_last = !is_read && !is_write;
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);
int length = 0;
if (stream->read_state == state) {
EV_SETx(&kev[length], stream->handle, EVFILT_WRITE, op, 0, 0, stream);
length++;
}
if (stream->write_state == state) {
EV_SETx(&kev[length], stream->handle, EVFILT_READ, op, 0, 0, stream);
length++;
}
add_kqueue_events(kev, length);
}
janet_unlisten_impl(state, is_gc);
janet_unlisten_impl(state);
}
#define JANET_KQUEUE_MAX_EVENTS 64
@@ -1833,14 +1884,14 @@ void janet_loop1_impl(int has_timeout, JanetTimestamp timeout) {
janet_ev_handle_selfpipe();
} else {
JanetStream *stream = p;
JanetListenerState *state = stream->state;
while (NULL != state) {
JanetListenerState *next_state = state->_next;
JanetListenerState *states[2] = {stream->read_state, stream->write_state};
for (int j = 0; j < 2; j++) {
JanetListenerState *state = states[j];
if (!state) continue;
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);
@@ -1854,15 +1905,11 @@ void janet_loop1_impl(int has_timeout, JanetTimestamp timeout) {
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;
}
/* Close the stream if requested and no more listeners are left */
if ((stream->flags & JANET_STREAM_TOCLOSE) && !stream->state) {
janet_stream_close(stream);
statuses[3] == JANET_ASYNC_STATUS_DONE) {
janet_unlisten(state);
}
}
janet_stream_checktoclose(stream);
}
}
}
@@ -1900,20 +1947,11 @@ static JanetTimestamp ts_now(void) {
return res;
}
static int make_poll_events(int mask) {
int events = 0;
if (mask & JANET_ASYNC_LISTEN_READ)
events |= POLLIN;
if (mask & JANET_ASYNC_LISTEN_WRITE)
events |= POLLOUT;
return events;
}
/* Wait for the next event */
JanetListenerState *janet_listen(JanetStream *stream, JanetListener behavior, int mask, size_t size, void *user) {
size_t oldsize = janet_vm.listener_cap;
size_t oldsize = janet_vm.listeners->capacity;
JanetListenerState *state = janet_listen_impl(stream, behavior, mask, size, user);
size_t newsize = janet_vm.listener_cap;
size_t newsize = janet_vm.listeners->capacity;
if (newsize > oldsize) {
janet_vm.fds = janet_realloc(janet_vm.fds, (newsize + 1) * sizeof(struct pollfd));
if (NULL == janet_vm.fds) {
@@ -1922,15 +1960,19 @@ JanetListenerState *janet_listen(JanetStream *stream, JanetListener behavior, in
}
struct pollfd ev;
ev.fd = stream->handle;
ev.events = make_poll_events(state->stream->_mask);
ev.events = 0;
if (stream->read_state) ev.events |= POLLIN;
if (stream->write_state) ev.events |= POLLOUT;
ev.revents = 0;
janet_vm.fds[state->_index + 1] = ev;
janet_vm.fds[state->index + 1] = ev;
return state;
}
static void janet_unlisten(JanetListenerState *state, int is_gc) {
janet_vm.fds[state->_index + 1] = janet_vm.fds[janet_vm.listener_count];
janet_unlisten_impl(state, is_gc);
static void janet_unlisten(JanetListenerState *state) {
if (state->stream) {
janet_vm.fds[state->index + 1] = janet_vm.fds[janet_vm.listeners->count];
}
janet_unlisten_impl(state);
}
void janet_loop1_impl(int has_timeout, JanetTimestamp timeout) {
@@ -1942,7 +1984,7 @@ void janet_loop1_impl(int has_timeout, JanetTimestamp timeout) {
JanetTimestamp now = ts_now();
to = now > timeout ? 0 : (int)(timeout - now);
}
ready = poll(janet_vm.fds, janet_vm.listener_count + 1, to);
ready = poll(janet_vm.fds, janet_vm.listeners->count + 1, to);
} while (ready == -1 && errno == EINTR);
if (ready == -1) {
JANET_EXIT("failed to poll events");
@@ -1955,10 +1997,10 @@ void janet_loop1_impl(int has_timeout, JanetTimestamp timeout) {
}
/* Step state machines */
for (size_t i = 0; i < janet_vm.listener_count; i++) {
for (int32_t i = 0; i < janet_vm.listeners->count; i++) {
struct pollfd *pfd = janet_vm.fds + i + 1;
/* Skip fds where nothing interesting happened */
JanetListenerState *state = janet_vm.listeners[i];
JanetListenerState *state = (JanetListenerState *) janet_unwrap_abstract(janet_vm.listeners->data[i]);
/* Normal event */
int mask = pfd->revents;
JanetAsyncStatus status1 = JANET_ASYNC_STATUS_NOT_DONE;
@@ -1978,12 +2020,10 @@ void janet_loop1_impl(int has_timeout, JanetTimestamp timeout) {
if (status1 == JANET_ASYNC_STATUS_DONE ||
status2 == JANET_ASYNC_STATUS_DONE ||
status3 == JANET_ASYNC_STATUS_DONE ||
status4 == JANET_ASYNC_STATUS_DONE)
janet_unlisten(state, 0);
/* Close the stream if requested and no more listeners are left */
if ((stream->flags & JANET_STREAM_TOCLOSE) && !stream->state) {
janet_stream_close(stream);
status4 == JANET_ASYNC_STATUS_DONE) {
janet_unlisten(state);
}
janet_stream_checktoclose(stream);
}
}
@@ -2470,8 +2510,7 @@ void janet_ev_recvfrom(JanetStream *stream, JanetBuffer *buf, int32_t nbytes, in
typedef enum {
JANET_ASYNC_WRITEMODE_WRITE,
JANET_ASYNC_WRITEMODE_SEND,
JANET_ASYNC_WRITEMODE_SENDTO,
JANET_ASYNC_WRITEMODE_CONNECT
JANET_ASYNC_WRITEMODE_SENDTO
} JanetWriteMode;
typedef struct {
@@ -2495,36 +2534,12 @@ typedef struct {
#endif
} StateWrite;
static JanetAsyncStatus handle_connect(JanetListenerState *s) {
#ifdef JANET_WINDOWS
int res = 0;
int size = sizeof(res);
int r = getsockopt((SOCKET)s->stream->handle, SOL_SOCKET, SO_ERROR, (char *)&res, &size);
#else
int res = 0;
socklen_t size = sizeof res;
int r = getsockopt(s->stream->handle, SOL_SOCKET, SO_ERROR, &res, &size);
#endif
if (r == 0) {
if (res == 0) {
janet_schedule(s->fiber, janet_wrap_abstract(s->stream));
} else {
s->stream->flags |= JANET_STREAM_TOCLOSE;
janet_cancel(s->fiber, janet_cstringv(strerror(res)));
}
} else {
s->stream->flags |= JANET_STREAM_TOCLOSE;
janet_cancel(s->fiber, janet_ev_lasterr());
}
return JANET_ASYNC_STATUS_DONE;
}
JanetAsyncStatus ev_machine_write(JanetListenerState *s, JanetAsyncEvent event) {
StateWrite *state = (StateWrite *) s;
switch (event) {
default:
break;
case JANET_ASYNC_EVENT_MARK:
case JANET_ASYNC_EVENT_MARK: {
janet_mark(state->is_buffer
? janet_wrap_buffer(state->src.buf)
: janet_wrap_string(state->src.str));
@@ -2532,6 +2547,7 @@ JanetAsyncStatus ev_machine_write(JanetListenerState *s, JanetAsyncEvent event)
janet_mark(janet_wrap_abstract(state->dest_abst));
}
break;
}
case JANET_ASYNC_EVENT_CLOSE:
janet_cancel(s->fiber, janet_cstringv("stream closed"));
return JANET_ASYNC_STATUS_DONE;
@@ -2548,11 +2564,6 @@ JanetAsyncStatus ev_machine_write(JanetListenerState *s, JanetAsyncEvent event)
}
break;
case JANET_ASYNC_EVENT_USER: {
#ifdef JANET_NET
if (state->mode == JANET_ASYNC_WRITEMODE_CONNECT) {
return handle_connect(s);
}
#endif
/* Begin write */
int32_t len;
const uint8_t *bytes;
@@ -2616,11 +2627,6 @@ JanetAsyncStatus ev_machine_write(JanetListenerState *s, JanetAsyncEvent event)
janet_cancel(s->fiber, janet_cstringv("stream hup"));
return JANET_ASYNC_STATUS_DONE;
case JANET_ASYNC_EVENT_WRITE: {
#ifdef JANET_NET
if (state->mode == JANET_ASYNC_WRITEMODE_CONNECT) {
return handle_connect(s);
}
#endif
int32_t start, len;
const uint8_t *bytes;
start = state->start;
@@ -2722,10 +2728,6 @@ void janet_ev_sendto_buffer(JanetStream *stream, JanetBuffer *buf, void *dest, i
void janet_ev_sendto_string(JanetStream *stream, JanetString str, void *dest, int flags) {
janet_ev_write_generic(stream, (void *) str, dest, JANET_ASYNC_WRITEMODE_SENDTO, 0, flags);
}
void janet_ev_connect(JanetStream *stream, int flags) {
janet_ev_write_generic(stream, NULL, NULL, JANET_ASYNC_WRITEMODE_CONNECT, 0, flags);
}
#endif
/* For a pipe ID */

View File

@@ -1530,6 +1530,22 @@ JANET_CORE_FN(cfun_ffi_pointer_buffer,
return janet_wrap_buffer(janet_pointer_buffer_unsafe(offset_pointer, capacity, count));
}
JANET_CORE_FN(cfun_ffi_pointer_cfunction,
"(ffi/pointer-cfunction pointer &opt name source-file source-line)",
"Create a C Function from a raw pointer. Optionally give the cfunction a name and "
"source location for stack traces and debugging.") {
janet_sandbox_assert(JANET_SANDBOX_FFI_USE);
janet_arity(argc, 1, 4);
void *pointer = janet_getpointer(argv, 0);
const char *name = janet_optcstring(argv, argc, 1, NULL);
const char *source = janet_optcstring(argv, argc, 2, NULL);
int32_t line = janet_optinteger(argv, argc, 3, -1);
if ((name != NULL) || (source != NULL) || (line != -1)) {
janet_registry_put((JanetCFunction) pointer, name, NULL, source, line);
}
return janet_wrap_cfunction((JanetCFunction) pointer);
}
JANET_CORE_FN(cfun_ffi_supported_calling_conventions,
"(ffi/calling-conventions)",
"Get an array of all supported calling conventions on the current arhcitecture. Some architectures may have some FFI "
@@ -1567,6 +1583,7 @@ void janet_lib_ffi(JanetTable *env) {
JANET_CORE_REG("ffi/malloc", cfun_ffi_malloc),
JANET_CORE_REG("ffi/free", cfun_ffi_free),
JANET_CORE_REG("ffi/pointer-buffer", cfun_ffi_pointer_buffer),
JANET_CORE_REG("ffi/pointer-cfunction", cfun_ffi_pointer_cfunction),
JANET_CORE_REG("ffi/calling-conventions", cfun_ffi_supported_calling_conventions),
JANET_REG_END
};

View File

@@ -39,8 +39,8 @@ static void fiber_reset(JanetFiber *fiber) {
fiber->env = NULL;
fiber->last_value = janet_wrap_nil();
#ifdef JANET_EV
fiber->waiting = NULL;
fiber->sched_id = 0;
fiber->waiting = NULL;
fiber->supervisor_channel = NULL;
#endif
janet_fiber_set_status(fiber, JANET_STATUS_NEW);
@@ -85,7 +85,6 @@ JanetFiber *janet_fiber_reset(JanetFiber *fiber, JanetFunction *callee, int32_t
if (janet_fiber_funcframe(fiber, callee)) return NULL;
janet_fiber_frame(fiber)->flags |= JANET_STACKFRAME_ENTRANCE;
#ifdef JANET_EV
fiber->waiting = NULL;
fiber->supervisor_channel = NULL;
#endif
return fiber;

View File

@@ -268,6 +268,9 @@ recur:
if (fiber->supervisor_channel) {
janet_mark_abstract(fiber->supervisor_channel);
}
if (fiber->waiting) {
janet_mark_abstract(fiber->waiting);
}
#endif
/* Explicit tail recursion */
@@ -370,14 +373,15 @@ void janet_sweep() {
if (head->type->gc) {
janet_assert(!head->type->gc(head->data, head->size), "finalizer failed");
}
/* Mark as tombstone in place */
items[i].key = janet_wrap_nil();
items[i].value = janet_wrap_false();
janet_vm.threaded_abstracts.deleted++;
janet_vm.threaded_abstracts.count--;
/* Free memory */
janet_free(janet_abstract_head(abst));
}
/* Mark as tombstone in place */
items[i].key = janet_wrap_nil();
items[i].value = janet_wrap_false();
janet_vm.threaded_abstracts.deleted++;
janet_vm.threaded_abstracts.count--;
}
/* Reset for next sweep */
@@ -437,6 +441,7 @@ void janet_collect(void) {
uint32_t i;
if (janet_vm.gc_suspend) return;
depth = JANET_RECURSION_GUARD;
janet_vm.gc_mark_phase = 1;
/* Try and prevent many major collections back to back.
* A full collection will take O(janet_vm.block_count) time.
* If we have a large heap, make sure our interval is not too
@@ -456,6 +461,7 @@ void janet_collect(void) {
Janet x = janet_vm.roots[--janet_vm.root_count];
janet_mark(x);
}
janet_vm.gc_mark_phase = 0;
janet_sweep();
janet_vm.next_collection = 0;
janet_free_all_scratch();
@@ -559,7 +565,9 @@ void janet_gcunlock(int handle) {
janet_vm.gc_suspend = handle;
}
/* Scratch memory API */
/* Scratch memory API
* Scratch memory allocations do not need to be free (but optionally can be), and will be automatically cleaned
* up in the next call to janet_collect. */
void *janet_smalloc(size_t size) {
JanetScratch *s = janet_malloc(sizeof(JanetScratch) + size);

View File

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

View File

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

View File

@@ -154,7 +154,7 @@ static void pushbytes(MarshalState *st, const uint8_t *bytes, int32_t len) {
janet_buffer_push_bytes(st->buf, bytes, len);
}
static void pushpointer(MarshalState *st, void *ptr) {
static void pushpointer(MarshalState *st, const void *ptr) {
janet_buffer_push_bytes(st->buf, (const uint8_t *) &ptr, sizeof(ptr));
}
@@ -246,6 +246,7 @@ static void marshal_one_def(MarshalState *st, JanetFuncDef *def, int flags) {
}
/* Add to lookup */
janet_v_push(st->seen_defs, def);
pushint(st, def->flags);
pushint(st, def->slotcount);
pushint(st, def->arity);
@@ -266,14 +267,14 @@ static void marshal_one_def(MarshalState *st, JanetFuncDef *def, int flags) {
/* marshal constants */
for (int32_t i = 0; i < def->constants_length; i++)
marshal_one(st, def->constants[i], flags);
marshal_one(st, def->constants[i], flags + 1);
/* Marshal symbol map, if needed */
for (int32_t i = 0; i < def->symbolmap_length; i++) {
pushint(st, (int32_t) def->symbolmap[i].birth_pc);
pushint(st, (int32_t) def->symbolmap[i].death_pc);
pushint(st, (int32_t) def->symbolmap[i].slot_index);
marshal_one(st, janet_wrap_symbol(def->symbolmap[i].symbol), flags);
marshal_one(st, janet_wrap_symbol(def->symbolmap[i].symbol), flags + 1);
}
/* marshal the bytecode */
@@ -362,6 +363,15 @@ void janet_marshal_int(JanetMarshalContext *ctx, int32_t value) {
pushint(st, value);
}
/* Only use in unsafe - don't marshal pointers otherwise */
void janet_marshal_ptr(JanetMarshalContext *ctx, const void *ptr) {
if (!(ctx->flags & JANET_MARSHAL_UNSAFE)) {
janet_panic("can only marshal pointers in unsafe mode");
}
MarshalState *st = (MarshalState *)(ctx->m_state);
pushpointer(st, ptr);
}
void janet_marshal_byte(JanetMarshalContext *ctx, uint8_t value) {
MarshalState *st = (MarshalState *)(ctx->m_state);
pushbyte(st, value);
@@ -378,18 +388,27 @@ void janet_marshal_janet(JanetMarshalContext *ctx, Janet x) {
marshal_one(st, x, ctx->flags + 1);
}
#ifdef JANET_MARSHAL_DEBUG
#define MARK_SEEN() \
do { if (st->maybe_cycles) { \
Janet _check = janet_table_get(&st->seen, x); \
if (!janet_checktype(_check, JANET_NIL)) janet_eprintf("double MARK_SEEN on %v\n", x); \
janet_eprintf("made reference %d (%t) to %v\n", st->nextid, x, x); \
janet_table_put(&st->seen, x, janet_wrap_integer(st->nextid++)); \
} } while (0)
#else
#define MARK_SEEN() \
do { if (st->maybe_cycles) { \
janet_table_put(&st->seen, x, janet_wrap_integer(st->nextid++)); \
} } while (0)
#endif
void janet_marshal_abstract(JanetMarshalContext *ctx, void *abstract) {
MarshalState *st = (MarshalState *)(ctx->m_state);
if (st->maybe_cycles) {
janet_table_put(&st->seen,
janet_wrap_abstract(abstract),
janet_wrap_integer(st->nextid++));
}
Janet x = janet_wrap_abstract(abstract);
MARK_SEEN();
}
#define MARK_SEEN() \
do { if (st->maybe_cycles) janet_table_put(&st->seen, x, janet_wrap_integer(st->nextid++)); } while (0)
static void marshal_one_abstract(MarshalState *st, Janet x, int flags) {
void *abstract = janet_unwrap_abstract(x);
#ifdef JANET_EV
@@ -411,7 +430,7 @@ static void marshal_one_abstract(MarshalState *st, Janet x, int flags) {
if (at->marshal) {
pushbyte(st, LB_ABSTRACT);
marshal_one(st, janet_csymbolv(at->name), flags + 1);
JanetMarshalContext context = {st, NULL, flags, NULL, at};
JanetMarshalContext context = {st, NULL, flags + 1, NULL, at};
at->marshal(abstract, &context);
} else {
janet_panicf("cannot marshal %p", x);
@@ -728,9 +747,22 @@ static uint64_t read64(UnmarshalState *st, const uint8_t **atdata) {
return ret;
}
#ifdef JANET_MARSHAL_DEBUG
static void dump_reference_table(UnmarshalState *st) {
for (int32_t i = 0; i < janet_v_count(st->lookup); i++) {
janet_eprintf(" reference %d (%t) = %v\n", i, st->lookup[i], st->lookup[i]);
}
}
#endif
/* Assert a janet type */
static void janet_asserttype(Janet x, JanetType t) {
static void janet_asserttype(Janet x, JanetType t, UnmarshalState *st) {
if (!janet_checktype(x, t)) {
#ifdef JANET_MARSHAL_DEBUG
dump_reference_table(st);
#else
(void) st;
#endif
janet_panicf("expected type %T, got %v", 1 << t, x);
}
}
@@ -782,7 +814,7 @@ static const uint8_t *unmarshal_one_env(
Janet fiberv;
/* On stack variant */
data = unmarshal_one(st, data, &fiberv, flags);
janet_asserttype(fiberv, JANET_FIBER);
janet_asserttype(fiberv, JANET_FIBER, st);
env->as.fiber = janet_unwrap_fiber(fiberv);
/* Negative offset indicates untrusted input */
env->offset = -offset;
@@ -880,13 +912,13 @@ static const uint8_t *unmarshal_one_def(
if (def->flags & JANET_FUNCDEF_FLAG_HASNAME) {
Janet x;
data = unmarshal_one(st, data, &x, flags + 1);
janet_asserttype(x, JANET_STRING);
janet_asserttype(x, JANET_STRING, st);
def->name = janet_unwrap_string(x);
}
if (def->flags & JANET_FUNCDEF_FLAG_HASSOURCE) {
Janet x;
data = unmarshal_one(st, data, &x, flags + 1);
janet_asserttype(x, JANET_STRING);
janet_asserttype(x, JANET_STRING, st);
def->source = janet_unwrap_string(x);
}
@@ -916,8 +948,9 @@ static const uint8_t *unmarshal_one_def(
def->symbolmap[i].slot_index = (uint32_t) readint(st, &data);
Janet value;
data = unmarshal_one(st, data, &value, flags + 1);
if (!janet_checktype(value, JANET_SYMBOL))
janet_panic("expected symbol in symbol map");
if (!janet_checktype(value, JANET_SYMBOL)) {
janet_panicf("corrupted symbolmap when unmarshalling debug info, got %v", value);
}
def->symbolmap[i].symbol = janet_unwrap_symbol(value);
}
def->symbolmap_length = (uint32_t) symbolmap_length;
@@ -1015,7 +1048,6 @@ static const uint8_t *unmarshal_one_fiber(
fiber->env = NULL;
fiber->last_value = janet_wrap_nil();
#ifdef JANET_EV
fiber->waiting = NULL;
fiber->sched_id = 0;
fiber->supervisor_channel = NULL;
#endif
@@ -1066,7 +1098,7 @@ static const uint8_t *unmarshal_one_fiber(
/* Get function */
Janet funcv;
data = unmarshal_one(st, data, &funcv, flags + 1);
janet_asserttype(funcv, JANET_FUNCTION);
janet_asserttype(funcv, JANET_FUNCTION, st);
func = janet_unwrap_function(funcv);
def = func->def;
@@ -1112,7 +1144,7 @@ static const uint8_t *unmarshal_one_fiber(
Janet envv;
fiber_flags &= ~JANET_FIBER_FLAG_HASENV;
data = unmarshal_one(st, data, &envv, flags + 1);
janet_asserttype(envv, JANET_TABLE);
janet_asserttype(envv, JANET_TABLE, st);
fiber_env = janet_unwrap_table(envv);
}
@@ -1121,7 +1153,7 @@ static const uint8_t *unmarshal_one_fiber(
Janet fiberv;
fiber_flags &= ~JANET_FIBER_FLAG_HASCHILD;
data = unmarshal_one(st, data, &fiberv, flags + 1);
janet_asserttype(fiberv, JANET_FIBER);
janet_asserttype(fiberv, JANET_FIBER, st);
fiber->child = janet_unwrap_fiber(fiberv);
}
@@ -1165,6 +1197,18 @@ int64_t janet_unmarshal_int64(JanetMarshalContext *ctx) {
return read64(st, &(ctx->data));
}
void *janet_unmarshal_ptr(JanetMarshalContext *ctx) {
if (!(ctx->flags & JANET_MARSHAL_UNSAFE)) {
janet_panic("can only unmarshal pointers in unsafe mode");
}
UnmarshalState *st = (UnmarshalState *)(ctx->u_state);
void *ptr;
MARSH_EOS(st, ctx->data + sizeof(void *) - 1);
memcpy((char *) &ptr, ctx->data, sizeof(void *));
ctx->data += sizeof(void *);
return ptr;
}
uint8_t janet_unmarshal_byte(JanetMarshalContext *ctx) {
UnmarshalState *st = (UnmarshalState *)(ctx->u_state);
MARSH_EOS(st, ctx->data);
@@ -1200,6 +1244,18 @@ void *janet_unmarshal_abstract(JanetMarshalContext *ctx, size_t size) {
return p;
}
void *janet_unmarshal_abstract_threaded(JanetMarshalContext *ctx, size_t size) {
#ifdef JANET_THREADS
void *p = janet_abstract_threaded(ctx->at, size);
janet_unmarshal_abstract_reuse(ctx, p);
return p;
#else
(void) ctx;
(void) size;
janet_panic("threaded abstracts not supported");
#endif
}
static const uint8_t *unmarshal_one_abstract(UnmarshalState *st, const uint8_t *data, Janet *out, int flags) {
Janet key;
data = unmarshal_one(st, data, &key, flags + 1);
@@ -1207,7 +1263,9 @@ static const uint8_t *unmarshal_one_abstract(UnmarshalState *st, const uint8_t *
if (at == NULL) janet_panic("unknown abstract type");
if (at->unmarshal) {
JanetMarshalContext context = {NULL, st, flags, data, at};
*out = janet_wrap_abstract(at->unmarshal(&context));
void *abst = at->unmarshal(&context);
janet_assert(abst != NULL, "null pointer abstract");
*out = janet_wrap_abstract(abst);
if (context.at != NULL) {
janet_panic("janet_unmarshal_abstract not called");
}
@@ -1308,7 +1366,7 @@ static const uint8_t *unmarshal_one(
}
case LB_FIBER: {
JanetFiber *fiber;
data = unmarshal_one_fiber(st, data + 1, &fiber, flags);
data = unmarshal_one_fiber(st, data + 1, &fiber, flags + 1);
*out = janet_wrap_fiber(fiber);
return data;
}
@@ -1323,6 +1381,9 @@ static const uint8_t *unmarshal_one(
func = janet_gcalloc(JANET_MEMORY_FUNCTION, sizeof(JanetFunction) +
len * sizeof(JanetFuncEnv));
func->def = NULL;
for (int32_t i = 0; i < len; i++) {
func->envs[i] = NULL;
}
*out = janet_wrap_function(func);
janet_v_push(st->lookup, *out);
data = unmarshal_one_def(st, data, &def, flags + 1);
@@ -1376,7 +1437,7 @@ static const uint8_t *unmarshal_one(
if (lead == LB_STRUCT_PROTO) {
Janet proto;
data = unmarshal_one(st, data, &proto, flags + 1);
janet_asserttype(proto, JANET_STRUCT);
janet_asserttype(proto, JANET_STRUCT, st);
janet_struct_proto(struct_) = janet_unwrap_struct(proto);
}
for (int32_t i = 0; i < len; i++) {
@@ -1399,7 +1460,7 @@ static const uint8_t *unmarshal_one(
if (lead == LB_TABLE_PROTO) {
Janet proto;
data = unmarshal_one(st, data, &proto, flags + 1);
janet_asserttype(proto, JANET_TABLE);
janet_asserttype(proto, JANET_TABLE, st);
t->proto = janet_unwrap_table(proto);
}
for (int32_t i = 0; i < len; i++) {

View File

@@ -111,6 +111,62 @@ static void janet_net_socknoblock(JSock s) {
#endif
}
/* State machine for async connect */
typedef struct {
JanetListenerState head;
int did_connect;
} NetStateConnect;
JanetAsyncStatus net_machine_connect(JanetListenerState *s, JanetAsyncEvent event) {
NetStateConnect *state = (NetStateConnect *)s;
switch (event) {
default:
return JANET_ASYNC_STATUS_NOT_DONE;
case JANET_ASYNC_EVENT_CLOSE:
janet_cancel(s->fiber, janet_cstringv("stream closed"));
return JANET_ASYNC_STATUS_DONE;
case JANET_ASYNC_EVENT_HUP:
case JANET_ASYNC_EVENT_ERR:
case JANET_ASYNC_EVENT_COMPLETE:
case JANET_ASYNC_EVENT_WRITE:
case JANET_ASYNC_EVENT_USER:
break;
}
JanetStream *stream = s->stream;
#ifdef JANET_WINDOWS
int res = 0;
int size = sizeof(res);
int r = getsockopt((SOCKET)stream->handle, SOL_SOCKET, SO_ERROR, (char *)&res, &size);
#else
int res = 0;
socklen_t size = sizeof res;
int r = getsockopt(stream->handle, SOL_SOCKET, SO_ERROR, &res, &size);
#endif
if (r == 0) {
if (res == 0) {
state->did_connect = 1;
janet_schedule(s->fiber, janet_wrap_abstract(s->stream));
} else {
janet_cancel(s->fiber, janet_cstringv(strerror(res)));
stream->flags |= JANET_STREAM_TOCLOSE;
}
} else {
janet_cancel(s->fiber, janet_ev_lasterr());
stream->flags |= JANET_STREAM_TOCLOSE;
}
return JANET_ASYNC_STATUS_DONE;
}
static void net_sched_connect(JanetStream *stream) {
JanetListenerState *s = janet_listen(stream, net_machine_connect, JANET_ASYNC_LISTEN_WRITE, sizeof(NetStateConnect), NULL);
NetStateConnect *state = (NetStateConnect *)s;
state->did_connect = 0;
#ifdef JANET_WINDOWS
net_machine_connect(s, JANET_ASYNC_EVENT_USER);
#endif
}
/* State machine for accepting connections. */
#ifdef JANET_WINDOWS
@@ -496,7 +552,7 @@ JANET_CORE_FN(cfun_net_connect,
}
#endif
if (status != 0) {
if (status) {
#ifdef JANET_WINDOWS
if (err != WSAEWOULDBLOCK) {
#else
@@ -508,9 +564,7 @@ JANET_CORE_FN(cfun_net_connect,
}
}
/* Handle the connect() result in the event loop*/
janet_ev_connect(stream, MSG_NOSIGNAL);
net_sched_connect(stream);
janet_await();
}

View File

@@ -706,6 +706,18 @@ static const struct keyword_signal signal_keywords[] = {
#endif
{NULL, 0},
};
static int get_signal_kw(const Janet *argv, int32_t n) {
JanetKeyword signal_kw = janet_getkeyword(argv, n);
const struct keyword_signal *ptr = signal_keywords;
while (ptr->keyword) {
if (!janet_cstrcmp(signal_kw, ptr->keyword)) {
return ptr->signal;
}
ptr++;
}
janet_panicf("undefined signal %v", argv[n]);
}
#endif
JANET_CORE_FN(os_proc_kill,
@@ -731,18 +743,7 @@ JANET_CORE_FN(os_proc_kill,
#else
int signal = -1;
if (argc == 3) {
JanetKeyword signal_kw = janet_getkeyword(argv, 2);
const struct keyword_signal *ptr = signal_keywords;
while (ptr->keyword) {
if (!janet_cstrcmp(signal_kw, ptr->keyword)) {
signal = ptr->signal;
break;
}
ptr++;
}
if (signal == -1) {
janet_panic("undefined signal");
}
signal = get_signal_kw(argv, 2);
}
int status = kill(proc->pid, signal == -1 ? SIGKILL : signal);
if (status) {
@@ -803,6 +804,108 @@ static void close_handle(JanetHandle handle) {
#endif
}
#ifdef JANET_EV
#ifndef JANET_WINDOWS
static void janet_signal_callback(JanetEVGenericMessage msg) {
int sig = msg.tag;
if (msg.argi) janet_interpreter_interrupt_handled(NULL);
Janet handlerv = janet_table_get(&janet_vm.signal_handlers, janet_wrap_integer(sig));
if (!janet_checktype(handlerv, JANET_FUNCTION)) {
/* Let another thread/process try to handle this */
sigset_t set;
sigemptyset(&set);
sigaddset(&set, sig);
#ifdef JANET_THREADS
pthread_sigmask(SIG_BLOCK, &set, NULL);
#else
sigprocmask(SIG_BLOCK, &set, NULL);
#endif
raise(sig);
return;
}
JanetFunction *handler = janet_unwrap_function(handlerv);
JanetFiber *fiber = janet_fiber(handler, 64, 0, NULL);
janet_schedule_soon(fiber, janet_wrap_nil(), JANET_SIGNAL_OK);
janet_ev_dec_refcount();
}
static void janet_signal_trampoline_no_interrupt(int sig) {
/* Do not interact with global janet state here except for janet_ev_post_event, unsafe! */
JanetEVGenericMessage msg;
memset(&msg, 0, sizeof(msg));
msg.tag = sig;
janet_ev_post_event(&janet_vm, janet_signal_callback, msg);
janet_ev_inc_refcount();
}
static void janet_signal_trampoline(int sig) {
/* Do not interact with global janet state here except for janet_ev_post_event, unsafe! */
JanetEVGenericMessage msg;
memset(&msg, 0, sizeof(msg));
msg.tag = sig;
msg.argi = 1;
janet_interpreter_interrupt(NULL);
janet_ev_post_event(&janet_vm, janet_signal_callback, msg);
janet_ev_inc_refcount();
}
#endif
JANET_CORE_FN(os_sigaction,
"(os/sigaction which &opt handler interrupt-interpreter)",
"Add a signal handler for a given action. Use nil for the `handler` argument to remove a signal handler. "
"All signal handlers are the same as supported by `os/proc-kill`.") {
janet_sandbox_assert(JANET_SANDBOX_SIGNAL);
janet_arity(argc, 1, 3);
#ifdef JANET_WINDOWS
(void) argv;
janet_panic("unsupported on this platform");
#else
/* TODO - per thread signal masks */
int rc;
int sig = get_signal_kw(argv, 0);
JanetFunction *handler = janet_optfunction(argv, argc, 1, NULL);
int can_interrupt = janet_optboolean(argv, argc, 2, 0);
Janet oldhandler = janet_table_get(&janet_vm.signal_handlers, janet_wrap_integer(sig));
if (!janet_checktype(oldhandler, JANET_NIL)) {
janet_gcunroot(oldhandler);
}
if (NULL != handler) {
Janet handlerv = janet_wrap_function(handler);
janet_gcroot(handlerv);
janet_table_put(&janet_vm.signal_handlers, janet_wrap_integer(sig), handlerv);
} else {
janet_table_put(&janet_vm.signal_handlers, janet_wrap_integer(sig), janet_wrap_nil());
}
struct sigaction action;
sigset_t mask;
sigfillset(&mask);
memset(&action, 0, sizeof(action));
if (can_interrupt) {
#ifdef JANET_NO_INTERPRETER_INTERRUPT
janet_panic("interpreter interrupt not enabled");
#else
action.sa_handler = janet_signal_trampoline;
#endif
} else {
action.sa_handler = janet_signal_trampoline_no_interrupt;
}
action.sa_mask = mask;
RETRY_EINTR(rc, sigaction(sig, &action, NULL));
sigset_t set;
sigemptyset(&set);
sigaddset(&set, sig);
#ifdef JANET_THREADS
pthread_sigmask(SIG_UNBLOCK, &set, NULL);
#else
sigprocmask(SIG_UNBLOCK, &set, NULL);
#endif
return janet_wrap_nil();
#endif
}
#endif
/* Create piped file for os/execute and os/spawn. Need to be careful that we mark
the error flag if we can't create pipe and don't leak handles. *handle will be cleaned
up by the calling function. If everything goes well, *handle is owned by the calling function,
@@ -1145,14 +1248,16 @@ static Janet os_execute_impl(int32_t argc, Janet *argv, int is_spawn) {
posix_spawn_file_actions_addclose(&actions, pipe_in);
} else if (new_in != JANET_HANDLE_NONE && new_in != 0) {
posix_spawn_file_actions_adddup2(&actions, new_in, 0);
posix_spawn_file_actions_addclose(&actions, new_in);
if (new_in != new_out && new_in != new_err)
posix_spawn_file_actions_addclose(&actions, new_in);
}
if (pipe_out != JANET_HANDLE_NONE) {
posix_spawn_file_actions_adddup2(&actions, pipe_out, 1);
posix_spawn_file_actions_addclose(&actions, pipe_out);
} else if (new_out != JANET_HANDLE_NONE && new_out != 1) {
posix_spawn_file_actions_adddup2(&actions, new_out, 1);
posix_spawn_file_actions_addclose(&actions, new_out);
if (new_out != new_err)
posix_spawn_file_actions_addclose(&actions, new_out);
}
if (pipe_err != JANET_HANDLE_NONE) {
posix_spawn_file_actions_adddup2(&actions, pipe_err, 2);
@@ -1332,8 +1437,8 @@ JANET_CORE_FN(os_getenv,
janet_sandbox_assert(JANET_SANDBOX_ENV);
janet_arity(argc, 1, 2);
const char *cstr = janet_getcstring(argv, 0);
const char *res = getenv(cstr);
janet_lock_environ();
const char *res = getenv(cstr);
Janet ret = res
? janet_cstringv(res)
: argc == 2
@@ -2534,6 +2639,7 @@ void janet_lib_os(JanetTable *env) {
#ifdef JANET_EV
JANET_CORE_REG("os/open", os_open), /* fs read and write */
JANET_CORE_REG("os/pipe", os_pipe),
JANET_CORE_REG("os/sigaction", os_sigaction),
#endif
#endif
JANET_REG_END

View File

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

View File

@@ -152,6 +152,12 @@ static void janet_escape_string_impl(JanetBuffer *buffer, const uint8_t *str, in
case '\v':
janet_buffer_push_bytes(buffer, (const uint8_t *)"\\v", 2);
break;
case '\a':
janet_buffer_push_bytes(buffer, (const uint8_t *)"\\a", 2);
break;
case '\b':
janet_buffer_push_bytes(buffer, (const uint8_t *)"\\b", 2);
break;
case 27:
janet_buffer_push_bytes(buffer, (const uint8_t *)"\\e", 2);
break;
@@ -244,6 +250,10 @@ void janet_to_string_b(JanetBuffer *buffer, Janet x) {
case JANET_FUNCTION: {
JanetFunction *fun = janet_unwrap_function(x);
JanetFuncDef *def = fun->def;
if (def == NULL) {
janet_buffer_push_cstring(buffer, "<incomplete function>");
break;
}
if (def->name) {
const uint8_t *n = def->name;
janet_buffer_push_cstring(buffer, "<function ");

View File

@@ -57,12 +57,20 @@ int janet_dobytes(JanetTable *env, const uint8_t *bytes, int32_t len, const char
}
} else {
ret = janet_wrap_string(cres.error);
int32_t line = (int32_t) parser.line;
int32_t col = (int32_t) parser.column;
if ((cres.error_mapping.line > 0) &&
(cres.error_mapping.column > 0)) {
line = cres.error_mapping.line;
col = cres.error_mapping.column;
}
if (cres.macrofiber) {
janet_eprintf("compile error in %s: ", sourcePath);
janet_eprintf("%s:%d:%d: compile error", sourcePath,
line, col);
janet_stacktrace_ext(cres.macrofiber, ret, "");
} else {
janet_eprintf("compile error in %s: %s\n", sourcePath,
(const char *)cres.error);
janet_eprintf("%s:%d:%d: compile error: %s\n", sourcePath,
line, col, (const char *)cres.error);
}
errflags |= 0x02;
done = 1;

View File

@@ -357,7 +357,8 @@ SlotHeadPair *dohead_destructure(JanetCompiler *c, SlotHeadPair *into, JanetFopt
if (has_drop && can_destructure_lhs && rhs_is_indexed) {
/* Code is of the form (def [a b] [1 2]), avoid the allocation of two tuples */
JanetView view_lhs, view_rhs;
JanetView view_lhs = {0};
JanetView view_rhs = {0};
janet_indexed_view(lhs, &view_lhs.items, &view_lhs.len);
janet_indexed_view(rhs, &view_rhs.items, &view_rhs.len);
int found_amp = 0;
@@ -529,6 +530,32 @@ static JanetSlot janetc_def(JanetFopts opts, int32_t argn, const Janet *argv) {
return ret;
}
/* Check if a form matches the pattern (= nil _) or (not= nil _) */
static int janetc_check_nil_form(JanetFopts opts, Janet x, Janet *capture, uint32_t fun_tag) {
if (!janet_checktype(x, JANET_TUPLE)) return 0;
JanetTuple tup = janet_unwrap_tuple(x);
if (3 != janet_tuple_length(tup)) return 0;
Janet op1 = tup[0];
if (janet_checktype(op1, JANET_SYMBOL)) {
Janet entry = janet_table_get(opts.compiler->env, op1);
if (janet_checktype(entry, JANET_TABLE)) {
op1 = janet_table_get(janet_unwrap_table(entry), janet_ckeywordv("value"));
}
}
if (!janet_checktype(op1, JANET_FUNCTION)) return 0;
JanetFunction *fun = janet_unwrap_function(op1);
uint32_t tag = fun->def->flags & JANET_FUNCDEF_FLAG_TAG;
if (tag != fun_tag) return 0;
if (janet_checktype(tup[1], JANET_NIL)) {
*capture = tup[2];
return 1;
} else if (janet_checktype(tup[2], JANET_NIL)) {
*capture = tup[1];
return 1;
}
return 0;
}
/*
* :condition
* ...
@@ -549,6 +576,7 @@ static JanetSlot janetc_if(JanetFopts opts, int32_t argn, const Janet *argv) {
JanetScope condscope, tempscope;
const int tail = opts.flags & JANET_FOPTS_TAIL;
const int drop = opts.flags & JANET_FOPTS_DROP;
uint8_t ifnjmp = JOP_JUMP_IF_NOT;
if (argn < 2 || argn > 3) {
janetc_cerror(c, "expected 2 or 3 arguments to if");
@@ -571,7 +599,16 @@ static JanetSlot janetc_if(JanetFopts opts, int32_t argn, const Janet *argv) {
/* Compile condition */
janetc_scope(&condscope, c, 0, "if");
cond = janetc_value(condopts, argv[0]);
Janet condform = argv[0];
if (janetc_check_nil_form(opts, condform, &condform, JANET_FUN_EQ)) {
ifnjmp = JOP_JUMP_IF_NOT_NIL;
}
if (janetc_check_nil_form(opts, condform, &condform, JANET_FUN_NEQ)) {
ifnjmp = JOP_JUMP_IF_NIL;
}
cond = janetc_value(condopts, condform);
/* Check constant condition. */
/* TODO: Use type info for more short circuits */
@@ -594,7 +631,7 @@ static JanetSlot janetc_if(JanetFopts opts, int32_t argn, const Janet *argv) {
}
/* Compile jump to right */
labeljr = janetc_emit_si(c, JOP_JUMP_IF_NOT, cond, 0, 0);
labeljr = janetc_emit_si(c, ifnjmp, cond, 0, 0);
/* Condition left body */
janetc_scope(&tempscope, c, 0, "if-true");
@@ -604,7 +641,7 @@ static JanetSlot janetc_if(JanetFopts opts, int32_t argn, const Janet *argv) {
/* Compile jump to done */
labeljd = janet_v_count(c->buffer);
if (!tail) janetc_emit(c, JOP_JUMP);
if (!tail && !(drop && janet_checktype(falsebody, JANET_NIL))) janetc_emit(c, JOP_JUMP);
/* Compile right body */
labelr = janet_v_count(c->buffer);
@@ -740,20 +777,6 @@ static JanetSlot janetc_break(JanetFopts opts, int32_t argn, const Janet *argv)
}
}
/* Check if a form matches the pattern (not= nil _) */
static int janetc_check_notnil_form(Janet x, Janet *capture) {
if (!janet_checktype(x, JANET_TUPLE)) return 0;
JanetTuple tup = janet_unwrap_tuple(x);
if (!janet_checktype(tup[0], JANET_FUNCTION)) return 0;
if (3 != janet_tuple_length(tup)) return 0;
JanetFunction *fun = janet_unwrap_function(tup[0]);
uint32_t tag = fun->def->flags & JANET_FUNCDEF_FLAG_TAG;
if (tag != JANET_FUN_NEQ) return 0;
if (!janet_checktype(tup[1], JANET_NIL)) return 0;
*capture = tup[2];
return 1;
}
/*
* :whiletop
* ...
@@ -770,6 +793,7 @@ static JanetSlot janetc_while(JanetFopts opts, int32_t argn, const Janet *argv)
JanetScope tempscope;
int32_t labelwt, labeld, labeljt, labelc, i;
int infinite = 0;
int is_nil_form = 0;
int is_notnil_form = 0;
uint8_t ifjmp = JOP_JUMP_IF;
uint8_t ifnjmp = JOP_JUMP_IF_NOT;
@@ -783,11 +807,16 @@ static JanetSlot janetc_while(JanetFopts opts, int32_t argn, const Janet *argv)
janetc_scope(&tempscope, c, JANET_SCOPE_WHILE, "while");
/* Check for `(not= nil _)` in condition, and if so, use the
/* Check for `(= nil _)` or `(not= nil _)` in condition, and if so, use the
* jmpnl or jmpnn instructions. This let's us implement `(each ...)`
* more efficiently. */
Janet condform = argv[0];
if (janetc_check_notnil_form(condform, &condform)) {
if (janetc_check_nil_form(opts, condform, &condform, JANET_FUN_EQ)) {
is_nil_form = 1;
ifjmp = JOP_JUMP_IF_NIL;
ifnjmp = JOP_JUMP_IF_NOT_NIL;
}
if (janetc_check_nil_form(opts, condform, &condform, JANET_FUN_NEQ)) {
is_notnil_form = 1;
ifjmp = JOP_JUMP_IF_NOT_NIL;
ifnjmp = JOP_JUMP_IF_NIL;
@@ -799,7 +828,9 @@ static JanetSlot janetc_while(JanetFopts opts, int32_t argn, const Janet *argv)
/* Check for constant condition */
if (cond.flags & JANET_SLOT_CONSTANT) {
/* Loop never executes */
int never_executes = is_notnil_form
int never_executes = is_nil_form
? !janet_checktype(cond.constant, JANET_NIL)
: is_notnil_form
? janet_checktype(cond.constant, JANET_NIL)
: !janet_truthy(cond.constant);
if (never_executes) {

View File

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

View File

@@ -89,7 +89,7 @@ struct JanetVM {
/* If this flag is true, suspend on function calls and backwards jumps.
* When this occurs, this flag will be reset to 0. */
int auto_suspend;
volatile int32_t auto_suspend;
/* The current running fiber on the current thread.
* Set and unset by functions in vm.c */
@@ -125,6 +125,7 @@ struct JanetVM {
size_t next_collection;
size_t block_count;
int gc_suspend;
int gc_mark_phase;
/* GC roots */
Janet *roots;
@@ -154,12 +155,11 @@ struct JanetVM {
JanetQueue spawn;
JanetTimeout *tq;
JanetRNG ev_rng;
JanetListenerState **listeners;
size_t listener_count;
size_t listener_cap;
size_t extra_listeners;
volatile size_t extra_listeners; /* used in signal handler, must be volatile */
JanetTable threaded_abstracts; /* All abstract types that can be shared between threads (used in this thread) */
JanetTable active_tasks; /* All possibly live task fibers - used just for tracking */
JanetArray *listeners; /* For GC */
JanetTable signal_handlers;
#ifdef JANET_WINDOWS
void **iocp;
#elif defined(JANET_EV_EPOLL)

View File

@@ -175,8 +175,9 @@ JANET_CORE_FN(cfun_string_slice,
"Returns a substring from a byte sequence. The substring is from "
"index `start` inclusive to index `end`, exclusive. All indexing "
"is from 0. `start` and `end` can also be negative to indicate indexing "
"from the end of the string. Note that index -1 is synonymous with "
"index `(length bytes)` to allow a full negative slice range. ") {
"from the end of the string. Note that if `start` is negative it is "
"exclusive, and if `end` is negative it is inclusive, to allow a full "
"negative slice range.") {
JanetByteView view = janet_getbytes(argv, 0);
JanetRange range = janet_getslice(argc, argv);
return janet_stringv(view.bytes + range.start, range.end - range.start);

View File

@@ -111,12 +111,11 @@ static void janet_table_rehash(JanetTable *t, int32_t size) {
JANET_OUT_OF_MEMORY;
}
}
int32_t i, oldcapacity;
oldcapacity = t->capacity;
int32_t oldcapacity = t->capacity;
t->data = newdata;
t->capacity = size;
t->deleted = 0;
for (i = 0; i < oldcapacity; i++) {
for (int32_t i = 0; i < oldcapacity; i++) {
JanetKV *kv = olddata + i;
if (!janet_checktype(kv->key, JANET_NIL)) {
JanetKV *newkv = janet_table_find(t, kv->key);

View File

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

View File

@@ -805,6 +805,13 @@ int janet_checkint(Janet x) {
return janet_checkintrange(dval);
}
int janet_checkuint(Janet x) {
if (!janet_checktype(x, JANET_NUMBER))
return 0;
double dval = janet_unwrap_number(x);
return janet_checkuintrange(dval);
}
int janet_checkint64(Janet x) {
if (!janet_checktype(x, JANET_NUMBER))
return 0;
@@ -816,7 +823,7 @@ int janet_checkuint64(Janet x) {
if (!janet_checktype(x, JANET_NUMBER))
return 0;
double dval = janet_unwrap_number(x);
return dval >= 0 && dval <= JANET_INTMAX_DOUBLE && dval == (uint64_t) dval;
return janet_checkuint64range(dval);
}
int janet_checksize(Janet x) {

View File

@@ -49,7 +49,7 @@
#ifndef JANET_EXIT
#include <stdio.h>
#define JANET_EXIT(m) do { \
fprintf(stderr, "C runtime error at line %d in file %s: %s\n",\
fprintf(stderr, "janet interpreter runtime error at line %d in file %s: %s\n",\
__LINE__,\
__FILE__,\
(m));\

View File

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

View File

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

View File

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

View File

@@ -235,9 +235,22 @@ extern "C" {
#endif
/* How to export symbols */
#ifndef JANET_EXPORT
#ifdef JANET_WINDOWS
#define JANET_EXPORT __declspec(dllexport)
#else
#define JANET_EXPORT __attribute__((visibility ("default")))
#endif
#endif
/* How declare API functions */
#ifndef JANET_API
#ifdef JANET_WINDOWS
#ifdef JANET_DLL_IMPORT
#define JANET_API __declspec(dllimport)
#else
#define JANET_API __declspec(dllexport)
#endif
#else
#define JANET_API __attribute__((visibility ("default")))
#endif
@@ -578,7 +591,6 @@ typedef enum {
JANET_ASYNC_EVENT_HUP,
JANET_ASYNC_EVENT_READ,
JANET_ASYNC_EVENT_WRITE,
JANET_ASYNC_EVENT_CANCEL,
JANET_ASYNC_EVENT_COMPLETE, /* Used on windows for IOCP */
JANET_ASYNC_EVENT_USER
} JanetAsyncEvent;
@@ -600,13 +612,9 @@ typedef JanetAsyncStatus(*JanetListener)(JanetListenerState *state, JanetAsyncEv
struct JanetStream {
JanetHandle handle;
uint32_t flags;
/* Linked list of all in-flight IO routines for this stream */
JanetListenerState *state;
JanetListenerState *read_state;
JanetListenerState *write_state;
const void *methods; /* Methods for this stream */
/* internal - used to disallow multiple concurrent reads / writes on the same stream.
* this constraint may be lifted later but allowing such would require more internal book keeping
* for some implementations. You can read and write at the same time on the same stream, though. */
int _mask;
};
/* Interface for state machine based event loop */
@@ -616,14 +624,12 @@ struct JanetListenerState {
JanetStream *stream;
void *event; /* Used to pass data from asynchronous IO event. Contents depend on both
implementation of the event loop and the particular event. */
uint32_t index; /* Used for GC and poll implentation */
uint32_t flags;
#ifdef JANET_WINDOWS
void *tag; /* Used to associate listeners with an overlapped structure */
int bytes; /* Used to track how many bytes were transfered. */
#endif
/* internal */
size_t _index;
int _mask;
JanetListenerState *_next;
};
#endif
@@ -653,10 +659,10 @@ struct JanetListenerState {
* external bindings, we should prefer using the Head structs directly, and
* use the host language to add sugar around the manipulation of the Janet types. */
JANET_API JanetStructHead *janet_struct_head(const JanetKV *st);
JANET_API JanetStructHead *janet_struct_head(JanetStruct st);
JANET_API JanetAbstractHead *janet_abstract_head(const void *abstract);
JANET_API JanetStringHead *janet_string_head(const uint8_t *s);
JANET_API JanetTupleHead *janet_tuple_head(const Janet *tuple);
JANET_API JanetStringHead *janet_string_head(JanetString s);
JANET_API JanetTupleHead *janet_tuple_head(JanetTuple tuple);
/* Some language bindings won't have access to the macro versions. */
@@ -665,16 +671,16 @@ JANET_API int janet_checktype(Janet x, JanetType type);
JANET_API int janet_checktypes(Janet x, int typeflags);
JANET_API int janet_truthy(Janet x);
JANET_API const JanetKV *janet_unwrap_struct(Janet x);
JANET_API const Janet *janet_unwrap_tuple(Janet x);
JANET_API JanetStruct janet_unwrap_struct(Janet x);
JANET_API JanetTuple janet_unwrap_tuple(Janet x);
JANET_API JanetFiber *janet_unwrap_fiber(Janet x);
JANET_API JanetArray *janet_unwrap_array(Janet x);
JANET_API JanetTable *janet_unwrap_table(Janet x);
JANET_API JanetBuffer *janet_unwrap_buffer(Janet x);
JANET_API const uint8_t *janet_unwrap_string(Janet x);
JANET_API const uint8_t *janet_unwrap_symbol(Janet x);
JANET_API const uint8_t *janet_unwrap_keyword(Janet x);
JANET_API void *janet_unwrap_abstract(Janet x);
JANET_API JanetString janet_unwrap_string(Janet x);
JANET_API JanetSymbol janet_unwrap_symbol(Janet x);
JANET_API JanetKeyword janet_unwrap_keyword(Janet x);
JANET_API JanetAbstract janet_unwrap_abstract(Janet x);
JANET_API void *janet_unwrap_pointer(Janet x);
JANET_API JanetFunction *janet_unwrap_function(Janet x);
JANET_API JanetCFunction janet_unwrap_cfunction(Janet x);
@@ -687,18 +693,18 @@ JANET_API Janet janet_wrap_number(double x);
JANET_API Janet janet_wrap_true(void);
JANET_API Janet janet_wrap_false(void);
JANET_API Janet janet_wrap_boolean(int x);
JANET_API Janet janet_wrap_string(const uint8_t *x);
JANET_API Janet janet_wrap_symbol(const uint8_t *x);
JANET_API Janet janet_wrap_keyword(const uint8_t *x);
JANET_API Janet janet_wrap_string(JanetString x);
JANET_API Janet janet_wrap_symbol(JanetSymbol x);
JANET_API Janet janet_wrap_keyword(JanetKeyword x);
JANET_API Janet janet_wrap_array(JanetArray *x);
JANET_API Janet janet_wrap_tuple(const Janet *x);
JANET_API Janet janet_wrap_struct(const JanetKV *x);
JANET_API Janet janet_wrap_tuple(JanetTuple x);
JANET_API Janet janet_wrap_struct(JanetStruct x);
JANET_API Janet janet_wrap_fiber(JanetFiber *x);
JANET_API Janet janet_wrap_buffer(JanetBuffer *x);
JANET_API Janet janet_wrap_function(JanetFunction *x);
JANET_API Janet janet_wrap_cfunction(JanetCFunction x);
JANET_API Janet janet_wrap_table(JanetTable *x);
JANET_API Janet janet_wrap_abstract(void *x);
JANET_API Janet janet_wrap_abstract(JanetAbstract x);
JANET_API Janet janet_wrap_pointer(void *x);
JANET_API Janet janet_wrap_integer(int32_t x);
@@ -730,6 +736,7 @@ JANET_API Janet janet_wrap_integer(int32_t x);
? janet_nanbox_isnumber(x) \
: janet_nanbox_checkauxtype((x), (t)))
/* Use JANET_API so that modules will use a local version of these functions if possible */
JANET_API void *janet_nanbox_to_pointer(Janet x);
JANET_API Janet janet_nanbox_from_pointer(void *p, uint64_t tagmask);
JANET_API Janet janet_nanbox_from_cpointer(const void *p, uint64_t tagmask);
@@ -776,14 +783,14 @@ JANET_API Janet janet_nanbox_from_bits(uint64_t bits);
#define janet_wrap_pointer(s) janet_nanbox_wrap_((s), JANET_POINTER)
/* Unwrap the pointer types */
#define janet_unwrap_struct(x) ((const JanetKV *)janet_nanbox_to_pointer(x))
#define janet_unwrap_tuple(x) ((const Janet *)janet_nanbox_to_pointer(x))
#define janet_unwrap_struct(x) ((JanetStruct)janet_nanbox_to_pointer(x))
#define janet_unwrap_tuple(x) ((JanetTuple)janet_nanbox_to_pointer(x))
#define janet_unwrap_fiber(x) ((JanetFiber *)janet_nanbox_to_pointer(x))
#define janet_unwrap_array(x) ((JanetArray *)janet_nanbox_to_pointer(x))
#define janet_unwrap_table(x) ((JanetTable *)janet_nanbox_to_pointer(x))
#define janet_unwrap_buffer(x) ((JanetBuffer *)janet_nanbox_to_pointer(x))
#define janet_unwrap_string(x) ((const uint8_t *)janet_nanbox_to_pointer(x))
#define janet_unwrap_symbol(x) ((const uint8_t *)janet_nanbox_to_pointer(x))
#define janet_unwrap_string(x) ((JanetString)janet_nanbox_to_pointer(x))
#define janet_unwrap_symbol(x) ((JanetSymbol)janet_nanbox_to_pointer(x))
#define janet_unwrap_keyword(x) ((const uint8_t *)janet_nanbox_to_pointer(x))
#define janet_unwrap_abstract(x) (janet_nanbox_to_pointer(x))
#define janet_unwrap_pointer(x) (janet_nanbox_to_pointer(x))
@@ -825,15 +832,15 @@ JANET_API Janet janet_nanbox32_from_tagp(uint32_t tag, void *pointer);
#define janet_wrap_cfunction(s) janet_nanbox32_from_tagp(JANET_CFUNCTION, (void *)(s))
#define janet_wrap_pointer(s) janet_nanbox32_from_tagp(JANET_POINTER, (void *)(s))
#define janet_unwrap_struct(x) ((const JanetKV *)(x).tagged.payload.pointer)
#define janet_unwrap_tuple(x) ((const Janet *)(x).tagged.payload.pointer)
#define janet_unwrap_struct(x) ((JanetStruct)(x).tagged.payload.pointer)
#define janet_unwrap_tuple(x) ((JanetTuple)(x).tagged.payload.pointer)
#define janet_unwrap_fiber(x) ((JanetFiber *)(x).tagged.payload.pointer)
#define janet_unwrap_array(x) ((JanetArray *)(x).tagged.payload.pointer)
#define janet_unwrap_table(x) ((JanetTable *)(x).tagged.payload.pointer)
#define janet_unwrap_buffer(x) ((JanetBuffer *)(x).tagged.payload.pointer)
#define janet_unwrap_string(x) ((const uint8_t *)(x).tagged.payload.pointer)
#define janet_unwrap_symbol(x) ((const uint8_t *)(x).tagged.payload.pointer)
#define janet_unwrap_keyword(x) ((const uint8_t *)(x).tagged.payload.pointer)
#define janet_unwrap_string(x) ((JanetString)(x).tagged.payload.pointer)
#define janet_unwrap_symbol(x) ((JanetSymbol)(x).tagged.payload.pointer)
#define janet_unwrap_keyword(x) ((JanetKeyword)(x).tagged.payload.pointer)
#define janet_unwrap_abstract(x) ((x).tagged.payload.pointer)
#define janet_unwrap_pointer(x) ((x).tagged.payload.pointer)
#define janet_unwrap_function(x) ((JanetFunction *)(x).tagged.payload.pointer)
@@ -848,15 +855,15 @@ JANET_API Janet janet_nanbox32_from_tagp(uint32_t tag, void *pointer);
#define janet_truthy(x) \
((x).type != JANET_NIL && ((x).type != JANET_BOOLEAN || ((x).as.u64 & 0x1)))
#define janet_unwrap_struct(x) ((const JanetKV *)(x).as.pointer)
#define janet_unwrap_tuple(x) ((const Janet *)(x).as.pointer)
#define janet_unwrap_struct(x) ((JanetStruct)(x).as.pointer)
#define janet_unwrap_tuple(x) ((JanetTuple)(x).as.pointer)
#define janet_unwrap_fiber(x) ((JanetFiber *)(x).as.pointer)
#define janet_unwrap_array(x) ((JanetArray *)(x).as.pointer)
#define janet_unwrap_table(x) ((JanetTable *)(x).as.pointer)
#define janet_unwrap_buffer(x) ((JanetBuffer *)(x).as.pointer)
#define janet_unwrap_string(x) ((const uint8_t *)(x).as.pointer)
#define janet_unwrap_symbol(x) ((const uint8_t *)(x).as.pointer)
#define janet_unwrap_keyword(x) ((const uint8_t *)(x).as.pointer)
#define janet_unwrap_string(x) ((JanetString)(x).as.pointer)
#define janet_unwrap_symbol(x) ((JanetSymbol)(x).as.pointer)
#define janet_unwrap_keyword(x) ((JanetKeyword)(x).as.pointer)
#define janet_unwrap_abstract(x) ((x).as.pointer)
#define janet_unwrap_pointer(x) ((x).as.pointer)
#define janet_unwrap_function(x) ((JanetFunction *)(x).as.pointer)
@@ -868,12 +875,15 @@ JANET_API Janet janet_nanbox32_from_tagp(uint32_t tag, void *pointer);
#endif
JANET_API int janet_checkint(Janet x);
JANET_API int janet_checkuint(Janet x);
JANET_API int janet_checkint64(Janet x);
JANET_API int janet_checkuint64(Janet x);
JANET_API int janet_checksize(Janet x);
JANET_API JanetAbstract janet_checkabstract(Janet x, const JanetAbstractType *at);
#define janet_checkintrange(x) ((x) >= INT32_MIN && (x) <= INT32_MAX && (x) == (int32_t)(x))
#define janet_checkuintrange(x) ((x) >= 0 && (x) <= UINT32_MAX && (x) == (uint32_t)(x))
#define janet_checkint64range(x) ((x) >= JANET_INTMIN_DOUBLE && (x) <= JANET_INTMAX_DOUBLE && (x) == (int64_t)(x))
#define janet_checkuint64range(x) ((x) >= 0 && (x) <= JANET_INTMAX_DOUBLE && (x) == (uint64_t)(x))
#define janet_unwrap_integer(x) ((int32_t) janet_unwrap_number(x))
#define janet_wrap_integer(x) janet_wrap_number((int32_t)(x))
@@ -909,8 +919,8 @@ struct JanetFiber {
* that is, fibers that are scheduled on the event loop and behave much like threads
* in a multi-tasking system. It would be possible to move these fields to a new
* type, say "JanetTask", that as separate from fibers to save a bit of space. */
JanetListenerState *waiting;
uint32_t sched_id; /* Increment everytime fiber is scheduled by event loop */
JanetListenerState *waiting;
void *supervisor_channel; /* Channel to push self to when complete */
#endif
};
@@ -1259,11 +1269,13 @@ enum JanetOpCode {
JOP_RETURN_NIL,
JOP_ADD_IMMEDIATE,
JOP_ADD,
JOP_SUBTRACT_IMMEDIATE,
JOP_SUBTRACT,
JOP_MULTIPLY_IMMEDIATE,
JOP_MULTIPLY,
JOP_DIVIDE_IMMEDIATE,
JOP_DIVIDE,
JOP_DIVIDE_FLOOR,
JOP_MODULO,
JOP_REMAINDER,
JOP_BAND,
@@ -1383,6 +1395,7 @@ JANET_API void janet_stream_flags(JanetStream *stream, uint32_t flags);
JANET_API void janet_schedule(JanetFiber *fiber, Janet value);
JANET_API void janet_cancel(JanetFiber *fiber, Janet value);
JANET_API void janet_schedule_signal(JanetFiber *fiber, Janet value, JanetSignal sig);
JANET_API void janet_schedule_soon(JanetFiber *fiber, Janet value, JanetSignal sig);
/* Start a state machine listening for events from a stream */
JANET_API JanetListenerState *janet_listen(JanetStream *stream, JanetListener behavior, int mask, size_t size, void *user);
@@ -1479,7 +1492,6 @@ JANET_API void janet_ev_readchunk(JanetStream *stream, JanetBuffer *buf, int32_t
JANET_API void janet_ev_recv(JanetStream *stream, JanetBuffer *buf, int32_t nbytes, int flags);
JANET_API void janet_ev_recvchunk(JanetStream *stream, JanetBuffer *buf, int32_t nbytes, int flags);
JANET_API void janet_ev_recvfrom(JanetStream *stream, JanetBuffer *buf, int32_t nbytes, int flags);
JANET_API void janet_ev_connect(JanetStream *stream, int flags);
#endif
/* Write async to a stream */
@@ -1607,7 +1619,7 @@ JANET_API void janet_buffer_push_u64(JanetBuffer *buffer, uint64_t x);
#define JANET_TUPLE_FLAG_BRACKETCTOR 0x10000
#define janet_tuple_head(t) ((JanetTupleHead *)((char *)t - offsetof(JanetTupleHead, data)))
#define janet_tuple_from_head(gcobject) ((const Janet *)((char *)gcobject + offsetof(JanetTupleHead, data)))
#define janet_tuple_from_head(gcobject) ((JanetTuple)((char *)gcobject + offsetof(JanetTupleHead, data)))
#define janet_tuple_length(t) (janet_tuple_head(t)->length)
#define janet_tuple_hash(t) (janet_tuple_head(t)->hash)
#define janet_tuple_sm_line(t) (janet_tuple_head(t)->sm_line)
@@ -1653,7 +1665,7 @@ JANET_API JanetSymbol janet_symbol_gen(void);
/* Structs */
#define janet_struct_head(t) ((JanetStructHead *)((char *)t - offsetof(JanetStructHead, data)))
#define janet_struct_from_head(t) ((const JanetKV *)((char *)gcobject + offsetof(JanetStructHead, data)))
#define janet_struct_from_head(t) ((JanetStruct)((char *)gcobject + offsetof(JanetStructHead, data)))
#define janet_struct_length(t) (janet_struct_head(t)->length)
#define janet_struct_capacity(t) (janet_struct_head(t)->capacity)
#define janet_struct_hash(t) (janet_struct_head(t)->hash)
@@ -1794,6 +1806,7 @@ JANET_API void janet_vm_free(JanetVM *vm);
JANET_API void janet_vm_save(JanetVM *into);
JANET_API void janet_vm_load(JanetVM *from);
JANET_API void janet_interpreter_interrupt(JanetVM *vm);
JANET_API void janet_interpreter_interrupt_handled(JanetVM *vm);
JANET_API JanetSignal janet_continue(JanetFiber *fiber, Janet in, Janet *out);
JANET_API JanetSignal janet_continue_signal(JanetFiber *fiber, Janet in, Janet *out, JanetSignal sig);
JANET_API JanetSignal janet_pcall(JanetFunction *fun, int32_t argn, const Janet *argv, Janet *out, JanetFiber **f);
@@ -1817,6 +1830,7 @@ JANET_API void janet_stacktrace_ext(JanetFiber *fiber, Janet err, const char *pr
#define JANET_SANDBOX_FS_TEMP 1024
#define JANET_SANDBOX_FFI_USE 2048
#define JANET_SANDBOX_FFI_JIT 4096
#define JANET_SANDBOX_SIGNAL 8192
#define JANET_SANDBOX_FFI (JANET_SANDBOX_FFI_DEFINE | JANET_SANDBOX_FFI_USE | JANET_SANDBOX_FFI_JIT)
#define JANET_SANDBOX_FS (JANET_SANDBOX_FS_WRITE | JANET_SANDBOX_FS_READ | JANET_SANDBOX_FS_TEMP)
#define JANET_SANDBOX_NET (JANET_SANDBOX_NET_CONNECT | JANET_SANDBOX_NET_LISTEN)
@@ -1940,10 +1954,10 @@ JANET_API void janet_register(const char *name, JanetCFunction cfun);
#endif
#ifndef JANET_ENTRY_NAME
#define JANET_MODULE_ENTRY \
JANET_MODULE_PREFIX JANET_API JanetBuildConfig _janet_mod_config(void) { \
JANET_MODULE_PREFIX JANET_EXPORT JanetBuildConfig _janet_mod_config(void) { \
return janet_config_current(); \
} \
JANET_MODULE_PREFIX JANET_API void _janet_init
JANET_MODULE_PREFIX JANET_EXPORT void _janet_init
#else
#define JANET_MODULE_ENTRY JANET_MODULE_PREFIX JANET_API void JANET_ENTRY_NAME
#endif
@@ -1992,6 +2006,8 @@ JANET_API JanetDictView janet_getdictionary(const Janet *argv, int32_t n);
JANET_API void *janet_getabstract(const Janet *argv, int32_t n, const JanetAbstractType *at);
JANET_API JanetRange janet_getslice(int32_t argc, const Janet *argv);
JANET_API int32_t janet_gethalfrange(const Janet *argv, int32_t n, int32_t length, const char *which);
JANET_API int32_t janet_getstartrange(const Janet *argv, int32_t argc, int32_t n, int32_t length);
JANET_API int32_t janet_getendrange(const Janet *argv, int32_t argc, int32_t n, int32_t length);
JANET_API int32_t janet_getargindex(const Janet *argv, int32_t n, int32_t length, const char *which);
JANET_API uint64_t janet_getflags(const Janet *argv, int32_t n, const char *flags);
@@ -2050,6 +2066,7 @@ JANET_API int janet_cryptorand(uint8_t *out, size_t n);
JANET_API void janet_marshal_size(JanetMarshalContext *ctx, size_t value);
JANET_API void janet_marshal_int(JanetMarshalContext *ctx, int32_t value);
JANET_API void janet_marshal_int64(JanetMarshalContext *ctx, int64_t value);
JANET_API void janet_marshal_ptr(JanetMarshalContext *ctx, const void *value);
JANET_API void janet_marshal_byte(JanetMarshalContext *ctx, uint8_t value);
JANET_API void janet_marshal_bytes(JanetMarshalContext *ctx, const uint8_t *bytes, size_t len);
JANET_API void janet_marshal_janet(JanetMarshalContext *ctx, Janet x);
@@ -2059,10 +2076,12 @@ JANET_API void janet_unmarshal_ensure(JanetMarshalContext *ctx, size_t size);
JANET_API size_t janet_unmarshal_size(JanetMarshalContext *ctx);
JANET_API int32_t janet_unmarshal_int(JanetMarshalContext *ctx);
JANET_API int64_t janet_unmarshal_int64(JanetMarshalContext *ctx);
JANET_API void *janet_unmarshal_ptr(JanetMarshalContext *ctx);
JANET_API uint8_t janet_unmarshal_byte(JanetMarshalContext *ctx);
JANET_API void janet_unmarshal_bytes(JanetMarshalContext *ctx, uint8_t *dest, size_t len);
JANET_API Janet janet_unmarshal_janet(JanetMarshalContext *ctx);
JANET_API JanetAbstract janet_unmarshal_abstract(JanetMarshalContext *ctx, size_t size);
JANET_API JanetAbstract janet_unmarshal_abstract_threaded(JanetMarshalContext *ctx, size_t size);
JANET_API void janet_unmarshal_abstract_reuse(JanetMarshalContext *ctx, void *p);
JANET_API void janet_register_abstract_type(const JanetAbstractType *at);

View File

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

View File

@@ -113,13 +113,22 @@
# 7478ad11
(assert (= nil (any? [])) "any? 1")
(assert (= nil (any? [false nil])) "any? 2")
(assert (= nil (any? [nil false])) "any? 3")
(assert (= false (any? [nil false])) "any? 3")
(assert (= 1 (any? [1])) "any? 4")
(assert (nan? (any? [nil math/nan nil])) "any? 5")
(assert (= true
(any? [nil nil false nil nil true nil nil nil nil false :a nil]))
"any? 6")
(assert (= true (every? [])) "every? 1")
(assert (= true (every? [1 true])) "every? 2")
(assert (= 1 (every? [true 1])) "every? 3")
(assert (= nil (every? [nil])) "every? 4")
(assert (= 2 (every? [1 math/nan 2])) "every? 5")
(assert (= false
(every? [1 1 true 1 1 false 1 1 1 1 true :a nil]))
"every? 6")
# Some higher order functions and macros
# 5e2de33
(def my-array @[1 2 3 4 5 6])
@@ -177,6 +186,11 @@
(assert (= txs [[-1 -1] [-1 0] [-1 1] [0 -1] [0 1] [1 -1] [1 0] [1 1]])
"nested seq")
# :unless modifier
(assert (deep= (seq [i :range [0 10] :unless (odd? i)] i)
@[0 2 4 6 8])
":unless modifier")
# 515891b03
(assert (deep= (tabseq [i :in (range 3)] i (* 3 i))
@{0 0 1 3 2 6}))
@@ -195,6 +209,12 @@
(assert (deep= (seq [x :down-to [10 0]] x) (seq [x :down [10 -1]] x))
"loop :down-to")
# one-term :range forms
(assert (deep= (seq [x :range [10]] x) (seq [x :range [0 10]] x))
"one-term :range")
(assert (deep= (seq [x :down [10]] x) (seq [x :down [10 0]] x))
"one-term :down")
# 7880d7320
(def res @{})
(loop [[k v] :pairs @{1 2 3 4 5 6}]
@@ -334,6 +354,13 @@
"sort 5")
(assert (<= ;(sort (map (fn [x] (math/random)) (range 1000)))) "sort 6")
# #1283
(assert (deep=
(partition 2 (generate [ i :in [:a :b :c :d :e]] i))
'@[(:a :b) (:c :d) (:e)]))
(assert (= (mean (generate [i :in [2 3 5 7 11]] i))
5.6))
# And and or
# c16a9d846
(assert (= (and true true) true) "and true true")
@@ -362,14 +389,7 @@
(assert (= false (and false false)) "and 1")
(assert (= false (or false false)) "or 1")
# Range
# a982f351d
(assert (deep= (range 10) @[0 1 2 3 4 5 6 7 8 9]) "range 1 argument")
(assert (deep= (range 5 10) @[5 6 7 8 9]) "range 2 arguments")
(assert (deep= (range 5 10 2) @[5 7 9]) "range 3 arguments")
# 11cd1279d
(assert (= (length (range 10)) 10) "(range 10)")
(assert (= (length (range 1 10)) 9) "(range 1 10)")
(assert (deep= @{:a 1 :b 2 :c 3} (zipcoll '[:a :b :c] '[1 2 3])) "zipcoll")
# bc8be266f

View File

@@ -77,6 +77,14 @@
(buffer/push-string b5 "456" @"789")
(assert (= "123456789" (string b5)) "buffer/push-buffer 2")
# Buffer from bytes
(assert (deep= @"" (buffer/from-bytes)) "buffer/from-bytes 1")
(assert (deep= @"ABC" (buffer/from-bytes 65 66 67)) "buffer/from-bytes 2")
(assert (deep= @"0123456789" (buffer/from-bytes ;(range 48 58))) "buffer/from-bytes 3")
(assert (= 0 (length (buffer/from-bytes))) "buffer/from-bytes 4")
(assert (= 5 (length (buffer/from-bytes ;(range 5)))) "buffer/from-bytes 5")
(assert-error "bad slot #1, expected 32 bit signed integer" (buffer/from-bytes :abc))
# some tests for buffer/format
# 029394d
(assert (= (string (buffer/format @"" "pi = %6.3f" math/pi)) "pi = 3.142")
@@ -103,6 +111,7 @@
(assert (deep= @"bcde" (buffer/blit @"" a -1 1 5)) "buffer/blit 3")
(assert (deep= @"cde" (buffer/blit @"" a -1 2 5)) "buffer/blit 4")
(assert (deep= @"de" (buffer/blit @"" a -1 3 5)) "buffer/blit 5")
(assert (deep= @"de" (buffer/blit @"" a nil 3 5)) "buffer/blit 6")
# buffer/push-at
# c55d93512
@@ -113,8 +122,5 @@
(assert (deep= @"abc423" (buffer/push-at @"abc123" 3 "4"))
"buffer/push-at 3")
# 4782a76
(assert (= 10 (do (var x 10) (def y x) (++ x) y)) "no invalid aliasing")
(end-suite)

View File

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

View File

@@ -25,38 +25,41 @@
# 5e1a8c86f
(def janet (dyn :executable))
# Subprocess should inherit the "RUN" parameter for fancy testing
(def run (filter next (string/split " " (os/getenv "SUBRUN" ""))))
(repeat 10
(let [p (os/spawn [janet "-e" `(print "hello")`] :p {:out :pipe})]
(let [p (os/spawn [;run janet "-e" `(print "hello")`] :p {:out :pipe})]
(os/proc-wait p)
(def x (:read (p :out) :all))
(assert (deep= "hello" (string/trim x))
"capture stdout from os/spawn pre close."))
(let [p (os/spawn [janet "-e" `(print "hello")`] :p {:out :pipe})]
(let [p (os/spawn [;run janet "-e" `(print "hello")`] :p {:out :pipe})]
(def x (:read (p :out) 1024))
(os/proc-wait p)
(assert (deep= "hello" (string/trim x))
"capture stdout from os/spawn post close."))
(let [p (os/spawn [janet "-e" `(file/read stdin :line)`] :px
(let [p (os/spawn [;run janet "-e" `(file/read stdin :line)`] :px
{:in :pipe})]
(:write (p :in) "hello!\n")
(assert-no-error "pipe stdin to process" (os/proc-wait p))))
(let [p (os/spawn [janet "-e" `(print (file/read stdin :line))`] :px
(let [p (os/spawn [;run janet "-e" `(print (file/read stdin :line))`] :px
{:in :pipe :out :pipe})]
(:write (p :in) "hello!\n")
(def x (:read (p :out) 1024))
(assert-no-error "pipe stdin to process 2" (os/proc-wait p))
(assert (= "hello!" (string/trim x)) "round trip pipeline in process"))
(let [p (os/spawn [janet "-e" `(do (ev/sleep 30) (os/exit 24)`] :p)]
(let [p (os/spawn [;run janet "-e" `(do (ev/sleep 30) (os/exit 24)`] :p)]
(os/proc-kill p)
(def retval (os/proc-wait p))
(assert (not= retval 24) "Process was *not* terminated by parent"))
(let [p (os/spawn [janet "-e" `(do (ev/sleep 30) (os/exit 24)`] :p)]
(let [p (os/spawn [;run janet "-e" `(do (ev/sleep 30) (os/exit 24)`] :p)]
(os/proc-kill p false :term)
(def retval (os/proc-wait p))
(assert (not= retval 24) "Process was *not* terminated by parent"))
@@ -66,7 +69,7 @@
(defn calc-1
"Run subprocess, read from stdout, then wait on subprocess."
[code]
(let [p (os/spawn [janet "-e" (string `(printf "%j" ` code `)`)] :px
(let [p (os/spawn [;run janet "-e" (string `(printf "%j" ` code `)`)] :px
{:out :pipe})]
(os/proc-wait p)
(def output (:read (p :out) :all))
@@ -86,7 +89,7 @@
to 10 bytes instead of :all
``
[code]
(let [p (os/spawn [janet "-e" (string `(printf "%j" ` code `)`)] :px
(let [p (os/spawn [;run janet "-e" (string `(printf "%j" ` code `)`)] :px
{:out :pipe})]
(def output (:read (p :out) 10))
(os/proc-wait p)
@@ -104,18 +107,18 @@
# a1cc5ca04
(assert-no-error "file writing 1"
(with [f (file/temp)]
(os/execute [janet "-e" `(repeat 20 (print :hello))`] :p {:out f})))
(os/execute [;run janet "-e" `(repeat 20 (print :hello))`] :p {:out f})))
(assert-no-error "file writing 2"
(with [f (file/open "unique.txt" :w)]
(os/execute [janet "-e" `(repeat 20 (print :hello))`] :p {:out f})
(os/execute [;run janet "-e" `(repeat 20 (print :hello))`] :p {:out f})
(file/flush f)))
# Issue #593
# a1cc5ca04
(assert-no-error "file writing 3"
(def outfile (file/open "unique.txt" :w))
(os/execute [janet "-e" "(pp (seq [i :range (1 10)] i))"] :p
(os/execute [;run janet "-e" "(pp (seq [i :range (1 10)] i))"] :p
{:out outfile})
(file/flush outfile)
(file/close outfile)
@@ -256,7 +259,7 @@
(ev/cancel fiber "boop")
# f0dbc2e
(assert (os/execute [janet "-e" `(+ 1 2 3)`] :xp) "os/execute self")
(assert (os/execute [;run janet "-e" `(+ 1 2 3)`] :xp) "os/execute self")
# Test some channel
# e76b8da26

View File

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

View File

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

View File

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

View File

@@ -307,12 +307,12 @@
(check-deep '(uint 2) "\xff\x7f" @[0x7fff])
(check-deep '(uint-be 2) "\x7f\xff" @[0x7fff])
(check-deep '(uint-be 2) "\x7f\xff" @[0x7fff])
(check-deep '(uint 8) "\xff\x7f\x00\x00\x00\x00\x00\x00"
@[(int/u64 0x7fff)])
(check-deep '(int 8) "\xff\x7f\x00\x00\x00\x00\x00\x00"
@[(int/s64 0x7fff)])
(check-deep '(uint 7) "\xff\x7f\x00\x00\x00\x00\x00" @[(int/u64 0x7fff)])
(check-deep '(int 7) "\xff\x7f\x00\x00\x00\x00\x00" @[(int/s64 0x7fff)])
(when-let [u64 int/u64
i64 int/s64]
(check-deep '(uint 8) "\xff\x7f\x00\x00\x00\x00\x00\x00" @[(u64 0x7fff)])
(check-deep '(int 8) "\xff\x7f\x00\x00\x00\x00\x00\x00" @[(i64 0x7fff)])
(check-deep '(uint 7) "\xff\x7f\x00\x00\x00\x00\x00" @[(u64 0x7fff)])
(check-deep '(int 7) "\xff\x7f\x00\x00\x00\x00\x00" @[(i64 0x7fff)]))
(check-deep '(* (int 2) -1) "123" nil)
@@ -367,7 +367,7 @@
(set "!$%&*+-./:<?=>@^_|"))
:token (some :symchars)
:hex (range "09" "af" "AF")
:escape (* "\\" (+ (set "ntrvzf0e\"\\")
:escape (* "\\" (+ (set `"'0?\abefnrtvz`)
(* "x" :hex :hex)
(error (constant "bad hex escape"))))
:comment (/ '(* "#" (any (if-not (+ "\n" -1) 1))) (constant :comment))

View File

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

View File

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

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

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