mirror of
https://github.com/janet-lang/janet
synced 2025-11-19 00:35:11 +00:00
Compare commits
214 Commits
v1.7.0
...
appveyor-t
| Author | SHA1 | Date | |
|---|---|---|---|
|
|
1579509a47 | ||
|
|
d3da9e7a0d | ||
|
|
61edf22a45 | ||
|
|
84974d6c56 | ||
|
|
da438a93e0 | ||
|
|
a87015598c | ||
|
|
c335bf5dc5 | ||
|
|
c6a782c0ce | ||
|
|
d148e14aa2 | ||
|
|
748a5d41c1 | ||
|
|
c876e63010 | ||
|
|
23b811243f | ||
|
|
99d9c57154 | ||
|
|
13559baecc | ||
|
|
481647ed5d | ||
|
|
5c162ce588 | ||
|
|
e1b6175efd | ||
|
|
ea46f096c2 | ||
|
|
da88dd8cfa | ||
|
|
9b5c6112e5 | ||
|
|
ea1341a129 | ||
|
|
343cb779d2 | ||
|
|
b0af01a762 | ||
|
|
d8617514f8 | ||
|
|
63812c9f80 | ||
|
|
676a0afe4c | ||
|
|
12d21dcb85 | ||
|
|
5054eb4276 | ||
|
|
122c77dbf6 | ||
|
|
3c66cab4e7 | ||
|
|
738fd479b3 | ||
|
|
5c612095a1 | ||
|
|
2a7008a82c | ||
|
|
82e052f2ec | ||
|
|
16fe0a301c | ||
|
|
aebb8010d4 | ||
|
|
e202d30835 | ||
|
|
fbe903b277 | ||
|
|
8a89e50c13 | ||
|
|
6cb0e0dcea | ||
|
|
a147ea3e80 | ||
|
|
557988e530 | ||
|
|
67fb2c212f | ||
|
|
3765b08cca | ||
|
|
3eb84fcb13 | ||
|
|
bea76e8e08 | ||
|
|
f5433dcaa4 | ||
|
|
ef3b953a42 | ||
|
|
605a205008 | ||
|
|
058f63b440 | ||
|
|
71882475d6 | ||
|
|
a3d29a15df | ||
|
|
a09112404d | ||
|
|
93fc11ea21 | ||
|
|
4faa129b8e | ||
|
|
6c4ed0409d | ||
|
|
ea2811f14f | ||
|
|
8bc2987a71 | ||
|
|
1d13095d19 | ||
|
|
5ed76f197a | ||
|
|
e1f4cadf41 | ||
|
|
3b0e6357ad | ||
|
|
02f17bd4e4 | ||
|
|
b63a0796fd | ||
|
|
e6d4e729fb | ||
|
|
b75a22b753 | ||
|
|
72beeeeaaa | ||
|
|
c3c42ef56f | ||
|
|
a3c55681b2 | ||
|
|
cc70388846 | ||
|
|
fcc610f539 | ||
|
|
5bbd507858 | ||
|
|
45156c0c47 | ||
|
|
553e38ffd6 | ||
|
|
c4ca0490ee | ||
|
|
b145d47863 | ||
|
|
095827a261 | ||
|
|
87ecdb8112 | ||
|
|
98b2fa4d64 | ||
|
|
810ef7401c | ||
|
|
ae70a03383 | ||
|
|
081d132538 | ||
|
|
bb5c478704 | ||
|
|
ff6601f29e | ||
|
|
320c6c6f05 | ||
|
|
6b89da4bb2 | ||
|
|
5b82b9e101 | ||
|
|
1d0e862129 | ||
|
|
f089b2001f | ||
|
|
9f8420bf50 | ||
|
|
8275da63fb | ||
|
|
72696600d8 | ||
|
|
1aeb317863 | ||
|
|
b49b510732 | ||
|
|
a0d61e45d5 | ||
|
|
95f1ef7561 | ||
|
|
edb2fab64c | ||
|
|
464fb73d83 | ||
|
|
6a4e63a17d | ||
|
|
168f94d29a | ||
|
|
3c2b1baff2 | ||
|
|
f2815d7068 | ||
|
|
f48d9465f5 | ||
|
|
6b1d5c6d7b | ||
|
|
789ef3608b | ||
|
|
57b08a57a0 | ||
|
|
5b6b9f1597 | ||
|
|
47f246ba66 | ||
|
|
b6b70d54ef | ||
|
|
417d9a14cc | ||
|
|
244566ccd4 | ||
|
|
ca4a35c90a | ||
|
|
e4ea8bc867 | ||
|
|
5d840b944b | ||
|
|
1e28876494 | ||
|
|
a40b2767c5 | ||
|
|
279b536646 | ||
|
|
ff163a5ae4 | ||
|
|
65379741f7 | ||
|
|
3eb0927a2b | ||
|
|
a3a45511e5 | ||
|
|
a20ea702e2 | ||
|
|
d2d0300c7e | ||
|
|
6e8aac984f | ||
|
|
6721c70b9e | ||
|
|
b8c1c1c144 | ||
|
|
e380c01dd1 | ||
|
|
655633ef34 | ||
|
|
3d1de237f6 | ||
|
|
6a63b13d69 | ||
|
|
3aca5502dc | ||
|
|
665f4bf248 | ||
|
|
b76ff3bdfc | ||
|
|
00450cd9db | ||
|
|
c344a543b0 | ||
|
|
554202f6e8 | ||
|
|
7590cfc610 | ||
|
|
eee8338064 | ||
|
|
3b5183a74e | ||
|
|
3ee43c3abb | ||
|
|
efdb13f0c7 | ||
|
|
f013c6e48d | ||
|
|
6e67899401 | ||
|
|
381dd1ce98 | ||
|
|
b0d8369534 | ||
|
|
4a7b18d841 | ||
|
|
7c4ffe9b9a | ||
|
|
de4f8f9aaf | ||
|
|
6554cc4a8d | ||
|
|
fac47e8ecb | ||
|
|
7443305039 | ||
|
|
635ae3a523 | ||
|
|
4a05b4556e | ||
|
|
c074615550 | ||
|
|
bac2b74b3d | ||
|
|
a3aaa6634d | ||
|
|
6a3a983f43 | ||
|
|
7996edfef9 | ||
|
|
0600b32908 | ||
|
|
77343e02e9 | ||
|
|
a3d4ecddba | ||
|
|
3d3d314fb7 | ||
|
|
3f3b756b61 | ||
|
|
d3b9b8d452 | ||
|
|
390c042027 | ||
|
|
c864828735 | ||
|
|
e0c9910d85 | ||
|
|
e62f12426b | ||
|
|
d3af50e4cc | ||
|
|
cbdb700edf | ||
|
|
6010b95fca | ||
|
|
e351dde651 | ||
|
|
714bd61d56 | ||
|
|
f9e9c70b6c | ||
|
|
6123c41f13 | ||
|
|
1aaa5618de | ||
|
|
fbe8998ca8 | ||
|
|
47e8f669f5 | ||
|
|
d804ee3c07 | ||
|
|
06a78d90d9 | ||
|
|
bc2ebce086 | ||
|
|
a07de921d0 | ||
|
|
6bc67b70a6 | ||
|
|
f06addfe06 | ||
|
|
7c2c50ee16 | ||
|
|
8580d3c27e | ||
|
|
951e10f272 | ||
|
|
2349ea9405 | ||
|
|
b17bf259f7 | ||
|
|
6b093bdcca | ||
|
|
10ec319c32 | ||
|
|
8cb63cebbe | ||
|
|
7d26de6697 | ||
|
|
8262290bff | ||
|
|
2779037f13 | ||
|
|
734c85d7ef | ||
|
|
05bd5767de | ||
|
|
59d288c429 | ||
|
|
8c41c0b6a7 | ||
|
|
f5f3858da1 | ||
|
|
738490e674 | ||
|
|
6a13703e32 | ||
|
|
20d5d560f3 | ||
|
|
aaabca6fc7 | ||
|
|
4b440618d6 | ||
|
|
a360cb7922 | ||
|
|
b9a2bb8104 | ||
|
|
031a9894b0 | ||
|
|
fcc09d7ea9 | ||
|
|
d8d482e433 | ||
|
|
3fdc053d6c | ||
|
|
8be3ce18aa | ||
|
|
00107c092c | ||
|
|
64e1961193 |
@@ -1,13 +0,0 @@
|
||||
image: freebsd/latest
|
||||
sources:
|
||||
- https://git.sr.ht/~bakpakin/janet
|
||||
packages:
|
||||
- gmake
|
||||
tasks:
|
||||
- build: |
|
||||
cd janet
|
||||
gmake
|
||||
gmake test
|
||||
sudo gmake install
|
||||
gmake test-install
|
||||
gmake test-amalg
|
||||
@@ -1,13 +0,0 @@
|
||||
image: openbsd/6.5
|
||||
sources:
|
||||
- https://git.sr.ht/~bakpakin/janet
|
||||
packages:
|
||||
- gmake
|
||||
tasks:
|
||||
- build: |
|
||||
cd janet
|
||||
gmake
|
||||
gmake test
|
||||
doas gmake install
|
||||
gmake test-install
|
||||
gmake test-amalg
|
||||
12
.builds/freebsd.yml
Normal file
12
.builds/freebsd.yml
Normal file
@@ -0,0 +1,12 @@
|
||||
image: freebsd/12.x
|
||||
sources:
|
||||
- https://git.sr.ht/~bakpakin/janet
|
||||
packages:
|
||||
- gmake
|
||||
tasks:
|
||||
- build: |
|
||||
cd janet
|
||||
gmake
|
||||
gmake test
|
||||
sudo gmake install
|
||||
gmake test-install
|
||||
12
.builds/openbsd.yml
Normal file
12
.builds/openbsd.yml
Normal file
@@ -0,0 +1,12 @@
|
||||
image: openbsd/latest
|
||||
sources:
|
||||
- https://git.sr.ht/~bakpakin/janet
|
||||
packages:
|
||||
- gmake
|
||||
tasks:
|
||||
- build: |
|
||||
cd janet
|
||||
gmake
|
||||
gmake test
|
||||
doas gmake install
|
||||
gmake test-install
|
||||
3
.gitignore
vendored
3
.gitignore
vendored
@@ -13,6 +13,9 @@ janet
|
||||
janet-*.tar.gz
|
||||
dist
|
||||
|
||||
# jpm lockfile
|
||||
lockfile.janet
|
||||
|
||||
# Kakoune (fzf via fd)
|
||||
.fdignore
|
||||
|
||||
|
||||
@@ -4,7 +4,6 @@ script:
|
||||
- make test
|
||||
- sudo make install
|
||||
- make test-install
|
||||
- make test-amalg
|
||||
- make build/janet-${TRAVIS_TAG}-${TRAVIS_OS_NAME}.tar.gz
|
||||
compiler:
|
||||
- clang
|
||||
|
||||
57
CHANGELOG.md
57
CHANGELOG.md
@@ -1,7 +1,60 @@
|
||||
# Changelog
|
||||
All notable changes to this project will be documented in this file.
|
||||
|
||||
### 1.7.0 - 2020-02-01
|
||||
## Unreleased - ???
|
||||
- Add `jpm rule-tree` subcommand.
|
||||
- Add `--offline` flag to jpm to force use of the cache.
|
||||
- Allow sending pointers and C functions across threads via `thread/send`.
|
||||
- Fix bug in `getline`.
|
||||
- Add `sh-rule` and `sh-phony` to jpm's dialect of Janet.
|
||||
- Change C api's `janet_formatb` -> `janet_formatbv`, and add new function `janet_formatb` to C api.
|
||||
- Add `edefer` macro to core.
|
||||
- A struct/table literal/constructor with duplicate keys will use the last value given.
|
||||
Previously, this was inconsistent between tables and structs, literals and constructor functions.
|
||||
- Add debugger to core. The debugger functions are only available
|
||||
in a debug repl, and are prefixed by a `.`.
|
||||
- Add `sort-by` and `sorted-by` to core.
|
||||
- Support UTF-8 escapes in strings via `\uXXXX` or `\UXXXXXX`.
|
||||
- Add `math/erf`
|
||||
- Add `math/erfc`
|
||||
- Add `math/log1p`
|
||||
- Add `math/next`
|
||||
- Add os/umask
|
||||
- Add os/perm-int
|
||||
- Add os/perm-string
|
||||
- Add :octal-permissions option for os/stat.
|
||||
- Add `jpm repl` subcommand, as well as `post-deps` macro in project.janet files.
|
||||
- Various bug fixes.
|
||||
|
||||
## 1.8.1 - 2020-03-31
|
||||
- Fix bugs for big endian systems
|
||||
- Fix 1.8.0 regression on BSDs
|
||||
|
||||
## 1.8.0 - 2020-03-29
|
||||
- Add `reduce2`, `accumulate`, and `accumulate2`.
|
||||
- Add lockfiles to `jpm` via `jpm make-lockfile` and `jpm load-lockfile`.
|
||||
- Add `os/realpath` (Not supported on windows).
|
||||
- Add `os/chmod`.
|
||||
- Add `chr` macro.
|
||||
- Allow `_` in the `match` macro to match anything without creating a binding
|
||||
or doing unification. Also change behavior of matching nil.
|
||||
- Add `:range-to` and `:down-to` verbs in the `loop` macro.
|
||||
- Fix `and` and `or` macros returning nil instead of false in some cases.
|
||||
- Allow matching successfully against nil values in the `match` macro.
|
||||
- Improve `janet_formatc` and `janet_panicf` formatters to be more like `string/format`.
|
||||
This makes it easier to make nice error messages from C.
|
||||
- Add `signal`
|
||||
- Add `fiber/can-resume?`
|
||||
- Allow fiber functions to accept arguments that are passed in via `resume`.
|
||||
- Make flychecking slightly less strict but more useful
|
||||
- Correct arity for `next`
|
||||
- Correct arity for `marshal`
|
||||
- Add `flush` and `eflush`
|
||||
- Add `prompt` and `return` on top of signal for user friendly delimited continuations.
|
||||
- Fix bug in buffer/blit when using the offset-src argument.
|
||||
- Fix segfault with malformed pegs.
|
||||
|
||||
## 1.7.0 - 2020-02-01
|
||||
- Remove `file/fileno` and `file/fdopen`.
|
||||
- Remove `==`, `not==`, `order<`, `order>`, `order<=`, and `order>=`. Instead, use the normal
|
||||
comparison and equality functions.
|
||||
@@ -32,7 +85,7 @@ All notable changes to this project will be documented in this file.
|
||||
- Fix thread module issue where sometimes decoding a message failed.
|
||||
- Fix segfault regression when macros are called with bad arity.
|
||||
|
||||
### 1.6.0 - 2019-12-22
|
||||
## 1.6.0 - 2019-12-22
|
||||
- Add `thread/` module to the core.
|
||||
- Allow seeding RNGs with any sequence of bytes. This provides
|
||||
a wider key space for the RNG. Exposed in C as `janet_rng_longseed`.
|
||||
|
||||
86
Makefile
86
Makefile
@@ -27,7 +27,7 @@ PREFIX?=/usr/local
|
||||
INCLUDEDIR?=$(PREFIX)/include
|
||||
BINDIR?=$(PREFIX)/bin
|
||||
LIBDIR?=$(PREFIX)/lib
|
||||
JANET_BUILD?="\"$(shell git log --pretty=format:'%h' -n 1 || 'local')\""
|
||||
JANET_BUILD?="\"$(shell git log --pretty=format:'%h' -n 1 || echo local)\""
|
||||
CLIBS=-lm -lpthread
|
||||
JANET_TARGET=build/janet
|
||||
JANET_LIBRARY=build/libjanet.so
|
||||
@@ -36,9 +36,9 @@ JANET_PATH?=$(LIBDIR)/janet
|
||||
MANPATH?=$(PREFIX)/share/man/man1/
|
||||
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 \
|
||||
-DJANET_BUILD=$(JANET_BUILD)
|
||||
CFLAGS:=$(CFLAGS) -std=c99 -Wall -Wextra -Isrc/include -Isrc/conf -fPIC -O2 -fvisibility=hidden
|
||||
LDFLAGS:=$(LDFLAGS) -rdynamic
|
||||
|
||||
# For installation
|
||||
@@ -48,13 +48,14 @@ LDCONFIG:=ldconfig "$(LIBDIR)"
|
||||
UNAME:=$(shell uname -s)
|
||||
ifeq ($(UNAME), Darwin)
|
||||
CLIBS:=$(CLIBS) -ldl
|
||||
LDCONFIG:=
|
||||
SONAME_SETTER:=-Wl,-install_name,
|
||||
LDCONFIG:=true
|
||||
else ifeq ($(UNAME), Linux)
|
||||
CLIBS:=$(CLIBS) -lrt -ldl
|
||||
endif
|
||||
# For other unix likes, add flags here!
|
||||
ifeq ($(UNAME), Haiku)
|
||||
LDCONFIG:=
|
||||
LDCONFIG:=true
|
||||
LDFLAGS=-Wl,--export-dynamic
|
||||
endif
|
||||
|
||||
@@ -129,14 +130,15 @@ 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)
|
||||
$(CC) $(CFLAGS) -DJANET_BOOTSTRAP -o $@ -c $<
|
||||
$(CC) $(BOOT_CFLAGS) -o $@ -c $<
|
||||
|
||||
build/janet_boot: $(JANET_BOOT_OBJECTS)
|
||||
$(CC) $(CFLAGS) -DJANET_BOOTSTRAP -o $@ $(JANET_BOOT_OBJECTS) $(CLIBS)
|
||||
$(CC) $(BOOT_CFLAGS) -o $@ $(JANET_BOOT_OBJECTS) $(CLIBS)
|
||||
|
||||
# Now the reason we bootstrap in the first place
|
||||
build/janet.c: build/janet_boot src/boot/boot.janet
|
||||
@@ -146,6 +148,8 @@ build/janet.c: build/janet_boot src/boot/boot.janet
|
||||
##### Amalgamation #####
|
||||
########################
|
||||
|
||||
SONAME=libjanet.so.1.9
|
||||
|
||||
build/shell.c: src/mainclient/shell.c
|
||||
cp $< $@
|
||||
|
||||
@@ -165,7 +169,7 @@ $(JANET_TARGET): build/janet.o build/shell.o
|
||||
$(CC) $(LDFLAGS) $(CFLAGS) -o $@ $^ $(CLIBS)
|
||||
|
||||
$(JANET_LIBRARY): build/janet.o build/shell.o
|
||||
$(CC) $(LDFLAGS) $(CFLAGS) -shared -o $@ $^ $(CLIBS)
|
||||
$(CC) $(LDFLAGS) $(CFLAGS) $(SONAME_SETTER)$(SONAME) -shared -o $@ $^ $(CLIBS)
|
||||
|
||||
$(JANET_STATIC_LIBRARY): build/janet.o build/shell.o
|
||||
$(AR) rcs $@ $^
|
||||
@@ -228,9 +232,7 @@ build/doc.html: $(JANET_TARGET) tools/gendoc.janet
|
||||
##### Installation #####
|
||||
########################
|
||||
|
||||
SONAME=libjanet.so.1
|
||||
|
||||
.PHONY: build/janet.pc
|
||||
.INTERMEDIATE: build/janet.pc
|
||||
build/janet.pc: $(JANET_TARGET)
|
||||
echo 'prefix=$(PREFIX)' > $@
|
||||
echo 'exec_prefix=$${prefix}' >> $@
|
||||
@@ -242,37 +244,37 @@ build/janet.pc: $(JANET_TARGET)
|
||||
echo "Description: Library for the Janet programming language." >> $@
|
||||
$(JANET_TARGET) -e '(print "Version: " janet/version)' >> $@
|
||||
echo 'Cflags: -I$${includedir}' >> $@
|
||||
echo 'Libs: -L$${libdir} -ljanet $(LDFLAGS)' >> $@
|
||||
echo 'Libs: -L$${libdir} -ljanet' >> $@
|
||||
echo 'Libs.private: $(CLIBS)' >> $@
|
||||
|
||||
install: $(JANET_TARGET) build/janet.pc
|
||||
mkdir -p '$(BINDIR)'
|
||||
cp $(JANET_TARGET) '$(BINDIR)/janet'
|
||||
mkdir -p '$(INCLUDEDIR)/janet'
|
||||
cp -rf $(JANET_HEADERS) '$(INCLUDEDIR)/janet'
|
||||
mkdir -p '$(JANET_PATH)'
|
||||
mkdir -p '$(LIBDIR)'
|
||||
cp $(JANET_LIBRARY) '$(LIBDIR)/libjanet.so.$(shell $(JANET_TARGET) -e '(print janet/version)')'
|
||||
cp $(JANET_STATIC_LIBRARY) '$(LIBDIR)/libjanet.a'
|
||||
ln -sf $(SONAME) '$(LIBDIR)/libjanet.so'
|
||||
ln -sf libjanet.so.$(shell $(JANET_TARGET) -e '(print janet/version)') $(LIBDIR)/$(SONAME)
|
||||
cp -rf auxbin/* '$(BINDIR)'
|
||||
mkdir -p '$(MANPATH)'
|
||||
cp janet.1 '$(MANPATH)'
|
||||
cp jpm.1 '$(MANPATH)'
|
||||
mkdir -p '$(PKG_CONFIG_PATH)'
|
||||
cp build/janet.pc '$(PKG_CONFIG_PATH)/janet.pc'
|
||||
-$(LDCONFIG)
|
||||
mkdir -p '$(DESTDIR)$(BINDIR)'
|
||||
cp $(JANET_TARGET) '$(DESTDIR)$(BINDIR)/janet'
|
||||
mkdir -p '$(DESTDIR)$(INCLUDEDIR)/janet'
|
||||
cp -rf $(JANET_HEADERS) '$(DESTDIR)$(INCLUDEDIR)/janet'
|
||||
mkdir -p '$(DESTDIR)$(JANET_PATH)'
|
||||
mkdir -p '$(DESTDIR)$(LIBDIR)'
|
||||
cp $(JANET_LIBRARY) '$(DESTDIR)$(LIBDIR)/libjanet.so.$(shell $(JANET_TARGET) -e '(print janet/version)')'
|
||||
cp $(JANET_STATIC_LIBRARY) '$(DESTDIR)$(LIBDIR)/libjanet.a'
|
||||
ln -sf $(SONAME) '$(DESTDIR)$(LIBDIR)/libjanet.so'
|
||||
ln -sf libjanet.so.$(shell $(JANET_TARGET) -e '(print janet/version)') $(DESTDIR)$(LIBDIR)/$(SONAME)
|
||||
cp -rf auxbin/* '$(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'
|
||||
[ -z '$(DESTDIR)' ] && $(LDCONFIG) || true
|
||||
|
||||
uninstall:
|
||||
-rm '$(BINDIR)/janet'
|
||||
-rm '$(BINDIR)/jpm'
|
||||
-rm -rf '$(INCLUDEDIR)/janet'
|
||||
-rm -rf '$(LIBDIR)'/libjanet.*
|
||||
-rm '$(PKG_CONFIG_PATH)/janet.pc'
|
||||
-rm '$(MANPATH)/janet.1'
|
||||
-rm '$(MANPATH)/jpm.1'
|
||||
# -rm -rf '$(JANET_PATH)'/* - err on the side of correctness here
|
||||
-rm '$(DESTDIR)$(BINDIR)/janet'
|
||||
-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 -rf '$(DESTDIR)$(JANET_PATH)'/* - err on the side of correctness here
|
||||
|
||||
#################
|
||||
##### Other #####
|
||||
@@ -301,15 +303,5 @@ test-install:
|
||||
cd test/install && jpm --verbose --test --modpath=. install https://github.com/janet-lang/path.git
|
||||
cd test/install && jpm --verbose --test --modpath=. install https://github.com/janet-lang/argparse.git
|
||||
|
||||
build/embed_janet.o: build/janet.c $(JANET_HEADERS)
|
||||
$(CC) $(CFLAGS) -c $< -o $@
|
||||
build/embed_main.o: test/amalg/main.c $(JANET_HEADERS)
|
||||
$(CC) $(CFLAGS) -c $< -o $@
|
||||
build/embed_test: build/embed_janet.o build/embed_main.o
|
||||
$(CC) $(LDFLAGS) $(CFLAGS) -o $@ $^ $(CLIBS)
|
||||
|
||||
test-amalg: build/embed_test
|
||||
./build/embed_test
|
||||
|
||||
.PHONY: clean install repl debug valgrind test \
|
||||
valtest emscripten dist uninstall docs grammar format
|
||||
|
||||
61
README.md
61
README.md
@@ -2,26 +2,28 @@
|
||||
|
||||
[](https://ci.appveyor.com/project/bakpakin/janet/branch/master)
|
||||
[](https://travis-ci.org/janet-lang/janet)
|
||||
[](https://builds.sr.ht/~bakpakin/janet/.freebsd.yaml?)
|
||||
[](https://builds.sr.ht/~bakpakin/janet/.openbsd.yaml?)
|
||||
[](https://builds.sr.ht/~bakpakin/janet/freebsd.yml?)
|
||||
[](https://builds.sr.ht/~bakpakin/janet/openbsd.yml?)
|
||||
|
||||
<img src="https://raw.githubusercontent.com/janet-lang/janet/master/assets/janet-w200.png" alt="Janet logo" width=200 align="left">
|
||||
|
||||
**Janet** is a functional and imperative programming language and bytecode interpreter. It is a
|
||||
modern lisp, but lists are replaced
|
||||
by other data structures with better utility and performance (arrays, tables, structs, tuples).
|
||||
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
|
||||
to run script files. This client program is separate from the core runtime, so
|
||||
janet could be embedded into other programs. Try janet in your browser at
|
||||
Janet can be embedded into other programs. Try Janet in your browser at
|
||||
[https://janet-lang.org](https://janet-lang.org).
|
||||
|
||||
<br>
|
||||
|
||||
## Use Cases
|
||||
|
||||
Janet makes a good system scripting language, or a language to embed in other programs, like Lua or Guile.
|
||||
Janet makes a good system scripting language, or a language to embed in other programs.
|
||||
It's like Lua and Guile in that regard. It has more built-in functionality and a richer core language than
|
||||
Lua, but smaller than GNU Guile or Python.
|
||||
|
||||
## Features
|
||||
|
||||
@@ -43,7 +45,7 @@ Janet makes a good system scripting language, or a language to embed in other pr
|
||||
* Imperative programming as well as functional
|
||||
* REPL
|
||||
* Parsing Expression Grammars built in to the core library
|
||||
* 300+ functions and macros in the core library
|
||||
* 400+ functions and macros in the core library
|
||||
* Embedding Janet in other programs
|
||||
* Interactive environment with detailed stack traces
|
||||
|
||||
@@ -61,7 +63,9 @@ documentation for symbols in the core library. For example,
|
||||
Shows documentation for the doc macro.
|
||||
|
||||
To get a list of all bindings in the default
|
||||
environment, use the `(all-bindings)` function.
|
||||
environment, use the `(all-bindings)` function. You
|
||||
can also use the `(doc)` macro with no arguments if you are in the repl
|
||||
to show bound symbols.
|
||||
|
||||
## Source
|
||||
|
||||
@@ -122,7 +126,7 @@ 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 the impatient, building with Meson is as simple as follows. The options provided to
|
||||
For the impatient, building with Meson is as follows. The options provided to
|
||||
`meson setup` below emulate Janet's Makefile.
|
||||
|
||||
```sh
|
||||
@@ -152,7 +156,7 @@ Emacs, and Atom will have syntax packages for the Janet language, though.
|
||||
## Installation
|
||||
|
||||
See [the Introduction](https://janet-lang.org/introduction.html) for more details. If you just want
|
||||
to try out the language, you don't need to install anything. You can also simply move the `janet` executable wherever you want on your system and run it.
|
||||
to try out the language, you don't need to install anything. You can also move the `janet` executable wherever you want on your system and run it.
|
||||
|
||||
## Usage
|
||||
|
||||
@@ -163,35 +167,38 @@ If you are looking to explore, you can print a list of all available macros, fun
|
||||
by entering the command `(all-bindings)` into the repl.
|
||||
|
||||
```
|
||||
$ ./janet
|
||||
Janet 0.0.0 alpha Copyright (C) 2017-2018 Calvin Rose
|
||||
$ janet
|
||||
Janet 1.7.1-dev-951e10f Copyright (C) 2017-2020 Calvin Rose
|
||||
janet:1:> (+ 1 2 3)
|
||||
6
|
||||
janet:2:> (print "Hello, World!")
|
||||
Hello, World!
|
||||
nil
|
||||
janet:3:> (os/exit)
|
||||
$ ./janet -h
|
||||
usage: ./janet [options] scripts...
|
||||
$ janet -h
|
||||
usage: build/janet [options] script args...
|
||||
Options are:
|
||||
-h Show this help
|
||||
-v Print the version string
|
||||
-s Use raw stdin instead of getline like functionality
|
||||
-e 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)
|
||||
-- Stop handling option
|
||||
$
|
||||
-h : Show this help
|
||||
-v : Print the version string
|
||||
-s : Use raw stdin instead of getline like functionality
|
||||
-e code : Execute a string of janet
|
||||
-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
|
||||
-l path : Execute code in a file before running the main script
|
||||
-- : Stop handling options
|
||||
```
|
||||
|
||||
If installed, you can also run `man janet` to get usage information.
|
||||
If installed, you can also run `man janet` and `man jpm` to get usage information.
|
||||
|
||||
## Embedding
|
||||
|
||||
The C API for Janet is not yet documented but coming soon.
|
||||
|
||||
Janet can be embedded in a host program very easily. There is a make target
|
||||
`make amalg` which creates the file `build/janet.c`, which is a single C file
|
||||
Janet can be embedded in a host program very easily. The normal build
|
||||
will create a file `build/janet.c`, which is a single C file
|
||||
that contains all the source to Janet. This file, along with
|
||||
`src/include/janet.h` and `src/include/janetconf.h` can dragged into any C
|
||||
project and compiled into the project. Janet should be compiled with `-std=c99`
|
||||
@@ -200,6 +207,8 @@ the dynamic linker, `-ldl`, if one wants to be able to load dynamic modules. If
|
||||
there is no need for dynamic modules, add the define
|
||||
`-DJANET_NO_DYNAMIC_MODULES` to the compiler options.
|
||||
|
||||
See the [Embedding Section](https://janet-lang.org/capi/embedding.html) on the website for more information.
|
||||
|
||||
## Examples
|
||||
|
||||
See the examples directory for some example janet code.
|
||||
|
||||
18
appveyor.yml
18
appveyor.yml
@@ -14,24 +14,23 @@ environment:
|
||||
matrix:
|
||||
fast_finish: true
|
||||
|
||||
# skip unsupported combinations
|
||||
init:
|
||||
- call "C:\Program Files (x86)\Microsoft Visual Studio\2019\Community\VC\Auxiliary\Build\vcvarsall.bat" %platform%
|
||||
|
||||
install:
|
||||
- set JANET_BUILD=%appveyor_repo_commit:~0,7%
|
||||
before_build:
|
||||
- choco install nsis -y -pre --version 3.05
|
||||
# Replace makensis.exe and files with special long string build. This should
|
||||
# prevent issues when setting PATH during installation.
|
||||
- 7z e "tools\nsis-3.05-strlen_8192.zip" -o"C:\Program Files (x86)\NSIS\" -y
|
||||
|
||||
build_script:
|
||||
- set JANET_BUILD=%appveyor_repo_commit:~0,7%
|
||||
- build_win all
|
||||
|
||||
test_script:
|
||||
- refreshenv
|
||||
# We need to reload vcvars after refreshing
|
||||
- call "C:\Program Files (x86)\Microsoft Visual Studio\2019\Community\VC\Auxiliary\Build\vcvarsall.bat" %platform%
|
||||
- build_win test-install
|
||||
- set janet_outname=%appveyor_repo_tag_name%
|
||||
- if "%janet_outname%"=="" set janet_outname=v1.7.0
|
||||
build: off
|
||||
- if "%janet_outname%"=="" set /P janet_outname=<build\version.txt
|
||||
|
||||
artifacts:
|
||||
- name: janet.c
|
||||
@@ -49,8 +48,7 @@ artifacts:
|
||||
- name: "janet-$(janet_outname)-windows-%platform%"
|
||||
path: dist
|
||||
type: Zip
|
||||
- path: "janet-$(janet_outname)-windows-installer.exe"
|
||||
name: "janet-$(janet_outname)-windows-%platform%-installer.exe"
|
||||
- path: "janet-$(janet_outname)-windows-%platform%-installer.exe"
|
||||
type: File
|
||||
|
||||
deploy:
|
||||
|
||||
292
auxbin/jpm
292
auxbin/jpm
@@ -34,7 +34,7 @@
|
||||
(defmacro rule
|
||||
"Add a rule to the rule graph."
|
||||
[target deps & body]
|
||||
~(,rule-impl ,target ,deps (fn [] nil ,;body)))
|
||||
~(,rule-impl ,target ,deps (fn [] ,;body)))
|
||||
|
||||
(defmacro phony
|
||||
"Add a phony rule to the rule graph. A phony rule will run every time
|
||||
@@ -43,6 +43,16 @@
|
||||
[target deps & body]
|
||||
~(,rule-impl ,target ,deps (fn [] nil ,;body) true))
|
||||
|
||||
(defmacro sh-rule
|
||||
"Add a rule that invokes a shell command, and fails if the command returns non-zero."
|
||||
[target deps & body]
|
||||
~(,rule-impl ,target ,deps (fn [] (,assert (,zero? (,os/shell (,string ,;body)))))))
|
||||
|
||||
(defmacro sh-phony
|
||||
"Add a phony rule that invokes a shell command, and fails if the command returns non-zero."
|
||||
[target deps & body]
|
||||
~(,rule-impl ,target ,deps (fn [] (,assert (,zero? (,os/shell (,string ,;body))))) true))
|
||||
|
||||
(defn add-dep
|
||||
"Add a dependency to an existing rule. Useful for extending phony
|
||||
rules or extending the dependency graph of existing rules."
|
||||
@@ -157,7 +167,7 @@
|
||||
ret)
|
||||
|
||||
(defn check-cc
|
||||
"Ensure we have a c compiler"
|
||||
"Ensure we have a c compiler."
|
||||
[]
|
||||
(if is-win
|
||||
(do
|
||||
@@ -167,6 +177,14 @@
|
||||
microsoft.com"))
|
||||
(do)))
|
||||
|
||||
(defn create-dirs
|
||||
"Create all directories needed for a file (mkdir -p)."
|
||||
[dest]
|
||||
(def segs (string/split "/" dest))
|
||||
(for i 1 (length segs)
|
||||
(def path (string/join (slice segs 0 i) "/"))
|
||||
(unless (empty? path) (os/mkdir path))))
|
||||
|
||||
#
|
||||
# Importing a file
|
||||
#
|
||||
@@ -177,24 +195,46 @@
|
||||
[into x]
|
||||
(when x
|
||||
(proto-flatten into (table/getproto x))
|
||||
(loop [k :keys x]
|
||||
(put into k (x k))))
|
||||
(merge-into into x))
|
||||
into)
|
||||
|
||||
(defn import-rules
|
||||
"Import another file that defines more rules. This ruleset
|
||||
is merged into the current ruleset."
|
||||
[path]
|
||||
(defn make-jpm-env
|
||||
"Build an environment table with jpm functions preloaded."
|
||||
[&opt no-deps]
|
||||
(def env (make-env))
|
||||
(unless (os/stat path :mode)
|
||||
(error (string "cannot open " path)))
|
||||
(put env :jpm-no-deps no-deps)
|
||||
(loop [k :keys _env :when (symbol? k)]
|
||||
(unless ((_env k) :private) (put env k (_env k))))
|
||||
env)
|
||||
|
||||
(defn require-jpm
|
||||
"Require a jpm file project file. This is different from a normal require
|
||||
in that code is loaded in the jpm environment."
|
||||
[path &opt no-deps]
|
||||
(unless (os/stat path :mode)
|
||||
(error (string "cannot open " path)))
|
||||
(def env (make-jpm-env no-deps))
|
||||
(def currenv (proto-flatten @{} (fiber/getenv (fiber/current))))
|
||||
(loop [k :keys currenv :when (keyword? k)]
|
||||
(put env k (currenv k)))
|
||||
(dofile path :env env :exit true)
|
||||
(when-let [rules (env :rules)] (merge-into (getrules) rules)))
|
||||
env)
|
||||
|
||||
(defn import-rules
|
||||
"Import another file that defines more rules. This ruleset
|
||||
is merged into the current ruleset."
|
||||
[path &opt no-deps]
|
||||
(def env (require-jpm path no-deps))
|
||||
(when-let [rules (env :rules)] (merge-into (getrules) rules))
|
||||
env)
|
||||
|
||||
(defmacro post-deps
|
||||
"Run code at the top level if jpm dependencies are installed. Build
|
||||
code that imports dependencies should be wrapped with this macro, as project.janet
|
||||
needs to be able to run successfully even without dependencies installed."
|
||||
[& body]
|
||||
(unless (dyn :jpm-no-deps)
|
||||
~',(reduce |(eval $1) nil body)))
|
||||
|
||||
#
|
||||
# OS and shell helpers
|
||||
@@ -226,15 +266,12 @@
|
||||
(defn rm
|
||||
"Remove a directory and all sub directories."
|
||||
[path]
|
||||
(try
|
||||
(if (= (os/stat path :mode) :directory)
|
||||
(do
|
||||
(each subpath (os/dir path)
|
||||
(rm (string path sep subpath)))
|
||||
(os/rmdir path))
|
||||
(os/rm path))
|
||||
([err f] (unless (string/has-prefix? "No such file or directory" err)
|
||||
(propagate err f)))))
|
||||
(if (= (os/lstat path :mode) :directory)
|
||||
(do
|
||||
(each subpath (os/dir path)
|
||||
(rm (string path sep subpath)))
|
||||
(os/rmdir path))
|
||||
(os/rm path)))
|
||||
|
||||
(defn copy
|
||||
"Copy a file or directory recursively from one location to another."
|
||||
@@ -251,11 +288,7 @@
|
||||
If we can't create it, give a friendly error. Return true if created, false if
|
||||
existing. Throw an error if we can't create it."
|
||||
[dir]
|
||||
(if (os/mkdir dir)
|
||||
true
|
||||
(if (os/stat dir :mode)
|
||||
false
|
||||
(error (string "Could not create " dir " - this could be a permission issue.")))))
|
||||
(os/mkdir dir))
|
||||
|
||||
#
|
||||
# C Compilation
|
||||
@@ -316,6 +349,7 @@
|
||||
(rule dest [src ;headers]
|
||||
(check-cc)
|
||||
(print "compiling " dest "...")
|
||||
(create-dirs dest)
|
||||
(if is-win
|
||||
(shell cc ;defines "/c" ;cflags (string "/Fo" dest) src)
|
||||
(shell cc "-c" src ;defines ;cflags "-o" dest))))
|
||||
@@ -348,6 +382,7 @@
|
||||
(rule target objects
|
||||
(check-cc)
|
||||
(print "linking " target "...")
|
||||
(create-dirs target)
|
||||
(if is-win
|
||||
(shell linker ;lflags (string "/OUT:" target) ;objects (win-import-library))
|
||||
(shell linker ;cflags `-o` target ;objects ;lflags))))
|
||||
@@ -359,12 +394,14 @@
|
||||
(rule target objects
|
||||
(check-cc)
|
||||
(print "creating static library " target "...")
|
||||
(create-dirs target)
|
||||
(if is-win
|
||||
(shell ar "/nologo" (string "/out:" target) ;objects)
|
||||
(shell ar "rcs" target ;objects))))
|
||||
|
||||
(defn- create-buffer-c-impl
|
||||
[bytes dest name]
|
||||
(create-dirs dest)
|
||||
(def out (file/open dest :w))
|
||||
(def chunks (seq [b :in bytes] (string b)))
|
||||
(file/write out
|
||||
@@ -381,6 +418,7 @@
|
||||
[source dest name]
|
||||
(rule dest [source]
|
||||
(print "generating " dest "...")
|
||||
(create-dirs dest)
|
||||
(with [f (file/open source :r)]
|
||||
(create-buffer-c-impl (:read f :all) dest name))))
|
||||
|
||||
@@ -407,6 +445,7 @@
|
||||
(rule dest [source]
|
||||
(check-cc)
|
||||
(print "generating executable c source...")
|
||||
(create-dirs dest)
|
||||
# Load entry environment and get main function.
|
||||
(def entry-env (dofile source))
|
||||
(def main ((entry-env 'main) :value))
|
||||
@@ -554,6 +593,15 @@ int main(int argc, const char **argv) {
|
||||
# Public utilities
|
||||
#
|
||||
|
||||
(defn parse
|
||||
"Read a string of Janet source and parse out the first expression."
|
||||
[src]
|
||||
(let [p (parser/new)]
|
||||
(:consume p src)
|
||||
(if (= :error (:status p))
|
||||
(error (string "Could not parse: " (parser/error p))))
|
||||
(:produce p)))
|
||||
|
||||
(defn find-manifest-dir
|
||||
"Get the path to the directory containing manifests for installed
|
||||
packages."
|
||||
@@ -563,7 +611,7 @@ int main(int argc, const char **argv) {
|
||||
(defn find-manifest
|
||||
"Get the full path of a manifest file given a package name."
|
||||
[name]
|
||||
(string (find-manifest-dir) sep name ".txt"))
|
||||
(string (find-manifest-dir) sep name ".jdn"))
|
||||
|
||||
(defn find-cache
|
||||
"Return the path to the global cache."
|
||||
@@ -575,17 +623,14 @@ int main(int argc, const char **argv) {
|
||||
"Uninstall bundle named name"
|
||||
[name]
|
||||
(def manifest (find-manifest name))
|
||||
(def f (file/open manifest :r))
|
||||
(unless f (print manifest " does not exist") (break))
|
||||
(loop [line :iterate (:read f :line)]
|
||||
(def path ((string/split "\n" line) 0))
|
||||
(def path ((string/split "\r" path) 0))
|
||||
(print "removing " path)
|
||||
(rm path))
|
||||
(:close f)
|
||||
(print "removing " manifest)
|
||||
(rm manifest)
|
||||
(print "Uninstalled."))
|
||||
(when-with [f (file/open manifest)]
|
||||
(def man (parse (:read f :all)))
|
||||
(each path (get man :paths [])
|
||||
(print "removing " path)
|
||||
(rm path))
|
||||
(print "removing " manifest)
|
||||
(rm manifest)
|
||||
(print "Uninstalled.")))
|
||||
|
||||
(defn- rimraf
|
||||
"Hard delete directory tree"
|
||||
@@ -607,7 +652,7 @@ int main(int argc, const char **argv) {
|
||||
(defn install-git
|
||||
"Install a bundle from git. If the bundle is already installed, the bundle
|
||||
is reinistalled (but not rebuilt if artifacts are cached)."
|
||||
[repotab &opt recurse]
|
||||
[repotab &opt recurse no-deps]
|
||||
(def repo (if (string? repotab) repotab (repotab :repo)))
|
||||
(def tag (unless (string? repotab) (repotab :tag)))
|
||||
# prevent infinite recursion (very unlikely, but consider
|
||||
@@ -632,12 +677,16 @@ int main(int argc, const char **argv) {
|
||||
(def id (filepath-replace repo))
|
||||
(def module-dir (string cache sep id))
|
||||
(var fresh false)
|
||||
(when (mkdir module-dir)
|
||||
(set fresh true)
|
||||
(print "cloning repository " repo " to " module-dir)
|
||||
(unless (zero? (os/execute ["git" "clone" repo module-dir] :p))
|
||||
(rimraf module-dir)
|
||||
(error (string "could not clone git dependency " repo))))
|
||||
(if (dyn :offline)
|
||||
(if (not= :directory (os/stat module-dir :mode))
|
||||
(error (string "did not find cached repo for dependency " repo))
|
||||
(set fresh true))
|
||||
(when (mkdir module-dir)
|
||||
(set fresh true)
|
||||
(print "cloning repository " repo " to " module-dir)
|
||||
(unless (zero? (os/execute ["git" "clone" repo module-dir] :p))
|
||||
(rimraf module-dir)
|
||||
(error (string "could not clone git dependency " repo)))))
|
||||
(def olddir (os/cwd))
|
||||
(try
|
||||
(with-dyns [:rules @{}
|
||||
@@ -650,9 +699,10 @@ int main(int argc, const char **argv) {
|
||||
(os/execute ["git" "pull" "origin" "master"] :p))
|
||||
(when tag
|
||||
(os/execute ["git" "reset" "--hard" tag] :p))
|
||||
(os/execute ["git" "submodule" "update" "--init" "--recursive"] :p)
|
||||
(unless (dyn :offline)
|
||||
(os/execute ["git" "submodule" "update" "--init" "--recursive"] :p))
|
||||
(import-rules "./project.janet")
|
||||
(do-rule "install-deps")
|
||||
(unless no-deps (do-rule "install-deps"))
|
||||
(do-rule "build")
|
||||
(do-rule "install"))
|
||||
([err] (print "Error building git repository dependency: " err)))
|
||||
@@ -669,6 +719,49 @@ int main(int argc, const char **argv) {
|
||||
(mkdir destdir)
|
||||
(copy src destdir)))
|
||||
|
||||
(defn- pslurp
|
||||
"Like slurp, but with file/popen instead file/open. Also trims output"
|
||||
[cmd]
|
||||
(string/trim (with [f (file/popen cmd)] (:read f :all))))
|
||||
|
||||
(defn- make-lockfile
|
||||
[&opt filename]
|
||||
(default filename "lockfile.jdn")
|
||||
(def cwd (os/cwd))
|
||||
(def packages @[])
|
||||
# Read installed modules from manifests
|
||||
(def mdir (find-manifest-dir))
|
||||
(each man (os/dir mdir)
|
||||
(def package (parse (slurp (string mdir sep man))))
|
||||
(if (and (dictionary? package) (package :repo) (package :sha))
|
||||
(array/push packages package)
|
||||
(print "Cannot add local or malformed package " mdir sep man " to lockfile, skipping...")))
|
||||
# Put in correct order, such that a package is preceded by all of its dependencies
|
||||
(def ordered-packages @[])
|
||||
(def resolved @{})
|
||||
(while (< (length ordered-packages) (length packages))
|
||||
(var made-progress false)
|
||||
(each p packages
|
||||
(def {:repo r :sha s :dependencies d} p)
|
||||
(def dep-urls (map |(if (string? $) $ ($ :repo)) d))
|
||||
(unless (resolved r)
|
||||
(when (all resolved dep-urls)
|
||||
(array/push ordered-packages {:repo r :sha s})
|
||||
(set made-progress true)
|
||||
(put resolved r true))))
|
||||
(unless made-progress
|
||||
(error (string/format "could not resolve package order for: %j"
|
||||
(filter (complement resolved) (map |($ :repo) packages))))))
|
||||
# Write to file
|
||||
(with [f (file/open filename :w)] (with-dyns [:out f] (printf "%j" ordered-packages))))
|
||||
|
||||
(defn- load-lockfile
|
||||
[&opt filename]
|
||||
(default filename "lockfile.jdn")
|
||||
(def lockarray (parse (slurp filename)))
|
||||
(each {:repo url :sha sha} lockarray
|
||||
(install-git {:repo url :tag sha} nil true)))
|
||||
|
||||
#
|
||||
# Declaring Artifacts - used in project.janet, targets specifically
|
||||
# tailored for janet.
|
||||
@@ -753,13 +846,15 @@ int main(int argc, const char **argv) {
|
||||
is marshalled into bytecode which is then embedded in a final executable for distribution.\n\n
|
||||
This executable can be installed as well to the --binpath given."
|
||||
[&keys {:install install :name name :entry entry :headers headers
|
||||
:cflags cflags :lflags lflags}]
|
||||
:cflags cflags :lflags lflags :deps deps}]
|
||||
(def name (if is-win (string name ".exe") name))
|
||||
(def dest (string "build" sep name))
|
||||
(create-executable @{:cflags cflags :lflags lflags} entry dest)
|
||||
(add-dep "build" dest)
|
||||
(when headers
|
||||
(each h headers (add-dep dest h)))
|
||||
(when deps
|
||||
(each d deps (add-dep dest d)))
|
||||
(when install
|
||||
(install-rule dest (dyn :binpath JANET_BINPATH))))
|
||||
|
||||
@@ -780,6 +875,19 @@ int main(int argc, const char **argv) {
|
||||
(add-body "install"
|
||||
(spit newname bat))))
|
||||
|
||||
(defn- print-rule-tree
|
||||
"Show dependencies for a given rule recursively in a nice tree."
|
||||
[root depth prefix prefix-part]
|
||||
(print prefix root)
|
||||
(when-let [[root-deps] ((getrules) root)]
|
||||
(when (pos? depth)
|
||||
(def l (-> root-deps length dec))
|
||||
(eachp [i d] (sorted root-deps)
|
||||
(print-rule-tree
|
||||
d (dec depth)
|
||||
(string prefix-part (if (= i l) " └─" " ├─"))
|
||||
(string prefix-part (if (= i l) " " " │ ")))))))
|
||||
|
||||
(defn declare-archive
|
||||
"Build a janet archive. This is a file that bundles together many janet
|
||||
scripts into a janet image. This file can the be moved to any machine with
|
||||
@@ -789,6 +897,7 @@ int main(int argc, const char **argv) {
|
||||
(def name (opts :name))
|
||||
(def iname (string "build" sep name ".jimage"))
|
||||
(rule iname (or (opts :deps) [])
|
||||
(create-dirs iname)
|
||||
(spit iname (make-image (require entry))))
|
||||
(def path (dyn :modpath JANET_MODPATH))
|
||||
(add-dep "build" iname)
|
||||
@@ -808,13 +917,20 @@ int main(int argc, const char **argv) {
|
||||
(setdyn :manifest-dir manifests)
|
||||
(setdyn :installed-files installed-files)
|
||||
|
||||
(rule "./build" [] (mkdir "build"))
|
||||
(phony "build" ["./build"])
|
||||
(phony "build" [])
|
||||
|
||||
(phony "manifest" []
|
||||
(print "generating " manifest "...")
|
||||
(mkdir manifests)
|
||||
(spit manifest (string (string/join installed-files "\n") "\n")))
|
||||
(def sha (pslurp "git rev-parse HEAD"))
|
||||
(def url (pslurp "git remote get-url origin"))
|
||||
(def man
|
||||
{:sha (if-not (empty? sha) sha)
|
||||
:repo (if-not (empty? url) url)
|
||||
:dependencies (array/slice (get meta :dependencies []))
|
||||
:paths installed-files})
|
||||
(spit manifest (string/format "%j\n" man)))
|
||||
|
||||
(phony "install" ["uninstall" "build" "manifest"]
|
||||
(when (dyn :test)
|
||||
(do-rule "test"))
|
||||
@@ -858,8 +974,8 @@ int main(int argc, const char **argv) {
|
||||
'(* "--" '(some (if-not "=" 1)) (+ (* "=" '(any 1)) -1))))
|
||||
|
||||
(defn- local-rule
|
||||
[rule]
|
||||
(import-rules "./project.janet")
|
||||
[rule &opt no-deps]
|
||||
(import-rules "./project.janet" no-deps)
|
||||
(do-rule rule))
|
||||
|
||||
(defn- help
|
||||
@@ -886,8 +1002,20 @@ Subcommands are:
|
||||
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.
|
||||
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.
|
||||
|
||||
Keys are:
|
||||
--modpath : The directory to install modules to. Defaults to $JANET_MODPATH, $JANET_PATH, or (dyn :syspath)
|
||||
@@ -901,15 +1029,17 @@ Keys are:
|
||||
--pkglist : URL of git repository for package listing. Defaults to $JANET_PKGLIST or https://github.com/janet-lang/pkgs.git
|
||||
|
||||
Flags are:
|
||||
--nocolor : Disable color in the jpm repl.
|
||||
--verbose : Print shell commands as they are executed.
|
||||
--test : If passed to jpm install, runs tests before installing. Will run tests recursively on dependencies.
|
||||
--offline : Prevents jpm from going to network to get dependencies - all dependencies should be in the cache or this command will fail.
|
||||
`))
|
||||
|
||||
(defn- show-help
|
||||
(defn show-help
|
||||
[]
|
||||
(print help))
|
||||
|
||||
(defn- show-paths
|
||||
(defn show-paths
|
||||
[]
|
||||
(print "binpath: " (dyn :binpath JANET_BINPATH))
|
||||
(print "modpath: " (dyn :modpath JANET_MODPATH))
|
||||
@@ -917,21 +1047,21 @@ Flags are:
|
||||
(print "headerpath: " (dyn :headerpath JANET_HEADERPATH))
|
||||
(print "syspath: " (dyn :syspath)))
|
||||
|
||||
(defn- build
|
||||
(defn build
|
||||
[]
|
||||
(local-rule "build"))
|
||||
|
||||
(defn- clean
|
||||
(defn clean
|
||||
[]
|
||||
(local-rule "clean"))
|
||||
|
||||
(defn- install
|
||||
(defn install
|
||||
[&opt repo]
|
||||
(if repo
|
||||
(install-git repo)
|
||||
(local-rule "install")))
|
||||
|
||||
(defn- test
|
||||
(defn test
|
||||
[]
|
||||
(local-rule "test"))
|
||||
|
||||
@@ -941,25 +1071,55 @@ Flags are:
|
||||
(uninstall what)
|
||||
(local-rule "uninstall")))
|
||||
|
||||
(defn- deps
|
||||
(defn deps
|
||||
[]
|
||||
(local-rule "install-deps"))
|
||||
(local-rule "install-deps" true))
|
||||
|
||||
(defn- list-rules
|
||||
[]
|
||||
(defn show-rule-tree
|
||||
[&opt root depth]
|
||||
(import-rules "./project.janet")
|
||||
(def max-depth (if depth (scan-number depth) math/inf))
|
||||
(if root
|
||||
(print-rule-tree root max-depth "" "")
|
||||
(let [ks (sort (seq [k :keys (dyn :rules)] k))]
|
||||
(each k ks (print-rule-tree k max-depth "" "")))))
|
||||
|
||||
(defn list-rules
|
||||
[&opt ctx]
|
||||
(import-rules "./project.janet" true)
|
||||
(def ks (sort (seq [k :keys (dyn :rules)] k)))
|
||||
(each k ks (print k)))
|
||||
|
||||
(defn- update-pkgs
|
||||
(defn update-pkgs
|
||||
[]
|
||||
(install-git (dyn :pkglist default-pkglist)))
|
||||
|
||||
(defn- quickbin
|
||||
(defn quickbin
|
||||
[input output]
|
||||
(create-executable @{} input output)
|
||||
(do-rule output))
|
||||
|
||||
(defn jpm-repl
|
||||
[]
|
||||
(def env
|
||||
(try
|
||||
(require-jpm "./project.janet")
|
||||
([err f]
|
||||
(if (= "cannot open ./project.janet" err)
|
||||
(put (make-jpm-env) :project {})
|
||||
(propagate err f)))))
|
||||
(setdyn :pretty-format (if-not (dyn :nocolor) "%.20Q" "%.20q"))
|
||||
(setdyn :err-color (if-not (dyn :nocolor) true))
|
||||
(def p (env :project))
|
||||
(def name (p :name))
|
||||
(if name (print "Project: " name))
|
||||
(if-let [r (p :repo)] (print "Repository: " r))
|
||||
(if-let [a (p :author)] (print "Author: " a))
|
||||
(defn getchunk [buf p]
|
||||
(def [line] (parser/where p))
|
||||
(getline (string "jpm[" (or name "repl") "]:" line ":" (parser/state p :delimiters) "> ") buf env))
|
||||
(repl getchunk nil env))
|
||||
|
||||
(def- subcommands
|
||||
{"build" build
|
||||
"clean" clean
|
||||
@@ -968,12 +1128,16 @@ Flags are:
|
||||
"test" test
|
||||
"help" help
|
||||
"deps" deps
|
||||
"repl" jpm-repl
|
||||
"rule-tree" show-rule-tree
|
||||
"show-paths" show-paths
|
||||
"clear-cache" clear-cache
|
||||
"run" local-rule
|
||||
"rules" list-rules
|
||||
"update-pkgs" update-pkgs
|
||||
"uninstall" uninstall-cmd
|
||||
"make-lockfile" make-lockfile
|
||||
"load-lockfile" load-lockfile
|
||||
"quickbin" quickbin})
|
||||
|
||||
(def- args (tuple/slice (dyn :args) 1))
|
||||
|
||||
@@ -131,7 +131,7 @@ exit /b 0
|
||||
@rem Run the installer. (Installs to the local user with default settings)
|
||||
:INSTALL
|
||||
@echo Running Installer...
|
||||
FOR %%a in (janet-*-windows-installer.exe) DO (
|
||||
FOR %%a in (janet-*-windows-*-installer.exe) DO (
|
||||
%%a /S /CurrentUser
|
||||
)
|
||||
exit /b 0
|
||||
|
||||
@@ -1,20 +1,18 @@
|
||||
###
|
||||
### A useful debugger library for Janet. Should be used
|
||||
### inside a debug repl.
|
||||
### inside a debug repl. This has been moved into the core.
|
||||
###
|
||||
|
||||
(defn .fiber
|
||||
"Get the current fiber being debugged."
|
||||
[]
|
||||
(if-let [entry (dyn '_fiber)]
|
||||
(entry :value)
|
||||
(dyn :fiber)))
|
||||
(dyn :fiber))
|
||||
|
||||
(defn .stack
|
||||
"Print the current fiber stack"
|
||||
[]
|
||||
(print)
|
||||
(debug/stacktrace (.fiber) "")
|
||||
(with-dyns [:err-color false] (debug/stacktrace (.fiber) ""))
|
||||
(print))
|
||||
|
||||
(defn .frame
|
||||
|
||||
@@ -1,3 +1,6 @@
|
||||
# This file is invoked by build_win.bat
|
||||
# Relevant configuration variables are set there.
|
||||
|
||||
Unicode True
|
||||
|
||||
!echo "Program Files: ${PROGRAMFILES}"
|
||||
@@ -20,6 +23,9 @@ VIFileVersion "${PRODUCT_VERSION}"
|
||||
|
||||
!if ${SIXTYFOUR} == "true"
|
||||
!define MULTIUSER_USE_PROGRAMFILES64
|
||||
!define PLATNAME "x64"
|
||||
!else
|
||||
!define PLATNAME "x86"
|
||||
!endif
|
||||
|
||||
# Includes
|
||||
@@ -36,12 +42,12 @@ Name "Janet"
|
||||
!define DOLLAR "$"
|
||||
!ifdef CHECK_${DOLLAR}%APPVEYOR_REPO_TAG_NAME%
|
||||
# We are not in the appveyor environment, use version name
|
||||
!define OUTNAME_PART v${VERSION}
|
||||
!define OUTNAME_PART ${VERSION}
|
||||
!else
|
||||
# We are in appveyor, use git tag name for installer
|
||||
!define OUTNAME_PART ${OUTNAME}
|
||||
!endif
|
||||
OutFile "janet-${OUTNAME_PART}-windows-installer.exe"
|
||||
OutFile "janet-${OUTNAME_PART}-windows-${PLATNAME}-installer.exe"
|
||||
|
||||
# Some Configuration
|
||||
!define APPNAME "Janet"
|
||||
|
||||
10
janet.1
10
janet.1
@@ -96,6 +96,10 @@ Delete everything before the cursor on the input line.
|
||||
.BR Ctrl\-W
|
||||
Delete one word before the cursor.
|
||||
|
||||
.TP 16
|
||||
.BR Ctrl\-G
|
||||
Show documentation for the current symbol under the cursor.
|
||||
|
||||
.TP 16
|
||||
.BR Alt\-B/Alt\-F
|
||||
Move cursor backwards and forwards one word.
|
||||
@@ -148,6 +152,12 @@ Read raw input from stdin and forgo prompt history and other readline-like featu
|
||||
Execute a string of Janet source. Source code is executed in the order it is encountered, so earlier
|
||||
arguments are executed before later ones.
|
||||
|
||||
.TP
|
||||
.BR \-d
|
||||
Enable debug mode. On all terminating signals as well the debug signal, this will
|
||||
cause the debugger to come up in the REPL. Same as calling (setdyn :debug true) in a
|
||||
default repl.
|
||||
|
||||
.TP
|
||||
.BR \-n
|
||||
Disable ANSI colors in the repl. Has no effect if no repl is run.
|
||||
|
||||
33
jpm.1
33
jpm.1
@@ -24,6 +24,10 @@ More interesting are the local commands. For more information on jpm usage, see
|
||||
|
||||
.SH FLAGS
|
||||
|
||||
.TP
|
||||
.BR \-\-nocolor
|
||||
Disable color in the jpm repl.
|
||||
|
||||
.TP
|
||||
.BR \-\-verbose
|
||||
Print detailed messages of what jpm is doing, including compilation commands and other shell commands.
|
||||
@@ -32,6 +36,12 @@ Print detailed messages of what jpm is doing, including compilation commands and
|
||||
.BR \-\-test
|
||||
If passed to jpm install, runs tests before installing. Will run tests recursively on dependencies.
|
||||
|
||||
.TP
|
||||
.BR \-\-offline
|
||||
Prevents jpm from going to network to get dependencies - all dependencies should be in the cache or this command will fail.
|
||||
Use this flag with the deps and update-pkgs subcommands. This is not a surefire way to prevent a build script from accessing
|
||||
the network, for example, a build script that invokes curl will still have network access.
|
||||
|
||||
.SH OPTIONS
|
||||
|
||||
.TP
|
||||
@@ -139,6 +149,12 @@ like make. run will run a single rule or build a single file.
|
||||
.BR rules
|
||||
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]
|
||||
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.
|
||||
|
||||
.TP
|
||||
.BR show-paths
|
||||
Show all of the paths used when installing and building artifacts.
|
||||
@@ -154,6 +170,23 @@ The main function is the entry point of the program and will receive command lin
|
||||
as function arguments. The entry file can import other modules, including native C modules, and
|
||||
jpm will attempt to include the dependencies into the generated executable.
|
||||
|
||||
.TP
|
||||
.BR repl
|
||||
Load the current project.janet file and start a repl in it's environment. This lets a user better
|
||||
debug the project file, as well as run rules manually.
|
||||
|
||||
.TP
|
||||
.BR make-lockfile\ [\fBfilename\fR]
|
||||
Create a lockfile. A lockfile is a record that describes what dependencies were installed at the
|
||||
time of the lockfile's creation, including exact versions. A lockfile can then be later used
|
||||
to set up that environment on a different machine via load-lockfile. By default, the lockfile
|
||||
is created at lockfile.jdn, although any path can be used.
|
||||
|
||||
.TP
|
||||
.BR load-lockfile\ [\fBfilename\fR]
|
||||
Install dependencies from a lockfile previously created with make-lockfile. By default, will look
|
||||
for a lockfile at lockfile.jdn, although any path can be used.
|
||||
|
||||
.SH ENVIRONMENT
|
||||
|
||||
.B JANET_PATH
|
||||
|
||||
14
meson.build
14
meson.build
@@ -20,7 +20,7 @@
|
||||
|
||||
project('janet', 'c',
|
||||
default_options : ['c_std=c99', 'b_lundef=false', 'default_library=both'],
|
||||
version : '1.7.0')
|
||||
version : '1.9.0-dev')
|
||||
|
||||
# Global settings
|
||||
janet_path = join_paths(get_option('prefix'), get_option('libdir'), 'janet')
|
||||
@@ -160,13 +160,15 @@ janetc = custom_target('janetc',
|
||||
output : 'janet.c',
|
||||
capture : true,
|
||||
command : [
|
||||
janet_boot, '@CURRENT_SOURCE_DIR@',
|
||||
janet_boot, meson.current_source_dir(),
|
||||
'JANET_PATH', janet_path, 'JANET_HEADERPATH', header_path
|
||||
])
|
||||
|
||||
libjanet = library('janet', janetc,
|
||||
include_directories : incdir,
|
||||
dependencies : [m_dep, dl_dep, thread_dep],
|
||||
version: meson.project_version(),
|
||||
soversion: version_parts[0] + '.' + version_parts[1],
|
||||
install : true)
|
||||
|
||||
# Extra c flags - adding -fvisibility=hidden matches the Makefile and
|
||||
@@ -216,7 +218,8 @@ test_files = [
|
||||
'test/suite4.janet',
|
||||
'test/suite5.janet',
|
||||
'test/suite6.janet',
|
||||
'test/suite7.janet'
|
||||
'test/suite7.janet',
|
||||
'test/suite8.janet'
|
||||
]
|
||||
foreach t : test_files
|
||||
test(t, janet_nativeclient, args : files([t]), workdir : meson.current_source_dir())
|
||||
@@ -229,6 +232,11 @@ run_target('repl', command : [janet_nativeclient])
|
||||
janet_dep = declare_dependency(include_directories : incdir,
|
||||
link_with : libjanet)
|
||||
|
||||
# pkgconfig
|
||||
pkg = import('pkgconfig')
|
||||
pkg.generate(libjanet,
|
||||
description: 'Library for the Janet programming language.')
|
||||
|
||||
# Installation
|
||||
install_man('janet.1')
|
||||
install_man('jpm.1')
|
||||
|
||||
@@ -104,7 +104,8 @@ int main(int argc, const char **argv) {
|
||||
}
|
||||
fclose(boot_file);
|
||||
|
||||
status = janet_dobytes(env, boot_buffer, boot_size, boot_filename, NULL);
|
||||
status = janet_dobytes(env, boot_buffer, (int32_t) boot_size, boot_filename, NULL);
|
||||
free(boot_buffer);
|
||||
|
||||
/* Deinitialize vm */
|
||||
janet_deinit();
|
||||
|
||||
File diff suppressed because it is too large
Load Diff
@@ -50,5 +50,20 @@ int system_test() {
|
||||
assert(janet_equals(janet_cstringv("a string."), janet_cstringv("a string.")));
|
||||
assert(janet_equals(janet_csymbolv("sym"), janet_csymbolv("sym")));
|
||||
|
||||
Janet *t1 = janet_tuple_begin(3);
|
||||
t1[0] = janet_wrap_nil();
|
||||
t1[1] = janet_wrap_integer(4);
|
||||
t1[2] = janet_cstringv("hi");
|
||||
Janet tuple1 = janet_wrap_tuple(janet_tuple_end(t1));
|
||||
|
||||
Janet *t2 = janet_tuple_begin(3);
|
||||
t2[0] = janet_wrap_nil();
|
||||
t2[1] = janet_wrap_integer(4);
|
||||
t2[2] = janet_cstringv("hi");
|
||||
Janet tuple2 = janet_wrap_tuple(janet_tuple_end(t2));
|
||||
|
||||
assert(janet_equals(tuple1, tuple2));
|
||||
|
||||
|
||||
return 0;
|
||||
}
|
||||
|
||||
@@ -27,10 +27,10 @@
|
||||
#define JANETCONF_H
|
||||
|
||||
#define JANET_VERSION_MAJOR 1
|
||||
#define JANET_VERSION_MINOR 7
|
||||
#define JANET_VERSION_MINOR 9
|
||||
#define JANET_VERSION_PATCH 0
|
||||
#define JANET_VERSION_EXTRA ""
|
||||
#define JANET_VERSION "1.7.0"
|
||||
#define JANET_VERSION "1.9.0-dev"
|
||||
|
||||
/* #define JANET_BUILD "local" */
|
||||
|
||||
|
||||
@@ -707,6 +707,9 @@ static JanetAssembleResult janet_asm1(JanetAssembler *parent, Janet source, int
|
||||
if (janet_indexed_view(x, &arr, &count)) {
|
||||
janet_asm_assert(&a, count == def->bytecode_length, "sourcemap must have the same length as the bytecode");
|
||||
def->sourcemap = malloc(sizeof(JanetSourceMapping) * (size_t) count);
|
||||
if (NULL == def->sourcemap) {
|
||||
JANET_OUT_OF_MEMORY;
|
||||
}
|
||||
for (i = 0; i < count; i++) {
|
||||
const Janet *tup;
|
||||
Janet entry = arr[i];
|
||||
@@ -730,6 +733,9 @@ static JanetAssembleResult janet_asm1(JanetAssembler *parent, Janet source, int
|
||||
/* Set environments */
|
||||
def->environments =
|
||||
realloc(def->environments, def->environments_length * sizeof(int32_t));
|
||||
if (NULL == def->environments) {
|
||||
JANET_OUT_OF_MEMORY;
|
||||
}
|
||||
|
||||
/* Verify the func def */
|
||||
if (janet_verify(def)) {
|
||||
|
||||
@@ -334,13 +334,15 @@ static Janet cfun_buffer_blit(int32_t argc, Janet *argv) {
|
||||
} else {
|
||||
length_src = src.len - offset_src;
|
||||
}
|
||||
int64_t last = ((int64_t) offset_dest - offset_src) + length_src;
|
||||
int64_t last = (int64_t) offset_dest + length_src;
|
||||
if (last > INT32_MAX)
|
||||
janet_panic("buffer blit out of range");
|
||||
janet_buffer_ensure(dest, (int32_t) last, 2);
|
||||
if (last > dest->count) dest->count = (int32_t) last;
|
||||
int32_t last32 = (int32_t) last;
|
||||
janet_buffer_ensure(dest, last32, 2);
|
||||
if (last32 > dest->count) dest->count = last32;
|
||||
if (length_src) {
|
||||
if (same_buf) {
|
||||
/* janet_buffer_ensure may have invalidated src */
|
||||
src.bytes = dest->data;
|
||||
memmove(dest->data + offset_dest, src.bytes + offset_src, length_src);
|
||||
} else {
|
||||
@@ -387,7 +389,7 @@ static const JanetReg buffer_cfuns[] = {
|
||||
"buffer/push-word", cfun_buffer_word,
|
||||
JDOC("(buffer/push-word buffer x)\n\n"
|
||||
"Append a machine word to a buffer. The 4 bytes of the integer are appended "
|
||||
"in twos complement, big endian order, unsigned. Returns the modified buffer. Will "
|
||||
"in twos complement, little endian order, unsigned. Returns the modified buffer. Will "
|
||||
"throw an error if the buffer overflows.")
|
||||
},
|
||||
{
|
||||
@@ -438,7 +440,7 @@ static const JanetReg buffer_cfuns[] = {
|
||||
},
|
||||
{
|
||||
"buffer/blit", cfun_buffer_blit,
|
||||
JDOC("(buffer/blit dest src & opt dest-start src-start src-end)\n\n"
|
||||
JDOC("(buffer/blit dest src &opt dest-start src-start src-end)\n\n"
|
||||
"Insert the contents of src into dest. Can optionally take indices that "
|
||||
"indicate which part of src to copy into which part of dest. Indices can be "
|
||||
"negative to index from the end of src or dest. Returns dest.")
|
||||
|
||||
@@ -212,6 +212,7 @@ JanetFuncDef *janet_funcdef_alloc(void) {
|
||||
def->environments = NULL;
|
||||
def->constants = NULL;
|
||||
def->bytecode = NULL;
|
||||
def->closure_bitset = NULL;
|
||||
def->flags = 0;
|
||||
def->slotcount = 0;
|
||||
def->arity = 0;
|
||||
|
||||
@@ -54,7 +54,7 @@ void janet_panicf(const char *format, ...) {
|
||||
while (format[len]) len++;
|
||||
janet_buffer_init(&buffer, len);
|
||||
va_start(args, format);
|
||||
janet_formatb(&buffer, format, args);
|
||||
janet_formatbv(&buffer, format, args);
|
||||
va_end(args);
|
||||
ret = janet_string(buffer.data, buffer.count);
|
||||
janet_buffer_deinit(&buffer);
|
||||
@@ -235,18 +235,20 @@ size_t janet_getsize(const Janet *argv, int32_t n) {
|
||||
|
||||
int32_t janet_gethalfrange(const Janet *argv, int32_t n, int32_t length, const char *which) {
|
||||
int32_t raw = janet_getinteger(argv, n);
|
||||
if (raw < 0) raw += length + 1;
|
||||
if (raw < 0 || raw > length)
|
||||
janet_panicf("%s index %d out of range [0,%d]", which, raw, length);
|
||||
return raw;
|
||||
int32_t not_raw = raw;
|
||||
if (not_raw < 0) not_raw += length + 1;
|
||||
if (not_raw < 0 || not_raw > length)
|
||||
janet_panicf("%s index %d out of range [%d,%d]", which, raw, -length - 1, length);
|
||||
return not_raw;
|
||||
}
|
||||
|
||||
int32_t janet_getargindex(const Janet *argv, int32_t n, int32_t length, const char *which) {
|
||||
int32_t raw = janet_getinteger(argv, n);
|
||||
if (raw < 0) raw += length;
|
||||
if (raw < 0 || raw > length)
|
||||
janet_panicf("%s index %d out of range [0,%d)", which, raw, length);
|
||||
return raw;
|
||||
int32_t not_raw = raw;
|
||||
if (not_raw < 0) not_raw += length;
|
||||
if (not_raw < 0 || not_raw > length)
|
||||
janet_panicf("%s index %d out of range [%d,%d)", which, raw, -length, length);
|
||||
return not_raw;
|
||||
}
|
||||
|
||||
JanetView janet_getindexed(const Janet *argv, int32_t n) {
|
||||
|
||||
@@ -28,6 +28,11 @@
|
||||
#include "vector.h"
|
||||
#endif
|
||||
|
||||
static int arity1or2(JanetFopts opts, JanetSlot *args) {
|
||||
(void) opts;
|
||||
int32_t arity = janet_v_count(args);
|
||||
return arity == 1 || arity == 2;
|
||||
}
|
||||
static int fixarity1(JanetFopts opts, JanetSlot *args) {
|
||||
(void) opts;
|
||||
return janet_v_count(args) == 1;
|
||||
@@ -63,6 +68,28 @@ static JanetSlot genericSSI(JanetFopts opts, int op, JanetSlot s, int32_t imm) {
|
||||
return target;
|
||||
}
|
||||
|
||||
/* Emit an insruction that implements a form by itself. */
|
||||
static JanetSlot opfunction(
|
||||
JanetFopts opts,
|
||||
JanetSlot *args,
|
||||
int op,
|
||||
Janet defaultArg2) {
|
||||
JanetCompiler *c = opts.compiler;
|
||||
int32_t len;
|
||||
len = janet_v_count(args);
|
||||
JanetSlot t;
|
||||
if (len == 1) {
|
||||
t = janetc_gettarget(opts);
|
||||
janetc_emit_sss(c, op, t, args[0], janetc_cslot(defaultArg2), 1);
|
||||
return t;
|
||||
} else {
|
||||
/* len == 2 */
|
||||
t = janetc_gettarget(opts);
|
||||
janetc_emit_sss(c, op, t, args[0], args[1], 1);
|
||||
}
|
||||
return t;
|
||||
}
|
||||
|
||||
/* Emit a series of instructions instead of a function call to a math op */
|
||||
static JanetSlot opreduce(
|
||||
JanetFopts opts,
|
||||
@@ -113,7 +140,7 @@ static JanetSlot do_get(JanetFopts opts, JanetSlot *args) {
|
||||
return opreduce(opts, args, JOP_GET, janet_wrap_nil());
|
||||
}
|
||||
static JanetSlot do_next(JanetFopts opts, JanetSlot *args) {
|
||||
return opreduce(opts, args, JOP_NEXT, janet_wrap_nil());
|
||||
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());
|
||||
@@ -143,7 +170,7 @@ static JanetSlot do_yield(JanetFopts opts, JanetSlot *args) {
|
||||
}
|
||||
}
|
||||
static JanetSlot do_resume(JanetFopts opts, JanetSlot *args) {
|
||||
return opreduce(opts, args, JOP_RESUME, janet_wrap_nil());
|
||||
return opfunction(opts, args, JOP_RESUME, janet_wrap_nil());
|
||||
}
|
||||
static JanetSlot do_apply(JanetFopts opts, JanetSlot *args) {
|
||||
/* Push phase */
|
||||
@@ -270,7 +297,7 @@ static const JanetFunOptimizer optimizers[] = {
|
||||
{fixarity1, do_error},
|
||||
{minarity2, do_apply},
|
||||
{maxarity1, do_yield},
|
||||
{fixarity2, do_resume},
|
||||
{arity1or2, do_resume},
|
||||
{fixarity2, do_in},
|
||||
{fixarity3, do_put},
|
||||
{fixarity1, do_length},
|
||||
@@ -293,7 +320,7 @@ static const JanetFunOptimizer optimizers[] = {
|
||||
{NULL, do_neq},
|
||||
{fixarity2, do_propagate},
|
||||
{fixarity2, do_get},
|
||||
{fixarity2, do_next},
|
||||
{arity1or2, do_next},
|
||||
{fixarity2, do_modulo},
|
||||
{fixarity2, do_remainder},
|
||||
};
|
||||
|
||||
@@ -102,6 +102,7 @@ void janetc_scope(JanetScope *s, JanetCompiler *c, int flags, const char *name)
|
||||
scope.bytecode_start = janet_v_count(c->buffer);
|
||||
scope.flags = flags;
|
||||
scope.parent = c->scope;
|
||||
janetc_regalloc_init(&scope.ua);
|
||||
/* Inherit slots */
|
||||
if ((!(flags & JANET_SCOPE_FUNCTION)) && c->scope) {
|
||||
janetc_regalloc_clone(&scope.ra, &(c->scope->ra));
|
||||
@@ -149,6 +150,7 @@ void janetc_popscope(JanetCompiler *c) {
|
||||
janet_v_free(oldscope->envs);
|
||||
janet_v_free(oldscope->defs);
|
||||
janetc_regalloc_deinit(&oldscope->ra);
|
||||
janetc_regalloc_deinit(&oldscope->ua);
|
||||
/* Update pointer */
|
||||
if (newscope)
|
||||
newscope->child = NULL;
|
||||
@@ -202,7 +204,7 @@ JanetSlot janetc_resolve(
|
||||
switch (btype) {
|
||||
default:
|
||||
case JANET_BINDING_NONE:
|
||||
janetc_error(c, janet_formatc("unknown symbol %q", sym));
|
||||
janetc_error(c, janet_formatc("unknown symbol %q", janet_wrap_symbol(sym)));
|
||||
return janetc_cslot(janet_wrap_nil());
|
||||
case JANET_BINDING_DEF:
|
||||
case JANET_BINDING_MACRO: /* Macro should function like defs when not in calling pos */
|
||||
@@ -236,6 +238,11 @@ found:
|
||||
scope = scope->parent;
|
||||
janet_assert(scope, "invalid scopes");
|
||||
scope->flags |= JANET_SCOPE_ENV;
|
||||
|
||||
/* In the function scope, allocate the slot as an upvalue */
|
||||
janetc_regalloc_touch(&scope->ua, ret.index);
|
||||
|
||||
/* Iterate through child scopes and make sure environment is propagated */
|
||||
scope = scope->child;
|
||||
|
||||
/* Propagate env up to current scope */
|
||||
@@ -455,6 +462,7 @@ static JanetSlot janetc_call(JanetFopts opts, JanetSlot *slots, JanetSlot fun) {
|
||||
break;
|
||||
case JANET_CFUNCTION:
|
||||
case JANET_ABSTRACT:
|
||||
case JANET_NIL:
|
||||
break;
|
||||
case JANET_KEYWORD:
|
||||
if (min_arity == 0) {
|
||||
@@ -736,6 +744,21 @@ JanetFuncDef *janetc_pop_funcdef(JanetCompiler *c) {
|
||||
def->flags |= JANET_FUNCDEF_FLAG_NEEDSENV;
|
||||
}
|
||||
|
||||
/* Copy upvalue bitset */
|
||||
if (scope->ua.count) {
|
||||
/* Number of u32s we need to create a bitmask for all slots */
|
||||
int32_t numchunks = (def->slotcount + 31) >> 5;
|
||||
uint32_t *chunks = malloc(sizeof(uint32_t) * numchunks);
|
||||
if (NULL == chunks) {
|
||||
JANET_OUT_OF_MEMORY;
|
||||
}
|
||||
memcpy(chunks, scope->ua.chunks, sizeof(uint32_t) * numchunks);
|
||||
/* 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 */
|
||||
janetc_popscope(c);
|
||||
|
||||
|
||||
@@ -127,7 +127,10 @@ struct JanetScope {
|
||||
/* Regsiter allocator */
|
||||
JanetcRegisterAllocator ra;
|
||||
|
||||
/* Referenced closure environents. The values at each index correspond
|
||||
/* Upvalue allocator */
|
||||
JanetcRegisterAllocator ua;
|
||||
|
||||
/* Referenced closure environments. The values at each index correspond
|
||||
* to which index to get the environment from in the parent. The environment
|
||||
* that corresponds to the direct parent's stack will always have value 0. */
|
||||
int32_t *envs;
|
||||
|
||||
@@ -435,7 +435,7 @@ static Janet janet_core_hash(int32_t argc, Janet *argv) {
|
||||
static Janet janet_core_getline(int32_t argc, Janet *argv) {
|
||||
FILE *in = janet_dynfile("in", stdin);
|
||||
FILE *out = janet_dynfile("out", stdout);
|
||||
janet_arity(argc, 0, 2);
|
||||
janet_arity(argc, 0, 3);
|
||||
JanetBuffer *buf = (argc >= 2) ? janet_getbuffer(argv, 1) : janet_buffer(10);
|
||||
if (argc >= 1) {
|
||||
const char *prompt = (const char *) janet_getstring(argv, 0);
|
||||
@@ -489,6 +489,31 @@ ret_false:
|
||||
return janet_wrap_false();
|
||||
}
|
||||
|
||||
static Janet janet_core_signal(int32_t argc, Janet *argv) {
|
||||
janet_arity(argc, 1, 2);
|
||||
int sig;
|
||||
if (janet_checkint(argv[0])) {
|
||||
int32_t s = janet_unwrap_integer(argv[0]);
|
||||
if (s < 0 || s > 9) {
|
||||
janet_panicf("expected user signal between 0 and 9, got %d", s);
|
||||
}
|
||||
sig = JANET_SIGNAL_USER0 + s;
|
||||
} else {
|
||||
JanetKeyword kw = janet_getkeyword(argv, 0);
|
||||
if (!janet_cstrcmp(kw, "yield")) {
|
||||
sig = JANET_SIGNAL_YIELD;
|
||||
} else if (!janet_cstrcmp(kw, "error")) {
|
||||
sig = JANET_SIGNAL_ERROR;
|
||||
} else if (!janet_cstrcmp(kw, "debug")) {
|
||||
sig = JANET_SIGNAL_DEBUG;
|
||||
} else {
|
||||
janet_panicf("unknown signal, expected :yield, :error, or :debug, got %v", argv[0]);
|
||||
}
|
||||
}
|
||||
Janet payload = argc == 2 ? argv[1] : janet_wrap_nil();
|
||||
janet_signalv(sig, payload);
|
||||
}
|
||||
|
||||
static const JanetReg corelib_cfuns[] = {
|
||||
{
|
||||
"native", janet_core_native,
|
||||
@@ -599,11 +624,10 @@ static const JanetReg corelib_cfuns[] = {
|
||||
{
|
||||
"type", janet_core_type,
|
||||
JDOC("(type x)\n\n"
|
||||
"Returns the type of x as a keyword symbol. x is one of\n"
|
||||
"Returns the type of x as a keyword. x is one of\n"
|
||||
"\t:nil\n"
|
||||
"\t:boolean\n"
|
||||
"\t:integer\n"
|
||||
"\t:real\n"
|
||||
"\t:number\n"
|
||||
"\t:array\n"
|
||||
"\t:tuple\n"
|
||||
"\t:table\n"
|
||||
@@ -614,7 +638,7 @@ static const JanetReg corelib_cfuns[] = {
|
||||
"\t:keyword\n"
|
||||
"\t:function\n"
|
||||
"\t:cfunction\n\n"
|
||||
"or another symbol for an abstract type.")
|
||||
"or another keyword for an abstract type.")
|
||||
},
|
||||
{
|
||||
"hash", janet_core_hash,
|
||||
@@ -627,7 +651,7 @@ static const JanetReg corelib_cfuns[] = {
|
||||
"getline", janet_core_getline,
|
||||
JDOC("(getline &opt prompt buf env)\n\n"
|
||||
"Reads a line of input into a buffer, including the newline character, using a prompt. "
|
||||
"An optional environment table can be provided for autocomplete. "
|
||||
"An optional environment table can be provided for auto-complete. "
|
||||
"Returns the modified buffer. "
|
||||
"Use this function to implement a simple interface for a terminal program.")
|
||||
},
|
||||
@@ -661,7 +685,7 @@ static const JanetReg corelib_cfuns[] = {
|
||||
"\t:all:\tthe value of path verbatim\n"
|
||||
"\t:cur:\tthe current file, or (dyn :current-file)\n"
|
||||
"\t:dir:\tthe directory containing the current file\n"
|
||||
"\t:name:\tthe filename component of path, with extenion if given\n"
|
||||
"\t:name:\tthe filename component of path, with extension if given\n"
|
||||
"\t:native:\tthe extension used to load natives, .so or .dll\n"
|
||||
"\t:sys:\tthe system path, or (syn :syspath)")
|
||||
},
|
||||
@@ -678,7 +702,12 @@ static const JanetReg corelib_cfuns[] = {
|
||||
{
|
||||
"slice", janet_core_slice,
|
||||
JDOC("(slice x &opt start end)\n\n"
|
||||
"Extract a sub-range of an indexed data strutrue or byte sequence.")
|
||||
"Extract a sub-range of an indexed data structure or byte sequence.")
|
||||
},
|
||||
{
|
||||
"signal", janet_core_signal,
|
||||
JDOC("(signal what x)\n\n"
|
||||
"Raise a signal with payload x. ")
|
||||
},
|
||||
{NULL, NULL, NULL}
|
||||
};
|
||||
@@ -990,7 +1019,7 @@ JanetTable *janet_core_env(JanetTable *replacements) {
|
||||
JDOC("(% dividend divisor)\n\n"
|
||||
"Returns the remainder of dividend / divisor."));
|
||||
janet_quick_asm(env, JANET_FUN_NEXT,
|
||||
"next", 2, 2, 2, 2, next_asm, sizeof(next_asm),
|
||||
"next", 2, 1, 2, 2, next_asm, sizeof(next_asm),
|
||||
JDOC("(next ds &opt key)\n\n"
|
||||
"Gets the next key in a datastructure. Can be used to iterate through "
|
||||
"the keys of a data structure in an unspecified order. Keys are guaranteed "
|
||||
|
||||
@@ -29,4 +29,9 @@
|
||||
#define _POSIX_C_SOURCE 200112L
|
||||
#endif
|
||||
|
||||
/* Needed for realpath on linux */
|
||||
#if !defined(_XOPEN_SOURCE) && (defined(__linux__) || defined(__EMSCRIPTEN__))
|
||||
#define _XOPEN_SOURCE 500
|
||||
#endif
|
||||
|
||||
#endif
|
||||
|
||||
111
src/core/fiber.c
111
src/core/fiber.c
@@ -65,7 +65,14 @@ JanetFiber *janet_fiber_reset(JanetFiber *fiber, JanetFunction *callee, int32_t
|
||||
if (newstacktop >= fiber->capacity) {
|
||||
janet_fiber_setcapacity(fiber, 2 * newstacktop);
|
||||
}
|
||||
safe_memcpy(fiber->data + fiber->stacktop, argv, argc * sizeof(Janet));
|
||||
if (argv) {
|
||||
memcpy(fiber->data + fiber->stacktop, argv, argc * sizeof(Janet));
|
||||
} else {
|
||||
/* If argv not given, fill with nil */
|
||||
for (int32_t i = 0; i < argc; i++) {
|
||||
fiber->data[fiber->stacktop + i] = janet_wrap_nil();
|
||||
}
|
||||
}
|
||||
fiber->stacktop = newstacktop;
|
||||
}
|
||||
if (janet_fiber_funcframe(fiber, callee)) return NULL;
|
||||
@@ -211,18 +218,79 @@ int janet_fiber_funcframe(JanetFiber *fiber, JanetFunction *func) {
|
||||
static void janet_env_detach(JanetFuncEnv *env) {
|
||||
/* Check for closure environment */
|
||||
if (env) {
|
||||
size_t s = sizeof(Janet) * (size_t) env->length;
|
||||
janet_env_valid(env);
|
||||
int32_t len = env->length;
|
||||
size_t s = sizeof(Janet) * (size_t) len;
|
||||
Janet *vmem = malloc(s);
|
||||
janet_vm_next_collection += (uint32_t) s;
|
||||
if (NULL == vmem) {
|
||||
JANET_OUT_OF_MEMORY;
|
||||
}
|
||||
safe_memcpy(vmem, env->as.fiber->data + env->offset, s);
|
||||
Janet *values = env->as.fiber->data + env->offset;
|
||||
safe_memcpy(vmem, values, s);
|
||||
uint32_t *bitset = janet_stack_frame(values)->func->def->closure_bitset;
|
||||
if (bitset) {
|
||||
/* Clear unneeded references in closure environment */
|
||||
for (int32_t i = 0; i < len; i += 32) {
|
||||
uint32_t mask = ~(bitset[i >> 5]);
|
||||
int32_t maxj = i + 32 > len ? len : i + 32;
|
||||
for (int32_t j = i; j < maxj; j++) {
|
||||
if (mask & 1) vmem[j] = janet_wrap_nil();
|
||||
mask >>= 1;
|
||||
}
|
||||
}
|
||||
}
|
||||
env->offset = 0;
|
||||
env->as.values = vmem;
|
||||
}
|
||||
}
|
||||
|
||||
/* Validate potentially untrusted func env (unmarshalled envs are difficult to verify) */
|
||||
int janet_env_valid(JanetFuncEnv *env) {
|
||||
if (env->offset < 0) {
|
||||
int32_t real_offset = -(env->offset);
|
||||
JanetFiber *fiber = env->as.fiber;
|
||||
int32_t i = fiber->frame;
|
||||
while (i > 0) {
|
||||
JanetStackFrame *frame = (JanetStackFrame *)(fiber->data + i - JANET_FRAME_SIZE);
|
||||
if (real_offset == i &&
|
||||
frame->env == env &&
|
||||
frame->func &&
|
||||
frame->func->def->slotcount == env->length) {
|
||||
env->offset = real_offset;
|
||||
return 1;
|
||||
}
|
||||
i = frame->prevframe;
|
||||
}
|
||||
/* Invalid, set to empty off-stack variant. */
|
||||
env->offset = 0;
|
||||
env->length = 0;
|
||||
env->as.values = NULL;
|
||||
return 0;
|
||||
} else {
|
||||
return 1;
|
||||
}
|
||||
}
|
||||
|
||||
/* Detach a fiber from the env if the target fiber has stopped mutating */
|
||||
void janet_env_maybe_detach(JanetFuncEnv *env) {
|
||||
/* Check for detachable closure envs */
|
||||
janet_env_valid(env);
|
||||
if (env->offset > 0) {
|
||||
JanetFiberStatus s = janet_fiber_status(env->as.fiber);
|
||||
int isFinished = s == JANET_STATUS_DEAD ||
|
||||
s == JANET_STATUS_ERROR ||
|
||||
s == JANET_STATUS_USER0 ||
|
||||
s == JANET_STATUS_USER1 ||
|
||||
s == JANET_STATUS_USER2 ||
|
||||
s == JANET_STATUS_USER3 ||
|
||||
s == JANET_STATUS_USER4;
|
||||
if (isFinished) {
|
||||
janet_env_detach(env);
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
/* Create a tail frame for a function */
|
||||
int janet_fiber_funcframe_tail(JanetFiber *fiber, JanetFunction *func) {
|
||||
int32_t i;
|
||||
@@ -362,10 +430,10 @@ static Janet cfun_fiber_new(int32_t argc, Janet *argv) {
|
||||
janet_arity(argc, 1, 2);
|
||||
JanetFunction *func = janet_getfunction(argv, 0);
|
||||
JanetFiber *fiber;
|
||||
if (func->def->min_arity != 0) {
|
||||
janet_panic("expected nullary function in fiber constructor");
|
||||
if (func->def->min_arity > 1) {
|
||||
janet_panicf("fiber function must accept 0 or 1 arguments");
|
||||
}
|
||||
fiber = janet_fiber(func, 64, 0, NULL);
|
||||
fiber = janet_fiber(func, 64, func->def->min_arity, NULL);
|
||||
if (argc == 2) {
|
||||
int32_t i;
|
||||
JanetByteView view = janet_getbytes(argv, 1);
|
||||
@@ -377,7 +445,7 @@ static Janet cfun_fiber_new(int32_t argc, Janet *argv) {
|
||||
} else {
|
||||
switch (view.bytes[i]) {
|
||||
default:
|
||||
janet_panicf("invalid flag %c, expected a, d, e, u, or y", view.bytes[i]);
|
||||
janet_panicf("invalid flag %c, expected a, t, d, e, u, y, i, or p", view.bytes[i]);
|
||||
break;
|
||||
case 'a':
|
||||
fiber->flags |=
|
||||
@@ -386,6 +454,15 @@ static Janet cfun_fiber_new(int32_t argc, Janet *argv) {
|
||||
JANET_FIBER_MASK_USER |
|
||||
JANET_FIBER_MASK_YIELD;
|
||||
break;
|
||||
case 't':
|
||||
fiber->flags |=
|
||||
JANET_FIBER_MASK_ERROR |
|
||||
JANET_FIBER_MASK_USER0 |
|
||||
JANET_FIBER_MASK_USER1 |
|
||||
JANET_FIBER_MASK_USER2 |
|
||||
JANET_FIBER_MASK_USER3 |
|
||||
JANET_FIBER_MASK_USER4;
|
||||
break;
|
||||
case 'd':
|
||||
fiber->flags |= JANET_FIBER_MASK_DEBUG;
|
||||
break;
|
||||
@@ -448,6 +525,20 @@ static Janet cfun_fiber_setmaxstack(int32_t argc, Janet *argv) {
|
||||
return argv[0];
|
||||
}
|
||||
|
||||
static Janet cfun_fiber_can_resume(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 1);
|
||||
JanetFiber *fiber = janet_getfiber(argv, 0);
|
||||
JanetFiberStatus s = janet_fiber_status(fiber);
|
||||
int isFinished = s == JANET_STATUS_DEAD ||
|
||||
s == JANET_STATUS_ERROR ||
|
||||
s == JANET_STATUS_USER0 ||
|
||||
s == JANET_STATUS_USER1 ||
|
||||
s == JANET_STATUS_USER2 ||
|
||||
s == JANET_STATUS_USER3 ||
|
||||
s == JANET_STATUS_USER4;
|
||||
return janet_wrap_boolean(!isFinished);
|
||||
}
|
||||
|
||||
static const JanetReg fiber_cfuns[] = {
|
||||
{
|
||||
"fiber/new", cfun_fiber_new,
|
||||
@@ -463,6 +554,7 @@ static const JanetReg fiber_cfuns[] = {
|
||||
"\ta - block all signals\n"
|
||||
"\td - block debug signals\n"
|
||||
"\te - block error signals\n"
|
||||
"\tt - block termination signals: error + user[0-4]\n"
|
||||
"\tu - block user signals\n"
|
||||
"\ty - block yield signals\n"
|
||||
"\t0-9 - block a specific user signal\n\n"
|
||||
@@ -513,6 +605,11 @@ static const JanetReg fiber_cfuns[] = {
|
||||
"Sets the environment table for a fiber. Set to nil to remove the current "
|
||||
"environment.")
|
||||
},
|
||||
{
|
||||
"fiber/can-resume?", cfun_fiber_can_resume,
|
||||
JDOC("(fiber/can-resume? fiber)\n\n"
|
||||
"Check if a fiber is finished and cannot be resumed.")
|
||||
},
|
||||
{NULL, NULL, NULL}
|
||||
};
|
||||
|
||||
|
||||
@@ -73,5 +73,7 @@ int janet_fiber_funcframe(JanetFiber *fiber, JanetFunction *func);
|
||||
int janet_fiber_funcframe_tail(JanetFiber *fiber, JanetFunction *func);
|
||||
void janet_fiber_cframe(JanetFiber *fiber, JanetCFunction cfun);
|
||||
void janet_fiber_popframe(JanetFiber *fiber);
|
||||
void janet_env_maybe_detach(JanetFuncEnv *env);
|
||||
int janet_env_valid(JanetFuncEnv *env);
|
||||
|
||||
#endif
|
||||
|
||||
@@ -27,6 +27,7 @@
|
||||
#include "symcache.h"
|
||||
#include "gc.h"
|
||||
#include "util.h"
|
||||
#include "fiber.h"
|
||||
#endif
|
||||
|
||||
struct JanetScratch {
|
||||
@@ -189,7 +190,10 @@ static void janet_mark_funcenv(JanetFuncEnv *env) {
|
||||
if (janet_gc_reachable(env))
|
||||
return;
|
||||
janet_gc_mark(env);
|
||||
if (env->offset) {
|
||||
/* If closure env references a dead fiber, we can just copy out the stack frame we need so
|
||||
* we don't need to keep around the whole dead fiber. */
|
||||
janet_env_maybe_detach(env);
|
||||
if (env->offset > 0) {
|
||||
/* On stack */
|
||||
janet_mark_fiber(env->as.fiber);
|
||||
} else {
|
||||
@@ -305,6 +309,7 @@ static void janet_deinit_block(JanetGCObject *mem) {
|
||||
free(def->constants);
|
||||
free(def->bytecode);
|
||||
free(def->sourcemap);
|
||||
free(def->closure_bitset);
|
||||
}
|
||||
break;
|
||||
}
|
||||
|
||||
@@ -81,7 +81,7 @@ static void it_u64_tostring(void *p, JanetBuffer *buffer) {
|
||||
janet_buffer_push_cstring(buffer, str);
|
||||
}
|
||||
|
||||
static const JanetAbstractType it_s64_type = {
|
||||
const JanetAbstractType janet_s64_type = {
|
||||
"core/s64",
|
||||
NULL,
|
||||
NULL,
|
||||
@@ -95,7 +95,7 @@ static const JanetAbstractType it_s64_type = {
|
||||
JANET_ATEND_HASH
|
||||
};
|
||||
|
||||
static const JanetAbstractType it_u64_type = {
|
||||
const JanetAbstractType janet_u64_type = {
|
||||
"core/u64",
|
||||
NULL,
|
||||
NULL,
|
||||
@@ -128,8 +128,8 @@ int64_t janet_unwrap_s64(Janet x) {
|
||||
}
|
||||
case JANET_ABSTRACT: {
|
||||
void *abst = janet_unwrap_abstract(x);
|
||||
if (janet_abstract_type(abst) == &it_s64_type ||
|
||||
(janet_abstract_type(abst) == &it_u64_type))
|
||||
if (janet_abstract_type(abst) == &janet_s64_type ||
|
||||
(janet_abstract_type(abst) == &janet_u64_type))
|
||||
return *(int64_t *)abst;
|
||||
break;
|
||||
}
|
||||
@@ -157,8 +157,8 @@ uint64_t janet_unwrap_u64(Janet x) {
|
||||
}
|
||||
case JANET_ABSTRACT: {
|
||||
void *abst = janet_unwrap_abstract(x);
|
||||
if (janet_abstract_type(abst) == &it_s64_type ||
|
||||
(janet_abstract_type(abst) == &it_u64_type))
|
||||
if (janet_abstract_type(abst) == &janet_s64_type ||
|
||||
(janet_abstract_type(abst) == &janet_u64_type))
|
||||
return *(uint64_t *)abst;
|
||||
break;
|
||||
}
|
||||
@@ -170,19 +170,19 @@ uint64_t janet_unwrap_u64(Janet x) {
|
||||
JanetIntType janet_is_int(Janet x) {
|
||||
if (!janet_checktype(x, JANET_ABSTRACT)) return JANET_INT_NONE;
|
||||
const JanetAbstractType *at = janet_abstract_type(janet_unwrap_abstract(x));
|
||||
return (at == &it_s64_type) ? JANET_INT_S64 :
|
||||
((at == &it_u64_type) ? JANET_INT_U64 :
|
||||
return (at == &janet_s64_type) ? JANET_INT_S64 :
|
||||
((at == &janet_u64_type) ? JANET_INT_U64 :
|
||||
JANET_INT_NONE);
|
||||
}
|
||||
|
||||
Janet janet_wrap_s64(int64_t x) {
|
||||
int64_t *box = janet_abstract(&it_s64_type, sizeof(int64_t));
|
||||
int64_t *box = janet_abstract(&janet_s64_type, sizeof(int64_t));
|
||||
*box = (int64_t)x;
|
||||
return janet_wrap_abstract(box);
|
||||
}
|
||||
|
||||
Janet janet_wrap_u64(uint64_t x) {
|
||||
uint64_t *box = janet_abstract(&it_u64_type, sizeof(uint64_t));
|
||||
uint64_t *box = janet_abstract(&janet_u64_type, sizeof(uint64_t));
|
||||
*box = (uint64_t)x;
|
||||
return janet_wrap_abstract(box);
|
||||
}
|
||||
@@ -200,7 +200,7 @@ static Janet cfun_it_u64_new(int32_t argc, Janet *argv) {
|
||||
#define OPMETHOD(T, type, name, oper) \
|
||||
static Janet cfun_it_##type##_##name(int32_t argc, Janet *argv) { \
|
||||
janet_arity(argc, 2, -1); \
|
||||
T *box = janet_abstract(&it_##type##_type, sizeof(T)); \
|
||||
T *box = janet_abstract(&janet_##type##_type, sizeof(T)); \
|
||||
*box = janet_unwrap_##type(argv[0]); \
|
||||
for (int32_t i = 1; i < argc; i++) \
|
||||
*box oper##= janet_unwrap_##type(argv[i]); \
|
||||
@@ -210,7 +210,7 @@ static Janet cfun_it_##type##_##name(int32_t argc, Janet *argv) { \
|
||||
#define OPMETHODINVERT(T, type, name, oper) \
|
||||
static Janet cfun_it_##type##_##name(int32_t argc, Janet *argv) { \
|
||||
janet_fixarity(argc, 2); \
|
||||
T *box = janet_abstract(&it_##type##_type, sizeof(T)); \
|
||||
T *box = janet_abstract(&janet_##type##_type, sizeof(T)); \
|
||||
*box = janet_unwrap_##type(argv[1]); \
|
||||
*box oper##= janet_unwrap_##type(argv[0]); \
|
||||
return janet_wrap_abstract(box); \
|
||||
@@ -219,7 +219,7 @@ static Janet cfun_it_##type##_##name(int32_t argc, Janet *argv) { \
|
||||
#define DIVMETHOD(T, type, name, oper) \
|
||||
static Janet cfun_it_##type##_##name(int32_t argc, Janet *argv) { \
|
||||
janet_arity(argc, 2, -1); \
|
||||
T *box = janet_abstract(&it_##type##_type, sizeof(T)); \
|
||||
T *box = janet_abstract(&janet_##type##_type, sizeof(T)); \
|
||||
*box = janet_unwrap_##type(argv[0]); \
|
||||
for (int32_t i = 1; i < argc; i++) { \
|
||||
T value = janet_unwrap_##type(argv[i]); \
|
||||
@@ -232,7 +232,7 @@ static Janet cfun_it_##type##_##name(int32_t argc, Janet *argv) { \
|
||||
#define DIVMETHODINVERT(T, type, name, oper) \
|
||||
static Janet cfun_it_##type##_##name(int32_t argc, Janet *argv) { \
|
||||
janet_fixarity(argc, 2); \
|
||||
T *box = janet_abstract(&it_##type##_type, sizeof(T)); \
|
||||
T *box = janet_abstract(&janet_##type##_type, sizeof(T)); \
|
||||
*box = janet_unwrap_##type(argv[1]); \
|
||||
T value = janet_unwrap_##type(argv[0]); \
|
||||
if (value == 0) janet_panic("division by zero"); \
|
||||
@@ -243,7 +243,7 @@ static Janet cfun_it_##type##_##name(int32_t argc, Janet *argv) { \
|
||||
#define DIVMETHOD_SIGNED(T, type, name, oper) \
|
||||
static Janet cfun_it_##type##_##name(int32_t argc, Janet *argv) { \
|
||||
janet_arity(argc, 2, -1); \
|
||||
T *box = janet_abstract(&it_##type##_type, sizeof(T)); \
|
||||
T *box = janet_abstract(&janet_##type##_type, sizeof(T)); \
|
||||
*box = janet_unwrap_##type(argv[0]); \
|
||||
for (int32_t i = 1; i < argc; i++) { \
|
||||
T value = janet_unwrap_##type(argv[i]); \
|
||||
@@ -257,7 +257,7 @@ static Janet cfun_it_##type##_##name(int32_t argc, Janet *argv) { \
|
||||
#define DIVMETHODINVERT_SIGNED(T, type, name, oper) \
|
||||
static Janet cfun_it_##type##_##name(int32_t argc, Janet *argv) { \
|
||||
janet_fixarity(argc, 2); \
|
||||
T *box = janet_abstract(&it_##type##_type, sizeof(T)); \
|
||||
T *box = janet_abstract(&janet_##type##_type, sizeof(T)); \
|
||||
*box = janet_unwrap_##type(argv[1]); \
|
||||
T value = janet_unwrap_##type(argv[0]); \
|
||||
if (value == 0) janet_panic("division by zero"); \
|
||||
@@ -276,7 +276,7 @@ static Janet cfun_it_##type##_##name(int32_t argc, Janet *argv) { \
|
||||
|
||||
static Janet cfun_it_s64_mod(int32_t argc, Janet *argv) {
|
||||
janet_arity(argc, 2, -1);
|
||||
int64_t *box = janet_abstract(&it_s64_type, sizeof(int64_t));
|
||||
int64_t *box = janet_abstract(&janet_s64_type, sizeof(int64_t));
|
||||
*box = janet_unwrap_s64(argv[0]);
|
||||
for (int32_t i = 1; i < argc; i++) {
|
||||
int64_t value = janet_unwrap_s64(argv[i]);
|
||||
@@ -292,7 +292,7 @@ static Janet cfun_it_s64_mod(int32_t argc, Janet *argv) {
|
||||
|
||||
static Janet cfun_it_s64_modi(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 2);
|
||||
int64_t *box = janet_abstract(&it_s64_type, sizeof(int64_t));
|
||||
int64_t *box = janet_abstract(&janet_s64_type, sizeof(int64_t));
|
||||
int64_t op1 = janet_unwrap_s64(argv[0]);
|
||||
int64_t op2 = janet_unwrap_s64(argv[1]);
|
||||
int64_t x = op1 % op2;
|
||||
@@ -441,8 +441,8 @@ static const JanetReg it_cfuns[] = {
|
||||
/* Module entry point */
|
||||
void janet_lib_inttypes(JanetTable *env) {
|
||||
janet_core_cfuns(env, NULL, it_cfuns);
|
||||
janet_register_abstract_type(&it_s64_type);
|
||||
janet_register_abstract_type(&it_u64_type);
|
||||
janet_register_abstract_type(&janet_s64_type);
|
||||
janet_register_abstract_type(&janet_u64_type);
|
||||
}
|
||||
|
||||
#endif
|
||||
|
||||
@@ -33,16 +33,10 @@
|
||||
#include <sys/wait.h>
|
||||
#endif
|
||||
|
||||
typedef struct IOFile IOFile;
|
||||
struct IOFile {
|
||||
FILE *file;
|
||||
int flags;
|
||||
};
|
||||
|
||||
static int cfun_io_gc(void *p, size_t len);
|
||||
static int io_file_get(void *p, Janet key, Janet *out);
|
||||
|
||||
JanetAbstractType cfun_io_filetype = {
|
||||
const JanetAbstractType janet_file_type = {
|
||||
"core/file",
|
||||
cfun_io_gc,
|
||||
NULL,
|
||||
@@ -90,7 +84,7 @@ static int checkflags(const uint8_t *str) {
|
||||
}
|
||||
|
||||
static Janet makef(FILE *f, int flags) {
|
||||
IOFile *iof = (IOFile *) janet_abstract(&cfun_io_filetype, sizeof(IOFile));
|
||||
JanetFile *iof = (JanetFile *) janet_abstract(&janet_file_type, sizeof(JanetFile));
|
||||
iof->file = f;
|
||||
iof->flags = flags;
|
||||
return janet_wrap_abstract(iof);
|
||||
@@ -158,7 +152,7 @@ static Janet cfun_io_fopen(int32_t argc, Janet *argv) {
|
||||
}
|
||||
|
||||
/* Read up to n bytes into buffer. */
|
||||
static void read_chunk(IOFile *iof, JanetBuffer *buffer, int32_t nBytesMax) {
|
||||
static void read_chunk(JanetFile *iof, JanetBuffer *buffer, int32_t nBytesMax) {
|
||||
if (!(iof->flags & (JANET_FILE_READ | JANET_FILE_UPDATE)))
|
||||
janet_panic("file is not readable");
|
||||
janet_buffer_extra(buffer, nBytesMax);
|
||||
@@ -172,7 +166,7 @@ static void read_chunk(IOFile *iof, JanetBuffer *buffer, int32_t nBytesMax) {
|
||||
/* Read a certain number of bytes into memory */
|
||||
static Janet cfun_io_fread(int32_t argc, Janet *argv) {
|
||||
janet_arity(argc, 2, 3);
|
||||
IOFile *iof = janet_getabstract(argv, 0, &cfun_io_filetype);
|
||||
JanetFile *iof = janet_getabstract(argv, 0, &janet_file_type);
|
||||
if (iof->flags & JANET_FILE_CLOSED) janet_panic("file is closed");
|
||||
JanetBuffer *buffer;
|
||||
if (argc == 2) {
|
||||
@@ -212,7 +206,7 @@ static Janet cfun_io_fread(int32_t argc, Janet *argv) {
|
||||
/* Write bytes to a file */
|
||||
static Janet cfun_io_fwrite(int32_t argc, Janet *argv) {
|
||||
janet_arity(argc, 1, -1);
|
||||
IOFile *iof = janet_getabstract(argv, 0, &cfun_io_filetype);
|
||||
JanetFile *iof = janet_getabstract(argv, 0, &janet_file_type);
|
||||
if (iof->flags & JANET_FILE_CLOSED)
|
||||
janet_panic("file is closed");
|
||||
if (!(iof->flags & (JANET_FILE_WRITE | JANET_FILE_APPEND | JANET_FILE_UPDATE)))
|
||||
@@ -235,7 +229,7 @@ static Janet cfun_io_fwrite(int32_t argc, Janet *argv) {
|
||||
/* Flush the bytes in the file */
|
||||
static Janet cfun_io_fflush(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 1);
|
||||
IOFile *iof = janet_getabstract(argv, 0, &cfun_io_filetype);
|
||||
JanetFile *iof = janet_getabstract(argv, 0, &janet_file_type);
|
||||
if (iof->flags & JANET_FILE_CLOSED)
|
||||
janet_panic("file is closed");
|
||||
if (!(iof->flags & (JANET_FILE_WRITE | JANET_FILE_APPEND | JANET_FILE_UPDATE)))
|
||||
@@ -248,7 +242,7 @@ static Janet cfun_io_fflush(int32_t argc, Janet *argv) {
|
||||
/* Cleanup a file */
|
||||
static int cfun_io_gc(void *p, size_t len) {
|
||||
(void) len;
|
||||
IOFile *iof = (IOFile *)p;
|
||||
JanetFile *iof = (JanetFile *)p;
|
||||
if (!(iof->flags & (JANET_FILE_NOT_CLOSEABLE | JANET_FILE_CLOSED))) {
|
||||
return fclose(iof->file);
|
||||
}
|
||||
@@ -258,7 +252,7 @@ static int cfun_io_gc(void *p, size_t len) {
|
||||
/* Close a file */
|
||||
static Janet cfun_io_fclose(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 1);
|
||||
IOFile *iof = janet_getabstract(argv, 0, &cfun_io_filetype);
|
||||
JanetFile *iof = janet_getabstract(argv, 0, &janet_file_type);
|
||||
if (iof->flags & JANET_FILE_CLOSED)
|
||||
return janet_wrap_nil();
|
||||
if (iof->flags & (JANET_FILE_NOT_CLOSEABLE))
|
||||
@@ -282,7 +276,7 @@ static Janet cfun_io_fclose(int32_t argc, Janet *argv) {
|
||||
/* Seek a file */
|
||||
static Janet cfun_io_fseek(int32_t argc, Janet *argv) {
|
||||
janet_arity(argc, 2, 3);
|
||||
IOFile *iof = janet_getabstract(argv, 0, &cfun_io_filetype);
|
||||
JanetFile *iof = janet_getabstract(argv, 0, &janet_file_type);
|
||||
if (iof->flags & JANET_FILE_CLOSED)
|
||||
janet_panic("file is closed");
|
||||
long int offset = 0;
|
||||
@@ -326,8 +320,8 @@ FILE *janet_dynfile(const char *name, FILE *def) {
|
||||
Janet x = janet_dyn(name);
|
||||
if (!janet_checktype(x, JANET_ABSTRACT)) return def;
|
||||
void *abstract = janet_unwrap_abstract(x);
|
||||
if (janet_abstract_type(abstract) != &cfun_io_filetype) return def;
|
||||
IOFile *iofile = abstract;
|
||||
if (janet_abstract_type(abstract) != &janet_file_type) return def;
|
||||
JanetFile *iofile = abstract;
|
||||
return iofile->file;
|
||||
}
|
||||
|
||||
@@ -354,9 +348,9 @@ static Janet cfun_io_print_impl(int32_t argc, Janet *argv,
|
||||
break;
|
||||
case JANET_ABSTRACT: {
|
||||
void *abstract = janet_unwrap_abstract(x);
|
||||
if (janet_abstract_type(abstract) != &cfun_io_filetype)
|
||||
if (janet_abstract_type(abstract) != &janet_file_type)
|
||||
return janet_wrap_nil();
|
||||
IOFile *iofile = abstract;
|
||||
JanetFile *iofile = abstract;
|
||||
f = iofile->file;
|
||||
break;
|
||||
}
|
||||
@@ -421,9 +415,9 @@ static Janet cfun_io_printf_impl(int32_t argc, Janet *argv, int newline,
|
||||
break;
|
||||
case JANET_ABSTRACT: {
|
||||
void *abstract = janet_unwrap_abstract(x);
|
||||
if (janet_abstract_type(abstract) != &cfun_io_filetype)
|
||||
if (janet_abstract_type(abstract) != &janet_file_type)
|
||||
return janet_wrap_nil();
|
||||
IOFile *iofile = abstract;
|
||||
JanetFile *iofile = abstract;
|
||||
f = iofile->file;
|
||||
break;
|
||||
}
|
||||
@@ -460,6 +454,38 @@ static Janet cfun_io_eprinf(int32_t argc, Janet *argv) {
|
||||
return cfun_io_printf_impl(argc, argv, 0, "err", stderr);
|
||||
}
|
||||
|
||||
static void janet_flusher(const char *name, FILE *dflt_file) {
|
||||
Janet x = janet_dyn(name);
|
||||
switch (janet_type(x)) {
|
||||
default:
|
||||
break;
|
||||
case JANET_NIL:
|
||||
fflush(dflt_file);
|
||||
break;
|
||||
case JANET_ABSTRACT: {
|
||||
void *abstract = janet_unwrap_abstract(x);
|
||||
if (janet_abstract_type(abstract) != &janet_file_type) break;
|
||||
JanetFile *iofile = abstract;
|
||||
fflush(iofile->file);
|
||||
break;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
static Janet cfun_io_flush(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 0);
|
||||
(void) argv;
|
||||
janet_flusher("out", stdout);
|
||||
return janet_wrap_nil();
|
||||
}
|
||||
|
||||
static Janet cfun_io_eflush(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 0);
|
||||
(void) argv;
|
||||
janet_flusher("err", stderr);
|
||||
return janet_wrap_nil();
|
||||
}
|
||||
|
||||
void janet_dynprintf(const char *name, FILE *dflt_file, const char *format, ...) {
|
||||
va_list args;
|
||||
va_start(args, format);
|
||||
@@ -476,12 +502,12 @@ void janet_dynprintf(const char *name, FILE *dflt_file, const char *format, ...)
|
||||
int32_t len = 0;
|
||||
while (format[len]) len++;
|
||||
janet_buffer_init(&buffer, len);
|
||||
janet_formatb(&buffer, format, args);
|
||||
janet_formatbv(&buffer, format, args);
|
||||
if (xtype == JANET_ABSTRACT) {
|
||||
void *abstract = janet_unwrap_abstract(x);
|
||||
if (janet_abstract_type(abstract) != &cfun_io_filetype)
|
||||
if (janet_abstract_type(abstract) != &janet_file_type)
|
||||
break;
|
||||
IOFile *iofile = abstract;
|
||||
JanetFile *iofile = abstract;
|
||||
f = iofile->file;
|
||||
}
|
||||
fwrite(buffer.data, buffer.count, 1, f);
|
||||
@@ -489,7 +515,7 @@ void janet_dynprintf(const char *name, FILE *dflt_file, const char *format, ...)
|
||||
break;
|
||||
}
|
||||
case JANET_BUFFER:
|
||||
janet_formatb(janet_unwrap_buffer(x), format, args);
|
||||
janet_formatbv(janet_unwrap_buffer(x), format, args);
|
||||
break;
|
||||
}
|
||||
va_end(args);
|
||||
@@ -541,6 +567,16 @@ static const JanetReg io_cfuns[] = {
|
||||
JDOC("(eprinf fmt & xs)\n\n"
|
||||
"Like eprintf but with no trailing newline.")
|
||||
},
|
||||
{
|
||||
"flush", cfun_io_flush,
|
||||
JDOC("(flush)\n\n"
|
||||
"Flush (dyn :out stdout) if it is a file, otherwise do nothing.")
|
||||
},
|
||||
{
|
||||
"eflush", cfun_io_eflush,
|
||||
JDOC("(eflush)\n\n"
|
||||
"Flush (dyn :err stderr) if it is a file, otherwise do nothing.")
|
||||
},
|
||||
{
|
||||
"file/temp", cfun_io_temp,
|
||||
JDOC("(file/temp)\n\n"
|
||||
@@ -618,7 +654,7 @@ static const JanetReg io_cfuns[] = {
|
||||
/* C API */
|
||||
|
||||
FILE *janet_getfile(const Janet *argv, int32_t n, int *flags) {
|
||||
IOFile *iof = janet_getabstract(argv, n, &cfun_io_filetype);
|
||||
JanetFile *iof = janet_getabstract(argv, n, &janet_file_type);
|
||||
if (NULL != flags) *flags = iof->flags;
|
||||
return iof->file;
|
||||
}
|
||||
@@ -628,11 +664,11 @@ Janet janet_makefile(FILE *f, int flags) {
|
||||
}
|
||||
|
||||
JanetAbstract janet_checkfile(Janet j) {
|
||||
return janet_checkabstract(j, &cfun_io_filetype);
|
||||
return janet_checkabstract(j, &janet_file_type);
|
||||
}
|
||||
|
||||
FILE *janet_unwrapfile(Janet j, int *flags) {
|
||||
IOFile *iof = janet_unwrap_abstract(j);
|
||||
JanetFile *iof = janet_unwrap_abstract(j);
|
||||
if (NULL != flags) *flags = iof->flags;
|
||||
return iof->file;
|
||||
}
|
||||
|
||||
324
src/core/marsh.c
324
src/core/marsh.c
@@ -42,26 +42,28 @@ typedef struct {
|
||||
/* Lead bytes in marshaling protocol */
|
||||
enum {
|
||||
LB_REAL = 200,
|
||||
LB_NIL,
|
||||
LB_FALSE,
|
||||
LB_TRUE,
|
||||
LB_FIBER,
|
||||
LB_INTEGER,
|
||||
LB_STRING,
|
||||
LB_SYMBOL,
|
||||
LB_KEYWORD,
|
||||
LB_ARRAY,
|
||||
LB_TUPLE,
|
||||
LB_TABLE,
|
||||
LB_TABLE_PROTO,
|
||||
LB_STRUCT,
|
||||
LB_BUFFER,
|
||||
LB_FUNCTION,
|
||||
LB_REGISTRY,
|
||||
LB_ABSTRACT,
|
||||
LB_REFERENCE,
|
||||
LB_FUNCENV_REF,
|
||||
LB_FUNCDEF_REF
|
||||
LB_NIL, /* 201 */
|
||||
LB_FALSE, /* 202 */
|
||||
LB_TRUE, /* 203 */
|
||||
LB_FIBER, /* 204 */
|
||||
LB_INTEGER, /* 205 */
|
||||
LB_STRING, /* 206 */
|
||||
LB_SYMBOL, /* 207 */
|
||||
LB_KEYWORD, /* 208 */
|
||||
LB_ARRAY, /* 209 */
|
||||
LB_TUPLE, /* 210 */
|
||||
LB_TABLE, /* 211 */
|
||||
LB_TABLE_PROTO, /* 212 */
|
||||
LB_STRUCT, /* 213 */
|
||||
LB_BUFFER, /* 214 */
|
||||
LB_FUNCTION, /* 215 */
|
||||
LB_REGISTRY, /* 216 */
|
||||
LB_ABSTRACT, /* 217 */
|
||||
LB_REFERENCE, /* 218 */
|
||||
LB_FUNCENV_REF, /* 219 */
|
||||
LB_FUNCDEF_REF, /* 220 */
|
||||
LB_UNSAFE_CFUNCTION, /* 221 */
|
||||
LB_UNSAFE_POINTER /* 222 */
|
||||
} LeadBytes;
|
||||
|
||||
/* Helper to look inside an entry in an environment */
|
||||
@@ -183,16 +185,32 @@ static void marshal_one_env(MarshalState *st, JanetFuncEnv *env, int flags) {
|
||||
return;
|
||||
}
|
||||
}
|
||||
janet_env_valid(env);
|
||||
janet_v_push(st->seen_envs, env);
|
||||
pushint(st, env->offset);
|
||||
pushint(st, env->length);
|
||||
if (env->offset) {
|
||||
/* On stack variant */
|
||||
marshal_one(st, janet_wrap_fiber(env->as.fiber), flags + 1);
|
||||
if (env->offset > 0 && (JANET_STATUS_ALIVE == janet_fiber_status(env->as.fiber))) {
|
||||
pushint(st, 0);
|
||||
pushint(st, env->length);
|
||||
Janet *values = env->as.fiber->data + env->offset;
|
||||
uint32_t *bitset = janet_stack_frame(values)->func->def->closure_bitset;
|
||||
for (int32_t i = 0; i < env->length; i++) {
|
||||
if (1 & (bitset[i >> 5] >> (i & 0x1F))) {
|
||||
marshal_one(st, values[i], flags + 1);
|
||||
} else {
|
||||
pushbyte(st, LB_NIL);
|
||||
}
|
||||
}
|
||||
} else {
|
||||
/* Off stack variant */
|
||||
for (int32_t i = 0; i < env->length; i++)
|
||||
marshal_one(st, env->as.values[i], flags + 1);
|
||||
janet_env_maybe_detach(env);
|
||||
pushint(st, env->offset);
|
||||
pushint(st, env->length);
|
||||
if (env->offset > 0) {
|
||||
/* On stack variant */
|
||||
marshal_one(st, janet_wrap_fiber(env->as.fiber), flags + 1);
|
||||
} else {
|
||||
/* Off stack variant */
|
||||
for (int32_t i = 0; i < env->length; i++)
|
||||
marshal_one(st, env->as.values[i], flags + 1);
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
@@ -205,6 +223,16 @@ static void janet_func_addflags(JanetFuncDef *def) {
|
||||
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++) {
|
||||
pushbyte(st, u32s[i] & 0xFF);
|
||||
pushbyte(st, (u32s[i] >> 8) & 0xFF);
|
||||
pushbyte(st, (u32s[i] >> 16) & 0xFF);
|
||||
pushbyte(st, (u32s[i] >> 24) & 0xFF);
|
||||
}
|
||||
}
|
||||
|
||||
/* Marshal a function def */
|
||||
static void marshal_one_def(MarshalState *st, JanetFuncDef *def, int flags) {
|
||||
MARSH_STACKCHECK;
|
||||
@@ -239,12 +267,7 @@ static void marshal_one_def(MarshalState *st, JanetFuncDef *def, int flags) {
|
||||
marshal_one(st, def->constants[i], flags);
|
||||
|
||||
/* marshal the bytecode */
|
||||
for (int32_t i = 0; i < def->bytecode_length; i++) {
|
||||
pushbyte(st, def->bytecode[i] & 0xFF);
|
||||
pushbyte(st, (def->bytecode[i] >> 8) & 0xFF);
|
||||
pushbyte(st, (def->bytecode[i] >> 16) & 0xFF);
|
||||
pushbyte(st, (def->bytecode[i] >> 24) & 0xFF);
|
||||
}
|
||||
janet_marshal_u32s(st, def->bytecode, def->bytecode_length);
|
||||
|
||||
/* marshal the environments if needed */
|
||||
for (int32_t i = 0; i < def->environments_length; i++)
|
||||
@@ -264,6 +287,11 @@ static void marshal_one_def(MarshalState *st, JanetFuncDef *def, int flags) {
|
||||
current = map.line;
|
||||
}
|
||||
}
|
||||
|
||||
/* Marshal closure bitset, if needed */
|
||||
if (def->flags & JANET_FUNCDEF_FLAG_HASCLOBITSET) {
|
||||
janet_marshal_u32s(st, def->closure_bitset, ((def->slotcount + 31) >> 5));
|
||||
}
|
||||
}
|
||||
|
||||
#define JANET_FIBER_FLAG_HASCHILD (1 << 29)
|
||||
@@ -537,9 +565,25 @@ static void marshal_one(MarshalState *st, Janet x, int flags) {
|
||||
marshal_one_fiber(st, janet_unwrap_fiber(x), flags + 1);
|
||||
return;
|
||||
}
|
||||
case JANET_CFUNCTION: {
|
||||
if (!(flags & JANET_MARSHAL_UNSAFE)) goto no_registry;
|
||||
MARK_SEEN();
|
||||
pushbyte(st, LB_UNSAFE_CFUNCTION);
|
||||
JanetCFunction cfn = janet_unwrap_cfunction(x);
|
||||
pushbytes(st, (uint8_t *) &cfn, sizeof(JanetCFunction));
|
||||
return;
|
||||
}
|
||||
case JANET_POINTER: {
|
||||
if (!(flags & JANET_MARSHAL_UNSAFE)) goto no_registry;
|
||||
MARK_SEEN();
|
||||
pushbyte(st, LB_UNSAFE_POINTER);
|
||||
void *ptr = janet_unwrap_pointer(x);
|
||||
pushbytes(st, (uint8_t *) &ptr, sizeof(void *));
|
||||
return;
|
||||
}
|
||||
no_registry:
|
||||
default: {
|
||||
janet_panicf("no registry value and cannot marshal %p", x);
|
||||
return;
|
||||
}
|
||||
}
|
||||
#undef MARK_SEEN
|
||||
@@ -609,6 +653,15 @@ static int32_t readint(UnmarshalState *st, const uint8_t **atdata) {
|
||||
return ret;
|
||||
}
|
||||
|
||||
/* Helper to read a natural number (int >= 0). */
|
||||
static int32_t readnat(UnmarshalState *st, const uint8_t **atdata) {
|
||||
int32_t ret = readint(st, atdata);
|
||||
if (ret < 0) {
|
||||
janet_panicf("expected integer >= 0, got %d", ret);
|
||||
}
|
||||
return ret;
|
||||
}
|
||||
|
||||
/* Helper to read a size_t (up to 8 bytes unsigned). */
|
||||
static uint64_t read64(UnmarshalState *st, const uint8_t **atdata) {
|
||||
uint64_t ret;
|
||||
@@ -677,36 +730,51 @@ static const uint8_t *unmarshal_one_env(
|
||||
JanetFuncEnv *env = janet_gcalloc(JANET_MEMORY_FUNCENV, sizeof(JanetFuncEnv));
|
||||
env->length = 0;
|
||||
env->offset = 0;
|
||||
env->as.values = NULL;
|
||||
janet_v_push(st->lookup_envs, env);
|
||||
int32_t offset = readint(st, &data);
|
||||
int32_t length = readint(st, &data);
|
||||
if (offset) {
|
||||
int32_t offset = readnat(st, &data);
|
||||
int32_t length = readnat(st, &data);
|
||||
if (offset > 0) {
|
||||
Janet fiberv;
|
||||
/* On stack variant */
|
||||
data = unmarshal_one(st, data, &fiberv, flags);
|
||||
janet_asserttype(fiberv, JANET_FIBER);
|
||||
env->as.fiber = janet_unwrap_fiber(fiberv);
|
||||
/* Unmarshalling fiber may set values */
|
||||
if (env->offset != 0 && env->offset != offset)
|
||||
janet_panic("invalid funcenv offset");
|
||||
if (env->length != 0 && env->length != length)
|
||||
janet_panic("invalid funcenv length");
|
||||
/* Negative offset indicates untrusted input */
|
||||
env->offset = -offset;
|
||||
} else {
|
||||
/* Off stack variant */
|
||||
if (length == 0) {
|
||||
janet_panic("invalid funcenv length");
|
||||
}
|
||||
env->as.values = malloc(sizeof(Janet) * (size_t) length);
|
||||
if (!env->as.values) {
|
||||
JANET_OUT_OF_MEMORY;
|
||||
}
|
||||
env->offset = 0;
|
||||
for (int32_t i = 0; i < length; i++)
|
||||
data = unmarshal_one(st, data, env->as.values + i, flags);
|
||||
}
|
||||
env->offset = offset;
|
||||
env->length = length;
|
||||
*out = env;
|
||||
}
|
||||
return data;
|
||||
}
|
||||
|
||||
/* Unmarshal a series of u32s */
|
||||
static const uint8_t *janet_unmarshal_u32s(UnmarshalState *st, const uint8_t *data, uint32_t *into, int32_t n) {
|
||||
for (int32_t i = 0; i < n; i++) {
|
||||
MARSH_EOS(st, data + 3);
|
||||
into[i] =
|
||||
(uint32_t)(data[0]) |
|
||||
((uint32_t)(data[1]) << 8) |
|
||||
((uint32_t)(data[2]) << 16) |
|
||||
((uint32_t)(data[3]) << 24);
|
||||
data += 4;
|
||||
}
|
||||
return data;
|
||||
}
|
||||
|
||||
/* Unmarshal a funcdef */
|
||||
static const uint8_t *unmarshal_one_def(
|
||||
UnmarshalState *st,
|
||||
@@ -730,6 +798,12 @@ static const uint8_t *unmarshal_one_def(
|
||||
def->bytecode_length = 0;
|
||||
def->name = NULL;
|
||||
def->source = NULL;
|
||||
def->closure_bitset = NULL;
|
||||
def->defs = NULL;
|
||||
def->environments = NULL;
|
||||
def->constants = NULL;
|
||||
def->bytecode = NULL;
|
||||
def->sourcemap = NULL;
|
||||
janet_v_push(st->lookup_defs, def);
|
||||
|
||||
/* Set default lengths to zero */
|
||||
@@ -740,18 +814,18 @@ static const uint8_t *unmarshal_one_def(
|
||||
|
||||
/* Read flags and other fixed values */
|
||||
def->flags = readint(st, &data);
|
||||
def->slotcount = readint(st, &data);
|
||||
def->arity = readint(st, &data);
|
||||
def->min_arity = readint(st, &data);
|
||||
def->max_arity = readint(st, &data);
|
||||
def->slotcount = readnat(st, &data);
|
||||
def->arity = readnat(st, &data);
|
||||
def->min_arity = readnat(st, &data);
|
||||
def->max_arity = readnat(st, &data);
|
||||
|
||||
/* Read some lengths */
|
||||
constants_length = readint(st, &data);
|
||||
bytecode_length = readint(st, &data);
|
||||
constants_length = readnat(st, &data);
|
||||
bytecode_length = readnat(st, &data);
|
||||
if (def->flags & JANET_FUNCDEF_FLAG_HASENVS)
|
||||
environments_length = readint(st, &data);
|
||||
environments_length = readnat(st, &data);
|
||||
if (def->flags & JANET_FUNCDEF_FLAG_HASDEFS)
|
||||
defs_length = readint(st, &data);
|
||||
defs_length = readnat(st, &data);
|
||||
|
||||
/* Check name and source (optional) */
|
||||
if (def->flags & JANET_FUNCDEF_FLAG_HASNAME) {
|
||||
@@ -785,15 +859,7 @@ static const uint8_t *unmarshal_one_def(
|
||||
if (!def->bytecode) {
|
||||
JANET_OUT_OF_MEMORY;
|
||||
}
|
||||
for (int32_t i = 0; i < bytecode_length; i++) {
|
||||
MARSH_EOS(st, data + 3);
|
||||
def->bytecode[i] =
|
||||
(uint32_t)(data[0]) |
|
||||
((uint32_t)(data[1]) << 8) |
|
||||
((uint32_t)(data[2]) << 16) |
|
||||
((uint32_t)(data[3]) << 24);
|
||||
data += 4;
|
||||
}
|
||||
data = janet_unmarshal_u32s(st, data, def->bytecode, bytecode_length);
|
||||
def->bytecode_length = bytecode_length;
|
||||
|
||||
/* Unmarshal environments */
|
||||
@@ -834,12 +900,21 @@ 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 = readint(st, &data);
|
||||
def->sourcemap[i].column = readnat(st, &data);
|
||||
}
|
||||
} else {
|
||||
def->sourcemap = NULL;
|
||||
}
|
||||
|
||||
/* Unmarshal closure bitset if needed */
|
||||
if (def->flags & JANET_FUNCDEF_FLAG_HASCLOBITSET) {
|
||||
def->closure_bitset = malloc(sizeof(uint32_t) * def->slotcount);
|
||||
if (NULL == def->closure_bitset) {
|
||||
JANET_OUT_OF_MEMORY;
|
||||
}
|
||||
data = janet_unmarshal_u32s(st, data, def->closure_bitset, (def->slotcount + 31) >> 5);
|
||||
}
|
||||
|
||||
/* Validate */
|
||||
if (janet_verify(def))
|
||||
janet_panic("funcdef has invalid bytecode");
|
||||
@@ -857,7 +932,7 @@ static const uint8_t *unmarshal_one_fiber(
|
||||
JanetFiber **out,
|
||||
int flags) {
|
||||
|
||||
/* Initialize a new fiber */
|
||||
/* Initialize a new fiber with gc friendly defaults */
|
||||
JanetFiber *fiber = janet_gcalloc(JANET_MEMORY_FIBER, sizeof(JanetFiber));
|
||||
fiber->flags = 0;
|
||||
fiber->frame = 0;
|
||||
@@ -872,42 +947,41 @@ static const uint8_t *unmarshal_one_fiber(
|
||||
/* Push fiber to seen stack */
|
||||
janet_v_push(st->lookup, janet_wrap_fiber(fiber));
|
||||
|
||||
/* Set frame later so fiber can be GCed at anytime if unmarshalling fails */
|
||||
int32_t frame = 0;
|
||||
int32_t stack = 0;
|
||||
int32_t stacktop = 0;
|
||||
|
||||
/* Read ints */
|
||||
fiber->flags = readint(st, &data);
|
||||
frame = readint(st, &data);
|
||||
fiber->stackstart = readint(st, &data);
|
||||
fiber->stacktop = readint(st, &data);
|
||||
fiber->maxstack = readint(st, &data);
|
||||
int32_t fiber_flags = readint(st, &data);
|
||||
int32_t frame = readnat(st, &data);
|
||||
int32_t fiber_stackstart = readnat(st, &data);
|
||||
int32_t fiber_stacktop = readnat(st, &data);
|
||||
int32_t fiber_maxstack = readnat(st, &data);
|
||||
JanetTable *fiber_env = NULL;
|
||||
|
||||
/* Check for bad flags and ints */
|
||||
if ((int32_t)(frame + JANET_FRAME_SIZE) > fiber->stackstart ||
|
||||
fiber->stackstart > fiber->stacktop ||
|
||||
fiber->stacktop > fiber->maxstack) {
|
||||
if ((int32_t)(frame + JANET_FRAME_SIZE) > fiber_stackstart ||
|
||||
fiber_stackstart > fiber_stacktop ||
|
||||
fiber_stacktop > fiber_maxstack) {
|
||||
janet_panic("fiber has incorrect stack setup");
|
||||
}
|
||||
|
||||
/* Allocate stack memory */
|
||||
fiber->capacity = fiber->stacktop + 10;
|
||||
fiber->capacity = fiber_stacktop + 10;
|
||||
fiber->data = malloc(sizeof(Janet) * fiber->capacity);
|
||||
if (!fiber->data) {
|
||||
JANET_OUT_OF_MEMORY;
|
||||
}
|
||||
for (int32_t i = 0; i < fiber->capacity; i++) {
|
||||
fiber->data[i] = janet_wrap_nil();
|
||||
}
|
||||
|
||||
/* get frames */
|
||||
stack = frame;
|
||||
stacktop = fiber->stackstart - JANET_FRAME_SIZE;
|
||||
int32_t stack = frame;
|
||||
int32_t stacktop = fiber_stackstart - JANET_FRAME_SIZE;
|
||||
while (stack > 0) {
|
||||
JanetFunction *func = NULL;
|
||||
JanetFuncDef *def = NULL;
|
||||
JanetFuncEnv *env = NULL;
|
||||
int32_t frameflags = readint(st, &data);
|
||||
int32_t prevframe = readint(st, &data);
|
||||
int32_t pcdiff = readint(st, &data);
|
||||
int32_t prevframe = readnat(st, &data);
|
||||
int32_t pcdiff = readnat(st, &data);
|
||||
|
||||
/* Get frame items */
|
||||
Janet *framestack = fiber->data + stack;
|
||||
@@ -923,15 +997,7 @@ static const uint8_t *unmarshal_one_fiber(
|
||||
/* Check env */
|
||||
if (frameflags & JANET_STACKFRAME_HASENV) {
|
||||
frameflags &= ~JANET_STACKFRAME_HASENV;
|
||||
int32_t offset = stack;
|
||||
int32_t length = stacktop - stack;
|
||||
data = unmarshal_one_env(st, data, &env, flags + 1);
|
||||
if (env->offset != 0 && env->offset != offset)
|
||||
janet_panic("funcenv offset does not match fiber frame");
|
||||
if (env->length != 0 && env->length != length)
|
||||
janet_panic("funcenv length does not match fiber frame");
|
||||
env->offset = offset;
|
||||
env->length = length;
|
||||
}
|
||||
|
||||
/* Error checking */
|
||||
@@ -939,11 +1005,11 @@ static const uint8_t *unmarshal_one_fiber(
|
||||
if (expected_framesize != stacktop - stack) {
|
||||
janet_panic("fiber stackframe size mismatch");
|
||||
}
|
||||
if (pcdiff < 0 || pcdiff >= def->bytecode_length) {
|
||||
if (pcdiff >= def->bytecode_length) {
|
||||
janet_panic("fiber stackframe has invalid pc");
|
||||
}
|
||||
if ((int32_t)(prevframe + JANET_FRAME_SIZE) > stack) {
|
||||
janet_panic("fibre stackframe does not align with previous frame");
|
||||
janet_panic("fiber stackframe does not align with previous frame");
|
||||
}
|
||||
|
||||
/* Get stack items */
|
||||
@@ -966,25 +1032,32 @@ static const uint8_t *unmarshal_one_fiber(
|
||||
}
|
||||
|
||||
/* Check for fiber env */
|
||||
if (fiber->flags & JANET_FIBER_FLAG_HASENV) {
|
||||
if (fiber_flags & JANET_FIBER_FLAG_HASENV) {
|
||||
Janet envv;
|
||||
fiber->flags &= ~JANET_FIBER_FLAG_HASENV;
|
||||
fiber_flags &= ~JANET_FIBER_FLAG_HASENV;
|
||||
data = unmarshal_one(st, data, &envv, flags + 1);
|
||||
janet_asserttype(envv, JANET_TABLE);
|
||||
fiber->env = janet_unwrap_table(envv);
|
||||
fiber_env = janet_unwrap_table(envv);
|
||||
}
|
||||
|
||||
/* Check for child fiber */
|
||||
if (fiber->flags & JANET_FIBER_FLAG_HASCHILD) {
|
||||
if (fiber_flags & JANET_FIBER_FLAG_HASCHILD) {
|
||||
Janet fiberv;
|
||||
fiber->flags &= ~JANET_FIBER_FLAG_HASCHILD;
|
||||
fiber_flags &= ~JANET_FIBER_FLAG_HASCHILD;
|
||||
data = unmarshal_one(st, data, &fiberv, flags + 1);
|
||||
janet_asserttype(fiberv, JANET_FIBER);
|
||||
fiber->child = janet_unwrap_fiber(fiberv);
|
||||
}
|
||||
|
||||
/* Return data */
|
||||
/* We have valid fiber, finally construct remaining fields. */
|
||||
fiber->frame = frame;
|
||||
fiber->flags = fiber_flags;
|
||||
fiber->stackstart = fiber_stackstart;
|
||||
fiber->stacktop = fiber_stacktop;
|
||||
fiber->maxstack = fiber_maxstack;
|
||||
fiber->env = fiber_env;
|
||||
|
||||
/* Return data */
|
||||
*out = fiber;
|
||||
return data;
|
||||
}
|
||||
@@ -1043,7 +1116,7 @@ static const uint8_t *unmarshal_one_abstract(UnmarshalState *st, const uint8_t *
|
||||
Janet key;
|
||||
data = unmarshal_one(st, data, &key, flags + 1);
|
||||
const JanetAbstractType *at = janet_get_abstract_type(key);
|
||||
if (at == NULL) return NULL;
|
||||
if (at == NULL) goto oops;
|
||||
if (at->unmarshal) {
|
||||
JanetMarshalContext context = {NULL, st, flags, data, at};
|
||||
*out = janet_wrap_abstract(at->unmarshal(&context));
|
||||
@@ -1052,7 +1125,8 @@ static const uint8_t *unmarshal_one_abstract(UnmarshalState *st, const uint8_t *
|
||||
}
|
||||
return context.data;
|
||||
}
|
||||
return NULL;
|
||||
oops:
|
||||
janet_panic("invalid abstract type");
|
||||
}
|
||||
|
||||
static const uint8_t *unmarshal_one(
|
||||
@@ -1064,7 +1138,7 @@ static const uint8_t *unmarshal_one(
|
||||
MARSH_STACKCHECK;
|
||||
MARSH_EOS(st, data);
|
||||
lead = data[0];
|
||||
if (lead < 200) {
|
||||
if (lead < LB_REAL) {
|
||||
*out = janet_wrap_integer(readint(st, &data));
|
||||
return data;
|
||||
}
|
||||
@@ -1100,7 +1174,7 @@ static const uint8_t *unmarshal_one(
|
||||
u.bytes[0] = data[8];
|
||||
u.bytes[1] = data[7];
|
||||
u.bytes[2] = data[6];
|
||||
u.bytes[5] = data[5];
|
||||
u.bytes[3] = data[5];
|
||||
u.bytes[4] = data[4];
|
||||
u.bytes[5] = data[3];
|
||||
u.bytes[6] = data[2];
|
||||
@@ -1118,7 +1192,7 @@ static const uint8_t *unmarshal_one(
|
||||
case LB_KEYWORD:
|
||||
case LB_REGISTRY: {
|
||||
data++;
|
||||
int32_t len = readint(st, &data);
|
||||
int32_t len = readnat(st, &data);
|
||||
MARSH_EOS(st, data - 1 + len);
|
||||
if (lead == LB_STRING) {
|
||||
const uint8_t *str = janet_string(data, len);
|
||||
@@ -1178,7 +1252,11 @@ static const uint8_t *unmarshal_one(
|
||||
/* Things that open with integers */
|
||||
{
|
||||
data++;
|
||||
int32_t len = readint(st, &data);
|
||||
int32_t len = readnat(st, &data);
|
||||
/* DOS check */
|
||||
if (lead != LB_REFERENCE) {
|
||||
MARSH_EOS(st, data - 1 + len);
|
||||
}
|
||||
if (lead == LB_ARRAY) {
|
||||
/* Array */
|
||||
JanetArray *array = janet_array(len);
|
||||
@@ -1210,7 +1288,7 @@ static const uint8_t *unmarshal_one(
|
||||
*out = janet_wrap_struct(janet_struct_end(struct_));
|
||||
janet_v_push(st->lookup, *out);
|
||||
} else if (lead == LB_REFERENCE) {
|
||||
if (len < 0 || len >= janet_v_count(st->lookup))
|
||||
if (len >= janet_v_count(st->lookup))
|
||||
janet_panicf("invalid reference %d", len);
|
||||
*out = st->lookup[len];
|
||||
} else {
|
||||
@@ -1233,6 +1311,42 @@ static const uint8_t *unmarshal_one(
|
||||
}
|
||||
return data;
|
||||
}
|
||||
case LB_UNSAFE_POINTER: {
|
||||
MARSH_EOS(st, data + sizeof(void *));
|
||||
data++;
|
||||
if (!(flags & JANET_MARSHAL_UNSAFE)) {
|
||||
janet_panicf("unsafe flag not given, "
|
||||
"will not unmarshal raw pointer at index %d",
|
||||
(int)(data - st->start));
|
||||
}
|
||||
union {
|
||||
void *ptr;
|
||||
uint8_t bytes[sizeof(void *)];
|
||||
} u;
|
||||
memcpy(u.bytes, data, sizeof(void *));
|
||||
data += sizeof(void *);
|
||||
*out = janet_wrap_pointer(u.ptr);
|
||||
janet_v_push(st->lookup, *out);
|
||||
return data;
|
||||
}
|
||||
case LB_UNSAFE_CFUNCTION: {
|
||||
MARSH_EOS(st, data + sizeof(JanetCFunction));
|
||||
data++;
|
||||
if (!(flags & JANET_MARSHAL_UNSAFE)) {
|
||||
janet_panicf("unsafe flag not given, "
|
||||
"will not unmarshal function pointer at index %d",
|
||||
(int)(data - st->start));
|
||||
}
|
||||
union {
|
||||
JanetCFunction ptr;
|
||||
uint8_t bytes[sizeof(JanetCFunction)];
|
||||
} u;
|
||||
memcpy(u.bytes, data, sizeof(JanetCFunction));
|
||||
data += sizeof(JanetCFunction);
|
||||
*out = janet_wrap_cfunction(u.ptr);
|
||||
janet_v_push(st->lookup, *out);
|
||||
return data;
|
||||
}
|
||||
default: {
|
||||
janet_panicf("unknown byte %x at index %d",
|
||||
*data,
|
||||
@@ -1274,7 +1388,7 @@ static Janet cfun_env_lookup(int32_t argc, Janet *argv) {
|
||||
}
|
||||
|
||||
static Janet cfun_marshal(int32_t argc, Janet *argv) {
|
||||
janet_arity(argc, 1, 2);
|
||||
janet_arity(argc, 1, 3);
|
||||
JanetBuffer *buffer;
|
||||
JanetTable *rreg = NULL;
|
||||
if (argc > 1) {
|
||||
|
||||
@@ -52,7 +52,7 @@ static void *janet_rng_unmarshal(JanetMarshalContext *ctx) {
|
||||
return rng;
|
||||
}
|
||||
|
||||
static JanetAbstractType JanetRNG_type = {
|
||||
const JanetAbstractType janet_rng_type = {
|
||||
"core/rng",
|
||||
NULL,
|
||||
NULL,
|
||||
@@ -115,7 +115,7 @@ double janet_rng_double(JanetRNG *rng) {
|
||||
|
||||
static Janet cfun_rng_make(int32_t argc, Janet *argv) {
|
||||
janet_arity(argc, 0, 1);
|
||||
JanetRNG *rng = janet_abstract(&JanetRNG_type, sizeof(JanetRNG));
|
||||
JanetRNG *rng = janet_abstract(&janet_rng_type, sizeof(JanetRNG));
|
||||
if (argc == 1) {
|
||||
if (janet_checkint(argv[0])) {
|
||||
uint32_t seed = (uint32_t)(janet_getinteger(argv, 0));
|
||||
@@ -132,13 +132,13 @@ static Janet cfun_rng_make(int32_t argc, Janet *argv) {
|
||||
|
||||
static Janet cfun_rng_uniform(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 1);
|
||||
JanetRNG *rng = janet_getabstract(argv, 0, &JanetRNG_type);
|
||||
JanetRNG *rng = janet_getabstract(argv, 0, &janet_rng_type);
|
||||
return janet_wrap_number(janet_rng_double(rng));
|
||||
}
|
||||
|
||||
static Janet cfun_rng_int(int32_t argc, Janet *argv) {
|
||||
janet_arity(argc, 1, 2);
|
||||
JanetRNG *rng = janet_getabstract(argv, 0, &JanetRNG_type);
|
||||
JanetRNG *rng = janet_getabstract(argv, 0, &janet_rng_type);
|
||||
if (argc == 1) {
|
||||
uint32_t word = janet_rng_u32(rng) >> 1;
|
||||
return janet_wrap_integer(word);
|
||||
@@ -166,7 +166,7 @@ static void rng_get_4bytes(JanetRNG *rng, uint8_t *buf) {
|
||||
|
||||
static Janet cfun_rng_buffer(int32_t argc, Janet *argv) {
|
||||
janet_arity(argc, 2, 3);
|
||||
JanetRNG *rng = janet_getabstract(argv, 0, &JanetRNG_type);
|
||||
JanetRNG *rng = janet_getabstract(argv, 0, &janet_rng_type);
|
||||
int32_t n = janet_getnat(argv, 1);
|
||||
JanetBuffer *buffer = janet_optbuffer(argv, argc, 2, n);
|
||||
|
||||
@@ -255,6 +255,10 @@ JANET_DEFINE_MATHOP(fabs, fabs)
|
||||
JANET_DEFINE_MATHOP(floor, floor)
|
||||
JANET_DEFINE_MATHOP(trunc, trunc)
|
||||
JANET_DEFINE_MATHOP(round, round)
|
||||
JANET_DEFINE_MATHOP(gamma, lgamma)
|
||||
JANET_DEFINE_MATHOP(log1p, log1p)
|
||||
JANET_DEFINE_MATHOP(erf, erf)
|
||||
JANET_DEFINE_MATHOP(erfc, erfc)
|
||||
|
||||
#define JANET_DEFINE_MATH2OP(name, fop)\
|
||||
static Janet janet_##name(int32_t argc, Janet *argv) {\
|
||||
@@ -267,6 +271,7 @@ static Janet janet_##name(int32_t argc, Janet *argv) {\
|
||||
JANET_DEFINE_MATH2OP(atan2, atan2)
|
||||
JANET_DEFINE_MATH2OP(pow, pow)
|
||||
JANET_DEFINE_MATH2OP(hypot, hypot)
|
||||
JANET_DEFINE_MATH2OP(nextafter, nextafter)
|
||||
|
||||
static Janet janet_not(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 1);
|
||||
@@ -438,6 +443,26 @@ static const JanetReg math_cfuns[] = {
|
||||
JDOC("(math/exp2 x)\n\n"
|
||||
"Returns 2 to the power of x.")
|
||||
},
|
||||
{
|
||||
"math/log1p", janet_log1p,
|
||||
JDOC("(math/log1p x)\n\n"
|
||||
"Returns (log base e of x) + 1 more accurately than (+ (math/log x) 1)")
|
||||
},
|
||||
{
|
||||
"math/gamma", janet_gamma,
|
||||
JDOC("(math/gamma x)\n\n"
|
||||
"Returns gamma(x).")
|
||||
},
|
||||
{
|
||||
"math/erfc", janet_erfc,
|
||||
JDOC("(math/erfc x)\n\n"
|
||||
"Returns the complementary error function of x.")
|
||||
},
|
||||
{
|
||||
"math/erf", janet_erf,
|
||||
JDOC("(math/erf x)\n\n"
|
||||
"Returns the error function of x.")
|
||||
},
|
||||
{
|
||||
"math/expm1", janet_expm1,
|
||||
JDOC("(math/expm1 x)\n\n"
|
||||
@@ -453,13 +478,18 @@ static const JanetReg math_cfuns[] = {
|
||||
JDOC("(math/round x)\n\n"
|
||||
"Returns the integer nearest to x.")
|
||||
},
|
||||
{
|
||||
"math/next", janet_nextafter,
|
||||
JDOC("(math/next y)\n\n"
|
||||
"Returns the next representable floating point value after x in the direction of y.")
|
||||
},
|
||||
{NULL, NULL, NULL}
|
||||
};
|
||||
|
||||
/* Module entry point */
|
||||
void janet_lib_math(JanetTable *env) {
|
||||
janet_core_cfuns(env, NULL, math_cfuns);
|
||||
janet_register_abstract_type(&JanetRNG_type);
|
||||
janet_register_abstract_type(&janet_rng_type);
|
||||
#ifdef JANET_BOOTSTRAP
|
||||
janet_def(env, "math/pi", janet_wrap_number(3.1415926535897931),
|
||||
JDOC("The value pi."));
|
||||
|
||||
457
src/core/os.c
457
src/core/os.c
@@ -32,6 +32,7 @@
|
||||
#include <time.h>
|
||||
#include <fcntl.h>
|
||||
#include <errno.h>
|
||||
#include <limits.h>
|
||||
#include <stdio.h>
|
||||
#include <string.h>
|
||||
#include <sys/stat.h>
|
||||
@@ -69,6 +70,13 @@ extern char **environ;
|
||||
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);
|
||||
#elif defined(JANET_WINDOWS)
|
||||
#define timegm _mkgmtime
|
||||
#endif
|
||||
|
||||
/* Access to some global variables should be synchronized if not in single threaded mode, as
|
||||
* setenv/getenv are not thread safe. */
|
||||
#ifdef JANET_THREADS
|
||||
@@ -401,7 +409,16 @@ static Janet os_execute(int32_t argc, Janet *argv) {
|
||||
}
|
||||
|
||||
os_execute_cleanup(envp, child_argv);
|
||||
return janet_wrap_integer(WEXITSTATUS(status));
|
||||
/* 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
|
||||
}
|
||||
|
||||
@@ -621,13 +638,11 @@ static Janet os_date(int32_t argc, Janet *argv) {
|
||||
struct tm *t_info = NULL;
|
||||
if (argc) {
|
||||
int64_t integer = janet_getinteger64(argv, 0);
|
||||
if (integer < 0)
|
||||
janet_panicf("expected non-negative 64 bit signed integer, got %v", argv[0]);
|
||||
t = (time_t) integer;
|
||||
} else {
|
||||
time(&t);
|
||||
}
|
||||
if (argc >= 2 && janet_truthy(argv[2])) {
|
||||
if (argc >= 2 && janet_truthy(argv[1])) {
|
||||
/* local time */
|
||||
#ifdef JANET_WINDOWS
|
||||
localtime_s(&t_infos, &t);
|
||||
@@ -658,6 +673,101 @@ static Janet os_date(int32_t argc, Janet *argv) {
|
||||
return janet_wrap_struct(janet_struct_end(st));
|
||||
}
|
||||
|
||||
static int entry_getdst(Janet env_entry) {
|
||||
Janet v;
|
||||
if (janet_checktype(env_entry, JANET_TABLE)) {
|
||||
JanetTable *entry = janet_unwrap_table(env_entry);
|
||||
v = janet_table_get(entry, janet_ckeywordv("dst"));
|
||||
} else if (janet_checktype(env_entry, JANET_STRUCT)) {
|
||||
const JanetKV *entry = janet_unwrap_struct(env_entry);
|
||||
v = janet_struct_get(entry, janet_ckeywordv("dst"));
|
||||
} else {
|
||||
v = janet_wrap_nil();
|
||||
}
|
||||
if (janet_checktype(v, JANET_NIL)) {
|
||||
return -1;
|
||||
} else {
|
||||
return janet_truthy(v);
|
||||
}
|
||||
}
|
||||
|
||||
#ifdef JANET_WINDOWS
|
||||
typedef int32_t timeint_t;
|
||||
#else
|
||||
typedef int64_t timeint_t;
|
||||
#endif
|
||||
|
||||
static timeint_t entry_getint(Janet env_entry, char *field) {
|
||||
Janet i;
|
||||
if (janet_checktype(env_entry, JANET_TABLE)) {
|
||||
JanetTable *entry = janet_unwrap_table(env_entry);
|
||||
i = janet_table_get(entry, janet_ckeywordv(field));
|
||||
} else if (janet_checktype(env_entry, JANET_STRUCT)) {
|
||||
const JanetKV *entry = janet_unwrap_struct(env_entry);
|
||||
i = janet_struct_get(entry, janet_ckeywordv(field));
|
||||
} else {
|
||||
return 0;
|
||||
}
|
||||
|
||||
if (janet_checktype(i, JANET_NIL)) {
|
||||
return 0;
|
||||
}
|
||||
|
||||
#ifdef JANET_WINDOWS
|
||||
if (!janet_checkint(i)) {
|
||||
janet_panicf("bad slot #%s, expected 32 bit signed integer, got %v",
|
||||
field, i);
|
||||
}
|
||||
#else
|
||||
if (!janet_checkint64(i)) {
|
||||
janet_panicf("bad slot #%s, expected 64 bit signed integer, got %v",
|
||||
field, i);
|
||||
}
|
||||
#endif
|
||||
|
||||
return (timeint_t)janet_unwrap_number(i);
|
||||
}
|
||||
|
||||
static Janet os_mktime(int32_t argc, Janet *argv) {
|
||||
janet_arity(argc, 1, 2);
|
||||
time_t t;
|
||||
struct tm t_info;
|
||||
|
||||
/* Use memset instead of = {0} to silence paranoid warning in macos */
|
||||
memset(&t_info, 0, sizeof(t_info));
|
||||
|
||||
if (!janet_checktype(argv[0], JANET_TABLE) &&
|
||||
!janet_checktype(argv[0], JANET_STRUCT))
|
||||
janet_panic_type(argv[0], 0, JANET_TFLAG_DICTIONARY);
|
||||
|
||||
t_info.tm_sec = entry_getint(argv[0], "seconds");
|
||||
t_info.tm_min = entry_getint(argv[0], "minutes");
|
||||
t_info.tm_hour = entry_getint(argv[0], "hours");
|
||||
t_info.tm_mday = entry_getint(argv[0], "month-day") + 1;
|
||||
t_info.tm_mon = entry_getint(argv[0], "month");
|
||||
t_info.tm_year = entry_getint(argv[0], "year") - 1900;
|
||||
t_info.tm_isdst = entry_getdst(argv[0]);
|
||||
|
||||
if (argc >= 2 && janet_truthy(argv[1])) {
|
||||
/* local time */
|
||||
t = mktime(&t_info);
|
||||
} else {
|
||||
/* utc time */
|
||||
#ifdef __sun
|
||||
janet_panic("os/mktime UTC not supported on Solaris");
|
||||
return janet_wrap_nil();
|
||||
#else
|
||||
t = timegm(&t_info);
|
||||
#endif
|
||||
}
|
||||
|
||||
if (t == (time_t) -1) {
|
||||
janet_panicf("%s", strerror(errno));
|
||||
}
|
||||
|
||||
return janet_wrap_number((double)t);
|
||||
}
|
||||
|
||||
static Janet os_link(int32_t argc, Janet *argv) {
|
||||
janet_arity(argc, 2, 3);
|
||||
#ifdef JANET_WINDOWS
|
||||
@@ -668,9 +778,25 @@ static Janet os_link(int32_t argc, Janet *argv) {
|
||||
#else
|
||||
const char *oldpath = janet_getcstring(argv, 0);
|
||||
const char *newpath = janet_getcstring(argv, 1);
|
||||
int res = ((argc == 3 && janet_getboolean(argv, 2)) ? symlink : link)(oldpath, newpath);
|
||||
int res = ((argc == 3 && janet_truthy(argv[2])) ? symlink : link)(oldpath, newpath);
|
||||
if (-1 == res) janet_panicf("%s: %s -> %s", strerror(errno), oldpath, newpath);
|
||||
return janet_wrap_integer(res);
|
||||
return janet_wrap_nil();
|
||||
#endif
|
||||
}
|
||||
|
||||
static Janet os_symlink(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 2);
|
||||
#ifdef JANET_WINDOWS
|
||||
(void) argc;
|
||||
(void) argv;
|
||||
janet_panic("os/symlink not supported on Windows");
|
||||
return janet_wrap_nil();
|
||||
#else
|
||||
const char *oldpath = janet_getcstring(argv, 0);
|
||||
const char *newpath = janet_getcstring(argv, 1);
|
||||
int res = symlink(oldpath, newpath);
|
||||
if (-1 == res) janet_panicf("%s: %s -> %s", strerror(errno), oldpath, newpath);
|
||||
return janet_wrap_nil();
|
||||
#endif
|
||||
}
|
||||
|
||||
@@ -682,7 +808,9 @@ static Janet os_mkdir(int32_t argc, Janet *argv) {
|
||||
#else
|
||||
int res = mkdir(path, S_IRUSR | S_IWUSR | S_IXUSR | S_IRGRP | S_IWGRP | S_IXGRP | S_IROTH | S_IXOTH);
|
||||
#endif
|
||||
return janet_wrap_boolean(res != -1);
|
||||
if (res == 0) return janet_wrap_true();
|
||||
if (errno == EEXIST) return janet_wrap_false();
|
||||
janet_panicf("%s: %s", strerror(errno), path);
|
||||
}
|
||||
|
||||
static Janet os_rmdir(int32_t argc, Janet *argv) {
|
||||
@@ -737,13 +865,42 @@ static Janet os_remove(int32_t argc, Janet *argv) {
|
||||
return janet_wrap_nil();
|
||||
}
|
||||
|
||||
static Janet os_readlink(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 1);
|
||||
#ifdef JANET_WINDOWS
|
||||
static const uint8_t *janet_decode_permissions(unsigned short m) {
|
||||
uint8_t flags[9] = {0};
|
||||
flags[0] = flags[3] = flags[6] = (m & S_IREAD) ? 'r' : '-';
|
||||
flags[1] = flags[4] = flags[7] = (m & S_IWRITE) ? 'w' : '-';
|
||||
flags[2] = flags[5] = flags[8] = (m & S_IEXEC) ? 'x' : '-';
|
||||
return janet_string(flags, sizeof(flags));
|
||||
(void) argc;
|
||||
(void) argv;
|
||||
janet_panic("os/readlink not supported on Windows");
|
||||
return janet_wrap_nil();
|
||||
#else
|
||||
static char buffer[PATH_MAX];
|
||||
const char *path = janet_getcstring(argv, 0);
|
||||
ssize_t len = readlink(path, buffer, sizeof buffer);
|
||||
if (len < 0 || (size_t)len >= sizeof buffer)
|
||||
janet_panicf("%s: %s", strerror(errno), path);
|
||||
return janet_stringv((const uint8_t *)buffer, len);
|
||||
#endif
|
||||
}
|
||||
|
||||
#ifdef JANET_WINDOWS
|
||||
|
||||
typedef struct _stat jstat_t;
|
||||
typedef unsigned short jmode_t;
|
||||
|
||||
static int32_t janet_perm_to_unix(unsigned short m) {
|
||||
int32_t ret = 0;
|
||||
if (m & S_IEXEC) ret |= 0111;
|
||||
if (m & S_IWRITE) ret |= 0222;
|
||||
if (m & S_IREAD) ret |= 0444;
|
||||
return ret;
|
||||
}
|
||||
|
||||
static unsigned short janet_perm_from_unix(int32_t x) {
|
||||
unsigned short m = 0;
|
||||
if (x & 111) m |= S_IEXEC;
|
||||
if (x & 222) m |= S_IWRITE;
|
||||
if (x & 444) m |= S_IREAD;
|
||||
return m;
|
||||
}
|
||||
|
||||
static const uint8_t *janet_decode_mode(unsigned short m) {
|
||||
@@ -753,19 +910,22 @@ static const uint8_t *janet_decode_mode(unsigned short m) {
|
||||
else if (m & _S_IFCHR) str = "character";
|
||||
return janet_ckeyword(str);
|
||||
}
|
||||
|
||||
static int32_t janet_decode_permissions(jmode_t mode) {
|
||||
return (int32_t)(mode & (S_IEXEC | S_IWRITE | S_IREAD));
|
||||
}
|
||||
|
||||
#else
|
||||
static const uint8_t *janet_decode_permissions(mode_t m) {
|
||||
uint8_t flags[9] = {0};
|
||||
flags[0] = (m & S_IRUSR) ? 'r' : '-';
|
||||
flags[1] = (m & S_IWUSR) ? 'w' : '-';
|
||||
flags[2] = (m & S_IXUSR) ? 'x' : '-';
|
||||
flags[3] = (m & S_IRGRP) ? 'r' : '-';
|
||||
flags[4] = (m & S_IWGRP) ? 'w' : '-';
|
||||
flags[5] = (m & S_IXGRP) ? 'x' : '-';
|
||||
flags[6] = (m & S_IROTH) ? 'r' : '-';
|
||||
flags[7] = (m & S_IWOTH) ? 'w' : '-';
|
||||
flags[8] = (m & S_IXOTH) ? 'x' : '-';
|
||||
return janet_string(flags, sizeof(flags));
|
||||
|
||||
typedef struct stat jstat_t;
|
||||
typedef mode_t jmode_t;
|
||||
|
||||
static int32_t janet_perm_to_unix(mode_t m) {
|
||||
return (int32_t) m;
|
||||
}
|
||||
|
||||
static mode_t janet_perm_from_unix(int32_t x) {
|
||||
return (mode_t) x;
|
||||
}
|
||||
|
||||
static const uint8_t *janet_decode_mode(mode_t m) {
|
||||
@@ -779,75 +939,131 @@ static const uint8_t *janet_decode_mode(mode_t m) {
|
||||
else if (S_ISCHR(m)) str = "character";
|
||||
return janet_ckeyword(str);
|
||||
}
|
||||
|
||||
static int32_t janet_decode_permissions(jmode_t mode) {
|
||||
return (int32_t)(mode & 0777);
|
||||
}
|
||||
|
||||
#endif
|
||||
|
||||
/* Can we do this? */
|
||||
#ifdef JANET_WINDOWS
|
||||
#define stat _stat
|
||||
#endif
|
||||
static int32_t os_parse_permstring(const uint8_t *perm) {
|
||||
int32_t m = 0;
|
||||
if (perm[0] == 'r') m |= 0400;
|
||||
if (perm[1] == 'w') m |= 0200;
|
||||
if (perm[2] == 'x') m |= 0100;
|
||||
if (perm[3] == 'r') m |= 0040;
|
||||
if (perm[4] == 'w') m |= 0020;
|
||||
if (perm[5] == 'x') m |= 0010;
|
||||
if (perm[6] == 'r') m |= 0004;
|
||||
if (perm[7] == 'w') m |= 0002;
|
||||
if (perm[8] == 'x') m |= 0001;
|
||||
return m;
|
||||
}
|
||||
|
||||
static Janet os_make_permstring(int32_t permissions) {
|
||||
uint8_t bytes[9] = {0};
|
||||
bytes[0] = (permissions & 0400) ? 'r' : '-';
|
||||
bytes[1] = (permissions & 0200) ? 'w' : '-';
|
||||
bytes[2] = (permissions & 0100) ? 'x' : '-';
|
||||
bytes[3] = (permissions & 0040) ? 'r' : '-';
|
||||
bytes[4] = (permissions & 0020) ? 'w' : '-';
|
||||
bytes[5] = (permissions & 0010) ? 'x' : '-';
|
||||
bytes[6] = (permissions & 0004) ? 'r' : '-';
|
||||
bytes[7] = (permissions & 0002) ? 'w' : '-';
|
||||
bytes[8] = (permissions & 0001) ? 'x' : '-';
|
||||
return janet_stringv(bytes, sizeof(bytes));
|
||||
}
|
||||
|
||||
static int32_t os_get_unix_mode(const Janet *argv, int32_t n) {
|
||||
int32_t unix_mode;
|
||||
if (janet_checkint(argv[n])) {
|
||||
/* Integer mode */
|
||||
int32_t x = janet_unwrap_integer(argv[n]);
|
||||
if (x < 0 || x > 0777) {
|
||||
janet_panicf("bad slot #%d, expected integer in range [0, 8r777], got %v", n, argv[n]);
|
||||
}
|
||||
unix_mode = x;
|
||||
} else {
|
||||
/* Bytes mode */
|
||||
JanetByteView bytes = janet_getbytes(argv, n);
|
||||
if (bytes.len != 9) {
|
||||
janet_panicf("bad slot #%d: expected byte sequence of length 9, got %v", n, argv[n]);
|
||||
}
|
||||
unix_mode = os_parse_permstring(bytes.bytes);
|
||||
}
|
||||
return unix_mode;
|
||||
}
|
||||
|
||||
static jmode_t os_getmode(const Janet *argv, int32_t n) {
|
||||
return janet_perm_from_unix(os_get_unix_mode(argv, n));
|
||||
}
|
||||
|
||||
/* Getters */
|
||||
static Janet os_stat_dev(struct stat *st) {
|
||||
static Janet os_stat_dev(jstat_t *st) {
|
||||
return janet_wrap_number(st->st_dev);
|
||||
}
|
||||
static Janet os_stat_inode(struct stat *st) {
|
||||
static Janet os_stat_inode(jstat_t *st) {
|
||||
return janet_wrap_number(st->st_ino);
|
||||
}
|
||||
static Janet os_stat_mode(struct stat *st) {
|
||||
static Janet os_stat_mode(jstat_t *st) {
|
||||
return janet_wrap_keyword(janet_decode_mode(st->st_mode));
|
||||
}
|
||||
static Janet os_stat_permissions(struct stat *st) {
|
||||
return janet_wrap_string(janet_decode_permissions(st->st_mode));
|
||||
static Janet os_stat_int_permissions(jstat_t *st) {
|
||||
return janet_wrap_integer(janet_perm_to_unix(janet_decode_permissions(st->st_mode)));
|
||||
}
|
||||
static Janet os_stat_uid(struct stat *st) {
|
||||
static Janet os_stat_permissions(jstat_t *st) {
|
||||
return os_make_permstring(janet_perm_to_unix(janet_decode_permissions(st->st_mode)));
|
||||
}
|
||||
static Janet os_stat_uid(jstat_t *st) {
|
||||
return janet_wrap_number(st->st_uid);
|
||||
}
|
||||
static Janet os_stat_gid(struct stat *st) {
|
||||
static Janet os_stat_gid(jstat_t *st) {
|
||||
return janet_wrap_number(st->st_gid);
|
||||
}
|
||||
static Janet os_stat_nlink(struct stat *st) {
|
||||
static Janet os_stat_nlink(jstat_t *st) {
|
||||
return janet_wrap_number(st->st_nlink);
|
||||
}
|
||||
static Janet os_stat_rdev(struct stat *st) {
|
||||
static Janet os_stat_rdev(jstat_t *st) {
|
||||
return janet_wrap_number(st->st_rdev);
|
||||
}
|
||||
static Janet os_stat_size(struct stat *st) {
|
||||
static Janet os_stat_size(jstat_t *st) {
|
||||
return janet_wrap_number(st->st_size);
|
||||
}
|
||||
static Janet os_stat_accessed(struct stat *st) {
|
||||
static Janet os_stat_accessed(jstat_t *st) {
|
||||
return janet_wrap_number((double) st->st_atime);
|
||||
}
|
||||
static Janet os_stat_modified(struct stat *st) {
|
||||
static Janet os_stat_modified(jstat_t *st) {
|
||||
return janet_wrap_number((double) st->st_mtime);
|
||||
}
|
||||
static Janet os_stat_changed(struct stat *st) {
|
||||
static Janet os_stat_changed(jstat_t *st) {
|
||||
return janet_wrap_number((double) st->st_ctime);
|
||||
}
|
||||
#ifdef JANET_WINDOWS
|
||||
static Janet os_stat_blocks(struct stat *st) {
|
||||
static Janet os_stat_blocks(jstat_t *st) {
|
||||
return janet_wrap_number(0);
|
||||
}
|
||||
static Janet os_stat_blocksize(struct stat *st) {
|
||||
static Janet os_stat_blocksize(jstat_t *st) {
|
||||
return janet_wrap_number(0);
|
||||
}
|
||||
#else
|
||||
static Janet os_stat_blocks(struct stat *st) {
|
||||
static Janet os_stat_blocks(jstat_t *st) {
|
||||
return janet_wrap_number(st->st_blocks);
|
||||
}
|
||||
static Janet os_stat_blocksize(struct stat *st) {
|
||||
static Janet os_stat_blocksize(jstat_t *st) {
|
||||
return janet_wrap_number(st->st_blksize);
|
||||
}
|
||||
#endif
|
||||
|
||||
struct OsStatGetter {
|
||||
const char *name;
|
||||
Janet(*fn)(struct stat *st);
|
||||
Janet(*fn)(jstat_t *st);
|
||||
};
|
||||
|
||||
static const struct OsStatGetter os_stat_getters[] = {
|
||||
{"dev", os_stat_dev},
|
||||
{"inode", os_stat_inode},
|
||||
{"mode", os_stat_mode},
|
||||
{"int-permissions", os_stat_int_permissions},
|
||||
{"permissions", os_stat_permissions},
|
||||
{"uid", os_stat_uid},
|
||||
{"gid", os_stat_gid},
|
||||
@@ -862,7 +1078,7 @@ static const struct OsStatGetter os_stat_getters[] = {
|
||||
{NULL, NULL}
|
||||
};
|
||||
|
||||
static Janet os_stat(int32_t argc, Janet *argv) {
|
||||
static Janet os_stat_or_lstat(int do_lstat, int32_t argc, Janet *argv) {
|
||||
janet_arity(argc, 1, 2);
|
||||
const char *path = janet_getcstring(argv, 0);
|
||||
JanetTable *tab = NULL;
|
||||
@@ -880,8 +1096,18 @@ static Janet os_stat(int32_t argc, Janet *argv) {
|
||||
}
|
||||
|
||||
/* Build result */
|
||||
struct stat st;
|
||||
int res = stat(path, &st);
|
||||
jstat_t st;
|
||||
#ifdef JANET_WINDOWS
|
||||
(void) do_lstat;
|
||||
int res = _stat(path, &st);
|
||||
#else
|
||||
int res;
|
||||
if (do_lstat) {
|
||||
res = lstat(path, &st);
|
||||
} else {
|
||||
res = stat(path, &st);
|
||||
}
|
||||
#endif
|
||||
if (-1 == res) {
|
||||
return janet_wrap_nil();
|
||||
}
|
||||
@@ -903,6 +1129,37 @@ static Janet os_stat(int32_t argc, Janet *argv) {
|
||||
}
|
||||
}
|
||||
|
||||
static Janet os_stat(int32_t argc, Janet *argv) {
|
||||
return os_stat_or_lstat(0, argc, argv);
|
||||
}
|
||||
|
||||
static Janet os_lstat(int32_t argc, Janet *argv) {
|
||||
return os_stat_or_lstat(1, argc, argv);
|
||||
}
|
||||
|
||||
static Janet os_chmod(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 2);
|
||||
const char *path = janet_getcstring(argv, 0);
|
||||
#ifdef JANET_WINDOWS
|
||||
int res = _chmod(path, os_getmode(argv, 1));
|
||||
#else
|
||||
int res = chmod(path, os_getmode(argv, 1));
|
||||
#endif
|
||||
if (-1 == res) janet_panicf("%s: %s", strerror(errno), path);
|
||||
return janet_wrap_nil();
|
||||
}
|
||||
|
||||
static Janet os_umask(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 1);
|
||||
int mask = (int) os_getmode(argv, 0);
|
||||
#ifdef JANET_WINDOWS
|
||||
int res = _umask(mask);
|
||||
#else
|
||||
int res = umask(mask);
|
||||
#endif
|
||||
return janet_wrap_integer(janet_perm_to_unix(res));
|
||||
}
|
||||
|
||||
static Janet os_dir(int32_t argc, Janet *argv) {
|
||||
janet_arity(argc, 1, 2);
|
||||
const char *dir = janet_getcstring(argv, 0);
|
||||
@@ -949,6 +1206,31 @@ static Janet os_rename(int32_t argc, Janet *argv) {
|
||||
return janet_wrap_nil();
|
||||
}
|
||||
|
||||
static Janet os_realpath(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 1);
|
||||
#ifdef JANET_WINDOWS
|
||||
(void) argv;
|
||||
janet_panic("os/realpath not supported on Windows");
|
||||
#else
|
||||
const char *src = janet_getcstring(argv, 0);
|
||||
char *dest = realpath(src, NULL);
|
||||
if (NULL == dest) janet_panicf("%s: %s", strerror(errno), src);
|
||||
Janet ret = janet_cstringv(dest);
|
||||
free(dest);
|
||||
return ret;
|
||||
#endif
|
||||
}
|
||||
|
||||
static Janet os_permission_string(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 1);
|
||||
return os_make_permstring(os_get_unix_mode(argv, 0));
|
||||
}
|
||||
|
||||
static Janet os_permission_int(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 1);
|
||||
return janet_wrap_integer(os_get_unix_mode(argv, 0));
|
||||
}
|
||||
|
||||
#endif /* JANET_REDUCED_OS */
|
||||
|
||||
static const JanetReg os_cfuns[] = {
|
||||
@@ -1007,7 +1289,8 @@ static const JanetReg os_cfuns[] = {
|
||||
" only that information from stat. If the file or directory does not exist, returns nil. The keys are\n\n"
|
||||
"\t:dev - the device that the file is on\n"
|
||||
"\t:mode - the type of file, one of :file, :directory, :block, :character, :fifo, :socket, :link, or :other\n"
|
||||
"\t:permissions - A unix permission string like \"rwx--x--x\"\n"
|
||||
"\t:int-permissions - A Unix permission integer like 8r744\n"
|
||||
"\t:permissions - A Unix permission string like \"rwxr--r--\"\n"
|
||||
"\t:uid - File uid\n"
|
||||
"\t:gid - File gid\n"
|
||||
"\t:nlink - number of links to file\n"
|
||||
@@ -1019,6 +1302,19 @@ static const JanetReg os_cfuns[] = {
|
||||
"\t:changed - timestamp when file last chnaged (permissions changed)\n"
|
||||
"\t:modified - timestamp when file last modified (content changed)\n")
|
||||
},
|
||||
{
|
||||
"os/lstat", os_lstat,
|
||||
JDOC("(os/lstat path &opt tab|key)\n\n"
|
||||
"Like os/stat, but don't follow symlinks.\n")
|
||||
},
|
||||
{
|
||||
"os/chmod", os_chmod,
|
||||
JDOC("(os/chmod path mode)\n\n"
|
||||
"Change file permissions, where mode is a permission string as returned by "
|
||||
"os/perm-string, or an integer as returned by os/perm-int. "
|
||||
"When mode is an integer, it is interpreted as a Unix permission value, best specified in octal, like "
|
||||
"8r666 or 8r400. Windows will not differentiate between user, group, and other permissions, and thus will combine all of these permissions. Returns nil.")
|
||||
},
|
||||
{
|
||||
"os/touch", os_touch,
|
||||
JDOC("(os/touch path &opt actime modtime)\n\n"
|
||||
@@ -1028,13 +1324,19 @@ static const JanetReg os_cfuns[] = {
|
||||
{
|
||||
"os/cd", os_cd,
|
||||
JDOC("(os/cd path)\n\n"
|
||||
"Change current directory to path. Returns true on success, false on failure.")
|
||||
"Change current directory to path. Returns nil on success, errors on failure.")
|
||||
},
|
||||
{
|
||||
"os/umask", os_umask,
|
||||
JDOC("(os/umask mask)\n\n"
|
||||
"Set a new umask, returns the old umask.")
|
||||
},
|
||||
{
|
||||
"os/mkdir", os_mkdir,
|
||||
JDOC("(os/mkdir path)\n\n"
|
||||
"Create a new directory. The path will be relative to the current directory if relative, otherwise "
|
||||
"it will be an absolute path.")
|
||||
"it will be an absolute path. Returns true if the directory was created, false if the directory already exists, and "
|
||||
"errors otherwise.")
|
||||
},
|
||||
{
|
||||
"os/rmdir", os_rmdir,
|
||||
@@ -1049,8 +1351,20 @@ static const JanetReg os_cfuns[] = {
|
||||
{
|
||||
"os/link", os_link,
|
||||
JDOC("(os/link oldpath newpath &opt symlink)\n\n"
|
||||
"Create a symlink from oldpath to newpath. The 3 optional paramater "
|
||||
"enables a hard link over a soft link. Does not work on Windows.")
|
||||
"Create a link at newpath that points to oldpath and returns nil. "
|
||||
"Iff symlink is truthy, creates a symlink. "
|
||||
"Iff symlink is falsey or not provided, "
|
||||
"creates a hard link. Does not work on Windows.")
|
||||
},
|
||||
{
|
||||
"os/symlink", os_symlink,
|
||||
JDOC("(os/symlink oldpath newpath)\n\n"
|
||||
"Create a symlink from oldpath to newpath, returning nil. Same as (os/link oldpath newpath true).")
|
||||
},
|
||||
{
|
||||
"os/readlink", os_readlink,
|
||||
JDOC("(os/readlink path)\n\n"
|
||||
"Read the contents of a symbolic link. Does not work on Windows.\n")
|
||||
},
|
||||
{
|
||||
"os/execute", os_execute,
|
||||
@@ -1080,6 +1394,16 @@ static const JanetReg os_cfuns[] = {
|
||||
"Get the current time expressed as the number of seconds since "
|
||||
"January 1, 1970, the Unix epoch. Returns a real number.")
|
||||
},
|
||||
{
|
||||
"os/mktime", os_mktime,
|
||||
JDOC("(os/mktime date-struct &opt local)\n\n"
|
||||
"Get the broken down date-struct time expressed as the number "
|
||||
" of seconds since January 1, 1970, the Unix epoch. "
|
||||
"Returns a real number. "
|
||||
"Date is given in UTC unless local is truthy, in which case the "
|
||||
"date is computed for the local timezone.\n\n"
|
||||
"Inverse function to os/date.")
|
||||
},
|
||||
{
|
||||
"os/clock", os_clock,
|
||||
JDOC("(os/clock)\n\n"
|
||||
@@ -1100,14 +1424,14 @@ static const JanetReg os_cfuns[] = {
|
||||
{
|
||||
"os/cryptorand", os_cryptorand,
|
||||
JDOC("(os/cryptorand n &opt buf)\n\n"
|
||||
"Get or append n bytes of good quality random data provided by the os. Returns a new buffer or buf.")
|
||||
"Get or append n bytes of good quality random data provided by the OS. Returns a new buffer or buf.")
|
||||
},
|
||||
{
|
||||
"os/date", os_date,
|
||||
JDOC("(os/date &opt time local)\n\n"
|
||||
"Returns the given time as a date struct, or the current time if no time is given. "
|
||||
"Returns a struct with following key values. Note that all numbers are 0-indexed. "
|
||||
"Date is given in UTC unless local is truthy, in which case the date is formated for "
|
||||
"Date is given in UTC unless local is truthy, in which case the date is formatted for "
|
||||
"the local timezone.\n\n"
|
||||
"\t:seconds - number of seconds [0-61]\n"
|
||||
"\t:minutes - number of minutes [0-59]\n"
|
||||
@@ -1124,6 +1448,25 @@ static const JanetReg os_cfuns[] = {
|
||||
JDOC("(os/rename oldname newname)\n\n"
|
||||
"Rename a file on disk to a new path. Returns nil.")
|
||||
},
|
||||
{
|
||||
"os/realpath", os_realpath,
|
||||
JDOC("(os/realpath path)\n\n"
|
||||
"Get the absolute path for a given path, following ../, ./, and symlinks. "
|
||||
"Returns an absolute path as a string. Will raise an error on Windows.")
|
||||
},
|
||||
{
|
||||
"os/perm-string", os_permission_string,
|
||||
JDOC("(os/perm-string int)\n\n"
|
||||
"Convert a Unix octal permission value from a permission integer as returned by os/stat "
|
||||
"to a human readable string, that follows the formatting "
|
||||
"of unix tools like ls. Returns the string as a 9 character string of r, w, x and - characters. Does not "
|
||||
"include the file/directory/symlink character as rendered by `ls`.")
|
||||
},
|
||||
{
|
||||
"os/perm-int", os_permission_int,
|
||||
JDOC("(os/perm-int bytes)\n\n"
|
||||
"Parse a 9 character permission string and return an integer that can be used by chmod.")
|
||||
},
|
||||
#endif
|
||||
{NULL, NULL, NULL}
|
||||
};
|
||||
|
||||
149
src/core/parse.c
149
src/core/parse.c
@@ -26,6 +26,9 @@
|
||||
#include "util.h"
|
||||
#endif
|
||||
|
||||
#define JANET_PARSER_DEAD 0x1
|
||||
#define JANET_PARSER_GENERATED_ERROR 0x2
|
||||
|
||||
/* Check if a character is whitespace */
|
||||
static int is_whitespace(uint8_t c) {
|
||||
return c == ' '
|
||||
@@ -201,6 +204,8 @@ static int checkescape(uint8_t c) {
|
||||
default:
|
||||
return -1;
|
||||
case 'x':
|
||||
case 'u':
|
||||
case 'U':
|
||||
return 1;
|
||||
case 'n':
|
||||
return '\n';
|
||||
@@ -228,6 +233,24 @@ static int checkescape(uint8_t c) {
|
||||
/* Forward declare */
|
||||
static int stringchar(JanetParser *p, JanetParseState *state, uint8_t c);
|
||||
|
||||
static void write_codepoint(JanetParser *p, int32_t codepoint) {
|
||||
if (codepoint <= 0x7F) {
|
||||
push_buf(p, (uint8_t) codepoint);
|
||||
} else if (codepoint <= 0x7FF) {
|
||||
push_buf(p, (uint8_t)((codepoint >> 6) & 0x1F) | 0xC0);
|
||||
push_buf(p, (uint8_t)((codepoint >> 0) & 0x3F) | 0x80);
|
||||
} else if (codepoint <= 0xFFFF) {
|
||||
push_buf(p, (uint8_t)((codepoint >> 12) & 0x0F) | 0xE0);
|
||||
push_buf(p, (uint8_t)((codepoint >> 6) & 0x3F) | 0x80);
|
||||
push_buf(p, (uint8_t)((codepoint >> 0) & 0x3F) | 0x80);
|
||||
} else {
|
||||
push_buf(p, (uint8_t)((codepoint >> 18) & 0x07) | 0xF0);
|
||||
push_buf(p, (uint8_t)((codepoint >> 12) & 0x3F) | 0x80);
|
||||
push_buf(p, (uint8_t)((codepoint >> 6) & 0x3F) | 0x80);
|
||||
push_buf(p, (uint8_t)((codepoint >> 0) & 0x3F) | 0x80);
|
||||
}
|
||||
}
|
||||
|
||||
static int escapeh(JanetParser *p, JanetParseState *state, uint8_t c) {
|
||||
int digit = to_hex(c);
|
||||
if (digit < 0) {
|
||||
@@ -237,7 +260,27 @@ static int escapeh(JanetParser *p, JanetParseState *state, uint8_t c) {
|
||||
state->argn = (state->argn << 4) + digit;
|
||||
state->counter--;
|
||||
if (!state->counter) {
|
||||
push_buf(p, (state->argn & 0xFF));
|
||||
push_buf(p, (uint8_t)(state->argn & 0xFF));
|
||||
state->argn = 0;
|
||||
state->consumer = stringchar;
|
||||
}
|
||||
return 1;
|
||||
}
|
||||
|
||||
static int escapeu(JanetParser *p, JanetParseState *state, uint8_t c) {
|
||||
int digit = to_hex(c);
|
||||
if (digit < 0) {
|
||||
p->error = "invalid hex digit in unicode escape";
|
||||
return 1;
|
||||
}
|
||||
state->argn = (state->argn << 4) + digit;
|
||||
state->counter--;
|
||||
if (!state->counter) {
|
||||
if (state->argn > 0x10FFFF) {
|
||||
p->error = "invalid unicode codepoint";
|
||||
return 1;
|
||||
}
|
||||
write_codepoint(p, state->argn);
|
||||
state->argn = 0;
|
||||
state->consumer = stringchar;
|
||||
}
|
||||
@@ -254,6 +297,10 @@ static int escape1(JanetParser *p, JanetParseState *state, uint8_t c) {
|
||||
state->counter = 2;
|
||||
state->argn = 0;
|
||||
state->consumer = escapeh;
|
||||
} else if (c == 'u' || c == 'U') {
|
||||
state->counter = c == 'u' ? 4 : 6;
|
||||
state->argn = 0;
|
||||
state->consumer = escapeu;
|
||||
} else {
|
||||
push_buf(p, (uint8_t) e);
|
||||
state->consumer = stringchar;
|
||||
@@ -393,21 +440,23 @@ static Janet close_array(JanetParser *p, JanetParseState *state) {
|
||||
|
||||
static Janet close_struct(JanetParser *p, JanetParseState *state) {
|
||||
JanetKV *st = janet_struct_begin(state->argn >> 1);
|
||||
for (int32_t i = state->argn; i > 0; i -= 2) {
|
||||
Janet value = p->args[--p->argcount];
|
||||
Janet key = p->args[--p->argcount];
|
||||
for (size_t i = p->argcount - state->argn; i < p->argcount; i += 2) {
|
||||
Janet key = p->args[i];
|
||||
Janet value = p->args[i + 1];
|
||||
janet_struct_put(st, key, value);
|
||||
}
|
||||
p->argcount -= state->argn;
|
||||
return janet_wrap_struct(janet_struct_end(st));
|
||||
}
|
||||
|
||||
static Janet close_table(JanetParser *p, JanetParseState *state) {
|
||||
JanetTable *table = janet_table(state->argn >> 1);
|
||||
for (int32_t i = state->argn; i > 0; i -= 2) {
|
||||
Janet value = p->args[--p->argcount];
|
||||
Janet key = p->args[--p->argcount];
|
||||
for (size_t i = p->argcount - state->argn; i < p->argcount; i += 2) {
|
||||
Janet key = p->args[i];
|
||||
Janet value = p->args[i + 1];
|
||||
janet_table_put(table, key, value);
|
||||
}
|
||||
p->argcount -= state->argn;
|
||||
return janet_wrap_table(table);
|
||||
}
|
||||
|
||||
@@ -591,11 +640,30 @@ void janet_parser_eof(JanetParser *parser) {
|
||||
size_t oldline = parser->line;
|
||||
janet_parser_consume(parser, '\n');
|
||||
if (parser->statecount > 1) {
|
||||
parser->error = "unexpected end of source";
|
||||
JanetParseState *s = parser->states + (parser->statecount - 1);
|
||||
JanetBuffer *buffer = janet_buffer(40);
|
||||
janet_buffer_push_cstring(buffer, "unexpected end of source, ");
|
||||
if (s->flags & PFLAG_PARENS) {
|
||||
janet_buffer_push_u8(buffer, '(');
|
||||
} else if (s->flags & PFLAG_SQRBRACKETS) {
|
||||
janet_buffer_push_u8(buffer, '[');
|
||||
} else if (s->flags & PFLAG_CURLYBRACKETS) {
|
||||
janet_buffer_push_u8(buffer, '{');
|
||||
} else if (s->flags & PFLAG_STRING) {
|
||||
janet_buffer_push_u8(buffer, '"');
|
||||
} else if (s->flags & PFLAG_LONGSTRING) {
|
||||
int32_t i;
|
||||
for (i = 0; i < s->argn; i++) {
|
||||
janet_buffer_push_u8(buffer, '`');
|
||||
}
|
||||
}
|
||||
janet_formatb(buffer, " opened at line %d, column %d", s->line, s->column);
|
||||
parser->error = (const char *) janet_string(buffer->data, buffer->count);
|
||||
parser->flag |= JANET_PARSER_GENERATED_ERROR;
|
||||
}
|
||||
parser->line = oldline;
|
||||
parser->column = oldcolumn;
|
||||
parser->flag = 1;
|
||||
parser->flag |= JANET_PARSER_DEAD;
|
||||
}
|
||||
|
||||
enum JanetParserStatus janet_parser_status(JanetParser *parser) {
|
||||
@@ -617,6 +685,7 @@ const char *janet_parser_error(JanetParser *parser) {
|
||||
if (status == JANET_PARSE_ERROR) {
|
||||
const char *e = parser->error;
|
||||
parser->error = NULL;
|
||||
parser->flag &= ~JANET_PARSER_GENERATED_ERROR;
|
||||
janet_parser_flush(parser);
|
||||
return e;
|
||||
}
|
||||
@@ -720,6 +789,9 @@ static int parsermark(void *p, size_t size) {
|
||||
for (i = 0; i < parser->argcount; i++) {
|
||||
janet_mark(parser->args[i]);
|
||||
}
|
||||
if (parser->flag & JANET_PARSER_GENERATED_ERROR) {
|
||||
janet_mark(janet_wrap_string(parser->error));
|
||||
}
|
||||
return 0;
|
||||
}
|
||||
|
||||
@@ -732,7 +804,7 @@ static int parsergc(void *p, size_t size) {
|
||||
|
||||
static int parserget(void *p, Janet key, Janet *out);
|
||||
|
||||
static JanetAbstractType janet_parse_parsertype = {
|
||||
const JanetAbstractType janet_parser_type = {
|
||||
"core/parser",
|
||||
parsergc,
|
||||
parsermark,
|
||||
@@ -744,14 +816,14 @@ static JanetAbstractType janet_parse_parsertype = {
|
||||
static Janet cfun_parse_parser(int32_t argc, Janet *argv) {
|
||||
(void) argv;
|
||||
janet_fixarity(argc, 0);
|
||||
JanetParser *p = janet_abstract(&janet_parse_parsertype, sizeof(JanetParser));
|
||||
JanetParser *p = janet_abstract(&janet_parser_type, sizeof(JanetParser));
|
||||
janet_parser_init(p);
|
||||
return janet_wrap_abstract(p);
|
||||
}
|
||||
|
||||
static Janet cfun_parse_consume(int32_t argc, Janet *argv) {
|
||||
janet_arity(argc, 2, 3);
|
||||
JanetParser *p = janet_getabstract(argv, 0, &janet_parse_parsertype);
|
||||
JanetParser *p = janet_getabstract(argv, 0, &janet_parser_type);
|
||||
JanetByteView view = janet_getbytes(argv, 1);
|
||||
if (argc == 3) {
|
||||
int32_t offset = janet_getinteger(argv, 2);
|
||||
@@ -776,14 +848,14 @@ static Janet cfun_parse_consume(int32_t argc, Janet *argv) {
|
||||
|
||||
static Janet cfun_parse_eof(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 1);
|
||||
JanetParser *p = janet_getabstract(argv, 0, &janet_parse_parsertype);
|
||||
JanetParser *p = janet_getabstract(argv, 0, &janet_parser_type);
|
||||
janet_parser_eof(p);
|
||||
return argv[0];
|
||||
}
|
||||
|
||||
static Janet cfun_parse_insert(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 2);
|
||||
JanetParser *p = janet_getabstract(argv, 0, &janet_parse_parsertype);
|
||||
JanetParser *p = janet_getabstract(argv, 0, &janet_parser_type);
|
||||
JanetParseState *s = p->states + p->statecount - 1;
|
||||
if (s->consumer == tokenchar) {
|
||||
janet_parser_consume(p, ' ');
|
||||
@@ -817,13 +889,13 @@ static Janet cfun_parse_insert(int32_t argc, Janet *argv) {
|
||||
|
||||
static Janet cfun_parse_has_more(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 1);
|
||||
JanetParser *p = janet_getabstract(argv, 0, &janet_parse_parsertype);
|
||||
JanetParser *p = janet_getabstract(argv, 0, &janet_parser_type);
|
||||
return janet_wrap_boolean(janet_parser_has_more(p));
|
||||
}
|
||||
|
||||
static Janet cfun_parse_byte(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 2);
|
||||
JanetParser *p = janet_getabstract(argv, 0, &janet_parse_parsertype);
|
||||
JanetParser *p = janet_getabstract(argv, 0, &janet_parser_type);
|
||||
int32_t i = janet_getinteger(argv, 1);
|
||||
janet_parser_consume(p, 0xFF & i);
|
||||
return argv[0];
|
||||
@@ -831,7 +903,7 @@ static Janet cfun_parse_byte(int32_t argc, Janet *argv) {
|
||||
|
||||
static Janet cfun_parse_status(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 1);
|
||||
JanetParser *p = janet_getabstract(argv, 0, &janet_parse_parsertype);
|
||||
JanetParser *p = janet_getabstract(argv, 0, &janet_parser_type);
|
||||
const char *stat = NULL;
|
||||
switch (janet_parser_status(p)) {
|
||||
case JANET_PARSE_PENDING:
|
||||
@@ -852,28 +924,32 @@ static Janet cfun_parse_status(int32_t argc, Janet *argv) {
|
||||
|
||||
static Janet cfun_parse_error(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 1);
|
||||
JanetParser *p = janet_getabstract(argv, 0, &janet_parse_parsertype);
|
||||
JanetParser *p = janet_getabstract(argv, 0, &janet_parser_type);
|
||||
const char *err = janet_parser_error(p);
|
||||
if (err) return janet_cstringv(err);
|
||||
if (err) {
|
||||
return (p->flag & JANET_PARSER_GENERATED_ERROR)
|
||||
? janet_wrap_string(err)
|
||||
: janet_cstringv(err);
|
||||
}
|
||||
return janet_wrap_nil();
|
||||
}
|
||||
|
||||
static Janet cfun_parse_produce(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 1);
|
||||
JanetParser *p = janet_getabstract(argv, 0, &janet_parse_parsertype);
|
||||
JanetParser *p = janet_getabstract(argv, 0, &janet_parser_type);
|
||||
return janet_parser_produce(p);
|
||||
}
|
||||
|
||||
static Janet cfun_parse_flush(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 1);
|
||||
JanetParser *p = janet_getabstract(argv, 0, &janet_parse_parsertype);
|
||||
JanetParser *p = janet_getabstract(argv, 0, &janet_parser_type);
|
||||
janet_parser_flush(p);
|
||||
return argv[0];
|
||||
}
|
||||
|
||||
static Janet cfun_parse_where(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 1);
|
||||
JanetParser *p = janet_getabstract(argv, 0, &janet_parse_parsertype);
|
||||
JanetParser *p = janet_getabstract(argv, 0, &janet_parser_type);
|
||||
Janet *tup = janet_tuple_begin(2);
|
||||
tup[0] = janet_wrap_integer(p->line);
|
||||
tup[1] = janet_wrap_integer(p->column);
|
||||
@@ -953,31 +1029,30 @@ struct ParserStateGetter {
|
||||
};
|
||||
|
||||
static Janet parser_state_delimiters(const JanetParser *_p) {
|
||||
JanetParser *clone = janet_abstract(&janet_parse_parsertype, sizeof(JanetParser));
|
||||
janet_parser_clone(_p, clone);
|
||||
JanetParser *p = (JanetParser *)_p;
|
||||
size_t i;
|
||||
const uint8_t *str;
|
||||
size_t oldcount;
|
||||
oldcount = clone->bufcount;
|
||||
for (i = 0; i < clone->statecount; i++) {
|
||||
JanetParseState *s = clone->states + i;
|
||||
oldcount = p->bufcount;
|
||||
for (i = 0; i < p->statecount; i++) {
|
||||
JanetParseState *s = p->states + i;
|
||||
if (s->flags & PFLAG_PARENS) {
|
||||
push_buf(clone, '(');
|
||||
push_buf(p, '(');
|
||||
} else if (s->flags & PFLAG_SQRBRACKETS) {
|
||||
push_buf(clone, '[');
|
||||
push_buf(p, '[');
|
||||
} else if (s->flags & PFLAG_CURLYBRACKETS) {
|
||||
push_buf(clone, '{');
|
||||
push_buf(p, '{');
|
||||
} else if (s->flags & PFLAG_STRING) {
|
||||
push_buf(clone, '"');
|
||||
push_buf(p, '"');
|
||||
} else if (s->flags & PFLAG_LONGSTRING) {
|
||||
int32_t i;
|
||||
for (i = 0; i < s->argn; i++) {
|
||||
push_buf(clone, '`');
|
||||
push_buf(p, '`');
|
||||
}
|
||||
}
|
||||
}
|
||||
str = janet_string(clone->buf + oldcount, (int32_t)(clone->bufcount - oldcount));
|
||||
clone->bufcount = oldcount;
|
||||
str = janet_string(p->buf + oldcount, (int32_t)(p->bufcount - oldcount));
|
||||
p->bufcount = oldcount;
|
||||
return janet_wrap_string(str);
|
||||
}
|
||||
|
||||
@@ -1004,7 +1079,7 @@ static const struct ParserStateGetter parser_state_getters[] = {
|
||||
static Janet cfun_parse_state(int32_t argc, Janet *argv) {
|
||||
janet_arity(argc, 1, 2);
|
||||
const uint8_t *key = NULL;
|
||||
JanetParser *p = janet_getabstract(argv, 0, &janet_parse_parsertype);
|
||||
JanetParser *p = janet_getabstract(argv, 0, &janet_parser_type);
|
||||
if (argc == 2) {
|
||||
key = janet_getkeyword(argv, 1);
|
||||
}
|
||||
@@ -1031,8 +1106,8 @@ static Janet cfun_parse_state(int32_t argc, Janet *argv) {
|
||||
|
||||
static Janet cfun_parse_clone(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 1);
|
||||
JanetParser *src = janet_getabstract(argv, 0, &janet_parse_parsertype);
|
||||
JanetParser *dest = janet_abstract(&janet_parse_parsertype, sizeof(JanetParser));
|
||||
JanetParser *src = janet_getabstract(argv, 0, &janet_parser_type);
|
||||
JanetParser *dest = janet_abstract(&janet_parser_type, sizeof(JanetParser));
|
||||
janet_parser_clone(src, dest);
|
||||
return janet_wrap_abstract(dest);
|
||||
}
|
||||
|
||||
@@ -35,34 +35,6 @@
|
||||
* Runtime
|
||||
*/
|
||||
|
||||
/* opcodes for peg vm */
|
||||
typedef enum {
|
||||
RULE_LITERAL, /* [len, bytes...] */
|
||||
RULE_NCHAR, /* [n] */
|
||||
RULE_NOTNCHAR, /* [n] */
|
||||
RULE_RANGE, /* [lo | hi << 16 (1 word)] */
|
||||
RULE_SET, /* [bitmap (8 words)] */
|
||||
RULE_LOOK, /* [offset, rule] */
|
||||
RULE_CHOICE, /* [len, rules...] */
|
||||
RULE_SEQUENCE, /* [len, rules...] */
|
||||
RULE_IF, /* [rule_a, rule_b (b if a)] */
|
||||
RULE_IFNOT, /* [rule_a, rule_b (b if not a)] */
|
||||
RULE_NOT, /* [rule] */
|
||||
RULE_BETWEEN, /* [lo, hi, rule] */
|
||||
RULE_GETTAG, /* [searchtag, tag] */
|
||||
RULE_CAPTURE, /* [rule, tag] */
|
||||
RULE_POSITION, /* [tag] */
|
||||
RULE_ARGUMENT, /* [argument-index, tag] */
|
||||
RULE_CONSTANT, /* [constant, tag] */
|
||||
RULE_ACCUMULATE, /* [rule, tag] */
|
||||
RULE_GROUP, /* [rule, tag] */
|
||||
RULE_REPLACE, /* [rule, constant, tag] */
|
||||
RULE_MATCHTIME, /* [rule, constant, tag] */
|
||||
RULE_ERROR, /* [rule] */
|
||||
RULE_DROP, /* [rule] */
|
||||
RULE_BACKMATCH, /* [tag] */
|
||||
} Opcode;
|
||||
|
||||
/* Hold captured patterns and match state */
|
||||
typedef struct {
|
||||
const uint8_t *text_start;
|
||||
@@ -369,19 +341,23 @@ tail:
|
||||
s->mode = oldmode;
|
||||
if (!result) return NULL;
|
||||
|
||||
Janet cap;
|
||||
Janet cap = janet_wrap_nil();
|
||||
Janet constant = s->constants[rule[2]];
|
||||
switch (janet_type(constant)) {
|
||||
default:
|
||||
cap = constant;
|
||||
break;
|
||||
case JANET_STRUCT:
|
||||
cap = janet_struct_get(janet_unwrap_struct(constant),
|
||||
s->captures->data[s->captures->count - 1]);
|
||||
if (s->captures->count) {
|
||||
cap = janet_struct_get(janet_unwrap_struct(constant),
|
||||
s->captures->data[s->captures->count - 1]);
|
||||
}
|
||||
break;
|
||||
case JANET_TABLE:
|
||||
cap = janet_table_get(janet_unwrap_table(constant),
|
||||
s->captures->data[s->captures->count - 1]);
|
||||
if (s->captures->count) {
|
||||
cap = janet_table_get(janet_unwrap_table(constant),
|
||||
s->captures->data[s->captures->count - 1]);
|
||||
}
|
||||
break;
|
||||
case JANET_CFUNCTION:
|
||||
cap = janet_unwrap_cfunction(constant)(s->captures->count - cs.cap,
|
||||
@@ -476,7 +452,7 @@ JANET_NO_RETURN static void peg_panic(Builder *b, const char *msg) {
|
||||
|
||||
static void peg_fixarity(Builder *b, int32_t argc, int32_t arity) {
|
||||
if (argc != arity) {
|
||||
peg_panicf(b, "expected %d argument%s, got %d%",
|
||||
peg_panicf(b, "expected %d argument%s, got %d",
|
||||
arity,
|
||||
arity == 1 ? "" : "s",
|
||||
argc);
|
||||
@@ -1012,16 +988,9 @@ static uint32_t peg_compile1(Builder *b, Janet peg) {
|
||||
* Post-Compilation
|
||||
*/
|
||||
|
||||
typedef struct {
|
||||
uint32_t *bytecode;
|
||||
Janet *constants;
|
||||
size_t bytecode_len;
|
||||
uint32_t num_constants;
|
||||
} Peg;
|
||||
|
||||
static int peg_mark(void *p, size_t size) {
|
||||
(void) size;
|
||||
Peg *peg = (Peg *)p;
|
||||
JanetPeg *peg = (JanetPeg *)p;
|
||||
if (NULL != peg->constants)
|
||||
for (uint32_t i = 0; i < peg->num_constants; i++)
|
||||
janet_mark(peg->constants[i]);
|
||||
@@ -1029,7 +998,7 @@ static int peg_mark(void *p, size_t size) {
|
||||
}
|
||||
|
||||
static void peg_marshal(void *p, JanetMarshalContext *ctx) {
|
||||
Peg *peg = (Peg *)p;
|
||||
JanetPeg *peg = (JanetPeg *)p;
|
||||
janet_marshal_size(ctx, peg->bytecode_len);
|
||||
janet_marshal_int(ctx, (int32_t)peg->num_constants);
|
||||
janet_marshal_abstract(ctx, p);
|
||||
@@ -1051,7 +1020,7 @@ static void *peg_unmarshal(JanetMarshalContext *ctx) {
|
||||
uint32_t num_constants = (uint32_t) janet_unmarshal_int(ctx);
|
||||
|
||||
/* Calculate offsets. Should match those in make_peg */
|
||||
size_t bytecode_start = size_padded(sizeof(Peg), sizeof(uint32_t));
|
||||
size_t bytecode_start = size_padded(sizeof(JanetPeg), sizeof(uint32_t));
|
||||
size_t bytecode_size = bytecode_len * sizeof(uint32_t);
|
||||
size_t constants_start = size_padded(bytecode_start + bytecode_size, sizeof(Janet));
|
||||
size_t total_size = constants_start + sizeof(Janet) * (size_t) num_constants;
|
||||
@@ -1061,7 +1030,7 @@ static void *peg_unmarshal(JanetMarshalContext *ctx) {
|
||||
|
||||
/* Allocate PEG */
|
||||
char *mem = janet_unmarshal_abstract(ctx, total_size);
|
||||
Peg *peg = (Peg *)mem;
|
||||
JanetPeg *peg = (JanetPeg *)mem;
|
||||
uint32_t *bytecode = (uint32_t *)(mem + bytecode_start);
|
||||
Janet *constants = (Janet *)(mem + constants_start);
|
||||
peg->bytecode = NULL;
|
||||
@@ -1204,7 +1173,7 @@ bad:
|
||||
|
||||
static int cfun_peg_getter(JanetAbstract a, Janet key, Janet *out);
|
||||
|
||||
static const JanetAbstractType peg_type = {
|
||||
const JanetAbstractType janet_peg_type = {
|
||||
"core/peg",
|
||||
NULL,
|
||||
peg_mark,
|
||||
@@ -1215,15 +1184,15 @@ static const JanetAbstractType peg_type = {
|
||||
JANET_ATEND_UNMARSHAL
|
||||
};
|
||||
|
||||
/* Convert Builder to Peg (Janet Abstract Value) */
|
||||
static Peg *make_peg(Builder *b) {
|
||||
size_t bytecode_start = size_padded(sizeof(Peg), sizeof(uint32_t));
|
||||
/* Convert Builder to JanetPeg (Janet Abstract Value) */
|
||||
static JanetPeg *make_peg(Builder *b) {
|
||||
size_t bytecode_start = size_padded(sizeof(JanetPeg), sizeof(uint32_t));
|
||||
size_t bytecode_size = janet_v_count(b->bytecode) * sizeof(uint32_t);
|
||||
size_t constants_start = size_padded(bytecode_start + bytecode_size, sizeof(Janet));
|
||||
size_t constants_size = janet_v_count(b->constants) * sizeof(Janet);
|
||||
size_t total_size = constants_start + constants_size;
|
||||
char *mem = janet_abstract(&peg_type, total_size);
|
||||
Peg *peg = (Peg *)mem;
|
||||
char *mem = janet_abstract(&janet_peg_type, total_size);
|
||||
JanetPeg *peg = (JanetPeg *)mem;
|
||||
peg->bytecode = (uint32_t *)(mem + bytecode_start);
|
||||
peg->constants = (Janet *)(mem + constants_start);
|
||||
peg->num_constants = janet_v_count(b->constants);
|
||||
@@ -1234,7 +1203,7 @@ static Peg *make_peg(Builder *b) {
|
||||
}
|
||||
|
||||
/* Compiler entry point */
|
||||
static Peg *compile_peg(Janet x) {
|
||||
static JanetPeg *compile_peg(Janet x) {
|
||||
Builder builder;
|
||||
builder.grammar = janet_table(0);
|
||||
builder.default_grammar = janet_get_core_table("default-peg-grammar");
|
||||
@@ -1245,7 +1214,7 @@ static Peg *compile_peg(Janet x) {
|
||||
builder.form = x;
|
||||
builder.depth = JANET_RECURSION_GUARD;
|
||||
peg_compile1(&builder, x);
|
||||
Peg *peg = make_peg(&builder);
|
||||
JanetPeg *peg = make_peg(&builder);
|
||||
builder_cleanup(&builder);
|
||||
return peg;
|
||||
}
|
||||
@@ -1256,15 +1225,15 @@ static Peg *compile_peg(Janet x) {
|
||||
|
||||
static Janet cfun_peg_compile(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 1);
|
||||
Peg *peg = compile_peg(argv[0]);
|
||||
JanetPeg *peg = compile_peg(argv[0]);
|
||||
return janet_wrap_abstract(peg);
|
||||
}
|
||||
|
||||
static Janet cfun_peg_match(int32_t argc, Janet *argv) {
|
||||
janet_arity(argc, 2, -1);
|
||||
Peg *peg;
|
||||
JanetPeg *peg;
|
||||
if (janet_checktype(argv[0], JANET_ABSTRACT) &&
|
||||
janet_abstract_type(janet_unwrap_abstract(argv[0])) == &peg_type) {
|
||||
janet_abstract_type(janet_unwrap_abstract(argv[0])) == &janet_peg_type) {
|
||||
peg = janet_unwrap_abstract(argv[0]);
|
||||
} else {
|
||||
peg = compile_peg(argv[0]);
|
||||
@@ -1323,7 +1292,7 @@ static const JanetReg peg_cfuns[] = {
|
||||
/* Load the peg module */
|
||||
void janet_lib_peg(JanetTable *env) {
|
||||
janet_core_cfuns(env, NULL, peg_cfuns);
|
||||
janet_register_abstract_type(&peg_type);
|
||||
janet_register_abstract_type(&janet_peg_type);
|
||||
}
|
||||
|
||||
#endif /* ifdef JANET_PEG */
|
||||
|
||||
249
src/core/pp.c
249
src/core/pp.c
@@ -156,7 +156,7 @@ static void janet_escape_string_impl(JanetBuffer *buffer, const uint8_t *str, in
|
||||
janet_buffer_push_bytes(buffer, (const uint8_t *)"\\\\", 2);
|
||||
break;
|
||||
default:
|
||||
if (c < 32 || c > 127) {
|
||||
if (c < 32 || c > 126) {
|
||||
uint8_t buf[4];
|
||||
buf[0] = '\\';
|
||||
buf[1] = 'x';
|
||||
@@ -459,8 +459,8 @@ static const char *janet_pretty_colors[] = {
|
||||
|
||||
#define JANET_PRETTY_DICT_ONELINE 4
|
||||
#define JANET_PRETTY_IND_ONELINE 10
|
||||
#define JANET_PRETTY_DICT_LIMIT 16
|
||||
#define JANET_PRETTY_ARRAY_LIMIT 16
|
||||
#define JANET_PRETTY_DICT_LIMIT 30
|
||||
#define JANET_PRETTY_ARRAY_LIMIT 160
|
||||
|
||||
/* Helper for pretty printing */
|
||||
static void janet_pretty_one(struct pretty *S, Janet x, int is_dict_value) {
|
||||
@@ -591,6 +591,11 @@ static void janet_pretty_one(struct pretty *S, Janet x, int is_dict_value) {
|
||||
if (is_dict_value && len >= JANET_PRETTY_DICT_ONELINE) print_newline(S, 0);
|
||||
for (i = 0; i < cap; i++) {
|
||||
if (!janet_checktype(kvs[i].key, JANET_NIL)) {
|
||||
if (counter == JANET_PRETTY_DICT_LIMIT) {
|
||||
print_newline(S, 0);
|
||||
janet_buffer_push_cstring(S->buffer, "...");
|
||||
break;
|
||||
}
|
||||
if (first_kv_pair) {
|
||||
first_kv_pair = 0;
|
||||
} else {
|
||||
@@ -600,11 +605,6 @@ static void janet_pretty_one(struct pretty *S, Janet x, int is_dict_value) {
|
||||
janet_buffer_push_u8(S->buffer, ' ');
|
||||
janet_pretty_one(S, kvs[i].value, 1);
|
||||
counter++;
|
||||
if (counter == 10) {
|
||||
print_newline(S, 0);
|
||||
janet_buffer_push_cstring(S->buffer, "...");
|
||||
break;
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
@@ -688,96 +688,6 @@ static void pushtypes(JanetBuffer *buffer, int types) {
|
||||
}
|
||||
}
|
||||
|
||||
void janet_formatb(JanetBuffer *bufp, const char *format, va_list args) {
|
||||
for (const char *c = format; *c; c++) {
|
||||
switch (*c) {
|
||||
default:
|
||||
janet_buffer_push_u8(bufp, *c);
|
||||
break;
|
||||
case '%': {
|
||||
if (c[1] == '\0')
|
||||
break;
|
||||
switch (*++c) {
|
||||
default:
|
||||
janet_buffer_push_u8(bufp, *c);
|
||||
break;
|
||||
case 'f':
|
||||
number_to_string_b(bufp, va_arg(args, double));
|
||||
break;
|
||||
case 'd':
|
||||
integer_to_string_b(bufp, va_arg(args, long));
|
||||
break;
|
||||
case 'S': {
|
||||
const uint8_t *str = va_arg(args, const uint8_t *);
|
||||
janet_buffer_push_bytes(bufp, str, janet_string_length(str));
|
||||
break;
|
||||
}
|
||||
case 's':
|
||||
janet_buffer_push_cstring(bufp, va_arg(args, const char *));
|
||||
break;
|
||||
case 'c':
|
||||
janet_buffer_push_u8(bufp, (uint8_t) va_arg(args, long));
|
||||
break;
|
||||
case 'q': {
|
||||
const uint8_t *str = va_arg(args, const uint8_t *);
|
||||
janet_escape_string_b(bufp, str);
|
||||
break;
|
||||
}
|
||||
case 't': {
|
||||
janet_buffer_push_cstring(bufp, typestr(va_arg(args, Janet)));
|
||||
break;
|
||||
}
|
||||
case 'T': {
|
||||
int types = va_arg(args, long);
|
||||
pushtypes(bufp, types);
|
||||
break;
|
||||
}
|
||||
case 'V': {
|
||||
janet_to_string_b(bufp, va_arg(args, Janet));
|
||||
break;
|
||||
}
|
||||
case 'v': {
|
||||
janet_description_b(bufp, va_arg(args, Janet));
|
||||
break;
|
||||
}
|
||||
case 'p': {
|
||||
janet_pretty(bufp, 4, 0, va_arg(args, Janet));
|
||||
break;
|
||||
}
|
||||
case 'P': {
|
||||
janet_pretty(bufp, 4, JANET_PRETTY_COLOR, va_arg(args, Janet));
|
||||
break;
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
/* Helper function for formatting strings. Useful for generating error messages and the like.
|
||||
* Similar to printf, but specialized for operating with janet. */
|
||||
const uint8_t *janet_formatc(const char *format, ...) {
|
||||
va_list args;
|
||||
const uint8_t *ret;
|
||||
JanetBuffer buffer;
|
||||
int32_t len = 0;
|
||||
|
||||
/* Calculate length, init buffer and args */
|
||||
while (format[len]) len++;
|
||||
janet_buffer_init(&buffer, len);
|
||||
va_start(args, format);
|
||||
|
||||
/* Run format */
|
||||
janet_formatb(&buffer, format, args);
|
||||
|
||||
/* Iterate length */
|
||||
va_end(args);
|
||||
|
||||
ret = janet_string(buffer.data, buffer.count);
|
||||
janet_buffer_deinit(&buffer);
|
||||
return ret;
|
||||
}
|
||||
|
||||
/*
|
||||
* code adapted from lua/lstrlib.c http://lua.org
|
||||
*/
|
||||
@@ -818,6 +728,149 @@ static const char *scanformat(
|
||||
return p;
|
||||
}
|
||||
|
||||
void janet_formatbv(JanetBuffer *b, const char *format, va_list args) {
|
||||
const char *format_end = format + strlen(format);
|
||||
const char *c = format;
|
||||
int32_t startlen = b->count;
|
||||
while (c < format_end) {
|
||||
if (*c != '%') {
|
||||
janet_buffer_push_u8(b, (uint8_t) *c++);
|
||||
} else if (*++c == '%') {
|
||||
janet_buffer_push_u8(b, (uint8_t) *c++);
|
||||
} else {
|
||||
char form[MAX_FORMAT], item[MAX_ITEM];
|
||||
char width[3], precision[3];
|
||||
int nb = 0; /* number of bytes in added item */
|
||||
c = scanformat(c, form, width, precision);
|
||||
switch (*c++) {
|
||||
case 'c': {
|
||||
int n = va_arg(args, long);
|
||||
nb = snprintf(item, MAX_ITEM, form, n);
|
||||
break;
|
||||
}
|
||||
case 'd':
|
||||
case 'i':
|
||||
case 'o':
|
||||
case 'u':
|
||||
case 'x':
|
||||
case 'X': {
|
||||
int32_t n = va_arg(args, long);
|
||||
nb = snprintf(item, MAX_ITEM, form, n);
|
||||
break;
|
||||
}
|
||||
case 'a':
|
||||
case 'A':
|
||||
case 'e':
|
||||
case 'E':
|
||||
case 'f':
|
||||
case 'g':
|
||||
case 'G': {
|
||||
double d = va_arg(args, double);
|
||||
nb = snprintf(item, MAX_ITEM, form, d);
|
||||
break;
|
||||
}
|
||||
case 's':
|
||||
case 'S': {
|
||||
const char *str = va_arg(args, const char *);
|
||||
int32_t len = c[-1] == 's'
|
||||
? (int32_t) strlen(str)
|
||||
: janet_string_length((JanetString) str);
|
||||
if (form[2] == '\0')
|
||||
janet_buffer_push_bytes(b, (const uint8_t *) str, len);
|
||||
else {
|
||||
if (len != (int32_t) strlen((const char *) str))
|
||||
janet_panic("string contains zeros");
|
||||
if (!strchr(form, '.') && len >= 100) {
|
||||
janet_panic("no precision and string is too long to be formatted");
|
||||
} else {
|
||||
nb = snprintf(item, MAX_ITEM, form, str);
|
||||
}
|
||||
}
|
||||
break;
|
||||
}
|
||||
case 'V':
|
||||
janet_to_string_b(b, va_arg(args, Janet));
|
||||
break;
|
||||
case 'v':
|
||||
janet_description_b(b, va_arg(args, Janet));
|
||||
break;
|
||||
case 't':
|
||||
janet_buffer_push_cstring(b, typestr(va_arg(args, Janet)));
|
||||
break;
|
||||
case 'T': {
|
||||
int types = va_arg(args, long);
|
||||
pushtypes(b, types);
|
||||
break;
|
||||
}
|
||||
case 'Q':
|
||||
case 'q':
|
||||
case 'P':
|
||||
case 'p': { /* janet pretty , precision = depth */
|
||||
int depth = atoi(precision);
|
||||
if (depth < 1) depth = 4;
|
||||
char d = c[-1];
|
||||
int has_color = (d == 'P') || (d == 'Q');
|
||||
int has_oneline = (d == 'Q') || (d == 'q');
|
||||
int flags = 0;
|
||||
flags |= has_color ? JANET_PRETTY_COLOR : 0;
|
||||
flags |= has_oneline ? JANET_PRETTY_ONELINE : 0;
|
||||
janet_pretty_(b, depth, flags, va_arg(args, Janet), startlen);
|
||||
break;
|
||||
}
|
||||
case 'j': {
|
||||
int depth = atoi(precision);
|
||||
if (depth < 1)
|
||||
depth = JANET_RECURSION_GUARD;
|
||||
janet_jdn_(b, depth, va_arg(args, Janet), startlen);
|
||||
break;
|
||||
}
|
||||
default: {
|
||||
/* also treat cases 'nLlh' */
|
||||
janet_panicf("invalid conversion '%s' to 'format'",
|
||||
form);
|
||||
}
|
||||
}
|
||||
if (nb >= MAX_ITEM)
|
||||
janet_panicf("format buffer overflow", form);
|
||||
if (nb > 0)
|
||||
janet_buffer_push_bytes(b, (uint8_t *) item, nb);
|
||||
}
|
||||
|
||||
}
|
||||
}
|
||||
|
||||
/* Helper function for formatting strings. Useful for generating error messages and the like.
|
||||
* Similar to printf, but specialized for operating with janet. */
|
||||
const uint8_t *janet_formatc(const char *format, ...) {
|
||||
va_list args;
|
||||
const uint8_t *ret;
|
||||
JanetBuffer buffer;
|
||||
int32_t len = 0;
|
||||
|
||||
/* Calculate length, init buffer and args */
|
||||
while (format[len]) len++;
|
||||
janet_buffer_init(&buffer, len);
|
||||
va_start(args, format);
|
||||
|
||||
/* Run format */
|
||||
janet_formatbv(&buffer, format, args);
|
||||
|
||||
/* Iterate length */
|
||||
va_end(args);
|
||||
|
||||
ret = janet_string(buffer.data, buffer.count);
|
||||
janet_buffer_deinit(&buffer);
|
||||
return ret;
|
||||
}
|
||||
|
||||
JanetBuffer *janet_formatb(JanetBuffer *buffer, const char *format, ...) {
|
||||
va_list args;
|
||||
va_start(args, format);
|
||||
janet_formatbv(buffer, format, args);
|
||||
va_end(args);
|
||||
return buffer;
|
||||
}
|
||||
|
||||
/* Shared implementation between string/format and
|
||||
* buffer/format */
|
||||
void janet_buffer_format(
|
||||
|
||||
@@ -53,6 +53,10 @@ extern JANET_THREAD_LOCAL Janet *janet_vm_return_reg;
|
||||
* along with otherwise bare c function pointers. */
|
||||
extern JANET_THREAD_LOCAL JanetTable *janet_vm_registry;
|
||||
|
||||
/* Registry for abstract abstract types that can be marshalled.
|
||||
* We need this to look up the constructors when unmarshalling. */
|
||||
extern JANET_THREAD_LOCAL JanetTable *janet_vm_abstract_registry;
|
||||
|
||||
/* Immutable value cache */
|
||||
extern JANET_THREAD_LOCAL const uint8_t **janet_vm_cache;
|
||||
extern JANET_THREAD_LOCAL uint32_t janet_vm_cache_capacity;
|
||||
@@ -75,6 +79,17 @@ extern JANET_THREAD_LOCAL JanetScratch **janet_scratch_mem;
|
||||
extern JANET_THREAD_LOCAL size_t janet_scratch_cap;
|
||||
extern JANET_THREAD_LOCAL size_t janet_scratch_len;
|
||||
|
||||
/* Recursionless traversal of data structures */
|
||||
typedef struct {
|
||||
JanetGCObject *self;
|
||||
JanetGCObject *other;
|
||||
int32_t index;
|
||||
int32_t index2;
|
||||
} JanetTraversalNode;
|
||||
extern JANET_THREAD_LOCAL JanetTraversalNode *janet_vm_traversal;
|
||||
extern JANET_THREAD_LOCAL JanetTraversalNode *janet_vm_traversal_top;
|
||||
extern JANET_THREAD_LOCAL JanetTraversalNode *janet_vm_traversal_base;
|
||||
|
||||
/* Setup / teardown */
|
||||
#ifdef JANET_THREADS
|
||||
void janet_threads_init(void);
|
||||
|
||||
@@ -208,9 +208,9 @@ static double convert(
|
||||
|
||||
/* Approximate exponent in base 2 of mant and exponent. This should get us a good estimate of the final size of the
|
||||
* number, within * 2^32 or so. */
|
||||
int32_t mant_exp2_approx = mant->n * 32 + 16;
|
||||
int32_t exp_exp2_approx = (int32_t)(floor(log2(base) * exponent));
|
||||
int32_t exp2_approx = mant_exp2_approx + exp_exp2_approx;
|
||||
int64_t mant_exp2_approx = mant->n * 32 + 16;
|
||||
int64_t exp_exp2_approx = (int64_t)(floor(log2(base) * exponent));
|
||||
int64_t exp2_approx = mant_exp2_approx + exp_exp2_approx;
|
||||
|
||||
/* Short circuit zero, huge, and small numbers. We use the exponent range of valid IEEE754 doubles (-1022, 1023)
|
||||
* with a healthy buffer to allow for inaccuracies in the approximation and denormailzed numbers. */
|
||||
|
||||
@@ -123,7 +123,8 @@ void janet_struct_put(JanetKV *st, Janet key, Janet value) {
|
||||
dist = otherdist;
|
||||
hash = otherhash;
|
||||
} else if (status == 0) {
|
||||
/* A key was added to the struct more than once */
|
||||
/* A key was added to the struct more than once - replace old value */
|
||||
kv->value = value;
|
||||
return;
|
||||
}
|
||||
}
|
||||
@@ -166,51 +167,3 @@ JanetTable *janet_struct_to_table(const JanetKV *st) {
|
||||
}
|
||||
return table;
|
||||
}
|
||||
|
||||
/* Check if two structs are equal */
|
||||
int janet_struct_equal(const JanetKV *lhs, const JanetKV *rhs) {
|
||||
int32_t index;
|
||||
int32_t llen = janet_struct_capacity(lhs);
|
||||
int32_t rlen = janet_struct_capacity(rhs);
|
||||
int32_t lhash = janet_struct_hash(lhs);
|
||||
int32_t rhash = janet_struct_hash(rhs);
|
||||
if (llen != rlen)
|
||||
return 0;
|
||||
if (lhash != rhash)
|
||||
return 0;
|
||||
for (index = 0; index < llen; index++) {
|
||||
const JanetKV *l = lhs + index;
|
||||
const JanetKV *r = rhs + index;
|
||||
if (!janet_equals(l->key, r->key))
|
||||
return 0;
|
||||
if (!janet_equals(l->value, r->value))
|
||||
return 0;
|
||||
}
|
||||
return 1;
|
||||
}
|
||||
|
||||
/* Compare structs */
|
||||
int janet_struct_compare(const JanetKV *lhs, const JanetKV *rhs) {
|
||||
int32_t i;
|
||||
int32_t lhash = janet_struct_hash(lhs);
|
||||
int32_t rhash = janet_struct_hash(rhs);
|
||||
int32_t llen = janet_struct_capacity(lhs);
|
||||
int32_t rlen = janet_struct_capacity(rhs);
|
||||
if (llen < rlen)
|
||||
return -1;
|
||||
if (llen > rlen)
|
||||
return 1;
|
||||
if (lhash < rhash)
|
||||
return -1;
|
||||
if (lhash > rhash)
|
||||
return 1;
|
||||
for (i = 0; i < llen; ++i) {
|
||||
const JanetKV *l = lhs + i;
|
||||
const JanetKV *r = rhs + i;
|
||||
int comp = janet_compare(l->key, r->key);
|
||||
if (comp != 0) return comp;
|
||||
comp = janet_compare(l->value, r->value);
|
||||
if (comp != 0) return comp;
|
||||
}
|
||||
return 0;
|
||||
}
|
||||
|
||||
@@ -51,10 +51,6 @@ struct JanetMailbox {
|
||||
pthread_cond_t cond;
|
||||
#endif
|
||||
|
||||
/* Setup procedure - requires a parent mailbox
|
||||
* to receive thunk from */
|
||||
JanetMailbox *parent;
|
||||
|
||||
/* Memory management - reference counting */
|
||||
int refCount;
|
||||
int closed;
|
||||
@@ -70,6 +66,11 @@ struct JanetMailbox {
|
||||
JanetBuffer messages[];
|
||||
};
|
||||
|
||||
typedef struct {
|
||||
JanetMailbox *original;
|
||||
JanetMailbox *newbox;
|
||||
} JanetMailboxPair;
|
||||
|
||||
static JANET_THREAD_LOCAL JanetMailbox *janet_vm_mailbox = NULL;
|
||||
static JANET_THREAD_LOCAL JanetThread *janet_vm_thread_current = NULL;
|
||||
static JANET_THREAD_LOCAL JanetTable *janet_vm_thread_decode = NULL;
|
||||
@@ -82,7 +83,7 @@ static JanetTable *janet_thread_get_decode(void) {
|
||||
return janet_vm_thread_decode;
|
||||
}
|
||||
|
||||
static JanetMailbox *janet_mailbox_create(JanetMailbox *parent, int refCount, uint16_t capacity) {
|
||||
static JanetMailbox *janet_mailbox_create(int refCount, uint16_t capacity) {
|
||||
JanetMailbox *mailbox = malloc(sizeof(JanetMailbox) + sizeof(JanetBuffer) * (size_t) capacity);
|
||||
if (NULL == mailbox) {
|
||||
JANET_OUT_OF_MEMORY;
|
||||
@@ -96,7 +97,6 @@ static JanetMailbox *janet_mailbox_create(JanetMailbox *parent, int refCount, ui
|
||||
#endif
|
||||
mailbox->refCount = refCount;
|
||||
mailbox->closed = 0;
|
||||
mailbox->parent = parent;
|
||||
mailbox->messageCount = 0;
|
||||
mailbox->messageCapacity = capacity;
|
||||
mailbox->messageFirst = 0;
|
||||
@@ -175,6 +175,23 @@ static int thread_mark(void *p, size_t size) {
|
||||
return 0;
|
||||
}
|
||||
|
||||
static JanetMailboxPair *make_mailbox_pair(JanetMailbox *original) {
|
||||
JanetMailboxPair *pair = malloc(sizeof(JanetMailboxPair));
|
||||
if (NULL == pair) {
|
||||
JANET_OUT_OF_MEMORY;
|
||||
}
|
||||
pair->original = original;
|
||||
janet_mailbox_ref(original, 1);
|
||||
pair->newbox = janet_mailbox_create(1, 16);
|
||||
return pair;
|
||||
}
|
||||
|
||||
static void destroy_mailbox_pair(JanetMailboxPair *pair) {
|
||||
janet_mailbox_ref(pair->original, -1);
|
||||
janet_mailbox_ref(pair->newbox, -1);
|
||||
free(pair);
|
||||
}
|
||||
|
||||
/* Abstract waiting for timeout across windows/posix */
|
||||
typedef struct {
|
||||
int timedwait;
|
||||
@@ -312,7 +329,7 @@ int janet_thread_send(JanetThread *thread, Janet msg, double timeout) {
|
||||
msgbuf->count = 0;
|
||||
|
||||
/* Start panic zone */
|
||||
janet_marshal(msgbuf, msg, thread->encode, 0);
|
||||
janet_marshal(msgbuf, msg, thread->encode, JANET_MARSHAL_UNSAFE);
|
||||
/* End panic zone */
|
||||
|
||||
mailbox->messageNext = (mailbox->messageNext + 1) % mailbox->messageCapacity;
|
||||
@@ -362,7 +379,7 @@ int janet_thread_receive(Janet *msg_out, double timeout) {
|
||||
const uint8_t *nextItem = NULL;
|
||||
Janet item = janet_unmarshal(
|
||||
msgbuf->data, msgbuf->count,
|
||||
0, janet_thread_get_decode(), &nextItem);
|
||||
JANET_MARSHAL_UNSAFE, janet_thread_get_decode(), &nextItem);
|
||||
*msg_out = item;
|
||||
|
||||
/* Cleanup */
|
||||
@@ -392,7 +409,7 @@ int janet_thread_receive(Janet *msg_out, double timeout) {
|
||||
|
||||
static int janet_thread_getter(void *p, Janet key, Janet *out);
|
||||
|
||||
static JanetAbstractType Thread_AT = {
|
||||
const JanetAbstractType janet_thread_type = {
|
||||
"core/thread",
|
||||
thread_gc,
|
||||
thread_mark,
|
||||
@@ -401,23 +418,25 @@ static JanetAbstractType Thread_AT = {
|
||||
};
|
||||
|
||||
static JanetThread *janet_make_thread(JanetMailbox *mailbox, JanetTable *encode) {
|
||||
JanetThread *thread = janet_abstract(&Thread_AT, sizeof(JanetThread));
|
||||
JanetThread *thread = janet_abstract(&janet_thread_type, sizeof(JanetThread));
|
||||
janet_mailbox_ref(mailbox, 1);
|
||||
thread->mailbox = mailbox;
|
||||
thread->encode = encode;
|
||||
return thread;
|
||||
}
|
||||
|
||||
JanetThread *janet_getthread(const Janet *argv, int32_t n) {
|
||||
return (JanetThread *) janet_getabstract(argv, n, &Thread_AT);
|
||||
return (JanetThread *) janet_getabstract(argv, n, &janet_thread_type);
|
||||
}
|
||||
|
||||
/* Runs in new thread */
|
||||
static int thread_worker(JanetMailbox *mailbox) {
|
||||
static int thread_worker(JanetMailboxPair *pair) {
|
||||
JanetFiber *fiber = NULL;
|
||||
Janet out;
|
||||
|
||||
/* Use the mailbox we were given */
|
||||
janet_vm_mailbox = mailbox;
|
||||
janet_vm_mailbox = pair->newbox;
|
||||
janet_mailbox_ref(pair->newbox, 1);
|
||||
|
||||
/* Init VM */
|
||||
janet_init();
|
||||
@@ -426,9 +445,7 @@ static int thread_worker(JanetMailbox *mailbox) {
|
||||
JanetTable *encode = janet_get_core_table("make-image-dict");
|
||||
|
||||
/* Create parent thread */
|
||||
JanetThread *parent = janet_make_thread(mailbox->parent, encode);
|
||||
janet_mailbox_ref(mailbox->parent, -1);
|
||||
mailbox->parent = NULL; /* only used to create the thread */
|
||||
JanetThread *parent = janet_make_thread(pair->original, encode);
|
||||
Janet parentv = janet_wrap_abstract(parent);
|
||||
|
||||
/* Unmarshal the function */
|
||||
@@ -449,16 +466,18 @@ static int thread_worker(JanetMailbox *mailbox) {
|
||||
fiber = janet_fiber(func, 64, 1, argv);
|
||||
JanetSignal sig = janet_continue(fiber, janet_wrap_nil(), &out);
|
||||
if (sig != JANET_SIGNAL_OK) {
|
||||
janet_eprintf("in thread %v: ", janet_wrap_abstract(janet_make_thread(mailbox, encode)));
|
||||
janet_eprintf("in thread %v: ", janet_wrap_abstract(janet_make_thread(pair->newbox, encode)));
|
||||
janet_stacktrace(fiber, out);
|
||||
}
|
||||
|
||||
/* Normal exit */
|
||||
destroy_mailbox_pair(pair);
|
||||
janet_deinit();
|
||||
return 0;
|
||||
|
||||
/* Fail to set something up */
|
||||
error:
|
||||
destroy_mailbox_pair(pair);
|
||||
janet_eprintf("\nthread failed to start\n");
|
||||
janet_deinit();
|
||||
return 1;
|
||||
@@ -467,12 +486,12 @@ error:
|
||||
#ifdef JANET_WINDOWS
|
||||
|
||||
static DWORD WINAPI janet_create_thread_wrapper(LPVOID param) {
|
||||
thread_worker((JanetMailbox *)param);
|
||||
thread_worker((JanetMailboxPair *)param);
|
||||
return 0;
|
||||
}
|
||||
|
||||
static int janet_thread_start_child(JanetThread *thread) {
|
||||
HANDLE handle = CreateThread(NULL, 0, janet_create_thread_wrapper, thread->mailbox, 0, NULL);
|
||||
static int janet_thread_start_child(JanetMailboxPair *pair) {
|
||||
HANDLE handle = CreateThread(NULL, 0, janet_create_thread_wrapper, pair, 0, NULL);
|
||||
int ret = NULL == handle;
|
||||
/* Does not kill thread, simply detatches */
|
||||
if (!ret) CloseHandle(handle);
|
||||
@@ -482,13 +501,13 @@ static int janet_thread_start_child(JanetThread *thread) {
|
||||
#else
|
||||
|
||||
static void *janet_pthread_wrapper(void *param) {
|
||||
thread_worker((JanetMailbox *)param);
|
||||
thread_worker((JanetMailboxPair *)param);
|
||||
return NULL;
|
||||
}
|
||||
|
||||
static int janet_thread_start_child(JanetThread *thread) {
|
||||
static int janet_thread_start_child(JanetMailboxPair *pair) {
|
||||
pthread_t handle;
|
||||
int error = pthread_create(&handle, NULL, janet_pthread_wrapper, thread->mailbox);
|
||||
int error = pthread_create(&handle, NULL, janet_pthread_wrapper, pair);
|
||||
if (error) {
|
||||
return 1;
|
||||
} else {
|
||||
@@ -505,7 +524,7 @@ static int janet_thread_start_child(JanetThread *thread) {
|
||||
|
||||
void janet_threads_init(void) {
|
||||
if (NULL == janet_vm_mailbox) {
|
||||
janet_vm_mailbox = janet_mailbox_create(NULL, 1, 10);
|
||||
janet_vm_mailbox = janet_mailbox_create(1, 10);
|
||||
}
|
||||
janet_vm_thread_decode = NULL;
|
||||
janet_vm_thread_current = NULL;
|
||||
@@ -529,7 +548,6 @@ static Janet cfun_thread_current(int32_t argc, Janet *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_mailbox_ref(janet_vm_mailbox, 1);
|
||||
janet_gcroot(janet_wrap_abstract(janet_vm_thread_current));
|
||||
}
|
||||
return janet_wrap_abstract(janet_vm_thread_current);
|
||||
@@ -544,15 +562,11 @@ static Janet cfun_thread_new(int32_t argc, Janet *argv) {
|
||||
janet_panicf("bad slot #1, expected integer in range [1, 65535], got %d", cap);
|
||||
}
|
||||
JanetTable *encode = janet_get_core_table("make-image-dict");
|
||||
JanetMailbox *mailbox = janet_mailbox_create(janet_vm_mailbox, 2, (uint16_t) cap);
|
||||
|
||||
/* one for created thread, one for ->parent reference in new mailbox */
|
||||
janet_mailbox_ref(janet_vm_mailbox, 2);
|
||||
|
||||
JanetThread *thread = janet_make_thread(mailbox, encode);
|
||||
if (janet_thread_start_child(thread)) {
|
||||
janet_mailbox_ref(mailbox, -1); /* mailbox reference */
|
||||
janet_mailbox_ref(janet_vm_mailbox, -1); /* ->parent reference */
|
||||
JanetMailboxPair *pair = make_mailbox_pair(janet_vm_mailbox);
|
||||
JanetThread *thread = janet_make_thread(pair->newbox, encode);
|
||||
if (janet_thread_start_child(pair)) {
|
||||
destroy_mailbox_pair(pair);
|
||||
janet_panic("could not start thread");
|
||||
}
|
||||
|
||||
@@ -650,7 +664,7 @@ static const JanetReg threadlib_cfuns[] = {
|
||||
/* Module entry point */
|
||||
void janet_lib_thread(JanetTable *env) {
|
||||
janet_core_cfuns(env, NULL, threadlib_cfuns);
|
||||
janet_register_abstract_type(&Thread_AT);
|
||||
janet_register_abstract_type(&janet_thread_type);
|
||||
}
|
||||
|
||||
#endif
|
||||
|
||||
@@ -53,45 +53,6 @@ const Janet *janet_tuple_n(const Janet *values, int32_t n) {
|
||||
return janet_tuple_end(t);
|
||||
}
|
||||
|
||||
/* Check if two tuples are equal */
|
||||
int janet_tuple_equal(const Janet *lhs, const Janet *rhs) {
|
||||
int32_t index;
|
||||
int32_t llen = janet_tuple_length(lhs);
|
||||
int32_t rlen = janet_tuple_length(rhs);
|
||||
int32_t lhash = janet_tuple_hash(lhs);
|
||||
int32_t rhash = janet_tuple_hash(rhs);
|
||||
if (lhash == 0)
|
||||
lhash = janet_tuple_hash(lhs) = janet_array_calchash(lhs, llen);
|
||||
if (rhash == 0)
|
||||
rhash = janet_tuple_hash(rhs) = janet_array_calchash(rhs, rlen);
|
||||
if (lhash != rhash)
|
||||
return 0;
|
||||
if (llen != rlen)
|
||||
return 0;
|
||||
for (index = 0; index < llen; index++) {
|
||||
if (!janet_equals(lhs[index], rhs[index]))
|
||||
return 0;
|
||||
}
|
||||
return 1;
|
||||
}
|
||||
|
||||
/* Compare tuples */
|
||||
int janet_tuple_compare(const Janet *lhs, const Janet *rhs) {
|
||||
int32_t i;
|
||||
int32_t llen = janet_tuple_length(lhs);
|
||||
int32_t rlen = janet_tuple_length(rhs);
|
||||
int32_t count = llen < rlen ? llen : rlen;
|
||||
for (i = 0; i < count; ++i) {
|
||||
int comp = janet_compare(lhs[i], rhs[i]);
|
||||
if (comp != 0) return comp;
|
||||
}
|
||||
if (llen < rlen)
|
||||
return -1;
|
||||
else if (llen > rlen)
|
||||
return 1;
|
||||
return 0;
|
||||
}
|
||||
|
||||
/* C Functions */
|
||||
|
||||
static Janet cfun_tuple_brackets(int32_t argc, Janet *argv) {
|
||||
|
||||
@@ -111,7 +111,7 @@ static void *ta_buffer_unmarshal(JanetMarshalContext *ctx) {
|
||||
return buf;
|
||||
}
|
||||
|
||||
static const JanetAbstractType ta_buffer_type = {
|
||||
const JanetAbstractType janet_ta_buffer_type = {
|
||||
"ta/buffer",
|
||||
ta_buffer_gc,
|
||||
NULL,
|
||||
@@ -154,7 +154,7 @@ static void *ta_view_unmarshal(JanetMarshalContext *ctx) {
|
||||
offset = janet_unmarshal_size(ctx);
|
||||
buffer = janet_unmarshal_janet(ctx);
|
||||
if (!janet_checktype(buffer, JANET_ABSTRACT) ||
|
||||
(janet_abstract_type(janet_unwrap_abstract(buffer)) != &ta_buffer_type)) {
|
||||
(janet_abstract_type(janet_unwrap_abstract(buffer)) != &janet_ta_buffer_type)) {
|
||||
janet_panicf("expected typed array buffer");
|
||||
}
|
||||
view->buffer = (JanetTArrayBuffer *)janet_unwrap_abstract(buffer);
|
||||
@@ -275,7 +275,7 @@ static void ta_setter(void *p, Janet key, Janet value) {
|
||||
}
|
||||
}
|
||||
|
||||
static const JanetAbstractType ta_view_type = {
|
||||
const JanetAbstractType janet_ta_view_type = {
|
||||
"ta/view",
|
||||
NULL,
|
||||
ta_mark,
|
||||
@@ -287,7 +287,7 @@ static const JanetAbstractType ta_view_type = {
|
||||
};
|
||||
|
||||
JanetTArrayBuffer *janet_tarray_buffer(size_t size) {
|
||||
JanetTArrayBuffer *buf = janet_abstract(&ta_buffer_type, sizeof(JanetTArrayBuffer));
|
||||
JanetTArrayBuffer *buf = janet_abstract(&janet_ta_buffer_type, sizeof(JanetTArrayBuffer));
|
||||
ta_buffer_init(buf, size);
|
||||
return buf;
|
||||
}
|
||||
@@ -299,13 +299,13 @@ JanetTArrayView *janet_tarray_view(
|
||||
size_t offset,
|
||||
JanetTArrayBuffer *buffer) {
|
||||
|
||||
JanetTArrayView *view = janet_abstract(&ta_view_type, sizeof(JanetTArrayView));
|
||||
JanetTArrayView *view = janet_abstract(&janet_ta_view_type, sizeof(JanetTArrayView));
|
||||
|
||||
if ((stride < 1) || (size < 1)) janet_panic("stride and size should be > 0");
|
||||
size_t buf_size = offset + ta_type_sizes[type] * ((size - 1) * stride + 1);
|
||||
|
||||
if (NULL == buffer) {
|
||||
buffer = janet_abstract(&ta_buffer_type, sizeof(JanetTArrayBuffer));
|
||||
buffer = janet_abstract(&janet_ta_buffer_type, sizeof(JanetTArrayBuffer));
|
||||
ta_buffer_init(buffer, buf_size);
|
||||
}
|
||||
|
||||
@@ -325,15 +325,15 @@ JanetTArrayView *janet_tarray_view(
|
||||
}
|
||||
|
||||
JanetTArrayBuffer *janet_gettarray_buffer(const Janet *argv, int32_t n) {
|
||||
return janet_getabstract(argv, n, &ta_buffer_type);
|
||||
return janet_getabstract(argv, n, &janet_ta_buffer_type);
|
||||
}
|
||||
|
||||
JanetTArrayView *janet_gettarray_any(const Janet *argv, int32_t n) {
|
||||
return janet_getabstract(argv, n, &ta_view_type);
|
||||
return janet_getabstract(argv, n, &janet_ta_view_type);
|
||||
}
|
||||
|
||||
JanetTArrayView *janet_gettarray_view(const Janet *argv, int32_t n, JanetTArrayType type) {
|
||||
JanetTArrayView *view = janet_getabstract(argv, n, &ta_view_type);
|
||||
JanetTArrayView *view = janet_getabstract(argv, n, &janet_ta_view_type);
|
||||
if (view->type != type) {
|
||||
janet_panicf("bad slot #%d, expected typed array of type %s, got %v",
|
||||
n, ta_type_names[type], argv[n]);
|
||||
@@ -359,7 +359,7 @@ static Janet cfun_typed_array_new(int32_t argc, Janet *argv) {
|
||||
4, argv[4]);
|
||||
}
|
||||
void *p = janet_unwrap_abstract(argv[4]);
|
||||
if (janet_abstract_type(p) == &ta_view_type) {
|
||||
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;
|
||||
@@ -375,7 +375,7 @@ static Janet cfun_typed_array_new(int32_t argc, Janet *argv) {
|
||||
static JanetTArrayView *ta_is_view(Janet x) {
|
||||
if (!janet_checktype(x, JANET_ABSTRACT)) return NULL;
|
||||
void *abst = janet_unwrap_abstract(x);
|
||||
if (janet_abstract_type(abst) != &ta_view_type) return NULL;
|
||||
if (janet_abstract_type(abst) != &janet_ta_view_type) return NULL;
|
||||
return (JanetTArrayView *)abst;
|
||||
}
|
||||
|
||||
@@ -396,7 +396,7 @@ static Janet cfun_typed_array_size(int32_t argc, Janet *argv) {
|
||||
if ((view = ta_is_view(argv[0]))) {
|
||||
return janet_wrap_number((double) view->size);
|
||||
}
|
||||
JanetTArrayBuffer *buf = (JanetTArrayBuffer *)janet_getabstract(argv, 0, &ta_buffer_type);
|
||||
JanetTArrayBuffer *buf = (JanetTArrayBuffer *)janet_getabstract(argv, 0, &janet_ta_buffer_type);
|
||||
return janet_wrap_number((double) buf->size);
|
||||
}
|
||||
|
||||
@@ -433,7 +433,7 @@ static Janet cfun_typed_array_properties(int32_t argc, Janet *argv) {
|
||||
|
||||
static Janet cfun_typed_array_slice(int32_t argc, Janet *argv) {
|
||||
janet_arity(argc, 1, 3);
|
||||
JanetTArrayView *src = janet_getabstract(argv, 0, &ta_view_type);
|
||||
JanetTArrayView *src = janet_getabstract(argv, 0, &janet_ta_view_type);
|
||||
JanetRange range;
|
||||
int32_t length = (int32_t)src->size;
|
||||
if (argc == 1) {
|
||||
@@ -461,9 +461,9 @@ static Janet cfun_typed_array_slice(int32_t argc, Janet *argv) {
|
||||
|
||||
static Janet cfun_typed_array_copy_bytes(int32_t argc, Janet *argv) {
|
||||
janet_arity(argc, 4, 5);
|
||||
JanetTArrayView *src = janet_getabstract(argv, 0, &ta_view_type);
|
||||
JanetTArrayView *src = janet_getabstract(argv, 0, &janet_ta_view_type);
|
||||
size_t index_src = janet_getsize(argv, 1);
|
||||
JanetTArrayView *dst = janet_getabstract(argv, 2, &ta_view_type);
|
||||
JanetTArrayView *dst = janet_getabstract(argv, 2, &janet_ta_view_type);
|
||||
size_t index_dst = janet_getsize(argv, 3);
|
||||
size_t count = (argc == 5) ? janet_getsize(argv, 4) : 1;
|
||||
size_t src_atom_size = ta_type_sizes[src->type];
|
||||
@@ -488,9 +488,9 @@ static Janet cfun_typed_array_copy_bytes(int32_t argc, Janet *argv) {
|
||||
|
||||
static Janet cfun_typed_array_swap_bytes(int32_t argc, Janet *argv) {
|
||||
janet_arity(argc, 4, 5);
|
||||
JanetTArrayView *src = janet_getabstract(argv, 0, &ta_view_type);
|
||||
JanetTArrayView *src = janet_getabstract(argv, 0, &janet_ta_view_type);
|
||||
size_t index_src = janet_getsize(argv, 1);
|
||||
JanetTArrayView *dst = janet_getabstract(argv, 2, &ta_view_type);
|
||||
JanetTArrayView *dst = janet_getabstract(argv, 2, &janet_ta_view_type);
|
||||
size_t index_dst = janet_getsize(argv, 3);
|
||||
size_t count = (argc == 5) ? janet_getsize(argv, 4) : 1;
|
||||
size_t src_atom_size = ta_type_sizes[src->type];
|
||||
@@ -574,8 +574,8 @@ static JanetMethod tarray_view_methods[] = {
|
||||
/* Module entry point */
|
||||
void janet_lib_typed_array(JanetTable *env) {
|
||||
janet_core_cfuns(env, NULL, ta_cfuns);
|
||||
janet_register_abstract_type(&ta_buffer_type);
|
||||
janet_register_abstract_type(&ta_view_type);
|
||||
janet_register_abstract_type(&janet_ta_buffer_type);
|
||||
janet_register_abstract_type(&janet_ta_view_type);
|
||||
}
|
||||
|
||||
#endif
|
||||
|
||||
@@ -380,7 +380,7 @@ void janet_var(JanetTable *env, const char *name, Janet val, const char *doc) {
|
||||
}
|
||||
|
||||
/* Load many cfunctions at once */
|
||||
void janet_cfuns(JanetTable *env, const char *regprefix, const JanetReg *cfuns) {
|
||||
static void _janet_cfuns_prefix(JanetTable *env, const char *regprefix, const JanetReg *cfuns, int defprefix) {
|
||||
uint8_t *longname_buffer = NULL;
|
||||
size_t prefixlen = 0;
|
||||
size_t bufsize = 0;
|
||||
@@ -414,47 +414,46 @@ void janet_cfuns(JanetTable *env, const char *regprefix, const JanetReg *cfuns)
|
||||
name = janet_csymbolv(cfuns->name);
|
||||
}
|
||||
Janet fun = janet_wrap_cfunction(cfuns->cfun);
|
||||
janet_def(env, cfuns->name, fun, cfuns->documentation);
|
||||
if (defprefix) {
|
||||
JanetTable *subt = janet_table(2);
|
||||
janet_table_put(subt, janet_ckeywordv("value"), fun);
|
||||
if (cfuns->documentation)
|
||||
janet_table_put(subt, janet_ckeywordv("doc"), janet_cstringv(cfuns->documentation));
|
||||
janet_table_put(env, name, janet_wrap_table(subt));
|
||||
} else {
|
||||
janet_def(env, cfuns->name, fun, cfuns->documentation);
|
||||
}
|
||||
janet_table_put(janet_vm_registry, fun, name);
|
||||
cfuns++;
|
||||
}
|
||||
free(longname_buffer);
|
||||
}
|
||||
|
||||
void janet_cfuns_prefix(JanetTable *env, const char *regprefix, const JanetReg *cfuns) {
|
||||
_janet_cfuns_prefix(env, regprefix, cfuns, 1);
|
||||
}
|
||||
|
||||
void janet_cfuns(JanetTable *env, const char *regprefix, const JanetReg *cfuns) {
|
||||
_janet_cfuns_prefix(env, regprefix, cfuns, 0);
|
||||
}
|
||||
|
||||
/* Abstract type introspection */
|
||||
|
||||
static const JanetAbstractType type_wrap = {
|
||||
"core/type-info",
|
||||
JANET_ATEND_NAME
|
||||
};
|
||||
|
||||
typedef struct {
|
||||
const JanetAbstractType *at;
|
||||
} JanetAbstractTypeWrap;
|
||||
|
||||
void janet_register_abstract_type(const JanetAbstractType *at) {
|
||||
JanetAbstractTypeWrap *abstract = (JanetAbstractTypeWrap *)
|
||||
janet_abstract(&type_wrap, sizeof(JanetAbstractTypeWrap));
|
||||
abstract->at = at;
|
||||
Janet sym = janet_csymbolv(at->name);
|
||||
if (!(janet_checktype(janet_table_get(janet_vm_registry, sym), JANET_NIL))) {
|
||||
if (!(janet_checktype(janet_table_get(janet_vm_abstract_registry, sym), JANET_NIL))) {
|
||||
janet_panicf("cannot register abstract type %s, "
|
||||
"a type with the same name exists", at->name);
|
||||
}
|
||||
janet_table_put(janet_vm_registry, sym, janet_wrap_abstract(abstract));
|
||||
janet_table_put(janet_vm_abstract_registry, sym, janet_wrap_pointer((void *) at));
|
||||
}
|
||||
|
||||
const JanetAbstractType *janet_get_abstract_type(Janet key) {
|
||||
Janet twrap = janet_table_get(janet_vm_registry, key);
|
||||
if (janet_checktype(twrap, JANET_NIL)) {
|
||||
Janet wrapped = janet_table_get(janet_vm_abstract_registry, key);
|
||||
if (janet_checktype(wrapped, JANET_NIL)) {
|
||||
return NULL;
|
||||
}
|
||||
if (!janet_checktype(twrap, JANET_ABSTRACT) ||
|
||||
(janet_abstract_type(janet_unwrap_abstract(twrap)) != &type_wrap)) {
|
||||
janet_panic("expected abstract type");
|
||||
}
|
||||
JanetAbstractTypeWrap *w = (JanetAbstractTypeWrap *)janet_unwrap_abstract(twrap);
|
||||
return w->at;
|
||||
return (JanetAbstractType *)(janet_unwrap_pointer(wrapped));
|
||||
}
|
||||
|
||||
#ifndef JANET_BOOTSTRAP
|
||||
|
||||
209
src/core/value.c
209
src/core/value.c
@@ -23,9 +23,91 @@
|
||||
#ifndef JANET_AMALG
|
||||
#include "features.h"
|
||||
#include "util.h"
|
||||
#include "state.h"
|
||||
#include "gc.h"
|
||||
#include <janet.h>
|
||||
#endif
|
||||
|
||||
JANET_THREAD_LOCAL JanetTraversalNode *janet_vm_traversal = NULL;
|
||||
JANET_THREAD_LOCAL JanetTraversalNode *janet_vm_traversal_top = NULL;
|
||||
JANET_THREAD_LOCAL JanetTraversalNode *janet_vm_traversal_base = NULL;
|
||||
|
||||
static void push_traversal_node(void *lhs, void *rhs, int32_t index2) {
|
||||
JanetTraversalNode node;
|
||||
node.self = (JanetGCObject *) lhs;
|
||||
node.other = (JanetGCObject *) rhs;
|
||||
node.index = 0;
|
||||
node.index2 = index2;
|
||||
if (janet_vm_traversal + 1 >= janet_vm_traversal_top) {
|
||||
size_t oldsize = janet_vm_traversal - janet_vm_traversal_base;
|
||||
size_t newsize = 2 * oldsize + 1;
|
||||
if (newsize < 128) {
|
||||
newsize = 128;
|
||||
}
|
||||
JanetTraversalNode *tn = realloc(janet_vm_traversal_base, newsize * sizeof(JanetTraversalNode));
|
||||
if (tn == NULL) {
|
||||
JANET_OUT_OF_MEMORY;
|
||||
}
|
||||
janet_vm_traversal_base = tn;
|
||||
janet_vm_traversal_top = janet_vm_traversal_base + newsize;
|
||||
janet_vm_traversal = janet_vm_traversal_base + oldsize;
|
||||
}
|
||||
*(++janet_vm_traversal) = node;
|
||||
}
|
||||
|
||||
/*
|
||||
* Used for travsersing structs and tuples without recursion
|
||||
* Returns:
|
||||
* 0 - next node found
|
||||
* 1 - early stop - lhs < rhs
|
||||
* 2 - no next node found
|
||||
* 3 - early stop - lhs > rhs
|
||||
*/
|
||||
static int traversal_next(Janet *x, Janet *y) {
|
||||
JanetTraversalNode *t = janet_vm_traversal;
|
||||
while (t && t > janet_vm_traversal_base) {
|
||||
JanetGCObject *self = t->self;
|
||||
JanetTupleHead *tself = (JanetTupleHead *)self;
|
||||
JanetStructHead *sself = (JanetStructHead *)self;
|
||||
JanetGCObject *other = t->other;
|
||||
JanetTupleHead *tother = (JanetTupleHead *)other;
|
||||
JanetStructHead *sother = (JanetStructHead *)other;
|
||||
if ((self->flags & JANET_MEM_TYPEBITS) == JANET_MEMORY_TUPLE) {
|
||||
/* Node is a tuple at index t->index */
|
||||
if (t->index < tself->length && t->index < tother->length) {
|
||||
int32_t index = t->index++;
|
||||
*x = tself->data[index];
|
||||
*y = tother->data[index];
|
||||
janet_vm_traversal = t;
|
||||
return 0;
|
||||
}
|
||||
if (t->index2 && tself->length != tother->length) {
|
||||
return tself->length > tother->length ? 3 : 1;
|
||||
}
|
||||
} else {
|
||||
/* Node is a struct at index t->index: if t->index2 is true, we should return the values. */
|
||||
if (t->index2) {
|
||||
t->index2 = 0;
|
||||
int32_t index = t->index++;
|
||||
*x = sself->data[index].value;
|
||||
*y = sother->data[index].value;
|
||||
janet_vm_traversal = t;
|
||||
return 0;
|
||||
}
|
||||
for (int32_t i = t->index; i < sself->capacity; i++) {
|
||||
t->index2 = 1;
|
||||
*x = sself->data[t->index].key;
|
||||
*y = sother->data[t->index].key;
|
||||
janet_vm_traversal = t;
|
||||
return 0;
|
||||
}
|
||||
}
|
||||
t--;
|
||||
}
|
||||
janet_vm_traversal = t;
|
||||
return 2;
|
||||
}
|
||||
|
||||
/*
|
||||
* Define a number of functions that can be used internally on ANY Janet.
|
||||
*/
|
||||
@@ -111,41 +193,51 @@ static int janet_compare_abstract(JanetAbstract xx, JanetAbstract yy) {
|
||||
return xt->compare(xx, yy);
|
||||
}
|
||||
|
||||
/* Check if two values are equal. This is strict equality with no conversion. */
|
||||
int janet_equals(Janet x, Janet y) {
|
||||
int result = 0;
|
||||
if (janet_type(x) != janet_type(y)) {
|
||||
result = 0;
|
||||
} else {
|
||||
janet_vm_traversal = janet_vm_traversal_base;
|
||||
do {
|
||||
if (janet_type(x) != janet_type(y)) return 0;
|
||||
switch (janet_type(x)) {
|
||||
case JANET_NIL:
|
||||
result = 1;
|
||||
break;
|
||||
case JANET_BOOLEAN:
|
||||
result = (janet_unwrap_boolean(x) == janet_unwrap_boolean(y));
|
||||
if (janet_unwrap_boolean(x) != janet_unwrap_boolean(y)) return 0;
|
||||
break;
|
||||
case JANET_NUMBER:
|
||||
result = (janet_unwrap_number(x) == janet_unwrap_number(y));
|
||||
if (janet_unwrap_number(x) != janet_unwrap_number(y)) return 0;
|
||||
break;
|
||||
case JANET_STRING:
|
||||
result = janet_string_equal(janet_unwrap_string(x), janet_unwrap_string(y));
|
||||
break;
|
||||
case JANET_TUPLE:
|
||||
result = janet_tuple_equal(janet_unwrap_tuple(x), janet_unwrap_tuple(y));
|
||||
break;
|
||||
case JANET_STRUCT:
|
||||
result = janet_struct_equal(janet_unwrap_struct(x), janet_unwrap_struct(y));
|
||||
if (!janet_string_equal(janet_unwrap_string(x), janet_unwrap_string(y))) return 0;
|
||||
break;
|
||||
case JANET_ABSTRACT:
|
||||
result = !janet_compare_abstract(janet_unwrap_abstract(x), janet_unwrap_abstract(y));
|
||||
if (janet_compare_abstract(janet_unwrap_abstract(x), janet_unwrap_abstract(y))) return 0;
|
||||
break;
|
||||
default:
|
||||
/* compare pointers */
|
||||
result = (janet_unwrap_pointer(x) == janet_unwrap_pointer(y));
|
||||
if (janet_unwrap_pointer(x) != janet_unwrap_pointer(y)) return 0;
|
||||
break;
|
||||
case JANET_TUPLE: {
|
||||
const Janet *t1 = janet_unwrap_tuple(x);
|
||||
const Janet *t2 = janet_unwrap_tuple(y);
|
||||
if (t1 == t2) break;
|
||||
if (janet_tuple_hash(t1) != janet_tuple_hash(t2)) return 0;
|
||||
if (janet_tuple_length(t1) != janet_tuple_length(t2)) return 0;
|
||||
push_traversal_node(janet_tuple_head(t1), janet_tuple_head(t2), 0);
|
||||
break;
|
||||
}
|
||||
break;
|
||||
case JANET_STRUCT: {
|
||||
const JanetKV *s1 = janet_unwrap_struct(x);
|
||||
const JanetKV *s2 = janet_unwrap_struct(y);
|
||||
if (s1 == s2) break;
|
||||
if (janet_struct_hash(s1) != janet_struct_hash(s2)) return 0;
|
||||
if (janet_struct_length(s1) != janet_struct_length(s2)) return 0;
|
||||
push_traversal_node(janet_struct_head(s1), janet_struct_head(s2), 0);
|
||||
break;
|
||||
}
|
||||
break;
|
||||
}
|
||||
}
|
||||
return result;
|
||||
} while (!traversal_next(&x, &y));
|
||||
return 1;
|
||||
}
|
||||
|
||||
/* Computes a hash value for a function */
|
||||
@@ -201,38 +293,71 @@ int32_t janet_hash(Janet x) {
|
||||
* If y is less, returns 1. All types are comparable
|
||||
* and should have strict ordering, excepts NaNs. */
|
||||
int janet_compare(Janet x, Janet y) {
|
||||
if (janet_type(x) == janet_type(y)) {
|
||||
switch (janet_type(x)) {
|
||||
janet_vm_traversal = janet_vm_traversal_base;
|
||||
int status;
|
||||
do {
|
||||
JanetType tx = janet_type(x);
|
||||
JanetType ty = janet_type(y);
|
||||
if (tx != ty) return tx < ty ? -1 : 1;
|
||||
switch (tx) {
|
||||
case JANET_NIL:
|
||||
return 0;
|
||||
case JANET_BOOLEAN:
|
||||
return janet_unwrap_boolean(x) - janet_unwrap_boolean(y);
|
||||
break;
|
||||
case JANET_BOOLEAN: {
|
||||
int diff = janet_unwrap_boolean(x) - janet_unwrap_boolean(y);
|
||||
if (diff) return diff;
|
||||
break;
|
||||
}
|
||||
case JANET_NUMBER: {
|
||||
double xx = janet_unwrap_number(x);
|
||||
double yy = janet_unwrap_number(y);
|
||||
return xx == yy
|
||||
? 0
|
||||
: (xx < yy) ? -1 : 1;
|
||||
if (xx == yy) {
|
||||
break;
|
||||
} else {
|
||||
return (xx < yy) ? -1 : 1;
|
||||
}
|
||||
}
|
||||
case JANET_STRING:
|
||||
case JANET_SYMBOL:
|
||||
case JANET_KEYWORD:
|
||||
return janet_string_compare(janet_unwrap_string(x), janet_unwrap_string(y));
|
||||
case JANET_TUPLE:
|
||||
return janet_tuple_compare(janet_unwrap_tuple(x), janet_unwrap_tuple(y));
|
||||
case JANET_STRUCT:
|
||||
return janet_struct_compare(janet_unwrap_struct(x), janet_unwrap_struct(y));
|
||||
case JANET_ABSTRACT:
|
||||
return janet_compare_abstract(janet_unwrap_abstract(x), janet_unwrap_abstract(y));
|
||||
default:
|
||||
if (janet_unwrap_string(x) == janet_unwrap_string(y)) {
|
||||
return 0;
|
||||
case JANET_KEYWORD: {
|
||||
int diff = janet_string_compare(janet_unwrap_string(x), janet_unwrap_string(y));
|
||||
if (diff) return diff;
|
||||
break;
|
||||
}
|
||||
case JANET_ABSTRACT: {
|
||||
int diff = janet_compare_abstract(janet_unwrap_abstract(x), janet_unwrap_abstract(y));
|
||||
if (diff) return diff;
|
||||
break;
|
||||
}
|
||||
default: {
|
||||
if (janet_unwrap_pointer(x) == janet_unwrap_pointer(y)) {
|
||||
break;
|
||||
} else {
|
||||
return janet_unwrap_string(x) > janet_unwrap_string(y) ? 1 : -1;
|
||||
return janet_unwrap_pointer(x) > janet_unwrap_pointer(y) ? 1 : -1;
|
||||
}
|
||||
}
|
||||
case JANET_TUPLE: {
|
||||
const Janet *lhs = janet_unwrap_tuple(x);
|
||||
const Janet *rhs = janet_unwrap_tuple(y);
|
||||
push_traversal_node(janet_tuple_head(lhs), janet_tuple_head(rhs), 1);
|
||||
break;
|
||||
}
|
||||
case JANET_STRUCT: {
|
||||
const JanetKV *lhs = janet_unwrap_struct(x);
|
||||
const JanetKV *rhs = janet_unwrap_struct(y);
|
||||
int32_t llen = janet_struct_capacity(lhs);
|
||||
int32_t rlen = janet_struct_capacity(rhs);
|
||||
int32_t lhash = janet_struct_hash(lhs);
|
||||
int32_t rhash = janet_struct_hash(rhs);
|
||||
if (llen < rlen) return -1;
|
||||
if (llen > rlen) return 1;
|
||||
if (lhash < rhash) return -1;
|
||||
if (lhash > rhash) return 1;
|
||||
push_traversal_node(janet_struct_head(lhs), janet_struct_head(rhs), 0);
|
||||
break;
|
||||
}
|
||||
}
|
||||
}
|
||||
return (janet_type(x) < janet_type(y)) ? -1 : 1;
|
||||
} while (!(status = traversal_next(&x, &y)));
|
||||
return status - 2;
|
||||
}
|
||||
|
||||
static int32_t getter_checkint(Janet key, int32_t max) {
|
||||
|
||||
@@ -30,9 +30,12 @@
|
||||
#include "util.h"
|
||||
#endif
|
||||
|
||||
#include <math.h>
|
||||
|
||||
/* VM state */
|
||||
JANET_THREAD_LOCAL JanetTable *janet_vm_core_env;
|
||||
JANET_THREAD_LOCAL JanetTable *janet_vm_registry;
|
||||
JANET_THREAD_LOCAL JanetTable *janet_vm_abstract_registry;
|
||||
JANET_THREAD_LOCAL int janet_vm_stackn = 0;
|
||||
JANET_THREAD_LOCAL JanetFiber *janet_vm_fiber = NULL;
|
||||
JANET_THREAD_LOCAL Janet *janet_vm_return_reg = NULL;
|
||||
@@ -86,8 +89,8 @@ JANET_THREAD_LOCAL jmp_buf *janet_vm_jmp_buf = NULL;
|
||||
func = janet_stack_frame(stack)->func; \
|
||||
} while (0)
|
||||
#define vm_return(sig, val) do { \
|
||||
vm_commit(); \
|
||||
janet_vm_return_reg[0] = (val); \
|
||||
vm_commit(); \
|
||||
return (sig); \
|
||||
} while (0)
|
||||
|
||||
@@ -104,13 +107,13 @@ JANET_THREAD_LOCAL jmp_buf *janet_vm_jmp_buf = NULL;
|
||||
#define vm_assert_type(X, T) do { \
|
||||
if (!(janet_checktype((X), (T)))) { \
|
||||
vm_commit(); \
|
||||
janet_panicf("expected %T, got %t", (1 << (T)), (X)); \
|
||||
janet_panicf("expected %T, got %v", (1 << (T)), (X)); \
|
||||
} \
|
||||
} while (0)
|
||||
#define vm_assert_types(X, TS) do { \
|
||||
if (!(janet_checktypes((X), (TS)))) { \
|
||||
vm_commit(); \
|
||||
janet_panicf("expected %T, got %t", (TS), (X)); \
|
||||
janet_panicf("expected %T, got %v", (TS), (X)); \
|
||||
} \
|
||||
} while (0)
|
||||
|
||||
@@ -287,6 +290,10 @@ static Janet janet_binop_call(const char *lmethod, const char *rmethod, Janet lh
|
||||
}
|
||||
}
|
||||
|
||||
/* Forward declaration */
|
||||
static JanetSignal janet_check_can_resume(JanetFiber *fiber, Janet *out);
|
||||
static JanetSignal janet_continue_no_check(JanetFiber *fiber, Janet in, Janet *out);
|
||||
|
||||
/* Interpreter main loop */
|
||||
static JanetSignal run_vm(JanetFiber *fiber, Janet in) {
|
||||
|
||||
@@ -821,7 +828,8 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in) {
|
||||
vm_assert(func->def->environments_length > eindex, "invalid upvalue environment");
|
||||
env = func->envs[eindex];
|
||||
vm_assert(env->length > vindex, "invalid upvalue index");
|
||||
if (env->offset) {
|
||||
vm_assert(janet_env_valid(env), "invalid upvalue environment");
|
||||
if (env->offset > 0) {
|
||||
/* On stack */
|
||||
stack[A] = env->as.fiber->data[env->offset + vindex];
|
||||
} else {
|
||||
@@ -838,7 +846,8 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in) {
|
||||
vm_assert(func->def->environments_length > eindex, "invalid upvalue environment");
|
||||
env = func->envs[eindex];
|
||||
vm_assert(env->length > vindex, "invalid upvalue index");
|
||||
if (env->offset) {
|
||||
vm_assert(janet_env_valid(env), "invalid upvalue environment");
|
||||
if (env->offset > 0) {
|
||||
env->as.fiber->data[env->offset + vindex] = stack[A];
|
||||
} else {
|
||||
env->as.values[vindex] = stack[A];
|
||||
@@ -901,7 +910,7 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in) {
|
||||
if (janet_indexed_view(stack[D], &vals, &len)) {
|
||||
janet_fiber_pushn(fiber, vals, len);
|
||||
} else {
|
||||
janet_panicf("expected %T, got %t", JANET_TFLAG_INDEXED, stack[D]);
|
||||
janet_panicf("expected %T, got %v", JANET_TFLAG_INDEXED, stack[D]);
|
||||
}
|
||||
}
|
||||
stack = fiber->data + fiber->frame;
|
||||
@@ -994,8 +1003,12 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in) {
|
||||
Janet retreg;
|
||||
vm_assert_type(stack[B], JANET_FIBER);
|
||||
JanetFiber *child = janet_unwrap_fiber(stack[B]);
|
||||
if (janet_check_can_resume(child, &retreg)) {
|
||||
vm_commit();
|
||||
janet_panicv(retreg);
|
||||
}
|
||||
fiber->child = child;
|
||||
JanetSignal sig = janet_continue(child, stack[C], &retreg);
|
||||
JanetSignal sig = janet_continue_no_check(child, stack[C], &retreg);
|
||||
if (sig != JANET_SIGNAL_OK && !(child->flags & (1 << sig))) {
|
||||
vm_return(sig, retreg);
|
||||
}
|
||||
@@ -1236,10 +1249,7 @@ Janet janet_call(JanetFunction *fun, int32_t argc, const Janet *argv) {
|
||||
return *janet_vm_return_reg;
|
||||
}
|
||||
|
||||
/* Enter the main vm loop */
|
||||
JanetSignal janet_continue(JanetFiber *fiber, Janet in, Janet *out) {
|
||||
jmp_buf buf;
|
||||
|
||||
static JanetSignal janet_check_can_resume(JanetFiber *fiber, Janet *out) {
|
||||
/* Check conditions */
|
||||
JanetFiberStatus old_status = janet_fiber_status(fiber);
|
||||
if (janet_vm_stackn >= JANET_RECURSION_GUARD) {
|
||||
@@ -1249,12 +1259,20 @@ JanetSignal janet_continue(JanetFiber *fiber, Janet in, Janet *out) {
|
||||
}
|
||||
if (old_status == JANET_STATUS_ALIVE ||
|
||||
old_status == JANET_STATUS_DEAD ||
|
||||
(old_status >= JANET_STATUS_USER0 && old_status <= JANET_STATUS_USER4) ||
|
||||
old_status == JANET_STATUS_ERROR) {
|
||||
const uint8_t *str = janet_formatc("cannot resume fiber with status :%s",
|
||||
janet_status_names[old_status]);
|
||||
*out = janet_wrap_string(str);
|
||||
return JANET_SIGNAL_ERROR;
|
||||
}
|
||||
return JANET_SIGNAL_OK;
|
||||
}
|
||||
|
||||
static JanetSignal janet_continue_no_check(JanetFiber *fiber, Janet in, Janet *out) {
|
||||
jmp_buf buf;
|
||||
|
||||
JanetFiberStatus old_status = janet_fiber_status(fiber);
|
||||
|
||||
/* Continue child fiber if it exists */
|
||||
if (fiber->child) {
|
||||
@@ -1269,6 +1287,19 @@ JanetSignal janet_continue(JanetFiber *fiber, Janet in, Janet *out) {
|
||||
fiber->child = NULL;
|
||||
}
|
||||
|
||||
/* Handle new fibers being resumed with a non-nil value */
|
||||
if (old_status == JANET_STATUS_NEW && !janet_checktype(in, JANET_NIL)) {
|
||||
Janet *stack = fiber->data + fiber->frame;
|
||||
JanetFunction *func = janet_stack_frame(stack)->func;
|
||||
if (func) {
|
||||
if (func->def->arity > 0) {
|
||||
stack[0] = in;
|
||||
} else if (func->def->flags & JANET_FUNCDEF_FLAG_VARARG) {
|
||||
stack[0] = janet_wrap_tuple(janet_tuple_n(&in, 1));
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
/* Save global state */
|
||||
int32_t oldn = janet_vm_stackn++;
|
||||
int handle = janet_vm_gc_suspend;
|
||||
@@ -1311,6 +1342,14 @@ JanetSignal janet_continue(JanetFiber *fiber, Janet in, Janet *out) {
|
||||
return signal;
|
||||
}
|
||||
|
||||
/* Enter the main vm loop */
|
||||
JanetSignal janet_continue(JanetFiber *fiber, Janet in, Janet *out) {
|
||||
/* Check conditions */
|
||||
JanetSignal tmp_signal = janet_check_can_resume(fiber, out);
|
||||
if (tmp_signal) return tmp_signal;
|
||||
return janet_continue_no_check(fiber, in, out);
|
||||
}
|
||||
|
||||
JanetSignal janet_pcall(
|
||||
JanetFunction *fun,
|
||||
int32_t argc,
|
||||
@@ -1364,7 +1403,13 @@ int janet_init(void) {
|
||||
janet_scratch_cap = 0;
|
||||
/* Initialize registry */
|
||||
janet_vm_registry = janet_table(0);
|
||||
janet_vm_abstract_registry = janet_table(0);
|
||||
janet_gcroot(janet_wrap_table(janet_vm_registry));
|
||||
janet_gcroot(janet_wrap_table(janet_vm_abstract_registry));
|
||||
/* Traversal */
|
||||
janet_vm_traversal = NULL;
|
||||
janet_vm_traversal_base = NULL;
|
||||
janet_vm_traversal_top = NULL;
|
||||
/* Core env */
|
||||
janet_vm_core_env = NULL;
|
||||
/* Seed RNG */
|
||||
@@ -1385,7 +1430,9 @@ void janet_deinit(void) {
|
||||
janet_vm_root_count = 0;
|
||||
janet_vm_root_capacity = 0;
|
||||
janet_vm_registry = NULL;
|
||||
janet_vm_abstract_registry = NULL;
|
||||
janet_vm_core_env = NULL;
|
||||
free(janet_vm_traversal_base);
|
||||
#ifdef JANET_THREADS
|
||||
janet_threads_deinit();
|
||||
#endif
|
||||
|
||||
@@ -97,7 +97,14 @@ extern "C" {
|
||||
#endif
|
||||
|
||||
/* Check big endian */
|
||||
#if defined(__MIPSEB__) /* MIPS 32-bit */ \
|
||||
#if defined(__LITTLE_ENDIAN__) || \
|
||||
(defined(__BYTE_ORDER__) && (__BYTE_ORDER__ == __ORDER_LITTLE_ENDIAN__))
|
||||
/* If we know the target is LE, always use that - e.g. ppc64 little endian
|
||||
* defines the __LITTLE_ENDIAN__ macro in the ABI spec, so we can rely
|
||||
* on that and if that's not defined, fall back to big endian assumption
|
||||
*/
|
||||
#define JANET_LITTLE_ENDIAN 1
|
||||
#elif defined(__MIPSEB__) /* MIPS 32-bit */ \
|
||||
|| defined(__ppc__) || defined(__PPC__) /* CPU(PPC) - PowerPC 32-bit */ \
|
||||
|| defined(__powerpc__) || defined(__powerpc) || defined(__POWERPC__) \
|
||||
|| defined(_M_PPC) || defined(__PPC) \
|
||||
@@ -656,7 +663,7 @@ struct Janet {
|
||||
#define janet_type(x) ((x).type)
|
||||
#define janet_checktype(x, t) ((x).type == (t))
|
||||
#define janet_truthy(x) \
|
||||
((x).type != JANET_NIL && ((x).type != JANET_BOOLEAN || ((x).as.integer & 0x1)))
|
||||
((x).type != JANET_NIL && ((x).type != JANET_BOOLEAN || ((x).as.u64 & 0x1)))
|
||||
|
||||
#define janet_unwrap_struct(x) ((const JanetKV *)(x).as.pointer)
|
||||
#define janet_unwrap_tuple(x) ((const Janet *)(x).as.pointer)
|
||||
@@ -681,8 +688,8 @@ JANET_API int janet_checkint(Janet x);
|
||||
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_t)(x))
|
||||
#define janet_checkint64range(x) ((x) == (int64_t)(x))
|
||||
#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_unwrap_integer(x) ((int32_t) janet_unwrap_number(x))
|
||||
#define janet_wrap_integer(x) janet_wrap_number((int32_t)(x))
|
||||
|
||||
@@ -726,8 +733,9 @@ struct JanetStackFrame {
|
||||
int32_t flags;
|
||||
};
|
||||
|
||||
/* Number of Janets a frame takes up in the stack */
|
||||
#define JANET_FRAME_SIZE ((sizeof(JanetStackFrame) + sizeof(Janet) - 1) / sizeof(Janet))
|
||||
/* Number of Janets a frame takes up in the stack
|
||||
* Should be constant across architectures */
|
||||
#define JANET_FRAME_SIZE 4
|
||||
|
||||
/* A dynamic array type. */
|
||||
struct JanetArray {
|
||||
@@ -805,6 +813,7 @@ struct JanetAbstractHead {
|
||||
#define JANET_FUNCDEF_FLAG_HASENVS 0x400000
|
||||
#define JANET_FUNCDEF_FLAG_HASSOURCEMAP 0x800000
|
||||
#define JANET_FUNCDEF_FLAG_STRUCTARG 0x1000000
|
||||
#define JANET_FUNCDEF_FLAG_HASCLOBITSET 0x2000000
|
||||
#define JANET_FUNCDEF_FLAG_TAG 0xFFFF
|
||||
|
||||
/* Source mapping structure for a bytecode instruction */
|
||||
@@ -820,6 +829,7 @@ struct JanetFuncDef {
|
||||
Janet *constants;
|
||||
JanetFuncDef **defs;
|
||||
uint32_t *bytecode;
|
||||
uint32_t *closure_bitset; /* Bit set indicating which slots can be referenced by closures. */
|
||||
|
||||
/* Various debug information */
|
||||
JanetSourceMapping *sourcemap;
|
||||
@@ -887,8 +897,9 @@ struct JanetParser {
|
||||
int flag;
|
||||
};
|
||||
|
||||
/* A context for marshaling and unmarshaling abstract types */
|
||||
typedef struct {
|
||||
void *m_state; /* void* to not expose MarshalState ?*/
|
||||
void *m_state;
|
||||
void *u_state;
|
||||
int flags;
|
||||
const uint8_t *data;
|
||||
@@ -965,6 +976,12 @@ struct JanetRNG {
|
||||
uint32_t counter;
|
||||
};
|
||||
|
||||
typedef struct JanetFile JanetFile;
|
||||
struct JanetFile {
|
||||
FILE *file;
|
||||
int flags;
|
||||
};
|
||||
|
||||
/* Thread types */
|
||||
#ifdef JANET_THREADS
|
||||
typedef struct JanetThread JanetThread;
|
||||
@@ -1095,6 +1112,7 @@ extern enum JanetInstructionType janet_instructions[JOP_INSTRUCTION_COUNT];
|
||||
/***** START SECTION MAIN *****/
|
||||
|
||||
/* Parsing */
|
||||
extern JANET_API const JanetAbstractType janet_parser_type;
|
||||
JANET_API void janet_parser_init(JanetParser *parser);
|
||||
JANET_API void janet_parser_deinit(JanetParser *parser);
|
||||
JANET_API void janet_parser_consume(JanetParser *parser, uint8_t c);
|
||||
@@ -1156,6 +1174,7 @@ JANET_API void janet_debug_find(
|
||||
JanetString source, int32_t line, int32_t column);
|
||||
|
||||
/* RNG */
|
||||
extern JANET_API const JanetAbstractType janet_rng_type;
|
||||
JANET_API JanetRNG *janet_default_rng(void);
|
||||
JANET_API void janet_rng_seed(JanetRNG *rng, uint32_t seed);
|
||||
JANET_API void janet_rng_longseed(JanetRNG *rng, const uint8_t *bytes, int32_t len);
|
||||
@@ -1190,6 +1209,7 @@ JANET_API void janet_buffer_push_u64(JanetBuffer *buffer, uint64_t x);
|
||||
#define JANET_TUPLE_FLAG_BRACKETCTOR 0x10000
|
||||
|
||||
#define janet_tuple_head(t) ((JanetTupleHead *)((char *)t - offsetof(JanetTupleHead, data)))
|
||||
#define janet_tuple_from_head(gcobject) ((const Janet *)((char *)gcobject + offsetof(JanetTupleHead, data)))
|
||||
#define janet_tuple_length(t) (janet_tuple_head(t)->length)
|
||||
#define janet_tuple_hash(t) (janet_tuple_head(t)->hash)
|
||||
#define janet_tuple_sm_line(t) (janet_tuple_head(t)->sm_line)
|
||||
@@ -1198,8 +1218,6 @@ JANET_API void janet_buffer_push_u64(JanetBuffer *buffer, uint64_t x);
|
||||
JANET_API Janet *janet_tuple_begin(int32_t length);
|
||||
JANET_API JanetTuple janet_tuple_end(Janet *tuple);
|
||||
JANET_API JanetTuple janet_tuple_n(const Janet *values, int32_t n);
|
||||
JANET_API int janet_tuple_equal(JanetTuple lhs, JanetTuple rhs);
|
||||
JANET_API int janet_tuple_compare(JanetTuple lhs, JanetTuple rhs);
|
||||
|
||||
/* String/Symbol functions */
|
||||
#define janet_string_head(s) ((JanetStringHead *)((char *)s - offsetof(JanetStringHead, data)))
|
||||
@@ -1219,7 +1237,8 @@ JANET_API void janet_description_b(JanetBuffer *buffer, Janet x);
|
||||
#define janet_cstringv(cstr) janet_wrap_string(janet_cstring(cstr))
|
||||
#define janet_stringv(str, len) janet_wrap_string(janet_string((str), (len)))
|
||||
JANET_API JanetString janet_formatc(const char *format, ...);
|
||||
JANET_API void janet_formatb(JanetBuffer *bufp, const char *format, va_list args);
|
||||
JANET_API JanetBuffer *janet_formatb(JanetBuffer *bufp, const char *format, ...);
|
||||
JANET_API void janet_formatbv(JanetBuffer *bufp, const char *format, va_list args);
|
||||
|
||||
/* Symbol functions */
|
||||
JANET_API JanetSymbol janet_symbol(const uint8_t *str, int32_t len);
|
||||
@@ -1236,6 +1255,7 @@ JANET_API JanetSymbol janet_symbol_gen(void);
|
||||
|
||||
/* Structs */
|
||||
#define janet_struct_head(t) ((JanetStructHead *)((char *)t - offsetof(JanetStructHead, data)))
|
||||
#define janet_struct_from_head(t) ((const JanetKV *)((char *)gcobject + offsetof(JanetStructHead, data)))
|
||||
#define janet_struct_length(t) (janet_struct_head(t)->length)
|
||||
#define janet_struct_capacity(t) (janet_struct_head(t)->capacity)
|
||||
#define janet_struct_hash(t) (janet_struct_head(t)->hash)
|
||||
@@ -1244,8 +1264,6 @@ JANET_API void janet_struct_put(JanetKV *st, Janet key, Janet value);
|
||||
JANET_API JanetStruct janet_struct_end(JanetKV *st);
|
||||
JANET_API Janet janet_struct_get(JanetStruct st, Janet key);
|
||||
JANET_API JanetTable *janet_struct_to_table(JanetStruct st);
|
||||
JANET_API int janet_struct_equal(JanetStruct lhs, JanetStruct rhs);
|
||||
JANET_API int janet_struct_compare(JanetStruct lhs, JanetStruct rhs);
|
||||
JANET_API const JanetKV *janet_struct_find(JanetStruct st, Janet key);
|
||||
|
||||
/* Table functions */
|
||||
@@ -1278,6 +1296,7 @@ JANET_API const JanetKV *janet_dictionary_next(const JanetKV *kvs, int32_t cap,
|
||||
|
||||
/* Abstract */
|
||||
#define janet_abstract_head(u) ((JanetAbstractHead *)((char *)u - offsetof(JanetAbstractHead, data)))
|
||||
#define janet_abstract_from_head(gcobject) ((JanetAbstract)((char *)gcobject + offsetof(JanetAbstractHead, data)))
|
||||
#define janet_abstract_type(u) (janet_abstract_head(u)->type)
|
||||
#define janet_abstract_size(u) (janet_abstract_head(u)->size)
|
||||
JANET_API void *janet_abstract_begin(const JanetAbstractType *type, size_t size);
|
||||
@@ -1290,6 +1309,8 @@ typedef JanetBuildConfig(*JanetModconf)(void);
|
||||
JANET_API JanetModule janet_native(const char *name, JanetString *error);
|
||||
|
||||
/* Marshaling */
|
||||
#define JANET_MARSHAL_UNSAFE 0x20000
|
||||
|
||||
JANET_API void janet_marshal(
|
||||
JanetBuffer *buf,
|
||||
Janet x,
|
||||
@@ -1468,6 +1489,8 @@ JANET_API JanetArray *janet_optarray(const Janet *argv, int32_t argc, int32_t n,
|
||||
JANET_API Janet janet_dyn(const char *name);
|
||||
JANET_API void janet_setdyn(const char *name, Janet value);
|
||||
|
||||
extern JANET_API const JanetAbstractType janet_file_type;
|
||||
|
||||
#define JANET_FILE_WRITE 1
|
||||
#define JANET_FILE_READ 2
|
||||
#define JANET_FILE_APPEND 4
|
||||
@@ -1505,8 +1528,52 @@ JANET_API JanetAbstract janet_unmarshal_abstract(JanetMarshalContext *ctx, size_
|
||||
JANET_API void janet_register_abstract_type(const JanetAbstractType *at);
|
||||
JANET_API const JanetAbstractType *janet_get_abstract_type(Janet key);
|
||||
|
||||
#ifdef JANET_PEG
|
||||
|
||||
extern JANET_API const JanetAbstractType janet_peg_type;
|
||||
|
||||
/* opcodes for peg vm */
|
||||
typedef enum {
|
||||
RULE_LITERAL, /* [len, bytes...] */
|
||||
RULE_NCHAR, /* [n] */
|
||||
RULE_NOTNCHAR, /* [n] */
|
||||
RULE_RANGE, /* [lo | hi << 16 (1 word)] */
|
||||
RULE_SET, /* [bitmap (8 words)] */
|
||||
RULE_LOOK, /* [offset, rule] */
|
||||
RULE_CHOICE, /* [len, rules...] */
|
||||
RULE_SEQUENCE, /* [len, rules...] */
|
||||
RULE_IF, /* [rule_a, rule_b (b if a)] */
|
||||
RULE_IFNOT, /* [rule_a, rule_b (b if not a)] */
|
||||
RULE_NOT, /* [rule] */
|
||||
RULE_BETWEEN, /* [lo, hi, rule] */
|
||||
RULE_GETTAG, /* [searchtag, tag] */
|
||||
RULE_CAPTURE, /* [rule, tag] */
|
||||
RULE_POSITION, /* [tag] */
|
||||
RULE_ARGUMENT, /* [argument-index, tag] */
|
||||
RULE_CONSTANT, /* [constant, tag] */
|
||||
RULE_ACCUMULATE, /* [rule, tag] */
|
||||
RULE_GROUP, /* [rule, tag] */
|
||||
RULE_REPLACE, /* [rule, constant, tag] */
|
||||
RULE_MATCHTIME, /* [rule, constant, tag] */
|
||||
RULE_ERROR, /* [rule] */
|
||||
RULE_DROP, /* [rule] */
|
||||
RULE_BACKMATCH, /* [tag] */
|
||||
} JanetPegOpcode;
|
||||
|
||||
typedef struct {
|
||||
uint32_t *bytecode;
|
||||
Janet *constants;
|
||||
size_t bytecode_len;
|
||||
uint32_t num_constants;
|
||||
} JanetPeg;
|
||||
|
||||
#endif
|
||||
|
||||
#ifdef JANET_TYPED_ARRAY
|
||||
|
||||
extern JANET_API const JanetAbstractType janet_ta_view_type;
|
||||
extern JANET_API const JanetAbstractType janet_ta_buffer_type;
|
||||
|
||||
typedef enum {
|
||||
JANET_TARRAY_TYPE_U8,
|
||||
JANET_TARRAY_TYPE_S8,
|
||||
@@ -1557,6 +1624,9 @@ JanetTArrayView *janet_gettarray_any(const Janet *argv, int32_t n);
|
||||
|
||||
#ifdef JANET_INT_TYPES
|
||||
|
||||
extern JANET_API const JanetAbstractType janet_s64_type;
|
||||
extern JANET_API const JanetAbstractType janet_u64_type;
|
||||
|
||||
typedef enum {
|
||||
JANET_INT_NONE,
|
||||
JANET_INT_S64,
|
||||
@@ -1573,6 +1643,15 @@ JANET_API int janet_scan_uint64(const uint8_t *str, int32_t len, uint64_t *out);
|
||||
|
||||
#endif
|
||||
|
||||
#ifdef JANET_THREADS
|
||||
|
||||
extern JANET_API const JanetAbstractType janet_thread_type;
|
||||
|
||||
JANET_API int janet_thread_receive(Janet *msg_out, double timeout);
|
||||
JANET_API int janet_thread_send(JanetThread *thread, Janet msg, double timeout);
|
||||
|
||||
#endif
|
||||
|
||||
/***** END SECTION MAIN *****/
|
||||
|
||||
#ifdef __cplusplus
|
||||
|
||||
@@ -515,6 +515,147 @@ static void check_specials(JanetByteView src) {
|
||||
check_cmatch(src, "while");
|
||||
}
|
||||
|
||||
static void resolve_format(JanetTable *entry) {
|
||||
int is_macro = janet_truthy(janet_table_get(entry, janet_ckeywordv("macro")));
|
||||
Janet refv = janet_table_get(entry, janet_ckeywordv("ref"));
|
||||
int is_ref = janet_checktype(refv, JANET_ARRAY);
|
||||
Janet value = janet_wrap_nil();
|
||||
if (is_ref) {
|
||||
JanetArray *a = janet_unwrap_array(refv);
|
||||
if (a->count) value = a->data[0];
|
||||
} else {
|
||||
value = janet_table_get(entry, janet_ckeywordv("value"));
|
||||
}
|
||||
if (is_macro) {
|
||||
fprintf(stderr, " macro\n");
|
||||
gbl_lines_below++;
|
||||
} else if (is_ref) {
|
||||
janet_eprintf(" var (%t)\n", value);
|
||||
gbl_lines_below++;
|
||||
} else {
|
||||
janet_eprintf(" %t\n", value);
|
||||
gbl_lines_below++;
|
||||
}
|
||||
Janet sm = janet_table_get(entry, janet_ckeywordv("source-map"));
|
||||
Janet path = janet_get(sm, janet_wrap_integer(0));
|
||||
Janet line = janet_get(sm, janet_wrap_integer(1));
|
||||
Janet col = janet_get(sm, janet_wrap_integer(2));
|
||||
if (janet_checktype(path, JANET_STRING) && janet_truthy(line) && janet_truthy(col)) {
|
||||
janet_eprintf(" %S on line %v, column %v\n", janet_unwrap_string(path), line, col);
|
||||
gbl_lines_below++;
|
||||
}
|
||||
}
|
||||
|
||||
static void doc_format(JanetString doc, int32_t width) {
|
||||
int32_t maxcol = width - 8;
|
||||
uint8_t wordbuf[256] = {0};
|
||||
int32_t wordp = 0;
|
||||
int32_t current = 0;
|
||||
if (maxcol > 200) maxcol = 200;
|
||||
fprintf(stderr, " ");
|
||||
for (int32_t i = 0; i < janet_string_length(doc); i++) {
|
||||
uint8_t b = doc[i];
|
||||
switch (b) {
|
||||
default: {
|
||||
if (maxcol <= current + wordp + 1) {
|
||||
if (!current) {
|
||||
fwrite(wordbuf, wordp, 1, stderr);
|
||||
wordp = 0;
|
||||
}
|
||||
fprintf(stderr, "\n ");
|
||||
gbl_lines_below++;
|
||||
current = 0;
|
||||
}
|
||||
wordbuf[wordp++] = b;
|
||||
break;
|
||||
}
|
||||
case '\t': {
|
||||
if (maxcol <= current + wordp + 2) {
|
||||
if (!current) {
|
||||
fwrite(wordbuf, wordp, 1, stderr);
|
||||
wordp = 0;
|
||||
}
|
||||
fprintf(stderr, "\n ");
|
||||
gbl_lines_below++;
|
||||
current = 0;
|
||||
}
|
||||
wordbuf[wordp++] = ' ';
|
||||
wordbuf[wordp++] = ' ';
|
||||
break;
|
||||
}
|
||||
case '\n':
|
||||
case ' ': {
|
||||
if (wordp) {
|
||||
int32_t oldcur = current;
|
||||
int spacer = maxcol > current + wordp + 1;
|
||||
if (spacer) current++;
|
||||
else current = 0;
|
||||
current += wordp;
|
||||
if (oldcur) fprintf(stderr, spacer ? " " : "\n ");
|
||||
if (oldcur && !spacer) gbl_lines_below++;
|
||||
fwrite(wordbuf, wordp, 1, stderr);
|
||||
wordp = 0;
|
||||
}
|
||||
if (b == '\n') {
|
||||
fprintf(stderr, "\n ");
|
||||
gbl_lines_below++;
|
||||
current = 0;
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
if (wordp) {
|
||||
int32_t oldcur = current;
|
||||
int spacer = maxcol > current + wordp + 1;
|
||||
if (spacer) current++;
|
||||
else current = 0;
|
||||
current += wordp + 1;
|
||||
if (oldcur) fprintf(stderr, spacer ? " " : "\n ");
|
||||
if (oldcur && !spacer) gbl_lines_below++;
|
||||
fwrite(wordbuf, wordp, 1, stderr);
|
||||
wordp = 0;
|
||||
}
|
||||
}
|
||||
|
||||
static void find_matches(JanetByteView prefix) {
|
||||
JanetTable *env = gbl_complete_env;
|
||||
gbl_match_count = 0;
|
||||
while (NULL != env) {
|
||||
JanetKV *kvend = env->data + env->capacity;
|
||||
for (JanetKV *kv = env->data; kv < kvend; kv++) {
|
||||
if (!janet_checktype(kv->key, JANET_SYMBOL)) continue;
|
||||
const uint8_t *sym = janet_unwrap_symbol(kv->key);
|
||||
check_match(prefix, sym, janet_string_length(sym));
|
||||
}
|
||||
env = env->proto;
|
||||
}
|
||||
}
|
||||
|
||||
static void kshowdoc(void) {
|
||||
if (!gbl_complete_env) return;
|
||||
while (is_symbol_char_gen(gbl_buf[gbl_pos])) gbl_pos++;
|
||||
JanetByteView prefix = get_symprefix();
|
||||
Janet symbol = janet_symbolv(prefix.bytes, prefix.len);
|
||||
Janet entry = janet_table_get(gbl_complete_env, symbol);
|
||||
if (!janet_checktype(entry, JANET_TABLE)) return;
|
||||
Janet doc = janet_table_get(janet_unwrap_table(entry), janet_ckeywordv("doc"));
|
||||
if (!janet_checktype(doc, JANET_STRING)) return;
|
||||
JanetString docs = janet_unwrap_string(doc);
|
||||
int num_cols = getcols();
|
||||
clearlines();
|
||||
fprintf(stderr, "\n\n\n");
|
||||
gbl_lines_below += 3;
|
||||
resolve_format(janet_unwrap_table(entry));
|
||||
fprintf(stderr, "\n");
|
||||
gbl_lines_below += 1;
|
||||
doc_format(docs, num_cols);
|
||||
fprintf(stderr, "\n\n");
|
||||
gbl_lines_below += 2;
|
||||
/* Go up to original line (zsh-like autocompletion) */
|
||||
fprintf(stderr, "\x1B[%dA", gbl_lines_below);
|
||||
fflush(stderr);
|
||||
}
|
||||
|
||||
static void kshowcomp(void) {
|
||||
JanetTable *env = gbl_complete_env;
|
||||
if (env == NULL) {
|
||||
@@ -528,19 +669,9 @@ static void kshowcomp(void) {
|
||||
gbl_pos++;
|
||||
|
||||
JanetByteView prefix = get_symprefix();
|
||||
if (prefix.len == 0) return;
|
||||
if (prefix.len == 0) return;
|
||||
|
||||
/* Find all matches */
|
||||
gbl_match_count = 0;
|
||||
while (NULL != env) {
|
||||
JanetKV *kvend = env->data + env->capacity;
|
||||
for (JanetKV *kv = env->data; kv < kvend; kv++) {
|
||||
if (!janet_checktype(kv->key, JANET_SYMBOL)) continue;
|
||||
const uint8_t *sym = janet_unwrap_symbol(kv->key);
|
||||
check_match(prefix, sym, janet_string_length(sym));
|
||||
}
|
||||
env = env->proto;
|
||||
}
|
||||
find_matches(prefix);
|
||||
|
||||
check_specials(prefix);
|
||||
|
||||
@@ -620,8 +751,12 @@ static int line() {
|
||||
clearlines();
|
||||
return -1;
|
||||
case 4: /* ctrl-d, eof */
|
||||
clearlines();
|
||||
return -1;
|
||||
if (gbl_len == 0) { /* quit on empty line */
|
||||
clearlines();
|
||||
return -1;
|
||||
}
|
||||
kdelete(1);
|
||||
break;
|
||||
case 5: /* ctrl-e */
|
||||
gbl_pos = gbl_len;
|
||||
refresh();
|
||||
@@ -629,6 +764,10 @@ static int line() {
|
||||
case 6: /* ctrl-f */
|
||||
kright();
|
||||
break;
|
||||
case 7: /* ctrl-g */
|
||||
kshowdoc();
|
||||
refresh();
|
||||
break;
|
||||
case 127: /* backspace */
|
||||
case 8: /* ctrl-h */
|
||||
kbackspace(1);
|
||||
@@ -761,6 +900,9 @@ static int line() {
|
||||
case '.': /* Alt-. */
|
||||
historymove(-JANET_HISTORY_MAX);
|
||||
break;
|
||||
case 127: /* Alt-backspace */
|
||||
kbackspacew();
|
||||
break;
|
||||
}
|
||||
}
|
||||
break;
|
||||
|
||||
45
test/fuzzers/fuzz_dostring.c
Normal file
45
test/fuzzers/fuzz_dostring.c
Normal file
@@ -0,0 +1,45 @@
|
||||
#include <stdint.h>
|
||||
#include <string.h>
|
||||
#include <janet.h>
|
||||
|
||||
int LLVMFuzzerTestOneInput(const uint8_t *data, size_t size) {
|
||||
|
||||
/* init Janet */
|
||||
janet_init();
|
||||
|
||||
/* fuzz the parser */
|
||||
JanetParser parser;
|
||||
janet_parser_init(&parser);
|
||||
for (int i = 0, done = 0; i < size; i++) {
|
||||
switch (janet_parser_status(&parser)) {
|
||||
case JANET_PARSE_DEAD:
|
||||
case JANET_PARSE_ERROR:
|
||||
done = 1;
|
||||
break;
|
||||
case JANET_PARSE_PENDING:
|
||||
if (i == size) {
|
||||
janet_parser_eof(&parser);
|
||||
} else {
|
||||
janet_parser_consume(&parser, data[i]);
|
||||
}
|
||||
break;
|
||||
case JANET_PARSE_ROOT:
|
||||
if (i >= size) {
|
||||
janet_parser_eof(&parser);
|
||||
} else {
|
||||
janet_parser_consume(&parser, data[i]);
|
||||
}
|
||||
break;
|
||||
}
|
||||
|
||||
if (done == 1)
|
||||
break;
|
||||
}
|
||||
janet_parser_deinit(&parser);
|
||||
|
||||
/* cleanup Janet */
|
||||
janet_deinit();
|
||||
|
||||
return 0;
|
||||
}
|
||||
|
||||
@@ -8,7 +8,8 @@
|
||||
|
||||
(defn assert
|
||||
"Override's the default assert with some nice error handling."
|
||||
[x e]
|
||||
[x &opt e]
|
||||
(default e "assert error")
|
||||
(++ num-tests-run)
|
||||
(when x (++ num-tests-passed))
|
||||
(if x
|
||||
|
||||
@@ -206,6 +206,10 @@
|
||||
(def 🐮 :cow)
|
||||
(assert (= (string "🐼" 🦊 🐮) "🐼foxcow") "emojis 🙉 :)")
|
||||
(assert (not= 🦊 "🦊") "utf8 strings are not symbols and vice versa")
|
||||
(assert (= "\U01F637" "😷") "unicode escape 1")
|
||||
(assert (= "\u2623" "\U002623" "☣") "unicode escape 2")
|
||||
(assert (= "\u24c2" "\U0024c2" "Ⓜ") "unicode escape 3")
|
||||
(assert (= "\u0061" "a") "unicode escape 4")
|
||||
|
||||
# Symbols with @ character
|
||||
|
||||
@@ -250,6 +254,11 @@
|
||||
(assert (apply <= (merge @[1 3 5] @[2 4 6 6 6 9])) "merge sort merge 3")
|
||||
(assert (apply <= (merge '(1 3 5) @[2 4 6 6 6 9])) "merge sort merge 4")
|
||||
|
||||
(assert (deep= @[1 2 3 4 5] (sort @[5 3 4 1 2])) "sort 1")
|
||||
(assert (deep= @[{:a 1} {:a 4} {:a 7}] (sort-by |($ :a) @[{:a 4} {:a 7} {:a 1}])) "sort 2")
|
||||
(assert (deep= @[1 2 3 4 5] (sorted [5 3 4 1 2])) "sort 3")
|
||||
(assert (deep= @[{:a 1} {:a 4} {:a 7}] (sorted-by |($ :a) [{:a 4} {:a 7} {:a 1}])) "sort 4")
|
||||
|
||||
# Gensym tests
|
||||
|
||||
(assert (not= (gensym) (gensym)) "two gensyms not equal")
|
||||
@@ -319,5 +328,11 @@
|
||||
(assert (= true ;(map truthy? [0 "" true @{} {} [] '()])) "truthy values")
|
||||
(assert (= false ;(map truthy? [nil false])) "non-truthy values")
|
||||
|
||||
# Struct and Table duplicate elements
|
||||
(assert (= {:a 3 :b 2} {:a 1 :b 2 :a 3}) "struct literal duplicate keys")
|
||||
(assert (= {:a 3 :b 2} (struct :a 1 :b 2 :a 3)) "struct constructor duplicate keys")
|
||||
(assert (deep= @{:a 3 :b 2} @{:a 1 :b 2 :a 3}) "table literal duplicate keys")
|
||||
(assert (deep= @{:a 3 :b 2} (table :a 1 :b 2 :a 3)) "table constructor duplicate keys")
|
||||
|
||||
(end-suite)
|
||||
|
||||
|
||||
@@ -212,13 +212,17 @@
|
||||
|
||||
(assert (= 7 (case :a :b 5 :c 6 :u 10 7)) "case with default")
|
||||
|
||||
# Testing the loop and for macros
|
||||
# Testing the loop and seq macros
|
||||
(def xs (apply tuple (seq [x :range [0 10] :when (even? x)] (tuple (/ x 2) x))))
|
||||
(assert (= xs '((0 0) (1 2) (2 4) (3 6) (4 8))) "seq macro 1")
|
||||
|
||||
(def xs (apply tuple (seq [x :down [8 -2] :when (even? x)] (tuple (/ x 2) x))))
|
||||
(assert (= xs '((4 8) (3 6) (2 4) (1 2) (0 0))) "seq macro 2")
|
||||
|
||||
# :range-to and :down-to
|
||||
(assert (deep= (seq [x :range-to [0 10]] x) (seq [x :range [0 11]] x)) "loop :range-to")
|
||||
(assert (deep= (seq [x :down-to [10 0]] x) (seq [x :down [10 -1]] x)) "loop :down-to")
|
||||
|
||||
# Some testing for not=
|
||||
(assert (not= 1 1 0) "not= 1")
|
||||
(assert (not= 0 1 1) "not= 2")
|
||||
@@ -255,4 +259,26 @@
|
||||
(assert (array= (array/slice @[1 2 3] 0 2) @[1 2]) "array/slice 1")
|
||||
(assert (array= (array/slice @[0 7 3 9 1 4] 2 -2) @[3 9 1]) "array/slice 2")
|
||||
|
||||
# Even and odd
|
||||
|
||||
(assert (odd? 9) "odd? 1")
|
||||
(assert (odd? -9) "odd? 2")
|
||||
(assert (not (odd? 10)) "odd? 3")
|
||||
(assert (not (odd? 0)) "odd? 4")
|
||||
(assert (not (odd? -10)) "odd? 5")
|
||||
(assert (not (odd? 1.1)) "odd? 6")
|
||||
(assert (not (odd? -0.1)) "odd? 7")
|
||||
(assert (not (odd? -1.1)) "odd? 8")
|
||||
(assert (not (odd? -1.6)) "odd? 9")
|
||||
|
||||
(assert (even? 10) "even? 1")
|
||||
(assert (even? -10) "even? 2")
|
||||
(assert (even? 0) "even? 3")
|
||||
(assert (not (even? 9)) "even? 4")
|
||||
(assert (not (even? -9)) "even? 5")
|
||||
(assert (not (even? 0.1)) "even? 6")
|
||||
(assert (not (even? -0.1)) "even? 7")
|
||||
(assert (not (even? -10.1)) "even? 8")
|
||||
(assert (not (even? -10.6)) "even? 9")
|
||||
|
||||
(end-suite)
|
||||
|
||||
@@ -226,6 +226,23 @@
|
||||
:week-day 3}
|
||||
(os/date 1388608200)) "os/date")
|
||||
|
||||
# OS mktime test
|
||||
|
||||
(assert (= 1388608200 (os/mktime {:year-day 0
|
||||
:minutes 30
|
||||
:month 0
|
||||
:dst false
|
||||
:seconds 0
|
||||
:year 2014
|
||||
:month-day 0
|
||||
:hours 20
|
||||
:week-day 3})) "os/mktime")
|
||||
|
||||
(def now (os/time))
|
||||
(assert (= (os/mktime (os/date now)) now) "UTC os/mktime")
|
||||
(assert (= (os/mktime (os/date now true) true) now) "local os/mktime")
|
||||
(assert (= (os/mktime {:year 1970}) 0) "os/mktime default values")
|
||||
|
||||
# Appending buffer to self
|
||||
|
||||
(with-dyns [:out @""]
|
||||
|
||||
255
test/suite8.janet
Normal file
255
test/suite8.janet
Normal file
@@ -0,0 +1,255 @@
|
||||
# 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 8)
|
||||
|
||||
###
|
||||
### Compiling brainfuck to Janet.
|
||||
###
|
||||
|
||||
(def- bf-peg
|
||||
"Peg for compiling brainfuck into a Janet source ast."
|
||||
(peg/compile
|
||||
~{:+ (/ '(some "+") ,(fn [x] ~(+= (DATA POS) ,(length x))))
|
||||
:- (/ '(some "-") ,(fn [x] ~(-= (DATA POS) ,(length x))))
|
||||
:> (/ '(some ">") ,(fn [x] ~(+= POS ,(length x))))
|
||||
:< (/ '(some "<") ,(fn [x] ~(-= POS ,(length x))))
|
||||
:. (* "." (constant (prinf "%c" (get DATA POS))))
|
||||
:loop (/ (* "[" :main "]") ,(fn [& captures]
|
||||
~(while (not= (get DATA POS) 0)
|
||||
,;captures)))
|
||||
:main (any (+ :s :loop :+ :- :> :< :.)) }))
|
||||
|
||||
(defn bf
|
||||
"Run brainfuck."
|
||||
[text]
|
||||
(eval
|
||||
~(let [DATA (array/new-filled 100 0)]
|
||||
(var POS 50)
|
||||
,;(peg/match bf-peg text))))
|
||||
|
||||
(defn test-bf
|
||||
"Test some bf for expected output."
|
||||
[input output]
|
||||
(def b @"")
|
||||
(with-dyns [:out b]
|
||||
(bf input))
|
||||
(assert (= (string output) (string b))
|
||||
(string "bf input '"
|
||||
input
|
||||
"' failed, expected "
|
||||
(describe output)
|
||||
", got "
|
||||
(describe (string b))
|
||||
".")))
|
||||
|
||||
(test-bf "++++++++[>++++[>++>+++>+++>+<<<<-]>+>+>->>+[<]<-]>>.>---.+++++++..+++.>>.<-.<.+++.------.--------.>>+.>++." "Hello World!\n")
|
||||
|
||||
(test-bf ">++++++++[-<+++++++++>]<.>>+>-[+]++>++>+++[>[->+++<<+++>]<<]>-----.>->
|
||||
+++..+++.>-.<<+[>[+>+]>>]<--------------.>>.+++.------.--------.>+.>+."
|
||||
"Hello World!\n")
|
||||
|
||||
(test-bf "+[+[<<<+>>>>]+<-<-<<<+<++]<<.<++.<++..+++.<<++.<---.>>.>.+++.------.>-.>>--."
|
||||
"Hello, World!")
|
||||
|
||||
# Prompts and Labels
|
||||
|
||||
(assert (= 10 (label a (for i 0 10 (if (= i 5) (return a 10))))) "label 1")
|
||||
|
||||
(defn recur
|
||||
[lab x y]
|
||||
(when (= x y) (return lab :done))
|
||||
(def res (label newlab (recur (or lab newlab) (+ x 1) y)))
|
||||
(if lab :oops res))
|
||||
(assert (= :done (recur nil 0 10)) "label 2")
|
||||
|
||||
(assert (= 10 (prompt :a (for i 0 10 (if (= i 5) (return :a 10))))) "prompt 1")
|
||||
|
||||
(defn- inner-loop
|
||||
[i]
|
||||
(if (= i 5)
|
||||
(return :a 10)))
|
||||
|
||||
(assert (= 10 (prompt :a (for i 0 10 (inner-loop i)))) "prompt 2")
|
||||
|
||||
(defn- inner-loop2
|
||||
[i]
|
||||
(try
|
||||
(if (= i 5)
|
||||
(error 10))
|
||||
([err] (return :a err))))
|
||||
|
||||
(assert (= 10 (prompt :a (for i 0 10 (inner-loop2 i)))) "prompt 3")
|
||||
|
||||
# Match checks
|
||||
|
||||
(assert (= :hi (match nil nil :hi)) "match 1")
|
||||
(assert (= :hi (match {:a :hi} {:a a} a)) "match 2")
|
||||
(assert (= nil (match {:a :hi} {:a a :b b} a)) "match 3")
|
||||
(assert (= nil (match [1 2] [a b c] a)) "match 4")
|
||||
(assert (= 2 (match [1 2] [a b] b)) "match 5")
|
||||
|
||||
# And/or checks
|
||||
|
||||
(assert (= false (and false false)) "and 1")
|
||||
(assert (= false (or false false)) "or 1")
|
||||
|
||||
# #300 Regression test
|
||||
|
||||
# Just don't segfault
|
||||
(assert (peg/match '{:main (replace "S" {"S" :spade})} "S7") "regression #300")
|
||||
|
||||
# Test cases for #293
|
||||
(assert (= :yes (match [1 2 3] [_ a _] :yes :no)) "match wildcard 1")
|
||||
(assert (= :no (match [1 2 3] [__ a __] :yes :no)) "match wildcard 2")
|
||||
(assert (= :yes (match [1 2 [1 2 3]] [_ a [_ _ _]] :yes :no)) "match wildcard 3")
|
||||
(assert (= :yes (match [1 2 3] (_ (even? 2)) :yes :no)) "match wildcard 4")
|
||||
(assert (= :yes (match {:a 1} {:a _} :yes :no)) "match wildcard 5")
|
||||
(assert (= false (match {:a 1 :b 2 :c 3} {:a a :b _ :c _ :d _} :no {:a _ :b _ :c _} false :no)) "match wildcard 6")
|
||||
(assert (= nil (match {:a 1 :b 2 :c 3} {:a a :b _ :c _ :d _} :no {:a _ :b _ :c _} nil :no)) "match wildcard 7")
|
||||
|
||||
# Regression #301
|
||||
(def b (buffer/new-filled 128 0x78))
|
||||
(assert (= 38 (length (buffer/blit @"" b -1 90))) "buffer/blit 1")
|
||||
|
||||
(def a @"abcdefghijklm")
|
||||
(assert (deep= @"abcde" (buffer/blit @"" a -1 0 5)) "buffer/blit 2")
|
||||
(assert (deep= @"bcde" (buffer/blit @"" a -1 1 5)) "buffer/blit 3")
|
||||
(assert (deep= @"cde" (buffer/blit @"" a -1 2 5)) "buffer/blit 4")
|
||||
(assert (deep= @"de" (buffer/blit @"" a -1 3 5)) "buffer/blit 5")
|
||||
|
||||
# chr
|
||||
(assert (= (chr "a") 97) "chr 1")
|
||||
|
||||
# Detaching closure over non resumable fiber.
|
||||
(do
|
||||
(defn f1
|
||||
[a]
|
||||
(defn f1 [] (++ (a 0)))
|
||||
(defn f2 [] (++ (a 0)))
|
||||
(error [f1 f2]))
|
||||
(def [_ [f1 f2]] (protect (f1 @[0])))
|
||||
# At time of writing, mark phase can detach closure envs.
|
||||
(gccollect)
|
||||
(assert (= 1 (f1)) "detach-non-resumable-closure 1")
|
||||
(assert (= 2 (f2)) "detach-non-resumable-closure 2"))
|
||||
|
||||
# Marshal closure over non resumable fiber.
|
||||
(do
|
||||
(defn f1
|
||||
[a]
|
||||
(defn f1 [] (++ (a 0)))
|
||||
(defn f2 [] (++ (a 0)))
|
||||
(error [f1 f2]))
|
||||
(def [_ tup] (protect (f1 @[0])))
|
||||
(def [f1 f2] (unmarshal (marshal tup make-image-dict) load-image-dict))
|
||||
(assert (= 1 (f1)) "marshal-non-resumable-closure 1")
|
||||
(assert (= 2 (f2)) "marshal-non-resumable-closure 2"))
|
||||
|
||||
# Marshal closure over currently alive fiber.
|
||||
(do
|
||||
(defn f1
|
||||
[a]
|
||||
(defn f1 [] (++ (a 0)))
|
||||
(defn f2 [] (++ (a 0)))
|
||||
(marshal [f1 f2] make-image-dict))
|
||||
(def [f1 f2] (unmarshal (f1 @[0]) load-image-dict))
|
||||
(assert (= 1 (f1)) "marshal-live-closure 1")
|
||||
(assert (= 2 (f2)) "marshal-live-closure 2"))
|
||||
|
||||
(do
|
||||
(var a 1)
|
||||
(defn b [x] (+ a x))
|
||||
(def c (unmarshal (marshal b)))
|
||||
(assert (= 2 (c 1)) "marshal-on-stack-closure 1"))
|
||||
|
||||
# Reduce2
|
||||
|
||||
(assert (= (reduce + 0 (range 1 10)) (reduce2 + (range 10))) "reduce2 1")
|
||||
(assert (= (reduce * 1 (range 2 10)) (reduce2 * (range 1 10))) "reduce2 2")
|
||||
(assert (= nil (reduce2 * [])) "reduce2 3")
|
||||
|
||||
# Accumulate
|
||||
|
||||
(assert (deep= (accumulate + 0 (range 5)) @[0 1 3 6 10]) "accumulate 1")
|
||||
(assert (deep= (accumulate2 + (range 5)) @[0 1 3 6 10]) "accumulate2 1")
|
||||
(assert (deep= @[] (accumulate2 + [])) "accumulate2 2")
|
||||
(assert (deep= @[] (accumulate 0 + [])) "accumulate 2")
|
||||
|
||||
# Perm strings
|
||||
|
||||
(assert (= (os/perm-int "rwxrwxrwx") 8r777) "perm 1")
|
||||
(assert (= (os/perm-int "rwxr-xr-x") 8r755) "perm 2")
|
||||
(assert (= (os/perm-int "rw-r--r--") 8r644) "perm 3")
|
||||
|
||||
(assert (= (band (os/perm-int "rwxrwxrwx") 8r077) 8r077) "perm 4")
|
||||
(assert (= (band (os/perm-int "rwxr-xr-x") 8r077) 8r055) "perm 5")
|
||||
(assert (= (band (os/perm-int "rw-r--r--") 8r077) 8r044) "perm 6")
|
||||
|
||||
(assert (= (os/perm-string 8r777) "rwxrwxrwx") "perm 7")
|
||||
(assert (= (os/perm-string 8r755) "rwxr-xr-x") "perm 8")
|
||||
(assert (= (os/perm-string 8r644) "rw-r--r--") "perm 9")
|
||||
|
||||
# Issue #336 cases - don't segfault
|
||||
|
||||
(assert-error "unmarshal errors 1" (unmarshal @"\xd6\xb9\xb9"))
|
||||
(assert-error "unmarshal errors 2" (unmarshal @"\xd7bc"))
|
||||
(assert-error "unmarshal errors 3" (unmarshal "\xd3\x01\xd9\x01\x62\xcf\x03\x78\x79\x7a" load-image-dict))
|
||||
(assert-error "unmarshal errors 4"
|
||||
(unmarshal
|
||||
@"\xD7\xCD\0e/p\x98\0\0\x03\x01\x01\x01\x02\0\0\x04\0\xCEe/p../tools
|
||||
\0\0\0/afl\0\0\x01\0erate\xDE\xDE\xDE\xDE\xDE\xDE\xDE\xDE\xDE\xDE
|
||||
\xA8\xDE\xDE\xDE\xDE\xDE\xDE\0\0\0\xDE\xDE_unmarshal_testcase3.ja
|
||||
neldb\0\0\0\xD8\x05printG\x01\0\xDE\xDE\xDE'\x03\0marshal_tes/\x02
|
||||
\0\0\0\0\0*\xFE\x01\04\x02\0\0'\x03\0\r\0\r\0\r\0\r" load-image-dict))
|
||||
|
||||
# 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)
|
||||
(gccollect)
|
||||
(marshal x make-image-dict)
|
||||
|
||||
(def b @"\xCC\xCD\0\x03\0\x08\x04\rm\xCD\x7F\xFF\xFF\xFF\x02\0\x02\xD7\xCD\0\x98\0\0\x05\x01\x01\x01\x01\x08\xCE\x01f\xCE../tools/afl/generate_unmarshal_testcases.janet\xCE\x012,\x01\0\0&\x03\0\06\x02\x03\x03)\x03\x01\0*\x04\0\00\x03\x04\0>\x03\0\0\x03\x03\0\0*\x05\0\x11\0\x11\0\x05\0\x05\0\x05\0\x05\0\x05\xC9\xDA\x04\xC9\xC9\xC9")
|
||||
(unmarshal b load-image-dict)
|
||||
(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))
|
||||
(gccollect)
|
||||
|
||||
# in vs get regression
|
||||
(assert (nil? (first @"")) "in vs get 1")
|
||||
(assert (nil? (last @"")) "in vs get 1")
|
||||
|
||||
# For undefined behavior sanitizer
|
||||
0xf&1fffFFFF
|
||||
|
||||
# Tuple comparison
|
||||
(assert (< [1 2 3] [2 2 3]) "tuple comparison 1")
|
||||
(assert (< [1 2 3] [2 2]) "tuple comparison 2")
|
||||
(assert (< [1 2 3] [2 2 3 4]) "tuple comparison 3")
|
||||
(assert (< [1 2 3] [1 2 3 4]) "tuple comparison 4")
|
||||
(assert (< [1 2 3] [1 2 3 -1]) "tuple comparison 5")
|
||||
(assert (> [1 2 3] [1 2]) "tuple comparison 6")
|
||||
|
||||
(end-suite)
|
||||
@@ -3,12 +3,26 @@
|
||||
To use these, you need to install afl (of course), and xterm. A tiling window manager helps manage
|
||||
many concurrent fuzzer instances.
|
||||
|
||||
Note, afl sometimes requires system configuration, if you find AFL quitting prematurely, try manually
|
||||
launching it and addressing any error messages.
|
||||
|
||||
## Fuzz the parser
|
||||
```
|
||||
$ sh ./tools/afl/prepare_to_fuzz.sh
|
||||
export NFUZZ=1
|
||||
$ export NFUZZ=1
|
||||
$ sh ./tools/afl/fuzz.sh parser
|
||||
Ctrl+C when done to close all fuzzer terminals.
|
||||
$ sh ./tools/afl/aggregate_cases.sh parser
|
||||
$ ls ./fuzz_out/parser_aggregated/
|
||||
```
|
||||
```
|
||||
|
||||
## Fuzz the unmarshaller
|
||||
```
|
||||
$ janet ./tools/afl/generate_unmarshal_testcases.janet
|
||||
$ sh ./tools/afl/prepare_to_fuzz.sh
|
||||
$ export NFUZZ=1
|
||||
$ sh ./tools/afl/fuzz.sh unmarshal
|
||||
Ctrl+C when done to close all fuzzer terminals.
|
||||
$ sh ./tools/afl/aggregate_cases.sh unmarshal
|
||||
$ ls ./fuzz_out/unmarshal_aggregated/
|
||||
```
|
||||
|
||||
49
tools/afl/generate_unmarshal_testcases.janet
Normal file
49
tools/afl/generate_unmarshal_testcases.janet
Normal file
@@ -0,0 +1,49 @@
|
||||
|
||||
(os/mkdir "./tools/afl/unmarshal_testcases/")
|
||||
|
||||
(defn spit-case [n v]
|
||||
(spit
|
||||
(string "./tools/afl/unmarshal_testcases/" (string n))
|
||||
(marshal v make-image-dict)))
|
||||
|
||||
(def cases [
|
||||
nil
|
||||
|
||||
"abc"
|
||||
|
||||
:def
|
||||
|
||||
'hij
|
||||
|
||||
123
|
||||
|
||||
(int/s64 123)
|
||||
|
||||
"7"
|
||||
|
||||
[1 2 3]
|
||||
|
||||
@[1 2 3]
|
||||
|
||||
{:a 123}
|
||||
|
||||
@{:b 'xyz}
|
||||
|
||||
(peg/compile
|
||||
'{:a (* "a" :b "a")
|
||||
:b (* "b" (+ :a 0) "b")
|
||||
:main (* "(" :b ")")})
|
||||
|
||||
(fn f [a] (fn [] {:ab a}))
|
||||
|
||||
(fn f [a] (print "hello world!"))
|
||||
|
||||
(do
|
||||
(defn f [a] (yield) @[1 "2"])
|
||||
(def fb (fiber/new f))
|
||||
(resume fb)
|
||||
fb)
|
||||
])
|
||||
|
||||
(eachk i cases
|
||||
(spit-case i (in cases i)))
|
||||
6
tools/afl/unmarshal_runner.janet
Normal file
6
tools/afl/unmarshal_runner.janet
Normal file
@@ -0,0 +1,6 @@
|
||||
# Unmarshal garbage.
|
||||
(def v (unmarshal (slurp ((dyn :args) 1)) load-image-dict))
|
||||
# Trigger leaks or use after free.
|
||||
(gccollect)
|
||||
# Attempt to use generated value.
|
||||
(marshal v make-image-dict)
|
||||
@@ -308,7 +308,7 @@
|
||||
<array>
|
||||
<dict>
|
||||
<key>match</key>
|
||||
<string>(\\[nevr0zft"\\']|\\x[0-9a-fA-F][0-9a-fA-f])</string>
|
||||
<string>(\\[nevr0zft"\\']|\\x[0-9a-fA-F]{2}|\\u[0-9a-fA-F]{4}|\\U[0-9a-fA-F]{6})</string>
|
||||
<key>name</key>
|
||||
<string>constant.character.escape.janet</string>
|
||||
</dict>
|
||||
|
||||
Reference in New Issue
Block a user