mirror of
https://github.com/janet-lang/janet
synced 2025-11-06 10:33:03 +00:00
Compare commits
276 Commits
v1.10.1
...
consolidat
| Author | SHA1 | Date | |
|---|---|---|---|
|
|
d199c817dc | ||
|
|
dc51bd09f7 | ||
|
|
139e3fab25 | ||
|
|
7a98f9aa02 | ||
|
|
b53dd67e74 | ||
|
|
e546731093 | ||
|
|
d50c4ef6da | ||
|
|
7d0b1955a2 | ||
|
|
16cf7681f0 | ||
|
|
12f09ad2d7 | ||
|
|
b3e88a8d80 | ||
|
|
761273bcc4 | ||
|
|
1a75f68cb2 | ||
|
|
1b0edf54f1 | ||
|
|
caa6576719 | ||
|
|
93bd2c11fa | ||
|
|
2be09790a9 | ||
|
|
bf6eae711a | ||
|
|
69b68c0091 | ||
|
|
6f1d5d3b73 | ||
|
|
099a912992 | ||
|
|
56b1ea3726 | ||
|
|
d6391f2d70 | ||
|
|
07910272e2 | ||
|
|
1092013c2b | ||
|
|
0db83bd787 | ||
|
|
f55316eabc | ||
|
|
840f59934e | ||
|
|
75a9c59ad8 | ||
|
|
adfccd33ae | ||
|
|
9d41243c15 | ||
|
|
e33e182eb0 | ||
|
|
4dffd662f0 | ||
|
|
5064d579d4 | ||
|
|
540425a41b | ||
|
|
4d21b582c7 | ||
|
|
f288bc1790 | ||
|
|
8942e348bd | ||
|
|
9f27336827 | ||
|
|
f517cccf7b | ||
|
|
3a937ace51 | ||
|
|
b8661f8bff | ||
|
|
51828ab5f8 | ||
|
|
84fe5d7f34 | ||
|
|
2891d2b260 | ||
|
|
edfb861a5f | ||
|
|
88c1cf3ee7 | ||
|
|
813e3fdcfd | ||
|
|
bbe10e4938 | ||
|
|
cb4903fa86 | ||
|
|
ea45165db8 | ||
|
|
1fba699ed4 | ||
|
|
ce3d574c41 | ||
|
|
7a601a7eb2 | ||
|
|
9ec66ab826 | ||
|
|
ebfa07f8ce | ||
|
|
964a800d51 | ||
|
|
5c05dec65a | ||
|
|
bf6ebc4a68 | ||
|
|
2e944931b3 | ||
|
|
db67538311 | ||
|
|
307c7e00e2 | ||
|
|
45feb55483 | ||
|
|
0a1d902f46 | ||
|
|
959a577b5f | ||
|
|
b91fe8be5a | ||
|
|
d1f0a13ddc | ||
|
|
c455bdad11 | ||
|
|
bc1ef813c2 | ||
|
|
603791c0ba | ||
|
|
8091b1289f | ||
|
|
cc0035b1d7 | ||
|
|
ceba1ba4ee | ||
|
|
468e13501c | ||
|
|
32bf70571a | ||
|
|
95f4bd8e23 | ||
|
|
4c9624db64 | ||
|
|
2cbf4d8ad1 | ||
|
|
524c9b50d4 | ||
|
|
d3147b661b | ||
|
|
d3182dce51 | ||
|
|
8763df1cd0 | ||
|
|
15e05b692c | ||
|
|
2bf5e341d3 | ||
|
|
b53890ddae | ||
|
|
93602ad9ea | ||
|
|
191d0001f4 | ||
|
|
1a04ce33f1 | ||
|
|
babfe50550 | ||
|
|
ff57b3eb72 | ||
|
|
1837e89fe4 | ||
|
|
24b8b0e382 | ||
|
|
321a758ab9 | ||
|
|
1a9c14acde | ||
|
|
e8734c77b4 | ||
|
|
1eb00a9f74 | ||
|
|
922a21d359 | ||
|
|
4a4f314768 | ||
|
|
3c64596ea1 | ||
|
|
33283b1b6e | ||
|
|
2f89bdc672 | ||
|
|
2d275c4782 | ||
|
|
25156eb83e | ||
|
|
39032b45c9 | ||
|
|
821a8dca3b | ||
|
|
0145b133a1 | ||
|
|
b0b137d7f0 | ||
|
|
b0c09153c2 | ||
|
|
0485078c6c | ||
|
|
7079cc43c9 | ||
|
|
e7fca0051e | ||
|
|
6273e56886 | ||
|
|
8b9ad2dce8 | ||
|
|
301cbb0e68 | ||
|
|
5313963baf | ||
|
|
f60348eee4 | ||
|
|
a31e079f93 | ||
|
|
556edc9f0d | ||
|
|
17d0b7a985 | ||
|
|
86e00e865e | ||
|
|
5dda83dc73 | ||
|
|
28439d822a | ||
|
|
b1d8ee19ca | ||
|
|
f7c556ed8d | ||
|
|
5377e10532 | ||
|
|
30522bbf7d | ||
|
|
58374623b7 | ||
|
|
7e7498350f | ||
|
|
06c268c274 | ||
|
|
9b36e2b145 | ||
|
|
ca75f8dc20 | ||
|
|
6f2f3fdb68 | ||
|
|
c903e49a4f | ||
|
|
9121feb44f | ||
|
|
7b42ed66f2 | ||
|
|
fb26c9b2c4 | ||
|
|
78ffb63429 | ||
|
|
1213990b7d | ||
|
|
c3af30d520 | ||
|
|
2598123140 | ||
|
|
40627191f3 | ||
|
|
38dc844e85 | ||
|
|
abc4405a76 | ||
|
|
243c66442d | ||
|
|
9afcec77f6 | ||
|
|
70ad98cc6f | ||
|
|
76cfbde933 | ||
|
|
f200bd9594 | ||
|
|
4d4ca7bb36 | ||
|
|
78c3c6dafa | ||
|
|
6d859dec67 | ||
|
|
3563e7e1aa | ||
|
|
cb898fabf4 | ||
|
|
5899671d96 | ||
|
|
8c1eb23aa1 | ||
|
|
b564087db0 | ||
|
|
1748e8510e | ||
|
|
742c5bb639 | ||
|
|
297de01d95 | ||
|
|
fb31c3b46d | ||
|
|
ba2beffcd8 | ||
|
|
2eb2dddb59 | ||
|
|
0601d851d0 | ||
|
|
b731f6ab03 | ||
|
|
0403e306ed | ||
|
|
d393fbf360 | ||
|
|
4cc680965c | ||
|
|
ba08e487cb | ||
|
|
d37eda4e9b | ||
|
|
3960d0f6de | ||
|
|
5be5e5b58f | ||
|
|
04ac9b8e32 | ||
|
|
409a8a3a43 | ||
|
|
1ba3f72e4c | ||
|
|
3e5e9e57e9 | ||
|
|
02e5e49de2 | ||
|
|
43438d3824 | ||
|
|
8f82d19fd1 | ||
|
|
ee450bcd77 | ||
|
|
553b4d9428 | ||
|
|
df145f4bc9 | ||
|
|
fa55283f62 | ||
|
|
9e163db491 | ||
|
|
286230f477 | ||
|
|
3ba2c7e7e8 | ||
|
|
b4f5e5bc00 | ||
|
|
f580d2e41a | ||
|
|
cd197e8be3 | ||
|
|
51cf6465ff | ||
|
|
a1feb32a2f | ||
|
|
7478ad115f | ||
|
|
9d8e338a11 | ||
|
|
ed4163cfde | ||
|
|
bd95f742c0 | ||
|
|
463e6d9316 | ||
|
|
3358811788 | ||
|
|
a45509d28e | ||
|
|
9ba94d2c6b | ||
|
|
a4de83b3a3 | ||
|
|
68a12d1d17 | ||
|
|
c97d3cf359 | ||
|
|
4721337c7c | ||
|
|
2b36ed967c | ||
|
|
3bb8f1ac8d | ||
|
|
617ec7f565 | ||
|
|
dc259b9f8e | ||
|
|
7b31a87b3c | ||
|
|
37a430c97c | ||
|
|
f264cb0b18 | ||
|
|
6ea530cc48 | ||
|
|
a0abf307b4 | ||
|
|
55cf9f5e1c | ||
|
|
b89f0fac7b | ||
|
|
8b3b3182bd | ||
|
|
97c64f27ff | ||
|
|
e548e1f6e0 | ||
|
|
7ea1c7d85a | ||
|
|
e08235b575 | ||
|
|
783c672130 | ||
|
|
5351a6b2ed | ||
|
|
a110b103e8 | ||
|
|
c26f573620 | ||
|
|
f06e9ae30c | ||
|
|
f5d208d5d6 | ||
|
|
7fb8c4a68d | ||
|
|
647fc56d47 | ||
|
|
597d84e263 | ||
|
|
977b0c3c0c | ||
|
|
1b0d6de735 | ||
|
|
2f5bb7774e | ||
|
|
5565f02dbd | ||
|
|
17a131ac21 | ||
|
|
9a5cfe9f75 | ||
|
|
cc936d9977 | ||
|
|
e9911fee4d | ||
|
|
aefde67aa2 | ||
|
|
a1ea62a923 | ||
|
|
7209ced446 | ||
|
|
db63d352a2 | ||
|
|
289de840fd | ||
|
|
cb34a8b620 | ||
|
|
95c633914f | ||
|
|
d033412b1f | ||
|
|
9c5e97144d | ||
|
|
8b96289e2f | ||
|
|
51ff43e2f2 | ||
|
|
1e30f4f973 | ||
|
|
36f66661f7 | ||
|
|
de27fc15b6 | ||
|
|
f9f90ba1d6 | ||
|
|
51bf8a3538 | ||
|
|
7b033a48a3 | ||
|
|
1b420f69aa | ||
|
|
6a187a384b | ||
|
|
ac5de1f96e | ||
|
|
6c917f686a | ||
|
|
328ee94412 | ||
|
|
de9951594e | ||
|
|
561fc15ae9 | ||
|
|
d65814c53f | ||
|
|
803f17aa90 | ||
|
|
08a3687eb5 | ||
|
|
c4035b2273 | ||
|
|
5c364e0f7c | ||
|
|
b1a4f05b5a | ||
|
|
ce2079104a | ||
|
|
d64e9b6263 | ||
|
|
123710078d | ||
|
|
ec0d0ba368 | ||
|
|
3f434f2a44 | ||
|
|
71d8e6b4cd | ||
|
|
a78af0a7fb | ||
|
|
117ae196fd | ||
|
|
4c211c8dce | ||
|
|
c10d9b9d9d | ||
|
|
b68b0a256e |
@@ -10,3 +10,5 @@ tasks:
|
||||
cd build
|
||||
ninja
|
||||
ninja test
|
||||
doas ninja install
|
||||
doas jpm --verbose install circlet
|
||||
|
||||
15
.builds/meson2.yml
Normal file
15
.builds/meson2.yml
Normal file
@@ -0,0 +1,15 @@
|
||||
image: openbsd/latest
|
||||
sources:
|
||||
- https://git.sr.ht/~bakpakin/janet
|
||||
packages:
|
||||
- meson
|
||||
tasks:
|
||||
- build: |
|
||||
cd janet
|
||||
meson setup build --buildtype=release
|
||||
cd build
|
||||
meson configure -Dprf=true
|
||||
ninja
|
||||
ninja test
|
||||
doas ninja install
|
||||
doas jpm --verbose install circlet
|
||||
@@ -17,7 +17,6 @@ tasks:
|
||||
meson configure -Dpeg=false
|
||||
meson configure -Dassembler=false
|
||||
meson configure -Dint_types=false
|
||||
meson configure -Dtyped_arrays=false
|
||||
meson configure -Dtyped_array=false
|
||||
meson configure -Dreduced_os=true
|
||||
meson configure -Dprf=false
|
||||
ninja # will not pass tests but should build
|
||||
|
||||
10
.gitattributes
vendored
Normal file
10
.gitattributes
vendored
Normal file
@@ -0,0 +1,10 @@
|
||||
*.janet linguist-language=Clojure
|
||||
|
||||
*.janet text eol=lf
|
||||
*.c text eol=lf
|
||||
*.h text eol=lf
|
||||
*.md text eol=lf
|
||||
*.yml text eol=lf
|
||||
*.build text eol=lf
|
||||
*.txt text eol=lf
|
||||
*.sh text eol=lf
|
||||
9
.gitignore
vendored
9
.gitignore
vendored
@@ -32,6 +32,9 @@ lockfile.janet
|
||||
# Local directory for testing
|
||||
local
|
||||
|
||||
# Common test file I use.
|
||||
temp.janet
|
||||
|
||||
# Emscripten
|
||||
*.bc
|
||||
janet.js
|
||||
@@ -43,6 +46,7 @@ janet.wasm
|
||||
|
||||
# Generate test files
|
||||
*.out
|
||||
.orig
|
||||
|
||||
# Tools
|
||||
xxd
|
||||
@@ -50,6 +54,7 @@ xxd.exe
|
||||
|
||||
# VSCode
|
||||
.vs
|
||||
.clangd
|
||||
|
||||
# Swap files
|
||||
*.swp
|
||||
@@ -61,6 +66,10 @@ tags
|
||||
vgcore.*
|
||||
*.out.*
|
||||
|
||||
# Wix artifacts
|
||||
*.msi
|
||||
*.wixpdb
|
||||
|
||||
# Created by https://www.gitignore.io/api/c
|
||||
|
||||
### C ###
|
||||
|
||||
81
CHANGELOG.md
81
CHANGELOG.md
@@ -1,6 +1,87 @@
|
||||
# Changelog
|
||||
All notable changes to this project will be documented in this file.
|
||||
|
||||
## Unreleased - ???
|
||||
- Add `janet_thread_current(void)` to C API
|
||||
- Add integer parsing forms to pegs. This makes parsing many binary protocols easier.
|
||||
- Lots of updates to networking code - now can use epoll (or poll) on linux and IOCP on windows.
|
||||
- Add `ev/` module. This exposes a fiber scheduler, queues, timeouts, and other functionality to users
|
||||
for single threaded cooperative scheduling and asynchornous IO.
|
||||
- Add `net/accept-loop` and `net/listen`. These functions break down `net/server` into it's essential parts
|
||||
and are more flexible. They also allow furter improvements to these utility functions.
|
||||
|
||||
## 1.12.2 - 2020-09-20
|
||||
- Add janet\_try and janet\_restore to C API.
|
||||
- Fix `os/execute` regression on windows.
|
||||
- Add :pipe option to `os/spawn`.
|
||||
- Fix docstring typos.
|
||||
|
||||
## 1.12.1 - 2020-09-07
|
||||
- Make `zero?`, `one?`, `pos?`, and `neg?` polymorphic.
|
||||
- Add C++ support to jpm and improve C++ interop in janet.h.
|
||||
- Add `%t` formatter to `printf`, `string/format`, and other formatter functions.
|
||||
- Expose `janet_cfuns_prefix` in C API.
|
||||
- Add `os/proc-wait` and `os/proc-kill` for interacting with processes.
|
||||
- Add `janet_getjfile` to C API.
|
||||
- Allow redirection of stdin, stdout, and stderr by passing keywords in the env table in `os/spawn` and `os/execute`.
|
||||
- Add `os/spawn` to get a core/process back instead of an exit code as in `os/execute`.
|
||||
When called like this, `os/execute` returns immediately.
|
||||
- Add `:x` flag to os/execute to raise error when exit code is non-zero.
|
||||
- Don't run `main` when flychecking.
|
||||
- Add `:n` flag to `file/open` to raise an error if file cannot be opened.
|
||||
- Fix import macro to not try and coerce everything to a string.
|
||||
- Allow passing a second argument to `disasm`.
|
||||
- Add `cancel`. Resumes a fiber but makes it immediately error at the yield point.
|
||||
- Allow multi-line paste into built in repl.
|
||||
- Add `(curenv)`.
|
||||
- Change `net/read`, `net/chunk`, and `net/write` to raise errors in the case of failures.
|
||||
- Add `janet_continue_signal` to C API. This indirectly enables C functions that yield to the event loop
|
||||
to raise errors or other signals.
|
||||
- Update meson build script to fix bug on Debian's version of meson
|
||||
- Add `xprint`, `xprin`, `xprintf`, and `xprinf`.
|
||||
- `net/write` now raises an error message if write fails.
|
||||
- Fix issue with SIGPIPE on macOS and BSDs.
|
||||
|
||||
## 1.11.3 - 2020-08-03
|
||||
- Add `JANET_HASHSEED` environment variable when `JANET_PRF` is enabled.
|
||||
- Expose `janet_cryptorand` in C API.
|
||||
- Properly initialize PRF in default janet program
|
||||
- Add `index-of` to core library.
|
||||
- Add `-fPIC` back to core CFLAGS (non-optional when compiling default client with Makefile)
|
||||
- Fix defaults on Windows for ARM
|
||||
- Fix defaults on NetBSD.
|
||||
|
||||
## 1.11.1 - 2020-07-25
|
||||
- Fix jpm and git with multiple git installs on Windows
|
||||
- Fix importing a .so file in the current directory
|
||||
- Allow passing byte sequence types directly to typed-array constructors.
|
||||
- Fix bug sending files between threads.
|
||||
- Disable PRF by default.
|
||||
- Update the soname.
|
||||
|
||||
## 1.11.0 - 2020-07-18
|
||||
- Add `forever` macro.
|
||||
- Add `any?` predicate to core.
|
||||
- Add `jpm list-pkgs` subcommand to see which package aliases are in the listing.
|
||||
- Add `jpm list-installed` subcommand to see which packages are installed.
|
||||
- Add `math/int-min`, `math/int-max`, `math/int32-min`, and `math/int32-max` for getting integer limits.
|
||||
- The gc interval is now autotuned, to prevent very bad gc behavior.
|
||||
- Improvements to the bytecode compiler, Janet will now generate more efficient bytecode.
|
||||
- Add `peg/find`, `peg/find-all`, `peg/replace`, and `peg/replace-all`
|
||||
- Add `math/nan`
|
||||
- Add `forv` macro
|
||||
- Add `symbol/slice`
|
||||
- Add `keyword/slice`
|
||||
- Allow cross compilation with Makefile.
|
||||
- Change `compare-primitve` to `cmp` and make it more efficient.
|
||||
- Add `reverse!` for reversing an array or buffer in place.
|
||||
- `janet_dobytes` and `janet_dostring` return parse errors in \*out
|
||||
- Add `repeat` macro for iterating something n times.
|
||||
- Add `eachy` (each yield) macro for iterating a fiber.
|
||||
- Fix `:generate` verb in loop macro to accept non symbols as bindings.
|
||||
- Add `:h`, `:h+`, and `:h*` in `default-peg-grammar` for hexidecimal digits.
|
||||
- Fix `%j` formatter to print numbers precisely (using the `%.17g` format string to printf).
|
||||
|
||||
## 1.10.1 - 2020-06-18
|
||||
- Expose `janet_table_clear` in API.
|
||||
- Respect `JANET_NO_PROCESSES` define when building
|
||||
|
||||
60
Makefile
60
Makefile
@@ -33,13 +33,20 @@ JANET_TARGET=build/janet
|
||||
JANET_LIBRARY=build/libjanet.so
|
||||
JANET_STATIC_LIBRARY=build/libjanet.a
|
||||
JANET_PATH?=$(LIBDIR)/janet
|
||||
MANPATH?=$(PREFIX)/share/man/man1/
|
||||
PKG_CONFIG_PATH?=$(LIBDIR)/pkgconfig
|
||||
JANET_MANPATH?=$(PREFIX)/share/man/man1/
|
||||
JANET_PKG_CONFIG_PATH?=$(LIBDIR)/pkgconfig
|
||||
DEBUGGER=gdb
|
||||
SONAME_SETTER=-Wl,-soname,
|
||||
|
||||
CFLAGS:=$(CFLAGS) -std=c99 -Wall -Wextra -Isrc/include -Isrc/conf -fPIC -O2 -fvisibility=hidden
|
||||
LDFLAGS:=$(LDFLAGS) -rdynamic
|
||||
# For cross compilation
|
||||
HOSTCC?=$(CC)
|
||||
HOSTAR?=$(AR)
|
||||
CFLAGS?=-O2
|
||||
LDFLAGS?=-rdynamic
|
||||
|
||||
COMMON_CFLAGS:=-std=c99 -Wall -Wextra -Isrc/include -Isrc/conf -fvisibility=hidden -fPIC
|
||||
BOOT_CFLAGS:=-DJANET_BOOTSTRAP -DJANET_BUILD=$(JANET_BUILD) -O0 -g $(COMMON_CFLAGS)
|
||||
BUILD_CFLAGS:=$(CFLAGS) $(COMMON_CFLAGS)
|
||||
|
||||
# For installation
|
||||
LDCONFIG:=ldconfig "$(LIBDIR)"
|
||||
@@ -90,6 +97,7 @@ JANET_CORE_SOURCES=src/core/abstract.c \
|
||||
src/core/corelib.c \
|
||||
src/core/debug.c \
|
||||
src/core/emit.c \
|
||||
src/core/ev.c \
|
||||
src/core/fiber.c \
|
||||
src/core/gc.c \
|
||||
src/core/inttypes.c \
|
||||
@@ -131,11 +139,10 @@ JANET_BOOT_HEADERS=src/boot/tests.h
|
||||
##########################################################
|
||||
|
||||
JANET_BOOT_OBJECTS=$(patsubst src/%.c,build/%.boot.o,$(JANET_CORE_SOURCES) $(JANET_BOOT_SOURCES))
|
||||
BOOT_CFLAGS:=-DJANET_BOOTSTRAP -DJANET_BUILD=$(JANET_BUILD) $(CFLAGS)
|
||||
|
||||
$(JANET_BOOT_OBJECTS): $(JANET_BOOT_HEADERS)
|
||||
|
||||
build/%.boot.o: src/%.c $(JANET_HEADERS) $(JANET_LOCAL_HEADERS)
|
||||
build/%.boot.o: src/%.c $(JANET_HEADERS) $(JANET_LOCAL_HEADERS) Makefile
|
||||
$(CC) $(BOOT_CFLAGS) -o $@ -c $<
|
||||
|
||||
build/janet_boot: $(JANET_BOOT_OBJECTS)
|
||||
@@ -143,13 +150,14 @@ build/janet_boot: $(JANET_BOOT_OBJECTS)
|
||||
|
||||
# Now the reason we bootstrap in the first place
|
||||
build/janet.c: build/janet_boot src/boot/boot.janet
|
||||
build/janet_boot . JANET_PATH '$(JANET_PATH)' JANET_HEADERPATH '$(INCLUDEDIR)/janet' > $@
|
||||
build/janet_boot . JANET_PATH '$(JANET_PATH)' > $@
|
||||
cksum $@
|
||||
|
||||
########################
|
||||
##### Amalgamation #####
|
||||
########################
|
||||
|
||||
SONAME=libjanet.so.1.10
|
||||
SONAME=libjanet.so.1.12
|
||||
|
||||
build/shell.c: src/mainclient/shell.c
|
||||
cp $< $@
|
||||
@@ -161,24 +169,26 @@ build/janetconf.h: src/conf/janetconf.h
|
||||
cp $< $@
|
||||
|
||||
build/janet.o: build/janet.c build/janet.h build/janetconf.h
|
||||
$(CC) $(CFLAGS) -c $< -o $@ -I build
|
||||
$(HOSTCC) $(BUILD_CFLAGS) -c $< -o $@ -I build
|
||||
|
||||
build/shell.o: build/shell.c build/janet.h build/janetconf.h
|
||||
$(CC) $(CFLAGS) -c $< -o $@ -I build
|
||||
$(HOSTCC) $(BUILD_CFLAGS) -c $< -o $@ -I build
|
||||
|
||||
$(JANET_TARGET): build/janet.o build/shell.o
|
||||
$(CC) $(LDFLAGS) $(CFLAGS) -o $@ $^ $(CLIBS)
|
||||
$(HOSTCC) $(LDFLAGS) $(BUILD_CFLAGS) -o $@ $^ $(CLIBS)
|
||||
|
||||
$(JANET_LIBRARY): build/janet.o build/shell.o
|
||||
$(CC) $(LDFLAGS) $(CFLAGS) $(SONAME_SETTER)$(SONAME) -shared -o $@ $^ $(CLIBS)
|
||||
$(HOSTCC) $(LDFLAGS) $(BUILD_CFLAGS) $(SONAME_SETTER)$(SONAME) -shared -o $@ $^ $(CLIBS)
|
||||
|
||||
$(JANET_STATIC_LIBRARY): build/janet.o build/shell.o
|
||||
$(AR) rcs $@ $^
|
||||
$(HOSTAR) rcs $@ $^
|
||||
|
||||
###################
|
||||
##### Testing #####
|
||||
###################
|
||||
|
||||
# Testing assumes HOSTCC=CC
|
||||
|
||||
TEST_SCRIPTS=$(wildcard test/suite*.janet)
|
||||
|
||||
repl: $(JANET_TARGET)
|
||||
@@ -252,7 +262,7 @@ build/janet.pc: $(JANET_TARGET)
|
||||
echo 'Libs: -L$${libdir} -ljanet' >> $@
|
||||
echo 'Libs.private: $(CLIBS)' >> $@
|
||||
|
||||
install: $(JANET_TARGET) build/janet.pc build/jpm
|
||||
install: $(JANET_TARGET) $(JANET_LIBRARY) $(JANET_STATIC_LIBRARY) build/janet.pc build/jpm
|
||||
mkdir -p '$(DESTDIR)$(BINDIR)'
|
||||
cp $(JANET_TARGET) '$(DESTDIR)$(BINDIR)/janet'
|
||||
mkdir -p '$(DESTDIR)$(INCLUDEDIR)/janet'
|
||||
@@ -264,11 +274,11 @@ install: $(JANET_TARGET) build/janet.pc build/jpm
|
||||
ln -sf $(SONAME) '$(DESTDIR)$(LIBDIR)/libjanet.so'
|
||||
ln -sf libjanet.so.$(shell $(JANET_TARGET) -e '(print janet/version)') $(DESTDIR)$(LIBDIR)/$(SONAME)
|
||||
cp -rf build/jpm '$(DESTDIR)$(BINDIR)'
|
||||
mkdir -p '$(DESTDIR)$(MANPATH)'
|
||||
cp janet.1 '$(DESTDIR)$(MANPATH)'
|
||||
cp jpm.1 '$(DESTDIR)$(MANPATH)'
|
||||
mkdir -p '$(DESTDIR)$(PKG_CONFIG_PATH)'
|
||||
cp build/janet.pc '$(DESTDIR)$(PKG_CONFIG_PATH)/janet.pc'
|
||||
mkdir -p '$(DESTDIR)$(JANET_MANPATH)'
|
||||
cp janet.1 '$(DESTDIR)$(JANET_MANPATH)'
|
||||
cp jpm.1 '$(DESTDIR)$(JANET_MANPATH)'
|
||||
mkdir -p '$(DESTDIR)$(JANET_PKG_CONFIG_PATH)'
|
||||
cp build/janet.pc '$(DESTDIR)$(JANET_PKG_CONFIG_PATH)/janet.pc'
|
||||
[ -z '$(DESTDIR)' ] && $(LDCONFIG) || true
|
||||
|
||||
uninstall:
|
||||
@@ -276,9 +286,9 @@ uninstall:
|
||||
-rm '$(DESTDIR)$(BINDIR)/jpm'
|
||||
-rm -rf '$(DESTDIR)$(INCLUDEDIR)/janet'
|
||||
-rm -rf '$(DESTDIR)$(LIBDIR)'/libjanet.*
|
||||
-rm '$(DESTDIR)$(PKG_CONFIG_PATH)/janet.pc'
|
||||
-rm '$(DESTDIR)$(MANPATH)/janet.1'
|
||||
-rm '$(DESTDIR)$(MANPATH)/jpm.1'
|
||||
-rm '$(DESTDIR)$(JANET_PKG_CONFIG_PATH)/janet.pc'
|
||||
-rm '$(DESTDIR)$(JANET_MANPATH)/janet.1'
|
||||
-rm '$(DESTDIR)$(JANET_MANPATH)/jpm.1'
|
||||
# -rm -rf '$(DESTDIR)$(JANET_PATH)'/* - err on the side of correctness here
|
||||
|
||||
#################
|
||||
@@ -292,6 +302,10 @@ grammar: build/janet.tmLanguage
|
||||
build/janet.tmLanguage: tools/tm_lang_gen.janet $(JANET_TARGET)
|
||||
$(JANET_TARGET) $< > $@
|
||||
|
||||
compile-commands:
|
||||
# Requires pip install copmiledb
|
||||
compiledb make
|
||||
|
||||
clean:
|
||||
-rm -rf build vgcore.* callgrind.*
|
||||
-rm -rf test/install/build test/install/modpath
|
||||
@@ -333,4 +347,4 @@ help:
|
||||
@echo
|
||||
|
||||
.PHONY: clean install repl debug valgrind test \
|
||||
valtest dist uninstall docs grammar format help
|
||||
valtest dist uninstall docs grammar format help compile-commands
|
||||
|
||||
59
README.md
59
README.md
@@ -2,10 +2,10 @@
|
||||
|
||||
[](https://ci.appveyor.com/project/bakpakin/janet/branch/master)
|
||||
[](https://travis-ci.org/janet-lang/janet)
|
||||
[](https://builds.sr.ht/~bakpakin/janet/freebsd.yml?)
|
||||
[](https://builds.sr.ht/~bakpakin/janet/openbsd.yml?)
|
||||
[](https://builds.sr.ht/~bakpakin/janet/meson.yml?)
|
||||
[](https://builds.sr.ht/~bakpakin/janet/meson_min.yml?)
|
||||
[](https://builds.sr.ht/~bakpakin/janet/commits/freebsd.yml?)
|
||||
[](https://builds.sr.ht/~bakpakin/janet/commits/openbsd.yml?)
|
||||
[](https://builds.sr.ht/~bakpakin/janet/commits/meson.yml?)
|
||||
[](https://builds.sr.ht/~bakpakin/janet/commits/meson_min.yml?)
|
||||
|
||||
<img src="https://raw.githubusercontent.com/janet-lang/janet/master/assets/janet-w200.png" alt="Janet logo" width=200 align="left">
|
||||
|
||||
@@ -14,9 +14,9 @@ lisp-like language, but lists are replaced
|
||||
by other data structures (arrays, tables (hash table), struct (immutable hash table), tuples).
|
||||
The language also supports bridging to native code written in C, meta-programming with macros, and bytecode assembly.
|
||||
|
||||
There is a repl for trying out the language, as well as the ability
|
||||
There is a REPL for trying out the language, as well as the ability
|
||||
to run script files. This client program is separate from the core runtime, so
|
||||
Janet can be embedded into other programs. Try Janet in your browser at
|
||||
Janet can be embedded in other programs. Try Janet in your browser at
|
||||
[https://janet-lang.org](https://janet-lang.org).
|
||||
|
||||
<br>
|
||||
@@ -30,23 +30,23 @@ Lua, but smaller than GNU Guile or Python.
|
||||
## Features
|
||||
|
||||
* Minimal setup - one binary and you are good to go!
|
||||
* First class closures
|
||||
* First-class closures
|
||||
* Garbage collection
|
||||
* First class green threads (continuations)
|
||||
* Python style generators (implemented as a plain macro)
|
||||
* First-class green threads (continuations)
|
||||
* Python-style generators (implemented as a plain macro)
|
||||
* Mutable and immutable arrays (array/tuple)
|
||||
* Mutable and immutable hashtables (table/struct)
|
||||
* Mutable and immutable strings (buffer/string)
|
||||
* Macros
|
||||
* Byte code interpreter with an assembly interface, as well as bytecode verification
|
||||
* Tailcall Optimization
|
||||
* Tail call Optimization
|
||||
* Direct interop with C via abstract types and C functions
|
||||
* Dynamically load C libraries
|
||||
* Functional and imperative standard library
|
||||
* Lexical scoping
|
||||
* Imperative programming as well as functional
|
||||
* REPL
|
||||
* Parsing Expression Grammars built in to the core library
|
||||
* Parsing Expression Grammars built into the core library
|
||||
* 400+ functions and macros in the core library
|
||||
* Embedding Janet in other programs
|
||||
* Interactive environment with detailed stack traces
|
||||
@@ -56,7 +56,7 @@ Lua, but smaller than GNU Guile or Python.
|
||||
* For a quick tutorial, see [the introduction](https://janet-lang.org/docs/index.html) for more details.
|
||||
* For the full API for all functions in the core library, see [the core API doc](https://janet-lang.org/api/index.html)
|
||||
|
||||
Documentation is also available locally in the repl.
|
||||
Documentation is also available locally in the REPL.
|
||||
Use the `(doc symbol-name)` macro to get API
|
||||
documentation for symbols in the core library. For example,
|
||||
```
|
||||
@@ -66,7 +66,7 @@ Shows documentation for the doc macro.
|
||||
|
||||
To get a list of all bindings in the default
|
||||
environment, use the `(all-bindings)` function. You
|
||||
can also use the `(doc)` macro with no arguments if you are in the repl
|
||||
can also use the `(doc)` macro with no arguments if you are in the REPL
|
||||
to show bound symbols.
|
||||
|
||||
## Source
|
||||
@@ -92,7 +92,7 @@ Find out more about the available make targets by running `make help`.
|
||||
|
||||
### 32-bit Haiku
|
||||
|
||||
32-bit Haiku build instructions are the same as the unix-like build instructions,
|
||||
32-bit Haiku build instructions are the same as the UNIX-like build instructions,
|
||||
but you need to specify an alternative compiler, such as `gcc-x86`.
|
||||
|
||||
```
|
||||
@@ -104,7 +104,7 @@ make repl
|
||||
|
||||
### FreeBSD
|
||||
|
||||
FreeBSD build instructions are the same as the unix-like build instuctions,
|
||||
FreeBSD build instructions are the same as the UNIX-like build instructions,
|
||||
but you need `gmake` to compile. Alternatively, install directly from
|
||||
packages, using `pkg install lang/janet`.
|
||||
|
||||
@@ -115,6 +115,11 @@ gmake test
|
||||
gmake repl
|
||||
```
|
||||
|
||||
### NetBSD
|
||||
|
||||
NetBSD build instructions are the same as the FreeBSD build instructions.
|
||||
Alternatively, install directly from packages, using `pkgin install janet`.
|
||||
|
||||
### Windows
|
||||
|
||||
1. Install [Visual Studio](https://visualstudio.microsoft.com/thank-you-downloading-visual-studio/?sku=Community&rel=15#) or [Visual Studio Build Tools](https://visualstudio.microsoft.com/thank-you-downloading-visual-studio/?sku=BuildTools&rel=15#)
|
||||
@@ -131,11 +136,11 @@ Now you should have an `.msi`. You can run `build_win install` to install the `.
|
||||
|
||||
### Meson
|
||||
|
||||
Janet also has a build file for [Meson](https://mesonbuild.com/), a cross platform build
|
||||
system. Although Meson has a python dependency, Meson is a very complete build system that
|
||||
Janet also has a build file for [Meson](https://mesonbuild.com/), a cross-platform build
|
||||
system. Although Meson has a Python dependency, Meson is a very complete build system that
|
||||
is maybe more convenient and flexible for integrating into existing pipelines.
|
||||
Meson also provides much better IDE integration than Make or batch files, as well as support
|
||||
for cross compilation.
|
||||
for cross-compilation.
|
||||
|
||||
For the impatient, building with Meson is as follows. The options provided to
|
||||
`meson setup` below emulate Janet's Makefile.
|
||||
@@ -172,11 +177,11 @@ to try out the language, you don't need to install anything. You can also move t
|
||||
|
||||
## Usage
|
||||
|
||||
A repl is launched when the binary is invoked with no arguments. Pass the -h flag
|
||||
A REPL is launched when the binary is invoked with no arguments. Pass the -h flag
|
||||
to display the usage information. Individual scripts can be run with `./janet myscript.janet`
|
||||
|
||||
If you are looking to explore, you can print a list of all available macros, functions, and constants
|
||||
by entering the command `(all-bindings)` into the repl.
|
||||
by entering the command `(all-bindings)` into the REPL.
|
||||
|
||||
```
|
||||
$ janet
|
||||
@@ -194,13 +199,13 @@ Options are:
|
||||
-v : Print the version string
|
||||
-s : Use raw stdin instead of getline like functionality
|
||||
-e code : Execute a string of janet
|
||||
-r : Enter the repl after running all scripts
|
||||
-p : Keep on executing if there is a top level error (persistent)
|
||||
-q : Hide prompt, logo, and repl output (quiet)
|
||||
-r : Enter the REPL after running all scripts
|
||||
-p : Keep on executing if there is a top-level error (persistent)
|
||||
-q : Hide prompt, logo, and REPL output (quiet)
|
||||
-k : Compile scripts but do not execute (flycheck)
|
||||
-m syspath : Set system path for loading global modules
|
||||
-c source output : Compile janet source code into an image
|
||||
-n : Disable ANSI color output in the repl
|
||||
-n : Disable ANSI color output in the REPL
|
||||
-l path : Execute code in a file before running the main script
|
||||
-- : Stop handling options
|
||||
```
|
||||
@@ -227,16 +232,16 @@ See the examples directory for some example janet code.
|
||||
|
||||
## Discussion
|
||||
|
||||
Feel free to ask questions and join discussion on the [Janet Gitter Channel](https://gitter.im/janet-language/community).
|
||||
Feel free to ask questions and join the discussion on the [Janet Gitter Channel](https://gitter.im/janet-language/community).
|
||||
Alternatively, check out [the #janet channel on Freenode](https://webchat.freenode.net/)
|
||||
|
||||
## FAQ
|
||||
|
||||
### Why is my terminal spitting out junk when I run the repl?
|
||||
### Why is my terminal spitting out junk when I run the REPL?
|
||||
|
||||
Make sure your terminal supports ANSI escape codes. Most modern terminals will
|
||||
support these, but some older terminals, Windows consoles, or embedded terminals
|
||||
will not. If your terminal does not support ANSI escape codes, run the repl with
|
||||
will not. If your terminal does not support ANSI escape codes, run the REPL with
|
||||
the `-n` flag, which disables color output. You can also try the `-s` if further issues
|
||||
ensue.
|
||||
|
||||
|
||||
@@ -102,6 +102,7 @@ exit /b 0
|
||||
mkdir dist
|
||||
janet.exe tools\gendoc.janet > dist\doc.html
|
||||
janet.exe tools\removecr.janet dist\doc.html
|
||||
janet.exe tools\removecr.janet build\janet.c
|
||||
|
||||
copy build\janet.c dist\janet.c
|
||||
copy src\mainclient\shell.c dist\shell.c
|
||||
|
||||
@@ -1,23 +1,22 @@
|
||||
# Example of dst bytecode assembly
|
||||
|
||||
# Fibonacci sequence, implemented with naive recursion.
|
||||
(def fibasm (asm '{
|
||||
arity 1
|
||||
bytecode [
|
||||
(ltim 1 0 0x2) # $1 = $0 < 2
|
||||
(jmpif 1 :done) # if ($1) goto :done
|
||||
(lds 1) # $1 = self
|
||||
(addim 0 0 -0x1) # $0 = $0 - 1
|
||||
(push 0) # push($0), push argument for next function call
|
||||
(call 2 1) # $2 = call($1)
|
||||
(addim 0 0 -0x1) # $0 = $0 - 1
|
||||
(push 0) # push($0)
|
||||
(call 0 1) # $0 = call($1)
|
||||
(add 0 0 2) # $0 = $0 + $2 (integers)
|
||||
:done
|
||||
(ret 0) # return $0
|
||||
]
|
||||
}))
|
||||
(def fibasm
|
||||
(asm
|
||||
'{:arity 1
|
||||
:bytecode @[(ltim 1 0 0x2) # $1 = $0 < 2
|
||||
(jmpif 1 :done) # if ($1) goto :done
|
||||
(lds 1) # $1 = self
|
||||
(addim 0 0 -0x1) # $0 = $0 - 1
|
||||
(push 0) # push($0), push argument for next function call
|
||||
(call 2 1) # $2 = call($1)
|
||||
(addim 0 0 -0x1) # $0 = $0 - 1
|
||||
(push 0) # push($0)
|
||||
(call 0 1) # $0 = call($1)
|
||||
(add 0 0 2) # $0 = $0 + $2 (integers)
|
||||
:done
|
||||
(ret 0) # return $0
|
||||
]}))
|
||||
|
||||
# Test it
|
||||
|
||||
|
||||
15
examples/channel.janet
Normal file
15
examples/channel.janet
Normal file
@@ -0,0 +1,15 @@
|
||||
(def c (ev/chan 4))
|
||||
|
||||
(defn writer []
|
||||
(for i 0 10
|
||||
(ev/sleep 0.1)
|
||||
(print "writer giving item " i "...")
|
||||
(ev/give c (string "item " i))))
|
||||
|
||||
(defn reader [name]
|
||||
(forever
|
||||
(print "reader " name " got " (ev/take c))))
|
||||
|
||||
(ev/call writer)
|
||||
(each letter [:a :b :c :d :e :f :g]
|
||||
(ev/call reader letter))
|
||||
5
examples/echoclient.janet
Normal file
5
examples/echoclient.janet
Normal file
@@ -0,0 +1,5 @@
|
||||
(with [conn (net/connect "127.0.0.1" 8000)]
|
||||
(print "writing abcdefg...")
|
||||
(:write conn "abcdefg")
|
||||
(print "reading...")
|
||||
(printf "got: %v" (:read conn 1024)))
|
||||
15
examples/echoserve.janet
Normal file
15
examples/echoserve.janet
Normal file
@@ -0,0 +1,15 @@
|
||||
(defn handler
|
||||
"Simple handler for connections."
|
||||
[stream]
|
||||
(defer (:close stream)
|
||||
(def id (gensym))
|
||||
(def b @"")
|
||||
(print "Connection " id "!")
|
||||
(while (:read stream 1024 b)
|
||||
(printf " %v -> %v" id b)
|
||||
(:write stream b)
|
||||
(buffer/clear b))
|
||||
(printf "Done %v!" id)
|
||||
(ev/sleep 0.5)))
|
||||
|
||||
(net/server "127.0.0.1" "8000" handler)
|
||||
12
examples/evsleep.janet
Normal file
12
examples/evsleep.janet
Normal file
@@ -0,0 +1,12 @@
|
||||
(defn worker
|
||||
"Run for a number of iterations."
|
||||
[name iterations]
|
||||
(for i 0 iterations
|
||||
(ev/sleep 1)
|
||||
(print "worker " name " iteration " i)))
|
||||
|
||||
(ev/call worker :a 10)
|
||||
(ev/sleep 0.2)
|
||||
(ev/call worker :b 5)
|
||||
(ev/sleep 0.3)
|
||||
(ev/call worker :c 12)
|
||||
23
examples/select.janet
Normal file
23
examples/select.janet
Normal file
@@ -0,0 +1,23 @@
|
||||
(def channels
|
||||
(seq [:repeat 5] (ev/chan 4)))
|
||||
|
||||
(defn writer [c]
|
||||
(for i 0 3
|
||||
(def item (string i ":" (mod (hash c) 999)))
|
||||
(ev/sleep 0.1)
|
||||
(print "writer giving item " item " to " c "...")
|
||||
(ev/give c item))
|
||||
(print "Done!"))
|
||||
|
||||
(defn reader [name]
|
||||
(forever
|
||||
(def [_ c x] (ev/rselect ;channels))
|
||||
(print "reader " name " got " x " from " c)))
|
||||
|
||||
# Readers
|
||||
(each letter [:a :b :c :d :e :f :g]
|
||||
(ev/call reader letter))
|
||||
|
||||
# Writers
|
||||
(each c channels
|
||||
(ev/call writer c))
|
||||
37
examples/select2.janet
Normal file
37
examples/select2.janet
Normal file
@@ -0,0 +1,37 @@
|
||||
###
|
||||
### examples/select2.janet
|
||||
###
|
||||
### Mix reads and writes in select.
|
||||
###
|
||||
|
||||
(def c1 (ev/chan 40))
|
||||
(def c2 (ev/chan 40))
|
||||
(def c3 (ev/chan 40))
|
||||
(def c4 (ev/chan 40))
|
||||
|
||||
(def c5 (ev/chan 4))
|
||||
|
||||
(defn worker
|
||||
[c n x]
|
||||
(forever
|
||||
(ev/sleep n)
|
||||
(ev/give c x)))
|
||||
|
||||
(defn writer-worker
|
||||
[c]
|
||||
(forever
|
||||
(ev/sleep 0.2)
|
||||
(print "writing " (ev/take c))))
|
||||
|
||||
(ev/call worker c1 1 :item1)
|
||||
(ev/sleep 0.2)
|
||||
(ev/call worker c2 1 :item2)
|
||||
(ev/sleep 0.1)
|
||||
(ev/call worker c3 1 :item3)
|
||||
(ev/sleep 0.2)
|
||||
(ev/call worker c4 1 :item4)
|
||||
(ev/sleep 0.1)
|
||||
(ev/call worker c4 1 :item5)
|
||||
(ev/call writer-worker c5)
|
||||
|
||||
(forever (pp (ev/rselect c1 c2 c3 c4 [c5 :thing])))
|
||||
@@ -6,8 +6,15 @@
|
||||
(def b @"")
|
||||
(print "Connection " id "!")
|
||||
(while (:read stream 1024 b)
|
||||
(repeat 10 (print "work for " id " ...") (ev/sleep 0.1))
|
||||
(:write stream b)
|
||||
(buffer/clear b))
|
||||
(printf "Done %v!" id)))
|
||||
|
||||
(net/server "127.0.0.1" "8000" handler)
|
||||
# Run server.
|
||||
(let [server (net/server "127.0.0.1" "8000")]
|
||||
(print "Starting echo server on 127.0.0.1:8000")
|
||||
(forever
|
||||
(if-let [conn (:accept server)]
|
||||
(ev/call handler conn)
|
||||
(print "no new connections"))))
|
||||
|
||||
5
examples/udpclient.janet
Normal file
5
examples/udpclient.janet
Normal file
@@ -0,0 +1,5 @@
|
||||
(def conn (net/connect "127.0.0.1" "8009" :datagram))
|
||||
(:write conn (string/format "%q" (os/cryptorand 16)))
|
||||
(def x (:read conn 1024))
|
||||
(pp x)
|
||||
|
||||
6
examples/udpserver.janet
Normal file
6
examples/udpserver.janet
Normal file
@@ -0,0 +1,6 @@
|
||||
(def server (net/server "127.0.0.1" "8009" nil :datagram))
|
||||
(while true
|
||||
(def buf @"")
|
||||
(def who (:recv-from server 1024 buf))
|
||||
(printf "got %q from %v, echoing!" buf who)
|
||||
(:send-to server who buf))
|
||||
12
janet.1
12
janet.1
@@ -194,8 +194,8 @@ Source should be a path to the Janet module to compile, and output should be the
|
||||
resulting image. Output should usually end with the .jimage extension.
|
||||
|
||||
.TP
|
||||
.BR \-l\ path
|
||||
Load a Janet file before running a script or repl. Multiple files can be loaded
|
||||
.BR \-l\ lib
|
||||
Import a Janet module before running a script or repl. Multiple files can be loaded
|
||||
in this manner, and exports from each file will be made available to the script
|
||||
or repl.
|
||||
|
||||
@@ -213,5 +213,13 @@ find native and source code modules. If no JANET_PATH is set, Janet will look in
|
||||
the default location set at compile time.
|
||||
.RE
|
||||
|
||||
.B JANET_HASHSEED
|
||||
.RS
|
||||
To disable randomization of Janet's PRF on start up, one can set this variable. This can have the
|
||||
effect of making programs deterministic that otherwise would depend on the random seed chosen at program start.
|
||||
This variable does nothing in the default configuration of Janet, as PRF is disabled by default. Also, JANET_REDUCED_OS
|
||||
cannot be defined for this variable to have an effect.
|
||||
.RE
|
||||
|
||||
.SH AUTHOR
|
||||
Written by Calvin Rose <calsrose@gmail.com>
|
||||
|
||||
230
jpm
230
jpm
@@ -132,6 +132,15 @@
|
||||
"Convert url with potential bad characters into a file path element."
|
||||
(peg/compile ~(% (any (+ (/ '(set "<>:\"/\\|?*") "_") '1)))))
|
||||
|
||||
(def- entry-replacer
|
||||
"Convert url with potential bad characters into an entry-name"
|
||||
(peg/compile ~(% (any (+ '(range "AZ" "az" "09" "__") (/ '1 ,|(string "_" ($ 0) "_")))))))
|
||||
|
||||
(defn entry-replace
|
||||
"Escape special characters in the entry-name"
|
||||
[name]
|
||||
(get (peg/match entry-replacer name) 0))
|
||||
|
||||
(defn filepath-replace
|
||||
"Remove special characters from a string or path
|
||||
to make it into a path segment."
|
||||
@@ -323,7 +332,9 @@
|
||||
#
|
||||
|
||||
(def default-compiler (or (os/getenv "CC") (if is-win "cl.exe" "cc")))
|
||||
(def default-cpp-compiler (or (os/getenv "CXX") (if is-win "cl.exe" "c++")))
|
||||
(def default-linker (or (os/getenv "CC") (if is-win "link.exe" "cc")))
|
||||
(def default-cpp-linker (or (os/getenv "CXX") (if is-win "link.exe" "c++")))
|
||||
(def default-archiver (or (os/getenv "AR") (if is-win "lib.exe" "ar")))
|
||||
|
||||
# Detect threads
|
||||
@@ -352,6 +363,10 @@
|
||||
(if is-win
|
||||
["/nologo" "/MD"]
|
||||
["-std=c99" "-Wall" "-Wextra"]))
|
||||
(def default-cppflags
|
||||
(if is-win
|
||||
["/nologo" "/MD" "/EHsc"]
|
||||
["-std=c++11" "-Wall" "-Wextra"]))
|
||||
(def default-ldflags [])
|
||||
|
||||
# Required flags for dynamic libraries. These
|
||||
@@ -424,29 +439,54 @@
|
||||
(string "-I" (dyn :headerpath JANET_HEADERPATH))
|
||||
(string "-O" (opt opts :optimize 2))])
|
||||
|
||||
(defn- getcppflags
|
||||
"Generate the cpp flags from the input options."
|
||||
[opts]
|
||||
@[;(opt opts :cppflags default-cppflags)
|
||||
(string "-I" (dyn :headerpath JANET_HEADERPATH))
|
||||
(string "-O" (opt opts :optimize 2))])
|
||||
|
||||
(defn- entry-name
|
||||
"Name of symbol that enters static compilation of a module."
|
||||
[name]
|
||||
(string "janet_module_entry_" (filepath-replace name)))
|
||||
(string "janet_module_entry_" (entry-replace name)))
|
||||
|
||||
(defn- compile-c
|
||||
"Compile a C file into an object file."
|
||||
[opts src dest &opt static?]
|
||||
(def cc (opt opts :compiler default-compiler))
|
||||
(def cflags [;(getcflags opts) ;(if static? [] dynamic-cflags)])
|
||||
(def entry-defines (if-let [n (opts :entry-name)]
|
||||
(def entry-defines (if-let [n (and static? (opts :entry-name))]
|
||||
[(make-define "JANET_ENTRY_NAME" n)]
|
||||
[]))
|
||||
(def defines [;(make-defines (opt opts :defines {})) ;entry-defines])
|
||||
(def headers (or (opts :headers) []))
|
||||
(rule dest [src ;headers]
|
||||
(check-cc)
|
||||
(print "compiling " dest "...")
|
||||
(print "compiling " src " to " dest "...")
|
||||
(create-dirs dest)
|
||||
(if is-win
|
||||
(shell cc ;defines "/c" ;cflags (string "/Fo" dest) src)
|
||||
(shell cc "-c" src ;defines ;cflags "-o" dest))))
|
||||
|
||||
(defn- compile-cpp
|
||||
"Compile a C++ file into an object file."
|
||||
[opts src dest &opt static?]
|
||||
(def cpp (opt opts :cpp-compiler default-cpp-compiler))
|
||||
(def cflags [;(getcppflags opts) ;(if static? [] dynamic-cflags)])
|
||||
(def entry-defines (if-let [n (and static? (opts :entry-name))]
|
||||
[(make-define "JANET_ENTRY_NAME" n)]
|
||||
[]))
|
||||
(def defines [;(make-defines (opt opts :defines {})) ;entry-defines])
|
||||
(def headers (or (opts :headers) []))
|
||||
(rule dest [src ;headers]
|
||||
(check-cc)
|
||||
(print "compiling " src " to " dest "...")
|
||||
(create-dirs dest)
|
||||
(if is-win
|
||||
(shell cpp ;defines "/c" ;cflags (string "/Fo" dest) src)
|
||||
(shell cpp "-c" src ;defines ;cflags "-o" dest))))
|
||||
|
||||
(defn- libjanet
|
||||
"Find libjanet.a (or libjanet.lib on windows) at compile time"
|
||||
[]
|
||||
@@ -466,7 +506,7 @@
|
||||
(string hpath `\\janet.lib`))
|
||||
|
||||
(defn- link-c
|
||||
"Link object files together to make a native module."
|
||||
"Link C object files together to make a native module."
|
||||
[opts target & objects]
|
||||
(def linker (opt opts (if is-win :linker :compiler) default-linker))
|
||||
(def cflags (getcflags opts))
|
||||
@@ -481,6 +521,22 @@
|
||||
(shell linker ;ldflags (string "/OUT:" target) ;objects (win-import-library) ;lflags)
|
||||
(shell linker ;cflags ;ldflags `-o` target ;objects ;lflags))))
|
||||
|
||||
(defn- link-cpp
|
||||
"Link C++ object files together to make a native module."
|
||||
[opts target & objects]
|
||||
(def linker (opt opts (if is-win :cpp-linker :cpp-compiler) default-cpp-linker))
|
||||
(def cflags (getcppflags opts))
|
||||
(def lflags [;(opt opts :lflags default-lflags)
|
||||
;(if (opts :static) [] dynamic-lflags)])
|
||||
(def ldflags [;(opt opts :ldflags [])])
|
||||
(rule target objects
|
||||
(check-cc)
|
||||
(print "linking " target "...")
|
||||
(create-dirs target)
|
||||
(if is-win
|
||||
(shell linker ;ldflags (string "/OUT:" target) ;objects (win-import-library) ;lflags)
|
||||
(shell linker ;cflags ;ldflags `-o` target ;objects ;lflags))))
|
||||
|
||||
(defn- archive-c
|
||||
"Link object files together to make a static library."
|
||||
[opts target & objects]
|
||||
@@ -535,6 +591,23 @@
|
||||
```
|
||||
|
||||
int main(int argc, const char **argv) {
|
||||
|
||||
#if defined(JANET_PRF)
|
||||
uint8_t hash_key[JANET_HASH_KEY_SIZE + 1];
|
||||
#ifdef JANET_REDUCED_OS
|
||||
char *envvar = NULL;
|
||||
#else
|
||||
char *envvar = getenv("JANET_HASHSEED");
|
||||
#endif
|
||||
if (NULL != envvar) {
|
||||
strncpy((char *) hash_key, envvar, sizeof(hash_key) - 1);
|
||||
} else if (janet_cryptorand(hash_key, JANET_HASH_KEY_SIZE) != 0) {
|
||||
fputs("unable to initialize janet PRF hash function.\n", stderr);
|
||||
return 1;
|
||||
}
|
||||
janet_init_hash_key(hash_key);
|
||||
#endif
|
||||
|
||||
janet_init();
|
||||
|
||||
/* Get core env */
|
||||
@@ -638,10 +711,12 @@ int main(int argc, const char **argv) {
|
||||
(table/setproto m oldproto))
|
||||
|
||||
# Find static modules
|
||||
(var has-cpp false)
|
||||
(def declarations @"")
|
||||
(def lookup-into-invocations @"")
|
||||
(loop [[prefix name] :pairs prefixes]
|
||||
(def meta (eval-string (slurp (modpath-to-meta name))))
|
||||
(if (meta :cpp) (set has-cpp true))
|
||||
(buffer/push-string lookup-into-invocations
|
||||
" temptab = janet_table(0);\n"
|
||||
" temptab->proto = env;\n"
|
||||
@@ -664,17 +739,33 @@ int main(int argc, const char **argv) {
|
||||
(create-buffer-c-impl image cimage_dest "janet_payload_image")
|
||||
# Append main function
|
||||
(spit cimage_dest (make-bin-source declarations lookup-into-invocations) :ab)
|
||||
(def oimage_dest (out-path cimage_dest ".c" ".o"))
|
||||
# Compile and link final exectable
|
||||
(unless no-compile
|
||||
(def cc (opt opts :compiler default-compiler))
|
||||
(def ldflags [;dep-ldflags ;(opt opts :ldflags []) ;janet-ldflags])
|
||||
(def lflags [;static-libs (libjanet) ;dep-lflags ;(opt opts :lflags default-lflags) ;janet-lflags])
|
||||
(def cflags [;(getcflags opts) ;janet-cflags])
|
||||
(def defines (make-defines (opt opts :defines {})))
|
||||
(print "compiling and linking " dest "...")
|
||||
(def cc (opt opts :compiler default-compiler))
|
||||
(def cflags [;(getcflags opts) ;janet-cflags])
|
||||
(check-cc)
|
||||
(print "compiling " cimage_dest " to " oimage_dest "...")
|
||||
(create-dirs oimage_dest)
|
||||
(if is-win
|
||||
(shell cc ;cflags ;ldflags cimage_dest ;lflags `/link` (string "/OUT:" dest))
|
||||
(shell cc ;cflags ;ldflags `-o` dest cimage_dest ;lflags)))))
|
||||
(shell cc ;defines "/c" ;cflags (string "/Fo" oimage_dest) cimage_dest)
|
||||
(shell cc "-c" cimage_dest ;defines ;cflags "-o" oimage_dest))
|
||||
(if has-cpp
|
||||
(let [linker (opt opts (if is-win :cpp-linker :cpp-compiler) default-cpp-linker)
|
||||
cppflags [;(getcppflags opts) ;janet-cflags]]
|
||||
(print "linking " dest "...")
|
||||
(if is-win
|
||||
(shell linker ;ldflags (string "/OUT:" dest) oimage_dest ;lflags)
|
||||
(shell linker ;cppflags ;ldflags `-o` dest oimage_dest ;lflags)))
|
||||
(let [linker (opt opts (if is-win :linker :compiler) default-linker)]
|
||||
(print "linking " dest "...")
|
||||
(create-dirs dest)
|
||||
(if is-win
|
||||
(shell linker ;ldflags (string "/OUT:" dest) oimage_dest ;lflags)
|
||||
(shell linker ;cflags ;ldflags `-o` dest oimage_dest ;lflags)))))))
|
||||
|
||||
#
|
||||
# Installation and Dependencies
|
||||
@@ -688,7 +779,7 @@ int main(int argc, const char **argv) {
|
||||
(if stored-git-path (break stored-git-path))
|
||||
(set stored-git-path
|
||||
(if is-win
|
||||
(or (os/getenv "JANET_GIT") (pslurp "where git"))
|
||||
(or (os/getenv "JANET_GIT") (first (string/split "\n" (pslurp "where git"))))
|
||||
(os/getenv "JANET_GIT" "git"))))
|
||||
|
||||
(defn uninstall
|
||||
@@ -757,11 +848,11 @@ int main(int argc, const char **argv) {
|
||||
(os/execute [(git-path) "reset" "--hard" tag] :p))
|
||||
(unless (dyn :offline)
|
||||
(os/execute [(git-path) "submodule" "update" "--init" "--recursive"] :p))
|
||||
(import-rules "./project.janet")
|
||||
(import-rules "./project.janet" true)
|
||||
(unless no-deps (do-rule "install-deps"))
|
||||
(do-rule "build")
|
||||
(do-rule "install"))
|
||||
([err] (print "Error building git repository dependency: " err)))
|
||||
([err f] (print "Error building git repository dependency: " err) (propagate err f)))
|
||||
(os/cd olddir))
|
||||
|
||||
(defn install-rule
|
||||
@@ -836,9 +927,23 @@ int main(int argc, const char **argv) {
|
||||
|
||||
# Make dynamic module
|
||||
(def lname (string "build" sep name modext))
|
||||
(loop [src :in sources]
|
||||
(compile-c opts src (out-path src ".c" objext)))
|
||||
(def objects (map (fn [path] (out-path path ".c" objext)) sources))
|
||||
|
||||
# Get objects to build with
|
||||
(var has-cpp false)
|
||||
(def objects
|
||||
(seq [src :in sources]
|
||||
(cond
|
||||
(string/has-suffix? ".cpp" src)
|
||||
(let [op (out-path src ".cpp" objext)]
|
||||
(compile-cpp opts src op)
|
||||
(set has-cpp true)
|
||||
op)
|
||||
(string/has-suffix? ".c" src)
|
||||
(let [op (out-path src ".c" objext)]
|
||||
(compile-c opts src op)
|
||||
op)
|
||||
(errorf "unknown source file type: %s, expected .c or .cpp"))))
|
||||
|
||||
(when-let [embedded (opts :embedded)]
|
||||
(loop [src :in embedded]
|
||||
(def c-src (out-path src ".janet" ".janet.c"))
|
||||
@@ -846,7 +951,7 @@ int main(int argc, const char **argv) {
|
||||
(array/push objects o-src)
|
||||
(create-buffer-c src c-src (embed-name src))
|
||||
(compile-c opts c-src o-src)))
|
||||
(link-c opts lname ;objects)
|
||||
((if has-cpp link-cpp link-c) opts lname ;objects)
|
||||
(add-dep "build" lname)
|
||||
(install-rule lname path)
|
||||
|
||||
@@ -859,6 +964,7 @@ int main(int argc, const char **argv) {
|
||||
"# Metadata for static library %s\n\n%.20p"
|
||||
(string name statext)
|
||||
{:static-entry ename
|
||||
:cpp has-cpp
|
||||
:ldflags ~',(opts :ldflags)
|
||||
:lflags ~',(opts :lflags)})))
|
||||
(add-dep "build" metaname)
|
||||
@@ -870,9 +976,21 @@ int main(int argc, const char **argv) {
|
||||
(def opts (merge @{:entry-name ename} opts))
|
||||
(def sobjext (string ".static" objext))
|
||||
(def sjobjext (string ".janet" sobjext))
|
||||
(loop [src :in sources]
|
||||
(compile-c opts src (out-path src ".c" sobjext) true))
|
||||
(def sobjects (map (fn [path] (out-path path ".c" sobjext)) sources))
|
||||
|
||||
# Get static objects
|
||||
(def sobjects
|
||||
(seq [src :in sources]
|
||||
(cond
|
||||
(string/has-suffix? ".cpp" src)
|
||||
(let [op (out-path src ".cpp" sobjext)]
|
||||
(compile-cpp opts src op true)
|
||||
op)
|
||||
(string/has-suffix? ".c" src)
|
||||
(let [op (out-path src ".c" sobjext)]
|
||||
(compile-c opts src op true)
|
||||
op)
|
||||
(errorf "unknown source file type: %s, expected .c or .cpp"))))
|
||||
|
||||
(when-let [embedded (opts :embedded)]
|
||||
(loop [src :in embedded]
|
||||
(def c-src (out-path src ".janet" ".janet.c"))
|
||||
@@ -1069,36 +1187,50 @@ usage: jpm [--key=value, --flag] ... [subcommand] [args] ...
|
||||
|
||||
Run from a directory containing a project.janet file to perform operations
|
||||
on a project, or from anywhere to do operations on the global module cache (modpath).
|
||||
Commands that need write permission to the modpath are considered privileged commands - in
|
||||
some environments they may require super user privileges.
|
||||
Other project-level commands need to have a ./project.janet file in the current directory.
|
||||
|
||||
Subcommands are:
|
||||
build : build all artifacts
|
||||
Unprivileged global subcommands:
|
||||
help : show this help text
|
||||
show-paths : prints the paths that will be used to install things.
|
||||
quickbin entry executable : Create an executable from a janet script with a main function.
|
||||
|
||||
Privileged global subcommands:
|
||||
install (repo or name)... : install artifacts. If a repo is given, install the contents of that
|
||||
git repository, assuming that the repository is a jpm project. If not, build
|
||||
and install the current project.
|
||||
uninstall (module)... : uninstall a module. If no module is given, uninstall the module
|
||||
defined by the current directory.
|
||||
show-paths : prints the paths that will be used to install things.
|
||||
clean : remove any generated files or artifacts
|
||||
test : run tests. Tests should be .janet files in the test/ directory relative to project.janet.
|
||||
deps : install dependencies for the current project.
|
||||
clear-cache : clear the git cache. Useful for updating dependencies.
|
||||
clear-manifest : clear the manifest. Useful for fixing broken installs.
|
||||
run rule : run a rule. Can also run custom rules added via (phony "task" [deps...] ...)
|
||||
or (rule "ouput.file" [deps...] ...).
|
||||
rules : list rules available with run.
|
||||
rule-tree (root rule) (depth) : Print a nice tree to see what rules depend on other rules.
|
||||
Optinally provide a root rule to start printing from, and a
|
||||
max depth to print. Without these options, all rules will print
|
||||
their full dependency tree.
|
||||
update-pkgs : Update the current package listing from the remote git repository selected.
|
||||
quickbin entry executable : Create an executable from a janet script with a main function.
|
||||
make-lockfile (lockfile) : Create a lockfile based on repositories in the cache. The
|
||||
lockfile will record the exact versions of dependencies used to ensure a reproducible
|
||||
build. Lockfiles are best used with applications, not libraries. The default lockfile
|
||||
name is lockfile.jdn.
|
||||
load-lockfile (lockfile) : Install modules from a lockfile in a reproducible way. The
|
||||
default lockfile name is lockfile.jdn.
|
||||
update-pkgs : Update the current package listing from the remote git repository selected.
|
||||
|
||||
Privileged project subcommands:
|
||||
deps : install dependencies for the current project.
|
||||
install : install artifacts of the current project.
|
||||
uninstall : uninstall the current project's artifacts.
|
||||
|
||||
Unprivileged project subcommands:
|
||||
build : build all artifacts
|
||||
clean : remove any generated files or artifacts
|
||||
test : run tests. Tests should be .janet files in the test/ directory relative to project.janet.
|
||||
run rule : run a rule. Can also run custom rules added via (phony "task" [deps...] ...)
|
||||
or (rule "ouput.file" [deps...] ...).
|
||||
rules : list rules available with run.
|
||||
list-installed : list installed packages in the current syspath.
|
||||
list-pkgs (search) : list packages in the package listing that the contain the string search.
|
||||
If no search pattern is given, prints the entire package listing.
|
||||
rule-tree (root rule) (depth) : Print a nice tree to see what rules depend on other rules.
|
||||
Optionally provide a root rule to start printing from, and a
|
||||
max depth to print. Without these options, all rules will print
|
||||
their full dependency tree.
|
||||
debug-repl : Run a repl in the context of the current project.janet file. This lets you run rules and
|
||||
otherwise debug the current project.janet file.
|
||||
|
||||
@@ -1108,7 +1240,8 @@ Keys are:
|
||||
--binpath : The directory to install binaries and scripts. Defaults to $JANET_BINPATH.
|
||||
--libpath : The directory containing janet C libraries (libjanet.*). Defaults to $JANET_LIBPATH.
|
||||
--compiler : C compiler to use for natives. Defaults to $CC or cc (cl.exe on windows).
|
||||
--archiver : C compiler to use for static libraries. Defaults to $AR ar (lib.exe on windows).
|
||||
--cpp-compiler : C++ compiler to use for natives. Defaults to $CXX or c++ (cl.exe on windows).
|
||||
--archiver : C archiver to use for static libraries. Defaults to $AR ar (lib.exe on windows).
|
||||
--linker : C linker to use for linking natives. Defaults to link.exe on windows, not used on
|
||||
other platforms.
|
||||
--pkglist : URL of git repository for package listing. Defaults to $JANET_PKGLIST or https://github.com/janet-lang/pkgs.git
|
||||
@@ -1171,10 +1304,33 @@ Flags are:
|
||||
|
||||
(defn list-rules
|
||||
[&opt ctx]
|
||||
(import-rules "./project.janet" true)
|
||||
(import-rules "./project.janet")
|
||||
(def ks (sort (seq [k :keys (dyn :rules)] k)))
|
||||
(each k ks (print k)))
|
||||
|
||||
(defn list-installed
|
||||
[]
|
||||
(def xs
|
||||
(seq [x :in (os/dir (find-manifest-dir))
|
||||
:when (string/has-suffix? ".jdn" x)]
|
||||
(string/slice x 0 -5)))
|
||||
(sort xs)
|
||||
(each x xs (print x)))
|
||||
|
||||
(defn list-pkgs
|
||||
[&opt search]
|
||||
(def [ok _] (module/find "pkgs"))
|
||||
(unless ok
|
||||
(eprint "no local package listing found. Run `jpm update-pkgs` to get listing.")
|
||||
(os/exit 1))
|
||||
(def pkgs-mod (require "pkgs"))
|
||||
(def ps
|
||||
(seq [p :keys (get-in pkgs-mod ['packages :value] [])
|
||||
:when (if search (string/find search p) true)]
|
||||
p))
|
||||
(sort ps)
|
||||
(each p ps (print p)))
|
||||
|
||||
(defn update-pkgs
|
||||
[]
|
||||
(install-git (dyn :pkglist default-pkglist)))
|
||||
@@ -1216,6 +1372,8 @@ Flags are:
|
||||
"debug-repl" jpm-debug-repl
|
||||
"rule-tree" show-rule-tree
|
||||
"show-paths" show-paths
|
||||
"list-installed" list-installed
|
||||
"list-pkgs" list-pkgs
|
||||
"clear-cache" clear-cache
|
||||
"clear-manifest" clear-manifest
|
||||
"run" local-rule
|
||||
|
||||
29
jpm.1
29
jpm.1
@@ -71,9 +71,14 @@ $JANET_LIBPATH, or a reasonable default. See JANET_LIBPATH for more.
|
||||
|
||||
.TP
|
||||
.BR \-\-compiler=$CC
|
||||
Sets the compiler used for compiling native modules and standalone executables. Defaults
|
||||
Sets the C compiler used for compiling native modules and standalone executables. Defaults
|
||||
to cc.
|
||||
|
||||
.TP
|
||||
.BR \-\-cpp\-compiler=$CXX
|
||||
Sets the C++ compiler used for compiling native modules and standalone executables. Defaults
|
||||
to c++..
|
||||
|
||||
.TP
|
||||
.BR \-\-linker
|
||||
Sets the linker used to create native modules and executables. Only used on windows, where
|
||||
@@ -101,7 +106,6 @@ be created in the ./build/ directory.
|
||||
|
||||
.TP
|
||||
.BR install\ [\fBrepo...\fR]
|
||||
|
||||
When run with no arguments, installs all installable artifacts in the current project to
|
||||
the current JANET_MODPATH for modules and JANET_BINPATH for executables and scripts. Can also
|
||||
take an optional git repository URL and will install all artifacts in that repository instead.
|
||||
@@ -111,7 +115,7 @@ install multiple dependencies in one command.
|
||||
.TP
|
||||
.BR uninstall\ [\fBname...\fR]
|
||||
Uninstall a project installed with install. uninstall expects the name of the project, not the
|
||||
repository url, path to installed file or executable name. The name of the project must be specified
|
||||
repository url, path to installed file, or executable name. The name of the project must be specified
|
||||
at the top of the project.janet file in the declare-project form. If no name is given, uninstalls
|
||||
the current project if installed. Will also uninstall multiple packages in one command.
|
||||
|
||||
@@ -139,6 +143,15 @@ date or too large, clear-cache will remove the cache and jpm will rebuild it
|
||||
when needed. clear-cache is a global command, so a project.janet is not
|
||||
required.
|
||||
|
||||
.TP
|
||||
.BR list-installed
|
||||
List all installed packages in the current syspath.
|
||||
|
||||
.TP
|
||||
.BR list-pkgs\ [\fBsearch\fR]
|
||||
List all package aliases in the current package listing that contain the given search string.
|
||||
If no search string is given, prints the entire listing.
|
||||
|
||||
.TP
|
||||
.BR clear-manifest
|
||||
jpm creates a manifest directory that contains a list of all installed files.
|
||||
@@ -159,7 +172,7 @@ like make. run will run a single rule or build a single file.
|
||||
List all rules that can be run via run. This is useful for exploring rules in the project.
|
||||
|
||||
.TP
|
||||
.BR rule-tree\ [\fBroot\fR] [\fdepth\fR]
|
||||
.BR rule-tree\ [\fBroot\fR]\ [\fBdepth\fR]
|
||||
Show rule dependency tree in a pretty format. Optionally provide a rule to use as the tree
|
||||
root, as well as a max depth to print. By default, prints the full tree for all rules. This
|
||||
can be quite long, so it is recommended to give a root rule.
|
||||
@@ -173,7 +186,7 @@ Show all of the paths used when installing and building artifacts.
|
||||
Update the package listing by installing the 'pkgs' package. Same as jpm install pkgs
|
||||
|
||||
.TP
|
||||
.BR quickbin [\fBentry\fR] [\fBexecutable\fR]
|
||||
.BR quickbin\ [\fBentry\fR]\ [\fBexecutable\fR]
|
||||
Create a standalone, statically linked executable from a Janet source file that contains a main function.
|
||||
The main function is the entry point of the program and will receive command line arguments
|
||||
as function arguments. The entry file can import other modules, including native C modules, and
|
||||
@@ -209,7 +222,7 @@ the default location set at compile time, which can be determined with (dyn :sys
|
||||
.RS
|
||||
The location that jpm will use to install libraries to. Defaults to JANET_PATH, but you could
|
||||
set this to a different directory if you want to. Doing so would let you import Janet modules
|
||||
on the normal system path (JANET_PATH or (dyn :syspath)), but install to a different directory. It is also a more reliable way to install
|
||||
on the normal system path (JANET_PATH or (dyn :syspath)), but install to a different directory. It is also a more reliable way to install.
|
||||
This variable is overwritten by the --modpath=/some/path if it is provided.
|
||||
.RE
|
||||
|
||||
@@ -225,7 +238,7 @@ variable.
|
||||
.B JANET_LIBPATH
|
||||
.RS
|
||||
Similar to JANET_HEADERPATH, this path is where jpm will look for
|
||||
libjanet.a for creating standalong executables. This does not need to be
|
||||
libjanet.a for creating standalone executables. This does not need to be
|
||||
set on a normal install.
|
||||
If not provided, this will default to <jpm script location>/../lib.
|
||||
The --libpath=/some/path option will override this variable.
|
||||
@@ -244,11 +257,13 @@ The --binpath=/some/path will override this variable.
|
||||
The git repository URL that contains a listing of packages. This allows installing packages with shortnames, which
|
||||
is mostly a convenience. However, package dependencies can use short names, package listings
|
||||
can be used to choose a particular set of dependency versions for a whole project.
|
||||
.RE
|
||||
|
||||
.B JANET_GIT
|
||||
.RS
|
||||
An optional path to a git executable to use to clone git dependencies. By default, uses "git" on the current $PATH. You shouldn't need to set this
|
||||
if you have a normal install of git.
|
||||
.RE
|
||||
|
||||
.SH AUTHOR
|
||||
Written by Calvin Rose <calsrose@gmail.com>
|
||||
|
||||
54
meson.build
54
meson.build
@@ -20,7 +20,7 @@
|
||||
|
||||
project('janet', 'c',
|
||||
default_options : ['c_std=c99', 'b_lundef=false', 'default_library=both'],
|
||||
version : '1.10.1')
|
||||
version : '1.13.0')
|
||||
|
||||
# Global settings
|
||||
janet_path = join_paths(get_option('prefix'), get_option('libdir'), 'janet')
|
||||
@@ -60,10 +60,11 @@ conf.set('JANET_NO_SOURCEMAPS', not get_option('sourcemaps'))
|
||||
conf.set('JANET_NO_ASSEMBLER', not get_option('assembler'))
|
||||
conf.set('JANET_NO_PEG', not get_option('peg'))
|
||||
conf.set('JANET_NO_NET', not get_option('net'))
|
||||
conf.set('JANET_NO_EV', not get_option('ev'))
|
||||
conf.set('JANET_REDUCED_OS', get_option('reduced_os'))
|
||||
conf.set('JANET_NO_TYPED_ARRAY', not get_option('typed_array'))
|
||||
conf.set('JANET_NO_INT_TYPES', not get_option('int_types'))
|
||||
conf.set('JANET_NO_PRF', not get_option('prf'))
|
||||
conf.set('JANET_PRF', get_option('prf'))
|
||||
conf.set('JANET_RECURSION_GUARD', get_option('recursion_guard'))
|
||||
conf.set('JANET_MAX_PROTO_DEPTH', get_option('max_proto_depth'))
|
||||
conf.set('JANET_MAX_MACRO_EXPAND', get_option('max_macro_expand'))
|
||||
@@ -71,6 +72,7 @@ conf.set('JANET_STACK_MAX', get_option('stack_max'))
|
||||
conf.set('JANET_NO_UMASK', not get_option('umask'))
|
||||
conf.set('JANET_NO_REALPATH', not get_option('realpath'))
|
||||
conf.set('JANET_NO_PROCESSES', not get_option('processes'))
|
||||
conf.set('JANET_SIMPLE_GETLINE', get_option('simple_getline'))
|
||||
if get_option('os_name') != ''
|
||||
conf.set('JANET_OS_NAME', get_option('os_name'))
|
||||
endif
|
||||
@@ -110,6 +112,7 @@ core_src = [
|
||||
'src/core/corelib.c',
|
||||
'src/core/debug.c',
|
||||
'src/core/emit.c',
|
||||
'src/core/ev.c',
|
||||
'src/core/fiber.c',
|
||||
'src/core/gc.c',
|
||||
'src/core/inttypes.c',
|
||||
@@ -178,30 +181,28 @@ libjanet = library('janet', janetc,
|
||||
|
||||
# Extra c flags - adding -fvisibility=hidden matches the Makefile and
|
||||
# shaves off about 10k on linux x64, likely similar on other platforms.
|
||||
native_cc = meson.get_compiler('c', native: true)
|
||||
cross_cc = meson.get_compiler('c', native: false)
|
||||
if native_cc.has_argument('-fvisibility=hidden')
|
||||
extra_native_cflags = ['-fvisibility=hidden']
|
||||
if cc.has_argument('-fvisibility=hidden')
|
||||
extra_cflags = ['-fvisibility=hidden']
|
||||
else
|
||||
extra_native_cflags = []
|
||||
extra_cflags = []
|
||||
endif
|
||||
if cross_cc.has_argument('-fvisibility=hidden')
|
||||
extra_cross_cflags = ['-fvisibility=hidden']
|
||||
else
|
||||
extra_cross_cflags = []
|
||||
endif
|
||||
|
||||
janet_mainclient = executable('janet', janetc, mainclient_src,
|
||||
include_directories : incdir,
|
||||
dependencies : [m_dep, dl_dep, thread_dep],
|
||||
c_args : extra_native_cflags,
|
||||
c_args : extra_cflags,
|
||||
install : true)
|
||||
|
||||
if meson.is_cross_build()
|
||||
native_cc = meson.get_compiler('c', native: true)
|
||||
if native_cc.has_argument('-fvisibility=hidden')
|
||||
extra_native_cflags = ['-fvisibility=hidden']
|
||||
else
|
||||
extra_native_cflags = []
|
||||
endif
|
||||
janet_nativeclient = executable('janet-native', janetc, mainclient_src,
|
||||
include_directories : incdir,
|
||||
dependencies : [m_dep, dl_dep, thread_dep],
|
||||
c_args : extra_cross_cflags,
|
||||
c_args : extra_native_cflags,
|
||||
native : true)
|
||||
else
|
||||
janet_nativeclient = janet_mainclient
|
||||
@@ -216,16 +217,17 @@ docs = custom_target('docs',
|
||||
|
||||
# Tests
|
||||
test_files = [
|
||||
'test/suite0.janet',
|
||||
'test/suite1.janet',
|
||||
'test/suite2.janet',
|
||||
'test/suite3.janet',
|
||||
'test/suite4.janet',
|
||||
'test/suite5.janet',
|
||||
'test/suite6.janet',
|
||||
'test/suite7.janet',
|
||||
'test/suite8.janet',
|
||||
'test/suite9.janet'
|
||||
'test/suite0000.janet',
|
||||
'test/suite0001.janet',
|
||||
'test/suite0002.janet',
|
||||
'test/suite0003.janet',
|
||||
'test/suite0004.janet',
|
||||
'test/suite0005.janet',
|
||||
'test/suite0006.janet',
|
||||
'test/suite0007.janet',
|
||||
'test/suite0008.janet',
|
||||
'test/suite0009.janet',
|
||||
'test/suite0010.janet'
|
||||
]
|
||||
foreach t : test_files
|
||||
test(t, janet_nativeclient, args : files([t]), workdir : meson.current_source_dir())
|
||||
@@ -257,6 +259,6 @@ if get_option('peg') and not get_option('reduced_os') and get_option('processes'
|
||||
output : ['jpm'],
|
||||
command : [janet_nativeclient, '@INPUT@', '@OUTPUT@',
|
||||
'--binpath=' + join_paths(get_option('prefix'), get_option('bindir')),
|
||||
'--libpath=' + join_paths(get_option('prefix'), get_option('libdir'), 'janet'),
|
||||
'--libpath=' + join_paths(get_option('prefix'), get_option('libdir')),
|
||||
'--headerpath=' + join_paths(get_option('prefix'), get_option('includedir'))])
|
||||
endif
|
||||
|
||||
@@ -10,11 +10,13 @@ option('assembler', type : 'boolean', value : true)
|
||||
option('peg', type : 'boolean', value : true)
|
||||
option('typed_array', type : 'boolean', value : true)
|
||||
option('int_types', type : 'boolean', value : true)
|
||||
option('prf', type : 'boolean', value : true)
|
||||
option('prf', type : 'boolean', value : false)
|
||||
option('net', type : 'boolean', value : true)
|
||||
option('ev', type : 'boolean', value : true)
|
||||
option('processes', type : 'boolean', value : true)
|
||||
option('umask', type : 'boolean', value : true)
|
||||
option('realpath', type : 'boolean', value : true)
|
||||
option('simple_getline', type : 'boolean', value : false)
|
||||
|
||||
option('recursion_guard', type : 'integer', min : 10, max : 8000, value : 1024)
|
||||
option('max_proto_depth', type : 'integer', min : 10, max : 8000, value : 200)
|
||||
|
||||
@@ -7,6 +7,8 @@
|
||||
###
|
||||
###
|
||||
|
||||
(def root-env "The root environment used to create environments with (make-env)" _env)
|
||||
|
||||
(def defn :macro
|
||||
"(defn name & more)\n\nDefine a function. Equivalent to (def name (fn name [args] ...))."
|
||||
(fn defn [name & more]
|
||||
@@ -81,10 +83,6 @@
|
||||
(defn nan? "Check if x is NaN" [x] (not= x x))
|
||||
(defn even? "Check if x is even." [x] (= 0 (mod x 2)))
|
||||
(defn odd? "Check if x is odd." [x] (= 1 (mod x 2)))
|
||||
(defn zero? "Check if x is zero." [x] (= x 0))
|
||||
(defn pos? "Check if x is greater than 0." [x] (> x 0))
|
||||
(defn neg? "Check if x is less than 0." [x] (< x 0))
|
||||
(defn one? "Check if x is equal to 1." [x] (= x 1))
|
||||
(defn number? "Check if x is a number." [x] (= (type x) :number))
|
||||
(defn fiber? "Check if x is a fiber." [x] (= (type x) :fiber))
|
||||
(defn string? "Check if x is a string." [x] (= (type x) :string))
|
||||
@@ -99,7 +97,7 @@
|
||||
(defn array? "Check if x is an array." [x] (= (type x) :array))
|
||||
(defn tuple? "Check if x is a tuple." [x] (= (type x) :tuple))
|
||||
(defn boolean? "Check if x is a boolean." [x] (= (type x) :boolean))
|
||||
(defn bytes? "Check if x is a string, symbol, or buffer." [x]
|
||||
(defn bytes? "Check if x is a string, symbol, keyword, or buffer." [x]
|
||||
(def t (type x))
|
||||
(if (= t :string) true (if (= t :symbol) true (if (= t :keyword) true (= t :buffer)))))
|
||||
(defn dictionary? "Check if x a table or struct." [x]
|
||||
@@ -112,7 +110,7 @@
|
||||
(defn true? "Check if x is true." [x] (= x true))
|
||||
(defn false? "Check if x is false." [x] (= x false))
|
||||
(defn nil? "Check if x is nil." [x] (= x nil))
|
||||
(defn empty? "Check if xs is empty." [xs] (= 0 (length xs)))
|
||||
(defn empty? "Check if xs is empty." [xs] (= (length xs) 0))
|
||||
|
||||
(def idempotent?
|
||||
"(idempotent? x)\n\nCheck if x is a value that evaluates to itself when compiled."
|
||||
@@ -379,16 +377,27 @@
|
||||
,(apply defer [(or dtor :close) binding] [truthy])
|
||||
,falsey))
|
||||
|
||||
(defn- for-template
|
||||
[binding start stop step comparison delta body]
|
||||
(with-syms [i s]
|
||||
(defn- for-var-template
|
||||
[i start stop step comparison delta body]
|
||||
(with-syms [s]
|
||||
(def st (if (idempotent? step) step (gensym)))
|
||||
(def loop-body
|
||||
~(while (,comparison ,i ,s)
|
||||
,;body
|
||||
(set ,i (,delta ,i ,st))))
|
||||
~(do
|
||||
(var ,i ,start)
|
||||
(def ,s ,stop)
|
||||
(while (,comparison ,i ,s)
|
||||
(def ,binding ,i)
|
||||
,;body
|
||||
(set ,i (,delta ,i ,step))))))
|
||||
,;(if (= st step) [] [~(def ,st ,step)])
|
||||
,(if (and (number? st) (> st 0))
|
||||
loop-body
|
||||
~(if (,> ,st 0) ,loop-body)))))
|
||||
|
||||
(defn- for-template
|
||||
[binding start stop step comparison delta body]
|
||||
(def i (gensym))
|
||||
(for-var-template i start stop step comparison delta
|
||||
[~(def ,binding ,i) ;body]))
|
||||
|
||||
(defn- check-indexed [x]
|
||||
(if (indexed? x)
|
||||
@@ -401,26 +410,18 @@
|
||||
(for-template binding start stop (or step 1) comparison op [rest])))
|
||||
|
||||
(defn- each-template
|
||||
[binding inx body]
|
||||
[binding inx kind body]
|
||||
(with-syms [k]
|
||||
(def ds (if (idempotent? inx) inx (gensym)))
|
||||
~(do
|
||||
,(unless (= ds inx) ~(def ,ds ,inx))
|
||||
(var ,k (,next ,ds nil))
|
||||
(while (,not= nil ,k)
|
||||
(def ,binding (,in ,ds ,k))
|
||||
,;body
|
||||
(set ,k (,next ,ds ,k))))))
|
||||
|
||||
(defn- keys-template
|
||||
[binding in pair? body]
|
||||
(with-syms [k]
|
||||
(def ds (if (idempotent? in) in (gensym)))
|
||||
~(do
|
||||
,(unless (= ds in) ~(def ,ds ,in))
|
||||
(var ,k (,next ,ds nil))
|
||||
(while (,not= nil ,k)
|
||||
(def ,binding ,(if pair? ~(tuple ,k (in ,ds ,k)) k))
|
||||
(def ,binding
|
||||
,(case kind
|
||||
:each ~(,in ,ds ,k)
|
||||
:keys k
|
||||
:pairs ~(,tuple ,k (,in ,ds ,k))))
|
||||
,;body
|
||||
(set ,k (,next ,ds ,k))))))
|
||||
|
||||
@@ -433,6 +434,17 @@
|
||||
(def ,binding ,i)
|
||||
,body))))
|
||||
|
||||
(defn- loop-fiber-template
|
||||
[binding expr body]
|
||||
(with-syms [f s]
|
||||
(def ds (if (idempotent? binding) binding (gensym)))
|
||||
~(let [,f ,expr]
|
||||
(while true
|
||||
(def ,ds (,resume ,f))
|
||||
(if (= :dead (,fiber/status ,f)) (break))
|
||||
,;(if (= ds binding) [] [~(def ,binding ,ds)])
|
||||
,;body))))
|
||||
|
||||
(defn- loop1
|
||||
[body head i]
|
||||
|
||||
@@ -466,18 +478,19 @@
|
||||
:range-to (range-template binding object rest + <=)
|
||||
:down (range-template binding object rest - >)
|
||||
:down-to (range-template binding object rest - >=)
|
||||
:keys (keys-template binding object false [rest])
|
||||
:pairs (keys-template binding object true [rest])
|
||||
:in (each-template binding object [rest])
|
||||
:keys (each-template binding object :keys [rest])
|
||||
:pairs (each-template binding object :pairs [rest])
|
||||
:in (each-template binding object :each [rest])
|
||||
:iterate (iterate-template binding object rest)
|
||||
:generate (with-syms [f s]
|
||||
~(let [,f ,object]
|
||||
(while true
|
||||
(def ,binding (,resume ,f))
|
||||
(if (= :dead (,fiber/status ,f)) (break))
|
||||
,rest)))
|
||||
:generate (loop-fiber-template binding object [rest])
|
||||
(error (string "unexpected loop verb " verb)))))
|
||||
|
||||
(defmacro forv
|
||||
"Do a c style for loop for side effects. The iteration variable i
|
||||
can be mutated in the loop, unlike normal for. Returns nil."
|
||||
[i start stop & body]
|
||||
(for-var-template i start stop 1 < + body))
|
||||
|
||||
(defmacro for
|
||||
"Do a c style for loop for side effects. Returns nil."
|
||||
[i start stop & body]
|
||||
@@ -486,17 +499,34 @@
|
||||
(defmacro eachk
|
||||
"Loop over each key in ds. Returns nil."
|
||||
[x ds & body]
|
||||
(keys-template x ds false body))
|
||||
(each-template x ds :keys body))
|
||||
|
||||
(defmacro eachp
|
||||
"Loop over each (key, value) pair in ds. Returns nil."
|
||||
[x ds & body]
|
||||
(keys-template x ds true body))
|
||||
(each-template x ds :pairs body))
|
||||
|
||||
(defmacro eachy
|
||||
"Resume a fiber in a loop until it has errored or died. Evaluate the body
|
||||
of the loop with binding set to the yielded value."
|
||||
[x fiber & body]
|
||||
(loop-fiber-template x fiber body))
|
||||
|
||||
(defmacro repeat
|
||||
"Evaluate body n times. If n is negative, body will be evaluated 0 times. Evaluates to nil."
|
||||
[n & body]
|
||||
(with-syms [iter]
|
||||
~(do (var ,iter ,n) (while (> ,iter 0) ,;body (-- ,iter)))))
|
||||
|
||||
(defmacro forever
|
||||
"Evaluate body forever in a loop, or until a break statement."
|
||||
[& body]
|
||||
~(while true ,;body))
|
||||
|
||||
(defmacro each
|
||||
"Loop over each value in ds. Returns nil."
|
||||
[x ds & body]
|
||||
(each-template x ds body))
|
||||
(each-template x ds :each body))
|
||||
|
||||
(defmacro loop
|
||||
"A general purpose loop macro. This macro is similar to the Common Lisp
|
||||
@@ -535,14 +565,6 @@
|
||||
[head & body]
|
||||
(loop1 body head 0))
|
||||
|
||||
(put _env 'loop1 nil)
|
||||
(put _env 'check-indexed nil)
|
||||
(put _env 'for-template nil)
|
||||
(put _env 'iterate-template nil)
|
||||
(put _env 'each-template nil)
|
||||
(put _env 'keys-template nil)
|
||||
(put _env 'range-template nil)
|
||||
|
||||
(defmacro seq
|
||||
"Similar to loop, but accumulates the loop body into an array and returns that.
|
||||
See loop for details."
|
||||
@@ -561,6 +583,16 @@
|
||||
[& body]
|
||||
(tuple fiber/new (tuple 'fn '[] ;body) :yi))
|
||||
|
||||
(defmacro- undef
|
||||
"Remove binding from root-env"
|
||||
[& syms]
|
||||
~(do ,;(seq [s :in syms] ~(put root-env ',s nil))))
|
||||
|
||||
(undef _env)
|
||||
|
||||
(undef loop1 check-indexed for-template for-var-template iterate-template
|
||||
each-template range-template loop-fiber-template)
|
||||
|
||||
(defn sum
|
||||
"Returns the sum of xs. If xs is empty, returns 0."
|
||||
[xs]
|
||||
@@ -586,7 +618,7 @@
|
||||
the fal form. Bindings have the same syntax as the let macro."
|
||||
[bindings tru &opt fal]
|
||||
(def len (length bindings))
|
||||
(if (zero? len) (error "expected at least 1 binding"))
|
||||
(if (= 0 len) (error "expected at least 1 binding"))
|
||||
(if (odd? len) (error "expected an even number of bindings"))
|
||||
(defn aux [i]
|
||||
(if (>= i len)
|
||||
@@ -669,28 +701,17 @@
|
||||
|
||||
## Polymorphic comparisons
|
||||
|
||||
(defn compare-primitive
|
||||
"Compare x and y using primitive operators.
|
||||
Returns -1,0,1 for x < y, x = y, x > y respectively.
|
||||
Present mostly for constructing 'compare' methods in prototypes."
|
||||
[x y]
|
||||
(cond
|
||||
(= x y) 0
|
||||
(< x y) -1
|
||||
(> x y) 1))
|
||||
|
||||
(defn compare
|
||||
"Polymorphic compare. Returns -1,0,1 for x < y, x = y, x > y respectively.
|
||||
"Polymorphic compare. Returns -1, 0, 1 for x < y, x = y, x > y respectively.
|
||||
Differs from the primitive comparators in that it first checks to
|
||||
see whether either x or y implement a 'compare' method which can
|
||||
compare x and y. If so it uses that compare method. If not, it
|
||||
compare x and y. If so it uses that compare method. If not, it
|
||||
delegates to the primitive comparators."
|
||||
[x y]
|
||||
(or
|
||||
(when-let [f (get x :compare)] (f x y))
|
||||
(when-let [f (get y :compare)
|
||||
fyx (f y x)] (- fyx))
|
||||
(compare-primitive x y)))
|
||||
(when-let [f (get y :compare)] (- (f y x)))
|
||||
(cmp x y)))
|
||||
|
||||
(defn- compare-reduce [op xs]
|
||||
(var r true)
|
||||
@@ -727,7 +748,12 @@
|
||||
[& xs]
|
||||
(compare-reduce >= xs))
|
||||
|
||||
(put _env 'compare-reduce nil)
|
||||
(defn zero? "Check if x is zero." [x] (= (compare x 0) 0))
|
||||
(defn pos? "Check if x is greater than 0." [x] (= (compare x 0) 1))
|
||||
(defn neg? "Check if x is less than 0." [x] (= (compare x 0) -1))
|
||||
(defn one? "Check if x is equal to 1." [x] (= (compare x 1) 0))
|
||||
|
||||
(undef compare-reduce)
|
||||
|
||||
###
|
||||
###
|
||||
@@ -739,7 +765,7 @@
|
||||
[a lo hi by]
|
||||
(def pivot (in a hi))
|
||||
(var i lo)
|
||||
(for j lo hi
|
||||
(forv j lo hi
|
||||
(def aj (in a j))
|
||||
(when (by aj pivot)
|
||||
(def ai (in a i))
|
||||
@@ -763,8 +789,8 @@
|
||||
[a &opt by]
|
||||
(sort-help a 0 (- (length a) 1) (or by <)))
|
||||
|
||||
(put _env 'sort-part nil)
|
||||
(put _env 'sort-help nil)
|
||||
(undef sort-part)
|
||||
(undef sort-help)
|
||||
|
||||
(defn sort-by
|
||||
"Returns a new sorted array that compares elements by invoking
|
||||
@@ -837,19 +863,19 @@
|
||||
(def ninds (length inds))
|
||||
(if (= 0 ninds) (error "expected at least 1 indexed collection"))
|
||||
(var limit (length (in inds 0)))
|
||||
(for i 0 ninds
|
||||
(forv i 0 ninds
|
||||
(def l (length (in inds i)))
|
||||
(if (< l limit) (set limit l)))
|
||||
(def [i1 i2 i3 i4] inds)
|
||||
(def res (array/new limit))
|
||||
(case ninds
|
||||
1 (for i 0 limit (set (res i) (f (in i1 i))))
|
||||
2 (for i 0 limit (set (res i) (f (in i1 i) (in i2 i))))
|
||||
3 (for i 0 limit (set (res i) (f (in i1 i) (in i2 i) (in i3 i))))
|
||||
4 (for i 0 limit (set (res i) (f (in i1 i) (in i2 i) (in i3 i) (in i4 i))))
|
||||
(for i 0 limit
|
||||
1 (forv i 0 limit (set (res i) (f (in i1 i))))
|
||||
2 (forv i 0 limit (set (res i) (f (in i1 i) (in i2 i))))
|
||||
3 (forv i 0 limit (set (res i) (f (in i1 i) (in i2 i) (in i3 i))))
|
||||
4 (forv i 0 limit (set (res i) (f (in i1 i) (in i2 i) (in i3 i) (in i4 i))))
|
||||
(forv i 0 limit
|
||||
(def args (array/new ninds))
|
||||
(for j 0 ninds (set (args j) (in (in inds j) i)))
|
||||
(forv j 0 ninds (set (args j) (in (in inds j) i)))
|
||||
(set (res i) (f ;args))))
|
||||
res)
|
||||
|
||||
@@ -901,12 +927,12 @@
|
||||
1 (do
|
||||
(def [n] args)
|
||||
(def arr (array/new n))
|
||||
(for i 0 n (put arr i i))
|
||||
(forv i 0 n (put arr i i))
|
||||
arr)
|
||||
2 (do
|
||||
(def [n m] args)
|
||||
(def arr (array/new (- m n)))
|
||||
(for i n m (put arr (- i n) i))
|
||||
(forv i n m (put arr (- i n) i))
|
||||
arr)
|
||||
3 (do
|
||||
(def [n m s] args)
|
||||
@@ -935,6 +961,18 @@
|
||||
(def i (find-index pred ind))
|
||||
(if (= i nil) nil (in ind i)))
|
||||
|
||||
(defn index-of
|
||||
"Find the first key associated with a value x in a data structure, acting like a reverse lookup.
|
||||
Will not look at table prototypes.
|
||||
Returns dflt if not found."
|
||||
[x ind &opt dflt]
|
||||
(var k (next ind nil))
|
||||
(var ret dflt)
|
||||
(while (not= nil k)
|
||||
(when (= (in ind k) x) (set ret k) (break))
|
||||
(set k (next ind k)))
|
||||
ret)
|
||||
|
||||
(defn take
|
||||
"Take first n elements in an indexed type. Returns new indexed instance."
|
||||
[n ind]
|
||||
@@ -1103,11 +1141,14 @@
|
||||
:table (walk-dict f form)
|
||||
:struct (table/to-struct (walk-dict f form))
|
||||
:array (walk-ind f form)
|
||||
:tuple (tuple/slice (walk-ind f form))
|
||||
:tuple (let [x (walk-ind f form)]
|
||||
(if (= :parens (tuple/type form))
|
||||
(tuple/slice x)
|
||||
(tuple/brackets ;x)))
|
||||
form))
|
||||
|
||||
(put _env 'walk-ind nil)
|
||||
(put _env 'walk-dict nil)
|
||||
(undef walk-ind)
|
||||
(undef walk-dict)
|
||||
|
||||
(defn postwalk
|
||||
"Do a post-order traversal of a data structure and call (f x)
|
||||
@@ -1189,19 +1230,43 @@
|
||||
(if x nil (set res x)))
|
||||
res)
|
||||
|
||||
(defn any?
|
||||
"Returns the first truthy value in ind, otherwise nil.
|
||||
falsey value."
|
||||
[ind]
|
||||
(var res nil)
|
||||
(loop [x :in ind :until res]
|
||||
(if x (set res x)))
|
||||
res)
|
||||
|
||||
(defn reverse!
|
||||
"Reverses the order of the elements in a given array or buffer and returns it
|
||||
mutated."
|
||||
[t]
|
||||
(def len-1 (- (length t) 1))
|
||||
(def half (/ len-1 2))
|
||||
(forv i 0 half
|
||||
(def j (- len-1 i))
|
||||
(def l (in t i))
|
||||
(def r (in t j))
|
||||
(put t i r)
|
||||
(put t j l))
|
||||
t)
|
||||
|
||||
(defn reverse
|
||||
"Reverses the order of the elements in a given array or tuple and returns a new array."
|
||||
"Reverses the order of the elements in a given array or tuple and returns
|
||||
a new array. If string or buffer is provided function returns array of chars reversed."
|
||||
[t]
|
||||
(def len (length t))
|
||||
(var n (- len 1))
|
||||
(def reversed (array/new len))
|
||||
(def ret (array/new len))
|
||||
(while (>= n 0)
|
||||
(array/push reversed (in t n))
|
||||
(array/push ret (in t n))
|
||||
(-- n))
|
||||
reversed)
|
||||
ret)
|
||||
|
||||
(defn invert
|
||||
"Returns a table of where the keys of an associative data structure
|
||||
"Returns a table where the keys of an associative data structure
|
||||
are the values, and the values of the keys. If multiple keys have the same
|
||||
value, one key will be ignored."
|
||||
[ds]
|
||||
@@ -1215,11 +1280,14 @@
|
||||
Returns a new table."
|
||||
[ks vs]
|
||||
(def res @{})
|
||||
(def lk (length ks))
|
||||
(def lv (length vs))
|
||||
(def len (if (< lk lv) lk lv))
|
||||
(for i 0 len
|
||||
(put res (in ks i) (in vs i)))
|
||||
(var kk nil)
|
||||
(var vk nil)
|
||||
(while true
|
||||
(set kk (next ks kk))
|
||||
(if (= nil kk) (break))
|
||||
(set vk (next vs vk))
|
||||
(if (= nil vk) (break))
|
||||
(put res (in ks kk) (in vs vk)))
|
||||
res)
|
||||
|
||||
(defn get-in
|
||||
@@ -1239,7 +1307,7 @@
|
||||
(var d ds)
|
||||
(def len-1 (- (length ks) 1))
|
||||
(if (< len-1 0) (error "expected at least 1 key in ks"))
|
||||
(for i 0 len-1
|
||||
(forv i 0 len-1
|
||||
(def k (get ks i))
|
||||
(def v (get d k))
|
||||
(if (= nil v)
|
||||
@@ -1261,7 +1329,7 @@
|
||||
(var d ds)
|
||||
(def len-1 (- (length ks) 1))
|
||||
(if (< len-1 0) (error "expected at least 1 key in ks"))
|
||||
(for i 0 len-1
|
||||
(forv i 0 len-1
|
||||
(def k (get ks i))
|
||||
(def v (get d k))
|
||||
(if (= nil v)
|
||||
@@ -1289,7 +1357,7 @@
|
||||
[tab & colls]
|
||||
(loop [c :in colls
|
||||
key :keys c]
|
||||
(set (tab key) (in c key)))
|
||||
(put tab key (in c key)))
|
||||
tab)
|
||||
|
||||
(defn merge
|
||||
@@ -1300,7 +1368,7 @@
|
||||
(def container @{})
|
||||
(loop [c :in colls
|
||||
key :keys c]
|
||||
(set (container key) (in c key)))
|
||||
(put container key (in c key)))
|
||||
container)
|
||||
|
||||
(defn keys
|
||||
@@ -1324,7 +1392,7 @@
|
||||
arr)
|
||||
|
||||
(defn pairs
|
||||
"Get the values of an associative data structure."
|
||||
"Get the key-value pairs of an associative data structure."
|
||||
[x]
|
||||
(def arr (array/new (length x)))
|
||||
(var k (next x nil))
|
||||
@@ -1554,9 +1622,9 @@
|
||||
,(aux (+ 2 i))
|
||||
,$res)))) 0)))
|
||||
|
||||
(put _env 'sentinel nil)
|
||||
(put _env 'match-1 nil)
|
||||
(put _env 'with-idemp nil)
|
||||
(undef sentinel)
|
||||
(undef match-1)
|
||||
(undef with-idemp)
|
||||
|
||||
###
|
||||
###
|
||||
@@ -1637,7 +1705,7 @@
|
||||
(print (doc-format (string "Bindings:\n\n" (string/join bindings " "))))
|
||||
(print)
|
||||
(print (doc-format (string "Dynamics:\n\n" (string/join dynamics " "))))
|
||||
(print))
|
||||
(print "\n Use (doc sym) for more information on a binding.\n"))
|
||||
|
||||
(defn doc*
|
||||
"Get the documentation for a symbol in a given environment. Function form of doc."
|
||||
@@ -1681,8 +1749,8 @@
|
||||
[&opt sym]
|
||||
~(,doc* ',sym))
|
||||
|
||||
(put _env 'env-walk nil)
|
||||
(put _env 'print-index nil)
|
||||
(undef env-walk)
|
||||
(undef print-index)
|
||||
|
||||
###
|
||||
###
|
||||
@@ -1743,14 +1811,16 @@
|
||||
(defn expandqq [t]
|
||||
(defn qq [x]
|
||||
(case (type x)
|
||||
:tuple (do
|
||||
(def x0 (in x 0))
|
||||
(if (or (= 'unquote x0) (= 'unquote-splicing x0))
|
||||
(tuple x0 (recur (in x 1)))
|
||||
(tuple/slice (map qq x))))
|
||||
:tuple (if (= :brackets (tuple/type x))
|
||||
~[,;(map qq x)]
|
||||
(do
|
||||
(def x0 (get x 0))
|
||||
(if (= 'unquote x0)
|
||||
(tuple x0 (recur (get x 1)))
|
||||
(tuple/slice (map qq x)))))
|
||||
:array (map qq x)
|
||||
:table (table (map qq (kvs x)))
|
||||
:struct (struct (map qq (kvs x)))
|
||||
:table (table ;(map qq (kvs x)))
|
||||
:struct (struct ;(map qq (kvs x)))
|
||||
x))
|
||||
(tuple (in t 0) (qq (in t 1))))
|
||||
|
||||
@@ -1814,7 +1884,7 @@
|
||||
(case tx
|
||||
:tuple (or (not= (length x) (length y)) (some identity (map deep-not= x y)))
|
||||
:array (or (not= (length x) (length y)) (some identity (map deep-not= x y)))
|
||||
:struct (deep-not= (pairs x) (pairs y))
|
||||
:struct (deep-not= (kvs x) (kvs y))
|
||||
:table (deep-not= (table/to-struct x) (table/to-struct y))
|
||||
:buffer (not= (string x) (string y))
|
||||
(not= x y))))
|
||||
@@ -1934,20 +2004,24 @@
|
||||
that should make it easier to write more complex patterns."
|
||||
~@{:d (range "09")
|
||||
:a (range "az" "AZ")
|
||||
:s (set " \t\r\n\0\f")
|
||||
:s (set " \t\r\n\0\f\v")
|
||||
:w (range "az" "AZ" "09")
|
||||
:h (range "09" "af")
|
||||
:S (if-not :s 1)
|
||||
:W (if-not :w 1)
|
||||
:A (if-not :a 1)
|
||||
:D (if-not :d 1)
|
||||
:H (if-not :h 1)
|
||||
:d+ (some :d)
|
||||
:a+ (some :a)
|
||||
:s+ (some :s)
|
||||
:w+ (some :w)
|
||||
:h+ (some :h)
|
||||
:d* (any :d)
|
||||
:a* (any :a)
|
||||
:w* (any :w)
|
||||
:s* (any :s)})
|
||||
:s* (any :s)
|
||||
:h* (any :h)})
|
||||
|
||||
###
|
||||
###
|
||||
@@ -1965,7 +2039,7 @@
|
||||
will inherit bindings from the parent environment, but new
|
||||
bindings will not pollute the parent environment."
|
||||
[&opt parent]
|
||||
(def parent (if parent parent _env))
|
||||
(def parent (if parent parent root-env))
|
||||
(def newenv (table/setproto @{} parent))
|
||||
newenv)
|
||||
|
||||
@@ -2002,6 +2076,14 @@
|
||||
(if ec "\e[0m" "")))
|
||||
(eflush))
|
||||
|
||||
(defn curenv
|
||||
"Get the current environment table. Same as (fiber/getenv (fiber/current)). If n
|
||||
is provided, gets the nth prototype of the environment table."
|
||||
[&opt n]
|
||||
(var e (fiber/getenv (fiber/current)))
|
||||
(if n (repeat n (if (= nil e) (break)) (set e (table/getproto e))))
|
||||
e)
|
||||
|
||||
(defn run-context
|
||||
"Run a context. This evaluates expressions in an environment,
|
||||
and is encapsulates the parsing, compilation, and evaluation.
|
||||
@@ -2129,12 +2211,12 @@
|
||||
(buffer/push-string buf "\n")))
|
||||
(var returnval nil)
|
||||
(run-context {:chunks chunks
|
||||
:on-compile-error (fn [msg errf &]
|
||||
:on-compile-error (fn compile-error [msg errf &]
|
||||
(error (string "compile error: " msg)))
|
||||
:on-parse-error (fn [p x]
|
||||
:on-parse-error (fn parse-error [p x]
|
||||
(error (string "parse error: " (parser/error p))))
|
||||
:fiber-flags :i
|
||||
:on-status (fn [f val]
|
||||
:on-status (fn on-status [f val]
|
||||
(if-not (= (fiber/status f) :dead)
|
||||
(error val))
|
||||
(set returnval val))
|
||||
@@ -2173,10 +2255,11 @@
|
||||
by make-image, such that (load-image bytes) is the same as (unmarshal bytes load-image-dict)."
|
||||
@{})
|
||||
|
||||
(def comptime
|
||||
(defmacro comptime
|
||||
"(comptime x)\n\n
|
||||
Evals x at compile time and returns the result. Similar to a top level unquote."
|
||||
:macro eval)
|
||||
[x]
|
||||
(eval x))
|
||||
|
||||
(defn make-image
|
||||
"Create an image from an environment returned by require.
|
||||
@@ -2230,7 +2313,7 @@
|
||||
(module/add-paths ".jimage" :image)
|
||||
|
||||
# Version of fexists that works even with a reduced OS
|
||||
(if-let [has-stat (_env 'os/stat)]
|
||||
(if-let [has-stat (root-env 'os/stat)]
|
||||
(let [stat (has-stat :value)]
|
||||
(defglobal "fexists" (fn fexists [path] (= :file (stat path :mode)))))
|
||||
(defglobal "fexists"
|
||||
@@ -2277,10 +2360,10 @@
|
||||
str-parts (interpose "\n " paths)]
|
||||
[nil (string "could not find module " path ":\n " ;str-parts)])))
|
||||
|
||||
(put _env 'fexists nil)
|
||||
(put _env 'mod-filter nil)
|
||||
(put _env 'check-. nil)
|
||||
(put _env 'not-check-. nil)
|
||||
(undef fexists)
|
||||
(undef mod-filter)
|
||||
(undef check-.)
|
||||
(undef not-check-.)
|
||||
|
||||
(def module/cache
|
||||
"Table mapping loaded module identifiers to their environments."
|
||||
@@ -2388,7 +2471,7 @@
|
||||
(def newv (table/setproto @{:private (not ep)} v))
|
||||
(put env (symbol prefix k) newv)))
|
||||
|
||||
(put _env 'require-1 nil)
|
||||
(undef require-1)
|
||||
|
||||
(defmacro import
|
||||
"Import a module. First requires the module, and then merges its
|
||||
@@ -2400,11 +2483,12 @@
|
||||
to be called. Dynamic bindings will NOT be imported. Use :fresh to bypass the
|
||||
module cache."
|
||||
[path & args]
|
||||
(def argm (map |(if (keyword? $) $ (string $)) args))
|
||||
(def ps (partition 2 args))
|
||||
(def argm (mapcat (fn [[k v]] [k (if (= k :as) (string v) v)]) ps))
|
||||
(tuple import* (string path) ;argm))
|
||||
|
||||
(defmacro use
|
||||
"Similar to import, but imported bindings are not prefixed with a namespace
|
||||
"Similar to import, but imported bindings are not prefixed with a module
|
||||
identifier. Can also import multiple modules in one shot."
|
||||
[& modules]
|
||||
~(do ,;(map |~(,import* ,(string $) :prefix "") modules)))
|
||||
@@ -2454,7 +2538,7 @@
|
||||
(in (.slots frame-idx) (or nth 0)))
|
||||
|
||||
# Conditional compilation for disasm
|
||||
(def disasm-alias (if-let [x (_env 'disasm)] (x :value)))
|
||||
(def disasm-alias (if-let [x (root-env 'disasm)] (x :value)))
|
||||
|
||||
(defn .disasm
|
||||
"Gets the assembly for the current function."
|
||||
@@ -2503,7 +2587,7 @@
|
||||
[&opt n]
|
||||
(def fun (.fn n))
|
||||
(def bytecode (.bytecode n))
|
||||
(for i 0 (length bytecode)
|
||||
(forv i 0 (length bytecode)
|
||||
(debug/fbreak fun i))
|
||||
(print "Set " (length bytecode) " breakpoints in " fun))
|
||||
|
||||
@@ -2512,17 +2596,13 @@
|
||||
[&opt n]
|
||||
(def fun (.fn n))
|
||||
(def bytecode (.bytecode n))
|
||||
(for i 0 (length bytecode)
|
||||
(forv i 0 (length bytecode)
|
||||
(debug/unfbreak fun i))
|
||||
(print "Cleared " (length bytecode) " breakpoints in " fun))
|
||||
|
||||
(unless (get _env 'disasm)
|
||||
(put _env '.disasm nil)
|
||||
(put _env '.bytecode nil)
|
||||
(put _env '.breakall nil)
|
||||
(put _env '.clearall nil)
|
||||
(put _env '.ppasm nil))
|
||||
(put _env 'disasm-alias nil)
|
||||
(unless (get root-env 'disasm)
|
||||
(undef .disasm .bytecode .breakall .clearall .ppasm))
|
||||
(undef disasm-alias)
|
||||
|
||||
(defn .source
|
||||
"Show the source code for the function being debugged."
|
||||
@@ -2554,7 +2634,7 @@
|
||||
"Go to the next breakpoint."
|
||||
[&opt n]
|
||||
(var res nil)
|
||||
(for i 0 (or n 1)
|
||||
(forv i 0 (or n 1)
|
||||
(set res (resume (.fiber))))
|
||||
res)
|
||||
|
||||
@@ -2568,7 +2648,7 @@
|
||||
"Execute the next n instructions."
|
||||
[&opt n]
|
||||
(var res nil)
|
||||
(for i 0 (or n 1)
|
||||
(forv i 0 (or n 1)
|
||||
(set res (debug/step (.fiber))))
|
||||
res)
|
||||
|
||||
@@ -2576,9 +2656,9 @@
|
||||
"An environment that contains dot prefixed functions for debugging."
|
||||
@{})
|
||||
|
||||
(def- debugger-keys (filter (partial string/has-prefix? ".") (keys _env)))
|
||||
(each k debugger-keys (put debugger-env k (_env k)) (put _env k nil))
|
||||
(put _env 'debugger-keys nil)
|
||||
(def- debugger-keys (filter (partial string/has-prefix? ".") (keys root-env)))
|
||||
(each k debugger-keys (put debugger-env k (root-env k)) (put root-env k nil))
|
||||
(undef debugger-keys)
|
||||
|
||||
###
|
||||
###
|
||||
@@ -2642,6 +2722,37 @@
|
||||
:on-status (or onsignal (make-onsignal env 1))
|
||||
:source "repl"}))
|
||||
|
||||
###
|
||||
###
|
||||
### Extras
|
||||
###
|
||||
###
|
||||
|
||||
(defmacro- guarddef
|
||||
[sym form]
|
||||
(if (dyn sym)
|
||||
form))
|
||||
|
||||
(guarddef ev/go
|
||||
(defmacro ev/spawn
|
||||
"Run some code in a new fiber. This is shorthand for (ev/call (fn [] ;body))."
|
||||
[& body]
|
||||
~(,ev/call (fn [] ,;body))))
|
||||
|
||||
(guarddef net/listen
|
||||
(defn net/server
|
||||
"Start a server asynchornously with net/listen and net/accept-loop. Returns the new server stream."
|
||||
[host port &opt handler type]
|
||||
(def s (net/listen host port type))
|
||||
(if handler
|
||||
(ev/call (fn [] (net/accept-loop s handler))))
|
||||
s))
|
||||
|
||||
(guarddef ev/close
|
||||
(defn net/close "Alias for ev/close." [stream] (ev/close stream)))
|
||||
|
||||
(undef guarddef)
|
||||
|
||||
###
|
||||
###
|
||||
### CLI Tool Main
|
||||
@@ -2649,7 +2760,7 @@
|
||||
###
|
||||
|
||||
(defn- no-side-effects
|
||||
"Check if form may have side effects. If returns true, then the src
|
||||
"Check if form may have side effects. If rturns true, then the src
|
||||
must not have side effects, such as calling a C function."
|
||||
[src]
|
||||
(cond
|
||||
@@ -2674,7 +2785,7 @@
|
||||
(each a args (import* (string a) :prefix "" :evaluator evaluator)))
|
||||
|
||||
# conditional compilation for reduced os
|
||||
(def- getenv-alias (if-let [entry (in _env 'os/getenv)] (entry :value) (fn [&])))
|
||||
(def- getenv-alias (if-let [entry (in root-env 'os/getenv)] (entry :value) (fn [&])))
|
||||
|
||||
(defn cli-main
|
||||
"Entrance for the Janet CLI tool. Call this functions with the command line
|
||||
@@ -2706,15 +2817,15 @@
|
||||
-v : Print the version string
|
||||
-s : Use raw stdin instead of getline like functionality
|
||||
-e code : Execute a string of janet
|
||||
-d : Set the debug flag in the repl
|
||||
-r : Enter the repl after running all scripts
|
||||
-p : Keep on executing if there is a top level error (persistent)
|
||||
-d : Set the debug flag in the REPL
|
||||
-r : Enter the REPL after running all scripts
|
||||
-p : Keep on executing if there is a top-level error (persistent)
|
||||
-q : Hide logo (quiet)
|
||||
-k : Compile scripts but do not execute (flycheck)
|
||||
-m syspath : Set system path for loading global modules
|
||||
-c source output : Compile janet source code into an image
|
||||
-n : Disable ANSI color output in the repl
|
||||
-l path : Execute code in a file before running the main script
|
||||
-n : Disable ANSI color output in the REPL
|
||||
-l lib : Import a module before processing more arguments
|
||||
-- : Stop handling options`)
|
||||
(os/exit 0)
|
||||
1)
|
||||
@@ -2726,17 +2837,17 @@
|
||||
"k" (fn [&] (set *compile-only* true) (set *exit-on-error* false) 1)
|
||||
"n" (fn [&] (set *colorize* false) 1)
|
||||
"m" (fn [i &] (setdyn :syspath (in args (+ i 1))) 2)
|
||||
"c" (fn [i &]
|
||||
"c" (fn c-switch [i &]
|
||||
(def e (dofile (in args (+ i 1))))
|
||||
(spit (in args (+ i 2)) (make-image e))
|
||||
(set *no-file* false)
|
||||
3)
|
||||
"-" (fn [&] (set *handleopts* false) 1)
|
||||
"l" (fn [i &]
|
||||
"l" (fn l-switch [i &]
|
||||
(import* (in args (+ i 1))
|
||||
:prefix "" :exit *exit-on-error*)
|
||||
2)
|
||||
"e" (fn [i &]
|
||||
"e" (fn e-switch [i &]
|
||||
(set *no-file* false)
|
||||
(eval-string (in args (+ i 1)))
|
||||
2)
|
||||
@@ -2783,18 +2894,19 @@
|
||||
(def subargs (array/slice args i))
|
||||
(put env :args subargs)
|
||||
(dofile arg :prefix "" :exit *exit-on-error* :evaluator evaluator :env env)
|
||||
(if-let [main (get (in env 'main) :value)]
|
||||
(let [thunk (compile [main ;(tuple/slice args i)] env arg)]
|
||||
(if (function? thunk) (thunk) (error (thunk :error)))))
|
||||
(unless *compile-only*
|
||||
(if-let [main (get (in env 'main) :value)]
|
||||
(let [thunk (compile [main ;(tuple/slice args i)] env arg)]
|
||||
(if (function? thunk) (thunk) (error (thunk :error))))))
|
||||
(set i lenargs))))
|
||||
|
||||
(when (and (not *compile-only*) (or *should-repl* *no-file*))
|
||||
(if-not *quiet*
|
||||
(print "Janet " janet/version "-" janet/build " Copyright (C) 2017-2020 Calvin Rose"))
|
||||
(print "Janet " janet/version "-" janet/build " " (os/which) "/" (os/arch) " - '(doc)' for help"))
|
||||
(flush)
|
||||
(defn getprompt [p]
|
||||
(def [line] (parser/where p))
|
||||
(string "janet:" line ":" (parser/state p :delimiters) "> "))
|
||||
(string "repl:" line ":" (parser/state p :delimiters) "> "))
|
||||
(defn getstdin [prompt buf _]
|
||||
(file/write stdout prompt)
|
||||
(file/flush stdout)
|
||||
@@ -2808,12 +2920,7 @@
|
||||
(setdyn :err-color (if *colorize* true))
|
||||
(repl getchunk nil env)))
|
||||
|
||||
(put _env 'no-side-effects nil)
|
||||
(put _env 'is-safe-def nil)
|
||||
(put _env 'safe-forms nil)
|
||||
(put _env 'importers nil)
|
||||
(put _env 'use-2 nil)
|
||||
(put _env 'getenv-alias nil)
|
||||
(undef no-side-effects is-safe-def safe-forms importers use-2 getenv-alias)
|
||||
|
||||
###
|
||||
###
|
||||
@@ -2821,12 +2928,13 @@
|
||||
###
|
||||
###
|
||||
|
||||
(def root-env "The root environment used to create environments with (make-env)" _env)
|
||||
|
||||
(do
|
||||
(put _env 'boot/opts nil)
|
||||
(put _env '_env nil)
|
||||
(def load-dict (env-lookup _env))
|
||||
(undef boot/opts undef)
|
||||
(def load-dict (env-lookup root-env))
|
||||
(put load-dict 'boot/config nil)
|
||||
(put load-dict 'boot/args nil)
|
||||
(each [k v] (pairs load-dict)
|
||||
(if (number? v) (put load-dict k nil)))
|
||||
(merge-into load-image-dict load-dict)
|
||||
(merge-into make-image-dict (invert load-dict)))
|
||||
|
||||
@@ -2847,25 +2955,29 @@
|
||||
(put into k (x k))))
|
||||
into)
|
||||
|
||||
(def env (fiber/getenv (fiber/current)))
|
||||
|
||||
# Modify env based on some options.
|
||||
(loop [[k v] :pairs env
|
||||
(loop [[k v] :pairs root-env
|
||||
:when (symbol? k)]
|
||||
(def flat (proto-flatten @{} v))
|
||||
(when (boot/config :no-docstrings)
|
||||
(put flat :doc nil))
|
||||
(when (boot/config :no-sourcemaps)
|
||||
(put flat :source-map nil))
|
||||
(put env k flat))
|
||||
(put root-env k flat))
|
||||
|
||||
(put env 'boot/config nil)
|
||||
(put env 'boot/args nil)
|
||||
(def image (let [env-pairs (pairs (env-lookup env))
|
||||
(put root-env 'boot/config nil)
|
||||
(put root-env 'boot/args nil)
|
||||
|
||||
(def image (let [env-pairs (pairs (env-lookup root-env))
|
||||
essential-pairs (filter (fn [[k v]] (or (cfunction? v) (abstract? v))) env-pairs)
|
||||
lookup (table ;(mapcat identity essential-pairs))
|
||||
reverse-lookup (invert lookup)]
|
||||
(marshal env reverse-lookup)))
|
||||
# Check no duplicate values
|
||||
(def temp @{})
|
||||
(eachp [k v] lookup
|
||||
(if (in temp v) (errorf "duplicate value: %v" v))
|
||||
(put temp v k))
|
||||
(marshal root-env reverse-lookup)))
|
||||
|
||||
# Create amalgamation
|
||||
|
||||
@@ -2894,6 +3006,7 @@
|
||||
"src/core/corelib.c"
|
||||
"src/core/debug.c"
|
||||
"src/core/emit.c"
|
||||
"src/core/ev.c"
|
||||
"src/core/fiber.c"
|
||||
"src/core/gc.c"
|
||||
"src/core/inttypes.c"
|
||||
|
||||
@@ -23,6 +23,7 @@
|
||||
#include <janet.h>
|
||||
#include <assert.h>
|
||||
#include <stdio.h>
|
||||
#include <math.h>
|
||||
|
||||
#include "tests.h"
|
||||
|
||||
@@ -44,6 +45,11 @@ int system_test() {
|
||||
assert(janet_equals(janet_wrap_integer(INT32_MIN), janet_wrap_integer(INT32_MIN)));
|
||||
assert(janet_equals(janet_wrap_number(1.4), janet_wrap_number(1.4)));
|
||||
assert(janet_equals(janet_wrap_number(3.14159265), janet_wrap_number(3.14159265)));
|
||||
#ifdef NAN
|
||||
assert(janet_checktype(janet_wrap_number(NAN), JANET_NUMBER));
|
||||
#else
|
||||
assert(janet_checktype(janet_wrap_number(0.0 / 0.0), JANET_NUMBER));
|
||||
#endif
|
||||
|
||||
assert(NULL != &janet_wrap_nil);
|
||||
|
||||
|
||||
@@ -61,5 +61,11 @@ int table_test() {
|
||||
assert(janet_equals(janet_table_get(t2, janet_csymbolv("t2key1")), janet_wrap_integer(10)));
|
||||
assert(janet_equals(janet_table_get(t2, janet_csymbolv("t2key2")), janet_wrap_integer(100)));
|
||||
|
||||
assert(t2->count == 4);
|
||||
assert(janet_equals(janet_table_remove(t2, janet_csymbolv("t2key1")), janet_wrap_integer(10)));
|
||||
assert(t2->count == 3);
|
||||
assert(janet_equals(janet_table_remove(t2, janet_csymbolv("t2key2")), janet_wrap_integer(100)));
|
||||
assert(t2->count == 2);
|
||||
|
||||
return 0;
|
||||
}
|
||||
|
||||
@@ -27,10 +27,10 @@
|
||||
#define JANETCONF_H
|
||||
|
||||
#define JANET_VERSION_MAJOR 1
|
||||
#define JANET_VERSION_MINOR 10
|
||||
#define JANET_VERSION_PATCH 1
|
||||
#define JANET_VERSION_EXTRA ""
|
||||
#define JANET_VERSION "1.10.1"
|
||||
#define JANET_VERSION_MINOR 13
|
||||
#define JANET_VERSION_PATCH 0
|
||||
#define JANET_VERSION_EXTRA "-dev"
|
||||
#define JANET_VERSION "1.13.0-dev"
|
||||
|
||||
/* #define JANET_BUILD "local" */
|
||||
|
||||
@@ -41,7 +41,8 @@
|
||||
/* #define JANET_API __attribute__((visibility ("default"))) */
|
||||
|
||||
/* These settings should be specified before amalgamation is
|
||||
* built. */
|
||||
* built. Any build with these set should be considered non-standard, and
|
||||
* certain Janet libraries should be expected not to work. */
|
||||
/* #define JANET_NO_DOCSTRINGS */
|
||||
/* #define JANET_NO_SOURCEMAPS */
|
||||
/* #define JANET_REDUCED_OS */
|
||||
@@ -51,13 +52,15 @@
|
||||
/* #define JANET_NO_NET */
|
||||
/* #define JANET_NO_TYPED_ARRAY */
|
||||
/* #define JANET_NO_INT_TYPES */
|
||||
|
||||
/* Other settings */
|
||||
/* #define JANET_NO_PRF */
|
||||
/* #define JANET_NO_UTC_MKTIME */
|
||||
/* #define JANET_NO_EV */
|
||||
/* #define JANET_NO_REALPATH */
|
||||
/* #define JANET_NO_SYMLINKS */
|
||||
/* #define JANET_NO_UMASK */
|
||||
|
||||
/* Other settings */
|
||||
/* #define JANET_DEBUG */
|
||||
/* #define JANET_PRF */
|
||||
/* #define JANET_NO_UTC_MKTIME */
|
||||
/* #define JANET_OUT_OF_MEMORY do { printf("janet out of memory\n"); exit(1); } while (0) */
|
||||
/* #define JANET_EXIT(msg) do { printf("C assert failed executing janet: %s\n", msg); exit(1); } while (0) */
|
||||
/* #define JANET_TOP_LEVEL_SIGNAL(msg) call_my_function((msg), stderr) */
|
||||
@@ -67,5 +70,9 @@
|
||||
/* #define JANET_STACK_MAX 16384 */
|
||||
/* #define JANET_OS_NAME my-custom-os */
|
||||
/* #define JANET_ARCH_NAME pdp-8 */
|
||||
/* #define JANET_EV_EPOLL */
|
||||
|
||||
/* Main client settings, does not affect library code */
|
||||
/* #define JANET_SIMPLE_GETLINE */
|
||||
|
||||
#endif /* end of include guard: JANETCONF_H */
|
||||
|
||||
@@ -344,16 +344,16 @@ static const JanetReg array_cfuns[] = {
|
||||
{
|
||||
"array/concat", cfun_array_concat,
|
||||
JDOC("(array/concat arr & parts)\n\n"
|
||||
"Concatenates a variadic number of arrays (and tuples) into the first argument "
|
||||
"which must an array. If any of the parts are arrays or tuples, their elements will "
|
||||
"Concatenates a variable number of arrays (and tuples) into the first argument "
|
||||
"which must be an array. If any of the parts are arrays or tuples, their elements will "
|
||||
"be inserted into the array. Otherwise, each part in parts will be appended to arr in order. "
|
||||
"Return the modified array arr.")
|
||||
},
|
||||
{
|
||||
"array/insert", cfun_array_insert,
|
||||
JDOC("(array/insert arr at & xs)\n\n"
|
||||
"Insert all of xs into array arr at index at. at should be an integer "
|
||||
"0 and the length of the array. A negative value for at will index from "
|
||||
"Insert all xs into array arr at index at. at should be an integer between "
|
||||
"0 and the length of the array. A negative value for at will index backwards from "
|
||||
"the end of the array, such that inserting at -1 appends to the array. "
|
||||
"Returns the array.")
|
||||
},
|
||||
|
||||
198
src/core/asm.c
198
src/core/asm.c
@@ -73,6 +73,7 @@ static const JanetInstructionDef janet_ops[] = {
|
||||
{"call", JOP_CALL},
|
||||
{"clo", JOP_CLOSURE},
|
||||
{"cmp", JOP_COMPARE},
|
||||
{"cncl", JOP_CANCEL},
|
||||
{"div", JOP_DIVIDE},
|
||||
{"divim", JOP_DIVIDE_IMMEDIATE},
|
||||
{"eq", JOP_EQUALS},
|
||||
@@ -112,6 +113,8 @@ static const JanetInstructionDef janet_ops[] = {
|
||||
{"movn", JOP_MOVE_NEAR},
|
||||
{"mul", JOP_MULTIPLY},
|
||||
{"mulim", JOP_MULTIPLY_IMMEDIATE},
|
||||
{"neq", JOP_NOT_EQUALS},
|
||||
{"neqim", JOP_NOT_EQUALS_IMMEDIATE},
|
||||
{"next", JOP_NEXT},
|
||||
{"noop", JOP_NOOP},
|
||||
{"prop", JOP_PROPAGATE},
|
||||
@@ -718,6 +721,9 @@ static JanetAssembleResult janet_asm1(JanetAssembler *parent, Janet source, int
|
||||
janet_asm_error(&a, "invalid assembly");
|
||||
}
|
||||
|
||||
/* Add final flags */
|
||||
janet_def_addflags(def);
|
||||
|
||||
/* Finish everything and return funcdef */
|
||||
janet_asm_deinit(&a);
|
||||
result.error = NULL;
|
||||
@@ -835,85 +841,110 @@ Janet janet_asm_decode_instruction(uint32_t instr) {
|
||||
return janet_wrap_nil();
|
||||
}
|
||||
|
||||
Janet janet_disasm(JanetFuncDef *def) {
|
||||
int32_t i;
|
||||
/*
|
||||
* Disasm sections
|
||||
*/
|
||||
|
||||
static Janet janet_disasm_arity(JanetFuncDef *def) {
|
||||
return janet_wrap_integer(def->arity);
|
||||
}
|
||||
|
||||
static Janet janet_disasm_min_arity(JanetFuncDef *def) {
|
||||
return janet_wrap_integer(def->min_arity);
|
||||
}
|
||||
|
||||
static Janet janet_disasm_max_arity(JanetFuncDef *def) {
|
||||
return janet_wrap_integer(def->max_arity);
|
||||
}
|
||||
|
||||
static Janet janet_disasm_slotcount(JanetFuncDef *def) {
|
||||
return janet_wrap_integer(def->slotcount);
|
||||
}
|
||||
|
||||
static Janet janet_disasm_bytecode(JanetFuncDef *def) {
|
||||
JanetArray *bcode = janet_array(def->bytecode_length);
|
||||
JanetArray *constants;
|
||||
JanetTable *ret = janet_table(10);
|
||||
janet_table_put(ret, janet_ckeywordv("arity"), janet_wrap_integer(def->arity));
|
||||
janet_table_put(ret, janet_ckeywordv("min-arity"), janet_wrap_integer(def->min_arity));
|
||||
janet_table_put(ret, janet_ckeywordv("max-arity"), janet_wrap_integer(def->max_arity));
|
||||
janet_table_put(ret, janet_ckeywordv("bytecode"), janet_wrap_array(bcode));
|
||||
if (NULL != def->source) {
|
||||
janet_table_put(ret, janet_ckeywordv("source"), janet_wrap_string(def->source));
|
||||
}
|
||||
if (def->flags & JANET_FUNCDEF_FLAG_VARARG) {
|
||||
janet_table_put(ret, janet_ckeywordv("vararg"), janet_wrap_true());
|
||||
}
|
||||
if (NULL != def->name) {
|
||||
janet_table_put(ret, janet_ckeywordv("name"), janet_wrap_string(def->name));
|
||||
}
|
||||
|
||||
/* Add constants */
|
||||
if (def->constants_length > 0) {
|
||||
constants = janet_array(def->constants_length);
|
||||
janet_table_put(ret, janet_ckeywordv("constants"), janet_wrap_array(constants));
|
||||
for (i = 0; i < def->constants_length; i++) {
|
||||
constants->data[i] = def->constants[i];
|
||||
}
|
||||
constants->count = def->constants_length;
|
||||
}
|
||||
|
||||
/* Add bytecode */
|
||||
for (i = 0; i < def->bytecode_length; i++) {
|
||||
for (int32_t i = 0; i < def->bytecode_length; i++) {
|
||||
bcode->data[i] = janet_asm_decode_instruction(def->bytecode[i]);
|
||||
}
|
||||
bcode->count = def->bytecode_length;
|
||||
return janet_wrap_array(bcode);
|
||||
}
|
||||
|
||||
/* Add source map */
|
||||
if (NULL != def->sourcemap) {
|
||||
JanetArray *sourcemap = janet_array(def->bytecode_length);
|
||||
for (i = 0; i < def->bytecode_length; i++) {
|
||||
Janet *t = janet_tuple_begin(2);
|
||||
JanetSourceMapping mapping = def->sourcemap[i];
|
||||
t[0] = janet_wrap_integer(mapping.line);
|
||||
t[1] = janet_wrap_integer(mapping.column);
|
||||
sourcemap->data[i] = janet_wrap_tuple(janet_tuple_end(t));
|
||||
}
|
||||
sourcemap->count = def->bytecode_length;
|
||||
janet_table_put(ret, janet_ckeywordv("sourcemap"), janet_wrap_array(sourcemap));
|
||||
static Janet janet_disasm_source(JanetFuncDef *def) {
|
||||
if (def->source != NULL) return janet_wrap_string(def->source);
|
||||
return janet_wrap_nil();
|
||||
}
|
||||
|
||||
static Janet janet_disasm_name(JanetFuncDef *def) {
|
||||
if (def->name != NULL) return janet_wrap_string(def->name);
|
||||
return janet_wrap_nil();
|
||||
}
|
||||
|
||||
static Janet janet_disasm_vararg(JanetFuncDef *def) {
|
||||
return janet_wrap_boolean(def->flags & JANET_FUNCDEF_FLAG_VARARG);
|
||||
}
|
||||
|
||||
static Janet janet_disasm_constants(JanetFuncDef *def) {
|
||||
JanetArray *constants = janet_array(def->constants_length);
|
||||
for (int32_t i = 0; i < def->constants_length; i++) {
|
||||
constants->data[i] = def->constants[i];
|
||||
}
|
||||
constants->count = def->constants_length;
|
||||
return janet_wrap_array(constants);
|
||||
}
|
||||
|
||||
/* Add environments */
|
||||
if (NULL != def->environments) {
|
||||
JanetArray *envs = janet_array(def->environments_length);
|
||||
for (i = 0; i < def->environments_length; i++) {
|
||||
envs->data[i] = janet_wrap_integer(def->environments[i]);
|
||||
}
|
||||
envs->count = def->environments_length;
|
||||
janet_table_put(ret, janet_ckeywordv("environments"), janet_wrap_array(envs));
|
||||
static Janet janet_disasm_sourcemap(JanetFuncDef *def) {
|
||||
if (NULL == def->sourcemap) return janet_wrap_nil();
|
||||
JanetArray *sourcemap = janet_array(def->bytecode_length);
|
||||
for (int32_t i = 0; i < def->bytecode_length; i++) {
|
||||
Janet *t = janet_tuple_begin(2);
|
||||
JanetSourceMapping mapping = def->sourcemap[i];
|
||||
t[0] = janet_wrap_integer(mapping.line);
|
||||
t[1] = janet_wrap_integer(mapping.column);
|
||||
sourcemap->data[i] = janet_wrap_tuple(janet_tuple_end(t));
|
||||
}
|
||||
sourcemap->count = def->bytecode_length;
|
||||
return janet_wrap_array(sourcemap);
|
||||
}
|
||||
|
||||
/* Add closures */
|
||||
/* Funcdefs cannot be recursive */
|
||||
if (NULL != def->defs) {
|
||||
JanetArray *defs = janet_array(def->defs_length);
|
||||
for (i = 0; i < def->defs_length; i++) {
|
||||
defs->data[i] = janet_disasm(def->defs[i]);
|
||||
}
|
||||
defs->count = def->defs_length;
|
||||
janet_table_put(ret, janet_ckeywordv("defs"), janet_wrap_array(defs));
|
||||
static Janet janet_disasm_environments(JanetFuncDef *def) {
|
||||
JanetArray *envs = janet_array(def->environments_length);
|
||||
for (int32_t i = 0; i < def->environments_length; i++) {
|
||||
envs->data[i] = janet_wrap_integer(def->environments[i]);
|
||||
}
|
||||
envs->count = def->environments_length;
|
||||
return janet_wrap_array(envs);
|
||||
}
|
||||
|
||||
/* Add slotcount */
|
||||
janet_table_put(ret, janet_ckeywordv("slotcount"), janet_wrap_integer(def->slotcount));
|
||||
static Janet janet_disasm_defs(JanetFuncDef *def) {
|
||||
JanetArray *defs = janet_array(def->defs_length);
|
||||
for (int32_t i = 0; i < def->defs_length; i++) {
|
||||
defs->data[i] = janet_disasm(def->defs[i]);
|
||||
}
|
||||
defs->count = def->defs_length;
|
||||
return janet_wrap_array(defs);
|
||||
}
|
||||
|
||||
Janet janet_disasm(JanetFuncDef *def) {
|
||||
JanetTable *ret = janet_table(10);
|
||||
janet_table_put(ret, janet_ckeywordv("arity"), janet_disasm_arity(def));
|
||||
janet_table_put(ret, janet_ckeywordv("min-arity"), janet_disasm_min_arity(def));
|
||||
janet_table_put(ret, janet_ckeywordv("max-arity"), janet_disasm_max_arity(def));
|
||||
janet_table_put(ret, janet_ckeywordv("bytecode"), janet_disasm_bytecode(def));
|
||||
janet_table_put(ret, janet_ckeywordv("source"), janet_disasm_source(def));
|
||||
janet_table_put(ret, janet_ckeywordv("vararg"), janet_disasm_vararg(def));
|
||||
janet_table_put(ret, janet_ckeywordv("name"), janet_disasm_name(def));
|
||||
janet_table_put(ret, janet_ckeywordv("slotcount"), janet_disasm_slotcount(def));
|
||||
janet_table_put(ret, janet_ckeywordv("constants"), janet_disasm_constants(def));
|
||||
janet_table_put(ret, janet_ckeywordv("sourcemap"), janet_disasm_sourcemap(def));
|
||||
janet_table_put(ret, janet_ckeywordv("environments"), janet_disasm_environments(def));
|
||||
janet_table_put(ret, janet_ckeywordv("defs"), janet_disasm_defs(def));
|
||||
return janet_wrap_struct(janet_table_to_struct(ret));
|
||||
}
|
||||
|
||||
/* C Function for assembly */
|
||||
static Janet cfun_asm(int32_t argc, Janet *argv) {
|
||||
janet_arity(argc, 1, 1);
|
||||
janet_fixarity(argc, 1);
|
||||
JanetAssembleResult res;
|
||||
res = janet_asm(argv[0], 0);
|
||||
if (res.status != JANET_ASSEMBLE_OK) {
|
||||
@@ -923,9 +954,26 @@ static Janet cfun_asm(int32_t argc, Janet *argv) {
|
||||
}
|
||||
|
||||
static Janet cfun_disasm(int32_t argc, Janet *argv) {
|
||||
janet_arity(argc, 1, 1);
|
||||
janet_arity(argc, 1, 2);
|
||||
JanetFunction *f = janet_getfunction(argv, 0);
|
||||
return janet_disasm(f->def);
|
||||
if (argc == 2) {
|
||||
JanetKeyword kw = janet_getkeyword(argv, 1);
|
||||
if (!janet_cstrcmp(kw, "arity")) return janet_disasm_arity(f->def);
|
||||
if (!janet_cstrcmp(kw, "min-arity")) return janet_disasm_min_arity(f->def);
|
||||
if (!janet_cstrcmp(kw, "max-arity")) return janet_disasm_max_arity(f->def);
|
||||
if (!janet_cstrcmp(kw, "bytecode")) return janet_disasm_bytecode(f->def);
|
||||
if (!janet_cstrcmp(kw, "source")) return janet_disasm_source(f->def);
|
||||
if (!janet_cstrcmp(kw, "name")) return janet_disasm_name(f->def);
|
||||
if (!janet_cstrcmp(kw, "vararg")) return janet_disasm_vararg(f->def);
|
||||
if (!janet_cstrcmp(kw, "slotcount")) return janet_disasm_slotcount(f->def);
|
||||
if (!janet_cstrcmp(kw, "constants")) return janet_disasm_constants(f->def);
|
||||
if (!janet_cstrcmp(kw, "sourcemap")) return janet_disasm_sourcemap(f->def);
|
||||
if (!janet_cstrcmp(kw, "environments")) return janet_disasm_environments(f->def);
|
||||
if (!janet_cstrcmp(kw, "defs")) return janet_disasm_defs(f->def);
|
||||
janet_panicf("unknown disasm key %v", argv[1]);
|
||||
} else {
|
||||
return janet_disasm(f->def);
|
||||
}
|
||||
}
|
||||
|
||||
static const JanetReg asm_cfuns[] = {
|
||||
@@ -933,15 +981,29 @@ static const JanetReg asm_cfuns[] = {
|
||||
"asm", cfun_asm,
|
||||
JDOC("(asm assembly)\n\n"
|
||||
"Returns a new function that is the compiled result of the assembly.\n"
|
||||
"The syntax for the assembly can be found on the Janet website. Will throw an\n"
|
||||
"The syntax for the assembly can be found on the Janet website, and should correspond\n"
|
||||
"to the return value of disasm. Will throw an\n"
|
||||
"error on invalid assembly.")
|
||||
},
|
||||
{
|
||||
"disasm", cfun_disasm,
|
||||
JDOC("(disasm func)\n\n"
|
||||
"Returns assembly that could be used be compile the given function.\n"
|
||||
JDOC("(disasm func &opt field)\n\n"
|
||||
"Returns assembly that could be used to compile the given function.\n"
|
||||
"func must be a function, not a c function. Will throw on error on a badly\n"
|
||||
"typed argument.")
|
||||
"typed argument. If given a field name, will only return that part of the function assembly.\n"
|
||||
"Possible fields are:\n\n"
|
||||
"\t:arity - number of required and optional arguments.\n"
|
||||
"\t:min-arity - minimum number of arguments function can be called with.\n"
|
||||
"\t:max-arity - maximum number of arguments function can be called with.\n"
|
||||
"\t:vararg - true if function can take a variable number of arguments.\n"
|
||||
"\t:bytecode - array of parsed bytecode instructions. Each instruction is a tuple.\n"
|
||||
"\t:source - name of source file that this function was compiled from.\n"
|
||||
"\t:name - name of function.\n"
|
||||
"\t:slotcount - how many virtual registers, or slots, this function uses. Corresponds to stack space used by function.\n"
|
||||
"\t:constants - an array of constants referenced by this function.\n"
|
||||
"\t:sourcemap - a mapping of each bytecode instruction to a line and column in the source file.\n"
|
||||
"\t:environments - an internal mapping of which enclosing functions are referenced for bindings.\n"
|
||||
"\t:defs - other function definitions that this function may instantiate.\n")
|
||||
},
|
||||
{NULL, NULL, NULL}
|
||||
};
|
||||
|
||||
@@ -101,10 +101,13 @@ enum JanetInstructionType janet_instructions[JOP_INSTRUCTION_COUNT] = {
|
||||
JINT_SSS, /* JOP_GREATER_THAN_EQUAL */
|
||||
JINT_SSS, /* JOP_LESS_THAN_EQUAL */
|
||||
JINT_SSS, /* JOP_NEXT */
|
||||
JINT_SSS, /* JOP_NOT_EQUALS, */
|
||||
JINT_SSI, /* JOP_NOT_EQUALS_IMMEDIATE, */
|
||||
JINT_SSS /* JOP_CANCEL, */
|
||||
};
|
||||
|
||||
/* Verify some bytecode */
|
||||
int32_t janet_verify(JanetFuncDef *def) {
|
||||
int janet_verify(JanetFuncDef *def) {
|
||||
int vargs = !!(def->flags & JANET_FUNCDEF_FLAG_VARARG);
|
||||
int32_t i;
|
||||
int32_t maxslot = def->arity + vargs;
|
||||
|
||||
@@ -27,12 +27,26 @@
|
||||
#include "fiber.h"
|
||||
#endif
|
||||
|
||||
#ifndef JANET_SINGLE_THREADED
|
||||
#ifndef JANET_WINDOWS
|
||||
#include <pthread.h>
|
||||
#else
|
||||
#include <windows.h>
|
||||
#endif
|
||||
#endif
|
||||
|
||||
JANET_NO_RETURN static void janet_top_level_signal(const char *msg) {
|
||||
#ifdef JANET_TOP_LEVEL_SIGNAL
|
||||
JANET_TOP_LEVEL_SIGNAL(msg);
|
||||
#else
|
||||
fputs(msg, stdout);
|
||||
exit(1);
|
||||
# ifdef JANET_SINGLE_THREADED
|
||||
exit(-1);
|
||||
# elif defined(JANET_WINDOWS)
|
||||
ExitThread(-1);
|
||||
# else
|
||||
pthread_exit(NULL);
|
||||
# endif
|
||||
#endif
|
||||
}
|
||||
|
||||
@@ -325,7 +339,10 @@ JanetRange janet_getslice(int32_t argc, const Janet *argv) {
|
||||
}
|
||||
|
||||
Janet janet_dyn(const char *name) {
|
||||
if (!janet_vm_fiber) return janet_wrap_nil();
|
||||
if (!janet_vm_fiber) {
|
||||
if (!janet_vm_top_dyns) return janet_wrap_nil();
|
||||
return janet_table_get(janet_vm_top_dyns, janet_ckeywordv(name));
|
||||
}
|
||||
if (janet_vm_fiber->env) {
|
||||
return janet_table_get(janet_vm_fiber->env, janet_ckeywordv(name));
|
||||
} else {
|
||||
@@ -334,11 +351,15 @@ Janet janet_dyn(const char *name) {
|
||||
}
|
||||
|
||||
void janet_setdyn(const char *name, Janet value) {
|
||||
if (!janet_vm_fiber) return;
|
||||
if (!janet_vm_fiber->env) {
|
||||
janet_vm_fiber->env = janet_table(1);
|
||||
if (!janet_vm_fiber) {
|
||||
if (!janet_vm_top_dyns) janet_vm_top_dyns = janet_table(10);
|
||||
janet_table_put(janet_vm_top_dyns, janet_ckeywordv(name), value);
|
||||
} else {
|
||||
if (!janet_vm_fiber->env) {
|
||||
janet_vm_fiber->env = janet_table(1);
|
||||
}
|
||||
janet_table_put(janet_vm_fiber->env, janet_ckeywordv(name), value);
|
||||
}
|
||||
janet_table_put(janet_vm_fiber->env, janet_ckeywordv(name), value);
|
||||
}
|
||||
|
||||
uint64_t janet_getflags(const Janet *argv, int32_t n, const char *flags) {
|
||||
|
||||
132
src/core/cfuns.c
132
src/core/cfuns.c
@@ -33,6 +33,11 @@ static int arity1or2(JanetFopts opts, JanetSlot *args) {
|
||||
int32_t arity = janet_v_count(args);
|
||||
return arity == 1 || arity == 2;
|
||||
}
|
||||
static int arity2or3(JanetFopts opts, JanetSlot *args) {
|
||||
(void) opts;
|
||||
int32_t arity = janet_v_count(args);
|
||||
return arity == 2 || arity == 3;
|
||||
}
|
||||
static int fixarity1(JanetFopts opts, JanetSlot *args) {
|
||||
(void) opts;
|
||||
return janet_v_count(args) == 1;
|
||||
@@ -90,34 +95,67 @@ static JanetSlot opfunction(
|
||||
return t;
|
||||
}
|
||||
|
||||
/* Check if a value can be coerced to an immediate value */
|
||||
static int can_be_imm(Janet x, int8_t *out) {
|
||||
if (!janet_checkint(x)) return 0;
|
||||
int32_t integer = janet_unwrap_integer(x);
|
||||
if (integer > 127 || integer < -127) return 0;
|
||||
*out = (int8_t) integer;
|
||||
return 1;
|
||||
}
|
||||
|
||||
/* Check if a slot can be coerced to an immediate value */
|
||||
static int can_slot_be_imm(JanetSlot s, int8_t *out) {
|
||||
if (!(s.flags & JANET_SLOT_CONSTANT)) return 0;
|
||||
return can_be_imm(s.constant, out);
|
||||
}
|
||||
|
||||
/* Emit a series of instructions instead of a function call to a math op */
|
||||
static JanetSlot opreduce(
|
||||
JanetFopts opts,
|
||||
JanetSlot *args,
|
||||
int op,
|
||||
int opim,
|
||||
Janet nullary) {
|
||||
JanetCompiler *c = opts.compiler;
|
||||
int32_t i, len;
|
||||
int8_t imm = 0;
|
||||
int neg = opim < 0;
|
||||
if (opim < 0) opim = -opim;
|
||||
len = janet_v_count(args);
|
||||
JanetSlot t;
|
||||
if (len == 0) {
|
||||
return janetc_cslot(nullary);
|
||||
} else if (len == 1) {
|
||||
t = janetc_gettarget(opts);
|
||||
janetc_emit_sss(c, op, t, janetc_cslot(nullary), args[0], 1);
|
||||
/* Special case subtract to be times -1 */
|
||||
if (op == JOP_SUBTRACT) {
|
||||
janetc_emit_ssi(c, JOP_MULTIPLY_IMMEDIATE, t, args[0], -1, 1);
|
||||
} else {
|
||||
janetc_emit_sss(c, op, t, janetc_cslot(nullary), args[0], 1);
|
||||
}
|
||||
return t;
|
||||
}
|
||||
t = janetc_gettarget(opts);
|
||||
janetc_emit_sss(c, op, t, args[0], args[1], 1);
|
||||
for (i = 2; i < len; i++)
|
||||
janetc_emit_sss(c, op, t, t, args[i], 1);
|
||||
if (opim && can_slot_be_imm(args[1], &imm)) {
|
||||
janetc_emit_ssi(c, opim, t, args[0], neg ? -imm : imm, 1);
|
||||
} else {
|
||||
janetc_emit_sss(c, op, t, args[0], args[1], 1);
|
||||
}
|
||||
for (i = 2; i < len; i++) {
|
||||
if (opim && can_slot_be_imm(args[i], &imm)) {
|
||||
janetc_emit_ssi(c, opim, t, t, neg ? -imm : imm, 1);
|
||||
} else {
|
||||
janetc_emit_sss(c, op, t, t, args[i], 1);
|
||||
}
|
||||
}
|
||||
return t;
|
||||
}
|
||||
|
||||
/* Function optimizers */
|
||||
|
||||
static JanetSlot do_propagate(JanetFopts opts, JanetSlot *args) {
|
||||
return opreduce(opts, args, JOP_PROPAGATE, janet_wrap_nil());
|
||||
return opreduce(opts, args, JOP_PROPAGATE, 0, janet_wrap_nil());
|
||||
}
|
||||
static JanetSlot do_error(JanetFopts opts, JanetSlot *args) {
|
||||
janetc_emit_s(opts.compiler, JOP_ERROR, args[0], 0);
|
||||
@@ -134,19 +172,40 @@ static JanetSlot do_debug(JanetFopts opts, JanetSlot *args) {
|
||||
return t;
|
||||
}
|
||||
static JanetSlot do_in(JanetFopts opts, JanetSlot *args) {
|
||||
return opreduce(opts, args, JOP_IN, janet_wrap_nil());
|
||||
return opreduce(opts, args, JOP_IN, 0, janet_wrap_nil());
|
||||
}
|
||||
static JanetSlot do_get(JanetFopts opts, JanetSlot *args) {
|
||||
return opreduce(opts, args, JOP_GET, janet_wrap_nil());
|
||||
if (janet_v_count(args) == 3) {
|
||||
JanetCompiler *c = opts.compiler;
|
||||
JanetSlot t = janetc_gettarget(opts);
|
||||
int target_is_default = janetc_sequal(t, args[2]);
|
||||
JanetSlot dflt_slot = args[2];
|
||||
if (target_is_default) {
|
||||
dflt_slot = janetc_farslot(c);
|
||||
janetc_copy(c, dflt_slot, t);
|
||||
}
|
||||
janetc_emit_sss(c, JOP_GET, t, args[0], args[1], 1);
|
||||
int32_t label = janetc_emit_si(c, JOP_JUMP_IF_NOT_NIL, t, 0, 0);
|
||||
janetc_copy(c, t, dflt_slot);
|
||||
if (target_is_default) janetc_freeslot(c, dflt_slot);
|
||||
int32_t current = janet_v_count(c->buffer);
|
||||
c->buffer[label] |= (current - label) << 16;
|
||||
return t;
|
||||
} else {
|
||||
return opreduce(opts, args, JOP_GET, 0, janet_wrap_nil());
|
||||
}
|
||||
}
|
||||
static JanetSlot do_next(JanetFopts opts, JanetSlot *args) {
|
||||
return opfunction(opts, args, JOP_NEXT, janet_wrap_nil());
|
||||
}
|
||||
static JanetSlot do_modulo(JanetFopts opts, JanetSlot *args) {
|
||||
return opreduce(opts, args, JOP_MODULO, janet_wrap_nil());
|
||||
return opreduce(opts, args, JOP_MODULO, 0, janet_wrap_nil());
|
||||
}
|
||||
static JanetSlot do_remainder(JanetFopts opts, JanetSlot *args) {
|
||||
return opreduce(opts, args, JOP_REMAINDER, janet_wrap_nil());
|
||||
return opreduce(opts, args, JOP_REMAINDER, 0, janet_wrap_nil());
|
||||
}
|
||||
static JanetSlot do_cmp(JanetFopts opts, JanetSlot *args) {
|
||||
return opreduce(opts, args, JOP_COMPARE, 0, janet_wrap_nil());
|
||||
}
|
||||
static JanetSlot do_put(JanetFopts opts, JanetSlot *args) {
|
||||
if (opts.flags & JANET_FOPTS_DROP) {
|
||||
@@ -172,6 +231,9 @@ static JanetSlot do_yield(JanetFopts opts, JanetSlot *args) {
|
||||
static JanetSlot do_resume(JanetFopts opts, JanetSlot *args) {
|
||||
return opfunction(opts, args, JOP_RESUME, janet_wrap_nil());
|
||||
}
|
||||
static JanetSlot do_cancel(JanetFopts opts, JanetSlot *args) {
|
||||
return opfunction(opts, args, JOP_CANCEL, janet_wrap_nil());
|
||||
}
|
||||
static JanetSlot do_apply(JanetFopts opts, JanetSlot *args) {
|
||||
/* Push phase */
|
||||
JanetCompiler *c = opts.compiler;
|
||||
@@ -200,34 +262,34 @@ static JanetSlot do_apply(JanetFopts opts, JanetSlot *args) {
|
||||
/* Variadic operators specialization */
|
||||
|
||||
static JanetSlot do_add(JanetFopts opts, JanetSlot *args) {
|
||||
return opreduce(opts, args, JOP_ADD, janet_wrap_integer(0));
|
||||
return opreduce(opts, args, JOP_ADD, JOP_ADD_IMMEDIATE, janet_wrap_integer(0));
|
||||
}
|
||||
static JanetSlot do_sub(JanetFopts opts, JanetSlot *args) {
|
||||
return opreduce(opts, args, JOP_SUBTRACT, janet_wrap_integer(0));
|
||||
return opreduce(opts, args, JOP_SUBTRACT, -JOP_ADD_IMMEDIATE, janet_wrap_integer(0));
|
||||
}
|
||||
static JanetSlot do_mul(JanetFopts opts, JanetSlot *args) {
|
||||
return opreduce(opts, args, JOP_MULTIPLY, janet_wrap_integer(1));
|
||||
return opreduce(opts, args, JOP_MULTIPLY, JOP_MULTIPLY_IMMEDIATE, janet_wrap_integer(1));
|
||||
}
|
||||
static JanetSlot do_div(JanetFopts opts, JanetSlot *args) {
|
||||
return opreduce(opts, args, JOP_DIVIDE, janet_wrap_integer(1));
|
||||
return opreduce(opts, args, JOP_DIVIDE, JOP_DIVIDE_IMMEDIATE, janet_wrap_integer(1));
|
||||
}
|
||||
static JanetSlot do_band(JanetFopts opts, JanetSlot *args) {
|
||||
return opreduce(opts, args, JOP_BAND, janet_wrap_integer(-1));
|
||||
return opreduce(opts, args, JOP_BAND, 0, janet_wrap_integer(-1));
|
||||
}
|
||||
static JanetSlot do_bor(JanetFopts opts, JanetSlot *args) {
|
||||
return opreduce(opts, args, JOP_BOR, janet_wrap_integer(0));
|
||||
return opreduce(opts, args, JOP_BOR, 0, janet_wrap_integer(0));
|
||||
}
|
||||
static JanetSlot do_bxor(JanetFopts opts, JanetSlot *args) {
|
||||
return opreduce(opts, args, JOP_BXOR, janet_wrap_integer(0));
|
||||
return opreduce(opts, args, JOP_BXOR, 0, janet_wrap_integer(0));
|
||||
}
|
||||
static JanetSlot do_lshift(JanetFopts opts, JanetSlot *args) {
|
||||
return opreduce(opts, args, JOP_SHIFT_LEFT, janet_wrap_integer(1));
|
||||
return opreduce(opts, args, JOP_SHIFT_LEFT, JOP_SHIFT_LEFT_IMMEDIATE, janet_wrap_integer(1));
|
||||
}
|
||||
static JanetSlot do_rshift(JanetFopts opts, JanetSlot *args) {
|
||||
return opreduce(opts, args, JOP_SHIFT_RIGHT, janet_wrap_integer(1));
|
||||
return opreduce(opts, args, JOP_SHIFT_RIGHT, JOP_SHIFT_RIGHT_IMMEDIATE, janet_wrap_integer(1));
|
||||
}
|
||||
static JanetSlot do_rshiftu(JanetFopts opts, JanetSlot *args) {
|
||||
return opreduce(opts, args, JOP_SHIFT_RIGHT, janet_wrap_integer(1));
|
||||
return opreduce(opts, args, JOP_SHIFT_RIGHT_UNSIGNED, JOP_SHIFT_RIGHT_UNSIGNED_IMMEDIATE, janet_wrap_integer(1));
|
||||
}
|
||||
static JanetSlot do_bnot(JanetFopts opts, JanetSlot *args) {
|
||||
return genericSS(opts, JOP_BNOT, args[0]);
|
||||
@@ -238,9 +300,11 @@ static JanetSlot compreduce(
|
||||
JanetFopts opts,
|
||||
JanetSlot *args,
|
||||
int op,
|
||||
int opim,
|
||||
int invert) {
|
||||
JanetCompiler *c = opts.compiler;
|
||||
int32_t i, len;
|
||||
int8_t imm = 0;
|
||||
len = janet_v_count(args);
|
||||
int32_t *labels = NULL;
|
||||
JanetSlot t;
|
||||
@@ -251,19 +315,17 @@ static JanetSlot compreduce(
|
||||
}
|
||||
t = janetc_gettarget(opts);
|
||||
for (i = 1; i < len; i++) {
|
||||
janetc_emit_sss(c, op, t, args[i - 1], args[i], 1);
|
||||
if (opim && can_slot_be_imm(args[i], &imm)) {
|
||||
janetc_emit_ssi(c, opim, t, args[i - 1], imm, 1);
|
||||
} else {
|
||||
janetc_emit_sss(c, op, t, args[i - 1], args[i], 1);
|
||||
}
|
||||
if (i != (len - 1)) {
|
||||
int32_t label = janetc_emit_si(c, JOP_JUMP_IF_NOT, t, 0, 1);
|
||||
int32_t label = janetc_emit_si(c, invert ? JOP_JUMP_IF : JOP_JUMP_IF_NOT, t, 0, 1);
|
||||
janet_v_push(labels, label);
|
||||
}
|
||||
}
|
||||
int32_t end = janet_v_count(c->buffer);
|
||||
if (invert) {
|
||||
janetc_emit_si(c, JOP_JUMP_IF, t, 3, 0);
|
||||
janetc_emit_s(c, JOP_LOAD_TRUE, t, 1);
|
||||
janetc_emit(c, JOP_JUMP | (2 << 8));
|
||||
janetc_emit_s(c, JOP_LOAD_FALSE, t, 1);
|
||||
}
|
||||
for (i = 0; i < janet_v_count(labels); i++) {
|
||||
int32_t label = labels[i];
|
||||
c->buffer[label] |= ((end - label) << 16);
|
||||
@@ -273,22 +335,22 @@ static JanetSlot compreduce(
|
||||
}
|
||||
|
||||
static JanetSlot do_gt(JanetFopts opts, JanetSlot *args) {
|
||||
return compreduce(opts, args, JOP_GREATER_THAN, 0);
|
||||
return compreduce(opts, args, JOP_GREATER_THAN, JOP_GREATER_THAN_IMMEDIATE, 0);
|
||||
}
|
||||
static JanetSlot do_lt(JanetFopts opts, JanetSlot *args) {
|
||||
return compreduce(opts, args, JOP_LESS_THAN, 0);
|
||||
return compreduce(opts, args, JOP_LESS_THAN, JOP_LESS_THAN_IMMEDIATE, 0);
|
||||
}
|
||||
static JanetSlot do_gte(JanetFopts opts, JanetSlot *args) {
|
||||
return compreduce(opts, args, JOP_GREATER_THAN_EQUAL, 0);
|
||||
return compreduce(opts, args, JOP_GREATER_THAN_EQUAL, 0, 0);
|
||||
}
|
||||
static JanetSlot do_lte(JanetFopts opts, JanetSlot *args) {
|
||||
return compreduce(opts, args, JOP_LESS_THAN_EQUAL, 0);
|
||||
return compreduce(opts, args, JOP_LESS_THAN_EQUAL, 0, 0);
|
||||
}
|
||||
static JanetSlot do_eq(JanetFopts opts, JanetSlot *args) {
|
||||
return compreduce(opts, args, JOP_EQUALS, 0);
|
||||
return compreduce(opts, args, JOP_EQUALS, JOP_EQUALS_IMMEDIATE, 0);
|
||||
}
|
||||
static JanetSlot do_neq(JanetFopts opts, JanetSlot *args) {
|
||||
return compreduce(opts, args, JOP_EQUALS, 1);
|
||||
return compreduce(opts, args, JOP_NOT_EQUALS, JOP_NOT_EQUALS_IMMEDIATE, 1);
|
||||
}
|
||||
|
||||
/* Arranged by tag */
|
||||
@@ -319,10 +381,12 @@ static const JanetFunOptimizer optimizers[] = {
|
||||
{NULL, do_eq},
|
||||
{NULL, do_neq},
|
||||
{fixarity2, do_propagate},
|
||||
{fixarity2, do_get},
|
||||
{arity2or3, do_get},
|
||||
{arity1or2, do_next},
|
||||
{fixarity2, do_modulo},
|
||||
{fixarity2, do_remainder},
|
||||
{fixarity2, do_cmp},
|
||||
{fixarity2, do_cancel},
|
||||
};
|
||||
|
||||
const JanetFunOptimizer *janetc_funopt(uint32_t flags) {
|
||||
|
||||
@@ -698,7 +698,32 @@ JanetSlot janetc_value(JanetFopts opts, Janet x) {
|
||||
return ret;
|
||||
}
|
||||
|
||||
/* Add function flags to janet functions */
|
||||
void janet_def_addflags(JanetFuncDef *def) {
|
||||
int32_t set_flags = 0;
|
||||
int32_t unset_flags = 0;
|
||||
/* pos checks */
|
||||
if (def->name) set_flags |= JANET_FUNCDEF_FLAG_HASNAME;
|
||||
if (def->source) set_flags |= JANET_FUNCDEF_FLAG_HASSOURCE;
|
||||
if (def->defs) set_flags |= JANET_FUNCDEF_FLAG_HASDEFS;
|
||||
if (def->environments) set_flags |= JANET_FUNCDEF_FLAG_HASENVS;
|
||||
if (def->sourcemap) set_flags |= JANET_FUNCDEF_FLAG_HASSOURCEMAP;
|
||||
if (def->closure_bitset) set_flags |= JANET_FUNCDEF_FLAG_HASCLOBITSET;
|
||||
/* negative checks */
|
||||
if (!def->name) unset_flags |= JANET_FUNCDEF_FLAG_HASNAME;
|
||||
if (!def->source) unset_flags |= JANET_FUNCDEF_FLAG_HASSOURCE;
|
||||
if (!def->defs) unset_flags |= JANET_FUNCDEF_FLAG_HASDEFS;
|
||||
if (!def->environments) unset_flags |= JANET_FUNCDEF_FLAG_HASENVS;
|
||||
if (!def->sourcemap) unset_flags |= JANET_FUNCDEF_FLAG_HASSOURCEMAP;
|
||||
if (!def->closure_bitset) unset_flags |= JANET_FUNCDEF_FLAG_HASCLOBITSET;
|
||||
/* Update flags */
|
||||
def->flags |= set_flags;
|
||||
def->flags &= ~unset_flags;
|
||||
}
|
||||
|
||||
/* Compile a funcdef */
|
||||
/* Once the various other settings of the FuncDef have been tweaked,
|
||||
* call janet_def_addflags to set the proper flags for the funcdef */
|
||||
JanetFuncDef *janetc_pop_funcdef(JanetCompiler *c) {
|
||||
JanetScope *scope = c->scope;
|
||||
JanetFuncDef *def = janet_funcdef_alloc();
|
||||
@@ -761,7 +786,6 @@ JanetFuncDef *janetc_pop_funcdef(JanetCompiler *c) {
|
||||
/* Register allocator preallocates some registers [240-255, high 16 bits of chunk index 7], we can ignore those. */
|
||||
if (scope->ua.count > 7) chunks[7] &= 0xFFFFU;
|
||||
def->closure_bitset = chunks;
|
||||
def->flags |= JANET_FUNCDEF_FLAG_HASCLOBITSET;
|
||||
}
|
||||
|
||||
/* Pop the scope */
|
||||
@@ -818,6 +842,7 @@ JanetCompileResult janet_compile(Janet source, JanetTable *env, const uint8_t *w
|
||||
if (c.result.status == JANET_COMPILE_OK) {
|
||||
JanetFuncDef *def = janetc_pop_funcdef(&c);
|
||||
def->name = janet_cstring("_thunk");
|
||||
janet_def_addflags(def);
|
||||
c.result.funcdef = def;
|
||||
} else {
|
||||
c.result.error_mapping = c.current_mapping;
|
||||
|
||||
@@ -60,6 +60,8 @@
|
||||
#define JANET_FUN_NEXT 28
|
||||
#define JANET_FUN_MODULO 29
|
||||
#define JANET_FUN_REMAINDER 30
|
||||
#define JANET_FUN_CMP 31
|
||||
#define JANET_FUN_CANCEL 32
|
||||
|
||||
/* Compiler typedefs */
|
||||
typedef struct JanetCompiler JanetCompiler;
|
||||
|
||||
@@ -63,10 +63,29 @@ typedef void *Clib;
|
||||
#define error_clib() dlerror()
|
||||
#endif
|
||||
|
||||
static char *get_processed_name(const char *name) {
|
||||
if (name[0] == '.') return (char *) name;
|
||||
const char *c;
|
||||
for (c = name; *c; c++) {
|
||||
if (*c == '/') return (char *) name;
|
||||
}
|
||||
size_t l = (size_t)(c - name);
|
||||
char *ret = malloc(l + 3);
|
||||
if (NULL == ret) {
|
||||
JANET_OUT_OF_MEMORY;
|
||||
}
|
||||
ret[0] = '.';
|
||||
ret[1] = '/';
|
||||
memcpy(ret + 2, name, l + 1);
|
||||
return ret;
|
||||
}
|
||||
|
||||
JanetModule janet_native(const char *name, const uint8_t **error) {
|
||||
Clib lib = load_clib(name);
|
||||
char *processed_name = get_processed_name(name);
|
||||
Clib lib = load_clib(processed_name);
|
||||
JanetModule init;
|
||||
JanetModconf getter;
|
||||
if (name != processed_name) free(processed_name);
|
||||
if (!lib) {
|
||||
*error = janet_cstring(error_clib());
|
||||
return NULL;
|
||||
@@ -404,9 +423,11 @@ static Janet janet_core_gcsetinterval(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 1);
|
||||
size_t s = janet_getsize(argv, 0);
|
||||
/* limit interval to 48 bits */
|
||||
if (s > 0xFFFFFFFFFFFFUl) {
|
||||
#ifdef JANET_64
|
||||
if (s >> 48) {
|
||||
janet_panic("interval too large");
|
||||
}
|
||||
#endif
|
||||
janet_vm_gc_interval = s;
|
||||
return janet_wrap_nil();
|
||||
}
|
||||
@@ -739,6 +760,7 @@ static void janet_quick_asm(
|
||||
JANET_OUT_OF_MEMORY;
|
||||
}
|
||||
memcpy(def->bytecode, bytecode, bytecode_size);
|
||||
janet_def_addflags(def);
|
||||
janet_def(env, name, janet_wrap_function(janet_thunk(def)), doc);
|
||||
}
|
||||
|
||||
@@ -924,6 +946,10 @@ static const uint32_t resume_asm[] = {
|
||||
JOP_RESUME | (1 << 24),
|
||||
JOP_RETURN
|
||||
};
|
||||
static const uint32_t cancel_asm[] = {
|
||||
JOP_CANCEL | (1 << 24),
|
||||
JOP_RETURN
|
||||
};
|
||||
static const uint32_t in_asm[] = {
|
||||
JOP_IN | (1 << 24),
|
||||
JOP_LOAD_NIL | (3 << 8),
|
||||
@@ -968,6 +994,10 @@ static const uint32_t remainder_asm[] = {
|
||||
JOP_REMAINDER | (1 << 24),
|
||||
JOP_RETURN
|
||||
};
|
||||
static const uint32_t cmp_asm[] = {
|
||||
JOP_COMPARE | (1 << 24),
|
||||
JOP_RETURN
|
||||
};
|
||||
#endif /* ifdef JANET_BOOTSTRAP */
|
||||
|
||||
/*
|
||||
@@ -1004,6 +1034,9 @@ static void janet_load_libs(JanetTable *env) {
|
||||
#ifdef JANET_THREADS
|
||||
janet_lib_thread(env);
|
||||
#endif
|
||||
#ifdef JANET_EV
|
||||
janet_lib_ev(env);
|
||||
#endif
|
||||
#ifdef JANET_NET
|
||||
janet_lib_net(env);
|
||||
#endif
|
||||
@@ -1021,6 +1054,11 @@ JanetTable *janet_core_env(JanetTable *replacements) {
|
||||
"%", 2, 2, 2, 2, remainder_asm, sizeof(remainder_asm),
|
||||
JDOC("(% dividend divisor)\n\n"
|
||||
"Returns the remainder of dividend / divisor."));
|
||||
janet_quick_asm(env, JANET_FUN_CMP,
|
||||
"cmp", 2, 2, 2, 2, cmp_asm, sizeof(cmp_asm),
|
||||
JDOC("(cmp x y)\n\n"
|
||||
"Returns -1 if x is strictly less than y, 1 if y is strictly greater "
|
||||
"than x, and 0 otherwise. To return 0, x and y must be the exact same type."));
|
||||
janet_quick_asm(env, JANET_FUN_NEXT,
|
||||
"next", 2, 1, 2, 2, next_asm, sizeof(next_asm),
|
||||
JDOC("(next ds &opt key)\n\n"
|
||||
@@ -1052,6 +1090,11 @@ JanetTable *janet_core_env(JanetTable *replacements) {
|
||||
"Yield a value to a parent fiber. When a fiber yields, its execution is paused until "
|
||||
"another thread resumes it. The fiber will then resume, and the last yield call will "
|
||||
"return the value that was passed to resume."));
|
||||
janet_quick_asm(env, JANET_FUN_CANCEL,
|
||||
"cancel", 2, 2, 2, 2, cancel_asm, sizeof(cancel_asm),
|
||||
JDOC("(cancel fiber err)\n\n"
|
||||
"Resume a fiber but have it immediately raise an error. This lets a programmer unwind a pending fiber. "
|
||||
"Returns the same result as resume."));
|
||||
janet_quick_asm(env, JANET_FUN_RESUME,
|
||||
"resume", 2, 1, 2, 2, resume_asm, sizeof(resume_asm),
|
||||
JDOC("(resume fiber &opt x)\n\n"
|
||||
@@ -1178,7 +1221,7 @@ JanetTable *janet_core_env(JanetTable *replacements) {
|
||||
}
|
||||
|
||||
/* Load core cfunctions (and some built in janet assembly functions) */
|
||||
JanetTable *dict = janet_table(300);
|
||||
JanetTable *dict = janet_table(512);
|
||||
janet_load_libs(dict);
|
||||
|
||||
/* Add replacements */
|
||||
|
||||
@@ -37,7 +37,7 @@ int32_t janetc_allocfar(JanetCompiler *c) {
|
||||
return reg;
|
||||
}
|
||||
|
||||
/* Get a register less than 256 */
|
||||
/* Get a register less than 256 for temporary use. */
|
||||
int32_t janetc_allocnear(JanetCompiler *c, JanetcRegisterTemp tag) {
|
||||
return janetc_regalloc_temp(&c->scope->ra, tag);
|
||||
}
|
||||
@@ -205,7 +205,7 @@ static int32_t janetc_regnear(JanetCompiler *c, JanetSlot s, JanetcRegisterTemp
|
||||
}
|
||||
|
||||
/* Check if two slots are equal */
|
||||
static int janetc_sequal(JanetSlot lhs, JanetSlot rhs) {
|
||||
int janetc_sequal(JanetSlot lhs, JanetSlot rhs) {
|
||||
if ((lhs.flags & ~JANET_SLOTTYPE_ANY) == (rhs.flags & ~JANET_SLOTTYPE_ANY) &&
|
||||
lhs.index == rhs.index &&
|
||||
lhs.envindex == rhs.envindex) {
|
||||
@@ -245,8 +245,8 @@ void janetc_copy(
|
||||
janetc_moveback(c, dest, nearreg);
|
||||
/* Cleanup */
|
||||
janetc_regalloc_freetemp(&c->scope->ra, nearreg, JANETC_REGTEMP_3);
|
||||
|
||||
}
|
||||
|
||||
/* Instruction templated emitters */
|
||||
|
||||
static int32_t emit1s(JanetCompiler *c, uint8_t op, JanetSlot s, int32_t rest, int wr) {
|
||||
|
||||
@@ -42,6 +42,9 @@ int32_t janetc_emit_ssi(JanetCompiler *c, uint8_t op, JanetSlot s1, JanetSlot s2
|
||||
int32_t janetc_emit_ssu(JanetCompiler *c, uint8_t op, JanetSlot s1, JanetSlot s2, uint8_t immediate, int wr);
|
||||
int32_t janetc_emit_sss(JanetCompiler *c, uint8_t op, JanetSlot s1, JanetSlot s2, JanetSlot s3, int wr);
|
||||
|
||||
/* Check if two slots are equivalent */
|
||||
int janetc_sequal(JanetSlot x, JanetSlot y);
|
||||
|
||||
/* Move value from one slot to another. Cannot copy to constant slots. */
|
||||
void janetc_copy(JanetCompiler *c, JanetSlot dest, JanetSlot src);
|
||||
|
||||
|
||||
1843
src/core/ev.c
Normal file
1843
src/core/ev.c
Normal file
File diff suppressed because it is too large
Load Diff
@@ -25,8 +25,15 @@
|
||||
#ifndef JANET_FEATURES_H_defined
|
||||
#define JANET_FEATURES_H_defined
|
||||
|
||||
#ifndef _POSIX_C_SOURCE
|
||||
#define _POSIX_C_SOURCE 200809L
|
||||
#if defined(__NetBSD__) || defined(__APPLE__) || defined(__OpenBSD__) \
|
||||
|| defined(__bsdi__) || defined(__DragonFly__)
|
||||
/* Use BSD soucre on any BSD systems, include OSX */
|
||||
# define _BSD_SOURCE
|
||||
#else
|
||||
/* Use POSIX feature flags */
|
||||
# ifndef _POSIX_C_SOURCE
|
||||
# define _POSIX_C_SOURCE 200809L
|
||||
# endif
|
||||
#endif
|
||||
|
||||
#if defined(WIN32) || defined(_WIN32)
|
||||
@@ -38,4 +45,11 @@
|
||||
#define _XOPEN_SOURCE 500
|
||||
#endif
|
||||
|
||||
/* Needed for timegm and other extensions when building with -std=c99.
|
||||
* It also defines realpath, etc, which would normally require
|
||||
* _XOPEN_SOURCE >= 500. */
|
||||
#if !defined(_NETBSD_SOURCE) && defined(__NetBSD__)
|
||||
#define _NETBSD_SOURCE
|
||||
#endif
|
||||
|
||||
#endif
|
||||
|
||||
@@ -37,6 +37,10 @@ static void fiber_reset(JanetFiber *fiber) {
|
||||
fiber->child = NULL;
|
||||
fiber->flags = JANET_FIBER_MASK_YIELD | JANET_FIBER_RESUME_NO_USEVAL | JANET_FIBER_RESUME_NO_SKIP;
|
||||
fiber->env = NULL;
|
||||
#ifdef JANET_EV
|
||||
fiber->waiting = NULL;
|
||||
fiber->sched_id = 0;
|
||||
#endif
|
||||
janet_fiber_set_status(fiber, JANET_STATUS_NEW);
|
||||
}
|
||||
|
||||
@@ -77,6 +81,7 @@ JanetFiber *janet_fiber_reset(JanetFiber *fiber, JanetFunction *callee, int32_t
|
||||
}
|
||||
if (janet_fiber_funcframe(fiber, callee)) return NULL;
|
||||
janet_fiber_frame(fiber)->flags |= JANET_STACKFRAME_ENTRANCE;
|
||||
fiber->waiting = NULL;
|
||||
return fiber;
|
||||
}
|
||||
|
||||
@@ -85,14 +90,33 @@ JanetFiber *janet_fiber(JanetFunction *callee, int32_t capacity, int32_t argc, c
|
||||
return janet_fiber_reset(fiber_alloc(capacity), callee, argc, argv);
|
||||
}
|
||||
|
||||
#ifdef JANET_DEBUG
|
||||
/* Test for memory issues by reallocating fiber every time we push a stack frame */
|
||||
static void janet_fiber_refresh_memory(JanetFiber *fiber) {
|
||||
int32_t n = fiber->capacity;
|
||||
if (n) {
|
||||
Janet *newData = malloc(sizeof(Janet) * n);
|
||||
if (NULL == newData) {
|
||||
JANET_OUT_OF_MEMORY;
|
||||
}
|
||||
memcpy(newData, fiber->data, fiber->capacity * sizeof(Janet));
|
||||
free(fiber->data);
|
||||
fiber->data = newData;
|
||||
}
|
||||
}
|
||||
#endif
|
||||
|
||||
/* Ensure that the fiber has enough extra capacity */
|
||||
void janet_fiber_setcapacity(JanetFiber *fiber, int32_t n) {
|
||||
int32_t old_size = fiber->capacity;
|
||||
int32_t diff = n - old_size;
|
||||
Janet *newData = realloc(fiber->data, sizeof(Janet) * n);
|
||||
if (NULL == newData) {
|
||||
JANET_OUT_OF_MEMORY;
|
||||
}
|
||||
fiber->data = newData;
|
||||
fiber->capacity = n;
|
||||
janet_vm_next_collection += sizeof(Janet) * diff;
|
||||
}
|
||||
|
||||
/* Grow fiber if needed */
|
||||
@@ -173,6 +197,10 @@ int janet_fiber_funcframe(JanetFiber *fiber, JanetFunction *func) {
|
||||
|
||||
if (fiber->capacity < nextstacktop) {
|
||||
janet_fiber_setcapacity(fiber, 2 * nextstacktop);
|
||||
#ifdef JANET_DEBUG
|
||||
} else {
|
||||
janet_fiber_refresh_memory(fiber);
|
||||
#endif
|
||||
}
|
||||
|
||||
/* Nil unset stack arguments (Needed for gc correctness) */
|
||||
@@ -305,6 +333,10 @@ int janet_fiber_funcframe_tail(JanetFiber *fiber, JanetFunction *func) {
|
||||
|
||||
if (fiber->capacity < nextstacktop) {
|
||||
janet_fiber_setcapacity(fiber, 2 * nextstacktop);
|
||||
#ifdef JANET_DEBUG
|
||||
} else {
|
||||
janet_fiber_refresh_memory(fiber);
|
||||
#endif
|
||||
}
|
||||
|
||||
Janet *stack = fiber->data + fiber->frame;
|
||||
@@ -367,6 +399,10 @@ void janet_fiber_cframe(JanetFiber *fiber, JanetCFunction cfun) {
|
||||
|
||||
if (fiber->capacity < nextstacktop) {
|
||||
janet_fiber_setcapacity(fiber, 2 * nextstacktop);
|
||||
#ifdef JANET_DEBUG
|
||||
} else {
|
||||
janet_fiber_refresh_memory(fiber);
|
||||
#endif
|
||||
}
|
||||
|
||||
/* Set the next frame */
|
||||
|
||||
@@ -46,7 +46,9 @@
|
||||
#define JANET_FIBER_MASK_USERN(N) (16 << (N))
|
||||
#define JANET_FIBER_MASK_USER 0x3FF0
|
||||
|
||||
#define JANET_FIBER_STATUS_MASK 0xFF0000
|
||||
#define JANET_FIBER_STATUS_MASK 0x3F0000
|
||||
#define JANET_FIBER_FLAG_SCHEDULED 0x800000
|
||||
#define JANET_FIBER_RESUME_SIGNAL 0x400000
|
||||
#define JANET_FIBER_STATUS_OFFSET 16
|
||||
|
||||
#define JANET_FIBER_BREAKPOINT 0x1000000
|
||||
@@ -76,4 +78,8 @@ void janet_fiber_popframe(JanetFiber *fiber);
|
||||
void janet_env_maybe_detach(JanetFuncEnv *env);
|
||||
int janet_env_valid(JanetFuncEnv *env);
|
||||
|
||||
#ifdef JANET_EV
|
||||
void janet_fiber_did_resume(JanetFiber *fiber);
|
||||
#endif
|
||||
|
||||
#endif
|
||||
|
||||
@@ -28,6 +28,7 @@
|
||||
#include "gc.h"
|
||||
#include "util.h"
|
||||
#include "fiber.h"
|
||||
#include "vector.h"
|
||||
#endif
|
||||
|
||||
struct JanetScratch {
|
||||
@@ -39,6 +40,7 @@ struct JanetScratch {
|
||||
JANET_THREAD_LOCAL void *janet_vm_blocks;
|
||||
JANET_THREAD_LOCAL size_t janet_vm_gc_interval;
|
||||
JANET_THREAD_LOCAL size_t janet_vm_next_collection;
|
||||
JANET_THREAD_LOCAL size_t janet_vm_block_count;
|
||||
JANET_THREAD_LOCAL int janet_vm_gc_suspend = 0;
|
||||
|
||||
/* Roots */
|
||||
@@ -327,6 +329,7 @@ void janet_sweep() {
|
||||
previous = current;
|
||||
current->flags &= ~JANET_MEM_REACHABLE;
|
||||
} else {
|
||||
janet_vm_block_count--;
|
||||
janet_deinit_block(current);
|
||||
if (NULL != previous) {
|
||||
previous->next = next;
|
||||
@@ -359,6 +362,7 @@ void *janet_gcalloc(enum JanetMemoryType type, size_t size) {
|
||||
janet_vm_next_collection += size;
|
||||
mem->next = janet_vm_blocks;
|
||||
janet_vm_blocks = mem;
|
||||
janet_vm_block_count++;
|
||||
|
||||
return (void *)mem;
|
||||
}
|
||||
@@ -388,10 +392,19 @@ void janet_collect(void) {
|
||||
uint32_t i;
|
||||
if (janet_vm_gc_suspend) return;
|
||||
depth = JANET_RECURSION_GUARD;
|
||||
/* Try and prevent many major collections back to back.
|
||||
* A full collection will take O(janet_vm_block_count) time.
|
||||
* If we have a large heap, make sure our interval is not too
|
||||
* small so we won't make many collections over it. This is just a
|
||||
* heuristic for automatically changing the gc interval */
|
||||
if (janet_vm_block_count * 8 > janet_vm_gc_interval) {
|
||||
janet_vm_gc_interval = janet_vm_block_count * sizeof(JanetGCObject);
|
||||
}
|
||||
orig_rootcount = janet_vm_root_count;
|
||||
#ifdef JANET_NET
|
||||
janet_net_markloop();
|
||||
#ifdef JANET_EV
|
||||
janet_ev_mark();
|
||||
#endif
|
||||
janet_mark_fiber(janet_vm_root_fiber);
|
||||
for (i = 0; i < orig_rootcount; i++)
|
||||
janet_mark(janet_vm_roots[i]);
|
||||
while (orig_rootcount < janet_vm_root_count) {
|
||||
|
||||
@@ -20,18 +20,18 @@
|
||||
* IN THE SOFTWARE.
|
||||
*/
|
||||
|
||||
#include <errno.h>
|
||||
#include <stdlib.h>
|
||||
#include <limits.h>
|
||||
#include <inttypes.h>
|
||||
#include <math.h>
|
||||
|
||||
#ifndef JANET_AMALG
|
||||
#include "features.h"
|
||||
#include <janet.h>
|
||||
#include "util.h"
|
||||
#endif
|
||||
|
||||
#include <errno.h>
|
||||
#include <stdlib.h>
|
||||
#include <limits.h>
|
||||
#include <inttypes.h>
|
||||
#include <math.h>
|
||||
|
||||
/* Conditional compilation */
|
||||
#ifdef JANET_INT_TYPES
|
||||
|
||||
|
||||
212
src/core/io.c
212
src/core/io.c
@@ -37,22 +37,27 @@
|
||||
|
||||
static int cfun_io_gc(void *p, size_t len);
|
||||
static int io_file_get(void *p, Janet key, Janet *out);
|
||||
static void io_file_marshal(void *p, JanetMarshalContext *ctx);
|
||||
static void *io_file_unmarshal(JanetMarshalContext *ctx);
|
||||
|
||||
const JanetAbstractType janet_file_type = {
|
||||
"core/file",
|
||||
cfun_io_gc,
|
||||
NULL,
|
||||
io_file_get,
|
||||
JANET_ATEND_GET
|
||||
NULL,
|
||||
io_file_marshal,
|
||||
io_file_unmarshal,
|
||||
JANET_ATEND_UNMARSHAL
|
||||
};
|
||||
|
||||
/* Check arguments to fopen */
|
||||
static int checkflags(const uint8_t *str) {
|
||||
int flags = 0;
|
||||
static int32_t checkflags(const uint8_t *str) {
|
||||
int32_t flags = 0;
|
||||
int32_t i;
|
||||
int32_t len = janet_string_length(str);
|
||||
if (!len || len > 3)
|
||||
janet_panic("file mode must have a length between 1 and 3");
|
||||
if (!len || len > 10)
|
||||
janet_panic("file mode must have a length between 1 and 10");
|
||||
switch (*str) {
|
||||
default:
|
||||
janet_panicf("invalid flag %c, expected w, a, or r", *str);
|
||||
@@ -70,7 +75,7 @@ static int checkflags(const uint8_t *str) {
|
||||
for (i = 1; i < len; i++) {
|
||||
switch (str[i]) {
|
||||
default:
|
||||
janet_panicf("invalid flag %c, expected + or b", str[i]);
|
||||
janet_panicf("invalid flag %c, expected +, b, or n", str[i]);
|
||||
break;
|
||||
case '+':
|
||||
if (flags & JANET_FILE_UPDATE) return -1;
|
||||
@@ -80,12 +85,16 @@ static int checkflags(const uint8_t *str) {
|
||||
if (flags & JANET_FILE_BINARY) return -1;
|
||||
flags |= JANET_FILE_BINARY;
|
||||
break;
|
||||
case 'n':
|
||||
if (flags & JANET_FILE_NONIL) return -1;
|
||||
flags |= JANET_FILE_NONIL;
|
||||
break;
|
||||
}
|
||||
}
|
||||
return flags;
|
||||
}
|
||||
|
||||
static Janet makef(FILE *f, int flags) {
|
||||
static void *makef(FILE *f, int32_t flags) {
|
||||
JanetFile *iof = (JanetFile *) janet_abstract(&janet_file_type, sizeof(JanetFile));
|
||||
iof->file = f;
|
||||
iof->flags = flags;
|
||||
@@ -95,7 +104,7 @@ static Janet makef(FILE *f, int flags) {
|
||||
if (!(flags & JANET_FILE_NOT_CLOSEABLE))
|
||||
fcntl(fileno(f), F_SETFD, FD_CLOEXEC);
|
||||
#endif
|
||||
return janet_wrap_abstract(iof);
|
||||
return iof;
|
||||
}
|
||||
|
||||
/* Open a process */
|
||||
@@ -104,14 +113,14 @@ static Janet cfun_io_popen(int32_t argc, Janet *argv) {
|
||||
janet_arity(argc, 1, 2);
|
||||
const uint8_t *fname = janet_getstring(argv, 0);
|
||||
const uint8_t *fmode = NULL;
|
||||
int flags;
|
||||
int32_t flags;
|
||||
if (argc == 2) {
|
||||
fmode = janet_getkeyword(argv, 1);
|
||||
if (janet_string_length(fmode) != 1 ||
|
||||
!(fmode[0] == 'r' || fmode[0] == 'w')) {
|
||||
janet_panicf("invalid file mode :%S, expected :r or :w", fmode);
|
||||
flags = JANET_FILE_PIPED | checkflags(fmode);
|
||||
if (flags & (JANET_FILE_UPDATE | JANET_FILE_BINARY | JANET_FILE_APPEND)) {
|
||||
janet_panicf("invalid popen file mode :%S, expected :r or :w", fmode);
|
||||
}
|
||||
flags = JANET_FILE_PIPED | (fmode[0] == 'r' ? JANET_FILE_READ : JANET_FILE_WRITE);
|
||||
fmode = (const uint8_t *)((fmode[0] == 'r') ? "r" : "w");
|
||||
} else {
|
||||
fmode = (const uint8_t *)"r";
|
||||
flags = JANET_FILE_PIPED | JANET_FILE_READ;
|
||||
@@ -121,9 +130,11 @@ static Janet cfun_io_popen(int32_t argc, Janet *argv) {
|
||||
#endif
|
||||
FILE *f = popen((const char *)fname, (const char *)fmode);
|
||||
if (!f) {
|
||||
if (flags & JANET_FILE_NONIL)
|
||||
janet_panicf("failed to popen %s: %s", fname, strerror(errno));
|
||||
return janet_wrap_nil();
|
||||
}
|
||||
return makef(f, flags);
|
||||
return janet_makefile(f, flags);
|
||||
}
|
||||
#endif
|
||||
|
||||
@@ -141,7 +152,7 @@ static Janet cfun_io_fopen(int32_t argc, Janet *argv) {
|
||||
janet_arity(argc, 1, 2);
|
||||
const uint8_t *fname = janet_getstring(argv, 0);
|
||||
const uint8_t *fmode;
|
||||
int flags;
|
||||
int32_t flags;
|
||||
if (argc == 2) {
|
||||
fmode = janet_getkeyword(argv, 1);
|
||||
flags = checkflags(fmode);
|
||||
@@ -150,7 +161,9 @@ static Janet cfun_io_fopen(int32_t argc, Janet *argv) {
|
||||
flags = JANET_FILE_READ;
|
||||
}
|
||||
FILE *f = fopen((const char *)fname, (const char *)fmode);
|
||||
return f ? makef(f, flags) : janet_wrap_nil();
|
||||
return f ? janet_makefile(f, flags)
|
||||
: (flags & JANET_FILE_NONIL) ? (janet_panicf("failed to open file %s: %s", fname, strerror(errno)), janet_wrap_nil())
|
||||
: janet_wrap_nil();
|
||||
}
|
||||
|
||||
/* Read up to n bytes into buffer. */
|
||||
@@ -277,6 +290,8 @@ static Janet cfun_io_fclose(int32_t argc, Janet *argv) {
|
||||
iof->flags |= JANET_FILE_CLOSED;
|
||||
if (status == -1) janet_panic("could not close file");
|
||||
return janet_wrap_integer(WEXITSTATUS(status));
|
||||
#else
|
||||
return janet_wrap_nil();
|
||||
#endif
|
||||
} else {
|
||||
if (fclose(iof->file)) {
|
||||
@@ -284,8 +299,8 @@ static Janet cfun_io_fclose(int32_t argc, Janet *argv) {
|
||||
janet_panic("could not close file");
|
||||
}
|
||||
iof->flags |= JANET_FILE_CLOSED;
|
||||
return janet_wrap_nil();
|
||||
}
|
||||
return janet_wrap_nil();
|
||||
}
|
||||
|
||||
/* Seek a file */
|
||||
@@ -331,6 +346,50 @@ static int io_file_get(void *p, Janet key, Janet *out) {
|
||||
return janet_getmethod(janet_unwrap_keyword(key), io_file_methods, out);
|
||||
}
|
||||
|
||||
static void io_file_marshal(void *p, JanetMarshalContext *ctx) {
|
||||
JanetFile *iof = (JanetFile *)p;
|
||||
if (ctx->flags & JANET_MARSHAL_UNSAFE) {
|
||||
janet_marshal_abstract(ctx, p);
|
||||
#ifdef JANET_WINDOWS
|
||||
janet_marshal_int(ctx, _fileno(iof->file));
|
||||
#else
|
||||
janet_marshal_int(ctx, fileno(iof->file));
|
||||
#endif
|
||||
janet_marshal_int(ctx, iof->flags);
|
||||
} else {
|
||||
janet_panic("cannot marshal file in safe mode");
|
||||
}
|
||||
}
|
||||
|
||||
static void *io_file_unmarshal(JanetMarshalContext *ctx) {
|
||||
if (ctx->flags & JANET_MARSHAL_UNSAFE) {
|
||||
JanetFile *iof = janet_unmarshal_abstract(ctx, sizeof(JanetFile));
|
||||
int32_t fd = janet_unmarshal_int(ctx);
|
||||
int32_t flags = janet_unmarshal_int(ctx);
|
||||
char fmt[4] = {0};
|
||||
int index = 0;
|
||||
if (flags & JANET_FILE_READ) fmt[index++] = 'r';
|
||||
if (flags & JANET_FILE_APPEND) {
|
||||
fmt[index++] = 'a';
|
||||
} else if (flags & JANET_FILE_WRITE) {
|
||||
fmt[index++] = 'w';
|
||||
}
|
||||
#ifdef JANET_WINDOWS
|
||||
iof->file = _fdopen(fd, fmt);
|
||||
#else
|
||||
iof->file = fdopen(fd, fmt);
|
||||
#endif
|
||||
if (iof->file == NULL) {
|
||||
iof->flags = JANET_FILE_CLOSED;
|
||||
} else {
|
||||
iof->flags = flags;
|
||||
}
|
||||
return iof;
|
||||
} else {
|
||||
janet_panic("cannot unmarshal file in safe mode");
|
||||
}
|
||||
}
|
||||
|
||||
FILE *janet_dynfile(const char *name, FILE *def) {
|
||||
Janet x = janet_dyn(name);
|
||||
if (!janet_checktype(x, JANET_ABSTRACT)) return def;
|
||||
@@ -340,18 +399,16 @@ FILE *janet_dynfile(const char *name, FILE *def) {
|
||||
return iofile->file;
|
||||
}
|
||||
|
||||
static Janet cfun_io_print_impl(int32_t argc, Janet *argv,
|
||||
int newline, const char *name, FILE *dflt_file) {
|
||||
static Janet cfun_io_print_impl_x(int32_t argc, Janet *argv, int newline,
|
||||
FILE *dflt_file, int32_t offset, Janet x) {
|
||||
FILE *f;
|
||||
Janet x = janet_dyn(name);
|
||||
switch (janet_type(x)) {
|
||||
default:
|
||||
/* Other values simply do nothing */
|
||||
return janet_wrap_nil();
|
||||
janet_panicf("cannot print to %v", x);
|
||||
case JANET_BUFFER: {
|
||||
/* Special case buffer */
|
||||
JanetBuffer *buf = janet_unwrap_buffer(x);
|
||||
for (int32_t i = 0; i < argc; ++i) {
|
||||
for (int32_t i = offset; i < argc; ++i) {
|
||||
janet_to_string_b(buf, argv[i]);
|
||||
}
|
||||
if (newline)
|
||||
@@ -360,6 +417,7 @@ static Janet cfun_io_print_impl(int32_t argc, Janet *argv,
|
||||
}
|
||||
case JANET_NIL:
|
||||
f = dflt_file;
|
||||
if (f == NULL) janet_panic("cannot print to nil");
|
||||
break;
|
||||
case JANET_ABSTRACT: {
|
||||
void *abstract = janet_unwrap_abstract(x);
|
||||
@@ -370,7 +428,7 @@ static Janet cfun_io_print_impl(int32_t argc, Janet *argv,
|
||||
break;
|
||||
}
|
||||
}
|
||||
for (int32_t i = 0; i < argc; ++i) {
|
||||
for (int32_t i = offset; i < argc; ++i) {
|
||||
int32_t len;
|
||||
const uint8_t *vstr;
|
||||
if (janet_checktype(argv[i], JANET_BUFFER)) {
|
||||
@@ -383,7 +441,11 @@ static Janet cfun_io_print_impl(int32_t argc, Janet *argv,
|
||||
}
|
||||
if (len) {
|
||||
if (1 != fwrite(vstr, len, 1, f)) {
|
||||
janet_panicf("could not print %d bytes to (dyn :%s)", len, name);
|
||||
if (f == dflt_file) {
|
||||
janet_panicf("cannot print %d bytes", len);
|
||||
} else {
|
||||
janet_panicf("cannot print %d bytes to %v", len, x);
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
@@ -392,6 +454,13 @@ static Janet cfun_io_print_impl(int32_t argc, Janet *argv,
|
||||
return janet_wrap_nil();
|
||||
}
|
||||
|
||||
|
||||
static Janet cfun_io_print_impl(int32_t argc, Janet *argv,
|
||||
int newline, const char *name, FILE *dflt_file) {
|
||||
Janet x = janet_dyn(name);
|
||||
return cfun_io_print_impl_x(argc, argv, newline, dflt_file, 0, x);
|
||||
}
|
||||
|
||||
static Janet cfun_io_print(int32_t argc, Janet *argv) {
|
||||
return cfun_io_print_impl(argc, argv, 1, "out", stdout);
|
||||
}
|
||||
@@ -408,25 +477,33 @@ static Janet cfun_io_eprin(int32_t argc, Janet *argv) {
|
||||
return cfun_io_print_impl(argc, argv, 0, "err", stderr);
|
||||
}
|
||||
|
||||
static Janet cfun_io_printf_impl(int32_t argc, Janet *argv, int newline,
|
||||
const char *name, FILE *dflt_file) {
|
||||
FILE *f;
|
||||
static Janet cfun_io_xprint(int32_t argc, Janet *argv) {
|
||||
janet_arity(argc, 1, -1);
|
||||
const char *fmt = janet_getcstring(argv, 0);
|
||||
Janet x = janet_dyn(name);
|
||||
return cfun_io_print_impl_x(argc, argv, 1, NULL, 1, argv[0]);
|
||||
}
|
||||
|
||||
static Janet cfun_io_xprin(int32_t argc, Janet *argv) {
|
||||
janet_arity(argc, 1, -1);
|
||||
return cfun_io_print_impl_x(argc, argv, 0, NULL, 1, argv[0]);
|
||||
}
|
||||
|
||||
static Janet cfun_io_printf_impl_x(int32_t argc, Janet *argv, int newline,
|
||||
FILE *dflt_file, int32_t offset, Janet x) {
|
||||
FILE *f;
|
||||
const char *fmt = janet_getcstring(argv, offset);
|
||||
switch (janet_type(x)) {
|
||||
default:
|
||||
/* Other values simply do nothing */
|
||||
return janet_wrap_nil();
|
||||
janet_panicf("cannot print to %v", x);
|
||||
case JANET_BUFFER: {
|
||||
/* Special case buffer */
|
||||
JanetBuffer *buf = janet_unwrap_buffer(x);
|
||||
janet_buffer_format(buf, fmt, 0, argc, argv);
|
||||
janet_buffer_format(buf, fmt, offset, argc, argv);
|
||||
if (newline) janet_buffer_push_u8(buf, '\n');
|
||||
return janet_wrap_nil();
|
||||
}
|
||||
case JANET_NIL:
|
||||
f = dflt_file;
|
||||
if (f == NULL) janet_panic("cannot print to nil");
|
||||
break;
|
||||
case JANET_ABSTRACT: {
|
||||
void *abstract = janet_unwrap_abstract(x);
|
||||
@@ -438,11 +515,11 @@ static Janet cfun_io_printf_impl(int32_t argc, Janet *argv, int newline,
|
||||
}
|
||||
}
|
||||
JanetBuffer *buf = janet_buffer(10);
|
||||
janet_buffer_format(buf, fmt, 0, argc, argv);
|
||||
janet_buffer_format(buf, fmt, offset, argc, argv);
|
||||
if (newline) janet_buffer_push_u8(buf, '\n');
|
||||
if (buf->count) {
|
||||
if (1 != fwrite(buf->data, buf->count, 1, f)) {
|
||||
janet_panicf("could not print %d bytes to file", buf->count, name);
|
||||
janet_panicf("could not print %d bytes to file", buf->count);
|
||||
}
|
||||
}
|
||||
/* Clear buffer to make things easier for GC */
|
||||
@@ -453,6 +530,14 @@ static Janet cfun_io_printf_impl(int32_t argc, Janet *argv, int newline,
|
||||
return janet_wrap_nil();
|
||||
}
|
||||
|
||||
static Janet cfun_io_printf_impl(int32_t argc, Janet *argv, int newline,
|
||||
const char *name, FILE *dflt_file) {
|
||||
janet_arity(argc, 1, -1);
|
||||
Janet x = janet_dyn(name);
|
||||
return cfun_io_printf_impl_x(argc, argv, newline, dflt_file, 0, x);
|
||||
|
||||
}
|
||||
|
||||
static Janet cfun_io_printf(int32_t argc, Janet *argv) {
|
||||
return cfun_io_printf_impl(argc, argv, 1, "out", stdout);
|
||||
}
|
||||
@@ -469,6 +554,16 @@ static Janet cfun_io_eprinf(int32_t argc, Janet *argv) {
|
||||
return cfun_io_printf_impl(argc, argv, 0, "err", stderr);
|
||||
}
|
||||
|
||||
static Janet cfun_io_xprintf(int32_t argc, Janet *argv) {
|
||||
janet_arity(argc, 2, -1);
|
||||
return cfun_io_printf_impl_x(argc, argv, 1, NULL, 1, argv[0]);
|
||||
}
|
||||
|
||||
static Janet cfun_io_xprinf(int32_t argc, Janet *argv) {
|
||||
janet_arity(argc, 2, -1);
|
||||
return cfun_io_printf_impl_x(argc, argv, 0, NULL, 1, argv[0]);
|
||||
}
|
||||
|
||||
static void janet_flusher(const char *name, FILE *dflt_file) {
|
||||
Janet x = janet_dyn(name);
|
||||
switch (janet_type(x)) {
|
||||
@@ -582,6 +677,29 @@ static const JanetReg io_cfuns[] = {
|
||||
JDOC("(eprinf fmt & xs)\n\n"
|
||||
"Like eprintf but with no trailing newline.")
|
||||
},
|
||||
{
|
||||
"xprint", cfun_io_xprint,
|
||||
JDOC("(xprint to & xs)\n\n"
|
||||
"Print to a file or other value explicitly (no dynamic bindings) with a trailing "
|
||||
"newline character. The value to print "
|
||||
"to is the first argument, and is otherwise the same as print. Returns nil.")
|
||||
},
|
||||
{
|
||||
"xprin", cfun_io_xprin,
|
||||
JDOC("(xprin to & xs)\n\n"
|
||||
"Print to a file or other value explicitly (no dynamic bindings). The value to print "
|
||||
"to is the first argument, and is otherwise the same as prin. Returns nil.")
|
||||
},
|
||||
{
|
||||
"xprintf", cfun_io_xprintf,
|
||||
JDOC("(xprint to fmt & xs)\n\n"
|
||||
"Like printf but prints to an explicit file or value to. Returns nil.")
|
||||
},
|
||||
{
|
||||
"xprinf", cfun_io_xprinf,
|
||||
JDOC("(xprin to fmt & xs)\n\n"
|
||||
"Like prinf but prints to an explicit file or value to. Returns nil.")
|
||||
},
|
||||
{
|
||||
"flush", cfun_io_flush,
|
||||
JDOC("(flush)\n\n"
|
||||
@@ -610,7 +728,8 @@ static const JanetReg io_cfuns[] = {
|
||||
"\tw - allow writing to the file\n"
|
||||
"\ta - append to the file\n"
|
||||
"\tb - open the file in binary mode (rather than text mode)\n"
|
||||
"\t+ - append to the file instead of overwriting it")
|
||||
"\t+ - append to the file instead of overwriting it\n"
|
||||
"\tn - error if the file cannot be opened instead of returning nil")
|
||||
},
|
||||
{
|
||||
"file/close", cfun_io_fclose,
|
||||
@@ -658,7 +777,7 @@ static const JanetReg io_cfuns[] = {
|
||||
#ifndef JANET_NO_PROCESSES
|
||||
{
|
||||
"file/popen", cfun_io_popen,
|
||||
JDOC("(file/popen path &opt mode)\n\n"
|
||||
JDOC("(file/popen command &opt mode)\n\n"
|
||||
"Open a file that is backed by a process. The file must be opened in either "
|
||||
"the :r (read) or the :w (write) mode. In :r mode, the stdout of the "
|
||||
"process can be read from the file. In :w mode, the stdin of the process "
|
||||
@@ -670,16 +789,24 @@ static const JanetReg io_cfuns[] = {
|
||||
|
||||
/* C API */
|
||||
|
||||
JanetFile *janet_getjfile(const Janet *argv, int32_t n) {
|
||||
return janet_getabstract(argv, n, &janet_file_type);
|
||||
}
|
||||
|
||||
FILE *janet_getfile(const Janet *argv, int32_t n, int *flags) {
|
||||
JanetFile *iof = janet_getabstract(argv, n, &janet_file_type);
|
||||
if (NULL != flags) *flags = iof->flags;
|
||||
return iof->file;
|
||||
}
|
||||
|
||||
Janet janet_makefile(FILE *f, int flags) {
|
||||
JanetFile *janet_makejfile(FILE *f, int flags) {
|
||||
return makef(f, flags);
|
||||
}
|
||||
|
||||
Janet janet_makefile(FILE *f, int flags) {
|
||||
return janet_wrap_abstract(makef(f, flags));
|
||||
}
|
||||
|
||||
JanetAbstract janet_checkfile(Janet j) {
|
||||
return janet_checkabstract(j, &janet_file_type);
|
||||
}
|
||||
@@ -693,18 +820,19 @@ FILE *janet_unwrapfile(Janet j, int *flags) {
|
||||
/* Module entry point */
|
||||
void janet_lib_io(JanetTable *env) {
|
||||
janet_core_cfuns(env, NULL, io_cfuns);
|
||||
|
||||
janet_register_abstract_type(&janet_file_type);
|
||||
int default_flags = JANET_FILE_NOT_CLOSEABLE | JANET_FILE_SERIALIZABLE;
|
||||
/* stdout */
|
||||
janet_core_def(env, "stdout",
|
||||
makef(stdout, JANET_FILE_APPEND | JANET_FILE_NOT_CLOSEABLE | JANET_FILE_SERIALIZABLE),
|
||||
janet_makefile(stdout, JANET_FILE_APPEND | default_flags),
|
||||
JDOC("The standard output file."));
|
||||
/* stderr */
|
||||
janet_core_def(env, "stderr",
|
||||
makef(stderr, JANET_FILE_APPEND | JANET_FILE_NOT_CLOSEABLE | JANET_FILE_SERIALIZABLE),
|
||||
janet_makefile(stderr, JANET_FILE_APPEND | default_flags),
|
||||
JDOC("The standard error file."));
|
||||
/* stdin */
|
||||
janet_core_def(env, "stdin",
|
||||
makef(stdin, JANET_FILE_READ | JANET_FILE_NOT_CLOSEABLE | JANET_FILE_SERIALIZABLE),
|
||||
janet_makefile(stdin, JANET_FILE_READ | default_flags),
|
||||
JDOC("The standard input file."));
|
||||
|
||||
}
|
||||
|
||||
@@ -214,15 +214,6 @@ static void marshal_one_env(MarshalState *st, JanetFuncEnv *env, int flags) {
|
||||
}
|
||||
}
|
||||
|
||||
/* Add function flags to janet functions */
|
||||
static void janet_func_addflags(JanetFuncDef *def) {
|
||||
if (def->name) def->flags |= JANET_FUNCDEF_FLAG_HASNAME;
|
||||
if (def->source) def->flags |= JANET_FUNCDEF_FLAG_HASSOURCE;
|
||||
if (def->defs) def->flags |= JANET_FUNCDEF_FLAG_HASDEFS;
|
||||
if (def->environments) def->flags |= JANET_FUNCDEF_FLAG_HASENVS;
|
||||
if (def->sourcemap) def->flags |= JANET_FUNCDEF_FLAG_HASSOURCEMAP;
|
||||
}
|
||||
|
||||
/* Marshal a sequence of u32s */
|
||||
static void janet_marshal_u32s(MarshalState *st, const uint32_t *u32s, int32_t n) {
|
||||
for (int32_t i = 0; i < n; i++) {
|
||||
@@ -243,7 +234,6 @@ static void marshal_one_def(MarshalState *st, JanetFuncDef *def, int flags) {
|
||||
return;
|
||||
}
|
||||
}
|
||||
janet_func_addflags(def);
|
||||
/* Add to lookup */
|
||||
janet_v_push(st->seen_defs, def);
|
||||
pushint(st, def->flags);
|
||||
@@ -295,8 +285,8 @@ static void marshal_one_def(MarshalState *st, JanetFuncDef *def, int flags) {
|
||||
}
|
||||
|
||||
#define JANET_FIBER_FLAG_HASCHILD (1 << 29)
|
||||
#define JANET_FIBER_FLAG_HASENV (1 << 28)
|
||||
#define JANET_STACKFRAME_HASENV (1 << 30)
|
||||
#define JANET_FIBER_FLAG_HASENV (1 << 30)
|
||||
#define JANET_STACKFRAME_HASENV (1 << 31)
|
||||
|
||||
/* Marshal a fiber */
|
||||
static void marshal_one_fiber(MarshalState *st, JanetFiber *fiber, int flags) {
|
||||
@@ -900,7 +890,7 @@ static const uint8_t *unmarshal_one_def(
|
||||
for (int32_t i = 0; i < bytecode_length; i++) {
|
||||
current += readint(st, &data);
|
||||
def->sourcemap[i].line = current;
|
||||
def->sourcemap[i].column = readnat(st, &data);
|
||||
def->sourcemap[i].column = readint(st, &data);
|
||||
}
|
||||
} else {
|
||||
def->sourcemap = NULL;
|
||||
@@ -908,11 +898,12 @@ static const uint8_t *unmarshal_one_def(
|
||||
|
||||
/* Unmarshal closure bitset if needed */
|
||||
if (def->flags & JANET_FUNCDEF_FLAG_HASCLOBITSET) {
|
||||
def->closure_bitset = malloc(sizeof(uint32_t) * def->slotcount);
|
||||
int32_t n = (def->slotcount + 31) >> 5;
|
||||
def->closure_bitset = malloc(sizeof(uint32_t) * (size_t) n);
|
||||
if (NULL == def->closure_bitset) {
|
||||
JANET_OUT_OF_MEMORY;
|
||||
}
|
||||
data = janet_unmarshal_u32s(st, data, def->closure_bitset, (def->slotcount + 31) >> 5);
|
||||
data = janet_unmarshal_u32s(st, data, def->closure_bitset, n);
|
||||
}
|
||||
|
||||
/* Validate */
|
||||
@@ -943,6 +934,10 @@ static const uint8_t *unmarshal_one_fiber(
|
||||
fiber->data = NULL;
|
||||
fiber->child = NULL;
|
||||
fiber->env = NULL;
|
||||
#ifdef JANET_EV
|
||||
fiber->waiting = NULL;
|
||||
fiber->sched_id = 0;
|
||||
#endif
|
||||
|
||||
/* Push fiber to seen stack */
|
||||
janet_v_push(st->lookup, janet_wrap_fiber(fiber));
|
||||
@@ -1057,6 +1052,11 @@ static const uint8_t *unmarshal_one_fiber(
|
||||
fiber->maxstack = fiber_maxstack;
|
||||
fiber->env = fiber_env;
|
||||
|
||||
int status = janet_fiber_status(fiber);
|
||||
if (status < 0 || status > JANET_STATUS_ALIVE) {
|
||||
janet_panic("invalid fiber status");
|
||||
}
|
||||
|
||||
/* Return data */
|
||||
*out = fiber;
|
||||
return data;
|
||||
|
||||
@@ -499,5 +499,19 @@ void janet_lib_math(JanetTable *env) {
|
||||
JDOC("The number representing positive infinity"));
|
||||
janet_def(env, "math/-inf", janet_wrap_number(-INFINITY),
|
||||
JDOC("The number representing negative infinity"));
|
||||
janet_def(env, "math/int32-min", janet_wrap_number(INT32_MIN),
|
||||
JDOC("The maximum contiguous integer representable by a 32 bit signed integer"));
|
||||
janet_def(env, "math/int32-max", janet_wrap_number(INT32_MAX),
|
||||
JDOC("The minimum contiguous integer represtenable by a 32 bit signed integer"));
|
||||
janet_def(env, "math/int-min", janet_wrap_number(JANET_INTMIN_DOUBLE),
|
||||
JDOC("The maximum contiguous integer representable by a double (2^53)"));
|
||||
janet_def(env, "math/int-max", janet_wrap_number(JANET_INTMAX_DOUBLE),
|
||||
JDOC("The minimum contiguous integer represtenable by a double (-(2^53))"));
|
||||
#ifdef NAN
|
||||
janet_def(env, "math/nan", janet_wrap_number(NAN),
|
||||
#else
|
||||
janet_def(env, "math/nan", janet_wrap_number(0.0 / 0.0),
|
||||
#endif
|
||||
JDOC("Not a number (IEEE-754 NaN)"));
|
||||
#endif
|
||||
}
|
||||
|
||||
980
src/core/net.c
980
src/core/net.c
File diff suppressed because it is too large
Load Diff
531
src/core/os.c
531
src/core/os.c
@@ -24,6 +24,7 @@
|
||||
#include "features.h"
|
||||
#include <janet.h>
|
||||
#include "util.h"
|
||||
#include "gc.h"
|
||||
#endif
|
||||
|
||||
#ifndef JANET_REDUCED_OS
|
||||
@@ -36,8 +37,11 @@
|
||||
#include <stdio.h>
|
||||
#include <string.h>
|
||||
#include <sys/stat.h>
|
||||
#include <signal.h>
|
||||
|
||||
#define RETRY_EINTR(RC, CALL) do { (RC) = CALL; } while((RC) < 0 && errno == EINTR)
|
||||
#ifdef JANET_APPLE
|
||||
#include <AvailabilityMacros.h>
|
||||
#endif
|
||||
|
||||
#ifdef JANET_WINDOWS
|
||||
#include <windows.h>
|
||||
@@ -64,12 +68,6 @@ extern char **environ;
|
||||
#include <mach/mach.h>
|
||||
#endif
|
||||
|
||||
/* Setting C99 standard makes this not available, but it should
|
||||
* work/link properly if we detect a BSD */
|
||||
#if defined(JANET_BSD) || defined(JANET_APPLE)
|
||||
void arc4random_buf(void *buf, size_t nbytes);
|
||||
#endif
|
||||
|
||||
/* Not POSIX, but all Unixes but Solaris have this function. */
|
||||
#if defined(JANET_POSIX) && !defined(__sun)
|
||||
time_t timegm(struct tm *tm);
|
||||
@@ -159,6 +157,8 @@ static Janet os_arch(int32_t argc, Janet *argv) {
|
||||
return janet_ckeywordv("arm");
|
||||
#elif (defined(__sparc__))
|
||||
return janet_ckeywordv("sparc");
|
||||
#elif (defined(__ppc__))
|
||||
return janet_ckeywordv("ppc");
|
||||
#else
|
||||
return janet_ckeywordv("unknown");
|
||||
#endif
|
||||
@@ -221,7 +221,8 @@ static char **os_execute_env(int32_t argc, const Janet *argv) {
|
||||
return envp;
|
||||
}
|
||||
|
||||
/* Free memory from os_execute */
|
||||
/* Free memory from os_execute. Not actually needed, but doesn't pressure the GC
|
||||
in the happy path. */
|
||||
static void os_execute_cleanup(char **envp, const char **child_argv) {
|
||||
#ifdef JANET_WINDOWS
|
||||
(void) child_argv;
|
||||
@@ -314,16 +315,216 @@ static JanetBuffer *os_exec_escape(JanetView args) {
|
||||
}
|
||||
#endif
|
||||
|
||||
static Janet os_execute(int32_t argc, Janet *argv) {
|
||||
/* Process type for when running a subprocess and not immediately waiting */
|
||||
static const JanetAbstractType ProcAT;
|
||||
#define JANET_PROC_CLOSED 1
|
||||
#define JANET_PROC_WAITED 2
|
||||
typedef struct {
|
||||
int flags;
|
||||
#ifdef JANET_WINDOWS
|
||||
HANDLE pHandle;
|
||||
HANDLE tHandle;
|
||||
#else
|
||||
int pid;
|
||||
#endif
|
||||
int return_code;
|
||||
JanetFile *in;
|
||||
JanetFile *out;
|
||||
JanetFile *err;
|
||||
} JanetProc;
|
||||
|
||||
static int janet_proc_gc(void *p, size_t s) {
|
||||
(void) s;
|
||||
JanetProc *proc = (JanetProc *) p;
|
||||
#ifdef JANET_WINDOWS
|
||||
if (!(proc->flags & JANET_PROC_CLOSED)) {
|
||||
CloseHandle(proc->pHandle);
|
||||
CloseHandle(proc->tHandle);
|
||||
}
|
||||
#else
|
||||
if (!(proc->flags & JANET_PROC_WAITED)) {
|
||||
/* Kill and wait to prevent zombies */
|
||||
kill(proc->pid, SIGKILL);
|
||||
int status;
|
||||
waitpid(proc->pid, &status, 0);
|
||||
}
|
||||
#endif
|
||||
return 0;
|
||||
}
|
||||
|
||||
static int janet_proc_mark(void *p, size_t s) {
|
||||
(void) s;
|
||||
JanetProc *proc = (JanetProc *)p;
|
||||
if (NULL != proc->in) janet_mark(janet_wrap_abstract(proc->in));
|
||||
if (NULL != proc->out) janet_mark(janet_wrap_abstract(proc->out));
|
||||
if (NULL != proc->err) janet_mark(janet_wrap_abstract(proc->err));
|
||||
return 0;
|
||||
}
|
||||
|
||||
static Janet os_proc_wait_impl(JanetProc *proc) {
|
||||
if (proc->flags & JANET_PROC_WAITED) {
|
||||
janet_panicf("cannot wait on process that has already finished");
|
||||
}
|
||||
proc->flags |= JANET_PROC_WAITED;
|
||||
int status = 0;
|
||||
#ifdef JANET_WINDOWS
|
||||
WaitForSingleObject(proc->pHandle, INFINITE);
|
||||
GetExitCodeProcess(proc->pHandle, &status);
|
||||
if (!(proc->flags & JANET_PROC_CLOSED)) {
|
||||
proc->flags |= JANET_PROC_CLOSED;
|
||||
CloseHandle(proc->pHandle);
|
||||
CloseHandle(proc->tHandle);
|
||||
}
|
||||
#else
|
||||
waitpid(proc->pid, &status, 0);
|
||||
#endif
|
||||
proc->return_code = (int32_t) status;
|
||||
return janet_wrap_integer(proc->return_code);
|
||||
}
|
||||
|
||||
static Janet os_proc_wait(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 1);
|
||||
JanetProc *proc = janet_getabstract(argv, 0, &ProcAT);
|
||||
return os_proc_wait_impl(proc);
|
||||
}
|
||||
|
||||
static Janet os_proc_kill(int32_t argc, Janet *argv) {
|
||||
janet_arity(argc, 1, 2);
|
||||
JanetProc *proc = janet_getabstract(argv, 0, &ProcAT);
|
||||
if (proc->flags & JANET_PROC_WAITED) {
|
||||
janet_panicf("cannot kill process that has already finished");
|
||||
}
|
||||
#ifdef JANET_WINDOWS
|
||||
if (proc->flags & JANET_PROC_CLOSED) {
|
||||
janet_panicf("cannot close process handle that is already closed");
|
||||
}
|
||||
proc->flags |= JANET_PROC_CLOSED;
|
||||
CloseHandle(proc->pHandle);
|
||||
CloseHandle(proc->tHandle);
|
||||
#else
|
||||
int status = kill(proc->pid, SIGKILL);
|
||||
if (status) {
|
||||
janet_panic(strerror(errno));
|
||||
}
|
||||
#endif
|
||||
/* After killing process we wait on it. */
|
||||
if (argc > 1 && janet_truthy(argv[1])) {
|
||||
return os_proc_wait_impl(proc);
|
||||
} else {
|
||||
return argv[0];
|
||||
}
|
||||
}
|
||||
|
||||
static void swap_handles(JanetHandle *handles) {
|
||||
JanetHandle temp = handles[0];
|
||||
handles[0] = handles[1];
|
||||
handles[1] = temp;
|
||||
}
|
||||
|
||||
static void close_handle(JanetHandle handle) {
|
||||
#ifdef JANET_WINDOWS
|
||||
CloseHandle(handle);
|
||||
#else
|
||||
close(handle);
|
||||
#endif
|
||||
}
|
||||
|
||||
/* Create piped file for os/execute and os/spawn. Need to be careful that we mark
|
||||
the error flag if we can't create pipe and don't leak handles. *handle will be cleaned
|
||||
up by the calling function. If everything goes well, *handle is owned by the calling function,
|
||||
(if it is set) and the returned JanetFile owns the other end of the pipe, which will be closed
|
||||
on GC or fclose. */
|
||||
static JanetFile *make_pipes(JanetHandle *handle, int reverse, int *errflag) {
|
||||
JanetHandle handles[2];
|
||||
#ifdef JANET_WINDOWS
|
||||
SECURITY_ATTRIBUTES saAttr;
|
||||
memset(&saAttr, 0, sizeof(saAttr));
|
||||
saAttr.nLength = sizeof(saAttr);
|
||||
saAttr.bInheritHandle = TRUE;
|
||||
if (!CreatePipe(handles, handles + 1, &saAttr, 0)) goto error_pipe;
|
||||
if (reverse) swap_handles(handles);
|
||||
/* Don't inherit the side of the pipe owned by this process */
|
||||
if (!SetHandleInformation(handles[0], HANDLE_FLAG_INHERIT, 0)) goto error_set_handle_info;
|
||||
*handle = handles[1];
|
||||
int fd = _open_osfhandle((intptr_t) handles[0], reverse ? _O_WRONLY : _O_RDONLY);
|
||||
if (fd == -1) goto error_open_osfhandle;
|
||||
FILE *f = _fdopen(fd, reverse ? "w" : "r");
|
||||
if (NULL == f) goto error_fdopen;
|
||||
return janet_makejfile(f, reverse ? JANET_FILE_WRITE : JANET_FILE_READ);
|
||||
error_fdopen:
|
||||
_close(fd); /* we need to close the fake file descriptor instead of the handle, as ownership has been transfered. */
|
||||
*errflag = 1;
|
||||
return NULL;
|
||||
error_set_handle_info:
|
||||
error_open_osfhandle:
|
||||
close_handle(handles[0]);
|
||||
/* fallthrough */
|
||||
error_pipe:
|
||||
*errflag = 1;
|
||||
return NULL;
|
||||
#else
|
||||
if (pipe(handles)) goto error_pipe;
|
||||
if (reverse) swap_handles(handles);
|
||||
*handle = handles[1];
|
||||
FILE *f = fdopen(handles[0], reverse ? "w" : "r");
|
||||
if (NULL == f) goto error_fdopen;
|
||||
return janet_makejfile(f, reverse ? JANET_FILE_WRITE : JANET_FILE_READ);
|
||||
error_fdopen:
|
||||
close_handle(handles[0]);
|
||||
/* fallthrough */
|
||||
error_pipe:
|
||||
*errflag = 1;
|
||||
return NULL;
|
||||
#endif
|
||||
}
|
||||
|
||||
static const JanetMethod proc_methods[] = {
|
||||
{"wait", os_proc_wait},
|
||||
{"kill", os_proc_kill},
|
||||
{NULL, NULL}
|
||||
};
|
||||
|
||||
static int janet_proc_get(void *p, Janet key, Janet *out) {
|
||||
JanetProc *proc = (JanetProc *)p;
|
||||
if (janet_keyeq(key, "in")) {
|
||||
*out = (NULL == proc->in) ? janet_wrap_nil() : janet_wrap_abstract(proc->in);
|
||||
return 1;
|
||||
}
|
||||
if (janet_keyeq(key, "out")) {
|
||||
*out = (NULL == proc->out) ? janet_wrap_nil() : janet_wrap_abstract(proc->out);
|
||||
return 1;
|
||||
}
|
||||
if (janet_keyeq(key, "err")) {
|
||||
*out = (NULL == proc->out) ? janet_wrap_nil() : janet_wrap_abstract(proc->err);
|
||||
return 1;
|
||||
}
|
||||
if ((-1 != proc->return_code) && janet_keyeq(key, "return-code")) {
|
||||
*out = janet_wrap_integer(proc->return_code);
|
||||
return 1;
|
||||
}
|
||||
if (!janet_checktype(key, JANET_KEYWORD)) return 0;
|
||||
return janet_getmethod(janet_unwrap_keyword(key), proc_methods, out);
|
||||
}
|
||||
|
||||
static const JanetAbstractType ProcAT = {
|
||||
"core/process",
|
||||
janet_proc_gc,
|
||||
janet_proc_mark,
|
||||
janet_proc_get,
|
||||
JANET_ATEND_GET
|
||||
};
|
||||
|
||||
static Janet os_execute_impl(int32_t argc, Janet *argv, int is_async) {
|
||||
janet_arity(argc, 1, 3);
|
||||
|
||||
/* Get flags */
|
||||
uint64_t flags = 0;
|
||||
if (argc > 1) {
|
||||
flags = janet_getflags(argv, 1, "ep");
|
||||
flags = janet_getflags(argv, 1, "epx");
|
||||
}
|
||||
|
||||
/* Get environment */
|
||||
int use_environ = !janet_flag_at(flags, 0);
|
||||
char **envp = os_execute_env(argc, argv);
|
||||
|
||||
/* Get arguments */
|
||||
@@ -332,43 +533,132 @@ static Janet os_execute(int32_t argc, Janet *argv) {
|
||||
janet_panic("expected at least 1 command line argument");
|
||||
}
|
||||
|
||||
/* Optional stdio redirections */
|
||||
JanetFile *new_in = NULL, *new_out = NULL, *new_err = NULL;
|
||||
JanetHandle pipe_in = JANET_HANDLE_NONE, pipe_out = JANET_HANDLE_NONE, pipe_err = JANET_HANDLE_NONE;
|
||||
int pipe_errflag = 0; /* Track errors setting up pipes */
|
||||
|
||||
/* Get optional redirections */
|
||||
if (argc > 2) {
|
||||
JanetDictView tab = janet_getdictionary(argv, 2);
|
||||
Janet maybe_stdin = janet_dictionary_get(tab.kvs, tab.cap, janet_ckeywordv("in"));
|
||||
Janet maybe_stdout = janet_dictionary_get(tab.kvs, tab.cap, janet_ckeywordv("out"));
|
||||
Janet maybe_stderr = janet_dictionary_get(tab.kvs, tab.cap, janet_ckeywordv("err"));
|
||||
if (janet_keyeq(maybe_stdin, "pipe")) {
|
||||
new_in = make_pipes(&pipe_in, 1, &pipe_errflag);
|
||||
} else if (!janet_checktype(maybe_stdin, JANET_NIL)) {
|
||||
new_in = janet_getjfile(&maybe_stdin, 0);
|
||||
}
|
||||
if (janet_keyeq(maybe_stdout, "pipe")) {
|
||||
new_out = make_pipes(&pipe_out, 0, &pipe_errflag);
|
||||
} else if (!janet_checktype(maybe_stdout, JANET_NIL)) {
|
||||
new_out = janet_getjfile(&maybe_stdout, 0);
|
||||
}
|
||||
if (janet_keyeq(maybe_stderr, "err")) {
|
||||
new_err = make_pipes(&pipe_err, 0, &pipe_errflag);
|
||||
} else if (!janet_checktype(maybe_stderr, JANET_NIL)) {
|
||||
new_err = janet_getjfile(&maybe_stderr, 0);
|
||||
}
|
||||
}
|
||||
|
||||
/* Clean up if any of the pipes have any issues */
|
||||
if (pipe_errflag) {
|
||||
if (pipe_in != JANET_HANDLE_NONE) close_handle(pipe_in);
|
||||
if (pipe_out != JANET_HANDLE_NONE) close_handle(pipe_out);
|
||||
if (pipe_err != JANET_HANDLE_NONE) close_handle(pipe_err);
|
||||
janet_panic("failed to create pipes");
|
||||
}
|
||||
|
||||
/* Result */
|
||||
int status = 0;
|
||||
|
||||
#ifdef JANET_WINDOWS
|
||||
|
||||
HANDLE pHandle, tHandle;
|
||||
SECURITY_ATTRIBUTES saAttr;
|
||||
PROCESS_INFORMATION processInfo;
|
||||
STARTUPINFO startupInfo;
|
||||
memset(&saAttr, 0, sizeof(saAttr));
|
||||
memset(&processInfo, 0, sizeof(processInfo));
|
||||
memset(&startupInfo, 0, sizeof(startupInfo));
|
||||
startupInfo.cb = sizeof(startupInfo);
|
||||
startupInfo.dwFlags |= STARTF_USESTDHANDLES;
|
||||
saAttr.nLength = sizeof(saAttr);
|
||||
saAttr.bInheritHandle = TRUE;
|
||||
|
||||
JanetBuffer *buf = os_exec_escape(exargs);
|
||||
if (buf->count > 8191) {
|
||||
janet_panic("command line string too long (max 8191 characters)");
|
||||
}
|
||||
const char *path = (const char *) janet_unwrap_string(exargs.items[0]);
|
||||
char *cargv[2] = {(char *) buf->data, NULL};
|
||||
|
||||
/* Do IO redirection */
|
||||
|
||||
if (pipe_in != JANET_HANDLE_NONE) {
|
||||
startupInfo.hStdInput = pipe_in;
|
||||
} else if (new_in != NULL) {
|
||||
startupInfo.hStdInput = (HANDLE) _get_osfhandle(_fileno(new_in->file));
|
||||
} else {
|
||||
startupInfo.hStdInput = (HANDLE) _get_osfhandle(0);
|
||||
}
|
||||
|
||||
|
||||
if (pipe_out != JANET_HANDLE_NONE) {
|
||||
startupInfo.hStdOutput = pipe_out;
|
||||
} else if (new_out != NULL) {
|
||||
startupInfo.hStdOutput = (HANDLE) _get_osfhandle(_fileno(new_out->file));
|
||||
} else {
|
||||
startupInfo.hStdOutput = (HANDLE) _get_osfhandle(1);
|
||||
}
|
||||
|
||||
if (pipe_err != JANET_HANDLE_NONE) {
|
||||
startupInfo.hStdError = pipe_err;
|
||||
} else if (new_err != NULL) {
|
||||
startupInfo.hStdError = (HANDLE) _get_osfhandle(_fileno(new_err->file));
|
||||
} else {
|
||||
startupInfo.hStdError = (HANDLE) _get_osfhandle(2);
|
||||
}
|
||||
|
||||
/* Use _spawn family of functions. */
|
||||
/* Windows docs say do this before any spawns. */
|
||||
_flushall();
|
||||
|
||||
/* Use an empty env instead when envp is NULL to be consistent with other implementation. */
|
||||
char *empty_env[1] = {NULL};
|
||||
char **envp1 = (NULL == envp) ? empty_env : envp;
|
||||
|
||||
if (janet_flag_at(flags, 1) && janet_flag_at(flags, 0)) {
|
||||
status = (int) _spawnvpe(_P_WAIT, path, cargv, envp1);
|
||||
} else if (janet_flag_at(flags, 1)) {
|
||||
status = (int) _spawnvp(_P_WAIT, path, cargv);
|
||||
} else if (janet_flag_at(flags, 0)) {
|
||||
status = (int) _spawnve(_P_WAIT, path, cargv, envp1);
|
||||
} else {
|
||||
status = (int) _spawnv(_P_WAIT, path, cargv);
|
||||
int cp_failed = 0;
|
||||
if (!CreateProcess(janet_flag_at(flags, 1) ? NULL : path,
|
||||
(char *) buf->data, /* Single CLI argument */
|
||||
&saAttr, /* no proc inheritance */
|
||||
&saAttr, /* no thread inheritance */
|
||||
TRUE, /* handle inheritance */
|
||||
0, /* flags */
|
||||
use_environ ? NULL : envp, /* pass in environment */
|
||||
NULL, /* use parents starting directory */
|
||||
&startupInfo,
|
||||
&processInfo)) {
|
||||
cp_failed = 1;
|
||||
}
|
||||
|
||||
if (pipe_in != JANET_HANDLE_NONE) CloseHandle(pipe_in);
|
||||
if (pipe_out != JANET_HANDLE_NONE) CloseHandle(pipe_out);
|
||||
if (pipe_err != JANET_HANDLE_NONE) CloseHandle(pipe_err);
|
||||
|
||||
os_execute_cleanup(envp, NULL);
|
||||
|
||||
/* Check error */
|
||||
if (-1 == status) {
|
||||
janet_panicf("%p: %s", argv[0], strerror(errno));
|
||||
if (cp_failed) {
|
||||
janet_panic("failed to create process");
|
||||
}
|
||||
|
||||
return janet_wrap_integer(status);
|
||||
pHandle = processInfo.hProcess;
|
||||
tHandle = processInfo.hThread;
|
||||
|
||||
/* Wait and cleanup immedaitely */
|
||||
if (!is_async) {
|
||||
DWORD code;
|
||||
WaitForSingleObject(pHandle, INFINITE);
|
||||
GetExitCodeProcess(pHandle, &code);
|
||||
status = (int) code;
|
||||
CloseHandle(pHandle);
|
||||
CloseHandle(tHandle);
|
||||
}
|
||||
#else
|
||||
|
||||
const char **child_argv = janet_smalloc(sizeof(char *) * ((size_t) exargs.len + 1));
|
||||
@@ -381,23 +671,46 @@ static Janet os_execute(int32_t argc, Janet *argv) {
|
||||
|
||||
/* Use posix_spawn to spawn new process */
|
||||
|
||||
int use_environ = !janet_flag_at(flags, 0);
|
||||
|
||||
if (use_environ) {
|
||||
janet_lock_environ();
|
||||
}
|
||||
|
||||
/* Posix spawn setup */
|
||||
posix_spawn_file_actions_t actions;
|
||||
posix_spawn_file_actions_init(&actions);
|
||||
if (pipe_in != JANET_HANDLE_NONE) {
|
||||
posix_spawn_file_actions_adddup2(&actions, pipe_in, 0);
|
||||
} else if (new_in != NULL) {
|
||||
posix_spawn_file_actions_adddup2(&actions, fileno(new_in->file), 0);
|
||||
}
|
||||
if (pipe_out != JANET_HANDLE_NONE) {
|
||||
posix_spawn_file_actions_adddup2(&actions, pipe_out, 1);
|
||||
} else if (new_out != NULL) {
|
||||
posix_spawn_file_actions_adddup2(&actions, fileno(new_out->file), 1);
|
||||
}
|
||||
if (pipe_err != JANET_HANDLE_NONE) {
|
||||
posix_spawn_file_actions_adddup2(&actions, pipe_err, 2);
|
||||
} else if (new_err != NULL) {
|
||||
posix_spawn_file_actions_adddup2(&actions, fileno(new_err->file), 2);
|
||||
}
|
||||
|
||||
pid_t pid;
|
||||
if (janet_flag_at(flags, 1)) {
|
||||
status = posix_spawnp(&pid,
|
||||
child_argv[0], NULL, NULL, cargv,
|
||||
child_argv[0], &actions, NULL, cargv,
|
||||
use_environ ? environ : envp);
|
||||
} else {
|
||||
status = posix_spawn(&pid,
|
||||
child_argv[0], NULL, NULL, cargv,
|
||||
child_argv[0], &actions, NULL, cargv,
|
||||
use_environ ? environ : envp);
|
||||
}
|
||||
|
||||
posix_spawn_file_actions_destroy(&actions);
|
||||
|
||||
if (pipe_in != JANET_HANDLE_NONE) close(pipe_in);
|
||||
if (pipe_out != JANET_HANDLE_NONE) close(pipe_out);
|
||||
if (pipe_err != JANET_HANDLE_NONE) close(pipe_err);
|
||||
|
||||
if (use_environ) {
|
||||
janet_unlock_environ();
|
||||
}
|
||||
@@ -406,22 +719,51 @@ static Janet os_execute(int32_t argc, Janet *argv) {
|
||||
if (status) {
|
||||
os_execute_cleanup(envp, child_argv);
|
||||
janet_panicf("%p: %s", argv[0], strerror(errno));
|
||||
} else if (is_async) {
|
||||
/* Get process handle */
|
||||
os_execute_cleanup(envp, child_argv);
|
||||
} else {
|
||||
/* Wait to complete */
|
||||
waitpid(pid, &status, 0);
|
||||
os_execute_cleanup(envp, child_argv);
|
||||
/* Use POSIX shell semantics for interpreting signals */
|
||||
if (WIFEXITED(status)) {
|
||||
status = WEXITSTATUS(status);
|
||||
} else if (WIFSTOPPED(status)) {
|
||||
status = WSTOPSIG(status) + 128;
|
||||
} else {
|
||||
status = WTERMSIG(status) + 128;
|
||||
}
|
||||
}
|
||||
|
||||
os_execute_cleanup(envp, child_argv);
|
||||
/* Use POSIX shell semantics for interpreting signals */
|
||||
int ret;
|
||||
if (WIFEXITED(status)) {
|
||||
ret = WEXITSTATUS(status);
|
||||
} else if (WIFSTOPPED(status)) {
|
||||
ret = WSTOPSIG(status) + 128;
|
||||
} else {
|
||||
ret = WTERMSIG(status) + 128;
|
||||
}
|
||||
return janet_wrap_integer(ret);
|
||||
#endif
|
||||
if (is_async) {
|
||||
JanetProc *proc = janet_abstract(&ProcAT, sizeof(JanetProc));
|
||||
proc->return_code = -1;
|
||||
#ifdef JANET_WINDOWS
|
||||
proc->pHandle = pHandle;
|
||||
proc->tHandle = tHandle;
|
||||
#else
|
||||
proc->pid = pid;
|
||||
#endif
|
||||
proc->in = new_in;
|
||||
proc->out = new_out;
|
||||
proc->err = new_err;
|
||||
proc->flags = 0;
|
||||
return janet_wrap_abstract(proc);
|
||||
} else if (janet_flag_at(flags, 2) && status) {
|
||||
janet_panicf("command failed with non-zero exit code %d", status);
|
||||
} else {
|
||||
return janet_wrap_integer(status);
|
||||
}
|
||||
}
|
||||
|
||||
static Janet os_execute(int32_t argc, Janet *argv) {
|
||||
return os_execute_impl(argc, argv, 0);
|
||||
}
|
||||
|
||||
static Janet os_spawn(int32_t argc, Janet *argv) {
|
||||
return os_execute_impl(argc, argv, 1);
|
||||
}
|
||||
|
||||
static Janet os_shell(int32_t argc, Janet *argv) {
|
||||
@@ -508,39 +850,11 @@ static Janet os_time(int32_t argc, Janet *argv) {
|
||||
return janet_wrap_number(dtime);
|
||||
}
|
||||
|
||||
/* Clock shims */
|
||||
#ifdef JANET_WINDOWS
|
||||
static int gettime(struct timespec *spec) {
|
||||
FILETIME ftime;
|
||||
GetSystemTimeAsFileTime(&ftime);
|
||||
int64_t wintime = (int64_t)(ftime.dwLowDateTime) | ((int64_t)(ftime.dwHighDateTime) << 32);
|
||||
/* Windows epoch is January 1, 1601 apparently */
|
||||
wintime -= 116444736000000000LL;
|
||||
spec->tv_sec = wintime / 10000000LL;
|
||||
/* Resolution is 100 nanoseconds. */
|
||||
spec->tv_nsec = wintime % 10000000LL * 100;
|
||||
return 0;
|
||||
}
|
||||
#elif defined(__MACH__)
|
||||
static int gettime(struct timespec *spec) {
|
||||
clock_serv_t cclock;
|
||||
mach_timespec_t mts;
|
||||
host_get_clock_service(mach_host_self(), CALENDAR_CLOCK, &cclock);
|
||||
clock_get_time(cclock, &mts);
|
||||
mach_port_deallocate(mach_task_self(), cclock);
|
||||
spec->tv_sec = mts.tv_sec;
|
||||
spec->tv_nsec = mts.tv_nsec;
|
||||
return 0;
|
||||
}
|
||||
#else
|
||||
#define gettime(TV) clock_gettime(CLOCK_MONOTONIC, (TV))
|
||||
#endif
|
||||
|
||||
static Janet os_clock(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 0);
|
||||
(void) argv;
|
||||
struct timespec tv;
|
||||
if (gettime(&tv)) janet_panic("could not get time");
|
||||
if (janet_gettime(&tv)) janet_panic("could not get time");
|
||||
double dtime = tv.tv_sec + (tv.tv_nsec / 1E9);
|
||||
return janet_wrap_number(dtime);
|
||||
}
|
||||
@@ -579,7 +893,6 @@ static Janet os_cwd(int32_t argc, Janet *argv) {
|
||||
|
||||
static Janet os_cryptorand(int32_t argc, Janet *argv) {
|
||||
JanetBuffer *buffer;
|
||||
const char *genericerr = "unable to get sufficient random data";
|
||||
janet_arity(argc, 1, 2);
|
||||
int32_t offset;
|
||||
int32_t n = janet_getinteger(argv, 0);
|
||||
@@ -594,43 +907,9 @@ static Janet os_cryptorand(int32_t argc, Janet *argv) {
|
||||
/* We could optimize here by adding setcount_uninit */
|
||||
janet_buffer_setcount(buffer, offset + n);
|
||||
|
||||
#ifdef JANET_WINDOWS
|
||||
for (int32_t i = offset; i < buffer->count; i += sizeof(unsigned int)) {
|
||||
unsigned int v;
|
||||
if (rand_s(&v))
|
||||
janet_panic(genericerr);
|
||||
for (int32_t j = 0; (j < sizeof(unsigned int)) && (i + j < buffer->count); j++) {
|
||||
buffer->data[i + j] = v & 0xff;
|
||||
v = v >> 8;
|
||||
}
|
||||
}
|
||||
#elif defined(JANET_LINUX)
|
||||
/* We should be able to call getrandom on linux, but it doesn't seem
|
||||
to be uniformly supported on linux distros.
|
||||
In both cases, use this fallback path for now... */
|
||||
int rc;
|
||||
int randfd;
|
||||
RETRY_EINTR(randfd, open("/dev/urandom", O_RDONLY | O_CLOEXEC));
|
||||
if (randfd < 0)
|
||||
janet_panic(genericerr);
|
||||
while (n > 0) {
|
||||
ssize_t nread;
|
||||
RETRY_EINTR(nread, read(randfd, buffer->data + offset, n));
|
||||
if (nread <= 0) {
|
||||
RETRY_EINTR(rc, close(randfd));
|
||||
janet_panic(genericerr);
|
||||
}
|
||||
offset += nread;
|
||||
n -= nread;
|
||||
}
|
||||
RETRY_EINTR(rc, close(randfd));
|
||||
#elif defined(JANET_BSD) || defined(JANET_APPLE)
|
||||
(void) genericerr;
|
||||
arc4random_buf(buffer->data + offset, n);
|
||||
#else
|
||||
(void) genericerr;
|
||||
janet_panic("cryptorand currently unsupported on this platform");
|
||||
#endif
|
||||
if (janet_cryptorand(buffer->data + offset, n) != 0)
|
||||
janet_panic("unable to get sufficient random data");
|
||||
|
||||
return janet_wrap_buffer(buffer);
|
||||
}
|
||||
|
||||
@@ -1399,15 +1678,41 @@ static const JanetReg os_cfuns[] = {
|
||||
"\t:e - enables passing an environment to the program. Without :e, the "
|
||||
"current environment is inherited.\n"
|
||||
"\t:p - allows searching the current PATH for the binary to execute. "
|
||||
"Without this flag, binaries must use absolute paths.\n\n"
|
||||
"env is a table or struct mapping environment variables to values. "
|
||||
"Without this flag, binaries must use absolute paths.\n"
|
||||
"\t:x - raise error if exit code is non-zero.\n"
|
||||
"env is a table or struct mapping environment variables to values. It can also "
|
||||
"contain the keys :in, :out, and :err, which allow redirecting stdio in the subprocess. "
|
||||
"These arguments should be core/file values. "
|
||||
"One can also pass in the :pipe keyword "
|
||||
"for these arguments to create files that will read (for :err and :out) or write (for :in) "
|
||||
"to the file descriptor of the subprocess. This is only useful in os/spawn, which takes "
|
||||
"the same parameters as os/execute, but will return an object that contains references to these "
|
||||
"files via (return-value :in), (return-value :out), and (return-value :err). "
|
||||
"Returns the exit status of the program.")
|
||||
},
|
||||
{
|
||||
"os/spawn", os_spawn,
|
||||
JDOC("(os/spawn args &opts flags env)\n\n"
|
||||
"Execute a program on the system and return a handle to the process. Otherwise, the "
|
||||
"same arguments as os/execute. Does not wait for the process.")
|
||||
},
|
||||
{
|
||||
"os/shell", os_shell,
|
||||
JDOC("(os/shell str)\n\n"
|
||||
"Pass a command string str directly to the system shell.")
|
||||
},
|
||||
{
|
||||
"os/proc-wait", os_proc_wait,
|
||||
JDOC("(os/proc-wait proc)\n\n"
|
||||
"Block until the subprocess completes. Returns the subprocess return code.")
|
||||
},
|
||||
{
|
||||
"os/proc-kill", os_proc_kill,
|
||||
JDOC("(os/proc-kill proc &opt wait)\n\n"
|
||||
"Kill a subprocess by sending SIGKILL to it on posix systems, or by closing the process "
|
||||
"handle on windows. If wait is truthy, will wait for the process to finsih and "
|
||||
"returns the exit code. Otherwise, returns proc.")
|
||||
},
|
||||
#endif
|
||||
{
|
||||
"os/setenv", os_setenv,
|
||||
@@ -1438,8 +1743,8 @@ static const JanetReg os_cfuns[] = {
|
||||
},
|
||||
{
|
||||
"os/sleep", os_sleep,
|
||||
JDOC("(os/sleep nsec)\n\n"
|
||||
"Suspend the program for nsec seconds. 'nsec' can be a real number. Returns "
|
||||
JDOC("(os/sleep n)\n\n"
|
||||
"Suspend the program for n seconds. 'nsec' can be a real number. Returns "
|
||||
"nil.")
|
||||
},
|
||||
{
|
||||
|
||||
256
src/core/peg.c
256
src/core/peg.c
@@ -87,6 +87,12 @@ static void pushcap(PegState *s, Janet capture, uint32_t tag) {
|
||||
}
|
||||
}
|
||||
|
||||
/* Convert a uint64_t to a int64_t by wrapping to a maximum number of bytes */
|
||||
static int64_t peg_convert_u64_s64(uint64_t from, int width) {
|
||||
int shift = 8 * (8 - width);
|
||||
return ((int64_t)(from << shift)) >> shift;
|
||||
}
|
||||
|
||||
/* Prevent stack overflow */
|
||||
#define down1(s) do { \
|
||||
if (0 == --((s)->depth)) janet_panic("peg/match recursed too deeply"); \
|
||||
@@ -469,6 +475,47 @@ tail:
|
||||
return next_text;
|
||||
}
|
||||
|
||||
case RULE_READINT: {
|
||||
uint32_t tag = rule[2];
|
||||
uint32_t signedness = rule[1] & 0x10;
|
||||
uint32_t endianess = rule[1] & 0x20;
|
||||
int width = (int)(rule[1] & 0xF);
|
||||
if (text + width > s->text_end) return NULL;
|
||||
uint64_t accum = 0;
|
||||
if (endianess) {
|
||||
/* BE */
|
||||
for (int i = 0; i < width; i++) accum = (accum << 8) | text[i];
|
||||
} else {
|
||||
/* LE */
|
||||
for (int i = width - 1; i >= 0; i--) accum = (accum << 8) | text[i];
|
||||
}
|
||||
|
||||
Janet capture_value;
|
||||
/* We can only parse integeres of greater than 6 bytes reliable if int-types are enabled.
|
||||
* Otherwise, we may lose precision, so 6 is the maximum size when int-types are disabled. */
|
||||
#ifdef JANET_INT_TYPES
|
||||
if (width > 6) {
|
||||
if (signedness) {
|
||||
capture_value = janet_wrap_s64(peg_convert_u64_s64(accum, width));
|
||||
} else {
|
||||
capture_value = janet_wrap_u64(accum);
|
||||
}
|
||||
} else
|
||||
#endif
|
||||
{
|
||||
double double_value;
|
||||
if (signedness) {
|
||||
double_value = (double)(peg_convert_u64_s64(accum, width));
|
||||
} else {
|
||||
double_value = (double)accum;
|
||||
}
|
||||
capture_value = janet_wrap_number(double_value);
|
||||
}
|
||||
|
||||
pushcap(s, capture_value, tag);
|
||||
return text + width;
|
||||
}
|
||||
|
||||
}
|
||||
}
|
||||
|
||||
@@ -876,6 +923,36 @@ static void spec_matchtime(Builder *b, int32_t argc, const Janet *argv) {
|
||||
emit_3(r, RULE_MATCHTIME, subrule, cindex, tag);
|
||||
}
|
||||
|
||||
#ifdef JANET_INT_TYPES
|
||||
#define JANET_MAX_READINT_WIDTH 8
|
||||
#else
|
||||
#define JANET_MAX_READINT_WIDTH 6
|
||||
#endif
|
||||
|
||||
static void spec_readint(Builder *b, int32_t argc, const Janet *argv, uint32_t mask) {
|
||||
peg_arity(b, argc, 1, 2);
|
||||
Reserve r = reserve(b, 3);
|
||||
uint32_t tag = (argc == 2) ? emit_tag(b, argv[3]) : 0;
|
||||
int32_t width = peg_getnat(b, argv[0]);
|
||||
if ((width < 0) || (width > JANET_MAX_READINT_WIDTH)) {
|
||||
peg_panicf(b, "width must be between 0 and %d, got %d", JANET_MAX_READINT_WIDTH, width);
|
||||
}
|
||||
emit_2(r, RULE_READINT, mask | ((uint32_t) width), tag);
|
||||
}
|
||||
|
||||
static void spec_uint_le(Builder *b, int32_t argc, const Janet *argv) {
|
||||
spec_readint(b, argc, argv, 0x0u);
|
||||
}
|
||||
static void spec_int_le(Builder *b, int32_t argc, const Janet *argv) {
|
||||
spec_readint(b, argc, argv, 0x10u);
|
||||
}
|
||||
static void spec_uint_be(Builder *b, int32_t argc, const Janet *argv) {
|
||||
spec_readint(b, argc, argv, 0x20u);
|
||||
}
|
||||
static void spec_int_be(Builder *b, int32_t argc, const Janet *argv) {
|
||||
spec_readint(b, argc, argv, 0x30u);
|
||||
}
|
||||
|
||||
/* Special compiler form */
|
||||
typedef void (*Special)(Builder *b, int32_t argc, const Janet *argv);
|
||||
typedef struct {
|
||||
@@ -912,6 +989,8 @@ static const SpecialPair peg_specials[] = {
|
||||
{"group", spec_group},
|
||||
{"if", spec_if},
|
||||
{"if-not", spec_ifnot},
|
||||
{"int", spec_int_le},
|
||||
{"int-be", spec_int_be},
|
||||
{"lenprefix", spec_lenprefix},
|
||||
{"look", spec_look},
|
||||
{"not", spec_not},
|
||||
@@ -926,6 +1005,8 @@ static const SpecialPair peg_specials[] = {
|
||||
{"some", spec_some},
|
||||
{"thru", spec_thru},
|
||||
{"to", spec_to},
|
||||
{"uint", spec_uint_le},
|
||||
{"uint-be", spec_uint_be},
|
||||
};
|
||||
|
||||
/* Compile a janet value into a rule and return the rule index. */
|
||||
@@ -1226,6 +1307,11 @@ static void *peg_unmarshal(JanetMarshalContext *ctx) {
|
||||
op_flags[rule[1]] |= 0x01;
|
||||
i += 2;
|
||||
break;
|
||||
case RULE_READINT:
|
||||
/* [ width | (endianess << 5) | (signedness << 6), tag ] */
|
||||
if (rule[1] > JANET_MAX_READINT_WIDTH) goto bad;
|
||||
i += 3;
|
||||
break;
|
||||
default:
|
||||
goto bad;
|
||||
}
|
||||
@@ -1308,47 +1394,136 @@ static Janet cfun_peg_compile(int32_t argc, Janet *argv) {
|
||||
return janet_wrap_abstract(peg);
|
||||
}
|
||||
|
||||
static Janet cfun_peg_match(int32_t argc, Janet *argv) {
|
||||
janet_arity(argc, 2, -1);
|
||||
/* Common data for peg cfunctions */
|
||||
typedef struct {
|
||||
JanetPeg *peg;
|
||||
PegState s;
|
||||
JanetByteView bytes;
|
||||
JanetByteView repl;
|
||||
int32_t start;
|
||||
} PegCall;
|
||||
|
||||
/* Initialize state for peg cfunctions */
|
||||
static PegCall peg_cfun_init(int32_t argc, Janet *argv, int get_replace) {
|
||||
PegCall ret;
|
||||
int32_t min = get_replace ? 3 : 2;
|
||||
janet_arity(argc, get_replace, -1);
|
||||
if (janet_checktype(argv[0], JANET_ABSTRACT) &&
|
||||
janet_abstract_type(janet_unwrap_abstract(argv[0])) == &janet_peg_type) {
|
||||
peg = janet_unwrap_abstract(argv[0]);
|
||||
ret.peg = janet_unwrap_abstract(argv[0]);
|
||||
} else {
|
||||
peg = compile_peg(argv[0]);
|
||||
ret.peg = compile_peg(argv[0]);
|
||||
}
|
||||
JanetByteView bytes = janet_getbytes(argv, 1);
|
||||
int32_t start;
|
||||
PegState s;
|
||||
if (argc > 2) {
|
||||
start = janet_gethalfrange(argv, 2, bytes.len, "offset");
|
||||
s.extrac = argc - 3;
|
||||
s.extrav = janet_tuple_n(argv + 3, argc - 3);
|
||||
if (get_replace) {
|
||||
ret.repl = janet_getbytes(argv, 1);
|
||||
ret.bytes = janet_getbytes(argv, 2);
|
||||
} else {
|
||||
start = 0;
|
||||
s.extrac = 0;
|
||||
s.extrav = NULL;
|
||||
ret.bytes = janet_getbytes(argv, 1);
|
||||
}
|
||||
s.mode = PEG_MODE_NORMAL;
|
||||
s.text_start = bytes.bytes;
|
||||
s.text_end = bytes.bytes + bytes.len;
|
||||
s.depth = JANET_RECURSION_GUARD;
|
||||
s.captures = janet_array(0);
|
||||
s.scratch = janet_buffer(10);
|
||||
s.tags = janet_buffer(10);
|
||||
s.constants = peg->constants;
|
||||
s.bytecode = peg->bytecode;
|
||||
const uint8_t *result = peg_rule(&s, s.bytecode, bytes.bytes + start);
|
||||
return result ? janet_wrap_array(s.captures) : janet_wrap_nil();
|
||||
if (argc > min) {
|
||||
ret.start = janet_gethalfrange(argv, min, ret.bytes.len, "offset");
|
||||
ret.s.extrac = argc - min - 1;
|
||||
ret.s.extrav = janet_tuple_n(argv + min + 1, argc - min - 1);
|
||||
} else {
|
||||
ret.start = 0;
|
||||
ret.s.extrac = 0;
|
||||
ret.s.extrav = NULL;
|
||||
}
|
||||
ret.s.mode = PEG_MODE_NORMAL;
|
||||
ret.s.text_start = ret.bytes.bytes;
|
||||
ret.s.text_end = ret.bytes.bytes + ret.bytes.len;
|
||||
ret.s.depth = JANET_RECURSION_GUARD;
|
||||
ret.s.captures = janet_array(0);
|
||||
ret.s.scratch = janet_buffer(10);
|
||||
ret.s.tags = janet_buffer(10);
|
||||
ret.s.constants = ret.peg->constants;
|
||||
ret.s.bytecode = ret.peg->bytecode;
|
||||
return ret;
|
||||
}
|
||||
|
||||
static void peg_call_reset(PegCall *c) {
|
||||
c->s.captures->count = 0;
|
||||
c->s.scratch->count = 0;
|
||||
c->s.tags->count = 0;
|
||||
}
|
||||
|
||||
static Janet cfun_peg_match(int32_t argc, Janet *argv) {
|
||||
PegCall c = peg_cfun_init(argc, argv, 0);
|
||||
const uint8_t *result = peg_rule(&c.s, c.s.bytecode, c.bytes.bytes + c.start);
|
||||
return result ? janet_wrap_array(c.s.captures) : janet_wrap_nil();
|
||||
}
|
||||
|
||||
static Janet cfun_peg_find(int32_t argc, Janet *argv) {
|
||||
PegCall c = peg_cfun_init(argc, argv, 0);
|
||||
for (int32_t i = c.start; i < c.bytes.len; i++) {
|
||||
peg_call_reset(&c);
|
||||
if (peg_rule(&c.s, c.s.bytecode, c.bytes.bytes + i))
|
||||
return janet_wrap_integer(i);
|
||||
}
|
||||
return janet_wrap_nil();
|
||||
}
|
||||
|
||||
static Janet cfun_peg_find_all(int32_t argc, Janet *argv) {
|
||||
PegCall c = peg_cfun_init(argc, argv, 0);
|
||||
JanetArray *ret = janet_array(0);
|
||||
for (int32_t i = c.start; i < c.bytes.len; i++) {
|
||||
peg_call_reset(&c);
|
||||
if (peg_rule(&c.s, c.s.bytecode, c.bytes.bytes + i))
|
||||
janet_array_push(ret, janet_wrap_integer(i));
|
||||
}
|
||||
return janet_wrap_array(ret);
|
||||
}
|
||||
|
||||
static Janet cfun_peg_replace_generic(int32_t argc, Janet *argv, int only_one) {
|
||||
PegCall c = peg_cfun_init(argc, argv, 1);
|
||||
JanetBuffer *ret = janet_buffer(0);
|
||||
int32_t trail = 0;
|
||||
for (int32_t i = c.start; i < c.bytes.len;) {
|
||||
peg_call_reset(&c);
|
||||
const uint8_t *result = peg_rule(&c.s, c.s.bytecode, c.bytes.bytes + i);
|
||||
if (NULL != result) {
|
||||
if (trail < i) {
|
||||
janet_buffer_push_bytes(ret, c.bytes.bytes + trail, (i - trail));
|
||||
trail = i;
|
||||
}
|
||||
int32_t nexti = (int32_t)(result - c.bytes.bytes);
|
||||
janet_buffer_push_bytes(ret, c.repl.bytes, c.repl.len);
|
||||
trail = nexti;
|
||||
if (nexti == i) nexti++;
|
||||
i = nexti;
|
||||
if (only_one) break;
|
||||
} else {
|
||||
i++;
|
||||
}
|
||||
}
|
||||
if (trail < c.bytes.len) {
|
||||
janet_buffer_push_bytes(ret, c.bytes.bytes + trail, (c.bytes.len - trail));
|
||||
}
|
||||
return janet_wrap_buffer(ret);
|
||||
}
|
||||
|
||||
static Janet cfun_peg_replace_all(int32_t argc, Janet *argv) {
|
||||
return cfun_peg_replace_generic(argc, argv, 0);
|
||||
}
|
||||
|
||||
static Janet cfun_peg_replace(int32_t argc, Janet *argv) {
|
||||
return cfun_peg_replace_generic(argc, argv, 1);
|
||||
}
|
||||
|
||||
static JanetMethod peg_methods[] = {
|
||||
{"match", cfun_peg_match},
|
||||
{"find", cfun_peg_find},
|
||||
{"find-all", cfun_peg_find_all},
|
||||
{"replace", cfun_peg_replace},
|
||||
{"replace-all", cfun_peg_replace_all},
|
||||
{NULL, NULL}
|
||||
};
|
||||
|
||||
static int cfun_peg_getter(JanetAbstract a, Janet key, Janet *out) {
|
||||
(void) a;
|
||||
if (janet_keyeq(key, "match")) {
|
||||
*out = janet_wrap_cfunction(cfun_peg_match);
|
||||
return 1;
|
||||
}
|
||||
return 0;
|
||||
if (!janet_checktype(key, JANET_KEYWORD))
|
||||
return 0;
|
||||
return janet_getmethod(janet_unwrap_keyword(key), peg_methods, out);
|
||||
}
|
||||
|
||||
static const JanetReg peg_cfuns[] = {
|
||||
@@ -1364,6 +1539,27 @@ static const JanetReg peg_cfuns[] = {
|
||||
"Match a Parsing Expression Grammar to a byte string and return an array of captured values. "
|
||||
"Returns nil if text does not match the language defined by peg. The syntax of PEGs is documented on the Janet website.")
|
||||
},
|
||||
{
|
||||
"peg/find", cfun_peg_find,
|
||||
JDOC("(peg/find peg text &opt start & args)\n\n"
|
||||
"Find first index where the peg matches in text. Returns an integer, or nil if not found.")
|
||||
},
|
||||
{
|
||||
"peg/find-all", cfun_peg_find_all,
|
||||
JDOC("(peg/find-all peg text &opt start & args)\n\n"
|
||||
"Find all indexes where the peg matches in text. Returns an array of integers.")
|
||||
},
|
||||
{
|
||||
"peg/replace", cfun_peg_replace,
|
||||
JDOC("(peg/replace peg repl text &opt start & args)\n\n"
|
||||
"Replace first match of peg in text with repl, returning a new buffer. The peg does not need to make captures to do replacement. "
|
||||
"If no matches are found, returns the input string in a new buffer.")
|
||||
},
|
||||
{
|
||||
"peg/replace-all", cfun_peg_replace_all,
|
||||
JDOC("(peg/replace-all peg repl text &opt start & args)\n\n"
|
||||
"Replace all matches of peg in text with repl, returning a new buffer. The peg does not need to make captures to do replacement.")
|
||||
},
|
||||
{NULL, NULL, NULL}
|
||||
};
|
||||
|
||||
|
||||
@@ -39,11 +39,9 @@
|
||||
|
||||
static void number_to_string_b(JanetBuffer *buffer, double x) {
|
||||
janet_buffer_ensure(buffer, buffer->count + BUFSIZE, 2);
|
||||
/* Use int32_t range for valid integers because that is the
|
||||
* range most integer-expecting functions in the C api use. */
|
||||
const char *fmt = (x == floor(x) &&
|
||||
x <= ((double) INT32_MAX) &&
|
||||
x >= ((double) INT32_MIN)) ? "%.0f" : "%g";
|
||||
x <= JANET_INTMAX_DOUBLE &&
|
||||
x >= JANET_INTMIN_DOUBLE) ? "%.0f" : "%g";
|
||||
int count = snprintf((char *) buffer->data + buffer->count, BUFSIZE, fmt, x);
|
||||
buffer->count += count;
|
||||
}
|
||||
@@ -123,9 +121,6 @@ static void string_description_b(JanetBuffer *buffer, const char *title, void *p
|
||||
#undef POINTSIZE
|
||||
}
|
||||
|
||||
#undef HEX
|
||||
#undef BUFSIZE
|
||||
|
||||
static void janet_escape_string_impl(JanetBuffer *buffer, const uint8_t *str, int32_t len) {
|
||||
janet_buffer_push_u8(buffer, '"');
|
||||
for (int32_t i = 0; i < len; ++i) {
|
||||
@@ -191,7 +186,7 @@ static void janet_escape_buffer_b(JanetBuffer *buffer, JanetBuffer *bx) {
|
||||
void janet_to_string_b(JanetBuffer *buffer, Janet x) {
|
||||
switch (janet_type(x)) {
|
||||
case JANET_NIL:
|
||||
janet_buffer_push_cstring(buffer, "nil");
|
||||
janet_buffer_push_cstring(buffer, "");
|
||||
break;
|
||||
case JANET_BOOLEAN:
|
||||
janet_buffer_push_cstring(buffer,
|
||||
@@ -280,6 +275,9 @@ void janet_description_b(JanetBuffer *buffer, Janet x) {
|
||||
switch (janet_type(x)) {
|
||||
default:
|
||||
break;
|
||||
case JANET_NIL:
|
||||
janet_buffer_push_cstring(buffer, "nil");
|
||||
return;
|
||||
case JANET_KEYWORD:
|
||||
janet_buffer_push_u8(buffer, ':');
|
||||
break;
|
||||
@@ -354,12 +352,16 @@ static int print_jdn_one(struct pretty *S, Janet x, int depth) {
|
||||
if (depth == 0) return 1;
|
||||
switch (janet_type(x)) {
|
||||
case JANET_NIL:
|
||||
case JANET_NUMBER:
|
||||
case JANET_BOOLEAN:
|
||||
case JANET_BUFFER:
|
||||
case JANET_STRING:
|
||||
janet_description_b(S->buffer, x);
|
||||
break;
|
||||
case JANET_NUMBER:
|
||||
janet_buffer_ensure(S->buffer, S->buffer->count + BUFSIZE, 2);
|
||||
int count = snprintf((char *) S->buffer->data + S->buffer->count, BUFSIZE, "%.17g", janet_unwrap_number(x));
|
||||
S->buffer->count += count;
|
||||
break;
|
||||
case JANET_SYMBOL:
|
||||
case JANET_KEYWORD:
|
||||
if (contains_bad_chars(janet_unwrap_keyword(x), janet_type(x) == JANET_SYMBOL)) return 1;
|
||||
@@ -452,7 +454,7 @@ static const char *janet_pretty_colors[] = {
|
||||
"\x1B[36m",
|
||||
"\x1B[36m",
|
||||
"\x1B[36m",
|
||||
"\x1B[36m"
|
||||
"\x1B[36m",
|
||||
"\x1B[35m",
|
||||
"\x1B[36m",
|
||||
"\x1B[36m",
|
||||
@@ -953,6 +955,9 @@ void janet_buffer_format(
|
||||
janet_description_b(b, argv[arg]);
|
||||
break;
|
||||
}
|
||||
case 't':
|
||||
janet_buffer_push_cstring(b, typestr(argv[arg]));
|
||||
break;
|
||||
case 'M':
|
||||
case 'm':
|
||||
case 'N':
|
||||
@@ -994,3 +999,6 @@ void janet_buffer_format(
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
#undef HEX
|
||||
#undef BUFSIZE
|
||||
|
||||
@@ -23,7 +23,6 @@
|
||||
#ifndef JANET_AMALG
|
||||
#include "features.h"
|
||||
#include <janet.h>
|
||||
#include "state.h"
|
||||
#endif
|
||||
|
||||
/* Run a string */
|
||||
@@ -56,9 +55,10 @@ int janet_dobytes(JanetTable *env, const uint8_t *bytes, int32_t len, const char
|
||||
done = 1;
|
||||
}
|
||||
} else {
|
||||
ret = janet_wrap_string(cres.error);
|
||||
if (cres.macrofiber) {
|
||||
janet_eprintf("compile error in %s: ", sourcePath);
|
||||
janet_stacktrace(cres.macrofiber, janet_wrap_string(cres.error));
|
||||
janet_stacktrace(cres.macrofiber, ret);
|
||||
} else {
|
||||
janet_eprintf("compile error in %s: %s\n", sourcePath,
|
||||
(const char *)cres.error);
|
||||
@@ -68,25 +68,23 @@ int janet_dobytes(JanetTable *env, const uint8_t *bytes, int32_t len, const char
|
||||
}
|
||||
}
|
||||
|
||||
if (done) break;
|
||||
|
||||
/* Dispatch based on parse state */
|
||||
switch (janet_parser_status(&parser)) {
|
||||
case JANET_PARSE_DEAD:
|
||||
done = 1;
|
||||
break;
|
||||
case JANET_PARSE_ERROR:
|
||||
case JANET_PARSE_ERROR: {
|
||||
const char *e = janet_parser_error(&parser);
|
||||
errflags |= 0x04;
|
||||
janet_eprintf("parse error in %s: %s\n",
|
||||
sourcePath, janet_parser_error(&parser));
|
||||
ret = janet_cstringv(e);
|
||||
janet_eprintf("parse error in %s: %s\n", sourcePath, e);
|
||||
done = 1;
|
||||
break;
|
||||
case JANET_PARSE_PENDING:
|
||||
if (index == len) {
|
||||
janet_parser_eof(&parser);
|
||||
} else {
|
||||
janet_parser_consume(&parser, bytes[index++]);
|
||||
}
|
||||
break;
|
||||
}
|
||||
case JANET_PARSE_ROOT:
|
||||
case JANET_PARSE_PENDING:
|
||||
if (index >= len) {
|
||||
janet_parser_eof(&parser);
|
||||
} else {
|
||||
|
||||
@@ -649,6 +649,7 @@ static JanetSlot janetc_while(JanetFopts opts, int32_t argn, const Janet *argv)
|
||||
/* Compile function */
|
||||
JanetFuncDef *def = janetc_pop_funcdef(c);
|
||||
def->name = janet_cstring("_while");
|
||||
janet_def_addflags(def);
|
||||
int32_t defindex = janetc_addfuncdef(c, def);
|
||||
/* And then load the closure and call it. */
|
||||
int32_t cloreg = janetc_regalloc_temp(&c->scope->ra, JANETC_REGTEMP_0);
|
||||
@@ -823,6 +824,7 @@ static JanetSlot janetc_fn(JanetFopts opts, int32_t argn, const Janet *argv) {
|
||||
if (structarg) def->flags |= JANET_FUNCDEF_FLAG_STRUCTARG;
|
||||
|
||||
if (selfref) def->name = janet_unwrap_symbol(head);
|
||||
janet_def_addflags(def);
|
||||
defindex = janetc_addfuncdef(c, def);
|
||||
|
||||
/* Ensure enough slots for vararg function. */
|
||||
|
||||
@@ -34,6 +34,9 @@
|
||||
|
||||
typedef struct JanetScratch JanetScratch;
|
||||
|
||||
/* Top level dynamic bindings */
|
||||
extern JANET_THREAD_LOCAL JanetTable *janet_vm_top_dyns;
|
||||
|
||||
/* Cache the core environment */
|
||||
extern JANET_THREAD_LOCAL JanetTable *janet_vm_core_env;
|
||||
|
||||
@@ -68,6 +71,7 @@ extern JANET_THREAD_LOCAL uint32_t janet_vm_cache_deleted;
|
||||
extern JANET_THREAD_LOCAL void *janet_vm_blocks;
|
||||
extern JANET_THREAD_LOCAL size_t janet_vm_gc_interval;
|
||||
extern JANET_THREAD_LOCAL size_t janet_vm_next_collection;
|
||||
extern JANET_THREAD_LOCAL size_t janet_vm_block_count;
|
||||
extern JANET_THREAD_LOCAL int janet_vm_gc_suspend;
|
||||
|
||||
/* GC roots */
|
||||
@@ -97,4 +101,14 @@ void janet_threads_init(void);
|
||||
void janet_threads_deinit(void);
|
||||
#endif
|
||||
|
||||
#ifdef JANET_NET
|
||||
void janet_net_init(void);
|
||||
void janet_net_deinit(void);
|
||||
#endif
|
||||
|
||||
#ifdef JANET_EV
|
||||
void janet_ev_init(void);
|
||||
void janet_ev_deinit(void);
|
||||
#endif
|
||||
|
||||
#endif /* JANET_STATE_H_defined */
|
||||
|
||||
@@ -62,7 +62,7 @@ int janet_string_compare(const uint8_t *lhs, const uint8_t *rhs) {
|
||||
int32_t ylen = janet_string_length(rhs);
|
||||
int32_t len = xlen > ylen ? ylen : xlen;
|
||||
int res = memcmp(lhs, rhs, len);
|
||||
if (res) return res;
|
||||
if (res) return res > 0 ? 1 : -1;
|
||||
if (xlen == ylen) return 0;
|
||||
return xlen < ylen ? -1 : 1;
|
||||
}
|
||||
@@ -176,6 +176,18 @@ static Janet cfun_string_slice(int32_t argc, Janet *argv) {
|
||||
return janet_stringv(view.bytes + range.start, range.end - range.start);
|
||||
}
|
||||
|
||||
static Janet cfun_symbol_slice(int32_t argc, Janet *argv) {
|
||||
JanetByteView view = janet_getbytes(argv, 0);
|
||||
JanetRange range = janet_getslice(argc, argv);
|
||||
return janet_symbolv(view.bytes + range.start, range.end - range.start);
|
||||
}
|
||||
|
||||
static Janet cfun_keyword_slice(int32_t argc, Janet *argv) {
|
||||
JanetByteView view = janet_getbytes(argv, 0);
|
||||
JanetRange range = janet_getslice(argc, argv);
|
||||
return janet_keywordv(view.bytes + range.start, range.end - range.start);
|
||||
}
|
||||
|
||||
static Janet cfun_string_repeat(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 2);
|
||||
JanetByteView view = janet_getbytes(argv, 0);
|
||||
@@ -529,6 +541,16 @@ static const JanetReg string_cfuns[] = {
|
||||
"from the end of the string. Note that index -1 is synonymous with "
|
||||
"index (length bytes) to allow a full negative slice range. ")
|
||||
},
|
||||
{
|
||||
"keyword/slice", cfun_keyword_slice,
|
||||
JDOC("(keyword/slice bytes &opt start end)\n\n"
|
||||
"Same a string/slice, but returns a keyword.")
|
||||
},
|
||||
{
|
||||
"symbol/slice", cfun_symbol_slice,
|
||||
JDOC("(symbol/slice bytes &opt start end)\n\n"
|
||||
"Same a string/slice, but returns a symbol.")
|
||||
},
|
||||
{
|
||||
"string/repeat", cfun_string_repeat,
|
||||
JDOC("(string/repeat bytes n)\n\n"
|
||||
|
||||
@@ -173,7 +173,7 @@ Janet janet_table_rawget(JanetTable *t, Janet key) {
|
||||
Janet janet_table_remove(JanetTable *t, Janet key) {
|
||||
JanetKV *bucket = janet_table_find(t, key);
|
||||
if (NULL != bucket && !janet_checktype(bucket->key, JANET_NIL)) {
|
||||
Janet ret = bucket->key;
|
||||
Janet ret = bucket->value;
|
||||
t->count--;
|
||||
t->deleted++;
|
||||
bucket->key = janet_wrap_nil();
|
||||
@@ -256,7 +256,7 @@ static void janet_table_mergekv(JanetTable *table, const JanetKV *kvs, int32_t c
|
||||
}
|
||||
}
|
||||
|
||||
/* Merge a table other into another table */
|
||||
/* Merge a table into another table */
|
||||
void janet_table_merge_table(JanetTable *table, JanetTable *other) {
|
||||
janet_table_mergekv(table, other->data, other->capacity);
|
||||
}
|
||||
|
||||
@@ -234,7 +234,7 @@ static void janet_waiter_init(JanetWaiter *waiter, double sec) {
|
||||
if (waiter->timedwait) {
|
||||
/* N seconds -> timespec of (now + sec) */
|
||||
struct timespec now;
|
||||
clock_gettime(CLOCK_REALTIME, &now);
|
||||
janet_gettime(&now);
|
||||
time_t tvsec = (time_t) floor(sec);
|
||||
long tvnsec = (long) floor(1000000000.0 * (sec - ((double) tvsec)));
|
||||
tvsec += now.tv_sec;
|
||||
@@ -375,8 +375,12 @@ int janet_thread_receive(Janet *msg_out, double timeout) {
|
||||
|
||||
/* Handle errors */
|
||||
if (setjmp(buf)) {
|
||||
/* Cleanup jmp_buf, keep lock */
|
||||
/* Cleanup jmp_buf, return error.
|
||||
* Do not ignore bad messages as before. */
|
||||
janet_vm_jmp_buf = old_buf;
|
||||
*msg_out = *janet_vm_return_reg;
|
||||
janet_mailbox_unlock(mailbox);
|
||||
return 2;
|
||||
} else {
|
||||
JanetBuffer *msgbuf = mailbox->messages + mailbox->messageFirst;
|
||||
mailbox->messageCount--;
|
||||
@@ -411,7 +415,6 @@ int janet_thread_receive(Janet *msg_out, double timeout) {
|
||||
return 1;
|
||||
}
|
||||
}
|
||||
|
||||
}
|
||||
|
||||
static int janet_thread_getter(void *p, Janet key, Janet *out);
|
||||
@@ -499,6 +502,10 @@ static int thread_worker(JanetMailboxPair *pair) {
|
||||
/* Call function */
|
||||
Janet argv[1] = { parentv };
|
||||
fiber = janet_fiber(func, 64, 1, argv);
|
||||
if (pair->flags & JANET_THREAD_HEAVYWEIGHT) {
|
||||
fiber->env = janet_table(0);
|
||||
fiber->env->proto = janet_core_env(NULL);
|
||||
}
|
||||
JanetSignal sig = janet_continue(fiber, janet_wrap_nil(), &out);
|
||||
if (sig != JANET_SIGNAL_OK && sig < JANET_SIGNAL_USER0) {
|
||||
janet_eprintf("in thread %v: ", janet_wrap_abstract(janet_make_thread(pair->newbox, encode)));
|
||||
@@ -578,6 +585,14 @@ void janet_threads_deinit(void) {
|
||||
janet_vm_thread_decode = NULL;
|
||||
}
|
||||
|
||||
JanetThread *janet_thread_current(void) {
|
||||
if (NULL == janet_vm_thread_current) {
|
||||
janet_vm_thread_current = janet_make_thread(janet_vm_mailbox, janet_get_core_table("make-image-dict"));
|
||||
janet_gcroot(janet_wrap_abstract(janet_vm_thread_current));
|
||||
}
|
||||
return janet_vm_thread_current;
|
||||
}
|
||||
|
||||
/*
|
||||
* Cfuns
|
||||
*/
|
||||
@@ -585,11 +600,7 @@ void janet_threads_deinit(void) {
|
||||
static Janet cfun_thread_current(int32_t argc, Janet *argv) {
|
||||
(void) argv;
|
||||
janet_fixarity(argc, 0);
|
||||
if (NULL == janet_vm_thread_current) {
|
||||
janet_vm_thread_current = janet_make_thread(janet_vm_mailbox, janet_get_core_table("make-image-dict"));
|
||||
janet_gcroot(janet_wrap_abstract(janet_vm_thread_current));
|
||||
}
|
||||
return janet_wrap_abstract(janet_vm_thread_current);
|
||||
return janet_wrap_abstract(janet_thread_current());
|
||||
}
|
||||
|
||||
static Janet cfun_thread_new(int32_t argc, Janet *argv) {
|
||||
@@ -660,6 +671,8 @@ static Janet cfun_thread_receive(int32_t argc, Janet *argv) {
|
||||
break;
|
||||
case 1:
|
||||
janet_panicf("timeout after %f seconds", wait);
|
||||
case 2:
|
||||
janet_panicf("failed to receive message: %v", out);
|
||||
}
|
||||
return out;
|
||||
}
|
||||
@@ -671,6 +684,18 @@ static Janet cfun_thread_close(int32_t argc, Janet *argv) {
|
||||
return janet_wrap_nil();
|
||||
}
|
||||
|
||||
static Janet cfun_thread_exit(int32_t argc, Janet *argv) {
|
||||
(void) argv;
|
||||
janet_arity(argc, 0, 1);
|
||||
#if defined(JANET_WINDOWS)
|
||||
int32_t flag = janet_optinteger(argv, argc, 0, 0);
|
||||
ExitThread(flag);
|
||||
#else
|
||||
pthread_exit(NULL);
|
||||
#endif
|
||||
return janet_wrap_nil();
|
||||
}
|
||||
|
||||
static const JanetMethod janet_thread_methods[] = {
|
||||
{"send", cfun_thread_send},
|
||||
{"close", cfun_thread_close},
|
||||
@@ -703,15 +728,18 @@ static const JanetReg threadlib_cfuns[] = {
|
||||
},
|
||||
{
|
||||
"thread/send", cfun_thread_send,
|
||||
JDOC("(thread/send thread msg)\n\n"
|
||||
"Send a message to the thread. This will never block and returns thread immediately. "
|
||||
JDOC("(thread/send thread msgi &opt timeout)\n\n"
|
||||
"Send a message to the thread. By default, the timeout is 1 second, but an optional timeout "
|
||||
"in seconds can be provided. Use math/inf for no timeout. "
|
||||
"Will throw an error if there is a problem sending the message.")
|
||||
},
|
||||
{
|
||||
"thread/receive", cfun_thread_receive,
|
||||
JDOC("(thread/receive &opt timeout)\n\n"
|
||||
"Get a message sent to this thread. If timeout is provided, an error will be thrown after the timeout has elapsed but "
|
||||
"no messages are received.")
|
||||
"Get a message sent to this thread. If timeout (in seconds) is provided, an error "
|
||||
"will be thrown after the timeout has elapsed but "
|
||||
"no messages are received. The default timeout is 1 second, and math/inf cam be passed to "
|
||||
"turn off the timeout.")
|
||||
},
|
||||
{
|
||||
"thread/close", cfun_thread_close,
|
||||
@@ -719,6 +747,12 @@ static const JanetReg threadlib_cfuns[] = {
|
||||
"Close a thread, unblocking it and ending communication with it. Note that closing "
|
||||
"a thread is idempotent and does not cancel the thread's operation. Returns nil.")
|
||||
},
|
||||
{
|
||||
"thread/exit", cfun_thread_exit,
|
||||
JDOC("(thread/exit &opt code)\n\n"
|
||||
"Exit from the current thread. If no more threads are running, ends the process, but otherwise does "
|
||||
"not end the current process.")
|
||||
},
|
||||
{NULL, NULL, NULL}
|
||||
};
|
||||
|
||||
|
||||
@@ -376,21 +376,29 @@ static Janet cfun_typed_array_new(int32_t argc, Janet *argv) {
|
||||
if (argc > 3)
|
||||
offset = janet_getsize(argv, 3);
|
||||
if (argc > 4) {
|
||||
if (!janet_checktype(argv[4], JANET_ABSTRACT)) {
|
||||
janet_panicf("bad slot #%d, expected ta/view|ta/buffer, got %v",
|
||||
4, argv[4]);
|
||||
}
|
||||
void *p = janet_unwrap_abstract(argv[4]);
|
||||
if (janet_abstract_type(p) == &janet_ta_view_type) {
|
||||
JanetTArrayView *view = (JanetTArrayView *)p;
|
||||
offset = (view->buffer->data - view->as.u8) + offset * ta_type_sizes[view->type];
|
||||
stride *= view->stride;
|
||||
buffer = view->buffer;
|
||||
} else if (janet_abstract_type(p) == &janet_ta_buffer_type) {
|
||||
buffer = p;
|
||||
int32_t blen;
|
||||
const uint8_t *bytes;
|
||||
if (janet_bytes_view(argv[4], &bytes, &blen)) {
|
||||
buffer = janet_abstract(&janet_ta_buffer_type, sizeof(JanetTArrayBuffer));
|
||||
ta_buffer_init(buffer, (size_t) blen);
|
||||
memcpy(buffer->data, bytes, blen);
|
||||
} else {
|
||||
janet_panicf("bad slot #%d, expected ta/view|ta/buffer, got %v",
|
||||
4, argv[4]);
|
||||
if (!janet_checktype(argv[4], JANET_ABSTRACT)) {
|
||||
janet_panicf("bad slot #%d, expected ta/view|ta/buffer, got %v",
|
||||
4, argv[4]);
|
||||
}
|
||||
void *p = janet_unwrap_abstract(argv[4]);
|
||||
if (janet_abstract_type(p) == &janet_ta_view_type) {
|
||||
JanetTArrayView *view = (JanetTArrayView *)p;
|
||||
offset = (view->buffer->data - view->as.u8) + offset * ta_type_sizes[view->type];
|
||||
stride *= view->stride;
|
||||
buffer = view->buffer;
|
||||
} else if (janet_abstract_type(p) == &janet_ta_buffer_type) {
|
||||
buffer = p;
|
||||
} else {
|
||||
janet_panicf("bad slot #%d, expected ta/view|ta/buffer, got %v",
|
||||
4, argv[4]);
|
||||
}
|
||||
}
|
||||
}
|
||||
JanetTArrayView *view = janet_tarray_view(type, size, stride, offset, buffer);
|
||||
|
||||
108
src/core/util.c
108
src/core/util.c
@@ -26,6 +26,14 @@
|
||||
#include "util.h"
|
||||
#include "state.h"
|
||||
#include "gc.h"
|
||||
#ifdef JANET_WINDOWS
|
||||
#include <windows.h>
|
||||
#else
|
||||
#include <unistd.h>
|
||||
#include <sys/types.h>
|
||||
#include <sys/stat.h>
|
||||
#include <fcntl.h>
|
||||
#endif
|
||||
#endif
|
||||
|
||||
#include <inttypes.h>
|
||||
@@ -94,7 +102,7 @@ const char *const janet_status_names[16] = {
|
||||
"alive"
|
||||
};
|
||||
|
||||
#ifdef JANET_NO_PRF
|
||||
#ifndef JANET_PRF
|
||||
|
||||
int32_t janet_string_calchash(const uint8_t *str, int32_t len) {
|
||||
const uint8_t *end = str + len;
|
||||
@@ -441,7 +449,8 @@ void janet_cfuns(JanetTable *env, const char *regprefix, const JanetReg *cfuns)
|
||||
|
||||
void janet_register_abstract_type(const JanetAbstractType *at) {
|
||||
Janet sym = janet_csymbolv(at->name);
|
||||
if (!(janet_checktype(janet_table_get(janet_vm_abstract_registry, sym), JANET_NIL))) {
|
||||
Janet check = janet_table_get(janet_vm_abstract_registry, sym);
|
||||
if (!janet_checktype(check, JANET_NIL) && at != janet_unwrap_pointer(check)) {
|
||||
janet_panicf("cannot register abstract type %s, "
|
||||
"a type with the same name exists", at->name);
|
||||
}
|
||||
@@ -574,8 +583,12 @@ int janet_checksize(Janet x) {
|
||||
if (!janet_checktype(x, JANET_NUMBER))
|
||||
return 0;
|
||||
double dval = janet_unwrap_number(x);
|
||||
return dval == (double)((size_t) dval) &&
|
||||
dval <= SIZE_MAX;
|
||||
if (dval != (double)((size_t) dval)) return 0;
|
||||
if (SIZE_MAX > JANET_INTMAX_INT64) {
|
||||
return dval <= JANET_INTMAX_INT64;
|
||||
} else {
|
||||
return dval <= SIZE_MAX;
|
||||
}
|
||||
}
|
||||
|
||||
JanetTable *janet_get_core_table(const char *name) {
|
||||
@@ -586,3 +599,90 @@ JanetTable *janet_get_core_table(const char *name) {
|
||||
if (!janet_checktype(out, JANET_TABLE)) return NULL;
|
||||
return janet_unwrap_table(out);
|
||||
}
|
||||
|
||||
/* Clock shims for various platforms */
|
||||
#ifdef JANET_GETTIME
|
||||
/* For macos */
|
||||
#ifdef __MACH__
|
||||
#include <mach/clock.h>
|
||||
#include <mach/mach.h>
|
||||
#endif
|
||||
#ifdef JANET_WINDOWS
|
||||
int janet_gettime(struct timespec *spec) {
|
||||
FILETIME ftime;
|
||||
GetSystemTimeAsFileTime(&ftime);
|
||||
int64_t wintime = (int64_t)(ftime.dwLowDateTime) | ((int64_t)(ftime.dwHighDateTime) << 32);
|
||||
/* Windows epoch is January 1, 1601 apparently */
|
||||
wintime -= 116444736000000000LL;
|
||||
spec->tv_sec = wintime / 10000000LL;
|
||||
/* Resolution is 100 nanoseconds. */
|
||||
spec->tv_nsec = wintime % 10000000LL * 100;
|
||||
return 0;
|
||||
}
|
||||
#elif defined(__MACH__)
|
||||
int janet_gettime(struct timespec *spec) {
|
||||
clock_serv_t cclock;
|
||||
mach_timespec_t mts;
|
||||
host_get_clock_service(mach_host_self(), CALENDAR_CLOCK, &cclock);
|
||||
clock_get_time(cclock, &mts);
|
||||
mach_port_deallocate(mach_task_self(), cclock);
|
||||
spec->tv_sec = mts.tv_sec;
|
||||
spec->tv_nsec = mts.tv_nsec;
|
||||
return 0;
|
||||
}
|
||||
#else
|
||||
int janet_gettime(struct timespec *spec) {
|
||||
return clock_gettime(CLOCK_REALTIME, spec);
|
||||
}
|
||||
#endif
|
||||
#endif
|
||||
|
||||
/* Setting C99 standard makes this not available, but it should
|
||||
* work/link properly if we detect a BSD */
|
||||
#if defined(JANET_BSD) || defined(MAC_OS_X_VERSION_10_7)
|
||||
void arc4random_buf(void *buf, size_t nbytes);
|
||||
#endif
|
||||
|
||||
int janet_cryptorand(uint8_t *out, size_t n) {
|
||||
#ifdef JANET_WINDOWS
|
||||
for (size_t i = 0; i < n; i += sizeof(unsigned int)) {
|
||||
unsigned int v;
|
||||
if (rand_s(&v))
|
||||
return -1;
|
||||
for (int32_t j = 0; (j < sizeof(unsigned int)) && (i + j < n); j++) {
|
||||
out[i + j] = v & 0xff;
|
||||
v = v >> 8;
|
||||
}
|
||||
}
|
||||
return 0;
|
||||
#elif defined(JANET_LINUX) || ( defined(JANET_APPLE) && !defined(MAC_OS_X_VERSION_10_7) )
|
||||
/* We should be able to call getrandom on linux, but it doesn't seem
|
||||
to be uniformly supported on linux distros.
|
||||
On Mac, arc4random_buf wasn't available on until 10.7.
|
||||
In these cases, use this fallback path for now... */
|
||||
int rc;
|
||||
int randfd;
|
||||
RETRY_EINTR(randfd, open("/dev/urandom", O_RDONLY | O_CLOEXEC));
|
||||
if (randfd < 0)
|
||||
return -1;
|
||||
while (n > 0) {
|
||||
ssize_t nread;
|
||||
RETRY_EINTR(nread, read(randfd, out, n));
|
||||
if (nread <= 0) {
|
||||
RETRY_EINTR(rc, close(randfd));
|
||||
return -1;
|
||||
}
|
||||
out += nread;
|
||||
n -= nread;
|
||||
}
|
||||
RETRY_EINTR(rc, close(randfd));
|
||||
return 0;
|
||||
#elif defined(JANET_BSD) || defined(MAC_OS_X_VERSION_10_7)
|
||||
arc4random_buf(out, n);
|
||||
return 0;
|
||||
#else
|
||||
(void) n;
|
||||
(void) out;
|
||||
return -1;
|
||||
#endif
|
||||
}
|
||||
|
||||
@@ -31,6 +31,11 @@
|
||||
#include <stdio.h>
|
||||
#include <errno.h>
|
||||
|
||||
#if !defined(JANET_REDUCED_OS) || !defined(JANET_SINGLE_THREADED)
|
||||
#include <time.h>
|
||||
#define JANET_GETTIME
|
||||
#endif
|
||||
|
||||
/* Handle runtime errors */
|
||||
#ifndef JANET_EXIT
|
||||
#include <stdio.h>
|
||||
@@ -71,10 +76,10 @@ int32_t janet_tablen(int32_t n);
|
||||
void safe_memcpy(void *dest, const void *src, size_t len);
|
||||
void janet_buffer_push_types(JanetBuffer *buffer, int types);
|
||||
const JanetKV *janet_dict_find(const JanetKV *buckets, int32_t cap, Janet key);
|
||||
Janet janet_dict_get(const JanetKV *buckets, int32_t cap, Janet key);
|
||||
void janet_memempty(JanetKV *mem, int32_t count);
|
||||
void *janet_memalloc_empty(int32_t count);
|
||||
JanetTable *janet_get_core_table(const char *name);
|
||||
void janet_def_addflags(JanetFuncDef *def);
|
||||
const void *janet_strbinsearch(
|
||||
const void *tab,
|
||||
size_t tabcount,
|
||||
@@ -97,6 +102,13 @@ void janet_core_def(JanetTable *env, const char *name, Janet x, const void *p);
|
||||
void janet_core_cfuns(JanetTable *env, const char *regprefix, const JanetReg *cfuns);
|
||||
#endif
|
||||
|
||||
/* Clock gettime */
|
||||
#ifdef JANET_GETTIME
|
||||
int janet_gettime(struct timespec *spec);
|
||||
#endif
|
||||
|
||||
#define RETRY_EINTR(RC, CALL) do { (RC) = CALL; } while((RC) < 0 && errno == EINTR)
|
||||
|
||||
/* Initialize builtin libraries */
|
||||
void janet_lib_io(JanetTable *env);
|
||||
void janet_lib_math(JanetTable *env);
|
||||
@@ -128,8 +140,11 @@ void janet_lib_thread(JanetTable *env);
|
||||
#endif
|
||||
#ifdef JANET_NET
|
||||
void janet_lib_net(JanetTable *env);
|
||||
void janet_net_deinit(void);
|
||||
void janet_net_markloop(void);
|
||||
extern const JanetAbstractType janet_address_type;
|
||||
#endif
|
||||
#ifdef JANET_EV
|
||||
void janet_lib_ev(JanetTable *env);
|
||||
void janet_ev_mark(void);
|
||||
#endif
|
||||
|
||||
#endif
|
||||
|
||||
@@ -271,14 +271,12 @@ int32_t janet_hash(Janet x) {
|
||||
}
|
||||
/* fallthrough */
|
||||
default:
|
||||
/* TODO - test performance with different hash functions */
|
||||
if (sizeof(double) == sizeof(void *)) {
|
||||
/* Assuming 8 byte pointer */
|
||||
uint64_t i = janet_u64(x);
|
||||
hash = (int32_t)(i & 0xFFFFFFFF);
|
||||
/* Get a bit more entropy by shifting the low bits out */
|
||||
hash >>= 3;
|
||||
hash ^= (int32_t)(i >> 32);
|
||||
uint32_t lo = (uint32_t)(i & 0xFFFFFFFF);
|
||||
uint32_t hi = (uint32_t)(i >> 32);
|
||||
hash = (int32_t)(hi ^ (lo >> 3));
|
||||
} else {
|
||||
/* Assuming 4 byte pointer (or smaller) */
|
||||
hash = (int32_t)((char *)janet_unwrap_pointer(x) - (char *)0);
|
||||
|
||||
159
src/core/vm.c
159
src/core/vm.c
@@ -33,6 +33,7 @@
|
||||
#include <math.h>
|
||||
|
||||
/* VM state */
|
||||
JANET_THREAD_LOCAL JanetTable *janet_vm_top_dyns;
|
||||
JANET_THREAD_LOCAL JanetTable *janet_vm_core_env;
|
||||
JANET_THREAD_LOCAL JanetTable *janet_vm_registry;
|
||||
JANET_THREAD_LOCAL JanetTable *janet_vm_abstract_registry;
|
||||
@@ -94,6 +95,10 @@ JANET_THREAD_LOCAL jmp_buf *janet_vm_jmp_buf = NULL;
|
||||
vm_commit(); \
|
||||
return (sig); \
|
||||
} while (0)
|
||||
#define vm_return_no_restore(sig, val) do { \
|
||||
janet_vm_return_reg[0] = (val); \
|
||||
return (sig); \
|
||||
} while (0)
|
||||
|
||||
/* Next instruction variations */
|
||||
#define maybe_collect() do {\
|
||||
@@ -373,9 +378,9 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in) {
|
||||
&&label_JOP_GREATER_THAN_EQUAL,
|
||||
&&label_JOP_LESS_THAN_EQUAL,
|
||||
&&label_JOP_NEXT,
|
||||
&&label_unknown_op,
|
||||
&&label_unknown_op,
|
||||
&&label_unknown_op,
|
||||
&&label_JOP_NOT_EQUALS,
|
||||
&&label_JOP_NOT_EQUALS_IMMEDIATE,
|
||||
&&label_JOP_CANCEL,
|
||||
&&label_unknown_op,
|
||||
&&label_unknown_op,
|
||||
&&label_unknown_op,
|
||||
@@ -563,6 +568,15 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in) {
|
||||
register Janet *stack;
|
||||
register uint32_t *pc;
|
||||
register JanetFunction *func;
|
||||
|
||||
if (fiber->flags & JANET_FIBER_RESUME_SIGNAL) {
|
||||
JanetSignal sig = (fiber->gc.flags & JANET_FIBER_STATUS_MASK) >> JANET_FIBER_STATUS_OFFSET;
|
||||
fiber->gc.flags &= ~JANET_FIBER_STATUS_MASK;
|
||||
fiber->flags &= ~(JANET_FIBER_RESUME_SIGNAL | JANET_FIBER_FLAG_MASK);
|
||||
janet_vm_return_reg[0] = in;
|
||||
return sig;
|
||||
}
|
||||
|
||||
vm_restore();
|
||||
|
||||
if (fiber->flags & JANET_FIBER_DID_LONGJUMP) {
|
||||
@@ -613,7 +627,7 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in) {
|
||||
Janet retval = stack[D];
|
||||
int entrance_frame = janet_stack_frame(stack)->flags & JANET_STACKFRAME_ENTRANCE;
|
||||
janet_fiber_popframe(fiber);
|
||||
if (entrance_frame) vm_return(JANET_SIGNAL_OK, retval);
|
||||
if (entrance_frame) vm_return_no_restore(JANET_SIGNAL_OK, retval);
|
||||
vm_restore();
|
||||
stack[A] = retval;
|
||||
vm_checkgc_pcnext();
|
||||
@@ -623,7 +637,7 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in) {
|
||||
Janet retval = janet_wrap_nil();
|
||||
int entrance_frame = janet_stack_frame(stack)->flags & JANET_STACKFRAME_ENTRANCE;
|
||||
janet_fiber_popframe(fiber);
|
||||
if (entrance_frame) vm_return(JANET_SIGNAL_OK, retval);
|
||||
if (entrance_frame) vm_return_no_restore(JANET_SIGNAL_OK, retval);
|
||||
vm_restore();
|
||||
stack[A] = retval;
|
||||
vm_checkgc_pcnext();
|
||||
@@ -787,11 +801,20 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in) {
|
||||
stack[A] = janet_wrap_boolean(janet_unwrap_integer(stack[B]) == CS);
|
||||
vm_pcnext();
|
||||
|
||||
VM_OP(JOP_NOT_EQUALS)
|
||||
stack[A] = janet_wrap_boolean(!janet_equals(stack[B], stack[C]));
|
||||
vm_pcnext();
|
||||
|
||||
VM_OP(JOP_NOT_EQUALS_IMMEDIATE)
|
||||
stack[A] = janet_wrap_boolean(janet_unwrap_integer(stack[B]) != CS);
|
||||
vm_pcnext();
|
||||
|
||||
VM_OP(JOP_COMPARE)
|
||||
stack[A] = janet_wrap_integer(janet_compare(stack[B], stack[C]));
|
||||
vm_pcnext();
|
||||
|
||||
VM_OP(JOP_NEXT)
|
||||
vm_commit();
|
||||
stack[A] = janet_next(stack[B], stack[C]);
|
||||
vm_pcnext();
|
||||
|
||||
@@ -992,8 +1015,9 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in) {
|
||||
retreg = call_nonfn(fiber, callee);
|
||||
}
|
||||
janet_fiber_popframe(fiber);
|
||||
if (entrance_frame)
|
||||
vm_return(JANET_SIGNAL_OK, retreg);
|
||||
if (entrance_frame) {
|
||||
vm_return_no_restore(JANET_SIGNAL_OK, retreg);
|
||||
}
|
||||
vm_restore();
|
||||
stack[A] = retreg;
|
||||
vm_checkgc_pcnext();
|
||||
@@ -1040,6 +1064,25 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in) {
|
||||
vm_return((int) sub_status, stack[B]);
|
||||
}
|
||||
|
||||
VM_OP(JOP_CANCEL) {
|
||||
Janet retreg;
|
||||
vm_assert_type(stack[B], JANET_FIBER);
|
||||
JanetFiber *child = janet_unwrap_fiber(stack[B]);
|
||||
if (janet_check_can_resume(child, &retreg)) {
|
||||
vm_commit();
|
||||
janet_panicv(retreg);
|
||||
}
|
||||
fiber->child = child;
|
||||
JanetSignal sig = janet_continue_signal(child, stack[C], &retreg, JANET_SIGNAL_ERROR);
|
||||
if (sig != JANET_SIGNAL_OK && !(child->flags & (1 << sig))) {
|
||||
vm_return(sig, retreg);
|
||||
}
|
||||
fiber->child = NULL;
|
||||
stack = fiber->data + fiber->frame;
|
||||
stack[A] = retreg;
|
||||
vm_checkgc_pcnext();
|
||||
}
|
||||
|
||||
VM_OP(JOP_PUT)
|
||||
vm_commit();
|
||||
fiber->flags |= JANET_FIBER_RESUME_NO_USEVAL;
|
||||
@@ -1272,11 +1315,32 @@ static JanetSignal janet_check_can_resume(JanetFiber *fiber, Janet *out) {
|
||||
return JANET_SIGNAL_OK;
|
||||
}
|
||||
|
||||
void janet_try_init(JanetTryState *state) {
|
||||
state->stackn = janet_vm_stackn++;
|
||||
state->gc_handle = janet_vm_gc_suspend;
|
||||
state->vm_fiber = janet_vm_fiber;
|
||||
state->vm_jmp_buf = janet_vm_jmp_buf;
|
||||
state->vm_return_reg = janet_vm_return_reg;
|
||||
janet_vm_return_reg = &(state->payload);
|
||||
janet_vm_jmp_buf = &(state->buf);
|
||||
}
|
||||
|
||||
void janet_restore(JanetTryState *state) {
|
||||
janet_vm_stackn = state->stackn;
|
||||
janet_vm_gc_suspend = state->gc_handle;
|
||||
janet_vm_fiber = state->vm_fiber;
|
||||
janet_vm_jmp_buf = state->vm_jmp_buf;
|
||||
janet_vm_return_reg = state->vm_return_reg;
|
||||
}
|
||||
|
||||
static JanetSignal janet_continue_no_check(JanetFiber *fiber, Janet in, Janet *out) {
|
||||
jmp_buf buf;
|
||||
|
||||
JanetFiberStatus old_status = janet_fiber_status(fiber);
|
||||
|
||||
#ifdef JANET_EV
|
||||
janet_fiber_did_resume(fiber);
|
||||
#endif
|
||||
|
||||
/* Continue child fiber if it exists */
|
||||
if (fiber->child) {
|
||||
if (janet_vm_root_fiber == NULL) janet_vm_root_fiber = fiber;
|
||||
@@ -1306,45 +1370,21 @@ static JanetSignal janet_continue_no_check(JanetFiber *fiber, Janet in, Janet *o
|
||||
}
|
||||
|
||||
/* Save global state */
|
||||
int32_t oldn = janet_vm_stackn++;
|
||||
int handle = janet_vm_gc_suspend;
|
||||
JanetFiber *old_vm_fiber = janet_vm_fiber;
|
||||
jmp_buf *old_vm_jmp_buf = janet_vm_jmp_buf;
|
||||
Janet *old_vm_return_reg = janet_vm_return_reg;
|
||||
|
||||
/* Setup fiber */
|
||||
if (janet_vm_root_fiber == NULL) janet_vm_root_fiber = fiber;
|
||||
janet_vm_fiber = fiber;
|
||||
janet_gcroot(janet_wrap_fiber(fiber));
|
||||
janet_fiber_set_status(fiber, JANET_STATUS_ALIVE);
|
||||
janet_vm_return_reg = out;
|
||||
janet_vm_jmp_buf = &buf;
|
||||
|
||||
/* Run loop */
|
||||
JanetSignal signal;
|
||||
int jmpsig;
|
||||
#if defined(JANET_BSD) || defined(JANET_APPLE)
|
||||
jmpsig = _setjmp(buf);
|
||||
#else
|
||||
jmpsig = setjmp(buf);
|
||||
#endif
|
||||
if (jmpsig) {
|
||||
signal = (JanetSignal) jmpsig;
|
||||
} else {
|
||||
JanetTryState tstate;
|
||||
JanetSignal signal = janet_try(&tstate);
|
||||
if (!signal) {
|
||||
/* Normal setup */
|
||||
if (janet_vm_root_fiber == NULL) janet_vm_root_fiber = fiber;
|
||||
janet_vm_fiber = fiber;
|
||||
janet_fiber_set_status(fiber, JANET_STATUS_ALIVE);
|
||||
signal = run_vm(fiber, in);
|
||||
}
|
||||
|
||||
/* Tear down fiber */
|
||||
janet_fiber_set_status(fiber, signal);
|
||||
janet_gcunroot(janet_wrap_fiber(fiber));
|
||||
|
||||
/* Restore global state */
|
||||
/* Restore */
|
||||
if (janet_vm_root_fiber == fiber) janet_vm_root_fiber = NULL;
|
||||
janet_vm_gc_suspend = handle;
|
||||
janet_vm_fiber = old_vm_fiber;
|
||||
janet_vm_stackn = oldn;
|
||||
janet_vm_return_reg = old_vm_return_reg;
|
||||
janet_vm_jmp_buf = old_vm_jmp_buf;
|
||||
janet_fiber_set_status(fiber, signal);
|
||||
janet_restore(&tstate);
|
||||
*out = tstate.payload;
|
||||
|
||||
return signal;
|
||||
}
|
||||
@@ -1357,6 +1397,20 @@ JanetSignal janet_continue(JanetFiber *fiber, Janet in, Janet *out) {
|
||||
return janet_continue_no_check(fiber, in, out);
|
||||
}
|
||||
|
||||
/* Enter the main vm loop but immediately raise a signal */
|
||||
JanetSignal janet_continue_signal(JanetFiber *fiber, Janet in, Janet *out, JanetSignal sig) {
|
||||
JanetSignal tmp_signal = janet_check_can_resume(fiber, out);
|
||||
if (tmp_signal) return tmp_signal;
|
||||
if (sig != JANET_SIGNAL_OK) {
|
||||
JanetFiber *child = fiber;
|
||||
while (child->child) child = child->child;
|
||||
child->gc.flags &= ~JANET_FIBER_STATUS_MASK;
|
||||
child->gc.flags |= sig << JANET_FIBER_STATUS_OFFSET;
|
||||
child->flags |= JANET_FIBER_RESUME_SIGNAL;
|
||||
}
|
||||
return janet_continue_no_check(fiber, in, out);
|
||||
}
|
||||
|
||||
JanetSignal janet_pcall(
|
||||
JanetFunction *fun,
|
||||
int32_t argc,
|
||||
@@ -1394,11 +1448,8 @@ int janet_init(void) {
|
||||
/* Garbage collection */
|
||||
janet_vm_blocks = NULL;
|
||||
janet_vm_next_collection = 0;
|
||||
/* Setting memoryInterval to zero forces
|
||||
* a collection pretty much every cycle, which is
|
||||
* incredibly horrible for performance, but can help ensure
|
||||
* there are no memory bugs during development */
|
||||
janet_vm_gc_interval = 0x10000;
|
||||
janet_vm_gc_interval = 0x400000;
|
||||
janet_vm_block_count = 0;
|
||||
janet_symcache_init();
|
||||
/* Initialize gc roots */
|
||||
janet_vm_roots = NULL;
|
||||
@@ -1419,6 +1470,8 @@ int janet_init(void) {
|
||||
janet_vm_traversal_top = NULL;
|
||||
/* Core env */
|
||||
janet_vm_core_env = NULL;
|
||||
/* Dynamic bindings */
|
||||
janet_vm_top_dyns = NULL;
|
||||
/* Seed RNG */
|
||||
janet_rng_seed(janet_default_rng(), 0);
|
||||
/* Fibers */
|
||||
@@ -1428,6 +1481,12 @@ int janet_init(void) {
|
||||
/* Threads */
|
||||
#ifdef JANET_THREADS
|
||||
janet_threads_init();
|
||||
#endif
|
||||
#ifdef JANET_EV
|
||||
janet_ev_init();
|
||||
#endif
|
||||
#ifdef JANET_NET
|
||||
janet_net_init();
|
||||
#endif
|
||||
return 0;
|
||||
}
|
||||
@@ -1443,12 +1502,16 @@ void janet_deinit(void) {
|
||||
janet_vm_registry = NULL;
|
||||
janet_vm_abstract_registry = NULL;
|
||||
janet_vm_core_env = NULL;
|
||||
janet_vm_top_dyns = NULL;
|
||||
free(janet_vm_traversal_base);
|
||||
janet_vm_fiber = NULL;
|
||||
janet_vm_root_fiber = NULL;
|
||||
#ifdef JANET_THREADS
|
||||
janet_threads_deinit();
|
||||
#endif
|
||||
#ifdef JANET_EV
|
||||
janet_ev_deinit();
|
||||
#endif
|
||||
#ifdef JANET_NET
|
||||
janet_net_deinit();
|
||||
#endif
|
||||
|
||||
@@ -127,6 +127,12 @@ extern "C" {
|
||||
#define JANET_LITTLE_ENDIAN 1
|
||||
#endif
|
||||
|
||||
/* Limits for converting doubles to 64 bit integers */
|
||||
#define JANET_INTMAX_DOUBLE 9007199254740992.0
|
||||
#define JANET_INTMIN_DOUBLE (-9007199254740992.0)
|
||||
#define JANET_INTMAX_INT64 9007199254740992
|
||||
#define JANET_INTMIN_INT64 (-9007199254740992)
|
||||
|
||||
/* Check emscripten */
|
||||
#ifdef __EMSCRIPTEN__
|
||||
#define JANET_NO_DYNAMIC_MODULES
|
||||
@@ -171,8 +177,13 @@ extern "C" {
|
||||
#define JANET_TYPED_ARRAY
|
||||
#endif
|
||||
|
||||
/* Enable or disable event loop */
|
||||
#if !defined(JANET_NO_EV) && !defined(__EMSCRIPTEN__)
|
||||
#define JANET_EV
|
||||
#endif
|
||||
|
||||
/* Enable or disable networking */
|
||||
#if !defined(JANET_NO_NET) && !defined(__EMSCRIPTEN__)
|
||||
#if defined(JANET_EV) && !defined(JANET_NO_NET) && !defined(__EMSCRIPTEN__)
|
||||
#define JANET_NET
|
||||
#endif
|
||||
|
||||
@@ -195,7 +206,7 @@ extern "C" {
|
||||
#ifdef JANET_WINDOWS
|
||||
#define JANET_NO_RETURN __declspec(noreturn)
|
||||
#else
|
||||
#define JANET_NO_RETURN __attribute__ ((noreturn))
|
||||
#define JANET_NO_RETURN __attribute__((noreturn))
|
||||
#endif
|
||||
#endif
|
||||
|
||||
@@ -219,6 +230,11 @@ extern "C" {
|
||||
* To turn of nanboxing, for debugging purposes or for certain
|
||||
* architectures (Nanboxing only tested on x86 and x64), comment out
|
||||
* the JANET_NANBOX define.*/
|
||||
|
||||
#if defined(_M_ARM64) || defined(_M_ARM) || defined(__aarch64__)
|
||||
#define JANET_NO_NANBOX
|
||||
#endif
|
||||
|
||||
#ifndef JANET_NO_NANBOX
|
||||
#ifdef JANET_32
|
||||
#define JANET_NANBOX_32
|
||||
@@ -256,11 +272,22 @@ typedef struct {
|
||||
} JanetBuildConfig;
|
||||
|
||||
/* Get config of current compilation unit. */
|
||||
#ifdef __cplusplus
|
||||
/* C++11 syntax */
|
||||
#define janet_config_current() (JanetBuildConfig { \
|
||||
JANET_VERSION_MAJOR, \
|
||||
JANET_VERSION_MINOR, \
|
||||
JANET_VERSION_PATCH, \
|
||||
JANET_CURRENT_CONFIG_BITS })
|
||||
#else
|
||||
/* C99 syntax */
|
||||
#define janet_config_current() ((JanetBuildConfig){ \
|
||||
JANET_VERSION_MAJOR, \
|
||||
JANET_VERSION_MINOR, \
|
||||
JANET_VERSION_PATCH, \
|
||||
JANET_CURRENT_CONFIG_BITS })
|
||||
#endif
|
||||
|
||||
|
||||
/***** END SECTION CONFIG *****/
|
||||
|
||||
@@ -288,6 +315,15 @@ JANET_API extern const char *const janet_type_names[16];
|
||||
JANET_API extern const char *const janet_signal_names[14];
|
||||
JANET_API extern const char *const janet_status_names[16];
|
||||
|
||||
/* For various IO routines, we want to use an int on posix and HANDLE on windows */
|
||||
#ifdef JANET_WINDOWS
|
||||
typedef void *JanetHandle;
|
||||
#define JANET_HANDLE_NONE NULL
|
||||
#else
|
||||
typedef int JanetHandle;
|
||||
#define JANET_HANDLE_NONE (-1)
|
||||
#endif
|
||||
|
||||
/* Fiber signals */
|
||||
typedef enum {
|
||||
JANET_SIGNAL_OK,
|
||||
@@ -461,6 +497,75 @@ typedef void *JanetAbstract;
|
||||
#define JANET_TFLAG_CALLABLE (JANET_TFLAG_FUNCTION | JANET_TFLAG_CFUNCTION | \
|
||||
JANET_TFLAG_LENGTHABLE | JANET_TFLAG_ABSTRACT)
|
||||
|
||||
/* Event Loop Types */
|
||||
#ifdef JANET_EV
|
||||
|
||||
#define JANET_STREAM_CLOSED 0x1
|
||||
#define JANET_STREAM_SOCKET 0x2
|
||||
#define JANET_STREAM_IOCP 0x4
|
||||
#define JANET_STREAM_READABLE 0x200
|
||||
#define JANET_STREAM_WRITABLE 0x400
|
||||
#define JANET_STREAM_ACCEPTABLE 0x800
|
||||
#define JANET_STREAM_UDPSERVER 0x1000
|
||||
|
||||
typedef enum {
|
||||
JANET_ASYNC_EVENT_INIT,
|
||||
JANET_ASYNC_EVENT_MARK,
|
||||
JANET_ASYNC_EVENT_DEINIT,
|
||||
JANET_ASYNC_EVENT_CLOSE,
|
||||
JANET_ASYNC_EVENT_ERR,
|
||||
JANET_ASYNC_EVENT_HUP,
|
||||
JANET_ASYNC_EVENT_READ,
|
||||
JANET_ASYNC_EVENT_WRITE,
|
||||
JANET_ASYNC_EVENT_TIMEOUT,
|
||||
JANET_ASYNC_EVENT_COMPLETE, /* Used on windows for IOCP */
|
||||
JANET_ASYNC_EVENT_USER
|
||||
} JanetAsyncEvent;
|
||||
|
||||
#define JANET_ASYNC_LISTEN_READ (1 << JANET_ASYNC_EVENT_READ)
|
||||
#define JANET_ASYNC_LISTEN_WRITE (1 << JANET_ASYNC_EVENT_WRITE)
|
||||
|
||||
typedef enum {
|
||||
JANET_ASYNC_STATUS_NOT_DONE,
|
||||
JANET_ASYNC_STATUS_DONE
|
||||
} JanetAsyncStatus;
|
||||
|
||||
/* Typedefs */
|
||||
typedef struct JanetListenerState JanetListenerState;
|
||||
typedef struct JanetStream JanetStream;
|
||||
typedef JanetAsyncStatus(*JanetListener)(JanetListenerState *state, JanetAsyncEvent event);
|
||||
|
||||
/* Wrapper around file descriptors and HANDLEs that can be polled. */
|
||||
struct JanetStream {
|
||||
JanetHandle handle;
|
||||
uint32_t flags;
|
||||
/* Linked list of all in-flight IO routines for this stream */
|
||||
JanetListenerState *state;
|
||||
const void *methods; /* Methods for this stream */
|
||||
/* internal - used to disallow multiple concurrent reads / writes on the same stream.
|
||||
* this constraint may be lifted later but allowing such would require more internal book keeping
|
||||
* for some implementations. You can read and write at the same time on the same stream, though. */
|
||||
int _mask;
|
||||
};
|
||||
|
||||
/* Interface for state machine based event loop */
|
||||
struct JanetListenerState {
|
||||
JanetListener machine;
|
||||
JanetFiber *fiber;
|
||||
JanetStream *stream;
|
||||
void *event; /* Used to pass data from asynchronous IO event. Contents depend on both
|
||||
implementation of the event loop and the particular event. */
|
||||
#ifdef JANET_WINDOWS
|
||||
void *tag; /* Used to associate listeners with an overlapped structure */
|
||||
int bytes; /* Used to track how many bytes were transfered. */
|
||||
#endif
|
||||
/* internal */
|
||||
int _index; /* not used in all implementations */
|
||||
int _mask;
|
||||
JanetListenerState *_next;
|
||||
};
|
||||
#endif
|
||||
|
||||
/* We provide three possible implementations of Janets. The preferred
|
||||
* nanboxing approach, for 32 or 64 bits, and the standard C version. Code in the rest of the
|
||||
* application must interact through exposed interface. */
|
||||
@@ -550,14 +655,14 @@ JANET_API Janet janet_wrap_integer(int32_t x);
|
||||
#define janet_nanbox_tag(type) (janet_nanbox_lowtag(type) << 47)
|
||||
#define janet_type(x) \
|
||||
(isnan((x).number) \
|
||||
? (((x).u64 >> 47) & 0xF) \
|
||||
? (JanetType) (((x).u64 >> 47) & 0xF) \
|
||||
: JANET_NUMBER)
|
||||
|
||||
#define janet_nanbox_checkauxtype(x, type) \
|
||||
(((x).u64 & JANET_NANBOX_TAGBITS) == janet_nanbox_tag((type)))
|
||||
|
||||
#define janet_nanbox_isnumber(x) \
|
||||
(!isnan((x).number) || janet_nanbox_checkauxtype((x), JANET_NUMBER))
|
||||
(!isnan((x).number) || ((((x).u64 >> 47) & 0xF) == JANET_NUMBER))
|
||||
|
||||
#define janet_checktype(x, t) \
|
||||
(((t) == JANET_NUMBER) \
|
||||
@@ -629,7 +734,7 @@ JANET_API Janet janet_nanbox_from_bits(uint64_t bits);
|
||||
#define JANET_DOUBLE_OFFSET 0xFFFF
|
||||
|
||||
#define janet_u64(x) ((x).u64)
|
||||
#define janet_type(x) (((x).tagged.type < JANET_DOUBLE_OFFSET) ? (x).tagged.type : JANET_NUMBER)
|
||||
#define janet_type(x) (((x).tagged.type < JANET_DOUBLE_OFFSET) ? (JanetType)((x).tagged.type) : JANET_NUMBER)
|
||||
#define janet_checktype(x, t) ((t) == JANET_NUMBER \
|
||||
? (x).tagged.type >= JANET_DOUBLE_OFFSET \
|
||||
: (x).tagged.type == (t))
|
||||
@@ -706,7 +811,7 @@ JANET_API int janet_checkint64(Janet x);
|
||||
JANET_API int janet_checksize(Janet x);
|
||||
JANET_API JanetAbstract janet_checkabstract(Janet x, const JanetAbstractType *at);
|
||||
#define janet_checkintrange(x) ((x) >= INT32_MIN && (x) <= INT32_MAX && (x) == (int32_t)(x))
|
||||
#define janet_checkint64range(x) ((x) >= INT64_MIN && (x) <= INT64_MAX && (x) == (int64_t)(x))
|
||||
#define janet_checkint64range(x) ((x) >= JANET_INTMIN_DOUBLE && (x) <= JANET_INTMAX_DOUBLE && (x) == (int64_t)(x))
|
||||
#define janet_unwrap_integer(x) ((int32_t) janet_unwrap_number(x))
|
||||
#define janet_wrap_integer(x) janet_wrap_number((int32_t)(x))
|
||||
|
||||
@@ -728,11 +833,15 @@ struct JanetFiber {
|
||||
int32_t frame; /* Index of the stack frame */
|
||||
int32_t stackstart; /* Beginning of next args */
|
||||
int32_t stacktop; /* Top of stack. Where values are pushed and popped from. */
|
||||
int32_t capacity;
|
||||
int32_t capacity; /* How big is the stack memory */
|
||||
int32_t maxstack; /* Arbitrary defined limit for stack overflow */
|
||||
JanetTable *env; /* Dynamic bindings table (usually current environment). */
|
||||
Janet *data;
|
||||
Janet *data; /* Dynamically resized stack memory */
|
||||
JanetFiber *child; /* Keep linked list of fibers for restarting pending fibers */
|
||||
#ifdef JANET_EV
|
||||
JanetListenerState *waiting;
|
||||
uint32_t sched_id; /* Increment everytime fiber is scheduled by event loop */
|
||||
#endif
|
||||
};
|
||||
|
||||
/* Mark if a stack frame is a tail call for debugging */
|
||||
@@ -996,9 +1105,22 @@ struct JanetRNG {
|
||||
typedef struct JanetFile JanetFile;
|
||||
struct JanetFile {
|
||||
FILE *file;
|
||||
int flags;
|
||||
int32_t flags;
|
||||
};
|
||||
|
||||
/* For janet_try and janet_restore */
|
||||
typedef struct {
|
||||
/* old state */
|
||||
int32_t stackn;
|
||||
int gc_handle;
|
||||
JanetFiber *vm_fiber;
|
||||
jmp_buf *vm_jmp_buf;
|
||||
Janet *vm_return_reg;
|
||||
/* new state */
|
||||
jmp_buf buf;
|
||||
Janet payload;
|
||||
} JanetTryState;
|
||||
|
||||
/* Thread types */
|
||||
#ifdef JANET_THREADS
|
||||
typedef struct JanetThread JanetThread;
|
||||
@@ -1118,6 +1240,9 @@ enum JanetOpCode {
|
||||
JOP_GREATER_THAN_EQUAL,
|
||||
JOP_LESS_THAN_EQUAL,
|
||||
JOP_NEXT,
|
||||
JOP_NOT_EQUALS,
|
||||
JOP_NOT_EQUALS_IMMEDIATE,
|
||||
JOP_CANCEL,
|
||||
JOP_INSTRUCTION_COUNT
|
||||
};
|
||||
|
||||
@@ -1128,9 +1253,59 @@ extern enum JanetInstructionType janet_instructions[JOP_INSTRUCTION_COUNT];
|
||||
|
||||
/***** START SECTION MAIN *****/
|
||||
|
||||
/* Event Loop */
|
||||
#ifdef JANET_NET
|
||||
#ifdef JANET_EV
|
||||
|
||||
extern JANET_API const JanetAbstractType janet_stream_type;
|
||||
|
||||
/* Run the event loop */
|
||||
JANET_API void janet_loop(void);
|
||||
|
||||
/* Wrapper around streams */
|
||||
JANET_API JanetStream *janet_stream(JanetHandle handle, uint32_t flags, const JanetMethod *methods);
|
||||
JANET_API void janet_stream_close(JanetStream *stream);
|
||||
JANET_API Janet janet_cfun_stream_close(int32_t argc, Janet *argv);
|
||||
JANET_API Janet janet_cfun_stream_read(int32_t argc, Janet *argv);
|
||||
JANET_API Janet janet_cfun_stream_chunk(int32_t argc, Janet *argv);
|
||||
JANET_API Janet janet_cfun_stream_write(int32_t argc, Janet *argv);
|
||||
JANET_API void janet_stream_flags(JanetStream *stream, uint32_t flags);
|
||||
|
||||
/* Queue a fiber to run on the event loop */
|
||||
JANET_API void janet_schedule(JanetFiber *fiber, Janet value);
|
||||
JANET_API void janet_cancel(JanetFiber *fiber, Janet value);
|
||||
JANET_API void janet_schedule_signal(JanetFiber *fiber, Janet value, JanetSignal sig);
|
||||
|
||||
/* Start a state machine listening for events from a stream */
|
||||
JANET_API JanetListenerState *janet_listen(JanetStream *stream, JanetListener behavior, int mask, size_t size, void *user);
|
||||
|
||||
/* Shorthand for yielding to event loop in C */
|
||||
JANET_NO_RETURN JANET_API void janet_await(void);
|
||||
|
||||
/* For use inside listeners - adds a timeout to the current fiber, such that
|
||||
* it will be resumed after sec seconds if no other event schedules the current fiber. */
|
||||
JANET_API void janet_addtimeout(double sec);
|
||||
|
||||
/* Get last error from a an IO operation */
|
||||
JANET_API Janet janet_ev_lasterr(void);
|
||||
|
||||
/* Read async from a stream */
|
||||
JANET_API void janet_ev_read(JanetStream *stream, JanetBuffer *buf, int32_t nbytes);
|
||||
JANET_API void janet_ev_readchunk(JanetStream *stream, JanetBuffer *buf, int32_t nbytes);
|
||||
#ifdef JANET_NET
|
||||
JANET_API void janet_ev_recv(JanetStream *stream, JanetBuffer *buf, int32_t nbytes, int flags);
|
||||
JANET_API void janet_ev_recvchunk(JanetStream *stream, JanetBuffer *buf, int32_t nbytes, int flags);
|
||||
JANET_API void janet_ev_recvfrom(JanetStream *stream, JanetBuffer *buf, int32_t nbytes, int flags);
|
||||
#endif
|
||||
|
||||
/* Write async to a stream */
|
||||
JANET_API void janet_ev_write_buffer(JanetStream *stream, JanetBuffer *buf);
|
||||
JANET_API void janet_ev_write_string(JanetStream *stream, JanetString str);
|
||||
#ifdef JANET_NET
|
||||
JANET_API void janet_ev_send_buffer(JanetStream *stream, JanetBuffer *buf, int flags);
|
||||
JANET_API void janet_ev_send_string(JanetStream *stream, JanetString str, int flags);
|
||||
JANET_API void janet_ev_sendto_buffer(JanetStream *stream, JanetBuffer *buf, void *dest, int flags);
|
||||
JANET_API void janet_ev_sendto_string(JanetStream *stream, JanetString str, void *dest, int flags);
|
||||
#endif
|
||||
|
||||
#endif
|
||||
|
||||
/* Parsing */
|
||||
@@ -1373,10 +1548,17 @@ JANET_API int janet_verify(JanetFuncDef *def);
|
||||
JANET_API JanetBuffer *janet_pretty(JanetBuffer *buffer, int depth, int flags, Janet x);
|
||||
|
||||
/* Misc */
|
||||
#ifndef JANET_NO_PRF
|
||||
#ifdef JANET_PRF
|
||||
#define JANET_HASH_KEY_SIZE 16
|
||||
JANET_API void janet_init_hash_key(uint8_t key[JANET_HASH_KEY_SIZE]);
|
||||
#endif
|
||||
JANET_API void janet_try_init(JanetTryState *state);
|
||||
#if defined(JANET_BSD) || defined(JANET_APPLE)
|
||||
#define janet_try(state) (janet_try_init(state), (JanetSignal) _setjmp((state)->buf))
|
||||
#else
|
||||
#define janet_try(state) (janet_try_init(state), (JanetSignal) setjmp((state)->buf))
|
||||
#endif
|
||||
JANET_API void janet_restore(JanetTryState *state);
|
||||
JANET_API int janet_equals(Janet x, Janet y);
|
||||
JANET_API int32_t janet_hash(Janet x);
|
||||
JANET_API int janet_compare(Janet x, Janet y);
|
||||
@@ -1399,6 +1581,7 @@ JANET_API int janet_symeq(Janet x, const char *cstring);
|
||||
JANET_API int janet_init(void);
|
||||
JANET_API void janet_deinit(void);
|
||||
JANET_API JanetSignal janet_continue(JanetFiber *fiber, Janet in, Janet *out);
|
||||
JANET_API JanetSignal janet_continue_signal(JanetFiber *fiber, Janet in, Janet *out, JanetSignal sig);
|
||||
JANET_API JanetSignal janet_pcall(JanetFunction *fun, int32_t argn, const Janet *argv, Janet *out, JanetFiber **f);
|
||||
JANET_API JanetSignal janet_step(JanetFiber *fiber, Janet in, Janet *out);
|
||||
JANET_API Janet janet_call(JanetFunction *fun, int32_t argc, const Janet *argv);
|
||||
@@ -1424,6 +1607,7 @@ typedef enum {
|
||||
JANET_API void janet_def(JanetTable *env, const char *name, Janet val, const char *documentation);
|
||||
JANET_API void janet_var(JanetTable *env, const char *name, Janet val, const char *documentation);
|
||||
JANET_API void janet_cfuns(JanetTable *env, const char *regprefix, const JanetReg *cfuns);
|
||||
JANET_API void janet_cfuns_prefix(JanetTable *env, const char *regprefix, const JanetReg *cfuns);
|
||||
JANET_API JanetBindingType janet_resolve(JanetTable *env, JanetSymbol sym, Janet *out);
|
||||
JANET_API void janet_register(const char *name, JanetCFunction cfun);
|
||||
|
||||
@@ -1432,15 +1616,23 @@ JANET_API Janet janet_resolve_core(const char *name);
|
||||
|
||||
/* New C API */
|
||||
|
||||
/* Shorthand for janet C function declarations */
|
||||
#define JANET_CFUN(name) Janet name (int32_t argc, Janet *argv)
|
||||
|
||||
/* Allow setting entry name for static libraries */
|
||||
#ifdef __cplusplus
|
||||
#define JANET_MODULE_PREFIX extern "C"
|
||||
#else
|
||||
#define JANET_MODULE_PREFIX
|
||||
#endif
|
||||
#ifndef JANET_ENTRY_NAME
|
||||
#define JANET_MODULE_ENTRY \
|
||||
JANET_API JanetBuildConfig _janet_mod_config(void) { \
|
||||
JANET_MODULE_PREFIX JANET_API JanetBuildConfig _janet_mod_config(void) { \
|
||||
return janet_config_current(); \
|
||||
} \
|
||||
JANET_API void _janet_init
|
||||
JANET_MODULE_PREFIX JANET_API void _janet_init
|
||||
#else
|
||||
#define JANET_MODULE_ENTRY JANET_API void JANET_ENTRY_NAME
|
||||
#define JANET_MODULE_ENTRY JANET_MODULE_PREFIX JANET_API void JANET_ENTRY_NAME
|
||||
#endif
|
||||
|
||||
JANET_NO_RETURN JANET_API void janet_signalv(JanetSignal signal, Janet message);
|
||||
@@ -1525,12 +1717,17 @@ extern JANET_API const JanetAbstractType janet_file_type;
|
||||
#define JANET_FILE_BINARY 64
|
||||
#define JANET_FILE_SERIALIZABLE 128
|
||||
#define JANET_FILE_PIPED 256
|
||||
#define JANET_FILE_NONIL 512
|
||||
|
||||
JANET_API Janet janet_makefile(FILE *f, int flags);
|
||||
JANET_API FILE *janet_getfile(const Janet *argv, int32_t n, int *flags);
|
||||
JANET_API Janet janet_makefile(FILE *f, int32_t flags);
|
||||
JANET_API JanetFile *janet_makejfile(FILE *f, int32_t flags);
|
||||
JANET_API FILE *janet_getfile(const Janet *argv, int32_t n, int32_t *flags);
|
||||
JANET_API FILE *janet_dynfile(const char *name, FILE *def);
|
||||
JANET_API JanetFile *janet_getjfile(const Janet *argv, int32_t n);
|
||||
JANET_API JanetAbstract janet_checkfile(Janet j);
|
||||
JANET_API FILE *janet_unwrapfile(Janet j, int *flags);
|
||||
JANET_API FILE *janet_unwrapfile(Janet j, int32_t *flags);
|
||||
|
||||
JANET_API int janet_cryptorand(uint8_t *out, size_t n);
|
||||
|
||||
/* Marshal API */
|
||||
JANET_API void janet_marshal_size(JanetMarshalContext *ctx, size_t value);
|
||||
@@ -1586,6 +1783,7 @@ typedef enum {
|
||||
RULE_TO, /* [rule] */
|
||||
RULE_THRU, /* [rule] */
|
||||
RULE_LENPREFIX, /* [rule_a, rule_b (repeat rule_b rule_a times)] */
|
||||
RULE_READINT, /* [(signedness << 4) | (endianess << 5) | bytewidth, tag] */
|
||||
} JanetPegOpcode;
|
||||
|
||||
typedef struct {
|
||||
|
||||
@@ -84,7 +84,7 @@ static void simpleline(JanetBuffer *buffer) {
|
||||
}
|
||||
|
||||
/* Windows */
|
||||
#ifdef JANET_WINDOWS
|
||||
#if defined(JANET_WINDOWS) || defined(JANET_SIMPLE_GETLINE)
|
||||
|
||||
void janet_line_init() {
|
||||
;
|
||||
@@ -126,21 +126,28 @@ https://github.com/antirez/linenoise/blob/master/linenoise.c
|
||||
#define JANET_LINE_MAX 1024
|
||||
#define JANET_MATCH_MAX 256
|
||||
#define JANET_HISTORY_MAX 100
|
||||
static JANET_THREAD_LOCAL int gbl_israwmode = 0;
|
||||
static JANET_THREAD_LOCAL const char *gbl_prompt = "> ";
|
||||
static JANET_THREAD_LOCAL int gbl_plen = 2;
|
||||
static JANET_THREAD_LOCAL char gbl_buf[JANET_LINE_MAX];
|
||||
static JANET_THREAD_LOCAL int gbl_len = 0;
|
||||
static JANET_THREAD_LOCAL int gbl_pos = 0;
|
||||
static JANET_THREAD_LOCAL int gbl_cols = 80;
|
||||
static JANET_THREAD_LOCAL char *gbl_history[JANET_HISTORY_MAX];
|
||||
static JANET_THREAD_LOCAL int gbl_history_count = 0;
|
||||
static JANET_THREAD_LOCAL int gbl_historyi = 0;
|
||||
static JANET_THREAD_LOCAL int gbl_sigint_flag = 0;
|
||||
static JANET_THREAD_LOCAL struct termios gbl_termios_start;
|
||||
static JANET_THREAD_LOCAL JanetByteView gbl_matches[JANET_MATCH_MAX];
|
||||
static JANET_THREAD_LOCAL int gbl_match_count = 0;
|
||||
static JANET_THREAD_LOCAL int gbl_lines_below = 0;
|
||||
static int gbl_israwmode = 0;
|
||||
static const char *gbl_prompt = "> ";
|
||||
static int gbl_plen = 2;
|
||||
static char gbl_buf[JANET_LINE_MAX];
|
||||
static int gbl_len = 0;
|
||||
static int gbl_pos = 0;
|
||||
static int gbl_cols = 80;
|
||||
static char *gbl_history[JANET_HISTORY_MAX];
|
||||
static int gbl_history_count = 0;
|
||||
static int gbl_historyi = 0;
|
||||
static int gbl_sigint_flag = 0;
|
||||
static struct termios gbl_termios_start;
|
||||
static JanetByteView gbl_matches[JANET_MATCH_MAX];
|
||||
static int gbl_match_count = 0;
|
||||
static int gbl_lines_below = 0;
|
||||
|
||||
/* Put a lock around this global state so we don't screw up
|
||||
* the terminal in a multithreaded situation */
|
||||
#ifndef JANET_SINGLE_THREADED
|
||||
#include <pthread.h>
|
||||
static pthread_mutex_t gbl_lock = PTHREAD_MUTEX_INITIALIZER;
|
||||
#endif
|
||||
|
||||
/* Unsupported terminal list from linenoise */
|
||||
static const char *badterms[] = {
|
||||
@@ -162,6 +169,9 @@ static char *sdup(const char *s) {
|
||||
/* Ansi terminal raw mode */
|
||||
static int rawmode(void) {
|
||||
struct termios t;
|
||||
#ifndef JANET_SINGLE_THREADED
|
||||
pthread_mutex_lock(&gbl_lock);
|
||||
#endif
|
||||
if (!isatty(STDIN_FILENO)) goto fatal;
|
||||
if (tcgetattr(STDIN_FILENO, &gbl_termios_start) == -1) goto fatal;
|
||||
t = gbl_termios_start;
|
||||
@@ -170,18 +180,24 @@ static int rawmode(void) {
|
||||
t.c_lflag &= ~(ECHO | ICANON | IEXTEN | ISIG);
|
||||
t.c_cc[VMIN] = 1;
|
||||
t.c_cc[VTIME] = 0;
|
||||
if (tcsetattr(STDIN_FILENO, TCSAFLUSH, &t) < 0) goto fatal;
|
||||
if (tcsetattr(STDIN_FILENO, TCSADRAIN, &t) < 0) goto fatal;
|
||||
gbl_israwmode = 1;
|
||||
return 0;
|
||||
fatal:
|
||||
errno = ENOTTY;
|
||||
#ifndef JANET_SINGLE_THREADED
|
||||
pthread_mutex_unlock(&gbl_lock);
|
||||
#endif
|
||||
return -1;
|
||||
}
|
||||
|
||||
/* Disable raw mode */
|
||||
static void norawmode(void) {
|
||||
if (gbl_israwmode && tcsetattr(STDIN_FILENO, TCSAFLUSH, &gbl_termios_start) != -1)
|
||||
if (gbl_israwmode && tcsetattr(STDIN_FILENO, TCSADRAIN, &gbl_termios_start) != -1)
|
||||
gbl_israwmode = 0;
|
||||
#ifndef JANET_SINGLE_THREADED
|
||||
pthread_mutex_unlock(&gbl_lock);
|
||||
#endif
|
||||
}
|
||||
|
||||
static int curpos(void) {
|
||||
@@ -747,7 +763,7 @@ static int line() {
|
||||
|
||||
switch (c) {
|
||||
default:
|
||||
if (c < 0x20) break;
|
||||
if ((unsigned char) c < 0x20) break;
|
||||
if (insert(c, 1)) return -1;
|
||||
break;
|
||||
case 1: /* ctrl-a */
|
||||
@@ -996,6 +1012,28 @@ int main(int argc, char **argv) {
|
||||
SetConsoleOutputCP(65001);
|
||||
#endif
|
||||
|
||||
#if !defined(JANET_WINDOWS) && !defined(JANET_SIMPLE_GETLINE)
|
||||
/* Try and not leave the terminal in a bad state */
|
||||
atexit(norawmode);
|
||||
#endif
|
||||
|
||||
#if defined(JANET_PRF)
|
||||
uint8_t hash_key[JANET_HASH_KEY_SIZE + 1];
|
||||
#ifdef JANET_REDUCED_OS
|
||||
char *envvar = NULL;
|
||||
#else
|
||||
char *envvar = getenv("JANET_HASHSEED");
|
||||
#endif
|
||||
if (NULL != envvar) {
|
||||
strncpy((char *) hash_key, envvar, sizeof(hash_key) - 1);
|
||||
} else if (janet_cryptorand(hash_key, JANET_HASH_KEY_SIZE) != 0) {
|
||||
fputs("unable to initialize janet PRF hash function.\n", stderr);
|
||||
return 1;
|
||||
}
|
||||
janet_init_hash_key(hash_key);
|
||||
#endif
|
||||
|
||||
|
||||
/* Set up VM */
|
||||
janet_init();
|
||||
|
||||
@@ -1026,7 +1064,7 @@ int main(int argc, char **argv) {
|
||||
janet_stacktrace(fiber, out);
|
||||
}
|
||||
|
||||
#ifdef JANET_NET
|
||||
#ifdef JANET_EV
|
||||
status = JANET_SIGNAL_OK;
|
||||
janet_loop();
|
||||
#endif
|
||||
|
||||
@@ -3,7 +3,6 @@
|
||||
(var num-tests-passed 0)
|
||||
(var num-tests-run 0)
|
||||
(var suite-num 0)
|
||||
(var numchecks 0)
|
||||
(var start-time 0)
|
||||
|
||||
(defn assert
|
||||
@@ -12,17 +11,12 @@
|
||||
(default e "assert error")
|
||||
(++ num-tests-run)
|
||||
(when x (++ num-tests-passed))
|
||||
(def str (string e))
|
||||
(def truncated
|
||||
(if (> (length e) 40) (string (string/slice e 0 35) "...") (string e)))
|
||||
(if x
|
||||
(do
|
||||
(when (= numchecks 25)
|
||||
(set numchecks 0)
|
||||
(print))
|
||||
(++ numchecks)
|
||||
(file/write stdout "\e[32m✔\e[0m"))
|
||||
(do
|
||||
(file/write stdout "\n\e[31m✘\e[0m ")
|
||||
(set numchecks 0)
|
||||
(print e)))
|
||||
(eprintf "\e[32m✔\e[0m %s: %v" truncated x)
|
||||
(eprintf "\n\e[31m✘\e[0m %s: %v" truncated x))
|
||||
x)
|
||||
|
||||
(defmacro assert-error
|
||||
@@ -38,10 +32,10 @@
|
||||
(defn start-suite [x]
|
||||
(set suite-num x)
|
||||
(set start-time (os/clock))
|
||||
(print "\nRunning test suite " x " tests...\n "))
|
||||
(eprint "\nRunning test suite " x " tests...\n "))
|
||||
|
||||
(defn end-suite []
|
||||
(def delta (- (os/clock) start-time))
|
||||
(printf "\n\nTest suite %d finished in %.3f seconds" suite-num delta)
|
||||
(print num-tests-passed " of " num-tests-run " tests passed.\n")
|
||||
(eprintf "\n\nTest suite %d finished in %.3f seconds" suite-num delta)
|
||||
(eprint num-tests-passed " of " num-tests-run " tests passed.\n")
|
||||
(if (not= num-tests-passed num-tests-run) (os/exit 1)))
|
||||
|
||||
@@ -9,6 +9,14 @@
|
||||
:name "testmod2"
|
||||
:source @["testmod2.c"])
|
||||
|
||||
(declare-native
|
||||
:name "testmod3"
|
||||
:source @["testmod3.cpp"])
|
||||
|
||||
(declare-native
|
||||
:name "test-mod-4"
|
||||
:source @["testmod4.c"])
|
||||
|
||||
(declare-executable
|
||||
:name "testexec"
|
||||
:entry "testexec.janet")
|
||||
|
||||
@@ -1,6 +1,8 @@
|
||||
(use build/testmod)
|
||||
(use build/testmod2)
|
||||
(use build/testmod3)
|
||||
(use build/test-mod-4)
|
||||
|
||||
(defn main [&]
|
||||
(print "Hello from executable!")
|
||||
(print (+ (get5) (get6))))
|
||||
(print (+ (get5) (get6) (get7) (get8))))
|
||||
|
||||
42
test/install/testmod3.cpp
Normal file
42
test/install/testmod3.cpp
Normal file
@@ -0,0 +1,42 @@
|
||||
/*
|
||||
* Copyright (c) 2020 Calvin Rose and contributors
|
||||
*
|
||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
* deal in the Software without restriction, including without limitation the
|
||||
* rights to use, copy, modify, merge, publish, distribute, sublicense, and/or
|
||||
* sell copies of the Software, and to permit persons to whom the Software is
|
||||
* furnished to do so, subject to the following conditions:
|
||||
*
|
||||
* The above copyright notice and this permission notice shall be included in
|
||||
* all copies or substantial portions of the Software.
|
||||
*
|
||||
* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
|
||||
* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
|
||||
* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
|
||||
* AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
|
||||
* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
|
||||
* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS
|
||||
* IN THE SOFTWARE.
|
||||
*/
|
||||
|
||||
/* A very simple native module */
|
||||
|
||||
#include <janet.h>
|
||||
#include <iostream>
|
||||
|
||||
static Janet cfun_get_seven(int32_t argc, Janet *argv) {
|
||||
(void) argv;
|
||||
janet_fixarity(argc, 0);
|
||||
std::cout << "Hello!" << std::endl;
|
||||
return janet_wrap_number(7.0);
|
||||
}
|
||||
|
||||
static const JanetReg array_cfuns[] = {
|
||||
{"get7", cfun_get_seven, NULL},
|
||||
{NULL, NULL, NULL}
|
||||
};
|
||||
|
||||
JANET_MODULE_ENTRY(JanetTable *env) {
|
||||
janet_cfuns(env, NULL, array_cfuns);
|
||||
}
|
||||
40
test/install/testmod4.c
Normal file
40
test/install/testmod4.c
Normal file
@@ -0,0 +1,40 @@
|
||||
/*
|
||||
* Copyright (c) 2020 Calvin Rose and contributors
|
||||
*
|
||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
* deal in the Software without restriction, including without limitation the
|
||||
* rights to use, copy, modify, merge, publish, distribute, sublicense, and/or
|
||||
* sell copies of the Software, and to permit persons to whom the Software is
|
||||
* furnished to do so, subject to the following conditions:
|
||||
*
|
||||
* The above copyright notice and this permission notice shall be included in
|
||||
* all copies or substantial portions of the Software.
|
||||
*
|
||||
* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
|
||||
* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
|
||||
* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
|
||||
* AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
|
||||
* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
|
||||
* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS
|
||||
* IN THE SOFTWARE.
|
||||
*/
|
||||
|
||||
/* A very simple native module */
|
||||
|
||||
#include <janet.h>
|
||||
|
||||
static Janet cfun_get_eight(int32_t argc, Janet *argv) {
|
||||
(void) argv;
|
||||
janet_fixarity(argc, 0);
|
||||
return janet_wrap_number(8.0);
|
||||
}
|
||||
|
||||
static const JanetReg array_cfuns[] = {
|
||||
{"get8", cfun_get_eight, NULL},
|
||||
{NULL, NULL, NULL}
|
||||
};
|
||||
|
||||
JANET_MODULE_ENTRY(JanetTable *env) {
|
||||
janet_cfuns(env, NULL, array_cfuns);
|
||||
}
|
||||
@@ -337,9 +337,9 @@
|
||||
## Polymorphic comparison -- Issue #272
|
||||
|
||||
# confirm polymorphic comparison delegation to primitive comparators:
|
||||
(assert (= 0 (compare-primitive 3 3)) "compare-primitive integers (1)")
|
||||
(assert (= -1 (compare-primitive 3 5)) "compare-primitive integers (2)")
|
||||
(assert (= 1 (compare-primitive "foo" "bar")) "compare-primitive strings")
|
||||
(assert (= 0 (cmp 3 3)) "compare-primitive integers (1)")
|
||||
(assert (= -1 (cmp 3 5)) "compare-primitive integers (2)")
|
||||
(assert (= 1 (cmp "foo" "bar")) "compare-primitive strings")
|
||||
(assert (= 0 (compare 1 1)) "compare integers (1)")
|
||||
(assert (= -1 (compare 1 2)) "compare integers (2)")
|
||||
(assert (= 1 (compare "foo" "bar")) "compare strings (1)")
|
||||
@@ -372,9 +372,9 @@
|
||||
@{:type :mynum :v 0 :compare
|
||||
(fn [self other]
|
||||
(case (type other)
|
||||
:number (compare-primitive (self :v) other)
|
||||
:number (cmp (self :v) other)
|
||||
:table (when (= (get other :type) :mynum)
|
||||
(compare-primitive (self :v) (other :v)))))})
|
||||
(cmp (self :v) (other :v)))))})
|
||||
|
||||
(let [n3 (table/setproto @{:v 3} mynum)]
|
||||
(assert (= 0 (compare 3 n3)) "compare num to object (1)")
|
||||
@@ -386,17 +386,14 @@
|
||||
(assert (compare= 3 n3 (table/setproto @{:v 3} mynum)) "compare= poly")
|
||||
(assert (deep= (sorted @[4 5 n3 2] compare<) @[2 n3 4 5]) "polymorphic sort"))
|
||||
|
||||
(let [
|
||||
MAX_INT_64_STRING "9223372036854775807"
|
||||
(let [MAX_INT_64_STRING "9223372036854775807"
|
||||
MAX_UINT_64_STRING "18446744073709551615"
|
||||
MAX_INT_IN_DBL_STRING "9007199254740991"
|
||||
NAN (math/log -1)
|
||||
INF (/ 1 0)
|
||||
MINUS_INF (/ -1 0)
|
||||
|
||||
compare-poly-tests
|
||||
[
|
||||
[(int/s64 3) (int/u64 3) 0]
|
||||
[[(int/s64 3) (int/u64 3) 0]
|
||||
[(int/s64 -3) (int/u64 3) -1]
|
||||
[(int/s64 3) (int/u64 2) 1]
|
||||
[(int/s64 3) 3 0] [(int/s64 3) 4 -1] [(int/s64 3) -9 1]
|
||||
@@ -409,11 +406,16 @@
|
||||
[(+ 1 (int/u64 MAX_INT_IN_DBL_STRING)) (scan-number MAX_INT_IN_DBL_STRING) 1]
|
||||
[(int/s64 0) INF -1] [(int/u64 0) INF -1]
|
||||
[MINUS_INF (int/u64 0) -1] [MINUS_INF (int/s64 0) -1]
|
||||
[(int/s64 1) NAN 0] [NAN (int/u64 1) 0]
|
||||
]]
|
||||
[(int/s64 1) NAN 0] [NAN (int/u64 1) 0]]]
|
||||
(each [x y c] compare-poly-tests
|
||||
(assert (= c (compare x y)) (string/format "compare polymorphic %q %q %d" x y c)))
|
||||
)
|
||||
(assert (= c (compare x y)) (string/format "compare polymorphic %q %q %d" x y c))))
|
||||
|
||||
(assert (= nil (any? [])) "any? 1")
|
||||
(assert (= nil (any? [false nil])) "any? 2")
|
||||
(assert (= nil (any? [nil false])) "any? 3")
|
||||
(assert (= 1 (any? [1])) "any? 4")
|
||||
(assert (nan? (any? [nil math/nan nil])) "any? 5")
|
||||
(assert (= true (any? [nil nil false nil nil true nil nil nil nil false :a nil])) "any? 6")
|
||||
|
||||
(end-suite)
|
||||
|
||||
@@ -443,4 +443,26 @@
|
||||
(check-match redef-b "aabeef" false)
|
||||
(check-match redef-b "aaaaaa" false)
|
||||
|
||||
# Integer parsing
|
||||
|
||||
(check-deep '(int 1) "a" @[(chr "a")])
|
||||
(check-deep '(uint 1) "a" @[(chr "a")])
|
||||
(check-deep '(int-be 1) "a" @[(chr "a")])
|
||||
(check-deep '(uint-be 1) "a" @[(chr "a")])
|
||||
(check-deep '(int 1) "\xFF" @[-1])
|
||||
(check-deep '(uint 1) "\xFF" @[255])
|
||||
(check-deep '(int-be 1) "\xFF" @[-1])
|
||||
(check-deep '(uint-be 1) "\xFF" @[255])
|
||||
(check-deep '(int 2) "\xFF\x7f" @[0x7fff])
|
||||
(check-deep '(int-be 2) "\x7f\xff" @[0x7fff])
|
||||
(check-deep '(uint 2) "\xff\x7f" @[0x7fff])
|
||||
(check-deep '(uint-be 2) "\x7f\xff" @[0x7fff])
|
||||
(check-deep '(uint-be 2) "\x7f\xff" @[0x7fff])
|
||||
(check-deep '(uint 8) "\xff\x7f\x00\x00\x00\x00\x00\x00" @[(int/u64 0x7fff)])
|
||||
(check-deep '(int 8) "\xff\x7f\x00\x00\x00\x00\x00\x00" @[(int/s64 0x7fff)])
|
||||
(check-deep '(uint 7) "\xff\x7f\x00\x00\x00\x00\x00" @[(int/u64 0x7fff)])
|
||||
(check-deep '(int 7) "\xff\x7f\x00\x00\x00\x00\x00" @[(int/s64 0x7fff)])
|
||||
|
||||
(check-deep '(* (int 2) -1) "123" nil)
|
||||
|
||||
(end-suite)
|
||||
@@ -48,7 +48,9 @@
|
||||
(defn check-image
|
||||
"Run a marshaling test using the make-image and load-image functions."
|
||||
[x msg]
|
||||
(assert-no-error msg (load-image (make-image x))))
|
||||
(def im (make-image x))
|
||||
# (printf "\nimage-hash: %d" (-> im string hash))
|
||||
(assert-no-error msg (load-image im)))
|
||||
|
||||
(check-image (fn [] (fn [] 1)) "marshal nested functions")
|
||||
(check-image (fiber/new (fn [] (fn [] 1))) "marshal nested functions in fiber")
|
||||
@@ -315,4 +315,9 @@
|
||||
|
||||
(assert (= 40 counter) "if-with 1")
|
||||
|
||||
(def a @[])
|
||||
(eachk x [:a :b :c :d]
|
||||
(array/push a x))
|
||||
(assert (deep= (range 4) a) "eachk 1")
|
||||
|
||||
(end-suite)
|
||||
@@ -36,7 +36,7 @@
|
||||
:loop (/ (* "[" :main "]") ,(fn [& captures]
|
||||
~(while (not= (get DATA POS) 0)
|
||||
,;captures)))
|
||||
:main (any (+ :s :loop :+ :- :> :< :.)) }))
|
||||
:main (any (+ :s :loop :+ :- :> :< :.))}))
|
||||
|
||||
(defn bf
|
||||
"Run brainfuck."
|
||||
@@ -224,7 +224,7 @@ neldb\0\0\0\xD8\x05printG\x01\0\xDE\xDE\xDE'\x03\0marshal_tes/\x02
|
||||
# No segfault, valgrind clean.
|
||||
|
||||
(def x @"\xCC\xCD.nd\x80\0\r\x1C\xCDg!\0\x07\xCC\xCD\r\x1Ce\x10\0\r;\xCDb\x04\xFF9\xFF\x80\x04\x04\x04\x04\x04\x04\x04\x04\x04\x04\x04uu\x04\x04\x04\x04\x04\x04\x04\x04\x04\x04\x04\x04\x04\x04\0\x04\x04\x04\x04\x04\x04\x04\x04\x04\x04\x04\x04\x04\x04\x04\x04\x04\x04}\x04\x04\x04\x04\x04\x04\x04\x04#\x04\x04\x04\x04\x04\x04\x04\x04\x04\x04\x04\0\x01\0\0\x03\x04\x04\x04\xE2\x03\x04\x04\x04\x04\x04\x04\x04\x04\x04\x14\x1A\x04\x04\x04\x04\x04\x18\x04\x04!\x04\xE2\x03\x04\x04\x04\x04\x04\x04$\x04\x04\x04\x04\x04\x04\x04\x04\x04\x80\x04\x04\x04\x04\x04\x04\x04\x04\x04\x04\x04\x04\x04A\0\0\0\x03\0\0!\xBF\xFF")
|
||||
(unmarshal x load-image-dict)
|
||||
(assert-error "bad fiber status" (unmarshal x load-image-dict))
|
||||
(gccollect)
|
||||
(marshal x make-image-dict)
|
||||
|
||||
@@ -233,8 +233,8 @@ neldb\0\0\0\xD8\x05printG\x01\0\xDE\xDE\xDE'\x03\0marshal_tes/\x02
|
||||
(gccollect)
|
||||
|
||||
(def v (unmarshal
|
||||
@"\xD7\xCD0\xD4000000\0\x03\x01\xCE\00\0\x01\0\0000\x03\0\0\0000000000\xCC0\0000"
|
||||
load-image-dict))
|
||||
@"\xD7\xCD0\xD4000000\0\x03\x01\xCE\00\0\x01\0\0000\x03\0\0\0000000000\xCC0\0000"
|
||||
load-image-dict))
|
||||
(gccollect)
|
||||
|
||||
# in vs get regression
|
||||
@@ -271,7 +271,7 @@ neldb\0\0\0\xD8\x05printG\x01\0\xDE\xDE\xDE'\x03\0marshal_tes/\x02
|
||||
:packet-body '(lenprefix (-> :header-len) 1)
|
||||
|
||||
# header, followed by body, and drop the :header-len capture
|
||||
:packet (/ (* :packet-header :packet-body) ,|$1)
|
||||
:packet (/ (* :packet-header :packet-body) ,|$1)
|
||||
|
||||
# any exact seqence of packets (no extra characters)
|
||||
:main (* (any :packet) -1)}))
|
||||
@@ -307,4 +307,46 @@ neldb\0\0\0\xD8\x05printG\x01\0\xDE\xDE\xDE'\x03\0marshal_tes/\x02
|
||||
(assert (:match peg5 "abcabcabcac") "repeat alias 2")
|
||||
(assert (not (:match peg5 "abcabc")) "repeat alias 3")
|
||||
|
||||
(defn check-jdn [x]
|
||||
(assert (deep= (parse (string/format "%j" x)) x) "round trip jdn"))
|
||||
|
||||
(check-jdn 0)
|
||||
(check-jdn nil)
|
||||
(check-jdn [])
|
||||
(check-jdn @[[] [] 1231 9.123123 -123123 0.1231231230001])
|
||||
(check-jdn -0.123123123123)
|
||||
(check-jdn 12837192371923)
|
||||
(check-jdn "a string")
|
||||
(check-jdn @"a buffer")
|
||||
|
||||
# Issue 428
|
||||
(var result nil)
|
||||
(defn f [] (yield {:a :ok}))
|
||||
(assert-no-error "issue 428 1" (loop [{:a x} :generate (fiber/new f)] (set result x)))
|
||||
(assert (= result :ok) "issue 428 2")
|
||||
|
||||
# Inline 3 argument get
|
||||
(assert (= 10 (do (var a 10) (set a (get '{} :a a)))) "inline get 1")
|
||||
|
||||
# Keyword and Symbol slice
|
||||
(assert (= :keyword (keyword/slice "some_keyword_slice" 5 12)) "keyword slice")
|
||||
(assert (= 'symbol (symbol/slice "some_symbol_slice" 5 11)) "symbol slice")
|
||||
|
||||
# Peg find and find-all
|
||||
(def p "/usr/local/bin/janet")
|
||||
(assert (= (peg/find '"n/" p) 13) "peg find 1")
|
||||
(assert (not (peg/find '"t/" p)) "peg find 2")
|
||||
(assert (deep= (peg/find-all '"/" p) @[0 4 10 14]) "peg find-all")
|
||||
|
||||
# Peg replace and replace-all
|
||||
(var ti 0)
|
||||
(defn check-replacer
|
||||
[x y z]
|
||||
(assert (= (string/replace x y z) (string (peg/replace x y z))) "replacer test replace")
|
||||
(assert (= (string/replace-all x y z) (string (peg/replace-all x y z))) "replacer test replace-all"))
|
||||
(check-replacer "abc" "Z" "abcabcabcabasciabsabc")
|
||||
(check-replacer "abc" "Z" "")
|
||||
(check-replacer "aba" "ZZZZZZ" "ababababababa")
|
||||
(check-replacer "aba" "" "ababababababa")
|
||||
|
||||
(end-suite)
|
||||
@@ -48,4 +48,19 @@
|
||||
|
||||
(:close s)
|
||||
|
||||
# Create pipe
|
||||
|
||||
(var pipe-counter 0)
|
||||
(def [reader writer] (ev/pipe))
|
||||
(ev/spawn
|
||||
(while (ev/read reader 3)
|
||||
(++ pipe-counter))
|
||||
(assert (= 20 pipe-counter) "ev/pipe 1"))
|
||||
|
||||
(for i 0 10
|
||||
(ev/write writer "xxx---"))
|
||||
|
||||
(ev/close writer)
|
||||
(ev/sleep 0.1)
|
||||
|
||||
(end-suite)
|
||||
68
test/suite0010.janet
Normal file
68
test/suite0010.janet
Normal file
@@ -0,0 +1,68 @@
|
||||
# Copyright (c) 2020 Calvin Rose & contributors
|
||||
#
|
||||
# Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
# of this software and associated documentation files (the "Software"), to
|
||||
# deal in the Software without restriction, including without limitation the
|
||||
# rights to use, copy, modify, merge, publish, distribute, sublicense, and/or
|
||||
# sell copies of the Software, and to permit persons to whom the Software is
|
||||
# furnished to do so, subject to the following conditions:
|
||||
#
|
||||
# The above copyright notice and this permission notice shall be included in
|
||||
# all copies or substantial portions of the Software.
|
||||
#
|
||||
# THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
|
||||
# IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
|
||||
# FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
|
||||
# AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
|
||||
# LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
|
||||
# FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS
|
||||
# IN THE SOFTWARE.
|
||||
|
||||
(import ./helper :prefix "" :exit true)
|
||||
(start-suite 10)
|
||||
|
||||
# index-of
|
||||
(assert (= nil (index-of 10 [])) "index-of 1")
|
||||
(assert (= nil (index-of 10 [1 2 3])) "index-of 2")
|
||||
(assert (= 1 (index-of 2 [1 2 3])) "index-of 3")
|
||||
(assert (= 0 (index-of :a [:a :b :c])) "index-of 4")
|
||||
(assert (= nil (index-of :a {})) "index-of 5")
|
||||
(assert (= :a (index-of :A {:a :A :b :B})) "index-of 6")
|
||||
(assert (= :a (index-of :A @{:a :A :b :B})) "index-of 7")
|
||||
(assert (= 0 (index-of (chr "a") "abc")) "index-of 8")
|
||||
(assert (= nil (index-of (chr "a") "")) "index-of 9")
|
||||
(assert (= nil (index-of 10 @[])) "index-of 10")
|
||||
(assert (= nil (index-of 10 @[1 2 3])) "index-of 11")
|
||||
|
||||
# Regression
|
||||
(assert (= {:x 10} (|(let [x $] ~{:x ,x}) 10)) "issue 463")
|
||||
|
||||
# macex testing
|
||||
(assert (deep= (macex1 '~{1 2 3 4}) '~{1 2 3 4}) "macex1 qq struct")
|
||||
(assert (deep= (macex1 '~@{1 2 3 4}) '~@{1 2 3 4}) "macex1 qq table")
|
||||
(assert (deep= (macex1 '~(1 2 3 4)) '~[1 2 3 4]) "macex1 qq tuple")
|
||||
(assert (= :brackets (tuple/type (1 (macex1 '~[1 2 3 4])))) "macex1 qq bracket tuple")
|
||||
(assert (deep= (macex1 '~@[1 2 3 4 ,blah]) '~@[1 2 3 4 ,blah]) "macex1 qq array")
|
||||
|
||||
# Cancel test
|
||||
(def f (fiber/new (fn [&] (yield 1) (yield 2) (yield 3) 4) :yti))
|
||||
(assert (= 1 (resume f)) "cancel resume 1")
|
||||
(assert (= 2 (resume f)) "cancel resume 2")
|
||||
(assert (= :hi (cancel f :hi)) "cancel resume 3")
|
||||
(assert (= :error (fiber/status f)) "cancel resume 4")
|
||||
|
||||
# Curenv
|
||||
(assert (= (curenv) (curenv 0)) "curenv 1")
|
||||
(assert (= (table/getproto (curenv)) (curenv 1)) "curenv 2")
|
||||
(assert (= nil (curenv 1000000)) "curenv 3")
|
||||
(assert (= root-env (curenv 1)) "curenv 4")
|
||||
|
||||
# Import macro test
|
||||
(assert-no-error "import macro 1" (macex '(import a :as b :fresh maybe)))
|
||||
(assert (deep= ~(,import* "a" :as "b" :fresh maybe) (macex '(import a :as b :fresh maybe))) "import macro 2")
|
||||
|
||||
# #477 walk preserving bracket type
|
||||
(assert (= :brackets (tuple/type (postwalk identity '[]))) "walk square brackets 1")
|
||||
(assert (= :brackets (tuple/type (walk identity '[]))) "walk square brackets 2")
|
||||
|
||||
(end-suite)
|
||||
Reference in New Issue
Block a user