mirror of
https://github.com/janet-lang/janet
synced 2025-10-28 22:27:41 +00:00
Compare commits
160 Commits
repl-compl
...
v1.8.1
| Author | SHA1 | Date | |
|---|---|---|---|
|
|
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 | ||
|
|
f7ee8bd30d | ||
|
|
1bdde9c4f7 | ||
|
|
333ae7c4f8 | ||
|
|
f7b7c83264 | ||
|
|
6f9c9879ca | ||
|
|
b8df47e063 | ||
|
|
9dad8bf56d | ||
|
|
689f2dcbb4 | ||
|
|
163e2a5b22 | ||
|
|
e36334e14b | ||
|
|
60304c7e27 | ||
|
|
28d41039b8 | ||
|
|
b8d530da36 | ||
|
|
4fad0714e7 | ||
|
|
ca17eb4a2b | ||
|
|
4fe005e3c3 | ||
|
|
2f9ed8a572 | ||
|
|
688e18a891 | ||
|
|
8162c64ca3 | ||
|
|
e179f26d50 | ||
|
|
8db68c04c4 | ||
|
|
7c92c64730 | ||
|
|
01c6ffe1d5 | ||
|
|
46f57f5c38 | ||
|
|
1ec2e08f21 | ||
|
|
77742dec11 | ||
|
|
3cb947b37e | ||
|
|
62cf407f0c | ||
|
|
bbed72f39f | ||
|
|
99c94a78d6 | ||
|
|
2dd852da54 | ||
|
|
3c87d89df3 | ||
|
|
f4ad627b54 | ||
|
|
68a5667a1a | ||
|
|
693c6d63d4 | ||
|
|
f18c3323ea | ||
|
|
f74e19e673 | ||
|
|
da70807292 | ||
|
|
9f8bc6bb8a | ||
|
|
64b9482602 | ||
|
|
8fbcae6029 | ||
|
|
064475cb8d | ||
|
|
f4077b678a | ||
|
|
51678c1aba | ||
|
|
17a2fdbf1b | ||
|
|
65d7c3eed1 | ||
|
|
41bb8c543b | ||
|
|
bbd7355313 | ||
|
|
772916593b | ||
|
|
9d8af7355f | ||
|
|
521a29446f | ||
|
|
344f0b743d |
@@ -1,11 +0,0 @@
|
||||
image: freebsd/latest
|
||||
packages:
|
||||
- gmake
|
||||
tasks:
|
||||
- build: |
|
||||
cd janet
|
||||
gmake
|
||||
gmake test
|
||||
sudo gmake install
|
||||
gmake test-install
|
||||
gmake test-amalg
|
||||
@@ -1,11 +0,0 @@
|
||||
image: openbsd/6.5
|
||||
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
|
||||
|
||||
42
CHANGELOG.md
42
CHANGELOG.md
@@ -1,7 +1,36 @@
|
||||
# Changelog
|
||||
All notable changes to this project will be documented in this file.
|
||||
|
||||
### Unreleased
|
||||
## 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.
|
||||
- Let abstract types define a hash function and comparison/equality semantics. This lets
|
||||
@@ -9,20 +38,29 @@ All notable changes to this project will be documented in this file.
|
||||
will generate warnings when compiled against other versions.
|
||||
- Remove Emscripten build. Instead, use the amalgamated source code with a custom toolchain.
|
||||
- Update documentation.
|
||||
- Add `var-`
|
||||
- Add `module/add-paths`
|
||||
- Add `file/temp`
|
||||
- Add `mod` function to core.
|
||||
- Small bug fixes
|
||||
- Allow signaling from C functions (yielding) via janet\_signalv. This
|
||||
makes it easy to write C functions that work with event loops, such as
|
||||
in libuv or embedded in a game.
|
||||
- Add '%j' formatting option to the format family of functions.
|
||||
- Add `defer`
|
||||
- Add `assert`
|
||||
- Add `when-with`
|
||||
- Add `if-with`
|
||||
- Add completion to the default repl based on currently defined bindings. Also generally improve
|
||||
the repl keybindings.
|
||||
- Add `eachk`
|
||||
- Add `eachp`
|
||||
- Improve functionality of the `next` function. `next` now works on many different
|
||||
types, not just tables and structs. This allows for more generic data processing.
|
||||
- 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`.
|
||||
|
||||
164
Makefile
164
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
|
||||
@@ -37,9 +37,8 @@ MANPATH?=$(PREFIX)/share/man/man1/
|
||||
PKG_CONFIG_PATH?=$(LIBDIR)/pkgconfig
|
||||
DEBUGGER=gdb
|
||||
|
||||
CFLAGS=-std=c99 -Wall -Wextra -Isrc/include -Isrc/conf -fPIC -O2 -fvisibility=hidden -march=native \
|
||||
-DJANET_BUILD=$(JANET_BUILD)
|
||||
LDFLAGS=-rdynamic
|
||||
CFLAGS:=$(CFLAGS) -std=c99 -Wall -Wextra -Isrc/include -Isrc/conf -fPIC -O2 -fvisibility=hidden
|
||||
LDFLAGS:=$(LDFLAGS) -rdynamic
|
||||
|
||||
# For installation
|
||||
LDCONFIG:=ldconfig "$(LIBDIR)"
|
||||
@@ -48,13 +47,13 @@ LDCONFIG:=ldconfig "$(LIBDIR)"
|
||||
UNAME:=$(shell uname -s)
|
||||
ifeq ($(UNAME), Darwin)
|
||||
CLIBS:=$(CLIBS) -ldl
|
||||
LDCONFIG:=
|
||||
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
|
||||
|
||||
@@ -124,83 +123,31 @@ JANET_BOOT_SOURCES=src/boot/array_test.c \
|
||||
src/boot/table_test.c
|
||||
JANET_BOOT_HEADERS=src/boot/tests.h
|
||||
|
||||
JANET_MAINCLIENT_SOURCES=src/mainclient/line.c src/mainclient/main.c
|
||||
JANET_MAINCLIENT_HEADERS=src/mainclient/line.h
|
||||
##########################################################
|
||||
##### The bootstrap interpreter that creates janet.c #####
|
||||
##########################################################
|
||||
|
||||
JANET_WEBCLIENT_SOURCES=src/webclient/main.c
|
||||
|
||||
##################################################################
|
||||
##### The bootstrap interpreter that compiles the core image #####
|
||||
##################################################################
|
||||
|
||||
JANET_BOOT_OBJECTS=$(patsubst src/%.c,build/%.boot.o,$(JANET_CORE_SOURCES) $(JANET_BOOT_SOURCES)) \
|
||||
build/boot.gen.o
|
||||
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 $@ $^ $(CLIBS)
|
||||
$(CC) $(BOOT_CFLAGS) -o $@ $(JANET_BOOT_OBJECTS) $(CLIBS)
|
||||
|
||||
# Now the reason we bootstrap in the first place
|
||||
build/core_image.c: build/janet_boot
|
||||
build/janet_boot $@ JANET_PATH '$(JANET_PATH)' JANET_HEADERPATH '$(INCLUDEDIR)/janet'
|
||||
|
||||
##########################################################
|
||||
##### The main interpreter program and shared object #####
|
||||
##########################################################
|
||||
|
||||
JANET_CORE_OBJECTS=$(patsubst src/%.c,build/%.o,$(JANET_CORE_SOURCES)) build/core_image.o
|
||||
JANET_MAINCLIENT_OBJECTS=$(patsubst src/%.c,build/%.o,$(JANET_MAINCLIENT_SOURCES))
|
||||
|
||||
$(JANET_MAINCLIENT_OBJECTS): $(JANET_MAINCLIENT_HEADERS)
|
||||
|
||||
# Compile the core image generated by the bootstrap build
|
||||
build/core_image.o: build/core_image.c $(JANET_HEADERS) $(JANET_LOCAL_HEADERS)
|
||||
$(CC) $(CFLAGS) -o $@ -c $<
|
||||
|
||||
build/%.o: src/%.c $(JANET_HEADERS) $(JANET_LOCAL_HEADERS)
|
||||
$(CC) $(CFLAGS) -o $@ -c $<
|
||||
|
||||
$(JANET_TARGET): $(JANET_CORE_OBJECTS) $(JANET_MAINCLIENT_OBJECTS)
|
||||
$(CC) $(LDFLAGS) $(CFLAGS) -o $@ $^ $(CLIBS)
|
||||
|
||||
$(JANET_LIBRARY): $(JANET_CORE_OBJECTS)
|
||||
$(CC) $(LDFLAGS) $(CFLAGS) -shared -o $@ $^ $(CLIBS)
|
||||
|
||||
$(JANET_STATIC_LIBRARY): $(JANET_CORE_OBJECTS)
|
||||
$(AR) rcs $@ $^
|
||||
|
||||
#############################
|
||||
##### Generated C files #####
|
||||
#############################
|
||||
|
||||
%.gen.o: %.gen.c
|
||||
$(CC) $(CFLAGS) -o $@ -c $<
|
||||
|
||||
build/xxd: tools/xxd.c
|
||||
$(CC) $< -o $@
|
||||
|
||||
build/webinit.gen.c: src/webclient/webinit.janet build/xxd
|
||||
build/xxd $< $@ janet_gen_webinit
|
||||
build/boot.gen.c: src/boot/boot.janet build/xxd
|
||||
build/xxd $< $@ janet_gen_boot
|
||||
build/janet.c: build/janet_boot src/boot/boot.janet
|
||||
build/janet_boot . JANET_PATH '$(JANET_PATH)' JANET_HEADERPATH '$(INCLUDEDIR)/janet' > $@
|
||||
|
||||
########################
|
||||
##### Amalgamation #####
|
||||
########################
|
||||
|
||||
amalg: build/shell.c build/janet.c build/janet.h build/core_image.c build/janetconf.h
|
||||
|
||||
AMALG_SOURCE=$(JANET_LOCAL_HEADERS) $(JANET_CORE_SOURCES) build/core_image.c
|
||||
build/janet.c: $(AMALG_SOURCE) tools/amalg.janet $(JANET_TARGET)
|
||||
$(JANET_TARGET) tools/amalg.janet $(AMALG_SOURCE) > $@
|
||||
|
||||
AMALG_SHELL_SOURCE=src/mainclient/line.h src/mainclient/line.c src/mainclient/main.c
|
||||
build/shell.c: $(JANET_TARGET) tools/amalg.janet $(AMALG_SHELL_SOURCE)
|
||||
$(JANET_TARGET) tools/amalg.janet $(AMALG_SHELL_SOURCE) > $@
|
||||
build/shell.c: src/mainclient/shell.c
|
||||
cp $< $@
|
||||
|
||||
build/janet.h: src/include/janet.h
|
||||
cp $< $@
|
||||
@@ -208,6 +155,21 @@ build/janet.h: src/include/janet.h
|
||||
build/janetconf.h: src/conf/janetconf.h
|
||||
cp $< $@
|
||||
|
||||
build/janet.o: build/janet.c build/janet.h build/janetconf.h
|
||||
$(CC) $(CFLAGS) -c $< -o $@ -I build
|
||||
|
||||
build/shell.o: build/shell.c build/janet.h build/janetconf.h
|
||||
$(CC) $(CFLAGS) -c $< -o $@ -I build
|
||||
|
||||
$(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)
|
||||
|
||||
$(JANET_STATIC_LIBRARY): build/janet.o build/shell.o
|
||||
$(AR) rcs $@ $^
|
||||
|
||||
###################
|
||||
##### Testing #####
|
||||
###################
|
||||
@@ -268,7 +230,7 @@ build/doc.html: $(JANET_TARGET) tools/gendoc.janet
|
||||
|
||||
SONAME=libjanet.so.1
|
||||
|
||||
.PHONY: build/janet.pc
|
||||
.INTERMEDIATE: build/janet.pc
|
||||
build/janet.pc: $(JANET_TARGET)
|
||||
echo 'prefix=$(PREFIX)' > $@
|
||||
echo 'exec_prefix=$${prefix}' >> $@
|
||||
@@ -284,33 +246,33 @@ build/janet.pc: $(JANET_TARGET)
|
||||
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 #####
|
||||
@@ -339,15 +301,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 amalg \
|
||||
.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.
|
||||
|
||||
@@ -30,7 +30,7 @@ install:
|
||||
- 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.6.1
|
||||
- if "%janet_outname%"=="" set janet_outname=v1.8.1
|
||||
build: off
|
||||
|
||||
artifacts:
|
||||
|
||||
110
auxbin/jpm
110
auxbin/jpm
@@ -131,7 +131,6 @@
|
||||
["/nologo" "/MD"]
|
||||
["-std=c99" "-Wall" "-Wextra"]))
|
||||
|
||||
|
||||
# Link to pthreads
|
||||
(def- thread-flags (if is-win [] (if threads? ["-lpthread"] [])))
|
||||
|
||||
@@ -195,7 +194,8 @@
|
||||
(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)))
|
||||
(when-let [rules (env :rules)] (merge-into (getrules) rules))
|
||||
env)
|
||||
|
||||
#
|
||||
# OS and shell helpers
|
||||
@@ -252,11 +252,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
|
||||
@@ -555,6 +551,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."
|
||||
@@ -564,7 +569,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."
|
||||
@@ -576,17 +581,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"
|
||||
@@ -608,7 +610,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
|
||||
@@ -653,7 +655,7 @@ int main(int argc, const char **argv) {
|
||||
(os/execute ["git" "reset" "--hard" tag] :p))
|
||||
(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)))
|
||||
@@ -670,6 +672,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.janet")
|
||||
(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 p)
|
||||
(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.janet")
|
||||
(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,10 +798,11 @@ int main(int argc, const char **argv) {
|
||||
file is evaluated and a main function is looked for in the entry file. This function
|
||||
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}]
|
||||
[&keys {:install install :name name :entry entry :headers headers
|
||||
:cflags cflags :lflags lflags}]
|
||||
(def name (if is-win (string name ".exe") name))
|
||||
(def dest (string "build" sep name))
|
||||
(create-executable @{} entry dest)
|
||||
(create-executable @{:cflags cflags :lflags lflags} entry dest)
|
||||
(add-dep "build" dest)
|
||||
(when headers
|
||||
(each h headers (add-dep dest h)))
|
||||
@@ -814,7 +860,15 @@ int main(int argc, const char **argv) {
|
||||
(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"))
|
||||
@@ -888,6 +942,12 @@ Subcommands are:
|
||||
rules : list rules available with run.
|
||||
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.janet.
|
||||
load-lockfile (lockfile) : Install modules from a lockfile in a reproducible way. The
|
||||
default lockfile name is lockfile.janet.
|
||||
|
||||
Keys are:
|
||||
--modpath : The directory to install modules to. Defaults to $JANET_MODPATH, $JANET_PATH, or (dyn :syspath)
|
||||
@@ -974,6 +1034,8 @@ Flags are:
|
||||
"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))
|
||||
|
||||
@@ -33,20 +33,6 @@ mkdir build\core
|
||||
mkdir build\mainclient
|
||||
mkdir build\boot
|
||||
|
||||
@rem Build the xxd tool for generating sources
|
||||
cl /nologo /c tools/xxd.c /Fobuild\xxd.obj
|
||||
@if errorlevel 1 goto :BUILDFAIL
|
||||
link /nologo /out:build\xxd.exe build\xxd.obj
|
||||
@if errorlevel 1 goto :BUILDFAIL
|
||||
|
||||
@rem Generate the embedded sources
|
||||
build\xxd.exe src\boot\boot.janet build\boot.gen.c janet_gen_boot
|
||||
@if errorlevel 1 goto :BUILDFAIL
|
||||
|
||||
@rem Build the generated sources
|
||||
%JANET_COMPILE% /Fobuild\boot\boot.gen.obj build\boot.gen.c
|
||||
@if errorlevel 1 goto :BUILDFAIL
|
||||
|
||||
@rem Build the bootstrap interpreter
|
||||
for %%f in (src\core\*.c) do (
|
||||
%JANET_COMPILE% /DJANET_BOOTSTRAP /Fobuild\boot\%%~nf.obj %%f
|
||||
@@ -58,48 +44,25 @@ for %%f in (src\boot\*.c) do (
|
||||
)
|
||||
%JANET_LINK% /out:build\janet_boot.exe build\boot\*.obj
|
||||
@if errorlevel 1 goto :BUILDFAIL
|
||||
build\janet_boot build\core_image.c
|
||||
|
||||
@rem Build the core image
|
||||
%JANET_COMPILE% /Fobuild\core_image.obj build\core_image.c
|
||||
@if errorlevel 1 goto :BUILDFAIL
|
||||
build\janet_boot . > build\janet.c
|
||||
|
||||
@rem Build the sources
|
||||
for %%f in (src\core\*.c) do (
|
||||
%JANET_COMPILE% /Fobuild\core\%%~nf.obj %%f
|
||||
@if errorlevel 1 goto :BUILDFAIL
|
||||
)
|
||||
%JANET_COMPILE% /Fobuild\janet.obj build\janet.c
|
||||
@if errorlevel 1 goto :BUILDFAIL
|
||||
%JANET_COMPILE% /Fobuild\shell.obj src\mainclient\shell.c
|
||||
@if errorlevel 1 goto :BUILDFAIL
|
||||
|
||||
@rem Build the resources
|
||||
rc /nologo /fobuild\janet_win.res janet_win.rc
|
||||
|
||||
@rem Build the main client
|
||||
for %%f in (src\mainclient\*.c) do (
|
||||
%JANET_COMPILE% /Fobuild\mainclient\%%~nf.obj %%f
|
||||
@if errorlevel 1 goto :BUILDFAIL
|
||||
)
|
||||
|
||||
@rem Link everything to main client
|
||||
%JANET_LINK% /out:janet.exe build\core\*.obj build\mainclient\*.obj build\core_image.obj build\janet_win.res
|
||||
%JANET_LINK% /out:janet.exe build\janet.obj build\shell.obj build\janet_win.res
|
||||
@if errorlevel 1 goto :BUILDFAIL
|
||||
|
||||
@rem Build static library (libjanet.a)
|
||||
%JANET_LINK_STATIC% /out:build\libjanet.lib build\core\*.obj build\core_image.obj
|
||||
%JANET_LINK_STATIC% /out:build\libjanet.lib build\janet.obj
|
||||
@if errorlevel 1 goto :BUILDFAIL
|
||||
|
||||
@rem Gen amlag
|
||||
setlocal enabledelayedexpansion
|
||||
set "amalg_files="
|
||||
for %%f in (src\core\*.c) do (
|
||||
set "amalg_files=!amalg_files! %%f"
|
||||
)
|
||||
janet.exe tools\amalg.janet src\core\features.h src\core\util.h src\core\state.h src\core\gc.h src\core\vector.h src\core\fiber.h src\core\regalloc.h src\core\compile.h src\core\emit.h src\core\symcache.h %amalg_files% build\core_image.c > build\janet.c
|
||||
janet.exe tools\removecr.janet build\janet.c
|
||||
|
||||
@rem Gen shell.c
|
||||
janet.exe tools\amalg.janet src\mainclient\line.h src\mainclient\line.c src\mainclient\main.c > build\shell.c
|
||||
janet.exe tools\removecr.janet build\shell.c
|
||||
|
||||
echo === Successfully built janet.exe for Windows ===
|
||||
echo === Run 'build_win test' to run tests. ==
|
||||
echo === Run 'build_win clean' to delete build artifacts. ===
|
||||
@@ -141,7 +104,7 @@ janet.exe tools\gendoc.janet > dist\doc.html
|
||||
janet.exe tools\removecr.janet dist\doc.html
|
||||
|
||||
copy build\janet.c dist\janet.c
|
||||
copy build\shell.c dist\shell.c
|
||||
copy src\mainclient\shell.c dist\shell.c
|
||||
copy janet.exe dist\janet.exe
|
||||
copy LICENSE dist\LICENSE
|
||||
copy README.md dist\README.md
|
||||
|
||||
104
janet.1
104
janet.1
@@ -9,8 +9,8 @@ janet \- run the Janet language abstract machine
|
||||
[\fB\-m\fR \fIPATH\fR]
|
||||
[\fB\-c\fR \fIMODULE JIMAGE\fR]
|
||||
[\fB\-\-\fR]
|
||||
.IR script
|
||||
.IR args ...
|
||||
.BR script
|
||||
.BR args ...
|
||||
.SH DESCRIPTION
|
||||
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
|
||||
@@ -25,6 +25,106 @@ Implemented in mostly standard C99, Janet runs on Windows, Linux and macOS.
|
||||
The few features that are not standard C99 (dynamic library loading, compiler
|
||||
specific optimizations), are fairly straight forward. Janet can be easily ported to
|
||||
most new platforms.
|
||||
|
||||
.SH REPL KEY-BINDINGS
|
||||
|
||||
.TP 16
|
||||
.BR Home
|
||||
Move cursor to the beginning of input line.
|
||||
|
||||
.TP 16
|
||||
.BR End
|
||||
Move cursor to the end of input line.
|
||||
|
||||
.TP 16
|
||||
.BR Left/Right
|
||||
Move cursor in input line.
|
||||
|
||||
.TP 16
|
||||
.BR Up/Down
|
||||
Go backwards and forwards through history.
|
||||
|
||||
.TP 16
|
||||
.BR Tab
|
||||
Complete current symbol, or show available completions.
|
||||
|
||||
.TP 16
|
||||
.BR Delete
|
||||
Delete one character after the cursor.
|
||||
|
||||
.TP 16
|
||||
.BR Backspace
|
||||
Delete one character before the cursor.
|
||||
|
||||
.TP 16
|
||||
.BR Ctrl\-A
|
||||
Move cursor to the beginning of input line.
|
||||
|
||||
.TP 16
|
||||
.BR Ctrl\-B
|
||||
Move cursor one character to the left.
|
||||
|
||||
.TP 16
|
||||
.BR Ctrl\-E
|
||||
Move cursor to the end of input line.
|
||||
|
||||
.TP 16
|
||||
.BR Ctrl\-F
|
||||
Move cursor one character to the right.
|
||||
|
||||
.TP 16
|
||||
.BR Ctrl\-H
|
||||
Delete one character before the cursor.
|
||||
|
||||
.TP 16
|
||||
.BR Ctrl\-K
|
||||
Delete everything after the cursor on the input line.
|
||||
|
||||
.TP 16
|
||||
.BR Ctrl\-L
|
||||
Clear the screen.
|
||||
|
||||
.TP 16
|
||||
.BR Ctrl\-N/Ctrl\-P
|
||||
Go forwards and backwards through history.
|
||||
|
||||
.TP 16
|
||||
.BR Ctrl\-U
|
||||
Delete everything before the cursor on the input line.
|
||||
|
||||
.TP 16
|
||||
.BR Ctrl\-W
|
||||
Delete one word before the cursor.
|
||||
|
||||
.TP 16
|
||||
.BR Alt\-B/Alt\-F
|
||||
Move cursor backwards and forwards one word.
|
||||
|
||||
.TP 16
|
||||
.BR Alt\-D
|
||||
Delete one word after the cursor.
|
||||
|
||||
.TP 16
|
||||
.BR Alt\-,
|
||||
Go to earliest item in history.
|
||||
|
||||
.TP 16
|
||||
.BR Alt\-.
|
||||
Go to last item in history.
|
||||
|
||||
.LP
|
||||
|
||||
The repl keybindings are loosely based on a subset of GNU readline, although
|
||||
Janet does not use GNU readline internally for the repl. It is a limited
|
||||
substitute for GNU readline, and does not handle
|
||||
utf-8 input or other mutlibyte input well.
|
||||
|
||||
To disable the built-in repl input handling, pass the \fB\-s\fR option to Janet, and
|
||||
use a program like rlwrap with Janet to provide input.
|
||||
|
||||
For key bindings that operate on words, a word is considered to be a sequence
|
||||
of characters that does not contain whitespace.
|
||||
|
||||
.SH DOCUMENTATION
|
||||
|
||||
For more complete API documentation, run a REPL (Read Eval Print Loop), and use the doc macro to
|
||||
|
||||
59
meson.build
59
meson.build
@@ -20,7 +20,7 @@
|
||||
|
||||
project('janet', 'c',
|
||||
default_options : ['c_std=c99', 'b_lundef=false', 'default_library=both'],
|
||||
version : '1.6.1-dev')
|
||||
version : '1.8.1')
|
||||
|
||||
# Global settings
|
||||
janet_path = join_paths(get_option('prefix'), get_option('libdir'), 'janet')
|
||||
@@ -79,13 +79,6 @@ jconf = configure_file(output : 'janetconf.h',
|
||||
# Include directories
|
||||
incdir = include_directories(['src/include', '.'])
|
||||
|
||||
# Building generated sources
|
||||
xxd = executable('xxd', 'tools/xxd.c', native : true)
|
||||
gen = generator(xxd,
|
||||
output : '@BASENAME@.gen.c',
|
||||
arguments : ['@INPUT@', '@OUTPUT@', '@EXTRA_ARGS@'])
|
||||
boot_gen = gen.process('src/boot/boot.janet', extra_args: 'janet_gen_boot')
|
||||
|
||||
# Order is important here, as some headers
|
||||
# depend on other headers for the amalg target
|
||||
core_headers = [
|
||||
@@ -151,24 +144,27 @@ boot_src = [
|
||||
]
|
||||
|
||||
mainclient_src = [
|
||||
'src/mainclient/line.c',
|
||||
'src/mainclient/main.c'
|
||||
'src/mainclient/shell.c'
|
||||
]
|
||||
|
||||
# Build boot binary
|
||||
janet_boot = executable('janet-boot', core_src, boot_src, boot_gen,
|
||||
janet_boot = executable('janet-boot', core_src, boot_src,
|
||||
include_directories : incdir,
|
||||
c_args : '-DJANET_BOOTSTRAP',
|
||||
dependencies : [m_dep, dl_dep, thread_dep],
|
||||
native : true)
|
||||
|
||||
# Build core image
|
||||
core_image = custom_target('core_image',
|
||||
# Build janet.c
|
||||
janetc = custom_target('janetc',
|
||||
input : [janet_boot],
|
||||
output : 'core_image.gen.c',
|
||||
command : [janet_boot, '@OUTPUT@', 'JANET_PATH', janet_path, 'JANET_HEADERPATH', header_path])
|
||||
output : 'janet.c',
|
||||
capture : true,
|
||||
command : [
|
||||
janet_boot, meson.current_source_dir(),
|
||||
'JANET_PATH', janet_path, 'JANET_HEADERPATH', header_path
|
||||
])
|
||||
|
||||
libjanet = library('janet', core_src, core_image,
|
||||
libjanet = library('janet', janetc,
|
||||
include_directories : incdir,
|
||||
dependencies : [m_dep, dl_dep, thread_dep],
|
||||
install : true)
|
||||
@@ -188,14 +184,14 @@ else
|
||||
extra_cross_cflags = []
|
||||
endif
|
||||
|
||||
janet_mainclient = executable('janet', core_src, core_image, mainclient_src,
|
||||
janet_mainclient = executable('janet', janetc, mainclient_src,
|
||||
include_directories : incdir,
|
||||
dependencies : [m_dep, dl_dep, thread_dep],
|
||||
c_args : extra_native_cflags,
|
||||
install : true)
|
||||
|
||||
if meson.is_cross_build()
|
||||
janet_nativeclient = executable('janet-native', core_src, core_image, mainclient_src,
|
||||
janet_nativeclient = executable('janet-native', janetc, mainclient_src,
|
||||
include_directories : incdir,
|
||||
dependencies : [m_dep, dl_dep, thread_dep],
|
||||
c_args : extra_cross_cflags,
|
||||
@@ -211,25 +207,6 @@ docs = custom_target('docs',
|
||||
capture : true,
|
||||
command : [janet_nativeclient, '@INPUT@'])
|
||||
|
||||
# Amalgamated source
|
||||
amalg = custom_target('amalg',
|
||||
input : ['tools/amalg.janet', core_headers, core_src, core_image],
|
||||
output : ['janet.c'],
|
||||
capture : true,
|
||||
command : [janet_nativeclient, '@INPUT@'])
|
||||
amalg_shell = custom_target('amalg-shell',
|
||||
input : ['tools/amalg.janet', 'src/mainclient/line.h',
|
||||
'src/mainclient/line.c', 'src/mainclient/main.c'],
|
||||
output : ['shell.c'],
|
||||
capture : true,
|
||||
command : [janet_nativeclient, '@INPUT@'])
|
||||
|
||||
# Amalgamated client
|
||||
janet_amalgclient = executable('janet-amalg', amalg, amalg_shell,
|
||||
include_directories : incdir,
|
||||
dependencies : [m_dep, dl_dep, thread_dep],
|
||||
build_by_default : false)
|
||||
|
||||
# Tests
|
||||
test_files = [
|
||||
'test/suite0.janet',
|
||||
@@ -239,7 +216,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())
|
||||
@@ -252,6 +230,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')
|
||||
|
||||
@@ -23,6 +23,13 @@
|
||||
#include <janet.h>
|
||||
#include "tests.h"
|
||||
|
||||
#ifdef JANET_WINDOWS
|
||||
#include <direct.h>
|
||||
#define chdir(x) _chdir(x)
|
||||
#else
|
||||
#include <unistd.h>
|
||||
#endif
|
||||
|
||||
extern const unsigned char *janet_gen_boot;
|
||||
extern int32_t janet_gen_boot_size;
|
||||
|
||||
@@ -63,13 +70,42 @@ int main(int argc, const char **argv) {
|
||||
janet_def(env, "boot/config", janet_wrap_table(opts), "Boot options");
|
||||
|
||||
/* Run bootstrap script to generate core image */
|
||||
const char *boot_file;
|
||||
const char *boot_filename;
|
||||
#ifdef JANET_NO_SOURCEMAPS
|
||||
boot_file = NULL;
|
||||
boot_filename = NULL;
|
||||
#else
|
||||
boot_file = "boot.janet";
|
||||
boot_filename = "boot.janet";
|
||||
#endif
|
||||
status = janet_dobytes(env, janet_gen_boot, janet_gen_boot_size, boot_file, NULL);
|
||||
|
||||
int chdir_status = chdir(argv[1]);
|
||||
if (chdir_status) {
|
||||
fprintf(stderr, "Could not change to directory %s\n", argv[1]);
|
||||
exit(1);
|
||||
}
|
||||
|
||||
FILE *boot_file = fopen("src/boot/boot.janet", "rb");
|
||||
if (NULL == boot_file) {
|
||||
fprintf(stderr, "Could not open src/boot/boot.janet\n");
|
||||
exit(1);
|
||||
}
|
||||
|
||||
/* Slurp file into buffer */
|
||||
fseek(boot_file, 0, SEEK_END);
|
||||
size_t boot_size = ftell(boot_file);
|
||||
fseek(boot_file, 0, SEEK_SET);
|
||||
unsigned char *boot_buffer = malloc(boot_size);
|
||||
if (NULL == boot_buffer) {
|
||||
fprintf(stderr, "Failed to allocate boot buffer\n");
|
||||
exit(1);
|
||||
}
|
||||
if (!fread(boot_buffer, 1, boot_size, boot_file)) {
|
||||
fprintf(stderr, "Failed to read into boot buffer\n");
|
||||
exit(1);
|
||||
}
|
||||
fclose(boot_file);
|
||||
|
||||
status = janet_dobytes(env, boot_buffer, (int32_t) boot_size, boot_filename, NULL);
|
||||
free(boot_buffer);
|
||||
|
||||
/* Deinitialize vm */
|
||||
janet_deinit();
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
# The core janet library
|
||||
# Copyright 2019 © Calvin Rose
|
||||
# Copyright 2020 © Calvin Rose
|
||||
|
||||
###
|
||||
###
|
||||
@@ -58,6 +58,11 @@
|
||||
[name & more]
|
||||
~(def ,name :private ,;more))
|
||||
|
||||
(defmacro var-
|
||||
"Define a private var that will not be exported."
|
||||
[name & more]
|
||||
~(var ,name :private ,;more))
|
||||
|
||||
(defn defglobal
|
||||
"Dynamically create a global def."
|
||||
[name value]
|
||||
@@ -74,8 +79,8 @@
|
||||
|
||||
# Basic predicates
|
||||
(defn nan? "Check if x is NaN" [x] (not= x x))
|
||||
(defn even? "Check if x is even." [x] (= 0 (% x 2)))
|
||||
(defn odd? "Check if x is odd." [x] (not= 0 (% x 2)))
|
||||
(defn even? "Check if x is even." [x] (= 0 (mod x 2)))
|
||||
(defn odd? "Check if x is odd." [x] (= 1 (mod x 2)))
|
||||
(defn zero? "Check if x is zero." [x] (= x 0))
|
||||
(defn pos? "Check if x is greater than 0." [x] (> x 0))
|
||||
(defn neg? "Check if x is less than 0." [x] (< x 0))
|
||||
@@ -239,26 +244,30 @@
|
||||
[(,not= :error (,fiber/status ,f)) ,r])))
|
||||
|
||||
(defmacro and
|
||||
"Evaluates to the last argument if all preceding elements are true, otherwise
|
||||
evaluates to false."
|
||||
"Evaluates to the last argument if all preceding elements are truthy, otherwise
|
||||
evaluates to the first falsey argument."
|
||||
[& forms]
|
||||
(var ret true)
|
||||
(def len (length forms))
|
||||
(var i len)
|
||||
(while (> i 0)
|
||||
(-- i)
|
||||
(def v (in forms i))
|
||||
(set ret (if (= ret true)
|
||||
(in forms i)
|
||||
(tuple 'if (in forms i) ret))))
|
||||
v
|
||||
(if (idempotent? v)
|
||||
['if v ret v]
|
||||
(do (def s (gensym))
|
||||
['if ['def s v] ret s])))))
|
||||
ret)
|
||||
|
||||
(defmacro or
|
||||
"Evaluates to the last argument if all preceding elements are false, otherwise
|
||||
evaluates to true."
|
||||
"Evaluates to the last argument if all preceding elements are falsey, otherwise
|
||||
evaluates to the first truthy element."
|
||||
[& forms]
|
||||
(var ret nil)
|
||||
(def len (length forms))
|
||||
(var i len)
|
||||
(var i (- len 1))
|
||||
(var ret (in forms i))
|
||||
(while (> i 0)
|
||||
(-- i)
|
||||
(def fi (in forms i))
|
||||
@@ -282,17 +291,51 @@
|
||||
~(let (,;accum) ,;body))
|
||||
|
||||
(defmacro defer
|
||||
"Run form unconditionally after form, even if the body throws an error."
|
||||
"Run form unconditionally after body, even if the body throws an error.
|
||||
Will also run form if a user signal 0-4 is received."
|
||||
[form & body]
|
||||
(with-syms [f r]
|
||||
~(do
|
||||
(def ,f (,fiber/new (fn [] ,;body) :ie))
|
||||
(def ,f (,fiber/new (fn [] ,;body) :ti))
|
||||
(def ,r (,resume ,f))
|
||||
,form
|
||||
(if (= (,fiber/status ,f) :dead)
|
||||
,r
|
||||
(propagate ,r ,f)))))
|
||||
|
||||
(defmacro prompt
|
||||
"Set up a checkpoint that can be returned to. Tag should be a value
|
||||
that is used in a return statement, like a keyword."
|
||||
[tag & body]
|
||||
(with-syms [res target payload fib]
|
||||
~(do
|
||||
(def ,fib (,fiber/new (fn [] [,tag (do ,;body)]) :i0))
|
||||
(def ,res (,resume ,fib))
|
||||
(def [,target ,payload] ,res)
|
||||
(if (,= ,tag ,target)
|
||||
,payload
|
||||
(propagate ,res ,fib)))))
|
||||
|
||||
(defmacro chr
|
||||
"Convert a string of length 1 to its byte (ascii) value at compile time."
|
||||
[c]
|
||||
(unless (and (string? c) (= (length c) 1))
|
||||
(error (string/format "expected string of length 1, got %v" c)))
|
||||
(c 0))
|
||||
|
||||
(defmacro label
|
||||
"Set a label point that is lexically scoped. Name should be a symbol
|
||||
that will be bound to the label."
|
||||
[name & body]
|
||||
~(do
|
||||
(def ,name @"")
|
||||
,(apply prompt name body)))
|
||||
|
||||
(defn return
|
||||
"Return to a prompt point."
|
||||
[to &opt value]
|
||||
(signal 0 [to value]))
|
||||
|
||||
(defmacro with
|
||||
"Evaluate body with some resource, which will be automatically cleaned up
|
||||
if there is an error in body. binding is bound to the expression ctor, and
|
||||
@@ -301,16 +344,14 @@
|
||||
[[binding ctor dtor] & body]
|
||||
~(do
|
||||
(def ,binding ,ctor)
|
||||
(defer (,(or dtor :close) ,binding)
|
||||
,;body)))
|
||||
,(apply defer [(or dtor :close) binding] body)))
|
||||
|
||||
(defmacro when-with
|
||||
"Similar to with, but if binding is false or nil, returns
|
||||
nil without evaluating the body. Otherwise, the same as with."
|
||||
[[binding ctor dtor] & body]
|
||||
~(if-let [,binding ,ctor]
|
||||
(defer (,(or dtor :close) ,binding)
|
||||
,;body)))
|
||||
,(apply defer [(or dtor :close) binding] body)))
|
||||
|
||||
(defmacro if-with
|
||||
"Similar to with, but if binding is false or nil, evaluates
|
||||
@@ -318,7 +359,7 @@
|
||||
ctor is bound to binding."
|
||||
[[binding ctor dtor] truthy &opt falsey ]
|
||||
~(if-let [,binding ,ctor]
|
||||
(defer (,(or dtor :close) ,binding) ,truthy)
|
||||
,(apply defer [(or dtor :close) binding] [truthy])
|
||||
,falsey))
|
||||
|
||||
(defn- for-template
|
||||
@@ -332,18 +373,27 @@
|
||||
,;body
|
||||
(set ,i (,delta ,i ,step))))))
|
||||
|
||||
(defn- check-indexed [x]
|
||||
(if (indexed? x)
|
||||
x
|
||||
(error (string "expected tuple for range, got " x))))
|
||||
|
||||
(defn- range-template
|
||||
[binding object rest op comparison]
|
||||
(let [[start stop step] (check-indexed object)]
|
||||
(for-template binding start stop (or step 1) comparison op [rest])))
|
||||
|
||||
(defn- each-template
|
||||
[binding in body]
|
||||
(with-syms [i len]
|
||||
(def ds (if (idempotent? in) in (gensym)))
|
||||
[binding inx body]
|
||||
(with-syms [k]
|
||||
(def ds (if (idempotent? inx) inx (gensym)))
|
||||
~(do
|
||||
(var ,i 0)
|
||||
,(unless (= ds in) ~(def ,ds ,in))
|
||||
(def ,len (,length ,ds))
|
||||
(while (,< ,i ,len)
|
||||
(def ,binding (in ,ds ,i))
|
||||
,(unless (= ds inx) ~(def ,ds ,inx))
|
||||
(var ,k (,next ,ds nil))
|
||||
(while (,not= nil ,k)
|
||||
(def ,binding (,in ,ds ,k))
|
||||
,;body
|
||||
(++ ,i)))))
|
||||
(set ,k (,next ,ds ,k))))))
|
||||
|
||||
(defn- keys-template
|
||||
[binding in pair? body]
|
||||
@@ -352,7 +402,7 @@
|
||||
~(do
|
||||
,(unless (= ds in) ~(def ,ds ,in))
|
||||
(var ,k (,next ,ds nil))
|
||||
(while ,k
|
||||
(while (,not= nil ,k)
|
||||
(def ,binding ,(if pair? ~(tuple ,k (in ,ds ,k)) k))
|
||||
,;body
|
||||
(set ,k (,next ,ds ,k))))))
|
||||
@@ -366,11 +416,6 @@
|
||||
(def ,binding ,i)
|
||||
,body))))
|
||||
|
||||
(defn- check-indexed [x]
|
||||
(if (indexed? x)
|
||||
x
|
||||
(error (string "expected tuple for range, got " x))))
|
||||
|
||||
(defn- loop1
|
||||
[body head i]
|
||||
|
||||
@@ -400,12 +445,12 @@
|
||||
(def {(+ i 2) object} head)
|
||||
(let [rest (loop1 body head (+ i 3))]
|
||||
(case verb
|
||||
:range (let [[start stop step] (check-indexed object)]
|
||||
(for-template binding start stop (or step 1) < + [rest]))
|
||||
:range (range-template binding object rest + <)
|
||||
:range-to (range-template binding object rest + <=)
|
||||
:down (range-template binding object rest - >)
|
||||
:down-to (range-template binding object rest - >=)
|
||||
:keys (keys-template binding object false [rest])
|
||||
:pairs (keys-template binding object true [rest])
|
||||
:down (let [[start stop step] (check-indexed object)]
|
||||
(for-template binding start stop (or step 1) > - [rest]))
|
||||
:in (each-template binding object [rest])
|
||||
:iterate (iterate-template binding object rest)
|
||||
:generate (with-syms [f s]
|
||||
@@ -421,10 +466,20 @@
|
||||
[i start stop & body]
|
||||
(for-template i start stop 1 < + body))
|
||||
|
||||
(defmacro eachk
|
||||
"loop over each key in ds. returns nil."
|
||||
[x ds & body]
|
||||
(keys-template x ds false body))
|
||||
|
||||
(defmacro eachp
|
||||
"Loop over each (key, value) pair in ds. Returns nil."
|
||||
[x ds & body]
|
||||
(keys-template x ds true body))
|
||||
|
||||
(defmacro each
|
||||
"Loop over each value in ind. Returns nil."
|
||||
[x ind & body]
|
||||
(each-template x ind body))
|
||||
"Loop over each value in ds. Returns nil."
|
||||
[x ds & body]
|
||||
(each-template x ds body))
|
||||
|
||||
(defmacro loop
|
||||
"A general purpose loop macro. This macro is similar to the Common Lisp
|
||||
@@ -438,11 +493,14 @@
|
||||
\t:iterate - repeatedly evaluate and bind to the expression while it is truthy.\n
|
||||
\t:range - loop over a range. The object should be two element tuple with a start
|
||||
and end value, and an optional positive step. The range is half open, [start, end).\n
|
||||
\t:down - Same as range, but loops in reverse.\n
|
||||
\t:keys - Iterate over the keys in a data structure.\n
|
||||
\t:pairs - Iterate over the keys value pairs in a data structure.\n
|
||||
\t:in - Iterate over the values in an indexed data structure or byte sequence.\n
|
||||
\t:generate - Iterate over values yielded from a fiber. Can be paired with the generator
|
||||
\t:range-to - same as :range, but the range is inclusive [start, end].\n
|
||||
\t:down - loop over a range, stepping downwards. The object should be two element tuple
|
||||
with a start and (exclusive) end value, and an optional (positive!) step size.\n
|
||||
\t:down-to - same :as down, but the range is inclusive [start, end].\n
|
||||
\t:keys - iterate over the keys in a data structure.\n
|
||||
\t:pairs - iterate over the keys value pairs as tuples in a data structure.\n
|
||||
\t:in - iterate over the values in a data structure.\n
|
||||
\t:generate - iterate over values yielded from a fiber. Can be paired with the generator
|
||||
function for the producer/consumer pattern.\n\n
|
||||
loop also accepts conditionals to refine the looping further. Conditionals are of
|
||||
the form:\n\n
|
||||
@@ -466,6 +524,7 @@
|
||||
(put _env 'iterate-template nil)
|
||||
(put _env 'each-template nil)
|
||||
(put _env 'keys-template nil)
|
||||
(put _env 'range-template nil)
|
||||
|
||||
(defmacro seq
|
||||
"Similar to loop, but accumulates the loop body into an array and returns that.
|
||||
@@ -581,20 +640,10 @@
|
||||
"Returns the numeric minimum of the arguments."
|
||||
[& args] (extreme < args))
|
||||
|
||||
(defn max-order
|
||||
"Returns the maximum of the arguments according to a total
|
||||
order over all values."
|
||||
[& args] (extreme > args))
|
||||
|
||||
(defn min-order
|
||||
"Returns the minimum of the arguments according to a total
|
||||
order over all values."
|
||||
[& args] (extreme < args))
|
||||
|
||||
(defn first
|
||||
"Get the first element from an indexed data structure."
|
||||
[xs]
|
||||
(in xs 0))
|
||||
(get xs 0))
|
||||
|
||||
(defn last
|
||||
"Get the last element from an indexed data structure."
|
||||
@@ -650,6 +699,45 @@
|
||||
(each x ind (set res (f res x)))
|
||||
res)
|
||||
|
||||
(defn reduce2
|
||||
"The 2 argument version of reduce that does not take an initialization value.
|
||||
Instead the first element of the array is used for initialization."
|
||||
[f ind]
|
||||
(var k (next ind))
|
||||
(if (= nil k) (break nil))
|
||||
(var res (in ind k))
|
||||
(set k (next ind k))
|
||||
(while (not= nil k)
|
||||
(set res (f res (in ind k)))
|
||||
(set k (next ind k)))
|
||||
res)
|
||||
|
||||
(defn accumulate
|
||||
"Similar to reduce, but accumulates intermediate values into an array.
|
||||
The last element in the array is what would be the return value from reduce.
|
||||
The init value is not added to the array.
|
||||
Returns a new array."
|
||||
[f init ind]
|
||||
(var res init)
|
||||
(def ret (array/new (length ind)))
|
||||
(each x ind (array/push ret (set res (f res x))))
|
||||
ret)
|
||||
|
||||
(defn accumulate2
|
||||
"The 2 argument version of accumulate that does not take an initialization value."
|
||||
[f ind]
|
||||
(var k (next ind))
|
||||
(def ret (array/new (length ind)))
|
||||
(if (= nil k) (break ret))
|
||||
(var res (in ind k))
|
||||
(array/push ret res)
|
||||
(set k (next ind k))
|
||||
(while (not= nil k)
|
||||
(set res (f res (in ind k)))
|
||||
(array/push ret res)
|
||||
(set k (next ind k)))
|
||||
ret)
|
||||
|
||||
(defn map
|
||||
"Map a function over every element in an indexed data structure and
|
||||
return an array of the results."
|
||||
@@ -759,8 +847,10 @@
|
||||
[n ind]
|
||||
(def use-str (bytes? ind))
|
||||
(def f (if use-str string/slice tuple/slice))
|
||||
(def len (length ind))
|
||||
# make sure end is in [0, len]
|
||||
(def end (max 0 (min n (length ind))))
|
||||
(def m (if (> n 0) n 0))
|
||||
(def end (if (> m len) len m))
|
||||
(f ind 0 end))
|
||||
|
||||
(defn take-until
|
||||
@@ -784,8 +874,10 @@
|
||||
[n ind]
|
||||
(def use-str (bytes? ind))
|
||||
(def f (if use-str string/slice tuple/slice))
|
||||
(def len (length ind))
|
||||
# make sure start is in [0, len]
|
||||
(def start (max 0 (min n (length ind))))
|
||||
(def m (if (> n 0) n 0))
|
||||
(def start (if (> m len) len m))
|
||||
(f ind start -1))
|
||||
|
||||
(defn drop-until
|
||||
@@ -969,11 +1061,10 @@
|
||||
(with-syms [ret f s]
|
||||
~(do
|
||||
,;saveold
|
||||
(def ,f (,fiber/new (fn [] ,;setnew ,;body) :ei))
|
||||
(def ,f (,fiber/new (fn [] ,;setnew ,;body) :ti))
|
||||
(def ,ret (,resume ,f))
|
||||
,;restoreold
|
||||
(if (= (,fiber/status ,f) :error) (,propagate ,ret ,f))
|
||||
,ret)))
|
||||
(if (= (,fiber/status ,f) :dead) ,ret (,propagate ,ret ,f)))))
|
||||
|
||||
(defn partial
|
||||
"Partial function application."
|
||||
@@ -1244,9 +1335,10 @@
|
||||
nil)
|
||||
|
||||
(defn pp
|
||||
"Pretty print to stdout or (dyn :out)."
|
||||
`Pretty print to stdout or (dyn :out). The format string used is (dyn :pretty-format "%q").`
|
||||
[x]
|
||||
(print (buffer/format @"" (dyn :pretty-format "%q") x)))
|
||||
(printf (dyn :pretty-format "%q") x)
|
||||
(flush))
|
||||
|
||||
###
|
||||
###
|
||||
@@ -1279,12 +1371,15 @@
|
||||
[pattern expr onmatch seen]
|
||||
(cond
|
||||
|
||||
(= '_ pattern)
|
||||
(onmatch)
|
||||
|
||||
(symbol? pattern)
|
||||
(if (in seen pattern)
|
||||
~(if (= ,pattern ,expr) ,(onmatch) ,sentinel)
|
||||
(do
|
||||
(put seen pattern true)
|
||||
~(if (= nil (def ,pattern ,expr)) ,sentinel ,(onmatch))))
|
||||
~(do (def ,pattern ,expr) ,(onmatch))))
|
||||
|
||||
(and (tuple? pattern) (= :parens (tuple/type pattern)))
|
||||
(if (and (= (pattern 0) '@) (symbol? (pattern 1)))
|
||||
@@ -1301,12 +1396,14 @@
|
||||
(var i -1)
|
||||
(with-idemp
|
||||
$arr expr
|
||||
~(if (indexed? ,$arr)
|
||||
,((fn aux []
|
||||
(++ i)
|
||||
(if (= i len)
|
||||
(onmatch)
|
||||
(match-1 (in pattern i) (tuple in $arr i) aux seen))))
|
||||
~(if (,indexed? ,$arr)
|
||||
(if (< (,length ,$arr) ,len)
|
||||
,sentinel
|
||||
,((fn aux []
|
||||
(++ i)
|
||||
(if (= i len)
|
||||
(onmatch)
|
||||
(match-1 (in pattern i) (tuple in $arr i) aux seen)))))
|
||||
,sentinel)))
|
||||
|
||||
(dictionary? pattern)
|
||||
@@ -1314,26 +1411,29 @@
|
||||
(var key nil)
|
||||
(with-idemp
|
||||
$dict expr
|
||||
~(if (dictionary? ,$dict)
|
||||
~(if (,dictionary? ,$dict)
|
||||
,((fn aux []
|
||||
(set key (next pattern key))
|
||||
(def $val (gensym))
|
||||
(if (= key nil)
|
||||
(onmatch)
|
||||
(match-1 (in pattern key) (tuple in $dict key) aux seen))))
|
||||
~(do (def ,$val (,get ,$dict ,key))
|
||||
,(match-1 [(in pattern key) [not= nil $val]] $val aux seen)))))
|
||||
,sentinel)))
|
||||
|
||||
:else ~(if (= ,pattern ,expr) ,(onmatch) ,sentinel)))
|
||||
|
||||
(defmacro match
|
||||
"Pattern matching. Match an expression x against
|
||||
any number of cases. Easy case is a pattern to match against, followed
|
||||
any number of cases. Each case is a pattern to match against, followed
|
||||
by an expression to evaluate to if that case is matched. A pattern that is
|
||||
a symbol will match anything, binding x's value to that symbol. An array
|
||||
will match only if all of it's elements match the corresponding elements in
|
||||
x. A table or struct will match if all values match with the corresponding
|
||||
values in x. A tuple pattern will match if it's first element matches, and the following
|
||||
elements are treated as predicates and are true. Any other value pattern will only
|
||||
match if it is equal to x."
|
||||
elements are treated as predicates and are true. The last special case is
|
||||
the '_ symbol, which is a wildcard that will match any value without creating a binding.
|
||||
Any other value pattern will only match if it is equal to x."
|
||||
[x & cases]
|
||||
(with-idemp $x x
|
||||
(def len (length cases))
|
||||
@@ -1576,14 +1676,16 @@
|
||||
ret)
|
||||
|
||||
(defn all
|
||||
"Returns true if all xs are truthy, otherwise the first false or nil value."
|
||||
"Returns true if all xs are truthy, otherwise the resulty of first
|
||||
falsey predicate value, (pred x)."
|
||||
[pred xs]
|
||||
(var ret true)
|
||||
(loop [x :in xs :while ret] (set ret (pred x)))
|
||||
ret)
|
||||
|
||||
(defn some
|
||||
"Returns false if all xs are false or nil, otherwise returns the first true value."
|
||||
"Returns nil if all xs are false or nil, otherwise returns the result of the
|
||||
first truthy predicate, (pred x)."
|
||||
[pred xs]
|
||||
(var ret nil)
|
||||
(loop [x :in xs :while (not ret)] (if-let [y (pred x)] (set ret y)))
|
||||
@@ -1769,20 +1871,23 @@
|
||||
(string col)
|
||||
": "
|
||||
(parser/error p)
|
||||
(if ec "\e[0m" "")))
|
||||
(if ec "\e[0m" ""))
|
||||
(eflush))
|
||||
|
||||
(defn bad-compile
|
||||
"Default handler for a compile error."
|
||||
[msg macrof where]
|
||||
(def ec (dyn :err-color))
|
||||
(eprint
|
||||
(if ec "\e[31m" "")
|
||||
"compile error: "
|
||||
msg
|
||||
" while compiling "
|
||||
where
|
||||
(if ec "\e[0m" ""))
|
||||
(when macrof (debug/stacktrace macrof)))
|
||||
(if macrof
|
||||
(debug/stacktrace macrof (string msg " while compiling " where))
|
||||
(eprint
|
||||
(if ec "\e[31m" "")
|
||||
"compile error: "
|
||||
msg
|
||||
" while compiling "
|
||||
where
|
||||
(if ec "\e[0m" "")))
|
||||
(eflush))
|
||||
|
||||
(defn run-context
|
||||
"Run a context. This evaluates expressions of janet in an environment,
|
||||
@@ -1843,8 +1948,7 @@
|
||||
(on-compile-error msg errf where))))
|
||||
(or guard :a)))
|
||||
(fiber/setenv f env)
|
||||
(while (let [fs (fiber/status f)]
|
||||
(and (not= :dead fs) (not= :error fs)))
|
||||
(while (fiber/can-resume? f)
|
||||
(def res (resume f resumeval))
|
||||
(when good (when going (set resumeval (onstatus f res))))))
|
||||
|
||||
@@ -2079,7 +2183,7 @@
|
||||
:on-status (fn [f x]
|
||||
(when (not= (fiber/status f) :dead)
|
||||
(debug/stacktrace f x)
|
||||
(if exit-on-error (os/exit 1))))
|
||||
(if exit-on-error (os/exit 1) (eflush))))
|
||||
:evaluator evaluator
|
||||
:expander expander
|
||||
:source (if path-is-file "<anonymous>" spath)}))
|
||||
@@ -2108,7 +2212,7 @@
|
||||
(if-let [check (in module/cache fullpath)]
|
||||
check
|
||||
(do
|
||||
(def loader (module/loaders mod-kind))
|
||||
(def loader (if (keyword? mod-kind) (module/loaders mod-kind) mod-kind))
|
||||
(unless loader (error (string "module type " mod-kind " unknown")))
|
||||
(def env (loader fullpath args))
|
||||
(put module/cache fullpath env)
|
||||
@@ -2123,7 +2227,10 @@
|
||||
:prefix prefix
|
||||
:export ep} (table ;args))
|
||||
(def newenv (require path ;args))
|
||||
(def prefix (or (and as (string as "/")) prefix (string path "/")))
|
||||
(def prefix (or
|
||||
(and as (string as "/"))
|
||||
prefix
|
||||
(string (last (string/split "/" path)) "/")))
|
||||
(loop [[k v] :pairs newenv :when (symbol? k) :when (not (v :private))]
|
||||
(def newv (table/setproto @{:private (not ep)} v))
|
||||
(put env (symbol prefix k) newv)))
|
||||
@@ -2179,14 +2286,17 @@
|
||||
(put nextenv :debug-level level)
|
||||
(put nextenv :signal x)
|
||||
(debug/stacktrace f x)
|
||||
(eflush)
|
||||
(defn debugger-chunks [buf p]
|
||||
(def status (parser/state p :delimiters))
|
||||
(def c ((parser/where p) 0))
|
||||
(def prompt (string "debug[" level "]:" c ":" status "> "))
|
||||
(getline prompt buf nextenv))
|
||||
(print "entering debug[" level "] - (quit) to exit")
|
||||
(flush)
|
||||
(repl debugger-chunks (make-onsignal nextenv (+ 1 level)) nextenv)
|
||||
(print "exiting debug[" level "]")
|
||||
(flush)
|
||||
(nextenv :resume-value))
|
||||
|
||||
(fn [f x]
|
||||
@@ -2194,7 +2304,7 @@
|
||||
(do (pp x) (put e '_ @{:value x}))
|
||||
(if (e :debug)
|
||||
(enter-debugger f x)
|
||||
(do (debug/stacktrace f x) nil)))))
|
||||
(do (debug/stacktrace f x) (eflush))))))
|
||||
|
||||
(run-context {:env env
|
||||
:chunks chunks
|
||||
@@ -2207,6 +2317,29 @@
|
||||
###
|
||||
###
|
||||
|
||||
(defn- no-side-effects
|
||||
"Check if form may have side effects. If returns true, then the src
|
||||
must not have side effects, such as calling a C function."
|
||||
[src]
|
||||
(cond
|
||||
(tuple? src)
|
||||
(if (= (tuple/type src) :brackets)
|
||||
(all no-side-effects src))
|
||||
(array? src)
|
||||
(all no-side-effects src)
|
||||
(dictionary? src)
|
||||
(and (all no-side-effects (keys src))
|
||||
(all no-side-effects (values src)))
|
||||
true))
|
||||
|
||||
(defn- is-safe-def [x] (no-side-effects (last x)))
|
||||
|
||||
(def- safe-forms {'defn true 'defn- true 'defmacro true 'defmacro- true
|
||||
'def is-safe-def 'var is-safe-def 'def- is-safe-def 'var- is-safe-def
|
||||
'defglobal is-safe-def 'varglobal is-safe-def})
|
||||
|
||||
(def- importers {'import true 'import* true 'use true 'dofile true 'require true})
|
||||
|
||||
(defn cli-main
|
||||
"Entrance for the Janet CLI tool. Call this functions with the command line
|
||||
arguments as an array or tuple of strings to invoke the CLI interface."
|
||||
@@ -2274,15 +2407,21 @@
|
||||
(def h (in handlers n))
|
||||
(if h (h i) (do (print "unknown flag -" n) ((in handlers "h")))))
|
||||
|
||||
(def- safe-forms {'defn true 'defn- true 'defmacro true 'defmacro- true})
|
||||
(def- importers {'import true 'import* true 'use true 'dofile true 'require true})
|
||||
(defn- evaluator
|
||||
[thunk source env where]
|
||||
(if *compile-only*
|
||||
(when (tuple? source)
|
||||
(def head (source 0))
|
||||
(def safe-check (safe-forms head))
|
||||
(cond
|
||||
(safe-forms (source 0)) (thunk)
|
||||
(importers (source 0))
|
||||
# Sometimes safe form
|
||||
(function? safe-check)
|
||||
(if (safe-check source) (thunk))
|
||||
# Always safe form
|
||||
safe-check
|
||||
(thunk)
|
||||
# Import-like form
|
||||
(importers head)
|
||||
(do
|
||||
(let [[l c] (tuple/sourcemap source)
|
||||
newtup (tuple/setmap (tuple ;source :evaluator evaluator) l c)]
|
||||
@@ -2310,6 +2449,7 @@
|
||||
(when (and (not *compile-only*) (or *should-repl* *no-file*))
|
||||
(if-not *quiet*
|
||||
(print "Janet " janet/version "-" janet/build " Copyright (C) 2017-2020 Calvin Rose"))
|
||||
(flush)
|
||||
(defn noprompt [_] "")
|
||||
(defn getprompt [p]
|
||||
(def [line] (parser/where p))
|
||||
@@ -2328,6 +2468,11 @@
|
||||
(setdyn :err-color (if *colorize* true))
|
||||
(repl getchunk onsig env)))
|
||||
|
||||
(put _env 'no-side-effects nil)
|
||||
(put _env 'is-safe-def nil)
|
||||
(put _env 'safe-forms nil)
|
||||
(put _env 'importers nil)
|
||||
|
||||
|
||||
###
|
||||
###
|
||||
@@ -2381,21 +2526,92 @@
|
||||
reverse-lookup (invert lookup)]
|
||||
(marshal env reverse-lookup)))
|
||||
|
||||
# Create amalgamation
|
||||
|
||||
(def feature-header "src/core/features.h")
|
||||
|
||||
(def local-headers
|
||||
["src/core/util.h"
|
||||
"src/core/state.h"
|
||||
"src/core/gc.h"
|
||||
"src/core/vector.h"
|
||||
"src/core/fiber.h"
|
||||
"src/core/regalloc.h"
|
||||
"src/core/compile.h"
|
||||
"src/core/emit.h"
|
||||
"src/core/symcache.h"])
|
||||
|
||||
(def core-sources
|
||||
["src/core/abstract.c"
|
||||
"src/core/array.c"
|
||||
"src/core/asm.c"
|
||||
"src/core/buffer.c"
|
||||
"src/core/bytecode.c"
|
||||
"src/core/capi.c"
|
||||
"src/core/cfuns.c"
|
||||
"src/core/compile.c"
|
||||
"src/core/corelib.c"
|
||||
"src/core/debug.c"
|
||||
"src/core/emit.c"
|
||||
"src/core/fiber.c"
|
||||
"src/core/gc.c"
|
||||
"src/core/inttypes.c"
|
||||
"src/core/io.c"
|
||||
"src/core/marsh.c"
|
||||
"src/core/math.c"
|
||||
"src/core/os.c"
|
||||
"src/core/parse.c"
|
||||
"src/core/peg.c"
|
||||
"src/core/pp.c"
|
||||
"src/core/regalloc.c"
|
||||
"src/core/run.c"
|
||||
"src/core/specials.c"
|
||||
"src/core/string.c"
|
||||
"src/core/strtod.c"
|
||||
"src/core/struct.c"
|
||||
"src/core/symcache.c"
|
||||
"src/core/table.c"
|
||||
"src/core/thread.c"
|
||||
"src/core/tuple.c"
|
||||
"src/core/typedarray.c"
|
||||
"src/core/util.c"
|
||||
"src/core/value.c"
|
||||
"src/core/vector.c"
|
||||
"src/core/vm.c"
|
||||
"src/core/wrap.c"])
|
||||
|
||||
# Print janet.c to stdout
|
||||
(print "/* Amalgamated build - DO NOT EDIT */")
|
||||
(print "/* Generated from janet version " janet/version "-" janet/build " */")
|
||||
(print "#define JANET_BUILD \"" janet/build "\"")
|
||||
(print ```#define JANET_AMALG```)
|
||||
|
||||
(defn do-one-file
|
||||
[fname]
|
||||
(print "\n/* " fname " */")
|
||||
(print "#line 0 \"" fname "\"\n")
|
||||
(def source (slurp fname))
|
||||
(print (string/replace-all "\r" "" source)))
|
||||
|
||||
(do-one-file feature-header)
|
||||
|
||||
(print ```#include "janet.h"```)
|
||||
|
||||
(each h local-headers
|
||||
(do-one-file h))
|
||||
|
||||
(each s core-sources
|
||||
(do-one-file s))
|
||||
|
||||
# Create C source file that contains images a uint8_t buffer. This
|
||||
# can be compiled and linked statically into the main janet library
|
||||
# and example client.
|
||||
(def chunks (string/bytes image))
|
||||
(def image-file (file/open (boot/args 1) :wb))
|
||||
(file/write image-file
|
||||
"#ifndef JANET_AMALG\n"
|
||||
"#include <janet.h>\n"
|
||||
"#endif\n"
|
||||
"static const unsigned char janet_core_image_bytes[] = {\n")
|
||||
(loop [line :in (partition 10 chunks)]
|
||||
(def str (string ;(interpose ", " (map (partial string/format "0x%.2X") line))))
|
||||
(file/write image-file " " str ",\n"))
|
||||
(file/write image-file
|
||||
" 0\n};\n\n"
|
||||
"const unsigned char *janet_core_image = janet_core_image_bytes;\n"
|
||||
"size_t janet_core_image_size = sizeof(janet_core_image_bytes);\n")
|
||||
(file/close image-file))
|
||||
(print "static const unsigned char janet_core_image_bytes[] = {")
|
||||
(loop [line :in (partition 16 image)]
|
||||
(prin " ")
|
||||
(each b line
|
||||
(prinf "0x%.2X, " b))
|
||||
(print))
|
||||
(print " 0\n};\n")
|
||||
(print "const unsigned char *janet_core_image = janet_core_image_bytes;")
|
||||
(print "size_t janet_core_image_size = sizeof(janet_core_image_bytes);"))
|
||||
|
||||
@@ -27,10 +27,10 @@
|
||||
#define JANETCONF_H
|
||||
|
||||
#define JANET_VERSION_MAJOR 1
|
||||
#define JANET_VERSION_MINOR 6
|
||||
#define JANET_VERSION_MINOR 8
|
||||
#define JANET_VERSION_PATCH 1
|
||||
#define JANET_VERSION_EXTRA "-dev"
|
||||
#define JANET_VERSION "1.6.1-dev"
|
||||
#define JANET_VERSION_EXTRA ""
|
||||
#define JANET_VERSION "1.8.1"
|
||||
|
||||
/* #define JANET_BUILD "local" */
|
||||
|
||||
|
||||
@@ -56,7 +56,7 @@ JanetArray *janet_array_n(const Janet *elements, int32_t n) {
|
||||
if (!array->data) {
|
||||
JANET_OUT_OF_MEMORY;
|
||||
}
|
||||
memcpy(array->data, elements, sizeof(Janet) * n);
|
||||
safe_memcpy(array->data, elements, sizeof(Janet) * n);
|
||||
return array;
|
||||
}
|
||||
|
||||
@@ -235,10 +235,12 @@ static Janet cfun_array_insert(int32_t argc, Janet *argv) {
|
||||
janet_panic("array overflow");
|
||||
}
|
||||
janet_array_ensure(array, array->count + argc - 2, 2);
|
||||
memmove(array->data + at + argc - 2,
|
||||
array->data + at,
|
||||
restsize);
|
||||
memcpy(array->data + at, argv + 2, chunksize);
|
||||
if (restsize) {
|
||||
memmove(array->data + at + argc - 2,
|
||||
array->data + at,
|
||||
restsize);
|
||||
}
|
||||
safe_memcpy(array->data + at, argv + 2, chunksize);
|
||||
array->count += (argc - 2);
|
||||
return argv[0];
|
||||
}
|
||||
|
||||
@@ -87,6 +87,8 @@ static const JanetInstructionDef janet_ops[] = {
|
||||
{"in", JOP_IN},
|
||||
{"jmp", JOP_JUMP},
|
||||
{"jmpif", JOP_JUMP_IF},
|
||||
{"jmpni", JOP_JUMP_IF_NIL},
|
||||
{"jmpnn", JOP_JUMP_IF_NOT_NIL},
|
||||
{"jmpno", JOP_JUMP_IF_NOT},
|
||||
{"ldc", JOP_LOAD_CONSTANT},
|
||||
{"ldf", JOP_LOAD_FALSE},
|
||||
@@ -106,10 +108,12 @@ static const JanetInstructionDef janet_ops[] = {
|
||||
{"mkstu", JOP_MAKE_STRUCT},
|
||||
{"mktab", JOP_MAKE_TABLE},
|
||||
{"mktup", JOP_MAKE_TUPLE},
|
||||
{"mod", JOP_MODULO},
|
||||
{"movf", JOP_MOVE_FAR},
|
||||
{"movn", JOP_MOVE_NEAR},
|
||||
{"mul", JOP_MULTIPLY},
|
||||
{"mulim", JOP_MULTIPLY_IMMEDIATE},
|
||||
{"next", JOP_NEXT},
|
||||
{"noop", JOP_NOOP},
|
||||
{"prop", JOP_PROPAGATE},
|
||||
{"push", JOP_PUSH},
|
||||
@@ -118,6 +122,7 @@ static const JanetInstructionDef janet_ops[] = {
|
||||
{"pusha", JOP_PUSH_ARRAY},
|
||||
{"put", JOP_PUT},
|
||||
{"puti", JOP_PUT_INDEX},
|
||||
{"rem", JOP_REMAINDER},
|
||||
{"res", JOP_RESUME},
|
||||
{"ret", JOP_RETURN},
|
||||
{"retn", JOP_RETURN_NIL},
|
||||
|
||||
@@ -32,7 +32,7 @@
|
||||
JanetBuffer *janet_buffer_init(JanetBuffer *buffer, int32_t capacity) {
|
||||
uint8_t *data = NULL;
|
||||
if (capacity > 0) {
|
||||
janet_vm_next_collection += capacity;
|
||||
janet_gcpressure(capacity);
|
||||
data = malloc(sizeof(uint8_t) * (size_t) capacity);
|
||||
if (NULL == data) {
|
||||
JANET_OUT_OF_MEMORY;
|
||||
@@ -62,7 +62,7 @@ void janet_buffer_ensure(JanetBuffer *buffer, int32_t capacity, int32_t growth)
|
||||
if (capacity <= buffer->capacity) return;
|
||||
int64_t big_capacity = ((int64_t) capacity) * growth;
|
||||
capacity = big_capacity > INT32_MAX ? INT32_MAX : (int32_t) big_capacity;
|
||||
janet_vm_next_collection += capacity - buffer->capacity;
|
||||
janet_gcpressure(capacity - buffer->capacity);
|
||||
new_data = realloc(old, (size_t) capacity * sizeof(uint8_t));
|
||||
if (NULL == new_data) {
|
||||
JANET_OUT_OF_MEMORY;
|
||||
@@ -94,7 +94,7 @@ void janet_buffer_extra(JanetBuffer *buffer, int32_t n) {
|
||||
if (new_size > buffer->capacity) {
|
||||
int32_t new_capacity = new_size * 2;
|
||||
uint8_t *new_data = realloc(buffer->data, new_capacity * sizeof(uint8_t));
|
||||
janet_vm_next_collection += new_capacity - buffer->capacity;
|
||||
janet_gcpressure(new_capacity - buffer->capacity);
|
||||
if (NULL == new_data) {
|
||||
JANET_OUT_OF_MEMORY;
|
||||
}
|
||||
@@ -112,6 +112,7 @@ void janet_buffer_push_cstring(JanetBuffer *buffer, const char *cstring) {
|
||||
|
||||
/* Push multiple bytes into the buffer */
|
||||
void janet_buffer_push_bytes(JanetBuffer *buffer, const uint8_t *string, int32_t length) {
|
||||
if (0 == length) return;
|
||||
janet_buffer_extra(buffer, length);
|
||||
memcpy(buffer->data + buffer->count, string, length);
|
||||
buffer->count += length;
|
||||
@@ -333,16 +334,20 @@ 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;
|
||||
if (same_buf) {
|
||||
src.bytes = dest->data;
|
||||
memmove(dest->data + offset_dest, src.bytes + offset_src, length_src);
|
||||
} else {
|
||||
memcpy(dest->data + offset_dest, src.bytes + offset_src, length_src);
|
||||
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 {
|
||||
memcpy(dest->data + offset_dest, src.bytes + offset_src, length_src);
|
||||
}
|
||||
}
|
||||
return argv[0];
|
||||
}
|
||||
@@ -384,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.")
|
||||
},
|
||||
{
|
||||
@@ -435,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.")
|
||||
|
||||
@@ -41,6 +41,8 @@ enum JanetInstructionType janet_instructions[JOP_INSTRUCTION_COUNT] = {
|
||||
JINT_SSS, /* JOP_MULTIPLY, */
|
||||
JINT_SSI, /* JOP_DIVIDE_IMMEDIATE, */
|
||||
JINT_SSS, /* JOP_DIVIDE, */
|
||||
JINT_SSS, /* JOP_MODULO, */
|
||||
JINT_SSS, /* JOP_REMAINDER, */
|
||||
JINT_SSS, /* JOP_BAND, */
|
||||
JINT_SSS, /* JOP_BOR, */
|
||||
JINT_SSS, /* JOP_BXOR, */
|
||||
@@ -56,6 +58,8 @@ enum JanetInstructionType janet_instructions[JOP_INSTRUCTION_COUNT] = {
|
||||
JINT_L, /* JOP_JUMP, */
|
||||
JINT_SL, /* JOP_JUMP_IF, */
|
||||
JINT_SL, /* JOP_JUMP_IF_NOT, */
|
||||
JINT_SL, /* JOP_JUMP_IF_NIL, */
|
||||
JINT_SL, /* JOP_JUMP_IF_NOT_NIL, */
|
||||
JINT_SSS, /* JOP_GREATER_THAN, */
|
||||
JINT_SSI, /* JOP_GREATER_THAN_IMMEDIATE, */
|
||||
JINT_SSS, /* JOP_LESS_THAN, */
|
||||
@@ -95,7 +99,8 @@ enum JanetInstructionType janet_instructions[JOP_INSTRUCTION_COUNT] = {
|
||||
JINT_S, /* JOP_MAKE_TUPLE */
|
||||
JINT_S, /* JOP_MAKE_BRACKET_TUPLE */
|
||||
JINT_SSS, /* JOP_GREATER_THAN_EQUAL */
|
||||
JINT_SSS /* JOP_LESS_THAN_EQUAL */
|
||||
JINT_SSS, /* JOP_LESS_THAN_EQUAL */
|
||||
JINT_SSS, /* JOP_NEXT */
|
||||
};
|
||||
|
||||
/* Verify some bytecode */
|
||||
@@ -207,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;
|
||||
|
||||
@@ -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,
|
||||
@@ -112,6 +139,15 @@ static JanetSlot do_in(JanetFopts opts, JanetSlot *args) {
|
||||
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 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());
|
||||
}
|
||||
static JanetSlot do_remainder(JanetFopts opts, JanetSlot *args) {
|
||||
return opreduce(opts, args, JOP_REMAINDER, janet_wrap_nil());
|
||||
}
|
||||
static JanetSlot do_put(JanetFopts opts, JanetSlot *args) {
|
||||
if (opts.flags & JANET_FOPTS_DROP) {
|
||||
janetc_emit_sss(opts.compiler, JOP_PUT, args[0], args[1], args[2], 0);
|
||||
@@ -134,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 */
|
||||
@@ -261,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},
|
||||
@@ -283,7 +319,10 @@ static const JanetFunOptimizer optimizers[] = {
|
||||
{NULL, do_eq},
|
||||
{NULL, do_neq},
|
||||
{fixarity2, do_propagate},
|
||||
{fixarity2, do_get}
|
||||
{fixarity2, do_get},
|
||||
{arity1or2, do_next},
|
||||
{fixarity2, do_modulo},
|
||||
{fixarity2, do_remainder},
|
||||
};
|
||||
|
||||
const JanetFunOptimizer *janetc_funopt(uint32_t flags) {
|
||||
|
||||
@@ -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) {
|
||||
@@ -713,7 +721,7 @@ JanetFuncDef *janetc_pop_funcdef(JanetCompiler *c) {
|
||||
if (NULL == def->bytecode) {
|
||||
JANET_OUT_OF_MEMORY;
|
||||
}
|
||||
memcpy(def->bytecode, c->buffer + scope->bytecode_start, s);
|
||||
safe_memcpy(def->bytecode, c->buffer + scope->bytecode_start, s);
|
||||
janet_v__cnt(c->buffer) = scope->bytecode_start;
|
||||
if (NULL != c->mapbuffer && c->source) {
|
||||
size_t s = sizeof(JanetSourceMapping) * (size_t) def->bytecode_length;
|
||||
@@ -721,7 +729,7 @@ JanetFuncDef *janetc_pop_funcdef(JanetCompiler *c) {
|
||||
if (NULL == def->sourcemap) {
|
||||
JANET_OUT_OF_MEMORY;
|
||||
}
|
||||
memcpy(def->sourcemap, c->mapbuffer + scope->bytecode_start, s);
|
||||
safe_memcpy(def->sourcemap, c->mapbuffer + scope->bytecode_start, s);
|
||||
janet_v__cnt(c->mapbuffer) = scope->bytecode_start;
|
||||
}
|
||||
}
|
||||
@@ -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);
|
||||
|
||||
|
||||
@@ -57,6 +57,9 @@
|
||||
#define JANET_FUN_NEQ 25
|
||||
#define JANET_FUN_PROP 26
|
||||
#define JANET_FUN_GET 27
|
||||
#define JANET_FUN_NEXT 28
|
||||
#define JANET_FUN_MODULO 29
|
||||
#define JANET_FUN_REMAINDER 30
|
||||
|
||||
/* Compiler typedefs */
|
||||
typedef struct JanetCompiler JanetCompiler;
|
||||
@@ -124,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;
|
||||
|
||||
@@ -346,7 +346,7 @@ static Janet janet_core_tuple(int32_t argc, Janet *argv) {
|
||||
static Janet janet_core_array(int32_t argc, Janet *argv) {
|
||||
JanetArray *array = janet_array(argc);
|
||||
array->count = argc;
|
||||
memcpy(array->data, argv, argc * sizeof(Janet));
|
||||
safe_memcpy(array->data, argv, argc * sizeof(Janet));
|
||||
return janet_wrap_array(array);
|
||||
}
|
||||
|
||||
@@ -427,20 +427,6 @@ static Janet janet_core_type(int32_t argc, Janet *argv) {
|
||||
}
|
||||
}
|
||||
|
||||
static Janet janet_core_next(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 2);
|
||||
JanetDictView view = janet_getdictionary(argv, 0);
|
||||
const JanetKV *end = view.kvs + view.cap;
|
||||
const JanetKV *kv = janet_checktype(argv[1], JANET_NIL)
|
||||
? view.kvs
|
||||
: janet_dict_find(view.kvs, view.cap, argv[1]) + 1;
|
||||
while (kv < end) {
|
||||
if (!janet_checktype(kv->key, JANET_NIL)) return kv->key;
|
||||
kv++;
|
||||
}
|
||||
return janet_wrap_nil();
|
||||
}
|
||||
|
||||
static Janet janet_core_hash(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 1);
|
||||
return janet_wrap_number(janet_hash(argv[0]));
|
||||
@@ -503,6 +489,26 @@ 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;
|
||||
if (!janet_cstrcmp(kw, "error")) sig = JANET_SIGNAL_ERROR;
|
||||
if (!janet_cstrcmp(kw, "debug")) sig = JANET_SIGNAL_DEBUG;
|
||||
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,
|
||||
@@ -613,11 +619,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"
|
||||
@@ -628,16 +633,7 @@ static const JanetReg corelib_cfuns[] = {
|
||||
"\t:keyword\n"
|
||||
"\t:function\n"
|
||||
"\t:cfunction\n\n"
|
||||
"or another symbol for an abstract type.")
|
||||
},
|
||||
{
|
||||
"next", janet_core_next,
|
||||
JDOC("(next dict &opt key)\n\n"
|
||||
"Gets the next key in a struct or table. Can be used to iterate through "
|
||||
"the keys of a data structure in an unspecified order. Keys are guaranteed "
|
||||
"to be seen only once per iteration if they data structure is not mutated "
|
||||
"during iteration. If key is nil, next returns the first key. If next "
|
||||
"returns nil, there are no more keys to iterate through. ")
|
||||
"or another keyword for an abstract type.")
|
||||
},
|
||||
{
|
||||
"hash", janet_core_hash,
|
||||
@@ -648,8 +644,10 @@ static const JanetReg corelib_cfuns[] = {
|
||||
},
|
||||
{
|
||||
"getline", janet_core_getline,
|
||||
JDOC("(getline &opt prompt buf)\n\n"
|
||||
"Reads a line of input into a buffer, including the newline character, using a prompt. Returns the modified buffer. "
|
||||
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. "
|
||||
"Returns the modified buffer. "
|
||||
"Use this function to implement a simple interface for a terminal program.")
|
||||
},
|
||||
{
|
||||
@@ -701,6 +699,11 @@ static const JanetReg corelib_cfuns[] = {
|
||||
JDOC("(slice x &opt start end)\n\n"
|
||||
"Extract a sub-range of an indexed data strutrue or byte sequence.")
|
||||
},
|
||||
{
|
||||
"signal", janet_core_signal,
|
||||
JDOC("(signal what x)\n\n"
|
||||
"Raise a signal with payload x. ")
|
||||
},
|
||||
{NULL, NULL, NULL}
|
||||
};
|
||||
|
||||
@@ -948,6 +951,18 @@ static const uint32_t propagate_asm[] = {
|
||||
JOP_PROPAGATE | (1 << 24),
|
||||
JOP_RETURN
|
||||
};
|
||||
static const uint32_t next_asm[] = {
|
||||
JOP_NEXT | (1 << 24),
|
||||
JOP_RETURN
|
||||
};
|
||||
static const uint32_t modulo_asm[] = {
|
||||
JOP_MODULO | (1 << 24),
|
||||
JOP_RETURN
|
||||
};
|
||||
static const uint32_t remainder_asm[] = {
|
||||
JOP_REMAINDER | (1 << 24),
|
||||
JOP_RETURN
|
||||
};
|
||||
#endif /* ifdef JANET_BOOTSTRAP */
|
||||
|
||||
/*
|
||||
@@ -990,6 +1005,22 @@ static void janet_load_libs(JanetTable *env) {
|
||||
|
||||
JanetTable *janet_core_env(JanetTable *replacements) {
|
||||
JanetTable *env = (NULL != replacements) ? replacements : janet_table(0);
|
||||
janet_quick_asm(env, JANET_FUN_MODULO,
|
||||
"mod", 2, 2, 2, 2, modulo_asm, sizeof(modulo_asm),
|
||||
JDOC("(mod dividend divisor)\n\n"
|
||||
"Returns the modulo of dividend / divisor."));
|
||||
janet_quick_asm(env, JANET_FUN_REMAINDER,
|
||||
"%", 2, 2, 2, 2, remainder_asm, sizeof(remainder_asm),
|
||||
JDOC("(% dividend divisor)\n\n"
|
||||
"Returns the remainder of dividend / divisor."));
|
||||
janet_quick_asm(env, JANET_FUN_NEXT,
|
||||
"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 "
|
||||
"to be seen only once per iteration if they data structure is not mutated "
|
||||
"during iteration. If key is nil, next returns the first key. If next "
|
||||
"returns nil, there are no more keys to iterate through."));
|
||||
janet_quick_asm(env, JANET_FUN_PROP,
|
||||
"propagate", 2, 2, 2, 2, propagate_asm, sizeof(propagate_asm),
|
||||
JDOC("(propagate x fiber)\n\n"
|
||||
@@ -1095,22 +1126,22 @@ JanetTable *janet_core_env(JanetTable *replacements) {
|
||||
/* Variadic comparators */
|
||||
templatize_comparator(env, JANET_FUN_GT, ">", 0, JOP_GREATER_THAN,
|
||||
JDOC("(> & xs)\n\n"
|
||||
"Check if xs is in numerically descending order. Returns a boolean."));
|
||||
"Check if xs is in descending order. Returns a boolean."));
|
||||
templatize_comparator(env, JANET_FUN_LT, "<", 0, JOP_LESS_THAN,
|
||||
JDOC("(< & xs)\n\n"
|
||||
"Check if xs is in numerically ascending order. Returns a boolean."));
|
||||
"Check if xs is in ascending order. Returns a boolean."));
|
||||
templatize_comparator(env, JANET_FUN_GTE, ">=", 0, JOP_GREATER_THAN_EQUAL,
|
||||
JDOC("(>= & xs)\n\n"
|
||||
"Check if xs is in numerically non-ascending order. Returns a boolean."));
|
||||
"Check if xs is in non-ascending order. Returns a boolean."));
|
||||
templatize_comparator(env, JANET_FUN_LTE, "<=", 0, JOP_LESS_THAN_EQUAL,
|
||||
JDOC("(<= & xs)\n\n"
|
||||
"Check if xs is in numerically non-descending order. Returns a boolean."));
|
||||
"Check if xs is in non-descending order. Returns a boolean."));
|
||||
templatize_comparator(env, JANET_FUN_EQ, "=", 0, JOP_EQUALS,
|
||||
JDOC("(= & xs)\n\n"
|
||||
"Check if all values in xs are numerically equal (4.0 == 4). Returns a boolean."));
|
||||
"Check if all values in xs are equal. Returns a boolean."));
|
||||
templatize_comparator(env, JANET_FUN_NEQ, "not=", 1, JOP_EQUALS,
|
||||
JDOC("(not= & xs)\n\n"
|
||||
"Check if any values in xs are not numerically equal (3.0 not== 4). Returns a boolean."));
|
||||
"Check if any values in xs are not equal. Returns a boolean."));
|
||||
|
||||
/* Platform detection */
|
||||
janet_def(env, "janet/version", janet_cstringv(JANET_VERSION),
|
||||
|
||||
@@ -275,7 +275,7 @@ static Janet doframe(JanetStackFrame *frame) {
|
||||
}
|
||||
/* Add stack arguments */
|
||||
slots = janet_array(def->slotcount);
|
||||
memcpy(slots->data, stack, sizeof(Janet) * def->slotcount);
|
||||
safe_memcpy(slots->data, stack, sizeof(Janet) * def->slotcount);
|
||||
slots->count = def->slotcount;
|
||||
janet_table_put(t, janet_ckeywordv("slots"), janet_wrap_array(slots));
|
||||
}
|
||||
|
||||
@@ -29,4 +29,9 @@
|
||||
#define _POSIX_C_SOURCE 200112L
|
||||
#endif
|
||||
|
||||
/* Needed for realpath on linux */
|
||||
#if !defined(_XOPEN_SOURCE) && defined(__linux__)
|
||||
#define _XOPEN_SOURCE 500
|
||||
#endif
|
||||
|
||||
#endif
|
||||
|
||||
@@ -65,7 +65,14 @@ JanetFiber *janet_fiber_reset(JanetFiber *fiber, JanetFunction *callee, int32_t
|
||||
if (newstacktop >= fiber->capacity) {
|
||||
janet_fiber_setcapacity(fiber, 2 * newstacktop);
|
||||
}
|
||||
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;
|
||||
@@ -135,7 +142,7 @@ void janet_fiber_pushn(JanetFiber *fiber, const Janet *arr, int32_t n) {
|
||||
if (newtop > fiber->capacity) {
|
||||
janet_fiber_grow(fiber, newtop);
|
||||
}
|
||||
memcpy(fiber->data + fiber->stacktop, arr, n * sizeof(Janet));
|
||||
safe_memcpy(fiber->data + fiber->stacktop, arr, n * sizeof(Janet));
|
||||
fiber->stacktop = newtop;
|
||||
}
|
||||
|
||||
@@ -211,18 +218,50 @@ 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;
|
||||
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;
|
||||
}
|
||||
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;
|
||||
}
|
||||
}
|
||||
|
||||
/* 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 */
|
||||
if (env->offset) {
|
||||
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 +401,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);
|
||||
@@ -386,6 +425,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 +496,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 +525,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 +576,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,6 @@ 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);
|
||||
|
||||
#endif
|
||||
|
||||
@@ -27,8 +27,14 @@
|
||||
#include "symcache.h"
|
||||
#include "gc.h"
|
||||
#include "util.h"
|
||||
#include "fiber.h"
|
||||
#endif
|
||||
|
||||
struct JanetScratch {
|
||||
JanetScratchFinalizer finalize;
|
||||
long long mem[]; /* for proper alignment */
|
||||
};
|
||||
|
||||
/* GC State */
|
||||
JANET_THREAD_LOCAL void *janet_vm_blocks;
|
||||
JANET_THREAD_LOCAL size_t janet_vm_gc_interval;
|
||||
@@ -41,14 +47,7 @@ JANET_THREAD_LOCAL size_t janet_vm_root_count;
|
||||
JANET_THREAD_LOCAL size_t janet_vm_root_capacity;
|
||||
|
||||
/* Scratch Memory */
|
||||
#ifdef JANET_64
|
||||
#define SCRATCH_HDR_SIZE 16 /* smalloc must guarantee 16 byte alignment. */
|
||||
#elif JANET_32
|
||||
#define SCRATCH_HDR_SIZE 8 /* smalloc must guarantee 8 byte alignment. */
|
||||
#else
|
||||
#error "unknown scratch alignment"
|
||||
#endif
|
||||
JANET_THREAD_LOCAL void **janet_scratch_mem;
|
||||
JANET_THREAD_LOCAL JanetScratch **janet_scratch_mem;
|
||||
JANET_THREAD_LOCAL size_t janet_scratch_cap;
|
||||
JANET_THREAD_LOCAL size_t janet_scratch_len;
|
||||
|
||||
@@ -69,6 +68,11 @@ static void janet_mark_abstract(void *adata);
|
||||
static JANET_THREAD_LOCAL uint32_t depth = JANET_RECURSION_GUARD;
|
||||
static JANET_THREAD_LOCAL size_t orig_rootcount;
|
||||
|
||||
/* Hint to the GC that we may need to collect */
|
||||
void janet_gcpressure(size_t s) {
|
||||
janet_vm_next_collection += s;
|
||||
}
|
||||
|
||||
/* Mark a value */
|
||||
void janet_mark(Janet x) {
|
||||
if (depth) {
|
||||
@@ -186,6 +190,9 @@ static void janet_mark_funcenv(JanetFuncEnv *env) {
|
||||
if (janet_gc_reachable(env))
|
||||
return;
|
||||
janet_gc_mark(env);
|
||||
/* 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) {
|
||||
/* On stack */
|
||||
janet_mark_fiber(env->as.fiber);
|
||||
@@ -302,6 +309,7 @@ static void janet_deinit_block(JanetGCObject *mem) {
|
||||
free(def->constants);
|
||||
free(def->bytecode);
|
||||
free(def->sourcemap);
|
||||
free(def->closure_bitset);
|
||||
}
|
||||
break;
|
||||
}
|
||||
@@ -355,11 +363,11 @@ void *janet_gcalloc(enum JanetMemoryType type, size_t size) {
|
||||
return (void *)mem;
|
||||
}
|
||||
|
||||
static void free_one_scratch(void *mem) {
|
||||
ScratchFinalizer finalize = *(ScratchFinalizer *)mem;
|
||||
if (finalize)
|
||||
finalize((char *)mem + SCRATCH_HDR_SIZE);
|
||||
free(mem);
|
||||
static void free_one_scratch(JanetScratch *s) {
|
||||
if (NULL != s->finalize) {
|
||||
s->finalize((char *) s->mem);
|
||||
}
|
||||
free(s);
|
||||
}
|
||||
|
||||
/* Free all allocated scratch memory */
|
||||
@@ -370,6 +378,11 @@ static void janet_free_all_scratch(void) {
|
||||
janet_scratch_len = 0;
|
||||
}
|
||||
|
||||
static JanetScratch *janet_mem2scratch(void *mem) {
|
||||
JanetScratch *s = (JanetScratch *)mem;
|
||||
return s - 1;
|
||||
}
|
||||
|
||||
/* Run garbage collection */
|
||||
void janet_collect(void) {
|
||||
uint32_t i;
|
||||
@@ -473,26 +486,26 @@ void janet_gcunlock(int handle) {
|
||||
/* Scratch memory API */
|
||||
|
||||
void *janet_smalloc(size_t size) {
|
||||
void *mem = malloc(SCRATCH_HDR_SIZE + size);
|
||||
if (NULL == mem) {
|
||||
JanetScratch *s = malloc(sizeof(JanetScratch) + size);
|
||||
if (NULL == s) {
|
||||
JANET_OUT_OF_MEMORY;
|
||||
}
|
||||
*(ScratchFinalizer *)mem = NULL;
|
||||
s->finalize = NULL;
|
||||
if (janet_scratch_len == janet_scratch_cap) {
|
||||
size_t newcap = 2 * janet_scratch_cap + 2;
|
||||
void **newmem = (void **) realloc(janet_scratch_mem, newcap * sizeof(void *));
|
||||
JanetScratch **newmem = (JanetScratch **) realloc(janet_scratch_mem, newcap * sizeof(JanetScratch));
|
||||
if (NULL == newmem) {
|
||||
JANET_OUT_OF_MEMORY;
|
||||
}
|
||||
janet_scratch_cap = newcap;
|
||||
janet_scratch_mem = newmem;
|
||||
}
|
||||
janet_scratch_mem[janet_scratch_len++] = mem;
|
||||
return (char *)mem + SCRATCH_HDR_SIZE;
|
||||
janet_scratch_mem[janet_scratch_len++] = s;
|
||||
return (char *)(s->mem);
|
||||
}
|
||||
|
||||
void *janet_scalloc(size_t nmemb, size_t size) {
|
||||
if (nmemb && size > (size_t) -1 / size) {
|
||||
if (nmemb && size > SIZE_MAX / nmemb) {
|
||||
JANET_OUT_OF_MEMORY;
|
||||
}
|
||||
size_t n = nmemb * size;
|
||||
@@ -503,16 +516,16 @@ void *janet_scalloc(size_t nmemb, size_t size) {
|
||||
|
||||
void *janet_srealloc(void *mem, size_t size) {
|
||||
if (NULL == mem) return janet_smalloc(size);
|
||||
mem = (char *)mem - SCRATCH_HDR_SIZE;
|
||||
JanetScratch *s = janet_mem2scratch(mem);
|
||||
if (janet_scratch_len) {
|
||||
for (size_t i = janet_scratch_len - 1; ; i--) {
|
||||
if (janet_scratch_mem[i] == mem) {
|
||||
void *newmem = realloc(mem, size + SCRATCH_HDR_SIZE);
|
||||
if (NULL == newmem) {
|
||||
if (janet_scratch_mem[i] == s) {
|
||||
JanetScratch *news = realloc(s, size + sizeof(JanetScratch));
|
||||
if (NULL == news) {
|
||||
JANET_OUT_OF_MEMORY;
|
||||
}
|
||||
janet_scratch_mem[i] = newmem;
|
||||
return (char *)newmem + SCRATCH_HDR_SIZE;
|
||||
janet_scratch_mem[i] = news;
|
||||
return (char *)(news->mem);
|
||||
}
|
||||
if (i == 0) break;
|
||||
}
|
||||
@@ -520,19 +533,19 @@ void *janet_srealloc(void *mem, size_t size) {
|
||||
janet_exit("invalid janet_srealloc");
|
||||
}
|
||||
|
||||
void janet_sfinalizer(void *mem, ScratchFinalizer finalizer) {
|
||||
mem = (char *)mem - SCRATCH_HDR_SIZE;
|
||||
*(ScratchFinalizer *)mem = finalizer;
|
||||
void janet_sfinalizer(void *mem, JanetScratchFinalizer finalizer) {
|
||||
JanetScratch *s = janet_mem2scratch(mem);
|
||||
s->finalize = finalizer;
|
||||
}
|
||||
|
||||
void janet_sfree(void *mem) {
|
||||
if (NULL == mem) return;
|
||||
mem = (char *)mem - SCRATCH_HDR_SIZE;
|
||||
JanetScratch *s = janet_mem2scratch(mem);
|
||||
if (janet_scratch_len) {
|
||||
for (size_t i = janet_scratch_len - 1; ; i--) {
|
||||
if (janet_scratch_mem[i] == mem) {
|
||||
if (janet_scratch_mem[i] == s) {
|
||||
janet_scratch_mem[i] = janet_scratch_mem[--janet_scratch_len];
|
||||
free_one_scratch(mem);
|
||||
free_one_scratch(s);
|
||||
return;
|
||||
}
|
||||
if (i == 0) 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,
|
||||
@@ -91,10 +91,11 @@ static const JanetAbstractType it_s64_type = {
|
||||
int64_unmarshal,
|
||||
it_s64_tostring,
|
||||
janet_int64_compare,
|
||||
janet_int64_hash
|
||||
janet_int64_hash,
|
||||
JANET_ATEND_HASH
|
||||
};
|
||||
|
||||
static const JanetAbstractType it_u64_type = {
|
||||
const JanetAbstractType janet_u64_type = {
|
||||
"core/u64",
|
||||
NULL,
|
||||
NULL,
|
||||
@@ -104,7 +105,8 @@ static const JanetAbstractType it_u64_type = {
|
||||
int64_unmarshal,
|
||||
it_u64_tostring,
|
||||
janet_uint64_compare,
|
||||
janet_int64_hash
|
||||
janet_int64_hash,
|
||||
JANET_ATEND_HASH
|
||||
};
|
||||
|
||||
int64_t janet_unwrap_s64(Janet x) {
|
||||
@@ -126,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;
|
||||
}
|
||||
@@ -155,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;
|
||||
}
|
||||
@@ -168,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);
|
||||
}
|
||||
@@ -198,51 +200,52 @@ 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 (int i = 1; i < argc; i++) \
|
||||
for (int32_t i = 1; i < argc; i++) \
|
||||
*box oper##= janet_unwrap_##type(argv[i]); \
|
||||
return janet_wrap_abstract(box); \
|
||||
} \
|
||||
\
|
||||
static Janet cfun_it_##type##_##name##_mut(int32_t argc, Janet *argv) { \
|
||||
janet_arity(argc, 2, -1); \
|
||||
T *box = janet_getabstract(argv,0,&it_##type##_type); \
|
||||
for (int i = 1; i < argc; i++) \
|
||||
*box oper##= janet_unwrap_##type(argv[i]); \
|
||||
|
||||
#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(&janet_##type##_type, sizeof(T)); \
|
||||
*box = janet_unwrap_##type(argv[1]); \
|
||||
*box oper##= janet_unwrap_##type(argv[0]); \
|
||||
return janet_wrap_abstract(box); \
|
||||
}
|
||||
} \
|
||||
|
||||
#define DIVMETHOD(T, type, name, oper) \
|
||||
static Janet cfun_it_##type##_##name(int32_t argc, Janet *argv) { \
|
||||
janet_arity(argc, 2, -1); \
|
||||
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 (int i = 1; i < argc; i++) { \
|
||||
for (int32_t i = 1; i < argc; i++) { \
|
||||
T value = janet_unwrap_##type(argv[i]); \
|
||||
if (value == 0) janet_panic("division by zero"); \
|
||||
*box oper##= value; \
|
||||
} \
|
||||
return janet_wrap_abstract(box); \
|
||||
} \
|
||||
\
|
||||
static Janet cfun_it_##type##_##name##_mut(int32_t argc, Janet *argv) { \
|
||||
janet_arity(argc, 2, -1); \
|
||||
T *box = janet_getabstract(argv,0,&it_##type##_type); \
|
||||
for (int i = 1; i < argc; i++) { \
|
||||
T value = janet_unwrap_##type(argv[i]); \
|
||||
if (value == 0) janet_panic("division by zero"); \
|
||||
*box oper##= value; \
|
||||
} \
|
||||
|
||||
#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(&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"); \
|
||||
*box oper##= value; \
|
||||
return janet_wrap_abstract(box); \
|
||||
}
|
||||
} \
|
||||
|
||||
#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 (int i = 1; i < argc; i++) { \
|
||||
for (int32_t i = 1; i < argc; i++) { \
|
||||
T value = janet_unwrap_##type(argv[i]); \
|
||||
if (value == 0) janet_panic("division by zero"); \
|
||||
if ((value == -1) && (*box == INT64_MIN)) janet_panic("INT64_MIN divided by -1"); \
|
||||
@@ -250,18 +253,18 @@ static Janet cfun_it_##type##_##name(int32_t argc, Janet *argv) { \
|
||||
} \
|
||||
return janet_wrap_abstract(box); \
|
||||
} \
|
||||
\
|
||||
static Janet cfun_it_##type##_##name##_mut(int32_t argc, Janet *argv) { \
|
||||
janet_arity(argc, 2, -1); \
|
||||
T *box = janet_getabstract(argv,0,&it_##type##_type); \
|
||||
for (int i = 1; i < argc; i++) { \
|
||||
T value = janet_unwrap_##type(argv[i]); \
|
||||
if (value == 0) janet_panic("division by zero"); \
|
||||
if ((value == -1) && (*box == INT64_MIN)) janet_panic("INT64_MIN divided by -1"); \
|
||||
*box oper##= value; \
|
||||
} \
|
||||
|
||||
#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(&janet_##type##_type, sizeof(T)); \
|
||||
*box = janet_unwrap_##type(argv[1]); \
|
||||
T value = janet_unwrap_##type(argv[0]); \
|
||||
if (value == 0) janet_panic("division by zero"); \
|
||||
if ((value == -1) && (*box == INT64_MIN)) janet_panic("INT64_MIN divided by -1"); \
|
||||
*box oper##= value; \
|
||||
return janet_wrap_abstract(box); \
|
||||
}
|
||||
} \
|
||||
|
||||
#define COMPMETHOD(T, type, name, oper) \
|
||||
static Janet cfun_it_##type##_##name(int32_t argc, Janet *argv) { \
|
||||
@@ -271,11 +274,43 @@ static Janet cfun_it_##type##_##name(int32_t argc, Janet *argv) { \
|
||||
return janet_wrap_boolean(v1 oper v2); \
|
||||
}
|
||||
|
||||
static Janet cfun_it_s64_mod(int32_t argc, Janet *argv) {
|
||||
janet_arity(argc, 2, -1);
|
||||
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]);
|
||||
if (value == 0) janet_panic("division by zero");
|
||||
int64_t x = *box % value;
|
||||
if (x < 0) {
|
||||
x = (*box < 0) ? x - *box : x + *box;
|
||||
}
|
||||
*box = x;
|
||||
}
|
||||
return janet_wrap_abstract(box);
|
||||
}
|
||||
|
||||
static Janet cfun_it_s64_modi(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 2);
|
||||
int64_t *box = janet_abstract(&janet_s64_type, sizeof(int64_t));
|
||||
int64_t op1 = janet_unwrap_s64(argv[0]);
|
||||
int64_t op2 = janet_unwrap_s64(argv[1]);
|
||||
int64_t x = op1 % op2;
|
||||
if (x < 0) {
|
||||
x = (op1 < 0) ? x - op1 : x + op1;
|
||||
}
|
||||
*box = x;
|
||||
return janet_wrap_abstract(box);
|
||||
}
|
||||
|
||||
OPMETHOD(int64_t, s64, add, +)
|
||||
OPMETHOD(int64_t, s64, sub, -)
|
||||
OPMETHODINVERT(int64_t, s64, subi, -)
|
||||
OPMETHOD(int64_t, s64, mul, *)
|
||||
DIVMETHOD_SIGNED(int64_t, s64, div, /)
|
||||
DIVMETHOD_SIGNED(int64_t, s64, mod, %)
|
||||
DIVMETHOD_SIGNED(int64_t, s64, rem, %)
|
||||
DIVMETHODINVERT_SIGNED(int64_t, s64, divi, /)
|
||||
DIVMETHODINVERT_SIGNED(int64_t, s64, remi, %)
|
||||
OPMETHOD(int64_t, s64, and, &)
|
||||
OPMETHOD(int64_t, s64, or, |)
|
||||
OPMETHOD(int64_t, s64, xor, ^)
|
||||
@@ -290,9 +325,12 @@ COMPMETHOD(int64_t, s64, ne, !=)
|
||||
|
||||
OPMETHOD(uint64_t, u64, add, +)
|
||||
OPMETHOD(uint64_t, u64, sub, -)
|
||||
OPMETHODINVERT(uint64_t, u64, subi, -)
|
||||
OPMETHOD(uint64_t, u64, mul, *)
|
||||
DIVMETHOD(uint64_t, u64, div, /)
|
||||
DIVMETHOD(uint64_t, u64, mod, %)
|
||||
DIVMETHODINVERT(uint64_t, u64, divi, /)
|
||||
DIVMETHODINVERT(uint64_t, u64, modi, %)
|
||||
OPMETHOD(uint64_t, u64, and, &)
|
||||
OPMETHOD(uint64_t, u64, or, |)
|
||||
OPMETHOD(uint64_t, u64, xor, ^)
|
||||
@@ -312,10 +350,17 @@ COMPMETHOD(uint64_t, u64, ne, !=)
|
||||
|
||||
static JanetMethod it_s64_methods[] = {
|
||||
{"+", cfun_it_s64_add},
|
||||
{"r+", cfun_it_s64_add},
|
||||
{"-", cfun_it_s64_sub},
|
||||
{"r-", cfun_it_s64_subi},
|
||||
{"*", cfun_it_s64_mul},
|
||||
{"r*", cfun_it_s64_mul},
|
||||
{"/", cfun_it_s64_div},
|
||||
{"%", cfun_it_s64_mod},
|
||||
{"r/", cfun_it_s64_divi},
|
||||
{"mod", cfun_it_s64_mod},
|
||||
{"rmod", cfun_it_s64_modi},
|
||||
{"%", cfun_it_s64_rem},
|
||||
{"r%", cfun_it_s64_remi},
|
||||
{"<", cfun_it_s64_lt},
|
||||
{">", cfun_it_s64_gt},
|
||||
{"<=", cfun_it_s64_le},
|
||||
@@ -323,31 +368,30 @@ static JanetMethod it_s64_methods[] = {
|
||||
{"=", cfun_it_s64_eq},
|
||||
{"!=", cfun_it_s64_ne},
|
||||
{"&", cfun_it_s64_and},
|
||||
{"r&", cfun_it_s64_and},
|
||||
{"|", cfun_it_s64_or},
|
||||
{"r|", cfun_it_s64_or},
|
||||
{"^", cfun_it_s64_xor},
|
||||
{"r^", cfun_it_s64_xor},
|
||||
{"<<", cfun_it_s64_lshift},
|
||||
{">>", cfun_it_s64_rshift},
|
||||
|
||||
{"+!", cfun_it_s64_add_mut},
|
||||
{"-!", cfun_it_s64_sub_mut},
|
||||
{"*!", cfun_it_s64_mul_mut},
|
||||
{"/!", cfun_it_s64_div_mut},
|
||||
{"%!", cfun_it_s64_mod_mut},
|
||||
{"&!", cfun_it_s64_and_mut},
|
||||
{"|!", cfun_it_s64_or_mut},
|
||||
{"^!", cfun_it_s64_xor_mut},
|
||||
{"<<!", cfun_it_s64_lshift_mut},
|
||||
{">>!", cfun_it_s64_rshift_mut},
|
||||
|
||||
{NULL, NULL}
|
||||
};
|
||||
|
||||
static JanetMethod it_u64_methods[] = {
|
||||
{"+", cfun_it_u64_add},
|
||||
{"r+", cfun_it_u64_add},
|
||||
{"-", cfun_it_u64_sub},
|
||||
{"r-", cfun_it_u64_subi},
|
||||
{"*", cfun_it_u64_mul},
|
||||
{"r*", cfun_it_u64_mul},
|
||||
{"/", cfun_it_u64_div},
|
||||
{"r/", cfun_it_u64_divi},
|
||||
{"mod", cfun_it_u64_mod},
|
||||
{"rmod", cfun_it_u64_modi},
|
||||
{"%", cfun_it_u64_mod},
|
||||
{"r%", cfun_it_u64_modi},
|
||||
{"<", cfun_it_u64_lt},
|
||||
{">", cfun_it_u64_gt},
|
||||
{"<=", cfun_it_u64_le},
|
||||
@@ -355,22 +399,14 @@ static JanetMethod it_u64_methods[] = {
|
||||
{"=", cfun_it_u64_eq},
|
||||
{"!=", cfun_it_u64_ne},
|
||||
{"&", cfun_it_u64_and},
|
||||
{"r&", cfun_it_u64_and},
|
||||
{"|", cfun_it_u64_or},
|
||||
{"r|", cfun_it_u64_or},
|
||||
{"^", cfun_it_u64_xor},
|
||||
{"r^", cfun_it_u64_xor},
|
||||
{"<<", cfun_it_u64_lshift},
|
||||
{">>", cfun_it_u64_rshift},
|
||||
|
||||
{"+!", cfun_it_u64_add_mut},
|
||||
{"-!", cfun_it_u64_sub_mut},
|
||||
{"*!", cfun_it_u64_mul_mut},
|
||||
{"/!", cfun_it_u64_div_mut},
|
||||
{"%!", cfun_it_u64_mod_mut},
|
||||
{"&!", cfun_it_u64_and_mut},
|
||||
{"|!", cfun_it_u64_or_mut},
|
||||
{"^!", cfun_it_u64_xor_mut},
|
||||
{"<<!", cfun_it_u64_lshift_mut},
|
||||
{">>!", cfun_it_u64_rshift_mut},
|
||||
|
||||
{NULL, NULL}
|
||||
};
|
||||
|
||||
@@ -405,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
|
||||
|
||||
148
src/core/io.c
148
src/core/io.c
@@ -33,26 +33,15 @@
|
||||
#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,
|
||||
io_file_get,
|
||||
NULL,
|
||||
NULL,
|
||||
NULL,
|
||||
NULL,
|
||||
NULL,
|
||||
NULL
|
||||
JANET_ATEND_GET
|
||||
};
|
||||
|
||||
/* Check arguments to fopen */
|
||||
@@ -95,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);
|
||||
@@ -162,38 +151,8 @@ static Janet cfun_io_fopen(int32_t argc, Janet *argv) {
|
||||
return f ? makef(f, flags) : janet_wrap_nil();
|
||||
}
|
||||
|
||||
static Janet cfun_io_fdopen(int32_t argc, Janet *argv) {
|
||||
janet_arity(argc, 1, 2);
|
||||
const int fd = janet_getinteger(argv, 0);
|
||||
const uint8_t *fmode;
|
||||
int flags;
|
||||
if (argc == 2) {
|
||||
fmode = janet_getkeyword(argv, 1);
|
||||
flags = checkflags(fmode);
|
||||
} else {
|
||||
fmode = (const uint8_t *)"r";
|
||||
flags = JANET_FILE_READ;
|
||||
}
|
||||
#ifdef JANET_WINDOWS
|
||||
#define fdopen _fdopen
|
||||
#endif
|
||||
FILE *f = fdopen(fd, (const char *)fmode);
|
||||
return f ? makef(f, flags) : janet_wrap_nil();
|
||||
}
|
||||
|
||||
static Janet cfun_io_fileno(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 1);
|
||||
IOFile *iof = janet_getabstract(argv, 0, &cfun_io_filetype);
|
||||
if (iof->flags & JANET_FILE_CLOSED)
|
||||
janet_panic("file is closed");
|
||||
#ifdef JANET_WINDOWS
|
||||
#define fileno _fileno
|
||||
#endif
|
||||
return janet_wrap_integer(fileno(iof->file));
|
||||
}
|
||||
|
||||
/* 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);
|
||||
@@ -207,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) {
|
||||
@@ -247,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)))
|
||||
@@ -270,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)))
|
||||
@@ -283,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);
|
||||
}
|
||||
@@ -293,9 +252,9 @@ 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)
|
||||
janet_panic("file is closed");
|
||||
return janet_wrap_nil();
|
||||
if (iof->flags & (JANET_FILE_NOT_CLOSEABLE))
|
||||
janet_panic("file not closable");
|
||||
if (iof->flags & JANET_FILE_PIPED) {
|
||||
@@ -317,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;
|
||||
@@ -343,7 +302,6 @@ static Janet cfun_io_fseek(int32_t argc, Janet *argv) {
|
||||
|
||||
static JanetMethod io_file_methods[] = {
|
||||
{"close", cfun_io_fclose},
|
||||
{"fileno", cfun_io_fileno},
|
||||
{"flush", cfun_io_fflush},
|
||||
{"read", cfun_io_fread},
|
||||
{"seek", cfun_io_fseek},
|
||||
@@ -362,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;
|
||||
}
|
||||
|
||||
@@ -390,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;
|
||||
}
|
||||
@@ -457,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;
|
||||
}
|
||||
@@ -496,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);
|
||||
@@ -515,9 +505,9 @@ void janet_dynprintf(const char *name, FILE *dflt_file, const char *format, ...)
|
||||
janet_formatb(&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);
|
||||
@@ -577,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"
|
||||
@@ -597,26 +597,6 @@ static const JanetReg io_cfuns[] = {
|
||||
"\tb - open the file in binary mode (rather than text mode)\n"
|
||||
"\t+ - append to the file instead of overwriting it")
|
||||
},
|
||||
{
|
||||
"file/fdopen", cfun_io_fdopen,
|
||||
JDOC("(file/fdopen fd &opt mode)\n\n"
|
||||
"Create a file from an fd. fd is a platform specific file descriptor, and "
|
||||
"mode is a set of flags indicating the mode to open the file in. "
|
||||
"mode is a keyword where each character represents a flag. If the file "
|
||||
"cannot be opened, returns nil, otherwise returns the new file handle. "
|
||||
"Mode flags:\n\n"
|
||||
"\tr - allow reading from the file\n"
|
||||
"\tw - allow writing to the file\n"
|
||||
"\ta - append to the file\n"
|
||||
"\tb - open the file in binary mode (rather than text mode)\n"
|
||||
"\t+ - append to the file instead of overwriting it")
|
||||
},
|
||||
{
|
||||
"file/fileno", cfun_io_fileno,
|
||||
JDOC("(file/fileno f)\n\n"
|
||||
"Return the underlying file descriptor for the file as a number."
|
||||
"The meaning of this number is platform specific.")
|
||||
},
|
||||
{
|
||||
"file/close", cfun_io_fclose,
|
||||
JDOC("(file/close f)\n\n"
|
||||
@@ -674,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;
|
||||
}
|
||||
@@ -684,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;
|
||||
}
|
||||
|
||||
@@ -95,8 +95,8 @@ void janet_env_lookup_into(JanetTable *renv, JanetTable *env, const char *prefix
|
||||
const uint8_t *oldsym = janet_unwrap_symbol(env->data[i].key);
|
||||
int32_t oldlen = janet_string_length(oldsym);
|
||||
uint8_t *symbuf = janet_smalloc(prelen + oldlen);
|
||||
memcpy(symbuf, prefix, prelen);
|
||||
memcpy(symbuf + prelen, oldsym, oldlen);
|
||||
safe_memcpy(symbuf, prefix, prelen);
|
||||
safe_memcpy(symbuf + prelen, oldsym, oldlen);
|
||||
Janet s = janet_symbolv(symbuf, prelen + oldlen);
|
||||
janet_sfree(symbuf);
|
||||
janet_table_put(renv, s, entry_getval(env->data[i].value));
|
||||
@@ -184,15 +184,30 @@ static void marshal_one_env(MarshalState *st, JanetFuncEnv *env, int flags) {
|
||||
}
|
||||
}
|
||||
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 && (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) {
|
||||
/* 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 +220,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 +264,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 +284,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)
|
||||
@@ -707,6 +732,20 @@ static const uint8_t *unmarshal_one_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 +769,7 @@ static const uint8_t *unmarshal_one_def(
|
||||
def->bytecode_length = 0;
|
||||
def->name = NULL;
|
||||
def->source = NULL;
|
||||
def->closure_bitset = NULL;
|
||||
janet_v_push(st->lookup_defs, def);
|
||||
|
||||
/* Set default lengths to zero */
|
||||
@@ -785,15 +825,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 */
|
||||
@@ -840,6 +872,15 @@ static const uint8_t *unmarshal_one_def(
|
||||
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");
|
||||
@@ -1017,7 +1058,7 @@ uint8_t janet_unmarshal_byte(JanetMarshalContext *ctx) {
|
||||
void janet_unmarshal_bytes(JanetMarshalContext *ctx, uint8_t *dest, size_t len) {
|
||||
UnmarshalState *st = (UnmarshalState *)(ctx->u_state);
|
||||
MARSH_EOS(st, ctx->data + len - 1);
|
||||
memcpy(dest, ctx->data, len);
|
||||
safe_memcpy(dest, ctx->data, len);
|
||||
ctx->data += len;
|
||||
}
|
||||
|
||||
@@ -1100,7 +1141,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];
|
||||
@@ -1139,7 +1180,7 @@ static const uint8_t *unmarshal_one(
|
||||
} else { /* (lead == LB_BUFFER) */
|
||||
JanetBuffer *buffer = janet_buffer(len);
|
||||
buffer->count = len;
|
||||
memcpy(buffer->data, data, len);
|
||||
safe_memcpy(buffer->data, data, len);
|
||||
*out = janet_wrap_buffer(buffer);
|
||||
}
|
||||
janet_v_push(st->lookup, *out);
|
||||
@@ -1274,7 +1315,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,
|
||||
@@ -60,9 +60,7 @@ static JanetAbstractType JanetRNG_type = {
|
||||
NULL,
|
||||
janet_rng_marshal,
|
||||
janet_rng_unmarshal,
|
||||
NULL,
|
||||
NULL,
|
||||
NULL
|
||||
JANET_ATEND_UNMARSHAL
|
||||
};
|
||||
|
||||
JanetRNG *janet_default_rng(void) {
|
||||
@@ -117,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));
|
||||
@@ -134,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);
|
||||
@@ -168,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);
|
||||
|
||||
@@ -225,13 +223,6 @@ static Janet janet_srand(int32_t argc, Janet *argv) {
|
||||
return janet_wrap_nil();
|
||||
}
|
||||
|
||||
static Janet janet_remainder(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 2);
|
||||
double x = janet_getnumber(argv, 0);
|
||||
double y = janet_getnumber(argv, 1);
|
||||
return janet_wrap_number(fmod(x, y));
|
||||
}
|
||||
|
||||
#define JANET_DEFINE_MATHOP(name, fop)\
|
||||
static Janet janet_##name(int32_t argc, Janet *argv) {\
|
||||
janet_fixarity(argc, 1); \
|
||||
@@ -283,11 +274,6 @@ static Janet janet_not(int32_t argc, Janet *argv) {
|
||||
}
|
||||
|
||||
static const JanetReg math_cfuns[] = {
|
||||
{
|
||||
"%", janet_remainder,
|
||||
JDOC("(% dividend divisor)\n\n"
|
||||
"Returns the remainder of dividend / divisor.")
|
||||
},
|
||||
{
|
||||
"not", janet_not,
|
||||
JDOC("(not x)\n\nReturns the boolean inverse of x.")
|
||||
@@ -473,7 +459,7 @@ static const JanetReg math_cfuns[] = {
|
||||
/* 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."));
|
||||
|
||||
350
src/core/os.c
350
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,98 @@ 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 = { 0 };
|
||||
|
||||
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 +775,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 +805,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,6 +862,23 @@ 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
|
||||
(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
|
||||
static const uint8_t *janet_decode_permissions(unsigned short m) {
|
||||
uint8_t flags[9] = {0};
|
||||
@@ -746,6 +888,35 @@ static const uint8_t *janet_decode_permissions(unsigned short m) {
|
||||
return janet_string(flags, sizeof(flags));
|
||||
}
|
||||
|
||||
static unsigned short janet_encode_permissions(Janet *argv, int32_t n) {
|
||||
if (janet_checkint(argv[n])) {
|
||||
int32_t x = janet_unwrap_integer(argv[n]);
|
||||
if (x < 0 || x > 0777) {
|
||||
janet_panicf("expected integer in range [0, 8r777], got %v", argv[n]);
|
||||
}
|
||||
unsigned short m = 0;
|
||||
if (x & 1 || x & 010 || x & 0100) m |= S_IEXEC;
|
||||
if (x & 2 || x & 020 || x & 0200) m |= S_IWRITE;
|
||||
if (x & 4 || x & 040 || x & 0400) m |= S_IREAD;
|
||||
return m;
|
||||
}
|
||||
JanetString perm = janet_getstring(argv, n);
|
||||
if (janet_string_length(perm) != 9) {
|
||||
janet_panicf("expected string of length 9, got %S", perm);
|
||||
}
|
||||
unsigned short m = 0;
|
||||
if (perm[0] == 'r') m |= S_IREAD;
|
||||
if (perm[1] == 'w') m |= S_IWRITE;
|
||||
if (perm[2] == 'x') m |= S_IEXEC;
|
||||
if (perm[3] == 'r') m |= S_IREAD;
|
||||
if (perm[4] == 'w') m |= S_IWRITE;
|
||||
if (perm[5] == 'x') m |= S_IEXEC;
|
||||
if (perm[6] == 'r') m |= S_IREAD;
|
||||
if (perm[7] == 'w') m |= S_IWRITE;
|
||||
if (perm[8] == 'x') m |= S_IEXEC;
|
||||
return m;
|
||||
}
|
||||
|
||||
static const uint8_t *janet_decode_mode(unsigned short m) {
|
||||
const char *str = "other";
|
||||
if (m & _S_IFREG) str = "file";
|
||||
@@ -768,6 +939,31 @@ static const uint8_t *janet_decode_permissions(mode_t m) {
|
||||
return janet_string(flags, sizeof(flags));
|
||||
}
|
||||
|
||||
static mode_t janet_encode_permissions(Janet *argv, int32_t n) {
|
||||
if (janet_checkint(argv[n])) {
|
||||
int32_t x = janet_unwrap_integer(argv[n]);
|
||||
if (x < 0 || x > 0777) {
|
||||
janet_panicf("expected integer in range [0, 8r777], got %v", argv[n]);
|
||||
}
|
||||
return (mode_t) x;
|
||||
}
|
||||
JanetString perm = janet_getstring(argv, n);
|
||||
if (janet_string_length(perm) != 9) {
|
||||
janet_panicf("expected string of length 9, got %S", perm);
|
||||
}
|
||||
mode_t m = 0;
|
||||
if (perm[0] == 'r') m |= S_IRUSR;
|
||||
if (perm[1] == 'w') m |= S_IWUSR;
|
||||
if (perm[2] == 'x') m |= S_IXUSR;
|
||||
if (perm[3] == 'r') m |= S_IRGRP;
|
||||
if (perm[4] == 'w') m |= S_IWGRP;
|
||||
if (perm[5] == 'x') m |= S_IXGRP;
|
||||
if (perm[6] == 'r') m |= S_IROTH;
|
||||
if (perm[7] == 'w') m |= S_IWOTH;
|
||||
if (perm[8] == 'x') m |= S_IXOTH;
|
||||
return m;
|
||||
}
|
||||
|
||||
static const uint8_t *janet_decode_mode(mode_t m) {
|
||||
const char *str = "other";
|
||||
if (S_ISREG(m)) str = "file";
|
||||
@@ -781,67 +977,68 @@ static const uint8_t *janet_decode_mode(mode_t m) {
|
||||
}
|
||||
#endif
|
||||
|
||||
/* Can we do this? */
|
||||
#ifdef JANET_WINDOWS
|
||||
#define stat _stat
|
||||
typedef struct _stat jstat_t;
|
||||
#else
|
||||
typedef struct stat jstat_t;
|
||||
#endif
|
||||
|
||||
/* 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) {
|
||||
static Janet os_stat_permissions(jstat_t *st) {
|
||||
return janet_wrap_string(janet_decode_permissions(st->st_mode));
|
||||
}
|
||||
static Janet os_stat_uid(struct stat *st) {
|
||||
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[] = {
|
||||
@@ -862,7 +1059,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 +1077,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 +1110,26 @@ 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, janet_encode_permissions(argv, 1));
|
||||
#else
|
||||
int res = chmod(path, janet_encode_permissions(argv, 1));
|
||||
#endif
|
||||
if (-1 == res) janet_panicf("%s: %s", strerror(errno), path);
|
||||
return janet_wrap_nil();
|
||||
}
|
||||
|
||||
static Janet os_dir(int32_t argc, Janet *argv) {
|
||||
janet_arity(argc, 1, 2);
|
||||
const char *dir = janet_getcstring(argv, 0);
|
||||
@@ -949,6 +1176,21 @@ 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
|
||||
}
|
||||
|
||||
#endif /* JANET_REDUCED_OS */
|
||||
|
||||
static const JanetReg os_cfuns[] = {
|
||||
@@ -1007,7 +1249,7 @@ 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:permissions - A unix permission string like \"rwx--x--x\". On windows, a string like \"rwx\".\n"
|
||||
"\t:uid - File uid\n"
|
||||
"\t:gid - File gid\n"
|
||||
"\t:nlink - number of links to file\n"
|
||||
@@ -1019,6 +1261,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/stat, or an integer. "
|
||||
"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. Returns nil.")
|
||||
},
|
||||
{
|
||||
"os/touch", os_touch,
|
||||
JDOC("(os/touch path &opt actime modtime)\n\n"
|
||||
@@ -1028,13 +1283,14 @@ 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/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 create, false if the directoyr already exists, and "
|
||||
"errors otherwise.")
|
||||
},
|
||||
{
|
||||
"os/rmdir", os_rmdir,
|
||||
@@ -1049,8 +1305,18 @@ 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 symlink from oldpath to newpath, returning nil. The 3rd optional paramater "
|
||||
"enables a symlink iff truthy, hard link otherwise or if not provided. 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 +1346,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"
|
||||
@@ -1124,6 +1400,12 @@ 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.")
|
||||
},
|
||||
#endif
|
||||
{NULL, NULL, NULL}
|
||||
};
|
||||
|
||||
@@ -688,20 +688,19 @@ void janet_parser_clone(const JanetParser *src, JanetParser *dest) {
|
||||
if (dest->bufcap) {
|
||||
dest->buf = malloc(dest->bufcap);
|
||||
if (!dest->buf) goto nomem;
|
||||
memcpy(dest->buf, src->buf, dest->bufcap);
|
||||
}
|
||||
if (dest->argcap) {
|
||||
dest->args = malloc(sizeof(Janet) * dest->argcap);
|
||||
if (!dest->args) goto nomem;
|
||||
memcpy(dest->args, src->args, dest->argcap * sizeof(Janet));
|
||||
}
|
||||
if (dest->statecap) {
|
||||
dest->states = malloc(sizeof(JanetParseState) * dest->statecap);
|
||||
if (!dest->states) goto nomem;
|
||||
memcpy(dest->states, src->states, dest->statecap * sizeof(JanetParseState));
|
||||
}
|
||||
|
||||
memcpy(dest->buf, src->buf, dest->bufcap);
|
||||
memcpy(dest->args, src->args, dest->argcap * sizeof(Janet));
|
||||
memcpy(dest->states, src->states, dest->statecap * sizeof(JanetParseState));
|
||||
|
||||
return;
|
||||
|
||||
nomem:
|
||||
@@ -733,31 +732,26 @@ 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,
|
||||
parserget,
|
||||
NULL,
|
||||
NULL,
|
||||
NULL,
|
||||
NULL,
|
||||
NULL,
|
||||
NULL
|
||||
JANET_ATEND_GET
|
||||
};
|
||||
|
||||
/* C Function parser */
|
||||
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);
|
||||
@@ -782,14 +776,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, ' ');
|
||||
@@ -813,7 +807,7 @@ static Janet cfun_parse_insert(int32_t argc, Janet *argv) {
|
||||
}
|
||||
p->bufcap = newcap;
|
||||
}
|
||||
memcpy(p->buf + p->bufcount, str, slen);
|
||||
safe_memcpy(p->buf + p->bufcount, str, slen);
|
||||
p->bufcount = newcount;
|
||||
} else {
|
||||
janet_panic("cannot insert value into parser");
|
||||
@@ -823,13 +817,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];
|
||||
@@ -837,7 +831,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:
|
||||
@@ -858,7 +852,7 @@ 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);
|
||||
return janet_wrap_nil();
|
||||
@@ -866,20 +860,20 @@ static Janet cfun_parse_error(int32_t argc, Janet *argv) {
|
||||
|
||||
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);
|
||||
@@ -896,7 +890,7 @@ static Janet janet_wrap_parse_state(JanetParseState *s, Janet *args,
|
||||
if (s->flags & PFLAG_CONTAINER) {
|
||||
JanetArray *container_args = janet_array(s->argn);
|
||||
container_args->count = s->argn;
|
||||
memcpy(container_args->data, args, sizeof(args[0])*s->argn);
|
||||
safe_memcpy(container_args->data, args, sizeof(args[0])*s->argn);
|
||||
janet_table_put(state, janet_ckeywordv("args"),
|
||||
janet_wrap_array(container_args));
|
||||
}
|
||||
@@ -959,7 +953,7 @@ struct ParserStateGetter {
|
||||
};
|
||||
|
||||
static Janet parser_state_delimiters(const JanetParser *_p) {
|
||||
JanetParser *clone = janet_abstract(&janet_parse_parsertype, sizeof(JanetParser));
|
||||
JanetParser *clone = janet_abstract(&janet_parser_type, sizeof(JanetParser));
|
||||
janet_parser_clone(_p, clone);
|
||||
size_t i;
|
||||
const uint8_t *str;
|
||||
@@ -1010,7 +1004,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);
|
||||
}
|
||||
@@ -1037,8 +1031,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;
|
||||
@@ -348,9 +320,9 @@ tail:
|
||||
if (!result) return NULL;
|
||||
int32_t num_sub_captures = s->captures->count - cs.cap;
|
||||
JanetArray *sub_captures = janet_array(num_sub_captures);
|
||||
memcpy(sub_captures->data,
|
||||
s->captures->data + cs.cap,
|
||||
sizeof(Janet) * num_sub_captures);
|
||||
safe_memcpy(sub_captures->data,
|
||||
s->captures->data + cs.cap,
|
||||
sizeof(Janet) * num_sub_captures);
|
||||
sub_captures->count = num_sub_captures;
|
||||
cap_load(s, cs);
|
||||
pushcap(s, janet_wrap_array(sub_captures), tag);
|
||||
@@ -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,
|
||||
@@ -1212,31 +1181,29 @@ static const JanetAbstractType peg_type = {
|
||||
NULL,
|
||||
peg_marshal,
|
||||
peg_unmarshal,
|
||||
NULL,
|
||||
NULL,
|
||||
NULL
|
||||
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);
|
||||
memcpy(peg->bytecode, b->bytecode, bytecode_size);
|
||||
memcpy(peg->constants, b->constants, constants_size);
|
||||
safe_memcpy(peg->bytecode, b->bytecode, bytecode_size);
|
||||
safe_memcpy(peg->constants, b->constants, constants_size);
|
||||
peg->bytecode_len = janet_v_count(b->bytecode);
|
||||
return peg;
|
||||
}
|
||||
|
||||
/* 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");
|
||||
@@ -1247,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;
|
||||
}
|
||||
@@ -1258,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]);
|
||||
@@ -1325,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 */
|
||||
|
||||
360
src/core/pp.c
360
src/core/pp.c
@@ -177,6 +177,10 @@ static void janet_escape_string_b(JanetBuffer *buffer, const uint8_t *str) {
|
||||
}
|
||||
|
||||
static void janet_escape_buffer_b(JanetBuffer *buffer, JanetBuffer *bx) {
|
||||
if (bx == buffer) {
|
||||
/* Ensures buffer won't resize while escaping */
|
||||
janet_buffer_ensure(bx, bx->count + 5 * bx->count + 3, 1);
|
||||
}
|
||||
janet_buffer_push_u8(buffer, '@');
|
||||
janet_escape_string_impl(buffer, bx->data, bx->count);
|
||||
}
|
||||
@@ -248,6 +252,26 @@ void janet_to_string_b(JanetBuffer *buffer, Janet x) {
|
||||
}
|
||||
}
|
||||
|
||||
/* See parse.c for full table */
|
||||
|
||||
static const uint32_t pp_symchars[8] = {
|
||||
0x00000000, 0xf7ffec72, 0xc7ffffff, 0x07fffffe,
|
||||
0x00000000, 0x00000000, 0x00000000, 0x00000000
|
||||
};
|
||||
|
||||
static int pp_is_symbol_char(uint8_t c) {
|
||||
return pp_symchars[c >> 5] & ((uint32_t)1 << (c & 0x1F));
|
||||
}
|
||||
|
||||
/* Check if a symbol or keyword contains no symbol characters */
|
||||
static int contains_bad_chars(const uint8_t *sym, int issym) {
|
||||
int32_t len = janet_string_length(sym);
|
||||
if (len && issym && sym[0] >= '0' && sym[0] <= '9') return 1;
|
||||
for (int32_t i = 0; i < len; i++) {
|
||||
if (!pp_is_symbol_char(sym[i])) return 1;
|
||||
}
|
||||
return 0;
|
||||
}
|
||||
|
||||
void janet_description_b(JanetBuffer *buffer, Janet x) {
|
||||
switch (janet_type(x)) {
|
||||
@@ -261,10 +285,6 @@ void janet_description_b(JanetBuffer *buffer, Janet x) {
|
||||
return;
|
||||
case JANET_BUFFER: {
|
||||
JanetBuffer *b = janet_unwrap_buffer(x);
|
||||
if (b == buffer) {
|
||||
/* Ensures buffer won't resize while escaping */
|
||||
janet_buffer_ensure(b, 5 * b->count + 3, 1);
|
||||
}
|
||||
janet_escape_buffer_b(buffer, b);
|
||||
return;
|
||||
}
|
||||
@@ -326,6 +346,83 @@ struct pretty {
|
||||
JanetTable seen;
|
||||
};
|
||||
|
||||
/* Print jdn format */
|
||||
static int print_jdn_one(struct pretty *S, Janet x, int depth) {
|
||||
if (depth == 0) return 1;
|
||||
switch (janet_type(x)) {
|
||||
case JANET_NIL:
|
||||
case JANET_NUMBER:
|
||||
case JANET_BOOLEAN:
|
||||
case JANET_BUFFER:
|
||||
case JANET_STRING:
|
||||
janet_description_b(S->buffer, x);
|
||||
break;
|
||||
case JANET_SYMBOL:
|
||||
case JANET_KEYWORD:
|
||||
if (contains_bad_chars(janet_unwrap_keyword(x), janet_type(x) == JANET_SYMBOL)) return 1;
|
||||
janet_description_b(S->buffer, x);
|
||||
break;
|
||||
case JANET_TUPLE: {
|
||||
JanetTuple t = janet_unwrap_tuple(x);
|
||||
int isb = janet_tuple_flag(t) & JANET_TUPLE_FLAG_BRACKETCTOR;
|
||||
janet_buffer_push_u8(S->buffer, isb ? '[' : '(');
|
||||
for (int32_t i = 0; i < janet_tuple_length(t); i++) {
|
||||
if (i) janet_buffer_push_u8(S->buffer, ' ');
|
||||
if (print_jdn_one(S, t[i], depth - 1)) return 1;
|
||||
}
|
||||
janet_buffer_push_u8(S->buffer, isb ? ']' : ')');
|
||||
}
|
||||
break;
|
||||
case JANET_ARRAY: {
|
||||
janet_table_put(&S->seen, x, janet_wrap_true());
|
||||
JanetArray *a = janet_unwrap_array(x);
|
||||
janet_buffer_push_cstring(S->buffer, "@[");
|
||||
for (int32_t i = 0; i < a->count; i++) {
|
||||
if (i) janet_buffer_push_u8(S->buffer, ' ');
|
||||
if (print_jdn_one(S, a->data[i], depth - 1)) return 1;
|
||||
}
|
||||
janet_buffer_push_u8(S->buffer, ']');
|
||||
}
|
||||
break;
|
||||
case JANET_TABLE: {
|
||||
janet_table_put(&S->seen, x, janet_wrap_true());
|
||||
JanetTable *tab = janet_unwrap_table(x);
|
||||
janet_buffer_push_cstring(S->buffer, "@{");
|
||||
int isFirst = 1;
|
||||
for (int32_t i = 0; i < tab->capacity; i++) {
|
||||
const JanetKV *kv = tab->data + i;
|
||||
if (janet_checktype(kv->key, JANET_NIL)) continue;
|
||||
if (!isFirst) janet_buffer_push_u8(S->buffer, ' ');
|
||||
isFirst = 0;
|
||||
if (print_jdn_one(S, kv->key, depth - 1)) return 1;
|
||||
janet_buffer_push_u8(S->buffer, ' ');
|
||||
if (print_jdn_one(S, kv->value, depth - 1)) return 1;
|
||||
}
|
||||
janet_buffer_push_u8(S->buffer, '}');
|
||||
}
|
||||
break;
|
||||
case JANET_STRUCT: {
|
||||
JanetStruct st = janet_unwrap_struct(x);
|
||||
janet_buffer_push_u8(S->buffer, '{');
|
||||
int isFirst = 1;
|
||||
for (int32_t i = 0; i < janet_struct_capacity(st); i++) {
|
||||
const JanetKV *kv = st + i;
|
||||
if (janet_checktype(kv->key, JANET_NIL)) continue;
|
||||
if (!isFirst) janet_buffer_push_u8(S->buffer, ' ');
|
||||
isFirst = 0;
|
||||
if (print_jdn_one(S, kv->key, depth - 1)) return 1;
|
||||
janet_buffer_push_u8(S->buffer, ' ');
|
||||
if (print_jdn_one(S, kv->value, depth - 1)) return 1;
|
||||
}
|
||||
janet_buffer_push_u8(S->buffer, '}');
|
||||
}
|
||||
break;
|
||||
default:
|
||||
return 1;
|
||||
}
|
||||
return 0;
|
||||
}
|
||||
|
||||
static void print_newline(struct pretty *S, int just_a_space) {
|
||||
int i;
|
||||
if (just_a_space || (S->flags & JANET_PRETTY_ONELINE)) {
|
||||
@@ -544,6 +641,29 @@ JanetBuffer *janet_pretty(JanetBuffer *buffer, int depth, int flags, Janet x) {
|
||||
return janet_pretty_(buffer, depth, flags, x, buffer ? buffer->count : 0);
|
||||
}
|
||||
|
||||
static JanetBuffer *janet_jdn_(JanetBuffer *buffer, int depth, Janet x, int32_t startlen) {
|
||||
struct pretty S;
|
||||
if (NULL == buffer) {
|
||||
buffer = janet_buffer(0);
|
||||
}
|
||||
S.buffer = buffer;
|
||||
S.depth = depth;
|
||||
S.indent = 0;
|
||||
S.flags = 0;
|
||||
S.bufstartlen = startlen;
|
||||
janet_table_init(&S.seen, 10);
|
||||
int res = print_jdn_one(&S, x, depth);
|
||||
janet_table_deinit(&S.seen);
|
||||
if (res) {
|
||||
janet_panic("could not print to jdn format");
|
||||
}
|
||||
return S.buffer;
|
||||
}
|
||||
|
||||
JanetBuffer *janet_jdn(JanetBuffer *buffer, int depth, Janet x) {
|
||||
return janet_jdn_(buffer, depth, x, buffer ? buffer->count : 0);
|
||||
}
|
||||
|
||||
static const char *typestr(Janet x) {
|
||||
JanetType t = janet_type(x);
|
||||
return (t == JANET_ABSTRACT)
|
||||
@@ -568,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
|
||||
*/
|
||||
@@ -698,6 +728,141 @@ static const char *scanformat(
|
||||
return p;
|
||||
}
|
||||
|
||||
void janet_formatb(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_formatb(&buffer, format, args);
|
||||
|
||||
/* Iterate length */
|
||||
va_end(args);
|
||||
|
||||
ret = janet_string(buffer.data, buffer.count);
|
||||
janet_buffer_deinit(&buffer);
|
||||
return ret;
|
||||
}
|
||||
|
||||
/* Shared implementation between string/format and
|
||||
* buffer/format */
|
||||
void janet_buffer_format(
|
||||
@@ -789,6 +954,13 @@ void janet_buffer_format(
|
||||
janet_pretty_(b, depth, flags, argv[arg], startlen);
|
||||
break;
|
||||
}
|
||||
case 'j': {
|
||||
int depth = atoi(precision);
|
||||
if (depth < 1)
|
||||
depth = JANET_RECURSION_GUARD;
|
||||
janet_jdn_(b, depth, argv[arg], startlen);
|
||||
break;
|
||||
}
|
||||
default: {
|
||||
/* also treat cases 'nLlh' */
|
||||
janet_panicf("invalid conversion '%s' to 'format'",
|
||||
|
||||
@@ -538,6 +538,20 @@ static JanetSlot janetc_break(JanetFopts opts, int32_t argn, const Janet *argv)
|
||||
}
|
||||
}
|
||||
|
||||
/* Check if a form matches the pattern (not= nil _) */
|
||||
static int janetc_check_notnil_form(Janet x, Janet *capture) {
|
||||
if (!janet_checktype(x, JANET_TUPLE)) return 0;
|
||||
JanetTuple tup = janet_unwrap_tuple(x);
|
||||
if (!janet_checktype(tup[0], JANET_FUNCTION)) return 0;
|
||||
if (3 != janet_tuple_length(tup)) return 0;
|
||||
JanetFunction *fun = janet_unwrap_function(tup[0]);
|
||||
uint32_t tag = fun->def->flags & JANET_FUNCDEF_FLAG_TAG;
|
||||
if (tag != JANET_FUN_NEQ) return 0;
|
||||
if (!janet_checktype(tup[1], JANET_NIL)) return 0;
|
||||
*capture = tup[2];
|
||||
return 1;
|
||||
}
|
||||
|
||||
/*
|
||||
* :whiletop
|
||||
* ...
|
||||
@@ -554,6 +568,9 @@ static JanetSlot janetc_while(JanetFopts opts, int32_t argn, const Janet *argv)
|
||||
JanetScope tempscope;
|
||||
int32_t labelwt, labeld, labeljt, labelc, i;
|
||||
int infinite = 0;
|
||||
int is_notnil_form = 0;
|
||||
uint8_t ifjmp = JOP_JUMP_IF;
|
||||
uint8_t ifnjmp = JOP_JUMP_IF_NOT;
|
||||
|
||||
if (argn < 2) {
|
||||
janetc_cerror(c, "expected at least 2 arguments");
|
||||
@@ -564,13 +581,26 @@ static JanetSlot janetc_while(JanetFopts opts, int32_t argn, const Janet *argv)
|
||||
|
||||
janetc_scope(&tempscope, c, JANET_SCOPE_WHILE, "while");
|
||||
|
||||
/* Check for `(not= nil _)` in condition, and if so, use the
|
||||
* jmpnl or jmpnn instructions. This let's us implement `(each ...)`
|
||||
* more efficiently. */
|
||||
Janet condform = argv[0];
|
||||
if (janetc_check_notnil_form(condform, &condform)) {
|
||||
is_notnil_form = 1;
|
||||
ifjmp = JOP_JUMP_IF_NOT_NIL;
|
||||
ifnjmp = JOP_JUMP_IF_NIL;
|
||||
}
|
||||
|
||||
/* Compile condition */
|
||||
cond = janetc_value(subopts, argv[0]);
|
||||
cond = janetc_value(subopts, condform);
|
||||
|
||||
/* Check for constant condition */
|
||||
if (cond.flags & JANET_SLOT_CONSTANT) {
|
||||
/* Loop never executes */
|
||||
if (!janet_truthy(cond.constant)) {
|
||||
int never_executes = is_notnil_form
|
||||
? janet_checktype(cond.constant, JANET_NIL)
|
||||
: !janet_truthy(cond.constant);
|
||||
if (never_executes) {
|
||||
janetc_popscope(c);
|
||||
return janetc_cslot(janet_wrap_nil());
|
||||
}
|
||||
@@ -581,7 +611,7 @@ static JanetSlot janetc_while(JanetFopts opts, int32_t argn, const Janet *argv)
|
||||
/* Infinite loop does not need to check condition */
|
||||
labelc = infinite
|
||||
? 0
|
||||
: janetc_emit_si(c, JOP_JUMP_IF_NOT, cond, 0, 0);
|
||||
: janetc_emit_si(c, ifnjmp, cond, 0, 0);
|
||||
|
||||
/* Compile body */
|
||||
for (i = 1; i < argn; i++) {
|
||||
@@ -600,10 +630,10 @@ static JanetSlot janetc_while(JanetFopts opts, int32_t argn, const Janet *argv)
|
||||
janetc_scope(&tempscope, c, JANET_SCOPE_FUNCTION, "while-iife");
|
||||
|
||||
/* Recompile in the function scope */
|
||||
cond = janetc_value(subopts, argv[0]);
|
||||
cond = janetc_value(subopts, condform);
|
||||
if (!(cond.flags & JANET_SLOT_CONSTANT)) {
|
||||
/* If not an infinite loop, return nil when condition false */
|
||||
janetc_emit_si(c, JOP_JUMP_IF, cond, 2, 0);
|
||||
janetc_emit_si(c, ifjmp, cond, 2, 0);
|
||||
janetc_emit(c, JOP_RETURN_NIL);
|
||||
}
|
||||
for (i = 1; i < argn; i++) {
|
||||
|
||||
@@ -32,6 +32,8 @@
|
||||
* be in it. However, thread local global variables for interpreter
|
||||
* state should allow easy multi-threading. */
|
||||
|
||||
typedef struct JanetScratch JanetScratch;
|
||||
|
||||
/* Cache the core environment */
|
||||
extern JANET_THREAD_LOCAL JanetTable *janet_vm_core_env;
|
||||
|
||||
@@ -51,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;
|
||||
@@ -69,7 +75,7 @@ extern JANET_THREAD_LOCAL size_t janet_vm_root_count;
|
||||
extern JANET_THREAD_LOCAL size_t janet_vm_root_capacity;
|
||||
|
||||
/* Scratch memory */
|
||||
extern JANET_THREAD_LOCAL void **janet_scratch_mem;
|
||||
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;
|
||||
|
||||
|
||||
@@ -51,7 +51,7 @@ const uint8_t *janet_string(const uint8_t *buf, int32_t len) {
|
||||
head->length = len;
|
||||
head->hash = janet_string_calchash(buf, len);
|
||||
uint8_t *data = (uint8_t *)head->data;
|
||||
memcpy(data, buf, len);
|
||||
safe_memcpy(data, buf, len);
|
||||
data[len] = 0;
|
||||
return data;
|
||||
}
|
||||
@@ -187,7 +187,7 @@ static Janet cfun_string_repeat(int32_t argc, Janet *argv) {
|
||||
uint8_t *newbuf = janet_string_begin((int32_t) mulres);
|
||||
uint8_t *end = newbuf + mulres;
|
||||
for (uint8_t *p = newbuf; p < end; p += view.len) {
|
||||
memcpy(p, view.bytes, view.len);
|
||||
safe_memcpy(p, view.bytes, view.len);
|
||||
}
|
||||
return janet_wrap_string(janet_string_end(newbuf));
|
||||
}
|
||||
@@ -343,11 +343,11 @@ static Janet cfun_string_replace(int32_t argc, Janet *argv) {
|
||||
return janet_stringv(s.kmp.text, s.kmp.textlen);
|
||||
}
|
||||
buf = janet_string_begin(s.kmp.textlen - s.kmp.patlen + s.substlen);
|
||||
memcpy(buf, s.kmp.text, result);
|
||||
memcpy(buf + result, s.subst, s.substlen);
|
||||
memcpy(buf + result + s.substlen,
|
||||
s.kmp.text + result + s.kmp.patlen,
|
||||
s.kmp.textlen - result - s.kmp.patlen);
|
||||
safe_memcpy(buf, s.kmp.text, result);
|
||||
safe_memcpy(buf + result, s.subst, s.substlen);
|
||||
safe_memcpy(buf + result + s.substlen,
|
||||
s.kmp.text + result + s.kmp.patlen,
|
||||
s.kmp.textlen - result - s.kmp.patlen);
|
||||
kmp_deinit(&s.kmp);
|
||||
return janet_wrap_string(janet_string_end(buf));
|
||||
}
|
||||
@@ -445,11 +445,11 @@ static Janet cfun_string_join(int32_t argc, Janet *argv) {
|
||||
const uint8_t *chunk = NULL;
|
||||
int32_t chunklen = 0;
|
||||
if (i) {
|
||||
memcpy(out, joiner.bytes, joiner.len);
|
||||
safe_memcpy(out, joiner.bytes, joiner.len);
|
||||
out += joiner.len;
|
||||
}
|
||||
janet_bytes_view(parts.items[i], &chunk, &chunklen);
|
||||
memcpy(out, chunk, chunklen);
|
||||
safe_memcpy(out, chunk, chunklen);
|
||||
out += chunklen;
|
||||
}
|
||||
return janet_wrap_string(janet_string_end(buf));
|
||||
|
||||
@@ -447,12 +447,16 @@ int janet_scan_int64(const uint8_t *str, int32_t len, int64_t *out) {
|
||||
int neg;
|
||||
uint64_t bi;
|
||||
if (scan_uint64(str, len, &bi, &neg)) {
|
||||
if (neg && bi <= 0x8000000000000000ULL) {
|
||||
*out = -((int64_t) bi);
|
||||
if (neg && bi <= (UINT64_MAX / 2)) {
|
||||
if (bi > INT64_MAX) {
|
||||
*out = INT64_MIN;
|
||||
} else {
|
||||
*out = -((int64_t) bi);
|
||||
}
|
||||
return 1;
|
||||
}
|
||||
if (!neg && bi <= 0x7FFFFFFFFFFFFFFFULL) {
|
||||
*out = bi;
|
||||
if (!neg && bi <= INT64_MAX) {
|
||||
*out = (int64_t) bi;
|
||||
return 1;
|
||||
}
|
||||
}
|
||||
|
||||
@@ -183,7 +183,7 @@ const uint8_t *janet_symbol(const uint8_t *str, int32_t len) {
|
||||
head->hash = hash;
|
||||
head->length = len;
|
||||
newstr = (uint8_t *)(head->data);
|
||||
memcpy(newstr, str, len);
|
||||
safe_memcpy(newstr, str, len);
|
||||
newstr[len] = 0;
|
||||
janet_symcache_put((const uint8_t *)newstr, bucket);
|
||||
return newstr;
|
||||
|
||||
@@ -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;
|
||||
@@ -392,37 +409,34 @@ 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,
|
||||
janet_thread_getter,
|
||||
NULL,
|
||||
NULL,
|
||||
NULL,
|
||||
NULL,
|
||||
NULL,
|
||||
NULL
|
||||
JANET_ATEND_GET
|
||||
};
|
||||
|
||||
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();
|
||||
@@ -431,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 */
|
||||
@@ -454,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;
|
||||
@@ -472,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);
|
||||
@@ -487,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 {
|
||||
@@ -510,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;
|
||||
@@ -534,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);
|
||||
@@ -549,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");
|
||||
}
|
||||
|
||||
@@ -655,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
|
||||
|
||||
@@ -49,7 +49,7 @@ const Janet *janet_tuple_end(Janet *tuple) {
|
||||
/* Build a tuple with n values */
|
||||
const Janet *janet_tuple_n(const Janet *values, int32_t n) {
|
||||
Janet *t = janet_tuple_begin(n);
|
||||
memcpy(t, values, sizeof(Janet) * n);
|
||||
safe_memcpy(t, values, sizeof(Janet) * n);
|
||||
return janet_tuple_end(t);
|
||||
}
|
||||
|
||||
|
||||
@@ -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,
|
||||
@@ -119,9 +119,7 @@ static const JanetAbstractType ta_buffer_type = {
|
||||
NULL,
|
||||
ta_buffer_marshal,
|
||||
ta_buffer_unmarshal,
|
||||
NULL,
|
||||
NULL,
|
||||
NULL
|
||||
JANET_ATEND_UNMARSHAL
|
||||
};
|
||||
|
||||
static int ta_mark(void *p, size_t s) {
|
||||
@@ -156,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);
|
||||
@@ -277,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,
|
||||
@@ -285,13 +283,11 @@ static const JanetAbstractType ta_view_type = {
|
||||
ta_setter,
|
||||
ta_view_marshal,
|
||||
ta_view_unmarshal,
|
||||
NULL,
|
||||
NULL,
|
||||
NULL
|
||||
JANET_ATEND_UNMARSHAL
|
||||
};
|
||||
|
||||
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;
|
||||
}
|
||||
@@ -303,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);
|
||||
}
|
||||
|
||||
@@ -329,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]);
|
||||
@@ -363,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;
|
||||
@@ -379,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;
|
||||
}
|
||||
|
||||
@@ -400,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);
|
||||
}
|
||||
|
||||
@@ -437,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) {
|
||||
@@ -465,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];
|
||||
@@ -492,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];
|
||||
@@ -578,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
|
||||
|
||||
@@ -200,9 +200,9 @@ static uint32_t halfsiphash(const uint8_t *in, const size_t inlen, const uint8_t
|
||||
}
|
||||
/* end of siphash */
|
||||
|
||||
static uint8_t hash_key[16] = {0};
|
||||
static uint8_t hash_key[JANET_HASH_KEY_SIZE] = {0};
|
||||
|
||||
void janet_init_hash_key(uint8_t new_key[16]) {
|
||||
void janet_init_hash_key(uint8_t new_key[JANET_HASH_KEY_SIZE]) {
|
||||
memcpy(hash_key, new_key, sizeof(hash_key));
|
||||
}
|
||||
|
||||
@@ -248,6 +248,12 @@ int32_t janet_tablen(int32_t n) {
|
||||
return n + 1;
|
||||
}
|
||||
|
||||
/* Avoid some undefined behavior that was common in the code base. */
|
||||
void safe_memcpy(void *dest, const void *src, size_t len) {
|
||||
if (!len) return;
|
||||
memcpy(dest, src, len);
|
||||
}
|
||||
|
||||
/* Helper to find a value in a Janet struct or table. Returns the bucket
|
||||
* containing the key, or the first empty bucket if there is no such key. */
|
||||
const JanetKV *janet_dict_find(const JanetKV *buckets, int32_t cap, Janet key) {
|
||||
@@ -385,7 +391,7 @@ void janet_cfuns(JanetTable *env, const char *regprefix, const JanetReg *cfuns)
|
||||
if (NULL == longname_buffer) {
|
||||
JANET_OUT_OF_MEMORY;
|
||||
}
|
||||
memcpy(longname_buffer, regprefix, prefixlen);
|
||||
safe_memcpy(longname_buffer, regprefix, prefixlen);
|
||||
longname_buffer[prefixlen] = '/';
|
||||
prefixlen++;
|
||||
}
|
||||
@@ -402,7 +408,7 @@ void janet_cfuns(JanetTable *env, const char *regprefix, const JanetReg *cfuns)
|
||||
JANET_OUT_OF_MEMORY;
|
||||
}
|
||||
}
|
||||
memcpy(longname_buffer + prefixlen, cfuns->name, nmlen);
|
||||
safe_memcpy(longname_buffer + prefixlen, cfuns->name, nmlen);
|
||||
name = janet_wrap_symbol(janet_symbol(longname_buffer, totallen));
|
||||
} else {
|
||||
name = janet_csymbolv(cfuns->name);
|
||||
@@ -417,46 +423,21 @@ void janet_cfuns(JanetTable *env, const char *regprefix, const JanetReg *cfuns)
|
||||
|
||||
/* Abstract type introspection */
|
||||
|
||||
static const JanetAbstractType type_wrap = {
|
||||
"core/type-info",
|
||||
NULL,
|
||||
NULL,
|
||||
NULL,
|
||||
NULL,
|
||||
NULL,
|
||||
NULL,
|
||||
NULL,
|
||||
NULL,
|
||||
NULL
|
||||
};
|
||||
|
||||
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
|
||||
|
||||
@@ -68,6 +68,7 @@ int32_t janet_array_calchash(const Janet *array, int32_t len);
|
||||
int32_t janet_kv_calchash(const JanetKV *kvs, int32_t len);
|
||||
int32_t janet_string_calchash(const uint8_t *str, int32_t len);
|
||||
int32_t janet_tablen(int32_t n);
|
||||
void safe_memcpy(void *dest, const void *src, size_t len);
|
||||
void janet_buffer_push_types(JanetBuffer *buffer, int types);
|
||||
const JanetKV *janet_dict_find(const JanetKV *buckets, int32_t cap, Janet key);
|
||||
Janet janet_dict_get(const JanetKV *buckets, int32_t cap, Janet key);
|
||||
|
||||
@@ -22,6 +22,7 @@
|
||||
|
||||
#ifndef JANET_AMALG
|
||||
#include "features.h"
|
||||
#include "util.h"
|
||||
#include <janet.h>
|
||||
#endif
|
||||
|
||||
@@ -29,6 +30,73 @@
|
||||
* Define a number of functions that can be used internally on ANY Janet.
|
||||
*/
|
||||
|
||||
Janet janet_next(Janet ds, Janet key) {
|
||||
JanetType t = janet_type(ds);
|
||||
switch (t) {
|
||||
default:
|
||||
janet_panicf("expected iterable type, got %v", ds);
|
||||
case JANET_TABLE:
|
||||
case JANET_STRUCT: {
|
||||
const JanetKV *start;
|
||||
int32_t cap;
|
||||
if (t == JANET_TABLE) {
|
||||
JanetTable *tab = janet_unwrap_table(ds);
|
||||
cap = tab->capacity;
|
||||
start = tab->data;
|
||||
} else {
|
||||
JanetStruct st = janet_unwrap_struct(ds);
|
||||
cap = janet_struct_capacity(st);
|
||||
start = st;
|
||||
}
|
||||
const JanetKV *end = start + cap;
|
||||
const JanetKV *kv = janet_checktype(key, JANET_NIL)
|
||||
? start
|
||||
: janet_dict_find(start, cap, key) + 1;
|
||||
while (kv < end) {
|
||||
if (!janet_checktype(kv->key, JANET_NIL)) return kv->key;
|
||||
kv++;
|
||||
}
|
||||
break;
|
||||
}
|
||||
case JANET_STRING:
|
||||
case JANET_KEYWORD:
|
||||
case JANET_SYMBOL:
|
||||
case JANET_BUFFER:
|
||||
case JANET_ARRAY:
|
||||
case JANET_TUPLE: {
|
||||
int32_t i;
|
||||
if (janet_checktype(key, JANET_NIL)) {
|
||||
i = 0;
|
||||
} else if (janet_checkint(key)) {
|
||||
i = janet_unwrap_integer(key) + 1;
|
||||
} else {
|
||||
break;
|
||||
}
|
||||
int32_t len;
|
||||
if (t == JANET_BUFFER) {
|
||||
len = janet_unwrap_buffer(ds)->count;
|
||||
} else if (t == JANET_ARRAY) {
|
||||
len = janet_unwrap_array(ds)->count;
|
||||
} else if (t == JANET_TUPLE) {
|
||||
len = janet_tuple_length(janet_unwrap_tuple(ds));
|
||||
} else {
|
||||
len = janet_string_length(janet_unwrap_string(ds));
|
||||
}
|
||||
if (i < len && i >= 0) {
|
||||
return janet_wrap_integer(i);
|
||||
}
|
||||
break;
|
||||
}
|
||||
case JANET_ABSTRACT: {
|
||||
JanetAbstract abst = janet_unwrap_abstract(ds);
|
||||
const JanetAbstractType *at = janet_abstract_type(abst);
|
||||
if (NULL == at->next) break;
|
||||
return at->next(abst, key);
|
||||
}
|
||||
}
|
||||
return janet_wrap_nil();
|
||||
}
|
||||
|
||||
/* Compare two abstract values */
|
||||
static int janet_compare_abstract(JanetAbstract xx, JanetAbstract yy) {
|
||||
if (xx == yy) return 0;
|
||||
|
||||
@@ -45,7 +45,7 @@ void *janet_v_flattenmem(void *v, int32_t itemsize) {
|
||||
size_t size = (size_t) itemsize * janet_v__cnt(v);
|
||||
p = malloc(size);
|
||||
if (NULL != p) {
|
||||
memcpy(p, v, size);
|
||||
safe_memcpy(p, v, size);
|
||||
return p;
|
||||
} else {
|
||||
JANET_OUT_OF_MEMORY;
|
||||
|
||||
264
src/core/vm.c
264
src/core/vm.c
@@ -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;
|
||||
@@ -118,12 +121,11 @@ JANET_THREAD_LOCAL jmp_buf *janet_vm_jmp_buf = NULL;
|
||||
#define vm_binop_immediate(op)\
|
||||
{\
|
||||
Janet op1 = stack[B];\
|
||||
vm_assert_type(op1, JANET_NUMBER);\
|
||||
if (!janet_checktype(op1, JANET_NUMBER)) {\
|
||||
vm_commit();\
|
||||
Janet _argv[2] = { op1, janet_wrap_number(CS) };\
|
||||
stack[A] = janet_mcall(#op, 2, _argv);\
|
||||
vm_pcnext();\
|
||||
vm_checkgc_pcnext();\
|
||||
} else {\
|
||||
double x1 = janet_unwrap_number(op1);\
|
||||
stack[A] = janet_wrap_number(x1 op CS);\
|
||||
@@ -133,10 +135,16 @@ JANET_THREAD_LOCAL jmp_buf *janet_vm_jmp_buf = NULL;
|
||||
#define _vm_bitop_immediate(op, type1)\
|
||||
{\
|
||||
Janet op1 = stack[B];\
|
||||
vm_assert_type(op1, JANET_NUMBER);\
|
||||
type1 x1 = (type1) janet_unwrap_integer(op1);\
|
||||
stack[A] = janet_wrap_integer(x1 op CS);\
|
||||
vm_pcnext();\
|
||||
if (!janet_checktype(op1, JANET_NUMBER)) {\
|
||||
vm_commit();\
|
||||
Janet _argv[2] = { op1, janet_wrap_number(CS) };\
|
||||
stack[A] = janet_mcall(#op, 2, _argv);\
|
||||
vm_checkgc_pcnext();\
|
||||
} else {\
|
||||
type1 x1 = (type1) janet_unwrap_integer(op1);\
|
||||
stack[A] = janet_wrap_integer(x1 op CS);\
|
||||
vm_pcnext();\
|
||||
}\
|
||||
}
|
||||
#define vm_bitop_immediate(op) _vm_bitop_immediate(op, int32_t);
|
||||
#define vm_bitopu_immediate(op) _vm_bitop_immediate(op, uint32_t);
|
||||
@@ -144,17 +152,15 @@ JANET_THREAD_LOCAL jmp_buf *janet_vm_jmp_buf = NULL;
|
||||
{\
|
||||
Janet op1 = stack[B];\
|
||||
Janet op2 = stack[C];\
|
||||
if (!janet_checktype(op1, JANET_NUMBER)) {\
|
||||
vm_commit();\
|
||||
Janet _argv[2] = { op1, op2 };\
|
||||
stack[A] = janet_mcall(#op, 2, _argv);\
|
||||
vm_pcnext();\
|
||||
} else {\
|
||||
vm_assert_type(op2, JANET_NUMBER);\
|
||||
if (janet_checktype(op1, JANET_NUMBER) && janet_checktype(op2, JANET_NUMBER)) {\
|
||||
double x1 = janet_unwrap_number(op1);\
|
||||
double x2 = janet_unwrap_number(op2);\
|
||||
stack[A] = wrap(x1 op x2);\
|
||||
vm_pcnext();\
|
||||
} else {\
|
||||
vm_commit();\
|
||||
stack[A] = janet_binop_call(#op, "r" #op, op1, op2);\
|
||||
vm_checkgc_pcnext();\
|
||||
}\
|
||||
}
|
||||
#define vm_binop(op) _vm_binop(op, janet_wrap_number)
|
||||
@@ -162,12 +168,16 @@ JANET_THREAD_LOCAL jmp_buf *janet_vm_jmp_buf = NULL;
|
||||
{\
|
||||
Janet op1 = stack[B];\
|
||||
Janet op2 = stack[C];\
|
||||
vm_assert_type(op1, JANET_NUMBER);\
|
||||
vm_assert_type(op2, JANET_NUMBER);\
|
||||
type1 x1 = (type1) janet_unwrap_integer(op1);\
|
||||
int32_t x2 = janet_unwrap_integer(op2);\
|
||||
stack[A] = janet_wrap_integer(x1 op x2);\
|
||||
vm_pcnext();\
|
||||
if (janet_checktype(op1, JANET_NUMBER) && janet_checktype(op2, JANET_NUMBER)) {\
|
||||
type1 x1 = (type1) janet_unwrap_integer(op1);\
|
||||
int32_t x2 = janet_unwrap_integer(op2);\
|
||||
stack[A] = janet_wrap_integer(x1 op x2);\
|
||||
vm_pcnext();\
|
||||
} else {\
|
||||
vm_commit();\
|
||||
stack[A] = janet_binop_call(#op, "r" #op, op1, op2);\
|
||||
vm_checkgc_pcnext();\
|
||||
}\
|
||||
}
|
||||
#define vm_bitop(op) _vm_bitop(op, int32_t)
|
||||
#define vm_bitopu(op) _vm_bitop(op, uint32_t)
|
||||
@@ -175,53 +185,77 @@ JANET_THREAD_LOCAL jmp_buf *janet_vm_jmp_buf = NULL;
|
||||
{\
|
||||
Janet op1 = stack[B];\
|
||||
Janet op2 = stack[C];\
|
||||
if (!janet_checktype(op1, JANET_NUMBER) || !janet_checktype(op2, JANET_NUMBER)) {\
|
||||
vm_commit();\
|
||||
stack[A] = janet_wrap_boolean(janet_compare(op1, op2) op 0);\
|
||||
vm_pcnext();\
|
||||
} else {\
|
||||
if (janet_checktype(op1, JANET_NUMBER) && janet_checktype(op2, JANET_NUMBER)) {\
|
||||
double x1 = janet_unwrap_number(op1);\
|
||||
double x2 = janet_unwrap_number(op2);\
|
||||
stack[A] = janet_wrap_boolean(x1 op x2);\
|
||||
vm_pcnext();\
|
||||
} else {\
|
||||
vm_commit();\
|
||||
stack[A] = janet_wrap_boolean(janet_compare(op1, op2) op 0);\
|
||||
vm_checkgc_pcnext();\
|
||||
}\
|
||||
}
|
||||
|
||||
/* Trace a function call */
|
||||
static void vm_do_trace(JanetFunction *func) {
|
||||
Janet *stack = janet_vm_fiber->data + janet_vm_fiber->stackstart;
|
||||
int32_t start = janet_vm_fiber->stackstart;
|
||||
int32_t end = janet_vm_fiber->stacktop;
|
||||
int32_t argc = end - start;
|
||||
static void vm_do_trace(JanetFunction *func, int32_t argc, const Janet *argv) {
|
||||
if (func->def->name) {
|
||||
janet_printf("trace (%S", func->def->name);
|
||||
} else {
|
||||
janet_printf("trace (%p", janet_wrap_function(func));
|
||||
}
|
||||
for (int32_t i = 0; i < argc; i++) {
|
||||
janet_printf(" %p", stack[i]);
|
||||
janet_printf(" %p", argv[i]);
|
||||
}
|
||||
printf(")\n");
|
||||
janet_printf(")\n");
|
||||
}
|
||||
|
||||
/* Call a non function type */
|
||||
/* Invoke a method once we have looked it up */
|
||||
static Janet janet_method_invoke(Janet method, int32_t argc, Janet *argv) {
|
||||
switch (janet_type(method)) {
|
||||
case JANET_CFUNCTION:
|
||||
return (janet_unwrap_cfunction(method))(argc, argv);
|
||||
case JANET_FUNCTION: {
|
||||
JanetFunction *fun = janet_unwrap_function(method);
|
||||
return janet_call(fun, argc, argv);
|
||||
}
|
||||
case JANET_ABSTRACT: {
|
||||
JanetAbstract abst = janet_unwrap_abstract(method);
|
||||
const JanetAbstractType *at = janet_abstract_type(abst);
|
||||
if (NULL != at->call) {
|
||||
return at->call(abst, argc, argv);
|
||||
}
|
||||
}
|
||||
/* fallthrough */
|
||||
case JANET_STRING:
|
||||
case JANET_BUFFER:
|
||||
case JANET_TABLE:
|
||||
case JANET_STRUCT:
|
||||
case JANET_ARRAY:
|
||||
case JANET_TUPLE: {
|
||||
if (argc != 1) {
|
||||
janet_panicf("%v called with %d arguments, possibly expected 1", method, argc);
|
||||
}
|
||||
return janet_in(method, argv[0]);
|
||||
}
|
||||
default: {
|
||||
if (argc != 1) {
|
||||
janet_panicf("%v called with %d arguments, possibly expected 1", method, argc);
|
||||
}
|
||||
return janet_in(argv[0], method);
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
/* Call a non function type from a JOP_CALL or JOP_TAILCALL instruction.
|
||||
* Assumes that the arguments are on the fiber stack. */
|
||||
static Janet call_nonfn(JanetFiber *fiber, Janet callee) {
|
||||
int32_t argn = fiber->stacktop - fiber->stackstart;
|
||||
Janet ds, key;
|
||||
if (argn != 1) janet_panicf("%v called with %d arguments, possibly expected 1", callee, argn);
|
||||
if (janet_checktypes(callee, JANET_TFLAG_INDEXED | JANET_TFLAG_DICTIONARY |
|
||||
JANET_TFLAG_STRING | JANET_TFLAG_BUFFER | JANET_TFLAG_ABSTRACT)) {
|
||||
ds = callee;
|
||||
key = fiber->data[fiber->stackstart];
|
||||
} else {
|
||||
ds = fiber->data[fiber->stackstart];
|
||||
key = callee;
|
||||
}
|
||||
int32_t argc = fiber->stacktop - fiber->stackstart;
|
||||
fiber->stacktop = fiber->stackstart;
|
||||
return janet_in(ds, key);
|
||||
return janet_method_invoke(callee, argc, fiber->data + fiber->stacktop);
|
||||
}
|
||||
|
||||
/* Get a callable from a keyword method name and check ensure that it is valid. */
|
||||
/* Get a callable from a keyword method name and ensure that it is valid. */
|
||||
static Janet resolve_method(Janet name, JanetFiber *fiber) {
|
||||
int32_t argc = fiber->stacktop - fiber->stackstart;
|
||||
if (argc < 1) janet_panicf("method call (%v) takes at least 1 argument, got 0", name);
|
||||
@@ -231,6 +265,31 @@ static Janet resolve_method(Janet name, JanetFiber *fiber) {
|
||||
return callee;
|
||||
}
|
||||
|
||||
/* Lookup method on value x */
|
||||
static Janet janet_method_lookup(Janet x, const char *name) {
|
||||
Janet kname = janet_ckeywordv(name);
|
||||
return janet_get(x, kname);
|
||||
}
|
||||
|
||||
/* Call a method first on the righthand side, and then on the left hand side with a prefix */
|
||||
static Janet janet_binop_call(const char *lmethod, const char *rmethod, Janet lhs, Janet rhs) {
|
||||
Janet lm = janet_method_lookup(lhs, lmethod);
|
||||
if (janet_checktype(lm, JANET_NIL)) {
|
||||
/* Invert order for rmethod */
|
||||
Janet lr = janet_method_lookup(rhs, rmethod);
|
||||
Janet argv[2] = { rhs, lhs };
|
||||
if (janet_checktype(lr, JANET_NIL)) {
|
||||
janet_panicf("could not find method :%s for %v, or :%s for %v",
|
||||
lmethod, lhs,
|
||||
rmethod, rhs);
|
||||
}
|
||||
return janet_method_invoke(lr, 2, argv);
|
||||
} else {
|
||||
Janet argv[2] = { lhs, rhs };
|
||||
return janet_method_invoke(lm, 2, argv);
|
||||
}
|
||||
}
|
||||
|
||||
/* Interpreter main loop */
|
||||
static JanetSignal run_vm(JanetFiber *fiber, Janet in) {
|
||||
|
||||
@@ -249,6 +308,8 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in) {
|
||||
&&label_JOP_MULTIPLY,
|
||||
&&label_JOP_DIVIDE_IMMEDIATE,
|
||||
&&label_JOP_DIVIDE,
|
||||
&&label_JOP_MODULO,
|
||||
&&label_JOP_REMAINDER,
|
||||
&&label_JOP_BAND,
|
||||
&&label_JOP_BOR,
|
||||
&&label_JOP_BXOR,
|
||||
@@ -264,6 +325,8 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in) {
|
||||
&&label_JOP_JUMP,
|
||||
&&label_JOP_JUMP_IF,
|
||||
&&label_JOP_JUMP_IF_NOT,
|
||||
&&label_JOP_JUMP_IF_NIL,
|
||||
&&label_JOP_JUMP_IF_NOT_NIL,
|
||||
&&label_JOP_GREATER_THAN,
|
||||
&&label_JOP_GREATER_THAN_IMMEDIATE,
|
||||
&&label_JOP_LESS_THAN,
|
||||
@@ -304,11 +367,7 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in) {
|
||||
&&label_JOP_MAKE_BRACKET_TUPLE,
|
||||
&&label_JOP_GREATER_THAN_EQUAL,
|
||||
&&label_JOP_LESS_THAN_EQUAL,
|
||||
&&label_unknown_op,
|
||||
&&label_unknown_op,
|
||||
&&label_unknown_op,
|
||||
&&label_unknown_op,
|
||||
&&label_unknown_op,
|
||||
&&label_JOP_NEXT,
|
||||
&&label_unknown_op,
|
||||
&&label_unknown_op,
|
||||
&&label_unknown_op,
|
||||
@@ -586,6 +645,37 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in) {
|
||||
VM_OP(JOP_DIVIDE)
|
||||
vm_binop( /);
|
||||
|
||||
VM_OP(JOP_MODULO) {
|
||||
Janet op1 = stack[B];
|
||||
Janet op2 = stack[C];
|
||||
if (janet_checktype(op1, JANET_NUMBER) && janet_checktype(op2, JANET_NUMBER)) {
|
||||
double x1 = janet_unwrap_number(op1);
|
||||
double x2 = janet_unwrap_number(op2);
|
||||
double intres = x2 * floor(x1 / x2);
|
||||
stack[A] = janet_wrap_number(x1 - intres);
|
||||
vm_pcnext();
|
||||
} else {
|
||||
vm_commit();
|
||||
stack[A] = janet_binop_call("mod", "rmod", op1, op2);
|
||||
vm_checkgc_pcnext();
|
||||
}
|
||||
}
|
||||
|
||||
VM_OP(JOP_REMAINDER) {
|
||||
Janet op1 = stack[B];
|
||||
Janet op2 = stack[C];
|
||||
if (janet_checktype(op1, JANET_NUMBER) && janet_checktype(op2, JANET_NUMBER)) {
|
||||
double x1 = janet_unwrap_number(op1);
|
||||
double x2 = janet_unwrap_number(op2);
|
||||
stack[A] = janet_wrap_number(fmod(x1, x2));
|
||||
vm_pcnext();
|
||||
} else {
|
||||
vm_commit();
|
||||
stack[A] = janet_binop_call("%", "r%", op1, op2);
|
||||
vm_checkgc_pcnext();
|
||||
}
|
||||
}
|
||||
|
||||
VM_OP(JOP_BAND)
|
||||
vm_bitop(&);
|
||||
|
||||
@@ -648,6 +738,22 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in) {
|
||||
}
|
||||
vm_next();
|
||||
|
||||
VM_OP(JOP_JUMP_IF_NIL)
|
||||
if (janet_checktype(stack[A], JANET_NIL)) {
|
||||
pc += ES;
|
||||
} else {
|
||||
pc++;
|
||||
}
|
||||
vm_next();
|
||||
|
||||
VM_OP(JOP_JUMP_IF_NOT_NIL)
|
||||
if (janet_checktype(stack[A], JANET_NIL)) {
|
||||
pc++;
|
||||
} else {
|
||||
pc += ES;
|
||||
}
|
||||
vm_next();
|
||||
|
||||
VM_OP(JOP_LESS_THAN)
|
||||
vm_compop( <);
|
||||
|
||||
@@ -680,6 +786,10 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in) {
|
||||
stack[A] = janet_wrap_integer(janet_compare(stack[B], stack[C]));
|
||||
vm_pcnext();
|
||||
|
||||
VM_OP(JOP_NEXT)
|
||||
stack[A] = janet_next(stack[B], stack[C]);
|
||||
vm_pcnext();
|
||||
|
||||
VM_OP(JOP_LOAD_NIL)
|
||||
stack[D] = janet_wrap_nil();
|
||||
vm_pcnext();
|
||||
@@ -811,7 +921,9 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in) {
|
||||
}
|
||||
if (janet_checktype(callee, JANET_FUNCTION)) {
|
||||
func = janet_unwrap_function(callee);
|
||||
if (func->gc.flags & JANET_FUNCFLAG_TRACE) vm_do_trace(func);
|
||||
if (func->gc.flags & JANET_FUNCFLAG_TRACE) {
|
||||
vm_do_trace(func, fiber->stacktop - fiber->stackstart, stack);
|
||||
}
|
||||
janet_stack_frame(stack)->pc = pc;
|
||||
if (janet_fiber_funcframe(fiber, func)) {
|
||||
int32_t n = fiber->stacktop - fiber->stackstart;
|
||||
@@ -848,7 +960,9 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in) {
|
||||
}
|
||||
if (janet_checktype(callee, JANET_FUNCTION)) {
|
||||
func = janet_unwrap_function(callee);
|
||||
if (func->gc.flags & JANET_FUNCFLAG_TRACE) vm_do_trace(func);
|
||||
if (func->gc.flags & JANET_FUNCFLAG_TRACE) {
|
||||
vm_do_trace(func, fiber->stacktop - fiber->stackstart, stack);
|
||||
}
|
||||
if (janet_fiber_funcframe_tail(fiber, func)) {
|
||||
janet_stack_frame(fiber->data + fiber->frame)->pc = pc;
|
||||
int32_t n = fiber->stacktop - fiber->stackstart;
|
||||
@@ -1096,6 +1210,11 @@ Janet janet_call(JanetFunction *fun, int32_t argc, const Janet *argv) {
|
||||
if (janet_vm_stackn >= JANET_RECURSION_GUARD)
|
||||
janet_panic("C stack recursed too deeply");
|
||||
|
||||
/* Tracing */
|
||||
if (fun->gc.flags & JANET_FUNCFLAG_TRACE) {
|
||||
vm_do_trace(fun, argc, argv);
|
||||
}
|
||||
|
||||
/* Push frame */
|
||||
janet_fiber_pushn(janet_vm_fiber, argv, argc);
|
||||
if (janet_fiber_funcframe(janet_vm_fiber, fun)) {
|
||||
@@ -1133,6 +1252,7 @@ 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]);
|
||||
@@ -1153,6 +1273,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;
|
||||
@@ -1219,30 +1352,12 @@ Janet janet_mcall(const char *name, int32_t argc, Janet *argv) {
|
||||
/* At least 1 argument */
|
||||
if (argc < 1) janet_panicf("method :%s expected at least 1 argument");
|
||||
/* Find method */
|
||||
Janet method;
|
||||
if (janet_checktype(argv[0], JANET_ABSTRACT)) {
|
||||
void *abst = janet_unwrap_abstract(argv[0]);
|
||||
JanetAbstractType *type = (JanetAbstractType *)janet_abstract_type(abst);
|
||||
if (!type->get || !(type->get)(abst, janet_ckeywordv(name), &method))
|
||||
janet_panicf("abstract value %v does not implement :%s", argv[0], name);
|
||||
} else if (janet_checktype(argv[0], JANET_TABLE)) {
|
||||
JanetTable *table = janet_unwrap_table(argv[0]);
|
||||
method = janet_table_get(table, janet_ckeywordv(name));
|
||||
} else if (janet_checktype(argv[0], JANET_STRUCT)) {
|
||||
const JanetKV *st = janet_unwrap_struct(argv[0]);
|
||||
method = janet_struct_get(st, janet_ckeywordv(name));
|
||||
} else {
|
||||
Janet method = janet_method_lookup(argv[0], name);
|
||||
if (janet_checktype(method, JANET_NIL)) {
|
||||
janet_panicf("could not find method :%s for %v", name, argv[0]);
|
||||
}
|
||||
/* Invoke method */
|
||||
if (janet_checktype(method, JANET_CFUNCTION)) {
|
||||
return (janet_unwrap_cfunction(method))(argc, argv);
|
||||
} else if (janet_checktype(method, JANET_FUNCTION)) {
|
||||
JanetFunction *fun = janet_unwrap_function(method);
|
||||
return janet_call(fun, argc, argv);
|
||||
} else {
|
||||
janet_panicf("method %s has unexpected value %v", name, method);
|
||||
}
|
||||
return janet_method_invoke(method, argc, argv);
|
||||
}
|
||||
|
||||
/* Setup VM */
|
||||
@@ -1266,7 +1381,9 @@ 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));
|
||||
/* Core env */
|
||||
janet_vm_core_env = NULL;
|
||||
/* Seed RNG */
|
||||
@@ -1287,6 +1404,7 @@ 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;
|
||||
#ifdef JANET_THREADS
|
||||
janet_threads_deinit();
|
||||
|
||||
@@ -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))
|
||||
|
||||
@@ -805,6 +812,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 +828,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 +896,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;
|
||||
@@ -907,8 +917,27 @@ struct JanetAbstractType {
|
||||
void (*tostring)(void *p, JanetBuffer *buffer);
|
||||
int (*compare)(void *lhs, void *rhs);
|
||||
int32_t (*hash)(void *p, size_t len);
|
||||
Janet(*next)(void *p, Janet key);
|
||||
Janet(*call)(void *p, int32_t argc, Janet *argv);
|
||||
};
|
||||
|
||||
/* Some macros to let us add extra types to JanetAbstract types without
|
||||
* needing to changing native modules that declare them as static const
|
||||
* structures. If more fields are added, these macros are modified to include
|
||||
* default values (usually NULL). This silences missing field warnings. */
|
||||
#define JANET_ATEND_NAME NULL,JANET_ATEND_GC
|
||||
#define JANET_ATEND_GC NULL,JANET_ATEND_GCMARK
|
||||
#define JANET_ATEND_GCMARK NULL,JANET_ATEND_GET
|
||||
#define JANET_ATEND_GET NULL,JANET_ATEND_PUT
|
||||
#define JANET_ATEND_PUT NULL,JANET_ATEND_MARSHAL
|
||||
#define JANET_ATEND_MARSHAL NULL,JANET_ATEND_UNMARSHAL
|
||||
#define JANET_ATEND_UNMARSHAL NULL,JANET_ATEND_TOSTRING
|
||||
#define JANET_ATEND_TOSTRING NULL,JANET_ATEND_COMPARE
|
||||
#define JANET_ATEND_COMPARE NULL,JANET_ATEND_HASH
|
||||
#define JANET_ATEND_HASH NULL,JANET_ATEND_NEXT
|
||||
#define JANET_ATEND_NEXT NULL,JANET_ATEND_CALL
|
||||
#define JANET_ATEND_CALL
|
||||
|
||||
struct JanetReg {
|
||||
const char *name;
|
||||
JanetCFunction cfun;
|
||||
@@ -946,6 +975,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;
|
||||
@@ -1005,6 +1040,8 @@ enum JanetOpCode {
|
||||
JOP_MULTIPLY,
|
||||
JOP_DIVIDE_IMMEDIATE,
|
||||
JOP_DIVIDE,
|
||||
JOP_MODULO,
|
||||
JOP_REMAINDER,
|
||||
JOP_BAND,
|
||||
JOP_BOR,
|
||||
JOP_BXOR,
|
||||
@@ -1020,6 +1057,8 @@ enum JanetOpCode {
|
||||
JOP_JUMP,
|
||||
JOP_JUMP_IF,
|
||||
JOP_JUMP_IF_NOT,
|
||||
JOP_JUMP_IF_NIL,
|
||||
JOP_JUMP_IF_NOT_NIL,
|
||||
JOP_GREATER_THAN,
|
||||
JOP_GREATER_THAN_IMMEDIATE,
|
||||
JOP_LESS_THAN,
|
||||
@@ -1060,6 +1099,7 @@ enum JanetOpCode {
|
||||
JOP_MAKE_BRACKET_TUPLE,
|
||||
JOP_GREATER_THAN_EQUAL,
|
||||
JOP_LESS_THAN_EQUAL,
|
||||
JOP_NEXT,
|
||||
JOP_INSTRUCTION_COUNT
|
||||
};
|
||||
|
||||
@@ -1071,6 +1111,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);
|
||||
@@ -1132,6 +1173,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);
|
||||
@@ -1290,6 +1332,7 @@ JANET_API int janet_gcunroot(Janet root);
|
||||
JANET_API int janet_gcunrootall(Janet root);
|
||||
JANET_API int janet_gclock(void);
|
||||
JANET_API void janet_gcunlock(int handle);
|
||||
JANET_API void janet_gcpressure(size_t s);
|
||||
|
||||
/* Functions */
|
||||
JANET_API JanetFuncDef *janet_funcdef_alloc(void);
|
||||
@@ -1303,7 +1346,8 @@ JANET_API JanetBuffer *janet_pretty(JanetBuffer *buffer, int depth, int flags, J
|
||||
|
||||
/* Misc */
|
||||
#ifndef JANET_NO_PRF
|
||||
JANET_API void janet_init_hash_key(uint8_t key[16]);
|
||||
#define JANET_HASH_KEY_SIZE 16
|
||||
JANET_API void janet_init_hash_key(uint8_t key[JANET_HASH_KEY_SIZE]);
|
||||
#endif
|
||||
JANET_API int janet_equals(Janet x, Janet y);
|
||||
JANET_API int32_t janet_hash(Janet x);
|
||||
@@ -1311,6 +1355,7 @@ JANET_API int janet_compare(Janet x, Janet y);
|
||||
JANET_API int janet_cstrcmp(JanetString str, const char *other);
|
||||
JANET_API Janet janet_in(Janet ds, Janet key);
|
||||
JANET_API Janet janet_get(Janet ds, Janet key);
|
||||
JANET_API Janet janet_next(Janet ds, Janet key);
|
||||
JANET_API Janet janet_getindex(Janet ds, int32_t index);
|
||||
JANET_API int32_t janet_length(Janet x);
|
||||
JANET_API Janet janet_lengthv(Janet x);
|
||||
@@ -1333,11 +1378,12 @@ JANET_API Janet janet_mcall(const char *name, int32_t argc, Janet *argv);
|
||||
JANET_API void janet_stacktrace(JanetFiber *fiber, Janet err);
|
||||
|
||||
/* Scratch Memory API */
|
||||
typedef void (*ScratchFinalizer)(void *);
|
||||
typedef void (*JanetScratchFinalizer)(void *);
|
||||
|
||||
JANET_API void *janet_smalloc(size_t size);
|
||||
JANET_API void *janet_srealloc(void *mem, size_t size);
|
||||
JANET_API void *janet_scalloc(size_t nmemb, size_t size);
|
||||
JANET_API void janet_sfinalizer(void *mem, ScratchFinalizer finalizer);
|
||||
JANET_API void janet_sfinalizer(void *mem, JanetScratchFinalizer finalizer);
|
||||
JANET_API void janet_sfree(void *mem);
|
||||
|
||||
/* C Library helpers */
|
||||
@@ -1440,6 +1486,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
|
||||
@@ -1477,8 +1525,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,
|
||||
@@ -1529,6 +1621,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,
|
||||
@@ -1545,6 +1640,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
|
||||
|
||||
@@ -1,40 +0,0 @@
|
||||
/*
|
||||
* Copyright (c) 2020 Calvin Rose
|
||||
*
|
||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
* deal in the Software without restriction, including without limitation the
|
||||
* rights to use, copy, modify, merge, publish, distribute, sublicense, and/or
|
||||
* sell copies of the Software, and to permit persons to whom the Software is
|
||||
* furnished to do so, subject to the following conditions:
|
||||
*
|
||||
* The above copyright notice and this permission notice shall be included in
|
||||
* all copies or substantial portions of the Software.
|
||||
*
|
||||
* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
|
||||
* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
|
||||
* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
|
||||
* AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
|
||||
* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
|
||||
* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS
|
||||
* IN THE SOFTWARE.
|
||||
*/
|
||||
|
||||
#ifndef JANET_LINE_H_defined
|
||||
#define JANET_LINE_H_defined
|
||||
|
||||
#if !defined(_POSIX_C_SOURCE)
|
||||
#define _POSIX_C_SOURCE 200112L
|
||||
#endif
|
||||
|
||||
#ifndef JANET_AMALG
|
||||
#include <janet.h>
|
||||
#endif
|
||||
|
||||
void janet_line_init();
|
||||
void janet_line_deinit();
|
||||
|
||||
void janet_line_get(const char *p, JanetBuffer *buffer);
|
||||
Janet janet_line_getter(int32_t argc, Janet *argv);
|
||||
|
||||
#endif
|
||||
@@ -1,90 +0,0 @@
|
||||
/*
|
||||
* Copyright (c) 2020 Calvin Rose
|
||||
*
|
||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
* deal in the Software without restriction, including without limitation the
|
||||
* rights to use, copy, modify, merge, publish, distribute, sublicense, and/or
|
||||
* sell copies of the Software, and to permit persons to whom the Software is
|
||||
* furnished to do so, subject to the following conditions:
|
||||
*
|
||||
* The above copyright notice and this permission notice shall be included in
|
||||
* all copies or substantial portions of the Software.
|
||||
*
|
||||
* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
|
||||
* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
|
||||
* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
|
||||
* AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
|
||||
* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
|
||||
* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS
|
||||
* IN THE SOFTWARE.
|
||||
*/
|
||||
|
||||
#if !defined(_POSIX_C_SOURCE)
|
||||
#define _POSIX_C_SOURCE 200112L
|
||||
#endif
|
||||
|
||||
#ifndef JANET_AMALG
|
||||
#include <janet.h>
|
||||
#include "line.h"
|
||||
#endif
|
||||
|
||||
#ifdef _WIN32
|
||||
#include <windows.h>
|
||||
#include <shlwapi.h>
|
||||
#ifndef ENABLE_VIRTUAL_TERMINAL_PROCESSING
|
||||
#define ENABLE_VIRTUAL_TERMINAL_PROCESSING 0x0004
|
||||
#endif
|
||||
#endif
|
||||
|
||||
int main(int argc, char **argv) {
|
||||
int i, status;
|
||||
JanetArray *args;
|
||||
JanetTable *env;
|
||||
|
||||
#ifdef _WIN32
|
||||
/* Enable color console on windows 10 console and utf8 output. */
|
||||
HANDLE hOut = GetStdHandle(STD_OUTPUT_HANDLE);
|
||||
DWORD dwMode = 0;
|
||||
GetConsoleMode(hOut, &dwMode);
|
||||
dwMode |= ENABLE_VIRTUAL_TERMINAL_PROCESSING;
|
||||
SetConsoleMode(hOut, dwMode);
|
||||
SetConsoleOutputCP(65001);
|
||||
#endif
|
||||
|
||||
/* Set up VM */
|
||||
janet_init();
|
||||
|
||||
/* Replace original getline with new line getter */
|
||||
JanetTable *replacements = janet_table(0);
|
||||
janet_table_put(replacements, janet_csymbolv("getline"), janet_wrap_cfunction(janet_line_getter));
|
||||
janet_line_init();
|
||||
|
||||
/* Get core env */
|
||||
env = janet_core_env(replacements);
|
||||
|
||||
/* Create args tuple */
|
||||
args = janet_array(argc);
|
||||
for (i = 1; i < argc; i++)
|
||||
janet_array_push(args, janet_cstringv(argv[i]));
|
||||
|
||||
/* Save current executable path to (dyn :executable) */
|
||||
janet_table_put(env, janet_ckeywordv("executable"), janet_cstringv(argv[0]));
|
||||
|
||||
/* Run startup script */
|
||||
Janet mainfun, out;
|
||||
janet_resolve(env, janet_csymbol("cli-main"), &mainfun);
|
||||
Janet mainargs[1] = { janet_wrap_array(args) };
|
||||
JanetFiber *fiber = janet_fiber(janet_unwrap_function(mainfun), 64, 1, mainargs);
|
||||
fiber->env = env;
|
||||
status = janet_continue(fiber, janet_wrap_nil(), &out);
|
||||
if (status != JANET_SIGNAL_OK) {
|
||||
janet_stacktrace(fiber, out);
|
||||
}
|
||||
|
||||
/* Deinitialize vm */
|
||||
janet_deinit();
|
||||
janet_line_deinit();
|
||||
|
||||
return status;
|
||||
}
|
||||
@@ -24,9 +24,25 @@
|
||||
#define _POSIX_C_SOURCE 200112L
|
||||
#endif
|
||||
|
||||
#ifndef JANET_AMALG
|
||||
#include "line.h"
|
||||
#include <janet.h>
|
||||
|
||||
#ifdef _WIN32
|
||||
#include <windows.h>
|
||||
#include <shlwapi.h>
|
||||
#ifndef ENABLE_VIRTUAL_TERMINAL_PROCESSING
|
||||
#define ENABLE_VIRTUAL_TERMINAL_PROCESSING 0x0004
|
||||
#endif
|
||||
#endif
|
||||
|
||||
void janet_line_init();
|
||||
void janet_line_deinit();
|
||||
|
||||
void janet_line_get(const char *p, JanetBuffer *buffer);
|
||||
Janet janet_line_getter(int32_t argc, Janet *argv);
|
||||
|
||||
/*
|
||||
* Line Editing
|
||||
*/
|
||||
|
||||
static JANET_THREAD_LOCAL JanetTable *gbl_complete_env;
|
||||
|
||||
@@ -67,7 +83,7 @@ void janet_line_deinit() {
|
||||
}
|
||||
|
||||
void janet_line_get(const char *p, JanetBuffer *buffer) {
|
||||
FILE *out = janet_dynfile("out", stdout);
|
||||
FILE *out = janet_dynfile("err", stderr);
|
||||
fputs(p, out);
|
||||
fflush(out);
|
||||
simpleline(buffer);
|
||||
@@ -80,8 +96,6 @@ void janet_line_get(const char *p, JanetBuffer *buffer) {
|
||||
https://github.com/antirez/linenoise/blob/master/linenoise.c
|
||||
*/
|
||||
|
||||
#include <janet.h>
|
||||
|
||||
#include <termios.h>
|
||||
#include <unistd.h>
|
||||
#include <stdlib.h>
|
||||
@@ -114,6 +128,7 @@ static JANET_THREAD_LOCAL int gbl_sigint_flag = 0;
|
||||
static JANET_THREAD_LOCAL struct termios gbl_termios_start;
|
||||
static JANET_THREAD_LOCAL JanetByteView gbl_matches[JANET_MATCH_MAX];
|
||||
static JANET_THREAD_LOCAL int gbl_match_count = 0;
|
||||
static JANET_THREAD_LOCAL int gbl_lines_below = 0;
|
||||
|
||||
/* Unsupported terminal list from linenoise */
|
||||
static const char *badterms[] = {
|
||||
@@ -236,6 +251,17 @@ static void refresh(void) {
|
||||
janet_buffer_deinit(&b);
|
||||
}
|
||||
|
||||
static void clearlines(void) {
|
||||
for (int i = 0; i < gbl_lines_below; i++) {
|
||||
fprintf(stderr, "\x1b[1B\x1b[999D\x1b[K");
|
||||
}
|
||||
if (gbl_lines_below) {
|
||||
fprintf(stderr, "\x1b[%dA\x1b[999D", gbl_lines_below);
|
||||
fflush(stderr);
|
||||
gbl_lines_below = 0;
|
||||
}
|
||||
}
|
||||
|
||||
static int insert(char c, int draw) {
|
||||
if (gbl_len < JANET_LINE_MAX - 1) {
|
||||
if (gbl_len == gbl_pos) {
|
||||
@@ -268,10 +294,8 @@ static void historymove(int delta) {
|
||||
gbl_historyi += delta;
|
||||
if (gbl_historyi < 0) {
|
||||
gbl_historyi = 0;
|
||||
return;
|
||||
} else if (gbl_historyi >= gbl_history_count) {
|
||||
gbl_historyi = gbl_history_count - 1;
|
||||
return;
|
||||
}
|
||||
strncpy(gbl_buf, gbl_history[gbl_historyi], JANET_LINE_MAX - 1);
|
||||
gbl_pos = gbl_len = strlen(gbl_buf);
|
||||
@@ -299,10 +323,20 @@ static void addhistory(void) {
|
||||
}
|
||||
|
||||
static void replacehistory(void) {
|
||||
char *newline = sdup(gbl_buf);
|
||||
if (!newline) return;
|
||||
free(gbl_history[0]);
|
||||
gbl_history[0] = newline;
|
||||
/* History count is always > 0 here */
|
||||
if (gbl_len == 0 || (gbl_history_count > 1 && !strcmp(gbl_buf, gbl_history[1]))) {
|
||||
/* Delete history */
|
||||
free(gbl_history[0]);
|
||||
for (int i = 1; i < gbl_history_count; i++) {
|
||||
gbl_history[i - 1] = gbl_history[i];
|
||||
}
|
||||
gbl_history_count--;
|
||||
} else {
|
||||
char *newline = sdup(gbl_buf);
|
||||
if (!newline) return;
|
||||
free(gbl_history[0]);
|
||||
gbl_history[0] = newline;
|
||||
}
|
||||
}
|
||||
|
||||
static void kleft(void) {
|
||||
@@ -312,6 +346,16 @@ static void kleft(void) {
|
||||
}
|
||||
}
|
||||
|
||||
static void kleftw(void) {
|
||||
while (gbl_pos > 0 && isspace(gbl_buf[gbl_pos - 1])) {
|
||||
gbl_pos--;
|
||||
}
|
||||
while (gbl_pos > 0 && !isspace(gbl_buf[gbl_pos - 1])) {
|
||||
gbl_pos--;
|
||||
}
|
||||
refresh();
|
||||
}
|
||||
|
||||
static void kright(void) {
|
||||
if (gbl_pos != gbl_len) {
|
||||
gbl_pos++;
|
||||
@@ -319,23 +363,54 @@ static void kright(void) {
|
||||
}
|
||||
}
|
||||
|
||||
static void kbackspace(void) {
|
||||
static void krightw(void) {
|
||||
while (gbl_pos != gbl_len && !isspace(gbl_buf[gbl_pos])) {
|
||||
gbl_pos++;
|
||||
}
|
||||
while (gbl_pos != gbl_len && isspace(gbl_buf[gbl_pos])) {
|
||||
gbl_pos++;
|
||||
}
|
||||
refresh();
|
||||
}
|
||||
|
||||
static void kbackspace(int draw) {
|
||||
if (gbl_pos > 0) {
|
||||
memmove(gbl_buf + gbl_pos - 1, gbl_buf + gbl_pos, gbl_len - gbl_pos);
|
||||
gbl_pos--;
|
||||
gbl_buf[--gbl_len] = '\0';
|
||||
refresh();
|
||||
if (draw) refresh();
|
||||
}
|
||||
}
|
||||
|
||||
static void kdelete(void) {
|
||||
static void kdelete(int draw) {
|
||||
if (gbl_pos != gbl_len) {
|
||||
memmove(gbl_buf + gbl_pos, gbl_buf + gbl_pos + 1, gbl_len - gbl_pos);
|
||||
gbl_buf[--gbl_len] = '\0';
|
||||
refresh();
|
||||
if (draw) refresh();
|
||||
}
|
||||
}
|
||||
|
||||
static void kbackspacew(void) {
|
||||
while (gbl_pos && isspace(gbl_buf[gbl_pos - 1])) {
|
||||
kbackspace(0);
|
||||
}
|
||||
while (gbl_pos && !isspace(gbl_buf[gbl_pos - 1])) {
|
||||
kbackspace(0);
|
||||
}
|
||||
refresh();
|
||||
}
|
||||
|
||||
static void kdeletew(void) {
|
||||
while (gbl_pos < gbl_len && isspace(gbl_buf[gbl_pos])) {
|
||||
kdelete(0);
|
||||
}
|
||||
while (gbl_pos < gbl_len && !isspace(gbl_buf[gbl_pos])) {
|
||||
kdelete(0);
|
||||
}
|
||||
refresh();
|
||||
}
|
||||
|
||||
|
||||
/* See tools/symchargen.c */
|
||||
static int is_symbol_char_gen(uint8_t c) {
|
||||
if (c & 0x80) return 1;
|
||||
@@ -440,7 +515,6 @@ static void check_specials(JanetByteView src) {
|
||||
check_cmatch(src, "while");
|
||||
}
|
||||
|
||||
/* TODO - check against special forms and print in alphabetical order */
|
||||
static void kshowcomp(void) {
|
||||
JanetTable *env = gbl_complete_env;
|
||||
if (env == NULL) {
|
||||
@@ -449,6 +523,10 @@ static void kshowcomp(void) {
|
||||
return;
|
||||
}
|
||||
|
||||
/* Advance while on symbol char */
|
||||
while (is_symbol_char_gen(gbl_buf[gbl_pos]))
|
||||
gbl_pos++;
|
||||
|
||||
JanetByteView prefix = get_symprefix();
|
||||
if (prefix.len == 0) return;
|
||||
|
||||
@@ -471,29 +549,39 @@ static void kshowcomp(void) {
|
||||
insert(lcp.bytes[i], 0);
|
||||
}
|
||||
|
||||
if (!gbl_lines_below && prefix.len != lcp.len) return;
|
||||
|
||||
int32_t maxlen = 0;
|
||||
for (int i = 0; i < gbl_match_count; i++)
|
||||
if (gbl_matches[i].len > maxlen)
|
||||
maxlen = gbl_matches[i].len;
|
||||
|
||||
int num_cols = getcols();
|
||||
clearlines();
|
||||
if (gbl_match_count >= 2) {
|
||||
|
||||
norawmode();
|
||||
|
||||
/* Second pass, print */
|
||||
int col_width = maxlen + 4;
|
||||
int cols = num_cols / col_width;
|
||||
if (cols == 0) cols = 1;
|
||||
int current_col = 0;
|
||||
for (int i = 0; i < gbl_match_count; i++) {
|
||||
if (current_col == 0) printf("\n");
|
||||
printf("%-*s", col_width, (const char *) gbl_matches[i].bytes);
|
||||
if (current_col == 0) {
|
||||
putc('\n', stderr);
|
||||
gbl_lines_below++;
|
||||
}
|
||||
JanetByteView s = gbl_matches[i];
|
||||
fprintf(stderr, "%s", (const char *) s.bytes);
|
||||
for (int j = s.len; j < col_width; j++) {
|
||||
putc(' ', stderr);
|
||||
}
|
||||
current_col = (current_col + 1) % cols;
|
||||
}
|
||||
printf("\n");
|
||||
|
||||
rawmode();
|
||||
/* Go up to original line (zsh-like autocompletion) */
|
||||
fprintf(stderr, "\x1B[%dA", gbl_lines_below);
|
||||
|
||||
fflush(stderr);
|
||||
}
|
||||
}
|
||||
|
||||
@@ -510,32 +598,15 @@ static int line() {
|
||||
if (write(STDOUT_FILENO, gbl_prompt, gbl_plen) == -1) return -1;
|
||||
for (;;) {
|
||||
char c;
|
||||
int nread;
|
||||
char seq[3];
|
||||
|
||||
nread = read(STDIN_FILENO, &c, 1);
|
||||
if (nread <= 0) return -1;
|
||||
if (read(STDIN_FILENO, &c, 1) <= 0) return -1;
|
||||
|
||||
switch (c) {
|
||||
default:
|
||||
if (c < 0x20) break;
|
||||
if (insert(c, 1)) return -1;
|
||||
break;
|
||||
case 9: /* tab */
|
||||
kshowcomp();
|
||||
refresh();
|
||||
break;
|
||||
case 13: /* enter */
|
||||
return 0;
|
||||
case 3: /* ctrl-c */
|
||||
errno = EAGAIN;
|
||||
gbl_sigint_flag = 1;
|
||||
return -1;
|
||||
case 127: /* backspace */
|
||||
case 8: /* ctrl-h */
|
||||
kbackspace();
|
||||
break;
|
||||
case 4: /* ctrl-d, eof */
|
||||
return -1;
|
||||
case 1: /* ctrl-a */
|
||||
gbl_pos = 0;
|
||||
refresh();
|
||||
@@ -543,6 +614,18 @@ static int line() {
|
||||
case 2: /* ctrl-b */
|
||||
kleft();
|
||||
break;
|
||||
case 3: /* ctrl-c */
|
||||
errno = EAGAIN;
|
||||
gbl_sigint_flag = 1;
|
||||
clearlines();
|
||||
return -1;
|
||||
case 4: /* ctrl-d, eof */
|
||||
if (gbl_len == 0) { /* quit on empty line */
|
||||
clearlines();
|
||||
return -1;
|
||||
}
|
||||
kdelete(1);
|
||||
break;
|
||||
case 5: /* ctrl-e */
|
||||
gbl_pos = gbl_len;
|
||||
refresh();
|
||||
@@ -550,48 +633,100 @@ static int line() {
|
||||
case 6: /* ctrl-f */
|
||||
kright();
|
||||
break;
|
||||
case 21:
|
||||
gbl_buf[0] = '\0';
|
||||
gbl_pos = gbl_len = 0;
|
||||
case 127: /* backspace */
|
||||
case 8: /* ctrl-h */
|
||||
kbackspace(1);
|
||||
break;
|
||||
case 9: /* tab */
|
||||
kshowcomp();
|
||||
refresh();
|
||||
break;
|
||||
case 11: /* ctrl-k */
|
||||
gbl_buf[gbl_pos] = '\0';
|
||||
gbl_len = gbl_pos;
|
||||
refresh();
|
||||
break;
|
||||
case 12: /* ctrl-l */
|
||||
clear();
|
||||
refresh();
|
||||
break;
|
||||
case 13: /* enter */
|
||||
clearlines();
|
||||
return 0;
|
||||
case 14: /* ctrl-n */
|
||||
historymove(-1);
|
||||
break;
|
||||
case 16: /* ctrl-p */
|
||||
historymove(1);
|
||||
break;
|
||||
case 21: { /* ctrl-u */
|
||||
memmove(gbl_buf, gbl_buf + gbl_pos, gbl_len - gbl_pos);
|
||||
gbl_len -= gbl_pos;
|
||||
gbl_buf[gbl_len] = '\0';
|
||||
gbl_pos = 0;
|
||||
refresh();
|
||||
break;
|
||||
}
|
||||
case 23: /* ctrl-w */
|
||||
kbackspacew();
|
||||
break;
|
||||
case 26: /* ctrl-z */
|
||||
norawmode();
|
||||
kill(getpid(), SIGSTOP);
|
||||
rawmode();
|
||||
refresh();
|
||||
break;
|
||||
case 12:
|
||||
clear();
|
||||
refresh();
|
||||
break;
|
||||
case 27: /* escape sequence */
|
||||
/* Read the next two bytes representing the escape sequence.
|
||||
* Use two calls to handle slow terminals returning the two
|
||||
* chars at different times. */
|
||||
if (read(STDIN_FILENO, seq, 1) == -1) break;
|
||||
if (read(STDIN_FILENO, seq + 1, 1) == -1) break;
|
||||
/* Esc[ = Control Sequence Introducer (CSI) */
|
||||
if (seq[0] == '[') {
|
||||
if (read(STDIN_FILENO, seq + 1, 1) == -1) break;
|
||||
if (seq[1] >= '0' && seq[1] <= '9') {
|
||||
/* Extended escape, read additional byte. */
|
||||
if (read(STDIN_FILENO, seq + 2, 1) == -1) break;
|
||||
if (seq[2] == '~') {
|
||||
switch (seq[1]) {
|
||||
case '1': /* Home */
|
||||
gbl_pos = 0;
|
||||
refresh();
|
||||
break;
|
||||
case '3': /* delete */
|
||||
kdelete();
|
||||
kdelete(1);
|
||||
break;
|
||||
case '4': /* End */
|
||||
gbl_pos = gbl_len;
|
||||
refresh();
|
||||
break;
|
||||
default:
|
||||
break;
|
||||
}
|
||||
}
|
||||
} else {
|
||||
} else if (seq[0] == 'O') {
|
||||
if (read(STDIN_FILENO, seq + 1, 1) == -1) break;
|
||||
switch (seq[1]) {
|
||||
default:
|
||||
break;
|
||||
case 'A':
|
||||
case 'H': /* Home (some keyboards) */
|
||||
gbl_pos = 0;
|
||||
refresh();
|
||||
break;
|
||||
case 'F': /* End (some keyboards) */
|
||||
gbl_pos = gbl_len;
|
||||
refresh();
|
||||
break;
|
||||
}
|
||||
} else {
|
||||
switch (seq[1]) {
|
||||
/* Single escape sequences */
|
||||
default:
|
||||
break;
|
||||
case 'A': /* Up */
|
||||
historymove(1);
|
||||
break;
|
||||
case 'B':
|
||||
case 'B': /* Down */
|
||||
historymove(-1);
|
||||
break;
|
||||
case 'C': /* Right */
|
||||
@@ -600,27 +735,38 @@ static int line() {
|
||||
case 'D': /* Left */
|
||||
kleft();
|
||||
break;
|
||||
case 'H':
|
||||
case 'H': /* Home */
|
||||
gbl_pos = 0;
|
||||
refresh();
|
||||
break;
|
||||
case 'F':
|
||||
case 'F': /* End */
|
||||
gbl_pos = gbl_len;
|
||||
refresh();
|
||||
break;
|
||||
}
|
||||
}
|
||||
} else if (seq[0] == 'O') {
|
||||
switch (seq[1]) {
|
||||
} else {
|
||||
/* Check alt-(shift) bindings */
|
||||
switch (seq[0]) {
|
||||
default:
|
||||
break;
|
||||
case 'H':
|
||||
gbl_pos = 0;
|
||||
refresh();
|
||||
case 'd': /* Alt-d */
|
||||
kdeletew();
|
||||
break;
|
||||
case 'F':
|
||||
gbl_pos = gbl_len;
|
||||
refresh();
|
||||
case 'b': /* Alt-b */
|
||||
kleftw();
|
||||
break;
|
||||
case 'f': /* Alt-f */
|
||||
krightw();
|
||||
break;
|
||||
case ',': /* Alt-, */
|
||||
historymove(JANET_HISTORY_MAX);
|
||||
break;
|
||||
case '.': /* Alt-. */
|
||||
historymove(-JANET_HISTORY_MAX);
|
||||
break;
|
||||
case 127: /* Alt-backspace */
|
||||
kbackspacew();
|
||||
break;
|
||||
}
|
||||
}
|
||||
@@ -655,7 +801,7 @@ void janet_line_get(const char *p, JanetBuffer *buffer) {
|
||||
gbl_prompt = p;
|
||||
buffer->count = 0;
|
||||
gbl_historyi = 0;
|
||||
FILE *out = janet_dynfile("out", stdout);
|
||||
FILE *out = janet_dynfile("err", stderr);
|
||||
if (!isatty(STDIN_FILENO) || !checktermsupport()) {
|
||||
simpleline(buffer);
|
||||
return;
|
||||
@@ -684,3 +830,59 @@ void janet_line_get(const char *p, JanetBuffer *buffer) {
|
||||
}
|
||||
|
||||
#endif
|
||||
|
||||
/*
|
||||
* Entry
|
||||
*/
|
||||
|
||||
int main(int argc, char **argv) {
|
||||
int i, status;
|
||||
JanetArray *args;
|
||||
JanetTable *env;
|
||||
|
||||
#ifdef _WIN32
|
||||
/* Enable color console on windows 10 console and utf8 output. */
|
||||
HANDLE hOut = GetStdHandle(STD_OUTPUT_HANDLE);
|
||||
DWORD dwMode = 0;
|
||||
GetConsoleMode(hOut, &dwMode);
|
||||
dwMode |= ENABLE_VIRTUAL_TERMINAL_PROCESSING;
|
||||
SetConsoleMode(hOut, dwMode);
|
||||
SetConsoleOutputCP(65001);
|
||||
#endif
|
||||
|
||||
/* Set up VM */
|
||||
janet_init();
|
||||
|
||||
/* Replace original getline with new line getter */
|
||||
JanetTable *replacements = janet_table(0);
|
||||
janet_table_put(replacements, janet_csymbolv("getline"), janet_wrap_cfunction(janet_line_getter));
|
||||
janet_line_init();
|
||||
|
||||
/* Get core env */
|
||||
env = janet_core_env(replacements);
|
||||
|
||||
/* Create args tuple */
|
||||
args = janet_array(argc);
|
||||
for (i = 1; i < argc; i++)
|
||||
janet_array_push(args, janet_cstringv(argv[i]));
|
||||
|
||||
/* Save current executable path to (dyn :executable) */
|
||||
janet_table_put(env, janet_ckeywordv("executable"), janet_cstringv(argv[0]));
|
||||
|
||||
/* Run startup script */
|
||||
Janet mainfun, out;
|
||||
janet_resolve(env, janet_csymbol("cli-main"), &mainfun);
|
||||
Janet mainargs[1] = { janet_wrap_array(args) };
|
||||
JanetFiber *fiber = janet_fiber(janet_unwrap_function(mainfun), 64, 1, mainargs);
|
||||
fiber->env = env;
|
||||
status = janet_continue(fiber, janet_wrap_nil(), &out);
|
||||
if (status != JANET_SIGNAL_OK) {
|
||||
janet_stacktrace(fiber, out);
|
||||
}
|
||||
|
||||
/* Deinitialize vm */
|
||||
janet_deinit();
|
||||
janet_line_deinit();
|
||||
|
||||
return status;
|
||||
}
|
||||
@@ -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)
|
||||
|
||||
@@ -72,9 +72,6 @@
|
||||
"trap INT64_MIN / -1"
|
||||
(:/ (int/s64 "-0x8000_0000_0000_0000") -1))
|
||||
|
||||
# in place operators
|
||||
(assert (let [a (u64 1e10)] (:+! a 1000000 "1000000" "0xffff") (:= a 10002065535)) "in place operators")
|
||||
|
||||
# int64 typed arrays
|
||||
(assert (let [t (tarray/new :int64 10)
|
||||
b (i64 1000)]
|
||||
@@ -167,6 +164,11 @@
|
||||
(defn test-expand [path temp]
|
||||
(string (module/expand-path path temp)))
|
||||
|
||||
# Right hand operators
|
||||
(assert (= (int/s64 (sum (range 10))) (sum (map int/s64 (range 10)))) "right hand operators 1")
|
||||
(assert (= (int/s64 (product (range 1 10))) (product (map int/s64 (range 1 10)))) "right hand operators 2")
|
||||
(assert (= (int/s64 15) (bor 10 (int/s64 5)) (bor (int/s64 10) 5)) "right hand operators 3")
|
||||
|
||||
(assert (= (test-expand "abc" ":cur:/:all:") "some-dir/abc") "module/expand-path 1")
|
||||
(assert (= (test-expand "./abc" ":cur:/:all:") "some-dir/abc") "module/expand-path 2")
|
||||
(assert (= (test-expand "abc/def.txt" ":cur:/:name:") "some-dir/def.txt") "module/expand-path 3")
|
||||
|
||||
@@ -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 @""]
|
||||
|
||||
197
test/suite8.janet
Normal file
197
test/suite8.janet
Normal file
@@ -0,0 +1,197 @@
|
||||
# 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")
|
||||
|
||||
(end-suite)
|
||||
104
tools/xxd.c
104
tools/xxd.c
@@ -1,104 +0,0 @@
|
||||
/*
|
||||
* Copyright (c) 2020 Calvin Rose
|
||||
*
|
||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
* deal in the Software without restriction, including without limitation the
|
||||
* rights to use, copy, modify, merge, publish, distribute, sublicense, and/or
|
||||
* sell copies of the Software, and to permit persons to whom the Software is
|
||||
* furnished to do so, subject to the following conditions:
|
||||
*
|
||||
* The above copyright notice and this permission notice shall be included in
|
||||
* all copies or substantial portions of the Software.
|
||||
*
|
||||
* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
|
||||
* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
|
||||
* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
|
||||
* AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
|
||||
* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
|
||||
* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS
|
||||
* IN THE SOFTWARE.
|
||||
*/
|
||||
|
||||
/* Simple clone of the xxd tool used at build time. Used to
|
||||
* create headers out of source files. Only used for core libraries
|
||||
* like the bootstrapping code and the stl. */
|
||||
|
||||
#include <stdlib.h>
|
||||
#include <stdio.h>
|
||||
#include <stdint.h>
|
||||
|
||||
#define BUFSIZE 1024
|
||||
#define PERLINE 10
|
||||
|
||||
int main(int argc, const char **argv) {
|
||||
|
||||
static const char hex[] = "0123456789ABCDEF";
|
||||
char buf[BUFSIZE];
|
||||
size_t bytesRead = 0;
|
||||
int32_t totalRead = 0;
|
||||
int lineIndex = 0;
|
||||
int line = 0;
|
||||
|
||||
if (argc != 4) {
|
||||
fprintf(stderr, "Usage: %s infile outfile symbol\n", argv[0]);
|
||||
return 1;
|
||||
}
|
||||
|
||||
/* Open the files */
|
||||
FILE *in = fopen(argv[1], "rb");
|
||||
FILE *out = fopen(argv[2], "wb");
|
||||
|
||||
/* Check if files open successfully */
|
||||
if (in == NULL) {
|
||||
fprintf(stderr, "Could not open input file %s\n", argv[1]);
|
||||
return 1;
|
||||
} else if (out == NULL) {
|
||||
fprintf(stderr, "Could not open output file %s\n", argv[2]);
|
||||
return 1;
|
||||
}
|
||||
|
||||
/* Write the header */
|
||||
fprintf(out, "/* Auto generated - DO NOT EDIT */\n\n#include <stdint.h>\n\n");
|
||||
fprintf(out, "static const unsigned char bytes_%s[] = {", argv[3]);
|
||||
|
||||
/* Read in chunks from buffer */
|
||||
while ((bytesRead = fread(buf, 1, sizeof(buf), in)) > 0) {
|
||||
size_t i;
|
||||
totalRead += bytesRead;
|
||||
for (i = 0; i < bytesRead; ++i) {
|
||||
int byte = ((uint8_t *)buf) [i];
|
||||
|
||||
/* Write the byte */
|
||||
if (lineIndex++ == 0) {
|
||||
if (line++)
|
||||
fputc(',', out);
|
||||
fputs("\n ", out);
|
||||
} else {
|
||||
fputs(", ", out);
|
||||
}
|
||||
fputs("0x", out);
|
||||
fputc(hex[byte >> 4], out);
|
||||
fputc(hex[byte & 0xF], out);
|
||||
|
||||
/* Make line index wrap */
|
||||
if (lineIndex >= PERLINE)
|
||||
lineIndex = 0;
|
||||
|
||||
}
|
||||
}
|
||||
|
||||
/* Write the tail */
|
||||
fputs("\n};\n\n", out);
|
||||
|
||||
fprintf(out, "const unsigned char *%s = bytes_%s;\n\n", argv[3], argv[3]);
|
||||
|
||||
/* Write chunk size */
|
||||
fprintf(out, "int32_t %s_size = %d;\n", argv[3], totalRead);
|
||||
|
||||
/* Close the file handles */
|
||||
fclose(in);
|
||||
fclose(out);
|
||||
|
||||
return 0;
|
||||
}
|
||||
Reference in New Issue
Block a user