mirror of
https://github.com/janet-lang/janet
synced 2025-10-28 14:17:42 +00:00
Compare commits
190 Commits
appveyor-e
...
v1.9.0
| Author | SHA1 | Date | |
|---|---|---|---|
|
|
235605bfa4 | ||
|
|
e8b3587946 | ||
|
|
9040ac6a0c | ||
|
|
a73ba56ebb | ||
|
|
1168f47768 | ||
|
|
73dba691b1 | ||
|
|
b1f76139a7 | ||
|
|
6b986fecb0 | ||
|
|
535ab8302b | ||
|
|
7125b3430c | ||
|
|
0615d09b7a | ||
|
|
1add0c7d43 | ||
|
|
8194f5ccaf | ||
|
|
057486cf56 | ||
|
|
f94e726271 | ||
|
|
95660002e1 | ||
|
|
95c669389b | ||
|
|
084fc9776d | ||
|
|
1498fdb7b0 | ||
|
|
79c3139748 | ||
|
|
bdd64f5656 | ||
|
|
dc3e9fb77c | ||
|
|
4b417c0e9d | ||
|
|
06c28f3a4d | ||
|
|
688fe6db5e | ||
|
|
9aefb59afe | ||
|
|
e3862b86b5 | ||
|
|
125cd222bb | ||
|
|
a0f351c9fa | ||
|
|
f7b49a2c91 | ||
|
|
fd70b47768 | ||
|
|
5d1fd390a6 | ||
|
|
8b5663e385 | ||
|
|
8b5bcaee3c | ||
|
|
ca845aa256 | ||
|
|
761ea65d81 | ||
|
|
1dc32d5e3d | ||
|
|
1c0a015cc8 | ||
|
|
bee415217d | ||
|
|
73989f5cc7 | ||
|
|
dd458c8ab5 | ||
|
|
63e9790123 | ||
|
|
70e1f3ac81 | ||
|
|
67f1872f4a | ||
|
|
8bbb7907d6 | ||
|
|
c98e1f3cae | ||
|
|
6b0f93ce8a | ||
|
|
80f19a0ab7 | ||
|
|
41894eb285 | ||
|
|
3535efd977 | ||
|
|
f6bd41ada7 | ||
|
|
7b5f40772f | ||
|
|
d2ebf4b52d | ||
|
|
0fe5c672a6 | ||
|
|
ce7d51f9be | ||
|
|
cc1f84d1d3 | ||
|
|
74126d9f24 | ||
|
|
69eb9531da | ||
|
|
da4d8254fa | ||
|
|
57332c5ccf | ||
|
|
9bc5ac05c4 | ||
|
|
0a4d58468e | ||
|
|
8ce092da68 | ||
|
|
fce1529bf2 | ||
|
|
61edf22a45 | ||
|
|
84974d6c56 | ||
|
|
da438a93e0 | ||
|
|
a87015598c | ||
|
|
c335bf5dc5 | ||
|
|
c6a782c0ce | ||
|
|
d148e14aa2 | ||
|
|
748a5d41c1 | ||
|
|
c876e63010 | ||
|
|
23b811243f | ||
|
|
99d9c57154 | ||
|
|
13559baecc | ||
|
|
481647ed5d | ||
|
|
5c162ce588 | ||
|
|
e1b6175efd | ||
|
|
ea46f096c2 | ||
|
|
da88dd8cfa | ||
|
|
9b5c6112e5 | ||
|
|
ea1341a129 | ||
|
|
343cb779d2 | ||
|
|
b0af01a762 | ||
|
|
d8617514f8 | ||
|
|
e579d1d89f | ||
|
|
63812c9f80 | ||
|
|
676a0afe4c | ||
|
|
42c257d0fc | ||
|
|
d5e5c98dc8 | ||
|
|
12d21dcb85 | ||
|
|
5054eb4276 | ||
|
|
122c77dbf6 | ||
|
|
3c66cab4e7 | ||
|
|
738fd479b3 | ||
|
|
5c612095a1 | ||
|
|
3e60e82529 | ||
|
|
60f8dd0bfc | ||
|
|
2a7008a82c | ||
|
|
0d3c6abee8 | ||
|
|
4a693222b4 | ||
|
|
82e052f2ec | ||
|
|
0745c15d7b | ||
|
|
2904c19ed9 | ||
|
|
16fe0a301c | ||
|
|
aebb8010d4 | ||
|
|
4ac382e553 | ||
|
|
596111c988 | ||
|
|
e202d30835 | ||
|
|
fbe903b277 | ||
|
|
8a89e50c13 | ||
|
|
6cb0e0dcea | ||
|
|
a147ea3e80 | ||
|
|
557988e530 | ||
|
|
67fb2c212f | ||
|
|
3765b08cca | ||
|
|
3eb84fcb13 | ||
|
|
bea76e8e08 | ||
|
|
f5433dcaa4 | ||
|
|
ef3b953a42 | ||
|
|
605a205008 | ||
|
|
058f63b440 | ||
|
|
71882475d6 | ||
|
|
a3d29a15df | ||
|
|
a09112404d | ||
|
|
93fc11ea21 | ||
|
|
4faa129b8e | ||
|
|
6c4ed0409d | ||
|
|
ea2811f14f | ||
|
|
8bc2987a71 | ||
|
|
1d13095d19 | ||
|
|
5ed76f197a | ||
|
|
e1f4cadf41 | ||
|
|
3b0e6357ad | ||
|
|
02f17bd4e4 | ||
|
|
b63a0796fd | ||
|
|
e6d4e729fb | ||
|
|
b75a22b753 | ||
|
|
72beeeeaaa | ||
|
|
c3c42ef56f | ||
|
|
a3c55681b2 | ||
|
|
cc70388846 | ||
|
|
fcc610f539 | ||
|
|
5bbd507858 | ||
|
|
45156c0c47 | ||
|
|
553e38ffd6 | ||
|
|
c4ca0490ee | ||
|
|
b145d47863 | ||
|
|
095827a261 | ||
|
|
87ecdb8112 | ||
|
|
98b2fa4d64 | ||
|
|
810ef7401c | ||
|
|
ae70a03383 | ||
|
|
081d132538 | ||
|
|
bb5c478704 | ||
|
|
ff6601f29e | ||
|
|
320c6c6f05 | ||
|
|
6b89da4bb2 | ||
|
|
5b82b9e101 | ||
|
|
1d0e862129 | ||
|
|
f089b2001f | ||
|
|
9f8420bf50 | ||
|
|
8275da63fb | ||
|
|
72696600d8 | ||
|
|
1aeb317863 | ||
|
|
b49b510732 | ||
|
|
a0d61e45d5 | ||
|
|
95f1ef7561 | ||
|
|
edb2fab64c | ||
|
|
464fb73d83 | ||
|
|
6a4e63a17d | ||
|
|
168f94d29a | ||
|
|
3c2b1baff2 | ||
|
|
57b08a57a0 | ||
|
|
65403ec9fe | ||
|
|
90b3730a0a | ||
|
|
16202216b2 | ||
|
|
8f1527712e | ||
|
|
01a79dc965 | ||
|
|
0df220780a | ||
|
|
f4a46ba6ea | ||
|
|
79bb9e54d5 | ||
|
|
135aff9e17 | ||
|
|
8ae6ae65a1 | ||
|
|
f4d7fd97f6 | ||
|
|
7f1f684b21 | ||
|
|
eda61455d3 | ||
|
|
c5907258c3 | ||
|
|
c0d2140d14 |
33
CHANGELOG.md
33
CHANGELOG.md
@@ -1,6 +1,39 @@
|
||||
# Changelog
|
||||
All notable changes to this project will be documented in this file.
|
||||
|
||||
## 1.9.0 - 2020-05-10
|
||||
- Add `:ldflags` option to many jpm declare functions.
|
||||
- Add `errorf` to core.
|
||||
- Add `lenprefix` combinator to PEGs.
|
||||
- Add `%M`, `%m`, `%N`, and `%n` formatters to formatting functions. These are the
|
||||
same as `%Q`, `%q`, `%P`, and `%p`, but will not truncate long values.
|
||||
- Add `fiber/root`.
|
||||
- Add beta `net/` module to core for socket based networking.
|
||||
- Add the `parse` function to parse strings of source code more conveniently.
|
||||
- Add `jpm rule-tree` subcommand.
|
||||
- Add `--offline` flag to jpm to force use of the cache.
|
||||
- Allow sending pointers and C functions across threads via `thread/send`.
|
||||
- Fix bug in `getline`.
|
||||
- Add `sh-rule` and `sh-phony` to jpm's dialect of Janet.
|
||||
- Change C api's `janet_formatb` -> `janet_formatbv`, and add new function `janet_formatb` to C api.
|
||||
- Add `edefer` macro to core.
|
||||
- A struct/table literal/constructor with duplicate keys will use the last value given.
|
||||
Previously, this was inconsistent between tables and structs, literals and constructor functions.
|
||||
- Add debugger to core. The debugger functions are only available
|
||||
in a debug repl, and are prefixed by a `.`.
|
||||
- Add `sort-by` and `sorted-by` to core.
|
||||
- Support UTF-8 escapes in strings via `\uXXXX` or `\UXXXXXX`.
|
||||
- Add `math/erf`
|
||||
- Add `math/erfc`
|
||||
- Add `math/log1p`
|
||||
- Add `math/next`
|
||||
- Add os/umask
|
||||
- Add os/perm-int
|
||||
- Add os/perm-string
|
||||
- Add :int-permissions option for os/stat.
|
||||
- Add `jpm repl` subcommand, as well as `post-deps` macro in project.janet files.
|
||||
- Various bug fixes.
|
||||
|
||||
## 1.8.1 - 2020-03-31
|
||||
- Fix bugs for big endian systems
|
||||
- Fix 1.8.0 regression on BSDs
|
||||
|
||||
29
Makefile
29
Makefile
@@ -36,6 +36,7 @@ JANET_PATH?=$(LIBDIR)/janet
|
||||
MANPATH?=$(PREFIX)/share/man/man1/
|
||||
PKG_CONFIG_PATH?=$(LIBDIR)/pkgconfig
|
||||
DEBUGGER=gdb
|
||||
SONAME_SETTER=-Wl,-soname,
|
||||
|
||||
CFLAGS:=$(CFLAGS) -std=c99 -Wall -Wextra -Isrc/include -Isrc/conf -fPIC -O2 -fvisibility=hidden
|
||||
LDFLAGS:=$(LDFLAGS) -rdynamic
|
||||
@@ -47,6 +48,7 @@ LDCONFIG:=ldconfig "$(LIBDIR)"
|
||||
UNAME:=$(shell uname -s)
|
||||
ifeq ($(UNAME), Darwin)
|
||||
CLIBS:=$(CLIBS) -ldl
|
||||
SONAME_SETTER:=-Wl,-install_name,
|
||||
LDCONFIG:=true
|
||||
else ifeq ($(UNAME), Linux)
|
||||
CLIBS:=$(CLIBS) -lrt -ldl
|
||||
@@ -94,6 +96,7 @@ JANET_CORE_SOURCES=src/core/abstract.c \
|
||||
src/core/io.c \
|
||||
src/core/marsh.c \
|
||||
src/core/math.c \
|
||||
src/core/net.c \
|
||||
src/core/os.c \
|
||||
src/core/parse.c \
|
||||
src/core/peg.c \
|
||||
@@ -146,6 +149,8 @@ build/janet.c: build/janet_boot src/boot/boot.janet
|
||||
##### Amalgamation #####
|
||||
########################
|
||||
|
||||
SONAME=libjanet.so.1.9
|
||||
|
||||
build/shell.c: src/mainclient/shell.c
|
||||
cp $< $@
|
||||
|
||||
@@ -165,7 +170,7 @@ $(JANET_TARGET): build/janet.o build/shell.o
|
||||
$(CC) $(LDFLAGS) $(CFLAGS) -o $@ $^ $(CLIBS)
|
||||
|
||||
$(JANET_LIBRARY): build/janet.o build/shell.o
|
||||
$(CC) $(LDFLAGS) $(CFLAGS) -shared -o $@ $^ $(CLIBS)
|
||||
$(CC) $(LDFLAGS) $(CFLAGS) $(SONAME_SETTER)$(SONAME) -shared -o $@ $^ $(CLIBS)
|
||||
|
||||
$(JANET_STATIC_LIBRARY): build/janet.o build/shell.o
|
||||
$(AR) rcs $@ $^
|
||||
@@ -190,12 +195,12 @@ valgrind: $(JANET_TARGET)
|
||||
test: $(JANET_TARGET) $(TEST_PROGRAMS)
|
||||
for f in test/suite*.janet; do ./$(JANET_TARGET) "$$f" || exit; done
|
||||
for f in examples/*.janet; do ./$(JANET_TARGET) -k "$$f"; done
|
||||
./$(JANET_TARGET) -k auxbin/jpm
|
||||
./$(JANET_TARGET) -k jpm
|
||||
|
||||
valtest: $(JANET_TARGET) $(TEST_PROGRAMS)
|
||||
for f in test/suite*.janet; do $(VALGRIND_COMMAND) ./$(JANET_TARGET) "$$f" || exit; done
|
||||
for f in examples/*.janet; do ./$(JANET_TARGET) -k "$$f"; done
|
||||
$(VALGRIND_COMMAND) ./$(JANET_TARGET) -k auxbin/jpm
|
||||
$(VALGRIND_COMMAND) ./$(JANET_TARGET) -k jpm
|
||||
|
||||
callgrind: $(JANET_TARGET)
|
||||
for f in test/suite*.janet; do valgrind --tool=callgrind ./$(JANET_TARGET) "$$f" || exit; done
|
||||
@@ -209,7 +214,7 @@ dist: build/janet-dist.tar.gz
|
||||
build/janet-%.tar.gz: $(JANET_TARGET) \
|
||||
src/include/janet.h src/conf/janetconf.h \
|
||||
jpm.1 janet.1 LICENSE CONTRIBUTING.md $(JANET_LIBRARY) $(JANET_STATIC_LIBRARY) \
|
||||
build/doc.html README.md build/janet.c build/shell.c auxbin/jpm
|
||||
build/doc.html README.md build/janet.c build/shell.c jpm
|
||||
$(eval JANET_DIST_DIR = "janet-$(shell basename $*)")
|
||||
mkdir -p build/$(JANET_DIST_DIR)
|
||||
cp -r $^ build/$(JANET_DIST_DIR)/
|
||||
@@ -228,8 +233,6 @@ build/doc.html: $(JANET_TARGET) tools/gendoc.janet
|
||||
##### Installation #####
|
||||
########################
|
||||
|
||||
SONAME=libjanet.so.1
|
||||
|
||||
.INTERMEDIATE: build/janet.pc
|
||||
build/janet.pc: $(JANET_TARGET)
|
||||
echo 'prefix=$(PREFIX)' > $@
|
||||
@@ -242,7 +245,7 @@ build/janet.pc: $(JANET_TARGET)
|
||||
echo "Description: Library for the Janet programming language." >> $@
|
||||
$(JANET_TARGET) -e '(print "Version: " janet/version)' >> $@
|
||||
echo 'Cflags: -I$${includedir}' >> $@
|
||||
echo 'Libs: -L$${libdir} -ljanet $(LDFLAGS)' >> $@
|
||||
echo 'Libs: -L$${libdir} -ljanet' >> $@
|
||||
echo 'Libs.private: $(CLIBS)' >> $@
|
||||
|
||||
install: $(JANET_TARGET) build/janet.pc
|
||||
@@ -256,7 +259,7 @@ install: $(JANET_TARGET) build/janet.pc
|
||||
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)'
|
||||
cp -rf jpm '$(DESTDIR)$(BINDIR)'
|
||||
mkdir -p '$(DESTDIR)$(MANPATH)'
|
||||
cp janet.1 '$(DESTDIR)$(MANPATH)'
|
||||
cp jpm.1 '$(DESTDIR)$(MANPATH)'
|
||||
@@ -287,6 +290,7 @@ build/janet.tmLanguage: tools/tm_lang_gen.janet $(JANET_TARGET)
|
||||
|
||||
clean:
|
||||
-rm -rf build vgcore.* callgrind.*
|
||||
-rm -rf test/install/build test/install/modpath
|
||||
|
||||
test-install:
|
||||
cd test/install \
|
||||
@@ -296,10 +300,11 @@ test-install:
|
||||
&& build/testexec \
|
||||
&& jpm --verbose quickbin testexec.janet build/testexec2 \
|
||||
&& build/testexec2 \
|
||||
&& jpm --verbose --testdeps --modpath=. install https://github.com/janet-lang/json.git
|
||||
cd test/install && jpm --verbose --test --modpath=. install https://github.com/janet-lang/jhydro.git
|
||||
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
|
||||
&& mkdir -p modpath \
|
||||
&& jpm --verbose --testdeps --modpath=./modpath install https://github.com/janet-lang/json.git
|
||||
cd test/install && jpm --verbose --test --modpath=./modpath install https://github.com/janet-lang/jhydro.git
|
||||
cd test/install && jpm --verbose --test --modpath=./modpath install https://github.com/janet-lang/path.git
|
||||
cd test/install && jpm --verbose --test --modpath=./modpath install https://github.com/janet-lang/argparse.git
|
||||
|
||||
.PHONY: clean install repl debug valgrind test \
|
||||
valtest emscripten dist uninstall docs grammar format
|
||||
|
||||
@@ -4,7 +4,6 @@ image:
|
||||
- Visual Studio 2019
|
||||
configuration:
|
||||
- Release
|
||||
- Debug
|
||||
platform:
|
||||
- x64
|
||||
- x86
|
||||
|
||||
@@ -116,7 +116,7 @@ copy src\include\janet.h dist\janet.h
|
||||
copy src\conf\janetconf.h dist\janetconf.h
|
||||
copy build\libjanet.lib dist\libjanet.lib
|
||||
|
||||
copy auxbin\jpm dist\jpm
|
||||
copy .\jpm dist\jpm
|
||||
copy tools\jpm.bat dist\jpm.bat
|
||||
|
||||
@rem Create installer
|
||||
|
||||
@@ -1,20 +1,18 @@
|
||||
###
|
||||
### A useful debugger library for Janet. Should be used
|
||||
### inside a debug repl.
|
||||
### inside a debug repl. This has been moved into the core.
|
||||
###
|
||||
|
||||
(defn .fiber
|
||||
"Get the current fiber being debugged."
|
||||
[]
|
||||
(if-let [entry (dyn '_fiber)]
|
||||
(entry :value)
|
||||
(dyn :fiber)))
|
||||
(dyn :fiber))
|
||||
|
||||
(defn .stack
|
||||
"Print the current fiber stack"
|
||||
[]
|
||||
(print)
|
||||
(debug/stacktrace (.fiber) "")
|
||||
(with-dyns [:err-color false] (debug/stacktrace (.fiber) ""))
|
||||
(print))
|
||||
|
||||
(defn .frame
|
||||
|
||||
6
examples/tcpclient.janet
Normal file
6
examples/tcpclient.janet
Normal file
@@ -0,0 +1,6 @@
|
||||
(with [conn (net/connect "127.0.0.1" "8000")]
|
||||
(printf "Connected to %q!" conn)
|
||||
(:write conn "Echo...")
|
||||
(print "Wrote to connection...")
|
||||
(def res (:read conn 1024))
|
||||
(pp res))
|
||||
13
examples/tcpserver.janet
Normal file
13
examples/tcpserver.janet
Normal file
@@ -0,0 +1,13 @@
|
||||
(defn handler
|
||||
"Simple handler for connections."
|
||||
[stream]
|
||||
(defer (:close stream)
|
||||
(def id (gensym))
|
||||
(def b @"")
|
||||
(print "Connection " id "!")
|
||||
(while (:read stream 1024 b)
|
||||
(:write stream b)
|
||||
(buffer/clear b))
|
||||
(printf "Done %v!" id)))
|
||||
|
||||
(net/server "127.0.0.1" "8000" handler)
|
||||
@@ -1,6 +1,7 @@
|
||||
# This file is invoked by build_win.bat
|
||||
# Relevant configuration variables are set there.
|
||||
|
||||
SetCompressor /FINAL /SOLID lzma
|
||||
Unicode True
|
||||
|
||||
!echo "Program Files: ${PROGRAMFILES}"
|
||||
@@ -110,7 +111,7 @@ section "Janet" BfWSection
|
||||
# Bin files
|
||||
file /oname=bin\janet.exe dist\janet.exe
|
||||
file /oname=logo.ico assets\icon.ico
|
||||
file /oname=bin\jpm.janet auxbin\jpm
|
||||
file /oname=bin\jpm.janet .\jpm
|
||||
file /oname=bin\jpm.bat tools\jpm.bat
|
||||
|
||||
# C headers and library files
|
||||
|
||||
12
janet.1
12
janet.1
@@ -96,6 +96,10 @@ Delete everything before the cursor on the input line.
|
||||
.BR Ctrl\-W
|
||||
Delete one word before the cursor.
|
||||
|
||||
.TP 16
|
||||
.BR Ctrl\-G
|
||||
Show documentation for the current symbol under the cursor.
|
||||
|
||||
.TP 16
|
||||
.BR Alt\-B/Alt\-F
|
||||
Move cursor backwards and forwards one word.
|
||||
@@ -148,6 +152,12 @@ Read raw input from stdin and forgo prompt history and other readline-like featu
|
||||
Execute a string of Janet source. Source code is executed in the order it is encountered, so earlier
|
||||
arguments are executed before later ones.
|
||||
|
||||
.TP
|
||||
.BR \-d
|
||||
Enable debug mode. On all terminating signals as well the debug signal, this will
|
||||
cause the debugger to come up in the REPL. Same as calling (setdyn :debug true) in a
|
||||
default repl.
|
||||
|
||||
.TP
|
||||
.BR \-n
|
||||
Disable ANSI colors in the repl. Has no effect if no repl is run.
|
||||
@@ -165,7 +175,7 @@ after an error. Persistent mode can be good for debugging and testing.
|
||||
|
||||
.TP
|
||||
.BR \-q
|
||||
Quiet output. Don't print a repl prompt or expression results to stdout.
|
||||
Hide the logo in the repl.
|
||||
|
||||
.TP
|
||||
.BR \-k
|
||||
|
||||
737
auxbin/jpm → jpm
737
auxbin/jpm → jpm
File diff suppressed because it is too large
Load Diff
42
jpm.1
42
jpm.1
@@ -24,6 +24,10 @@ More interesting are the local commands. For more information on jpm usage, see
|
||||
|
||||
.SH FLAGS
|
||||
|
||||
.TP
|
||||
.BR \-\-nocolor
|
||||
Disable color in the jpm repl.
|
||||
|
||||
.TP
|
||||
.BR \-\-verbose
|
||||
Print detailed messages of what jpm is doing, including compilation commands and other shell commands.
|
||||
@@ -32,6 +36,12 @@ Print detailed messages of what jpm is doing, including compilation commands and
|
||||
.BR \-\-test
|
||||
If passed to jpm install, runs tests before installing. Will run tests recursively on dependencies.
|
||||
|
||||
.TP
|
||||
.BR \-\-offline
|
||||
Prevents jpm from going to network to get dependencies - all dependencies should be in the cache or this command will fail.
|
||||
Use this flag with the deps and update-pkgs subcommands. This is not a surefire way to prevent a build script from accessing
|
||||
the network, for example, a build script that invokes curl will still have network access.
|
||||
|
||||
.SH OPTIONS
|
||||
|
||||
.TP
|
||||
@@ -90,19 +100,20 @@ Builds all artifacts specified in the project.janet file in the current director
|
||||
be created in the ./build/ directory.
|
||||
|
||||
.TP
|
||||
.BR install\ [\fBrepo\fR]
|
||||
.BR install\ [\fBrepo...\fR]
|
||||
|
||||
When run with no arguments, installs all installable artifacts in the current project to
|
||||
the current JANET_MODPATH for modules and JANET_BINPATH for executables and scripts. Can also
|
||||
take an optional git repository URL and will install all artifacts in that repository instead.
|
||||
When run with an argument, install does not need to be run from a jpm project directory.
|
||||
When run with an argument, install does not need to be run from a jpm project directory. Will also
|
||||
install multiple dependencies in one command.
|
||||
|
||||
.TP
|
||||
.BR uninstall\ [\fBname\fR]
|
||||
.BR uninstall\ [\fBname...\fR]
|
||||
Uninstall a project installed with install. uninstall expects the name of the project, not the
|
||||
repository url, path to installed file or executable name. The name of the project must be specified
|
||||
at the top of the project.janet file in the declare-project form. If no name is given, uninstalls
|
||||
the current project if installed.
|
||||
the current project if installed. Will also uninstall multiple packages in one command.
|
||||
|
||||
.TP
|
||||
.BR clean
|
||||
@@ -139,6 +150,12 @@ like make. run will run a single rule or build a single file.
|
||||
.BR rules
|
||||
List all rules that can be run via run. This is useful for exploring rules in the project.
|
||||
|
||||
.TP
|
||||
.BR rule-tree\ [\fBroot\fR] [\fdepth\fR]
|
||||
Show rule dependency tree in a pretty format. Optionally provide a rule to use as the tree
|
||||
root, as well as a max depth to print. By default, prints the full tree for all rules. This
|
||||
can be quite long, so it is recommended to give a root rule.
|
||||
|
||||
.TP
|
||||
.BR show-paths
|
||||
Show all of the paths used when installing and building artifacts.
|
||||
@@ -154,6 +171,23 @@ The main function is the entry point of the program and will receive command lin
|
||||
as function arguments. The entry file can import other modules, including native C modules, and
|
||||
jpm will attempt to include the dependencies into the generated executable.
|
||||
|
||||
.TP
|
||||
.BR repl
|
||||
Load the current project.janet file and start a repl in it's environment. This lets a user better
|
||||
debug the project file, as well as run rules manually.
|
||||
|
||||
.TP
|
||||
.BR make-lockfile\ [\fBfilename\fR]
|
||||
Create a lockfile. A lockfile is a record that describes what dependencies were installed at the
|
||||
time of the lockfile's creation, including exact versions. A lockfile can then be later used
|
||||
to set up that environment on a different machine via load-lockfile. By default, the lockfile
|
||||
is created at lockfile.jdn, although any path can be used.
|
||||
|
||||
.TP
|
||||
.BR load-lockfile\ [\fBfilename\fR]
|
||||
Install dependencies from a lockfile previously created with make-lockfile. By default, will look
|
||||
for a lockfile at lockfile.jdn, although any path can be used.
|
||||
|
||||
.SH ENVIRONMENT
|
||||
|
||||
.B JANET_PATH
|
||||
|
||||
12
meson.build
12
meson.build
@@ -20,7 +20,7 @@
|
||||
|
||||
project('janet', 'c',
|
||||
default_options : ['c_std=c99', 'b_lundef=false', 'default_library=both'],
|
||||
version : '1.8.1')
|
||||
version : '1.9.0')
|
||||
|
||||
# Global settings
|
||||
janet_path = join_paths(get_option('prefix'), get_option('libdir'), 'janet')
|
||||
@@ -59,6 +59,7 @@ conf.set('JANET_NO_DOCSTRINGS', not get_option('docstrings'))
|
||||
conf.set('JANET_NO_SOURCEMAPS', not get_option('sourcemaps'))
|
||||
conf.set('JANET_NO_ASSEMBLER', not get_option('assembler'))
|
||||
conf.set('JANET_NO_PEG', not get_option('peg'))
|
||||
conf.set('JANET_NO_NET', not get_option('net'))
|
||||
conf.set('JANET_REDUCED_OS', get_option('reduced_os'))
|
||||
conf.set('JANET_NO_TYPED_ARRAY', not get_option('typed_array'))
|
||||
conf.set('JANET_NO_INT_TYPES', not get_option('int_types'))
|
||||
@@ -112,6 +113,7 @@ core_src = [
|
||||
'src/core/io.c',
|
||||
'src/core/marsh.c',
|
||||
'src/core/math.c',
|
||||
'src/core/net.c',
|
||||
'src/core/os.c',
|
||||
'src/core/parse.c',
|
||||
'src/core/peg.c',
|
||||
@@ -167,6 +169,8 @@ janetc = custom_target('janetc',
|
||||
libjanet = library('janet', janetc,
|
||||
include_directories : incdir,
|
||||
dependencies : [m_dep, dl_dep, thread_dep],
|
||||
version: meson.project_version(),
|
||||
soversion: version_parts[0] + '.' + version_parts[1],
|
||||
install : true)
|
||||
|
||||
# Extra c flags - adding -fvisibility=hidden matches the Makefile and
|
||||
@@ -218,6 +222,7 @@ test_files = [
|
||||
'test/suite6.janet',
|
||||
'test/suite7.janet',
|
||||
'test/suite8.janet'
|
||||
'test/suite9.janet'
|
||||
]
|
||||
foreach t : test_files
|
||||
test(t, janet_nativeclient, args : files([t]), workdir : meson.current_source_dir())
|
||||
@@ -239,8 +244,5 @@ pkg.generate(libjanet,
|
||||
install_man('janet.1')
|
||||
install_man('jpm.1')
|
||||
install_headers(['src/include/janet.h', jconf], subdir: 'janet')
|
||||
janet_binscripts = [
|
||||
'auxbin/jpm'
|
||||
]
|
||||
install_data(sources : janet_binscripts, install_dir : get_option('bindir'))
|
||||
install_data(sources : ['jpm'], install_dir : get_option('bindir'))
|
||||
install_data(sources : ['tools/.keep'], install_dir : join_paths(get_option('libdir'), 'janet'))
|
||||
|
||||
@@ -11,6 +11,7 @@ option('peg', type : 'boolean', value : true)
|
||||
option('typed_array', type : 'boolean', value : true)
|
||||
option('int_types', type : 'boolean', value : true)
|
||||
option('prf', type : 'boolean', value : true)
|
||||
option('net', type : 'boolean', value : true)
|
||||
|
||||
option('recursion_guard', type : 'integer', min : 10, max : 8000, value : 1024)
|
||||
option('max_proto_depth', type : 'integer', min : 10, max : 8000, value : 200)
|
||||
|
||||
@@ -32,7 +32,7 @@
|
||||
(def buf (buffer "(" name))
|
||||
(while (< index arglen)
|
||||
(buffer/push-string buf " ")
|
||||
(buffer/format buf "%p" (in args index))
|
||||
(buffer/format buf "%j" (in args index))
|
||||
(set index (+ index 1)))
|
||||
(array/push modifiers (string buf ")\n\n" docstr))
|
||||
# Build return value
|
||||
@@ -141,6 +141,11 @@
|
||||
[x &opt err]
|
||||
(if x x (error (if err err "assert failure"))))
|
||||
|
||||
(defn errorf
|
||||
"A combination of error and string/format. Equivalent to (error (string/format fmt ;args))"
|
||||
[fmt & args]
|
||||
(error (string/format fmt ;args)))
|
||||
|
||||
(defmacro default
|
||||
"Define a default value for an optional argument.
|
||||
Expands to (def sym (if (= nil sym) val sym))"
|
||||
@@ -240,8 +245,8 @@
|
||||
[& body]
|
||||
(let [f (gensym) r (gensym)]
|
||||
~(let [,f (,fiber/new (fn [] ,;body) :ie)
|
||||
,r (,resume ,f)]
|
||||
[(,not= :error (,fiber/status ,f)) ,r])))
|
||||
,r (,resume ,f)]
|
||||
[(,not= :error (,fiber/status ,f)) ,r])))
|
||||
|
||||
(defmacro and
|
||||
"Evaluates to the last argument if all preceding elements are truthy, otherwise
|
||||
@@ -301,7 +306,19 @@
|
||||
,form
|
||||
(if (= (,fiber/status ,f) :dead)
|
||||
,r
|
||||
(propagate ,r ,f)))))
|
||||
(,propagate ,r ,f)))))
|
||||
|
||||
(defmacro edefer
|
||||
"Run form after body in the case that body terminates abnormally (an error or user signal 0-4).
|
||||
Otherwise, return last form in body."
|
||||
[form & body]
|
||||
(with-syms [f r]
|
||||
~(do
|
||||
(def ,f (,fiber/new (fn [] ,;body) :ti))
|
||||
(def ,r (,resume ,f))
|
||||
(if (= (,fiber/status ,f) :dead)
|
||||
,r
|
||||
(do ,form (,propagate ,r ,f))))))
|
||||
|
||||
(defmacro prompt
|
||||
"Set up a checkpoint that can be returned to. Tag should be a value
|
||||
@@ -314,7 +331,7 @@
|
||||
(def [,target ,payload] ,res)
|
||||
(if (,= ,tag ,target)
|
||||
,payload
|
||||
(propagate ,res ,fib)))))
|
||||
(,propagate ,res ,fib)))))
|
||||
|
||||
(defmacro chr
|
||||
"Convert a string of length 1 to its byte (ascii) value at compile time."
|
||||
@@ -357,7 +374,7 @@
|
||||
"Similar to with, but if binding is false or nil, evaluates
|
||||
the falsey path. Otherwise, evaluates the truthy path. In both cases,
|
||||
ctor is bound to binding."
|
||||
[[binding ctor dtor] truthy &opt falsey ]
|
||||
[[binding ctor dtor] truthy &opt falsey]
|
||||
~(if-let [,binding ,ctor]
|
||||
,(apply defer [(or dtor :close) binding] [truthy])
|
||||
,falsey))
|
||||
@@ -467,7 +484,7 @@
|
||||
(for-template i start stop 1 < + body))
|
||||
|
||||
(defmacro eachk
|
||||
"loop over each key in ds. returns nil."
|
||||
"Loop over each key in ds. Returns nil."
|
||||
[x ds & body]
|
||||
(keys-template x ds false body))
|
||||
|
||||
@@ -489,7 +506,7 @@
|
||||
that define something to loop over. They are formatted like:\n\n
|
||||
\tbinding :verb object/expression\n\n
|
||||
Where binding is a binding as passed to def, :verb is one of a set of keywords,
|
||||
and object is any janet expression. The available verbs are:\n\n
|
||||
and object is any expression. The available verbs are:\n\n
|
||||
\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
|
||||
@@ -606,9 +623,9 @@
|
||||
(case (length functions)
|
||||
0 nil
|
||||
1 (in functions 0)
|
||||
2 (let [[f g] functions] (fn [& x] (f (g ;x))))
|
||||
3 (let [[f g h] functions] (fn [& x] (f (g (h ;x)))))
|
||||
4 (let [[f g h i] functions] (fn [& x] (f (g (h (i ;x))))))
|
||||
2 (let [[f g] functions] (fn [& x] (f (g ;x))))
|
||||
3 (let [[f g h] functions] (fn [& x] (f (g (h ;x)))))
|
||||
4 (let [[f g h i] functions] (fn [& x] (f (g (h (i ;x))))))
|
||||
(let [[f g h i] functions]
|
||||
(comp (fn [x] (f (g (h (i x)))))
|
||||
;(tuple/slice functions 4 -1)))))
|
||||
@@ -648,7 +665,7 @@
|
||||
(defn last
|
||||
"Get the last element from an indexed data structure."
|
||||
[xs]
|
||||
(in xs (- (length xs) 1)))
|
||||
(get xs (- (length xs) 1)))
|
||||
|
||||
###
|
||||
###
|
||||
@@ -656,41 +673,54 @@
|
||||
###
|
||||
###
|
||||
|
||||
(def sort
|
||||
"(sort xs [, by])\n\nSort an array in-place. Uses quick-sort and is not a stable sort."
|
||||
(do
|
||||
(defn- sort-part
|
||||
[a lo hi by]
|
||||
(def pivot (in a hi))
|
||||
(var i lo)
|
||||
(for j lo hi
|
||||
(def aj (in a j))
|
||||
(when (by aj pivot)
|
||||
(def ai (in a i))
|
||||
(set (a i) aj)
|
||||
(set (a j) ai)
|
||||
(++ i)))
|
||||
(set (a hi) (in a i))
|
||||
(set (a i) pivot)
|
||||
i)
|
||||
|
||||
(defn part
|
||||
[a lo hi by]
|
||||
(def pivot (in a hi))
|
||||
(var i lo)
|
||||
(for j lo hi
|
||||
(def aj (in a j))
|
||||
(when (by aj pivot)
|
||||
(def ai (in a i))
|
||||
(set (a i) aj)
|
||||
(set (a j) ai)
|
||||
(++ i)))
|
||||
(set (a hi) (in a i))
|
||||
(set (a i) pivot)
|
||||
i)
|
||||
(defn- sort-help
|
||||
[a lo hi by]
|
||||
(when (> hi lo)
|
||||
(def piv (sort-part a lo hi by))
|
||||
(sort-help a lo (- piv 1) by)
|
||||
(sort-help a (+ piv 1) hi by))
|
||||
a)
|
||||
|
||||
(defn sort-help
|
||||
[a lo hi by]
|
||||
(when (> hi lo)
|
||||
(def piv (part a lo hi by))
|
||||
(sort-help a lo (- piv 1) by)
|
||||
(sort-help a (+ piv 1) hi by))
|
||||
a)
|
||||
(defn sort
|
||||
"Sort an array in-place. Uses quick-sort and is not a stable sort."
|
||||
[a &opt by]
|
||||
(sort-help a 0 (- (length a) 1) (or by <)))
|
||||
|
||||
(fn sort [a &opt by]
|
||||
(sort-help a 0 (- (length a) 1) (or by <)))))
|
||||
(put _env 'sort-part nil)
|
||||
(put _env 'sort-help nil)
|
||||
|
||||
(defn sort-by
|
||||
"Returns a new sorted array that compares elements by invoking
|
||||
a function on each element and comparing the result with <."
|
||||
[f ind]
|
||||
(sort ind (fn [x y] (< (f x) (f y)))))
|
||||
|
||||
(defn sorted
|
||||
"Returns a new sorted array without modifying the old one."
|
||||
[ind &opt by]
|
||||
(sort (array/slice ind) by))
|
||||
|
||||
(defn sorted-by
|
||||
"Returns a new sorted array that compares elements by invoking
|
||||
a function on each element and comparing the result with <."
|
||||
[f ind]
|
||||
(sorted ind (fn [x y] (< (f x) (f y)))))
|
||||
|
||||
(defn reduce
|
||||
"Reduce, also know as fold-left in many languages, transforms
|
||||
an indexed type (array, tuple) with a function to produce a value."
|
||||
@@ -942,7 +972,7 @@
|
||||
(reduce fop x forms))
|
||||
|
||||
(defmacro -?>
|
||||
"Short circuit threading macro. Inserts x as the last value in the first form
|
||||
"Short circuit threading macro. Inserts x as the second value in the first form
|
||||
in forms, and inserts the modified first form into the second form
|
||||
in the same manner, and so on. The pipeline will return nil
|
||||
if an intermediate value is nil.
|
||||
@@ -958,7 +988,7 @@
|
||||
(reduce fop x forms))
|
||||
|
||||
(defmacro -?>>
|
||||
"Threading macro. Inserts x as the last value in the first form
|
||||
"Short circuit threading macro. Inserts x as the last value in the first form
|
||||
in forms, and inserts the modified first form into the second form
|
||||
in the same manner, and so on. The pipeline will return nil
|
||||
if an intermediate value is nil.
|
||||
@@ -1045,7 +1075,7 @@
|
||||
[bindings & body]
|
||||
(def dyn-forms
|
||||
(seq [i :range [0 (length bindings) 2]]
|
||||
~(setdyn ,(bindings i) ,(bindings (+ i 1)))))
|
||||
~(setdyn ,(bindings i) ,(bindings (+ i 1)))))
|
||||
~(,resume (,fiber/new (fn [] ,;dyn-forms ,;body) :p)))
|
||||
|
||||
(defmacro with-vars
|
||||
@@ -1059,12 +1089,12 @@
|
||||
(def setnew (seq [i :range [0 len 2]] ['set (vars i) (vars (+ i 1))]))
|
||||
(def restoreold (seq [i :range [0 len 2]] ['set (vars i) (temp (/ i 2))]))
|
||||
(with-syms [ret f s]
|
||||
~(do
|
||||
,;saveold
|
||||
(def ,f (,fiber/new (fn [] ,;setnew ,;body) :ti))
|
||||
(def ,ret (,resume ,f))
|
||||
,;restoreold
|
||||
(if (= (,fiber/status ,f) :dead) ,ret (,propagate ,ret ,f)))))
|
||||
~(do
|
||||
,;saveold
|
||||
(def ,f (,fiber/new (fn [] ,;setnew ,;body) :ti))
|
||||
(def ,ret (,resume ,f))
|
||||
,;restoreold
|
||||
(if (= (,fiber/status ,f) :dead) ,ret (,propagate ,ret ,f)))))
|
||||
|
||||
(defn partial
|
||||
"Partial function application."
|
||||
@@ -1382,9 +1412,9 @@
|
||||
~(do (def ,pattern ,expr) ,(onmatch))))
|
||||
|
||||
(and (tuple? pattern) (= :parens (tuple/type pattern)))
|
||||
(if (and (= (pattern 0) '@) (symbol? (pattern 1)))
|
||||
(if (= (get pattern 0) '@)
|
||||
# Unification with external values
|
||||
~(if (= ,(pattern 1) ,expr) ,(onmatch) ,sentinel)
|
||||
~(if (= ,(get pattern 1) ,expr) ,(onmatch) ,sentinel)
|
||||
(match-1
|
||||
(in pattern 0) expr
|
||||
(fn []
|
||||
@@ -1418,7 +1448,7 @@
|
||||
(if (= key nil)
|
||||
(onmatch)
|
||||
~(do (def ,$val (,get ,$dict ,key))
|
||||
,(match-1 [(in pattern key) [not= nil $val]] $val aux seen)))))
|
||||
,(match-1 [(in pattern key) [not= nil $val]] $val aux seen)))))
|
||||
,sentinel)))
|
||||
|
||||
:else ~(if (= ,pattern ,expr) ,(onmatch) ,sentinel)))
|
||||
@@ -1457,10 +1487,10 @@
|
||||
###
|
||||
|
||||
(defn- env-walk
|
||||
[pred &opt env]
|
||||
[pred &opt env local]
|
||||
(default env (fiber/getenv (fiber/current)))
|
||||
(def envs @[])
|
||||
(do (var e env) (while e (array/push envs e) (set e (table/getproto e))))
|
||||
(do (var e env) (while e (array/push envs e) (set e (table/getproto e)) (if local (break))))
|
||||
(def ret-set @{})
|
||||
(loop [envi :in envs
|
||||
k :keys envi
|
||||
@@ -1469,22 +1499,24 @@
|
||||
(sort (keys ret-set)))
|
||||
|
||||
(defn all-bindings
|
||||
"Get all symbols available in an enviroment. Defaults to the current
|
||||
fiber's environment."
|
||||
[&opt env]
|
||||
(env-walk symbol? env))
|
||||
"Get all symbols available in an environment. Defaults to the current
|
||||
fiber's environment. If local is truthy, will not show inherited bindings
|
||||
(from prototype tables)."
|
||||
[&opt env local]
|
||||
(env-walk symbol? env local))
|
||||
|
||||
(defn all-dynamics
|
||||
"Get all dynamic bindings in an environment. Defaults to the current
|
||||
fiber's environment."
|
||||
[&opt env]
|
||||
(env-walk keyword? env))
|
||||
fiber's environment. If local is truthy, will not show inherited bindings
|
||||
(from prototype tables)."
|
||||
[&opt env local]
|
||||
(env-walk keyword? env local))
|
||||
|
||||
(defn doc-format
|
||||
"Reformat text to wrap at a given line."
|
||||
[text]
|
||||
[text &opt width]
|
||||
|
||||
(def maxcol (- (dyn :doc-width 80) 8))
|
||||
(def maxcol (- (or width (dyn :doc-width 80)) 8))
|
||||
(var buf @" ")
|
||||
(var word @"")
|
||||
(var current 0)
|
||||
@@ -1530,7 +1562,7 @@
|
||||
(print))
|
||||
|
||||
(defn doc*
|
||||
"Get the documentation for a symbol in a given environment."
|
||||
"Get the documentation for a symbol in a given environment. Function form of doc."
|
||||
[&opt sym]
|
||||
|
||||
(cond
|
||||
@@ -1564,7 +1596,10 @@
|
||||
(print-index identity)))
|
||||
|
||||
(defmacro doc
|
||||
"Shows documentation for the given symbol."
|
||||
"Shows documentation for the given symbol, or can show a list of available bindings.
|
||||
If sym is a symbol, will look for documentation for that symbol. If sym is a string
|
||||
or is not provided, will show all lexical and dynamic bindings in the current environment with
|
||||
that prefix (all bindings will be shown if no prefix is given)."
|
||||
[&opt sym]
|
||||
~(,doc* ',sym))
|
||||
|
||||
@@ -1676,7 +1711,7 @@
|
||||
ret)
|
||||
|
||||
(defn all
|
||||
"Returns true if all xs are truthy, otherwise the resulty of first
|
||||
"Returns true if all xs are truthy, otherwise the result of first
|
||||
falsey predicate value, (pred x)."
|
||||
[pred xs]
|
||||
(var ret true)
|
||||
@@ -1721,8 +1756,8 @@
|
||||
:array (tuple/slice (map freeze x))
|
||||
:tuple (tuple/slice (map freeze x))
|
||||
:table (if-let [p (table/getproto x)]
|
||||
(freeze (merge (table/clone p) x))
|
||||
(struct ;(map freeze (kvs x))))
|
||||
(freeze (merge (table/clone p) x))
|
||||
(struct ;(map freeze (kvs x))))
|
||||
:struct (struct ;(map freeze (kvs x)))
|
||||
:buffer (string x)
|
||||
x))
|
||||
@@ -1890,8 +1925,9 @@
|
||||
(eflush))
|
||||
|
||||
(defn run-context
|
||||
"Run a context. This evaluates expressions of janet in an environment,
|
||||
"Run a context. This evaluates expressions in an environment,
|
||||
and is encapsulates the parsing, compilation, and evaluation.
|
||||
Returns (in environment :exit-value environment) when complete.
|
||||
opts is a table or struct of options. The options are as follows:\n\n\t
|
||||
:chunks - callback to read into a buffer - default is getline\n\t
|
||||
:on-parse-error - callback when parsing fails - default is bad-parse\n\t
|
||||
@@ -1920,6 +1956,7 @@
|
||||
(default on-parse-error bad-parse)
|
||||
(default evaluator (fn evaluate [x &] (x)))
|
||||
(default where "<anonymous>")
|
||||
(default guard :ydt)
|
||||
|
||||
# Are we done yet?
|
||||
(var going true)
|
||||
@@ -1946,12 +1983,19 @@
|
||||
(string err " on line " line ", column " column)
|
||||
err))
|
||||
(on-compile-error msg errf where))))
|
||||
(or guard :a)))
|
||||
guard))
|
||||
(fiber/setenv f env)
|
||||
(while (fiber/can-resume? f)
|
||||
(def res (resume f resumeval))
|
||||
(when good (when going (set resumeval (onstatus f res))))))
|
||||
|
||||
(defn parse-err
|
||||
"Handle parser error in the correct environment"
|
||||
[p where]
|
||||
(def f (coro (on-parse-error p where)))
|
||||
(fiber/setenv f env)
|
||||
(resume f))
|
||||
|
||||
# Loop
|
||||
(def buf @"")
|
||||
(while going
|
||||
@@ -1969,12 +2013,12 @@
|
||||
(while (parser/has-more p)
|
||||
(eval1 (parser/produce p)))
|
||||
(when (= (parser/status p) :error)
|
||||
(on-parse-error p where))))
|
||||
(parse-err p where))))
|
||||
# Check final parser state
|
||||
(while (parser/has-more p)
|
||||
(eval1 (parser/produce p)))
|
||||
(when (= (parser/status p) :error)
|
||||
(on-parse-error p where))
|
||||
(parse-err p where))
|
||||
|
||||
(in env :exit-value env))
|
||||
|
||||
@@ -2021,6 +2065,19 @@
|
||||
(res)
|
||||
(error (res :error))))
|
||||
|
||||
(defn parse
|
||||
"Parse a string and return the first value. For complex parsing, such as for a repl with error handling,
|
||||
use the parser api."
|
||||
[str]
|
||||
(let [p (parser/new)]
|
||||
(parser/consume p str)
|
||||
(parser/eof p)
|
||||
(if (parser/has-more p)
|
||||
(parser/produce p)
|
||||
(if (= :error (parser/status p))
|
||||
(error (parser/error p))
|
||||
(error "no value")))))
|
||||
|
||||
(def make-image-dict
|
||||
"A table used in combination with marshal to marshal code (images), such that
|
||||
(make-image x) is the same as (marshal x make-image-dict)."
|
||||
@@ -2073,7 +2130,7 @@
|
||||
[ext loader]
|
||||
(defn- find-prefix
|
||||
[pre]
|
||||
(or (find-index |(string/has-prefix? pre ($ 0)) module/paths) 0))
|
||||
(or (find-index |(and (string? ($ 0)) (string/has-prefix? pre ($ 0))) module/paths) 0))
|
||||
(array/insert module/paths 0 [(string ":cur:/:all:" ext) loader check-.])
|
||||
(def all-index (find-prefix ":all:"))
|
||||
(array/insert module/paths all-index [(string ":all:" ext) loader not-check-.])
|
||||
@@ -2096,7 +2153,7 @@
|
||||
(when f
|
||||
(def res
|
||||
(try (do (file/read f 1) true)
|
||||
([err] nil)))
|
||||
([err] nil)))
|
||||
(file/close f)
|
||||
res))))
|
||||
|
||||
@@ -2118,8 +2175,8 @@
|
||||
(when (mod-filter checker path)
|
||||
(if (function? p)
|
||||
(when-let [res (p path)]
|
||||
(set ret [res mod-kind])
|
||||
(break))
|
||||
(set ret [res mod-kind])
|
||||
(break))
|
||||
(do
|
||||
(def fullpath (string (module/expand-path path p)))
|
||||
(when (fexists fullpath)
|
||||
@@ -2149,29 +2206,32 @@
|
||||
@{})
|
||||
|
||||
(defn dofile
|
||||
"Evaluate a file and return the resulting environment."
|
||||
[path & args]
|
||||
(def {:exit exit-on-error
|
||||
:source source
|
||||
:env env
|
||||
:expander expander
|
||||
:evaluator evaluator} (table ;args))
|
||||
"Evaluate a file and return the resulting environment. :env, :expander, and
|
||||
:evaluator are passed through to the underlying run-context call.
|
||||
If exit is true, any top level errors will trigger a call to (os/exit 1)
|
||||
after printing the error."
|
||||
[path &keys
|
||||
{:exit exit
|
||||
:env env
|
||||
:source src
|
||||
:expander expander
|
||||
:evaluator evaluator}]
|
||||
(def f (if (= (type path) :core/file)
|
||||
path
|
||||
(file/open path :rb)))
|
||||
(def path-is-file (= f path))
|
||||
(default env (make-env))
|
||||
(def spath (string path))
|
||||
(put env :current-file (if-not path-is-file spath))
|
||||
(put env :source (if-not path-is-file spath path))
|
||||
(put env :current-file (or src (if-not path-is-file spath)))
|
||||
(put env :source (or src (if-not path-is-file spath path)))
|
||||
(defn chunks [buf _] (file/read f 2048 buf))
|
||||
(defn bp [&opt x y]
|
||||
(def ret (bad-parse x y))
|
||||
(if exit-on-error (os/exit 1))
|
||||
(if exit (os/exit 1))
|
||||
ret)
|
||||
(defn bc [&opt x y z]
|
||||
(def ret (bad-compile x y z))
|
||||
(if exit-on-error (os/exit 1))
|
||||
(if exit (os/exit 1))
|
||||
ret)
|
||||
(unless f
|
||||
(error (string "could not find file " path)))
|
||||
@@ -2183,10 +2243,10 @@
|
||||
:on-status (fn [f x]
|
||||
(when (not= (fiber/status f) :dead)
|
||||
(debug/stacktrace f x)
|
||||
(if exit-on-error (os/exit 1) (eflush))))
|
||||
(if exit (os/exit 1) (eflush))))
|
||||
:evaluator evaluator
|
||||
:expander expander
|
||||
:source (if path-is-file "<anonymous>" spath)}))
|
||||
:source (or src (if path-is-file "<anonymous>" spath))}))
|
||||
(if-not path-is-file (file/close f))
|
||||
nenv)
|
||||
|
||||
@@ -2204,19 +2264,21 @@
|
||||
|
||||
(defn require
|
||||
"Require a module with the given name. Will search all of the paths in
|
||||
module/paths, then the path as a raw file path. Returns the new environment
|
||||
module/paths. Returns the new environment
|
||||
returned from compiling and running the file."
|
||||
[path & args]
|
||||
(def [fullpath mod-kind] (module/find path))
|
||||
(unless fullpath (error mod-kind))
|
||||
(if-let [check (in module/cache fullpath)]
|
||||
check
|
||||
(do
|
||||
(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)
|
||||
env)))
|
||||
(if (module/loading fullpath)
|
||||
(error (string "circular dependency " fullpath " detected"))
|
||||
(do
|
||||
(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)
|
||||
env))))
|
||||
|
||||
(defn import*
|
||||
"Function form of import. Same parameters, but the path
|
||||
@@ -2244,18 +2306,183 @@
|
||||
any errors encountered at the top level in the module will cause (os/exit 1)
|
||||
to be called. Dynamic bindings will NOT be imported."
|
||||
[path & args]
|
||||
(def argm (map (fn [x]
|
||||
(if (keyword? x)
|
||||
x
|
||||
(string x)))
|
||||
args))
|
||||
(def argm (map |(if (keyword? $) $ (string $)) args))
|
||||
(tuple import* (string path) ;argm))
|
||||
|
||||
(defmacro use
|
||||
"Similar to import, but imported bindings are not prefixed with a namespace
|
||||
identifier. Can also import multiple modules in one shot."
|
||||
[& modules]
|
||||
~(do ,;(map (fn [x] ~(,import* ,(string x) :prefix "")) modules)))
|
||||
~(do ,;(map |~(,import* ,(string $) :prefix "") modules)))
|
||||
|
||||
###
|
||||
###
|
||||
### Debugger
|
||||
###
|
||||
###
|
||||
|
||||
(defn .fiber
|
||||
"Get the current fiber being debugged."
|
||||
[]
|
||||
(dyn :fiber))
|
||||
|
||||
(defn .signal
|
||||
"Get the current signal being debugged."
|
||||
[]
|
||||
(dyn :signal))
|
||||
|
||||
(defn .stack
|
||||
"Print the current fiber stack"
|
||||
[]
|
||||
(print)
|
||||
(with-dyns [:err-color false] (debug/stacktrace (.fiber) (.signal)))
|
||||
(print))
|
||||
|
||||
(defn .frame
|
||||
"Show a stack frame"
|
||||
[&opt n]
|
||||
(def stack (debug/stack (.fiber)))
|
||||
(in stack (or n 0)))
|
||||
|
||||
(defn .fn
|
||||
"Get the current function"
|
||||
[&opt n]
|
||||
(in (.frame n) :function))
|
||||
|
||||
(defn .slots
|
||||
"Get an array of slots in a stack frame"
|
||||
[&opt n]
|
||||
(in (.frame n) :slots))
|
||||
|
||||
(defn .slot
|
||||
"Get the value of the nth slot."
|
||||
[&opt nth frame-idx]
|
||||
(in (.slots frame-idx) (or nth 0)))
|
||||
|
||||
# Conditional compilation for disasm
|
||||
(def disasm-alias (if-let [x (_env 'disasm)] (x :value)))
|
||||
|
||||
(defn .disasm
|
||||
"Gets the assembly for the current function."
|
||||
[&opt n]
|
||||
(def frame (.frame n))
|
||||
(def func (frame :function))
|
||||
(disasm-alias func))
|
||||
|
||||
(defn .bytecode
|
||||
"Get the bytecode for the current function."
|
||||
[&opt n]
|
||||
((.disasm n) 'bytecode))
|
||||
|
||||
(defn .ppasm
|
||||
"Pretty prints the assembly for the current function"
|
||||
[&opt n]
|
||||
(def frame (.frame n))
|
||||
(def func (frame :function))
|
||||
(def dasm (disasm-alias func))
|
||||
(def bytecode (in dasm 'bytecode))
|
||||
(def pc (frame :pc))
|
||||
(def sourcemap (in dasm 'sourcemap))
|
||||
(var last-loc [-2 -2])
|
||||
(print "\n signal: " (.signal))
|
||||
(print " function: " (dasm 'name) " [" (in dasm 'source "") "]")
|
||||
(when-let [constants (dasm 'constants)]
|
||||
(printf " constants: %.4q" constants))
|
||||
(printf " slots: %.4q\n" (frame :slots))
|
||||
(def padding (string/repeat " " 20))
|
||||
(loop [i :range [0 (length bytecode)]
|
||||
:let [instr (bytecode i)]]
|
||||
(prin (if (= (tuple/type instr) :brackets) "*" " "))
|
||||
(prin (if (= i pc) "> " " "))
|
||||
(prinf "%.20s" (string (string/join (map string instr) " ") padding))
|
||||
(when sourcemap
|
||||
(let [[sl sc] (sourcemap i)
|
||||
loc [sl sc]]
|
||||
(when (not= loc last-loc)
|
||||
(set last-loc loc)
|
||||
(prin " # line " sl ", column " sc))))
|
||||
(print))
|
||||
(print))
|
||||
|
||||
(unless (get _env 'disasm)
|
||||
(put _env '.disasm nil)
|
||||
(put _env '.bytecode nil)
|
||||
(put _env '.ppasm nil))
|
||||
(put _env 'disasm-alias nil)
|
||||
|
||||
(defn .source
|
||||
"Show the source code for the function being debugged."
|
||||
[&opt n]
|
||||
(def frame (.frame n))
|
||||
(def s (frame :source))
|
||||
(def all-source (slurp s))
|
||||
(print "\n" all-source "\n"))
|
||||
|
||||
(defn .breakall
|
||||
"Set breakpoints on all instructions in the current function."
|
||||
[&opt n]
|
||||
(def fun (.fn n))
|
||||
(def bytecode (.bytecode n))
|
||||
(for i 0 (length bytecode)
|
||||
(debug/fbreak fun i))
|
||||
(print "Set " (length bytecode) " breakpoints in " fun))
|
||||
|
||||
(defn .clearall
|
||||
"Clear all breakpoints on the current function."
|
||||
[&opt n]
|
||||
(def fun (.fn n))
|
||||
(def bytecode (.bytecode n))
|
||||
(for i 0 (length bytecode)
|
||||
(debug/unfbreak fun i))
|
||||
(print "Cleared " (length bytecode) " breakpoints in " fun))
|
||||
|
||||
(defn .break
|
||||
"Set breakpoint at the current pc."
|
||||
[]
|
||||
(def frame (.frame))
|
||||
(def fun (frame :function))
|
||||
(def pc (frame :pc))
|
||||
(debug/fbreak fun pc)
|
||||
(print "Set breakpoint in " fun " at pc=" pc))
|
||||
|
||||
(defn .clear
|
||||
"Clear the current breakpoint"
|
||||
[]
|
||||
(def frame (.frame))
|
||||
(def fun (frame :function))
|
||||
(def pc (frame :pc))
|
||||
(debug/unfbreak fun pc)
|
||||
(print "Cleared breakpoint in " fun " at pc=" pc))
|
||||
|
||||
(defn .next
|
||||
"Go to the next breakpoint."
|
||||
[&opt n]
|
||||
(var res nil)
|
||||
(for i 0 (or n 1)
|
||||
(set res (resume (.fiber))))
|
||||
res)
|
||||
|
||||
(defn .nextc
|
||||
"Go to the next breakpoint, clearing the current breakpoint."
|
||||
[&opt n]
|
||||
(.clear)
|
||||
(.next n))
|
||||
|
||||
(defn .step
|
||||
"Execute the next n instructions."
|
||||
[&opt n]
|
||||
(var res nil)
|
||||
(for i 0 (or n 1)
|
||||
(set res (debug/step (.fiber))))
|
||||
res)
|
||||
|
||||
(def debugger-env
|
||||
"An environment that contains dot prefixed functions for debugging."
|
||||
@{})
|
||||
|
||||
(def- debugger-keys (filter (partial string/has-prefix? ".") (keys _env)))
|
||||
(each k debugger-keys (put debugger-env k (_env k)) (put _env k nil))
|
||||
(put _env 'debugger-keys nil)
|
||||
|
||||
###
|
||||
###
|
||||
@@ -2271,11 +2498,15 @@
|
||||
the repl in."
|
||||
[&opt chunks onsignal env]
|
||||
(default env (make-env))
|
||||
(default chunks (fn [buf p] (getline (string "repl:"
|
||||
((parser/where p) 0)
|
||||
":"
|
||||
(parser/state p :delimiters) "> ")
|
||||
buf env)))
|
||||
(default chunks
|
||||
(fn [buf p]
|
||||
(getline
|
||||
(string
|
||||
"repl:"
|
||||
((parser/where p) 0)
|
||||
":"
|
||||
(parser/state p :delimiters) "> ")
|
||||
buf env)))
|
||||
(defn make-onsignal
|
||||
[e level]
|
||||
|
||||
@@ -2285,13 +2516,14 @@
|
||||
(put nextenv :fiber f)
|
||||
(put nextenv :debug-level level)
|
||||
(put nextenv :signal x)
|
||||
(merge-into nextenv debugger-env)
|
||||
(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))
|
||||
(def prpt (string "debug[" level "]:" c ":" status "> "))
|
||||
(getline prpt buf nextenv))
|
||||
(print "entering debug[" level "] - (quit) to exit")
|
||||
(flush)
|
||||
(repl debugger-chunks (make-onsignal nextenv (+ 1 level)) nextenv)
|
||||
@@ -2301,7 +2533,10 @@
|
||||
|
||||
(fn [f x]
|
||||
(if (= :dead (fiber/status f))
|
||||
(do (pp x) (put e '_ @{:value x}))
|
||||
(do
|
||||
(put e '_ @{:value x})
|
||||
(printf (get e :pretty-format "%q") x)
|
||||
(flush))
|
||||
(if (e :debug)
|
||||
(enter-debugger f x)
|
||||
(do (debug/stacktrace f x) (eflush))))))
|
||||
@@ -2340,6 +2575,9 @@
|
||||
|
||||
(def- importers {'import true 'import* true 'use true 'dofile true 'require true})
|
||||
|
||||
# conditional compilation for reduced os
|
||||
(def- getenv-alias (if-let [entry (in _env 'os/getenv)] (entry :value) (fn [&])))
|
||||
|
||||
(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."
|
||||
@@ -2354,10 +2592,11 @@
|
||||
(var *handleopts* true)
|
||||
(var *exit-on-error* true)
|
||||
(var *colorize* true)
|
||||
(var *debug* false)
|
||||
(var *compile-only* false)
|
||||
|
||||
(if-let [jp (os/getenv "JANET_PATH")] (setdyn :syspath jp))
|
||||
(if-let [jp (os/getenv "JANET_HEADERPATH")] (setdyn :headerpath jp))
|
||||
(if-let [jp (getenv-alias "JANET_PATH")] (setdyn :syspath jp))
|
||||
(if-let [jp (getenv-alias "JANET_HEADERPATH")] (setdyn :headerpath jp))
|
||||
|
||||
# Flag handlers
|
||||
(def handlers
|
||||
@@ -2369,9 +2608,10 @@
|
||||
-v : Print the version string
|
||||
-s : Use raw stdin instead of getline like functionality
|
||||
-e code : Execute a string of janet
|
||||
-d : Set the debug flag in the repl
|
||||
-r : Enter the repl after running all scripts
|
||||
-p : Keep on executing if there is a top level error (persistent)
|
||||
-q : Hide prompt, logo, and repl output (quiet)
|
||||
-q : Hide logo (quiet)
|
||||
-k : Compile scripts but do not execute (flycheck)
|
||||
-m syspath : Set system path for loading global modules
|
||||
-c source output : Compile janet source code into an image
|
||||
@@ -2401,7 +2641,8 @@
|
||||
"e" (fn [i &]
|
||||
(set *no-file* false)
|
||||
(eval-string (in args (+ i 1)))
|
||||
2)})
|
||||
2)
|
||||
"d" (fn [&] (set *debug* true) 1)})
|
||||
|
||||
(defn- dohandler [n i &]
|
||||
(def h (in handlers n))
|
||||
@@ -2450,29 +2691,27 @@
|
||||
(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))
|
||||
(string "janet:" line ":" (parser/state p :delimiters) "> "))
|
||||
(def prompter (if *quiet* noprompt getprompt))
|
||||
(defn getstdin [prompt buf _]
|
||||
(file/write stdout prompt)
|
||||
(file/flush stdout)
|
||||
(file/read stdin :line buf))
|
||||
(def env (make-env))
|
||||
(if *debug* (put env :debug true))
|
||||
(def getter (if *raw-stdin* getstdin getline))
|
||||
(defn getchunk [buf p]
|
||||
(getter (prompter p) buf env))
|
||||
(def onsig (if *quiet* (fn [x &] x) nil))
|
||||
(getter (getprompt p) buf env))
|
||||
(setdyn :pretty-format (if *colorize* "%.20Q" "%.20q"))
|
||||
(setdyn :err-color (if *colorize* true))
|
||||
(repl getchunk onsig env)))
|
||||
(repl getchunk nil env)))
|
||||
|
||||
(put _env 'no-side-effects nil)
|
||||
(put _env 'is-safe-def nil)
|
||||
(put _env 'safe-forms nil)
|
||||
(put _env 'importers nil)
|
||||
|
||||
(put _env 'getenv-alias nil)
|
||||
|
||||
###
|
||||
###
|
||||
@@ -2480,7 +2719,7 @@
|
||||
###
|
||||
###
|
||||
|
||||
(def root-env "The root environment used to create envionments with (make-env)" _env)
|
||||
(def root-env "The root environment used to create environments with (make-env)" _env)
|
||||
|
||||
(do
|
||||
(put _env 'boot/opts nil)
|
||||
@@ -2559,6 +2798,7 @@
|
||||
"src/core/io.c"
|
||||
"src/core/marsh.c"
|
||||
"src/core/math.c"
|
||||
"src/core/net.c"
|
||||
"src/core/os.c"
|
||||
"src/core/parse.c"
|
||||
"src/core/peg.c"
|
||||
|
||||
@@ -50,5 +50,20 @@ int system_test() {
|
||||
assert(janet_equals(janet_cstringv("a string."), janet_cstringv("a string.")));
|
||||
assert(janet_equals(janet_csymbolv("sym"), janet_csymbolv("sym")));
|
||||
|
||||
Janet *t1 = janet_tuple_begin(3);
|
||||
t1[0] = janet_wrap_nil();
|
||||
t1[1] = janet_wrap_integer(4);
|
||||
t1[2] = janet_cstringv("hi");
|
||||
Janet tuple1 = janet_wrap_tuple(janet_tuple_end(t1));
|
||||
|
||||
Janet *t2 = janet_tuple_begin(3);
|
||||
t2[0] = janet_wrap_nil();
|
||||
t2[1] = janet_wrap_integer(4);
|
||||
t2[2] = janet_cstringv("hi");
|
||||
Janet tuple2 = janet_wrap_tuple(janet_tuple_end(t2));
|
||||
|
||||
assert(janet_equals(tuple1, tuple2));
|
||||
|
||||
|
||||
return 0;
|
||||
}
|
||||
|
||||
@@ -27,10 +27,10 @@
|
||||
#define JANETCONF_H
|
||||
|
||||
#define JANET_VERSION_MAJOR 1
|
||||
#define JANET_VERSION_MINOR 8
|
||||
#define JANET_VERSION_PATCH 1
|
||||
#define JANET_VERSION_MINOR 9
|
||||
#define JANET_VERSION_PATCH 0
|
||||
#define JANET_VERSION_EXTRA ""
|
||||
#define JANET_VERSION "1.8.1"
|
||||
#define JANET_VERSION "1.9.0"
|
||||
|
||||
/* #define JANET_BUILD "local" */
|
||||
|
||||
@@ -45,14 +45,20 @@
|
||||
/* #define JANET_NO_DOCSTRINGS */
|
||||
/* #define JANET_NO_SOURCEMAPS */
|
||||
/* #define JANET_REDUCED_OS */
|
||||
|
||||
/* Other settings */
|
||||
/* #define JANET_NO_PROCESSES */
|
||||
/* #define JANET_NO_ASSEMBLER */
|
||||
/* #define JANET_NO_PEG */
|
||||
/* #define JANET_NO_NET */
|
||||
/* #define JANET_NO_TYPED_ARRAY */
|
||||
/* #define JANET_NO_INT_TYPES */
|
||||
|
||||
/* Other settings */
|
||||
/* #define JANET_NO_PRF */
|
||||
/* #define JANET_NO_UTC_MKTIME */
|
||||
/* #define JANET_NO_SYMLINKS */
|
||||
/* #define JANET_OUT_OF_MEMORY do { printf("janet out of memory\n"); exit(1); } while (0) */
|
||||
/* #define JANET_EXIT(msg) do { printf("C assert failed executing janet: %s\n", msg); exit(1); } while (0) */
|
||||
/* #define JANET_TOP_LEVEL_SIGNAL(msg) call_my_function((msg), stderr) */
|
||||
/* #define JANET_RECURSION_GUARD 1024 */
|
||||
/* #define JANET_MAX_PROTO_DEPTH 200 */
|
||||
/* #define JANET_MAX_MACRO_EXPAND 200 */
|
||||
|
||||
@@ -707,6 +707,9 @@ static JanetAssembleResult janet_asm1(JanetAssembler *parent, Janet source, int
|
||||
if (janet_indexed_view(x, &arr, &count)) {
|
||||
janet_asm_assert(&a, count == def->bytecode_length, "sourcemap must have the same length as the bytecode");
|
||||
def->sourcemap = malloc(sizeof(JanetSourceMapping) * (size_t) count);
|
||||
if (NULL == def->sourcemap) {
|
||||
JANET_OUT_OF_MEMORY;
|
||||
}
|
||||
for (i = 0; i < count; i++) {
|
||||
const Janet *tup;
|
||||
Janet entry = arr[i];
|
||||
@@ -730,6 +733,9 @@ static JanetAssembleResult janet_asm1(JanetAssembler *parent, Janet source, int
|
||||
/* Set environments */
|
||||
def->environments =
|
||||
realloc(def->environments, def->environments_length * sizeof(int32_t));
|
||||
if (NULL == def->environments) {
|
||||
JANET_OUT_OF_MEMORY;
|
||||
}
|
||||
|
||||
/* Verify the func def */
|
||||
if (janet_verify(def)) {
|
||||
@@ -958,7 +964,7 @@ static const JanetReg asm_cfuns[] = {
|
||||
"asm", cfun_asm,
|
||||
JDOC("(asm assembly)\n\n"
|
||||
"Returns a new function that is the compiled result of the assembly.\n"
|
||||
"The syntax for the assembly can be found on the janet wiki. Will throw an\n"
|
||||
"The syntax for the assembly can be found on the Janet website. Will throw an\n"
|
||||
"error on invalid assembly.")
|
||||
},
|
||||
{
|
||||
|
||||
@@ -27,6 +27,15 @@
|
||||
#include "fiber.h"
|
||||
#endif
|
||||
|
||||
JANET_NO_RETURN static void janet_top_level_signal(const char *msg) {
|
||||
#ifdef JANET_TOP_LEVEL_SIGNAL
|
||||
JANET_TOP_LEVEL_SIGNAL(msg);
|
||||
#else
|
||||
fputs(msg, stdout);
|
||||
exit(1);
|
||||
#endif
|
||||
}
|
||||
|
||||
void janet_signalv(JanetSignal sig, Janet message) {
|
||||
if (janet_vm_return_reg != NULL) {
|
||||
*janet_vm_return_reg = message;
|
||||
@@ -37,8 +46,8 @@ void janet_signalv(JanetSignal sig, Janet message) {
|
||||
longjmp(*janet_vm_jmp_buf, sig);
|
||||
#endif
|
||||
} else {
|
||||
fputs((const char *)janet_formatc("janet top level signal - %v\n", message), stdout);
|
||||
exit(1);
|
||||
const char *str = (const char *)janet_formatc("janet top level signal - %v\n", message);
|
||||
janet_top_level_signal(str);
|
||||
}
|
||||
}
|
||||
|
||||
@@ -54,7 +63,7 @@ void janet_panicf(const char *format, ...) {
|
||||
while (format[len]) len++;
|
||||
janet_buffer_init(&buffer, len);
|
||||
va_start(args, format);
|
||||
janet_formatb(&buffer, format, args);
|
||||
janet_formatbv(&buffer, format, args);
|
||||
va_end(args);
|
||||
ret = janet_string(buffer.data, buffer.count);
|
||||
janet_buffer_deinit(&buffer);
|
||||
@@ -235,18 +244,20 @@ size_t janet_getsize(const Janet *argv, int32_t n) {
|
||||
|
||||
int32_t janet_gethalfrange(const Janet *argv, int32_t n, int32_t length, const char *which) {
|
||||
int32_t raw = janet_getinteger(argv, n);
|
||||
if (raw < 0) raw += length + 1;
|
||||
if (raw < 0 || raw > length)
|
||||
janet_panicf("%s index %d out of range [0,%d]", which, raw, length);
|
||||
return raw;
|
||||
int32_t not_raw = raw;
|
||||
if (not_raw < 0) not_raw += length + 1;
|
||||
if (not_raw < 0 || not_raw > length)
|
||||
janet_panicf("%s index %d out of range [%d,%d]", which, raw, -length - 1, length);
|
||||
return not_raw;
|
||||
}
|
||||
|
||||
int32_t janet_getargindex(const Janet *argv, int32_t n, int32_t length, const char *which) {
|
||||
int32_t raw = janet_getinteger(argv, n);
|
||||
if (raw < 0) raw += length;
|
||||
if (raw < 0 || raw > length)
|
||||
janet_panicf("%s index %d out of range [0,%d)", which, raw, length);
|
||||
return raw;
|
||||
int32_t not_raw = raw;
|
||||
if (not_raw < 0) not_raw += length;
|
||||
if (not_raw < 0 || not_raw > length)
|
||||
janet_panicf("%s index %d out of range [%d,%d)", which, raw, -length, length);
|
||||
return not_raw;
|
||||
}
|
||||
|
||||
JanetView janet_getindexed(const Janet *argv, int32_t n) {
|
||||
|
||||
@@ -855,10 +855,10 @@ static const JanetReg compile_cfuns[] = {
|
||||
{
|
||||
"compile", cfun,
|
||||
JDOC("(compile ast &opt env source)\n\n"
|
||||
"Compiles an Abstract Syntax Tree (ast) into a janet function. "
|
||||
"Compiles an Abstract Syntax Tree (ast) into a function. "
|
||||
"Pair the compile function with parsing functionality to implement "
|
||||
"eval. Returns a janet function and does not modify ast. Throws an "
|
||||
"error if the ast cannot be compiled.")
|
||||
"eval. Returns a new function and does not modify ast. Returns an error "
|
||||
"struct with keys :line, :column, and :error if compilation fails.")
|
||||
},
|
||||
{NULL, NULL, NULL}
|
||||
};
|
||||
|
||||
@@ -435,7 +435,7 @@ static Janet janet_core_hash(int32_t argc, Janet *argv) {
|
||||
static Janet janet_core_getline(int32_t argc, Janet *argv) {
|
||||
FILE *in = janet_dynfile("in", stdin);
|
||||
FILE *out = janet_dynfile("out", stdout);
|
||||
janet_arity(argc, 0, 2);
|
||||
janet_arity(argc, 0, 3);
|
||||
JanetBuffer *buf = (argc >= 2) ? janet_getbuffer(argv, 1) : janet_buffer(10);
|
||||
if (argc >= 1) {
|
||||
const char *prompt = (const char *) janet_getstring(argv, 0);
|
||||
@@ -500,10 +500,15 @@ static Janet janet_core_signal(int32_t argc, Janet *argv) {
|
||||
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]);
|
||||
if (!janet_cstrcmp(kw, "yield")) {
|
||||
sig = JANET_SIGNAL_YIELD;
|
||||
} else if (!janet_cstrcmp(kw, "error")) {
|
||||
sig = JANET_SIGNAL_ERROR;
|
||||
} else if (!janet_cstrcmp(kw, "debug")) {
|
||||
sig = JANET_SIGNAL_DEBUG;
|
||||
} else {
|
||||
janet_panicf("unknown signal, expected :yield, :error, or :debug, got %v", argv[0]);
|
||||
}
|
||||
}
|
||||
Janet payload = argc == 2 ? argv[1] : janet_wrap_nil();
|
||||
janet_signalv(sig, payload);
|
||||
@@ -638,15 +643,15 @@ static const JanetReg corelib_cfuns[] = {
|
||||
{
|
||||
"hash", janet_core_hash,
|
||||
JDOC("(hash value)\n\n"
|
||||
"Gets a hash value for any janet value. The hash is an integer can be used "
|
||||
"as a cheap hash function for all janet objects. If two values are strictly equal, "
|
||||
"Gets a hash for any value. The hash is an integer can be used "
|
||||
"as a cheap hash function for all values. If two values are strictly equal, "
|
||||
"then they will have the same hash value.")
|
||||
},
|
||||
{
|
||||
"getline", janet_core_getline,
|
||||
JDOC("(getline &opt prompt buf env)\n\n"
|
||||
"Reads a line of input into a buffer, including the newline character, using a prompt. "
|
||||
"An optional environment table can be provided for autocomplete. "
|
||||
"An optional environment table can be provided for auto-complete. "
|
||||
"Returns the modified buffer. "
|
||||
"Use this function to implement a simple interface for a terminal program.")
|
||||
},
|
||||
@@ -680,7 +685,7 @@ static const JanetReg corelib_cfuns[] = {
|
||||
"\t:all:\tthe value of path verbatim\n"
|
||||
"\t:cur:\tthe current file, or (dyn :current-file)\n"
|
||||
"\t:dir:\tthe directory containing the current file\n"
|
||||
"\t:name:\tthe filename component of path, with extenion if given\n"
|
||||
"\t:name:\tthe name component of path, with extension if given\n"
|
||||
"\t:native:\tthe extension used to load natives, .so or .dll\n"
|
||||
"\t:sys:\tthe system path, or (syn :syspath)")
|
||||
},
|
||||
@@ -697,7 +702,7 @@ static const JanetReg corelib_cfuns[] = {
|
||||
{
|
||||
"slice", janet_core_slice,
|
||||
JDOC("(slice x &opt start end)\n\n"
|
||||
"Extract a sub-range of an indexed data strutrue or byte sequence.")
|
||||
"Extract a sub-range of an indexed data structure or byte sequence.")
|
||||
},
|
||||
{
|
||||
"signal", janet_core_signal,
|
||||
@@ -737,7 +742,7 @@ static void janet_quick_asm(
|
||||
janet_def(env, name, janet_wrap_function(janet_thunk(def)), doc);
|
||||
}
|
||||
|
||||
/* Macros for easier inline janet assembly */
|
||||
/* Macros for easier inline assembly */
|
||||
#define SSS(op, a, b, c) ((op) | ((a) << 8) | ((b) << 16) | ((c) << 24))
|
||||
#define SS(op, a, b) ((op) | ((a) << 8) | ((b) << 16))
|
||||
#define SSI(op, a, b, I) ((op) | ((a) << 8) | ((b) << 16) | ((uint32_t)(I) << 24))
|
||||
@@ -999,6 +1004,9 @@ static void janet_load_libs(JanetTable *env) {
|
||||
#ifdef JANET_THREADS
|
||||
janet_lib_thread(env);
|
||||
#endif
|
||||
#ifdef JANET_NET
|
||||
janet_lib_net(env);
|
||||
#endif
|
||||
}
|
||||
|
||||
#ifdef JANET_BOOTSTRAP
|
||||
@@ -1016,7 +1024,7 @@ JanetTable *janet_core_env(JanetTable *replacements) {
|
||||
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 "
|
||||
"Gets the next key in a data structure. 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 "
|
||||
@@ -1027,7 +1035,8 @@ JanetTable *janet_core_env(JanetTable *replacements) {
|
||||
"Propagate a signal from a fiber to the current fiber. The resulting "
|
||||
"stack trace from the current fiber will include frames from fiber. If "
|
||||
"fiber is in a state that can be resumed, resuming the current fiber will "
|
||||
"first resume fiber."));
|
||||
"first resume fiber. This function can be used to re-raise an error without "
|
||||
"losing the original stack trace."));
|
||||
janet_quick_asm(env, JANET_FUN_DEBUG,
|
||||
"debug", 1, 0, 1, 1, debug_asm, sizeof(debug_asm),
|
||||
JDOC("(debug &opt x)\n\n"
|
||||
@@ -1099,7 +1108,7 @@ JanetTable *janet_core_env(JanetTable *replacements) {
|
||||
JDOC("(/ & xs)\n\n"
|
||||
"Returns the quotient of xs. If xs is empty, returns 1. If xs has one value x, returns "
|
||||
"the reciprocal of x. Otherwise return the first value of xs repeatedly divided by the remaining "
|
||||
"values. Division by two integers uses truncating division."));
|
||||
"values."));
|
||||
templatize_varop(env, JANET_FUN_BAND, "band", -1, -1, JOP_BAND,
|
||||
JDOC("(band & xs)\n\n"
|
||||
"Returns the bit-wise and of all values in xs. Each x in xs must be an integer."));
|
||||
|
||||
@@ -26,11 +26,15 @@
|
||||
#define JANET_FEATURES_H_defined
|
||||
|
||||
#ifndef _POSIX_C_SOURCE
|
||||
#define _POSIX_C_SOURCE 200112L
|
||||
#define _POSIX_C_SOURCE 200809L
|
||||
#endif
|
||||
|
||||
#if defined(WIN32) || defined(_WIN32)
|
||||
#define WIN32_LEAN_AND_MEAN
|
||||
#endif
|
||||
|
||||
/* Needed for realpath on linux */
|
||||
#if !defined(_XOPEN_SOURCE) && defined(__linux__)
|
||||
#if !defined(_XOPEN_SOURCE) && (defined(__linux__) || defined(__EMSCRIPTEN__))
|
||||
#define _XOPEN_SOURCE 500
|
||||
#endif
|
||||
|
||||
|
||||
@@ -218,6 +218,7 @@ int janet_fiber_funcframe(JanetFiber *fiber, JanetFunction *func) {
|
||||
static void janet_env_detach(JanetFuncEnv *env) {
|
||||
/* Check for closure environment */
|
||||
if (env) {
|
||||
janet_env_valid(env);
|
||||
int32_t len = env->length;
|
||||
size_t s = sizeof(Janet) * (size_t) len;
|
||||
Janet *vmem = malloc(s);
|
||||
@@ -244,10 +245,38 @@ static void janet_env_detach(JanetFuncEnv *env) {
|
||||
}
|
||||
}
|
||||
|
||||
/* Validate potentially untrusted func env (unmarshalled envs are difficult to verify) */
|
||||
int janet_env_valid(JanetFuncEnv *env) {
|
||||
if (env->offset < 0) {
|
||||
int32_t real_offset = -(env->offset);
|
||||
JanetFiber *fiber = env->as.fiber;
|
||||
int32_t i = fiber->frame;
|
||||
while (i > 0) {
|
||||
JanetStackFrame *frame = (JanetStackFrame *)(fiber->data + i - JANET_FRAME_SIZE);
|
||||
if (real_offset == i &&
|
||||
frame->env == env &&
|
||||
frame->func &&
|
||||
frame->func->def->slotcount == env->length) {
|
||||
env->offset = real_offset;
|
||||
return 1;
|
||||
}
|
||||
i = frame->prevframe;
|
||||
}
|
||||
/* Invalid, set to empty off-stack variant. */
|
||||
env->offset = 0;
|
||||
env->length = 0;
|
||||
env->as.values = NULL;
|
||||
return 0;
|
||||
} else {
|
||||
return 1;
|
||||
}
|
||||
}
|
||||
|
||||
/* Detach a fiber from the env if the target fiber has stopped mutating */
|
||||
void janet_env_maybe_detach(JanetFuncEnv *env) {
|
||||
/* Check for detachable closure envs */
|
||||
if (env->offset) {
|
||||
janet_env_valid(env);
|
||||
if (env->offset > 0) {
|
||||
JanetFiberStatus s = janet_fiber_status(env->as.fiber);
|
||||
int isFinished = s == JANET_STATUS_DEAD ||
|
||||
s == JANET_STATUS_ERROR ||
|
||||
@@ -376,6 +405,10 @@ JanetFiber *janet_current_fiber(void) {
|
||||
return janet_vm_fiber;
|
||||
}
|
||||
|
||||
JanetFiber *janet_root_fiber(void) {
|
||||
return janet_vm_root_fiber;
|
||||
}
|
||||
|
||||
/* CFuns */
|
||||
|
||||
static Janet cfun_fiber_getenv(int32_t argc, Janet *argv) {
|
||||
@@ -416,7 +449,7 @@ static Janet cfun_fiber_new(int32_t argc, Janet *argv) {
|
||||
} else {
|
||||
switch (view.bytes[i]) {
|
||||
default:
|
||||
janet_panicf("invalid flag %c, expected a, d, e, u, or y", view.bytes[i]);
|
||||
janet_panicf("invalid flag %c, expected a, t, d, e, u, y, i, or p", view.bytes[i]);
|
||||
break;
|
||||
case 'a':
|
||||
fiber->flags |=
|
||||
@@ -479,6 +512,12 @@ static Janet cfun_fiber_current(int32_t argc, Janet *argv) {
|
||||
return janet_wrap_fiber(janet_vm_fiber);
|
||||
}
|
||||
|
||||
static Janet cfun_fiber_root(int32_t argc, Janet *argv) {
|
||||
(void) argv;
|
||||
janet_fixarity(argc, 0);
|
||||
return janet_wrap_fiber(janet_vm_root_fiber);
|
||||
}
|
||||
|
||||
static Janet cfun_fiber_maxstack(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 1);
|
||||
JanetFiber *fiber = janet_getfiber(argv, 0);
|
||||
@@ -546,6 +585,12 @@ static const JanetReg fiber_cfuns[] = {
|
||||
"\t:alive - the fiber is currently running and cannot be resumed\n"
|
||||
"\t:new - the fiber has just been created and not yet run")
|
||||
},
|
||||
{
|
||||
"fiber/root", cfun_fiber_root,
|
||||
JDOC("(fiber/root)\n\n"
|
||||
"Returns the current root fiber. The root fiber is the oldest ancestor "
|
||||
"that does not have a parent.")
|
||||
},
|
||||
{
|
||||
"fiber/current", cfun_fiber_current,
|
||||
JDOC("(fiber/current)\n\n"
|
||||
|
||||
@@ -74,5 +74,6 @@ int janet_fiber_funcframe_tail(JanetFiber *fiber, JanetFunction *func);
|
||||
void janet_fiber_cframe(JanetFiber *fiber, JanetCFunction cfun);
|
||||
void janet_fiber_popframe(JanetFiber *fiber);
|
||||
void janet_env_maybe_detach(JanetFuncEnv *env);
|
||||
int janet_env_valid(JanetFuncEnv *env);
|
||||
|
||||
#endif
|
||||
|
||||
@@ -193,7 +193,7 @@ static void janet_mark_funcenv(JanetFuncEnv *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) {
|
||||
if (env->offset > 0) {
|
||||
/* On stack */
|
||||
janet_mark_fiber(env->as.fiber);
|
||||
} else {
|
||||
@@ -389,6 +389,9 @@ void janet_collect(void) {
|
||||
if (janet_vm_gc_suspend) return;
|
||||
depth = JANET_RECURSION_GUARD;
|
||||
orig_rootcount = janet_vm_root_count;
|
||||
#ifdef JANET_NET
|
||||
janet_net_markloop();
|
||||
#endif
|
||||
for (i = 0; i < orig_rootcount; i++)
|
||||
janet_mark(janet_vm_roots[i]);
|
||||
while (orig_rootcount < janet_vm_root_count) {
|
||||
@@ -530,7 +533,7 @@ void *janet_srealloc(void *mem, size_t size) {
|
||||
if (i == 0) break;
|
||||
}
|
||||
}
|
||||
janet_exit("invalid janet_srealloc");
|
||||
JANET_EXIT("invalid janet_srealloc");
|
||||
}
|
||||
|
||||
void janet_sfinalizer(void *mem, JanetScratchFinalizer finalizer) {
|
||||
@@ -551,5 +554,5 @@ void janet_sfree(void *mem) {
|
||||
if (i == 0) break;
|
||||
}
|
||||
}
|
||||
janet_exit("invalid janet_sfree");
|
||||
JANET_EXIT("invalid janet_sfree");
|
||||
}
|
||||
|
||||
@@ -30,7 +30,9 @@
|
||||
#include <errno.h>
|
||||
|
||||
#ifndef JANET_WINDOWS
|
||||
#include <fcntl.h>
|
||||
#include <sys/wait.h>
|
||||
#include <unistd.h>
|
||||
#endif
|
||||
|
||||
static int cfun_io_gc(void *p, size_t len);
|
||||
@@ -87,18 +89,17 @@ static Janet makef(FILE *f, int flags) {
|
||||
JanetFile *iof = (JanetFile *) janet_abstract(&janet_file_type, sizeof(JanetFile));
|
||||
iof->file = f;
|
||||
iof->flags = flags;
|
||||
#ifndef JANET_WINDOWS
|
||||
/* While we would like fopen to set cloexec by default (like O_CLOEXEC) with the e flag, that is
|
||||
* not standard. */
|
||||
if (!(flags & JANET_FILE_NOT_CLOSEABLE))
|
||||
fcntl(fileno(f), F_SETFD, FD_CLOEXEC);
|
||||
#endif
|
||||
return janet_wrap_abstract(iof);
|
||||
}
|
||||
|
||||
/* Open a process */
|
||||
#ifdef __EMSCRIPTEN__
|
||||
static Janet cfun_io_popen(int32_t argc, Janet *argv) {
|
||||
(void) argc;
|
||||
(void) argv;
|
||||
janet_panic("not implemented on this platform");
|
||||
return janet_wrap_nil();
|
||||
}
|
||||
#else
|
||||
#ifndef JANET_NO_PROCESSES
|
||||
static Janet cfun_io_popen(int32_t argc, Janet *argv) {
|
||||
janet_arity(argc, 1, 2);
|
||||
const uint8_t *fname = janet_getstring(argv, 0);
|
||||
@@ -129,6 +130,7 @@ static Janet cfun_io_popen(int32_t argc, Janet *argv) {
|
||||
static Janet cfun_io_temp(int32_t argc, Janet *argv) {
|
||||
(void)argv;
|
||||
janet_fixarity(argc, 0);
|
||||
// XXX use mkostemp when we can to avoid CLOEXEC race.
|
||||
FILE *tmp = tmpfile();
|
||||
if (!tmp)
|
||||
janet_panicf("unable to create temporary file - %s", strerror(errno));
|
||||
@@ -239,12 +241,22 @@ static Janet cfun_io_fflush(int32_t argc, Janet *argv) {
|
||||
return argv[0];
|
||||
}
|
||||
|
||||
#ifdef JANET_WINDOWS
|
||||
#define pclose _pclose
|
||||
#define WEXITSTATUS(x) x
|
||||
#endif
|
||||
|
||||
/* Cleanup a file */
|
||||
static int cfun_io_gc(void *p, size_t len) {
|
||||
(void) len;
|
||||
JanetFile *iof = (JanetFile *)p;
|
||||
if (!(iof->flags & (JANET_FILE_NOT_CLOSEABLE | JANET_FILE_CLOSED))) {
|
||||
return fclose(iof->file);
|
||||
/* We can't panic inside a gc, so just ignore bad statuses here */
|
||||
if (iof->flags & JANET_FILE_PIPED) {
|
||||
pclose(iof->file);
|
||||
} else {
|
||||
fclose(iof->file);
|
||||
}
|
||||
}
|
||||
return 0;
|
||||
}
|
||||
@@ -258,10 +270,6 @@ static Janet cfun_io_fclose(int32_t argc, Janet *argv) {
|
||||
if (iof->flags & (JANET_FILE_NOT_CLOSEABLE))
|
||||
janet_panic("file not closable");
|
||||
if (iof->flags & JANET_FILE_PIPED) {
|
||||
#ifdef JANET_WINDOWS
|
||||
#define pclose _pclose
|
||||
#define WEXITSTATUS(x) x
|
||||
#endif
|
||||
int status = pclose(iof->file);
|
||||
iof->flags |= JANET_FILE_CLOSED;
|
||||
if (status == -1) janet_panic("could not close file");
|
||||
@@ -502,7 +510,7 @@ void janet_dynprintf(const char *name, FILE *dflt_file, const char *format, ...)
|
||||
int32_t len = 0;
|
||||
while (format[len]) len++;
|
||||
janet_buffer_init(&buffer, len);
|
||||
janet_formatb(&buffer, format, args);
|
||||
janet_formatbv(&buffer, format, args);
|
||||
if (xtype == JANET_ABSTRACT) {
|
||||
void *abstract = janet_unwrap_abstract(x);
|
||||
if (janet_abstract_type(abstract) != &janet_file_type)
|
||||
@@ -515,7 +523,7 @@ void janet_dynprintf(const char *name, FILE *dflt_file, const char *format, ...)
|
||||
break;
|
||||
}
|
||||
case JANET_BUFFER:
|
||||
janet_formatb(janet_unwrap_buffer(x), format, args);
|
||||
janet_formatbv(janet_unwrap_buffer(x), format, args);
|
||||
break;
|
||||
}
|
||||
va_end(args);
|
||||
@@ -640,6 +648,7 @@ static const JanetReg io_cfuns[] = {
|
||||
"for the relative number of bytes to seek in the file. n may be a real "
|
||||
"number to handle large files of more the 4GB. Returns the file handle.")
|
||||
},
|
||||
#ifndef JANET_NO_PROCESSES
|
||||
{
|
||||
"file/popen", cfun_io_popen,
|
||||
JDOC("(file/popen path &opt mode)\n\n"
|
||||
@@ -648,6 +657,7 @@ static const JanetReg io_cfuns[] = {
|
||||
"process can be read from the file. In :w mode, the stdin of the process "
|
||||
"can be written to. Returns the new file.")
|
||||
},
|
||||
#endif
|
||||
{NULL, NULL, NULL}
|
||||
};
|
||||
|
||||
|
||||
243
src/core/marsh.c
243
src/core/marsh.c
@@ -42,26 +42,28 @@ typedef struct {
|
||||
/* Lead bytes in marshaling protocol */
|
||||
enum {
|
||||
LB_REAL = 200,
|
||||
LB_NIL,
|
||||
LB_FALSE,
|
||||
LB_TRUE,
|
||||
LB_FIBER,
|
||||
LB_INTEGER,
|
||||
LB_STRING,
|
||||
LB_SYMBOL,
|
||||
LB_KEYWORD,
|
||||
LB_ARRAY,
|
||||
LB_TUPLE,
|
||||
LB_TABLE,
|
||||
LB_TABLE_PROTO,
|
||||
LB_STRUCT,
|
||||
LB_BUFFER,
|
||||
LB_FUNCTION,
|
||||
LB_REGISTRY,
|
||||
LB_ABSTRACT,
|
||||
LB_REFERENCE,
|
||||
LB_FUNCENV_REF,
|
||||
LB_FUNCDEF_REF
|
||||
LB_NIL, /* 201 */
|
||||
LB_FALSE, /* 202 */
|
||||
LB_TRUE, /* 203 */
|
||||
LB_FIBER, /* 204 */
|
||||
LB_INTEGER, /* 205 */
|
||||
LB_STRING, /* 206 */
|
||||
LB_SYMBOL, /* 207 */
|
||||
LB_KEYWORD, /* 208 */
|
||||
LB_ARRAY, /* 209 */
|
||||
LB_TUPLE, /* 210 */
|
||||
LB_TABLE, /* 211 */
|
||||
LB_TABLE_PROTO, /* 212 */
|
||||
LB_STRUCT, /* 213 */
|
||||
LB_BUFFER, /* 214 */
|
||||
LB_FUNCTION, /* 215 */
|
||||
LB_REGISTRY, /* 216 */
|
||||
LB_ABSTRACT, /* 217 */
|
||||
LB_REFERENCE, /* 218 */
|
||||
LB_FUNCENV_REF, /* 219 */
|
||||
LB_FUNCDEF_REF, /* 220 */
|
||||
LB_UNSAFE_CFUNCTION, /* 221 */
|
||||
LB_UNSAFE_POINTER /* 222 */
|
||||
} LeadBytes;
|
||||
|
||||
/* Helper to look inside an entry in an environment */
|
||||
@@ -183,8 +185,9 @@ static void marshal_one_env(MarshalState *st, JanetFuncEnv *env, int flags) {
|
||||
return;
|
||||
}
|
||||
}
|
||||
janet_env_valid(env);
|
||||
janet_v_push(st->seen_envs, env);
|
||||
if (env->offset && (JANET_STATUS_ALIVE == janet_fiber_status(env->as.fiber))) {
|
||||
if (env->offset > 0 && (JANET_STATUS_ALIVE == janet_fiber_status(env->as.fiber))) {
|
||||
pushint(st, 0);
|
||||
pushint(st, env->length);
|
||||
Janet *values = env->as.fiber->data + env->offset;
|
||||
@@ -200,7 +203,7 @@ static void marshal_one_env(MarshalState *st, JanetFuncEnv *env, int flags) {
|
||||
janet_env_maybe_detach(env);
|
||||
pushint(st, env->offset);
|
||||
pushint(st, env->length);
|
||||
if (env->offset) {
|
||||
if (env->offset > 0) {
|
||||
/* On stack variant */
|
||||
marshal_one(st, janet_wrap_fiber(env->as.fiber), flags + 1);
|
||||
} else {
|
||||
@@ -562,9 +565,25 @@ static void marshal_one(MarshalState *st, Janet x, int flags) {
|
||||
marshal_one_fiber(st, janet_unwrap_fiber(x), flags + 1);
|
||||
return;
|
||||
}
|
||||
case JANET_CFUNCTION: {
|
||||
if (!(flags & JANET_MARSHAL_UNSAFE)) goto no_registry;
|
||||
MARK_SEEN();
|
||||
pushbyte(st, LB_UNSAFE_CFUNCTION);
|
||||
JanetCFunction cfn = janet_unwrap_cfunction(x);
|
||||
pushbytes(st, (uint8_t *) &cfn, sizeof(JanetCFunction));
|
||||
return;
|
||||
}
|
||||
case JANET_POINTER: {
|
||||
if (!(flags & JANET_MARSHAL_UNSAFE)) goto no_registry;
|
||||
MARK_SEEN();
|
||||
pushbyte(st, LB_UNSAFE_POINTER);
|
||||
void *ptr = janet_unwrap_pointer(x);
|
||||
pushbytes(st, (uint8_t *) &ptr, sizeof(void *));
|
||||
return;
|
||||
}
|
||||
no_registry:
|
||||
default: {
|
||||
janet_panicf("no registry value and cannot marshal %p", x);
|
||||
return;
|
||||
}
|
||||
}
|
||||
#undef MARK_SEEN
|
||||
@@ -634,6 +653,15 @@ static int32_t readint(UnmarshalState *st, const uint8_t **atdata) {
|
||||
return ret;
|
||||
}
|
||||
|
||||
/* Helper to read a natural number (int >= 0). */
|
||||
static int32_t readnat(UnmarshalState *st, const uint8_t **atdata) {
|
||||
int32_t ret = readint(st, atdata);
|
||||
if (ret < 0) {
|
||||
janet_panicf("expected integer >= 0, got %d", ret);
|
||||
}
|
||||
return ret;
|
||||
}
|
||||
|
||||
/* Helper to read a size_t (up to 8 bytes unsigned). */
|
||||
static uint64_t read64(UnmarshalState *st, const uint8_t **atdata) {
|
||||
uint64_t ret;
|
||||
@@ -702,30 +730,31 @@ static const uint8_t *unmarshal_one_env(
|
||||
JanetFuncEnv *env = janet_gcalloc(JANET_MEMORY_FUNCENV, sizeof(JanetFuncEnv));
|
||||
env->length = 0;
|
||||
env->offset = 0;
|
||||
env->as.values = NULL;
|
||||
janet_v_push(st->lookup_envs, env);
|
||||
int32_t offset = readint(st, &data);
|
||||
int32_t length = readint(st, &data);
|
||||
if (offset) {
|
||||
int32_t offset = readnat(st, &data);
|
||||
int32_t length = readnat(st, &data);
|
||||
if (offset > 0) {
|
||||
Janet fiberv;
|
||||
/* On stack variant */
|
||||
data = unmarshal_one(st, data, &fiberv, flags);
|
||||
janet_asserttype(fiberv, JANET_FIBER);
|
||||
env->as.fiber = janet_unwrap_fiber(fiberv);
|
||||
/* Unmarshalling fiber may set values */
|
||||
if (env->offset != 0 && env->offset != offset)
|
||||
janet_panic("invalid funcenv offset");
|
||||
if (env->length != 0 && env->length != length)
|
||||
janet_panic("invalid funcenv length");
|
||||
/* Negative offset indicates untrusted input */
|
||||
env->offset = -offset;
|
||||
} else {
|
||||
/* Off stack variant */
|
||||
if (length == 0) {
|
||||
janet_panic("invalid funcenv length");
|
||||
}
|
||||
env->as.values = malloc(sizeof(Janet) * (size_t) length);
|
||||
if (!env->as.values) {
|
||||
JANET_OUT_OF_MEMORY;
|
||||
}
|
||||
env->offset = 0;
|
||||
for (int32_t i = 0; i < length; i++)
|
||||
data = unmarshal_one(st, data, env->as.values + i, flags);
|
||||
}
|
||||
env->offset = offset;
|
||||
env->length = length;
|
||||
*out = env;
|
||||
}
|
||||
@@ -770,6 +799,11 @@ static const uint8_t *unmarshal_one_def(
|
||||
def->name = NULL;
|
||||
def->source = NULL;
|
||||
def->closure_bitset = NULL;
|
||||
def->defs = NULL;
|
||||
def->environments = NULL;
|
||||
def->constants = NULL;
|
||||
def->bytecode = NULL;
|
||||
def->sourcemap = NULL;
|
||||
janet_v_push(st->lookup_defs, def);
|
||||
|
||||
/* Set default lengths to zero */
|
||||
@@ -780,18 +814,18 @@ static const uint8_t *unmarshal_one_def(
|
||||
|
||||
/* Read flags and other fixed values */
|
||||
def->flags = readint(st, &data);
|
||||
def->slotcount = readint(st, &data);
|
||||
def->arity = readint(st, &data);
|
||||
def->min_arity = readint(st, &data);
|
||||
def->max_arity = readint(st, &data);
|
||||
def->slotcount = readnat(st, &data);
|
||||
def->arity = readnat(st, &data);
|
||||
def->min_arity = readnat(st, &data);
|
||||
def->max_arity = readnat(st, &data);
|
||||
|
||||
/* Read some lengths */
|
||||
constants_length = readint(st, &data);
|
||||
bytecode_length = readint(st, &data);
|
||||
constants_length = readnat(st, &data);
|
||||
bytecode_length = readnat(st, &data);
|
||||
if (def->flags & JANET_FUNCDEF_FLAG_HASENVS)
|
||||
environments_length = readint(st, &data);
|
||||
environments_length = readnat(st, &data);
|
||||
if (def->flags & JANET_FUNCDEF_FLAG_HASDEFS)
|
||||
defs_length = readint(st, &data);
|
||||
defs_length = readnat(st, &data);
|
||||
|
||||
/* Check name and source (optional) */
|
||||
if (def->flags & JANET_FUNCDEF_FLAG_HASNAME) {
|
||||
@@ -866,7 +900,7 @@ static const uint8_t *unmarshal_one_def(
|
||||
for (int32_t i = 0; i < bytecode_length; i++) {
|
||||
current += readint(st, &data);
|
||||
def->sourcemap[i].line = current;
|
||||
def->sourcemap[i].column = readint(st, &data);
|
||||
def->sourcemap[i].column = readnat(st, &data);
|
||||
}
|
||||
} else {
|
||||
def->sourcemap = NULL;
|
||||
@@ -898,7 +932,7 @@ static const uint8_t *unmarshal_one_fiber(
|
||||
JanetFiber **out,
|
||||
int flags) {
|
||||
|
||||
/* Initialize a new fiber */
|
||||
/* Initialize a new fiber with gc friendly defaults */
|
||||
JanetFiber *fiber = janet_gcalloc(JANET_MEMORY_FIBER, sizeof(JanetFiber));
|
||||
fiber->flags = 0;
|
||||
fiber->frame = 0;
|
||||
@@ -913,42 +947,41 @@ static const uint8_t *unmarshal_one_fiber(
|
||||
/* Push fiber to seen stack */
|
||||
janet_v_push(st->lookup, janet_wrap_fiber(fiber));
|
||||
|
||||
/* Set frame later so fiber can be GCed at anytime if unmarshalling fails */
|
||||
int32_t frame = 0;
|
||||
int32_t stack = 0;
|
||||
int32_t stacktop = 0;
|
||||
|
||||
/* Read ints */
|
||||
fiber->flags = readint(st, &data);
|
||||
frame = readint(st, &data);
|
||||
fiber->stackstart = readint(st, &data);
|
||||
fiber->stacktop = readint(st, &data);
|
||||
fiber->maxstack = readint(st, &data);
|
||||
int32_t fiber_flags = readint(st, &data);
|
||||
int32_t frame = readnat(st, &data);
|
||||
int32_t fiber_stackstart = readnat(st, &data);
|
||||
int32_t fiber_stacktop = readnat(st, &data);
|
||||
int32_t fiber_maxstack = readnat(st, &data);
|
||||
JanetTable *fiber_env = NULL;
|
||||
|
||||
/* Check for bad flags and ints */
|
||||
if ((int32_t)(frame + JANET_FRAME_SIZE) > fiber->stackstart ||
|
||||
fiber->stackstart > fiber->stacktop ||
|
||||
fiber->stacktop > fiber->maxstack) {
|
||||
if ((int32_t)(frame + JANET_FRAME_SIZE) > fiber_stackstart ||
|
||||
fiber_stackstart > fiber_stacktop ||
|
||||
fiber_stacktop > fiber_maxstack) {
|
||||
janet_panic("fiber has incorrect stack setup");
|
||||
}
|
||||
|
||||
/* Allocate stack memory */
|
||||
fiber->capacity = fiber->stacktop + 10;
|
||||
fiber->capacity = fiber_stacktop + 10;
|
||||
fiber->data = malloc(sizeof(Janet) * fiber->capacity);
|
||||
if (!fiber->data) {
|
||||
JANET_OUT_OF_MEMORY;
|
||||
}
|
||||
for (int32_t i = 0; i < fiber->capacity; i++) {
|
||||
fiber->data[i] = janet_wrap_nil();
|
||||
}
|
||||
|
||||
/* get frames */
|
||||
stack = frame;
|
||||
stacktop = fiber->stackstart - JANET_FRAME_SIZE;
|
||||
int32_t stack = frame;
|
||||
int32_t stacktop = fiber_stackstart - JANET_FRAME_SIZE;
|
||||
while (stack > 0) {
|
||||
JanetFunction *func = NULL;
|
||||
JanetFuncDef *def = NULL;
|
||||
JanetFuncEnv *env = NULL;
|
||||
int32_t frameflags = readint(st, &data);
|
||||
int32_t prevframe = readint(st, &data);
|
||||
int32_t pcdiff = readint(st, &data);
|
||||
int32_t prevframe = readnat(st, &data);
|
||||
int32_t pcdiff = readnat(st, &data);
|
||||
|
||||
/* Get frame items */
|
||||
Janet *framestack = fiber->data + stack;
|
||||
@@ -964,15 +997,7 @@ static const uint8_t *unmarshal_one_fiber(
|
||||
/* Check env */
|
||||
if (frameflags & JANET_STACKFRAME_HASENV) {
|
||||
frameflags &= ~JANET_STACKFRAME_HASENV;
|
||||
int32_t offset = stack;
|
||||
int32_t length = stacktop - stack;
|
||||
data = unmarshal_one_env(st, data, &env, flags + 1);
|
||||
if (env->offset != 0 && env->offset != offset)
|
||||
janet_panic("funcenv offset does not match fiber frame");
|
||||
if (env->length != 0 && env->length != length)
|
||||
janet_panic("funcenv length does not match fiber frame");
|
||||
env->offset = offset;
|
||||
env->length = length;
|
||||
}
|
||||
|
||||
/* Error checking */
|
||||
@@ -980,11 +1005,11 @@ static const uint8_t *unmarshal_one_fiber(
|
||||
if (expected_framesize != stacktop - stack) {
|
||||
janet_panic("fiber stackframe size mismatch");
|
||||
}
|
||||
if (pcdiff < 0 || pcdiff >= def->bytecode_length) {
|
||||
if (pcdiff >= def->bytecode_length) {
|
||||
janet_panic("fiber stackframe has invalid pc");
|
||||
}
|
||||
if ((int32_t)(prevframe + JANET_FRAME_SIZE) > stack) {
|
||||
janet_panic("fibre stackframe does not align with previous frame");
|
||||
janet_panic("fiber stackframe does not align with previous frame");
|
||||
}
|
||||
|
||||
/* Get stack items */
|
||||
@@ -1007,25 +1032,32 @@ static const uint8_t *unmarshal_one_fiber(
|
||||
}
|
||||
|
||||
/* Check for fiber env */
|
||||
if (fiber->flags & JANET_FIBER_FLAG_HASENV) {
|
||||
if (fiber_flags & JANET_FIBER_FLAG_HASENV) {
|
||||
Janet envv;
|
||||
fiber->flags &= ~JANET_FIBER_FLAG_HASENV;
|
||||
fiber_flags &= ~JANET_FIBER_FLAG_HASENV;
|
||||
data = unmarshal_one(st, data, &envv, flags + 1);
|
||||
janet_asserttype(envv, JANET_TABLE);
|
||||
fiber->env = janet_unwrap_table(envv);
|
||||
fiber_env = janet_unwrap_table(envv);
|
||||
}
|
||||
|
||||
/* Check for child fiber */
|
||||
if (fiber->flags & JANET_FIBER_FLAG_HASCHILD) {
|
||||
if (fiber_flags & JANET_FIBER_FLAG_HASCHILD) {
|
||||
Janet fiberv;
|
||||
fiber->flags &= ~JANET_FIBER_FLAG_HASCHILD;
|
||||
fiber_flags &= ~JANET_FIBER_FLAG_HASCHILD;
|
||||
data = unmarshal_one(st, data, &fiberv, flags + 1);
|
||||
janet_asserttype(fiberv, JANET_FIBER);
|
||||
fiber->child = janet_unwrap_fiber(fiberv);
|
||||
}
|
||||
|
||||
/* Return data */
|
||||
/* We have valid fiber, finally construct remaining fields. */
|
||||
fiber->frame = frame;
|
||||
fiber->flags = fiber_flags;
|
||||
fiber->stackstart = fiber_stackstart;
|
||||
fiber->stacktop = fiber_stacktop;
|
||||
fiber->maxstack = fiber_maxstack;
|
||||
fiber->env = fiber_env;
|
||||
|
||||
/* Return data */
|
||||
*out = fiber;
|
||||
return data;
|
||||
}
|
||||
@@ -1084,7 +1116,7 @@ static const uint8_t *unmarshal_one_abstract(UnmarshalState *st, const uint8_t *
|
||||
Janet key;
|
||||
data = unmarshal_one(st, data, &key, flags + 1);
|
||||
const JanetAbstractType *at = janet_get_abstract_type(key);
|
||||
if (at == NULL) return NULL;
|
||||
if (at == NULL) goto oops;
|
||||
if (at->unmarshal) {
|
||||
JanetMarshalContext context = {NULL, st, flags, data, at};
|
||||
*out = janet_wrap_abstract(at->unmarshal(&context));
|
||||
@@ -1093,7 +1125,8 @@ static const uint8_t *unmarshal_one_abstract(UnmarshalState *st, const uint8_t *
|
||||
}
|
||||
return context.data;
|
||||
}
|
||||
return NULL;
|
||||
oops:
|
||||
janet_panic("invalid abstract type");
|
||||
}
|
||||
|
||||
static const uint8_t *unmarshal_one(
|
||||
@@ -1105,7 +1138,7 @@ static const uint8_t *unmarshal_one(
|
||||
MARSH_STACKCHECK;
|
||||
MARSH_EOS(st, data);
|
||||
lead = data[0];
|
||||
if (lead < 200) {
|
||||
if (lead < LB_REAL) {
|
||||
*out = janet_wrap_integer(readint(st, &data));
|
||||
return data;
|
||||
}
|
||||
@@ -1159,7 +1192,7 @@ static const uint8_t *unmarshal_one(
|
||||
case LB_KEYWORD:
|
||||
case LB_REGISTRY: {
|
||||
data++;
|
||||
int32_t len = readint(st, &data);
|
||||
int32_t len = readnat(st, &data);
|
||||
MARSH_EOS(st, data - 1 + len);
|
||||
if (lead == LB_STRING) {
|
||||
const uint8_t *str = janet_string(data, len);
|
||||
@@ -1219,7 +1252,11 @@ static const uint8_t *unmarshal_one(
|
||||
/* Things that open with integers */
|
||||
{
|
||||
data++;
|
||||
int32_t len = readint(st, &data);
|
||||
int32_t len = readnat(st, &data);
|
||||
/* DOS check */
|
||||
if (lead != LB_REFERENCE) {
|
||||
MARSH_EOS(st, data - 1 + len);
|
||||
}
|
||||
if (lead == LB_ARRAY) {
|
||||
/* Array */
|
||||
JanetArray *array = janet_array(len);
|
||||
@@ -1251,7 +1288,7 @@ static const uint8_t *unmarshal_one(
|
||||
*out = janet_wrap_struct(janet_struct_end(struct_));
|
||||
janet_v_push(st->lookup, *out);
|
||||
} else if (lead == LB_REFERENCE) {
|
||||
if (len < 0 || len >= janet_v_count(st->lookup))
|
||||
if (len >= janet_v_count(st->lookup))
|
||||
janet_panicf("invalid reference %d", len);
|
||||
*out = st->lookup[len];
|
||||
} else {
|
||||
@@ -1274,6 +1311,42 @@ static const uint8_t *unmarshal_one(
|
||||
}
|
||||
return data;
|
||||
}
|
||||
case LB_UNSAFE_POINTER: {
|
||||
MARSH_EOS(st, data + sizeof(void *));
|
||||
data++;
|
||||
if (!(flags & JANET_MARSHAL_UNSAFE)) {
|
||||
janet_panicf("unsafe flag not given, "
|
||||
"will not unmarshal raw pointer at index %d",
|
||||
(int)(data - st->start));
|
||||
}
|
||||
union {
|
||||
void *ptr;
|
||||
uint8_t bytes[sizeof(void *)];
|
||||
} u;
|
||||
memcpy(u.bytes, data, sizeof(void *));
|
||||
data += sizeof(void *);
|
||||
*out = janet_wrap_pointer(u.ptr);
|
||||
janet_v_push(st->lookup, *out);
|
||||
return data;
|
||||
}
|
||||
case LB_UNSAFE_CFUNCTION: {
|
||||
MARSH_EOS(st, data + sizeof(JanetCFunction));
|
||||
data++;
|
||||
if (!(flags & JANET_MARSHAL_UNSAFE)) {
|
||||
janet_panicf("unsafe flag not given, "
|
||||
"will not unmarshal function pointer at index %d",
|
||||
(int)(data - st->start));
|
||||
}
|
||||
union {
|
||||
JanetCFunction ptr;
|
||||
uint8_t bytes[sizeof(JanetCFunction)];
|
||||
} u;
|
||||
memcpy(u.bytes, data, sizeof(JanetCFunction));
|
||||
data += sizeof(JanetCFunction);
|
||||
*out = janet_wrap_cfunction(u.ptr);
|
||||
janet_v_push(st->lookup, *out);
|
||||
return data;
|
||||
}
|
||||
default: {
|
||||
janet_panicf("unknown byte %x at index %d",
|
||||
*data,
|
||||
@@ -1344,17 +1417,17 @@ static const JanetReg marsh_cfuns[] = {
|
||||
{
|
||||
"marshal", cfun_marshal,
|
||||
JDOC("(marshal x &opt reverse-lookup buffer)\n\n"
|
||||
"Marshal a janet value into a buffer and return the buffer. The buffer "
|
||||
"Marshal a value into a buffer and return the buffer. The buffer "
|
||||
"can the later be unmarshalled to reconstruct the initial value. "
|
||||
"Optionally, one can pass in a reverse lookup table to not marshal "
|
||||
"aliased values that are found in the table. Then a forward"
|
||||
"lookup table can be used to recover the original janet value when "
|
||||
"lookup table can be used to recover the original value when "
|
||||
"unmarshalling.")
|
||||
},
|
||||
{
|
||||
"unmarshal", cfun_unmarshal,
|
||||
JDOC("(unmarshal buffer &opt lookup)\n\n"
|
||||
"Unmarshal a janet value from a buffer. An optional lookup table "
|
||||
"Unmarshal a value from a buffer. An optional lookup table "
|
||||
"can be provided to allow for aliases to be resolved. Returns the value "
|
||||
"unmarshalled from the buffer.")
|
||||
},
|
||||
|
||||
@@ -255,6 +255,10 @@ JANET_DEFINE_MATHOP(fabs, fabs)
|
||||
JANET_DEFINE_MATHOP(floor, floor)
|
||||
JANET_DEFINE_MATHOP(trunc, trunc)
|
||||
JANET_DEFINE_MATHOP(round, round)
|
||||
JANET_DEFINE_MATHOP(gamma, lgamma)
|
||||
JANET_DEFINE_MATHOP(log1p, log1p)
|
||||
JANET_DEFINE_MATHOP(erf, erf)
|
||||
JANET_DEFINE_MATHOP(erfc, erfc)
|
||||
|
||||
#define JANET_DEFINE_MATH2OP(name, fop)\
|
||||
static Janet janet_##name(int32_t argc, Janet *argv) {\
|
||||
@@ -267,6 +271,7 @@ static Janet janet_##name(int32_t argc, Janet *argv) {\
|
||||
JANET_DEFINE_MATH2OP(atan2, atan2)
|
||||
JANET_DEFINE_MATH2OP(pow, pow)
|
||||
JANET_DEFINE_MATH2OP(hypot, hypot)
|
||||
JANET_DEFINE_MATH2OP(nextafter, nextafter)
|
||||
|
||||
static Janet janet_not(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 1);
|
||||
@@ -408,7 +413,7 @@ static const JanetReg math_cfuns[] = {
|
||||
"math/rng", cfun_rng_make,
|
||||
JDOC("(math/rng &opt seed)\n\n"
|
||||
"Creates a Psuedo-Random number generator, with an optional seed. "
|
||||
"The seed should be an unsigned 32 bit integer. "
|
||||
"The seed should be an unsigned 32 bit integer or a buffer. "
|
||||
"Do not use this for cryptography. Returns a core/rng abstract type.")
|
||||
},
|
||||
{
|
||||
@@ -438,6 +443,26 @@ static const JanetReg math_cfuns[] = {
|
||||
JDOC("(math/exp2 x)\n\n"
|
||||
"Returns 2 to the power of x.")
|
||||
},
|
||||
{
|
||||
"math/log1p", janet_log1p,
|
||||
JDOC("(math/log1p x)\n\n"
|
||||
"Returns (log base e of x) + 1 more accurately than (+ (math/log x) 1)")
|
||||
},
|
||||
{
|
||||
"math/gamma", janet_gamma,
|
||||
JDOC("(math/gamma x)\n\n"
|
||||
"Returns gamma(x).")
|
||||
},
|
||||
{
|
||||
"math/erfc", janet_erfc,
|
||||
JDOC("(math/erfc x)\n\n"
|
||||
"Returns the complementary error function of x.")
|
||||
},
|
||||
{
|
||||
"math/erf", janet_erf,
|
||||
JDOC("(math/erf x)\n\n"
|
||||
"Returns the error function of x.")
|
||||
},
|
||||
{
|
||||
"math/expm1", janet_expm1,
|
||||
JDOC("(math/expm1 x)\n\n"
|
||||
@@ -453,6 +478,11 @@ static const JanetReg math_cfuns[] = {
|
||||
JDOC("(math/round x)\n\n"
|
||||
"Returns the integer nearest to x.")
|
||||
},
|
||||
{
|
||||
"math/next", janet_nextafter,
|
||||
JDOC("(math/next x y)\n\n"
|
||||
"Returns the next representable floating point value after x in the direction of y.")
|
||||
},
|
||||
{NULL, NULL, NULL}
|
||||
};
|
||||
|
||||
|
||||
677
src/core/net.c
Normal file
677
src/core/net.c
Normal file
@@ -0,0 +1,677 @@
|
||||
/*
|
||||
* 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_AMALG
|
||||
#include "features.h"
|
||||
#include <janet.h>
|
||||
#include "util.h"
|
||||
#endif
|
||||
|
||||
#ifdef JANET_WINDOWS
|
||||
#include <windows.h>
|
||||
#include <winsock2.h>
|
||||
#include <ws2tcpip.h>
|
||||
#pragma comment (lib, "Ws2_32.lib")
|
||||
#pragma comment (lib, "Mswsock.lib")
|
||||
#pragma comment (lib, "Advapi32.lib")
|
||||
#else
|
||||
#include <unistd.h>
|
||||
#include <signal.h>
|
||||
#include <sys/ioctl.h>
|
||||
#include <sys/types.h>
|
||||
#include <sys/socket.h>
|
||||
#include <poll.h>
|
||||
#include <netdb.h>
|
||||
#include <fcntl.h>
|
||||
#endif
|
||||
|
||||
/*
|
||||
* Streams
|
||||
*/
|
||||
|
||||
#define JANET_STREAM_CLOSED 1
|
||||
#define JANET_STREAM_READABLE 2
|
||||
#define JANET_STREAM_WRITABLE 4
|
||||
|
||||
static int janet_stream_close(void *p, size_t s);
|
||||
static int janet_stream_getter(void *p, Janet key, Janet *out);
|
||||
static const JanetAbstractType StreamAT = {
|
||||
"core/stream",
|
||||
janet_stream_close,
|
||||
NULL,
|
||||
janet_stream_getter,
|
||||
JANET_ATEND_GET
|
||||
};
|
||||
|
||||
#ifdef JANET_WINDOWS
|
||||
typedef struct {
|
||||
SOCKET fd;
|
||||
int flags;
|
||||
} JanetStream;
|
||||
#define JSOCKCLOSE(x) closesocket(x)
|
||||
#define JSOCKDEFAULT INVALID_SOCKET
|
||||
#define JLASTERR WSAGetLastError()
|
||||
#define JSOCKVALID(x) ((x) != INVALID_SOCKET)
|
||||
#define JEINTR WSAEINTR
|
||||
#define JEWOULDBLOCK WSAEWOULDBLOCK
|
||||
#define JEAGAIN WSAEWOULDBLOCK
|
||||
#define JPOLL WSAPoll
|
||||
#define JPollStruct WSAPOLLFD
|
||||
#define JSock SOCKET
|
||||
#define JReadInt long
|
||||
#define JSOCKFLAGS 0
|
||||
static JanetStream *make_stream(SOCKET fd, int flags) {
|
||||
u_long iMode = 0;
|
||||
JanetStream *stream = janet_abstract(&StreamAT, sizeof(JanetStream));
|
||||
ioctlsocket(fd, FIONBIO, &iMode);
|
||||
stream->fd = fd;
|
||||
stream->flags = flags;
|
||||
return stream;
|
||||
}
|
||||
#else
|
||||
typedef struct {
|
||||
int fd;
|
||||
int flags;
|
||||
} JanetStream;
|
||||
#define JSOCKCLOSE(x) close(x)
|
||||
#define JSOCKDEFAULT 0
|
||||
#define JLASTERR errno
|
||||
#define JSOCKVALID(x) ((x) >= 0)
|
||||
#define JEINTR EINTR
|
||||
#define JEWOULDBLOCK EWOULDBLOCK
|
||||
#define JEAGAIN EAGAIN
|
||||
#define JPOLL poll
|
||||
#define JPollStruct struct pollfd
|
||||
#define JSock int
|
||||
#define JReadInt ssize_t
|
||||
#ifdef SOCK_CLOEXEC
|
||||
#define JSOCKFLAGS SOCK_CLOEXEC
|
||||
#else
|
||||
#define JSOCKFLAGS 0
|
||||
#endif
|
||||
static JanetStream *make_stream(int fd, int flags) {
|
||||
JanetStream *stream = janet_abstract(&StreamAT, sizeof(JanetStream));
|
||||
#ifndef SOCK_CLOEXEC
|
||||
int extra = O_CLOEXEC;
|
||||
#else
|
||||
int extra = 0;
|
||||
#endif
|
||||
fcntl(fd, F_SETFL, fcntl(fd, F_GETFL, 0) | O_NONBLOCK | extra);
|
||||
stream->fd = fd;
|
||||
stream->flags = flags;
|
||||
return stream;
|
||||
}
|
||||
#endif
|
||||
|
||||
/* We pass this flag to all send calls to prevent sigpipe */
|
||||
#ifndef MSG_NOSIGNAL
|
||||
#define MSG_NOSIGNAL 0
|
||||
#endif
|
||||
|
||||
static int janet_stream_close(void *p, size_t s) {
|
||||
(void) s;
|
||||
JanetStream *stream = p;
|
||||
if (!(stream->flags & JANET_STREAM_CLOSED)) {
|
||||
stream->flags |= JANET_STREAM_CLOSED;
|
||||
JSOCKCLOSE(stream->fd);
|
||||
}
|
||||
return 0;
|
||||
}
|
||||
|
||||
/*
|
||||
* Event loop
|
||||
*/
|
||||
|
||||
/* This large struct describes a waiting file descriptor, as well
|
||||
* as what to do when we get an event for it. It is a variant type, where
|
||||
* each variant implements a simple state machine. */
|
||||
typedef struct {
|
||||
|
||||
/* File descriptor to listen for events on. */
|
||||
JanetStream *stream;
|
||||
|
||||
/* Fiber to resume when event finishes. Can be NULL, in which case,
|
||||
* no fiber is resumed when event completes. */
|
||||
JanetFiber *fiber;
|
||||
|
||||
/* What kind of event we are listening for.
|
||||
* As more IO functionality get's added, we can
|
||||
* expand this. */
|
||||
enum {
|
||||
JLE_READ_CHUNK,
|
||||
JLE_READ_SOME,
|
||||
JLE_READ_ACCEPT,
|
||||
JLE_CONNECT,
|
||||
JLE_WRITE_FROM_BUFFER,
|
||||
JLE_WRITE_FROM_STRINGLIKE
|
||||
} event_type;
|
||||
|
||||
/* Each variant can have a different payload. */
|
||||
union {
|
||||
|
||||
/* JLE_READ_CHUNK/JLE_READ_SOME */
|
||||
struct {
|
||||
int32_t bytes_left;
|
||||
JanetBuffer *buf;
|
||||
} read_chunk;
|
||||
|
||||
/* JLE_READ_ACCEPT */
|
||||
struct {
|
||||
JanetFunction *handler;
|
||||
} read_accept;
|
||||
|
||||
/* JLE_WRITE_FROM_BUFFER */
|
||||
struct {
|
||||
JanetBuffer *buf;
|
||||
int32_t start;
|
||||
} write_from_buffer;
|
||||
|
||||
/* JLE_WRITE_FROM_STRINGLIKE */
|
||||
struct {
|
||||
const uint8_t *str;
|
||||
int32_t start;
|
||||
} write_from_stringlike;
|
||||
|
||||
} data;
|
||||
|
||||
} JanetLoopFD;
|
||||
|
||||
#define JANET_LOOPFD_MAX 1024
|
||||
|
||||
/* Global loop data */
|
||||
JANET_THREAD_LOCAL JPollStruct janet_vm_pollfds[JANET_LOOPFD_MAX];
|
||||
JANET_THREAD_LOCAL JanetLoopFD janet_vm_loopfds[JANET_LOOPFD_MAX];
|
||||
JANET_THREAD_LOCAL int janet_vm_loop_count;
|
||||
|
||||
/* We could also add/remove gc roots. This is easier for now. */
|
||||
void janet_net_markloop(void) {
|
||||
for (int i = 0; i < janet_vm_loop_count; i++) {
|
||||
JanetLoopFD lfd = janet_vm_loopfds[i];
|
||||
if (lfd.fiber != NULL) {
|
||||
janet_mark(janet_wrap_fiber(lfd.fiber));
|
||||
}
|
||||
janet_mark(janet_wrap_abstract(lfd.stream));
|
||||
switch (lfd.event_type) {
|
||||
default:
|
||||
break;
|
||||
case JLE_READ_CHUNK:
|
||||
case JLE_READ_SOME:
|
||||
janet_mark(janet_wrap_buffer(lfd.data.read_chunk.buf));
|
||||
break;
|
||||
case JLE_READ_ACCEPT:
|
||||
janet_mark(janet_wrap_function(lfd.data.read_accept.handler));
|
||||
break;
|
||||
case JLE_CONNECT:
|
||||
break;
|
||||
case JLE_WRITE_FROM_BUFFER:
|
||||
janet_mark(janet_wrap_buffer(lfd.data.write_from_buffer.buf));
|
||||
break;
|
||||
case JLE_WRITE_FROM_STRINGLIKE:
|
||||
janet_mark(janet_wrap_string(lfd.data.write_from_stringlike.str));
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
/* Add a loop fd to the global event loop */
|
||||
static int janet_loop_schedule(JanetLoopFD lfd, short events) {
|
||||
if (janet_vm_loop_count == JANET_LOOPFD_MAX) {
|
||||
return -1;
|
||||
}
|
||||
int index = janet_vm_loop_count++;
|
||||
janet_vm_loopfds[index] = lfd;
|
||||
janet_vm_pollfds[index].fd = lfd.stream->fd;
|
||||
janet_vm_pollfds[index].events = events;
|
||||
janet_vm_pollfds[index].revents = 0;
|
||||
return index;
|
||||
}
|
||||
|
||||
/* Remove event from list */
|
||||
static void janet_loop_rmindex(int index) {
|
||||
janet_vm_loopfds[index] = janet_vm_loopfds[--janet_vm_loop_count];
|
||||
janet_vm_pollfds[index] = janet_vm_pollfds[janet_vm_loop_count];
|
||||
}
|
||||
|
||||
|
||||
/* Return delta in number of loop fds. Abstracted out so
|
||||
* we can separate out the polling logic */
|
||||
static size_t janet_loop_event(size_t index) {
|
||||
JanetLoopFD *jlfd = janet_vm_loopfds + index;
|
||||
JanetStream *stream = jlfd->stream;
|
||||
JSock fd = stream->fd;
|
||||
int ret = 1;
|
||||
int should_resume = 0;
|
||||
Janet resumeval = janet_wrap_nil();
|
||||
if (stream->flags & JANET_STREAM_CLOSED) {
|
||||
should_resume = 1;
|
||||
ret = 0;
|
||||
} else {
|
||||
switch (jlfd->event_type) {
|
||||
case JLE_READ_CHUNK:
|
||||
case JLE_READ_SOME: {
|
||||
JanetBuffer *buffer = jlfd->data.read_chunk.buf;
|
||||
int32_t bytes_left = jlfd->data.read_chunk.bytes_left;
|
||||
janet_buffer_extra(buffer, bytes_left);
|
||||
if (!(stream->flags & JANET_STREAM_READABLE)) {
|
||||
should_resume = 1;
|
||||
ret = 0;
|
||||
break;
|
||||
}
|
||||
JReadInt nread;
|
||||
do {
|
||||
nread = recv(fd, buffer->data + buffer->count, bytes_left, 0);
|
||||
} while (nread == -1 && JLASTERR == JEINTR);
|
||||
if (JLASTERR == JEAGAIN || JLASTERR == JEWOULDBLOCK) {
|
||||
ret = 1;
|
||||
break;
|
||||
}
|
||||
|
||||
if (nread > 0) {
|
||||
buffer->count += nread;
|
||||
bytes_left -= nread;
|
||||
} else {
|
||||
bytes_left = 0;
|
||||
}
|
||||
if (jlfd->event_type == JLE_READ_SOME || bytes_left == 0) {
|
||||
should_resume = 1;
|
||||
if (nread > 0) {
|
||||
resumeval = janet_wrap_buffer(buffer);
|
||||
}
|
||||
ret = 0;
|
||||
} else {
|
||||
jlfd->data.read_chunk.bytes_left = bytes_left;
|
||||
ret = 1;
|
||||
}
|
||||
break;
|
||||
}
|
||||
case JLE_READ_ACCEPT: {
|
||||
JSock connfd = accept(fd, NULL, NULL);
|
||||
if (JSOCKVALID(connfd)) {
|
||||
/* Made a new connection socket */
|
||||
JanetStream *stream = make_stream(connfd, JANET_STREAM_READABLE | JANET_STREAM_WRITABLE);
|
||||
Janet streamv = janet_wrap_abstract(stream);
|
||||
JanetFunction *handler = jlfd->data.read_accept.handler;
|
||||
Janet out;
|
||||
JanetFiber *fiberp = NULL;
|
||||
/* Launch connection fiber */
|
||||
JanetSignal sig = janet_pcall(handler, 1, &streamv, &out, &fiberp);
|
||||
if (sig != JANET_SIGNAL_OK && sig != JANET_SIGNAL_EVENT) {
|
||||
janet_stacktrace(fiberp, out);
|
||||
}
|
||||
}
|
||||
ret = JANET_LOOPFD_MAX;
|
||||
break;
|
||||
}
|
||||
case JLE_WRITE_FROM_BUFFER:
|
||||
case JLE_WRITE_FROM_STRINGLIKE: {
|
||||
int32_t start, len;
|
||||
const uint8_t *bytes;
|
||||
if (!(stream->flags & JANET_STREAM_WRITABLE)) {
|
||||
should_resume = 1;
|
||||
ret = 0;
|
||||
break;
|
||||
}
|
||||
if (jlfd->event_type == JLE_WRITE_FROM_BUFFER) {
|
||||
JanetBuffer *buffer = jlfd->data.write_from_buffer.buf;
|
||||
bytes = buffer->data;
|
||||
len = buffer->count;
|
||||
start = jlfd->data.write_from_buffer.start;
|
||||
} else {
|
||||
bytes = jlfd->data.write_from_stringlike.str;
|
||||
len = janet_string_length(bytes);
|
||||
start = jlfd->data.write_from_stringlike.start;
|
||||
}
|
||||
if (start < len) {
|
||||
int32_t nbytes = len - start;
|
||||
JReadInt nwrote;
|
||||
do {
|
||||
nwrote = send(fd, bytes + start, nbytes, MSG_NOSIGNAL);
|
||||
} while (nwrote == -1 && JLASTERR == JEINTR);
|
||||
if (nwrote > 0) {
|
||||
start += nwrote;
|
||||
} else {
|
||||
start = len;
|
||||
}
|
||||
}
|
||||
if (start >= len) {
|
||||
should_resume = 1;
|
||||
ret = 0;
|
||||
} else {
|
||||
if (jlfd->event_type == JLE_WRITE_FROM_BUFFER) {
|
||||
jlfd->data.write_from_buffer.start = start;
|
||||
} else {
|
||||
jlfd->data.write_from_stringlike.start = start;
|
||||
}
|
||||
ret = 1;
|
||||
}
|
||||
break;
|
||||
}
|
||||
case JLE_CONNECT: {
|
||||
break;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
/* Resume a fiber for some events */
|
||||
if (NULL != jlfd->fiber && should_resume) {
|
||||
/* Resume the fiber */
|
||||
Janet out;
|
||||
JanetSignal sig = janet_continue(jlfd->fiber, resumeval, &out);
|
||||
if (sig != JANET_SIGNAL_OK && sig != JANET_SIGNAL_EVENT) {
|
||||
janet_stacktrace(jlfd->fiber, out);
|
||||
}
|
||||
}
|
||||
|
||||
/* Remove this handler from the handler pool. */
|
||||
if (should_resume) janet_loop_rmindex((int) index);
|
||||
|
||||
return ret;
|
||||
}
|
||||
|
||||
static void janet_loop1(void) {
|
||||
/* Remove closed file descriptors */
|
||||
for (int i = 0; i < janet_vm_loop_count;) {
|
||||
if (janet_vm_loopfds[i].stream->flags & JANET_STREAM_CLOSED) {
|
||||
janet_loop_rmindex(i);
|
||||
} else {
|
||||
i++;
|
||||
}
|
||||
}
|
||||
/* Poll */
|
||||
if (janet_vm_loop_count == 0) return;
|
||||
int ready;
|
||||
do {
|
||||
ready = JPOLL(janet_vm_pollfds, janet_vm_loop_count, -1);
|
||||
} while (ready == -1 && JLASTERR == JEINTR);
|
||||
if (ready == -1) return;
|
||||
/* Handle events */
|
||||
for (int i = 0; i < janet_vm_loop_count;) {
|
||||
int revents = janet_vm_pollfds[i].revents;
|
||||
janet_vm_pollfds[i].revents = 0;
|
||||
if ((janet_vm_pollfds[i].events | POLLHUP | POLLERR) & revents) {
|
||||
size_t delta = janet_loop_event(i);
|
||||
i += (int) delta;
|
||||
} else {
|
||||
i++;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
void janet_loop(void) {
|
||||
while (janet_vm_loop_count) {
|
||||
janet_loop1();
|
||||
}
|
||||
}
|
||||
|
||||
/*
|
||||
* Scheduling Helpers
|
||||
*/
|
||||
|
||||
#define JANET_SCHED_FSOME 1
|
||||
|
||||
JANET_NO_RETURN static void janet_sched_read(JanetStream *stream, JanetBuffer *buf, int32_t nbytes, int flags) {
|
||||
JanetLoopFD lfd;
|
||||
lfd.stream = stream;
|
||||
lfd.fiber = janet_root_fiber();
|
||||
lfd.event_type = (flags & JANET_SCHED_FSOME) ? JLE_READ_SOME : JLE_READ_CHUNK;
|
||||
lfd.data.read_chunk.buf = buf;
|
||||
lfd.data.read_chunk.bytes_left = nbytes;
|
||||
janet_loop_schedule(lfd, POLLIN);
|
||||
janet_signalv(JANET_SIGNAL_EVENT, janet_wrap_nil());
|
||||
}
|
||||
|
||||
JANET_NO_RETURN static void janet_sched_write_buffer(JanetStream *stream, JanetBuffer *buf) {
|
||||
JanetLoopFD lfd;
|
||||
lfd.stream = stream;
|
||||
lfd.fiber = janet_root_fiber();
|
||||
lfd.event_type = JLE_WRITE_FROM_BUFFER;
|
||||
lfd.data.write_from_buffer.buf = buf;
|
||||
lfd.data.write_from_buffer.start = 0;
|
||||
janet_loop_schedule(lfd, POLLOUT);
|
||||
janet_signalv(JANET_SIGNAL_EVENT, janet_wrap_nil());
|
||||
}
|
||||
|
||||
JANET_NO_RETURN static void janet_sched_write_stringlike(JanetStream *stream, const uint8_t *str) {
|
||||
JanetLoopFD lfd;
|
||||
lfd.stream = stream;
|
||||
lfd.fiber = janet_root_fiber();
|
||||
lfd.event_type = JLE_WRITE_FROM_STRINGLIKE;
|
||||
lfd.data.write_from_stringlike.str = str;
|
||||
lfd.data.write_from_stringlike.start = 0;
|
||||
janet_loop_schedule(lfd, POLLOUT);
|
||||
janet_signalv(JANET_SIGNAL_EVENT, janet_wrap_nil());
|
||||
}
|
||||
|
||||
/* Needs argc >= offset + 2 */
|
||||
static struct addrinfo *janet_get_addrinfo(Janet *argv, int32_t offset) {
|
||||
/* Get host and port */
|
||||
const char *host = janet_getcstring(argv, offset);
|
||||
const char *port;
|
||||
if (janet_checkint(argv[offset + 1])) {
|
||||
port = (const char *)janet_to_string(argv[offset + 1]);
|
||||
} else {
|
||||
port = janet_getcstring(argv, offset + 1);
|
||||
}
|
||||
/* getaddrinfo */
|
||||
struct addrinfo *ai = NULL;
|
||||
struct addrinfo hints;
|
||||
memset(&hints, 0, sizeof(hints));
|
||||
hints.ai_family = AF_UNSPEC;
|
||||
hints.ai_socktype = SOCK_STREAM;
|
||||
hints.ai_protocol = 0;
|
||||
hints.ai_flags = AI_PASSIVE;
|
||||
int status = getaddrinfo(host, port, &hints, &ai);
|
||||
if (status) {
|
||||
janet_panicf("could not get address info: %s", gai_strerror(status));
|
||||
}
|
||||
return ai;
|
||||
}
|
||||
|
||||
/*
|
||||
* C Funs
|
||||
*/
|
||||
|
||||
static Janet cfun_net_connect(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 2);
|
||||
|
||||
struct addrinfo *ai = janet_get_addrinfo(argv, 0);
|
||||
|
||||
/* Create socket */
|
||||
JSock sock = socket(ai->ai_family, ai->ai_socktype | JSOCKFLAGS, ai->ai_protocol);
|
||||
if (!JSOCKVALID(sock)) {
|
||||
freeaddrinfo(ai);
|
||||
janet_panic("could not create socket");
|
||||
}
|
||||
|
||||
/* Connect to socket */
|
||||
int status = connect(sock, ai->ai_addr, (int) ai->ai_addrlen);
|
||||
freeaddrinfo(ai);
|
||||
if (status == -1) {
|
||||
JSOCKCLOSE(sock);
|
||||
janet_panic("could not connect to socket");
|
||||
}
|
||||
|
||||
/* Wrap socket in abstract type JanetStream */
|
||||
JanetStream *stream = make_stream(sock, JANET_STREAM_READABLE | JANET_STREAM_WRITABLE);
|
||||
return janet_wrap_abstract(stream);
|
||||
}
|
||||
|
||||
static Janet cfun_net_server(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 3);
|
||||
|
||||
/* Get host, port, and handler*/
|
||||
JanetFunction *fun = janet_getfunction(argv, 2);
|
||||
|
||||
struct addrinfo *ai = janet_get_addrinfo(argv, 0);
|
||||
|
||||
/* Check all addrinfos in a loop for the first that we can bind to. */
|
||||
JSock sfd = JSOCKDEFAULT;
|
||||
struct addrinfo *rp = NULL;
|
||||
for (rp = ai; rp != NULL; rp = rp->ai_next) {
|
||||
sfd = socket(rp->ai_family, rp->ai_socktype | JSOCKFLAGS, rp->ai_protocol);
|
||||
if (!JSOCKVALID(sfd)) continue;
|
||||
/* Set various socket options */
|
||||
int enable = 1;
|
||||
if (setsockopt(sfd, SOL_SOCKET, SO_REUSEADDR, (char *) &enable, sizeof(int)) < 0) {
|
||||
JSOCKCLOSE(sfd);
|
||||
janet_panic("setsockopt(SO_REUSEADDR) failed");
|
||||
}
|
||||
#ifdef SO_NOSIGPIPE
|
||||
if (setsockopt(sfd, SOL_SOCKET, SO_NOSIGPIPE, &enable, sizeof(int)) < 0) {
|
||||
JSOCKCLOSE(sfd);
|
||||
janet_panic("setsockopt(SO_NOSIGPIPE) failed");
|
||||
}
|
||||
#endif
|
||||
#ifdef SO_REUSEPORT
|
||||
if (setsockopt(sfd, SOL_SOCKET, SO_REUSEPORT, &enable, sizeof(int)) < 0) {
|
||||
JSOCKCLOSE(sfd);
|
||||
janet_panic("setsockopt(SO_REUSEPORT) failed");
|
||||
}
|
||||
#endif
|
||||
/* Bind */
|
||||
if (bind(sfd, rp->ai_addr, (int) rp->ai_addrlen) == 0) break;
|
||||
JSOCKCLOSE(sfd);
|
||||
}
|
||||
if (NULL == rp) {
|
||||
freeaddrinfo(ai);
|
||||
janet_panic("could not bind to any sockets");
|
||||
}
|
||||
|
||||
/* listen */
|
||||
int status = listen(sfd, 1024);
|
||||
freeaddrinfo(ai);
|
||||
if (status) {
|
||||
JSOCKCLOSE(sfd);
|
||||
janet_panic("could not listen on file descriptor");
|
||||
}
|
||||
|
||||
/* Put sfd on our loop */
|
||||
JanetLoopFD lfd = {0};
|
||||
lfd.stream = make_stream(sfd, 0);
|
||||
lfd.event_type = JLE_READ_ACCEPT;
|
||||
lfd.data.read_accept.handler = fun;
|
||||
janet_loop_schedule(lfd, POLLIN);
|
||||
|
||||
return janet_wrap_abstract(lfd.stream);
|
||||
}
|
||||
|
||||
static Janet cfun_stream_read(int32_t argc, Janet *argv) {
|
||||
janet_arity(argc, 2, 3);
|
||||
JanetStream *stream = janet_getabstract(argv, 0, &StreamAT);
|
||||
int32_t n = janet_getnat(argv, 1);
|
||||
JanetBuffer *buffer = janet_optbuffer(argv, argc, 2, 10);
|
||||
janet_sched_read(stream, buffer, n, JANET_SCHED_FSOME);
|
||||
}
|
||||
|
||||
static Janet cfun_stream_chunk(int32_t argc, Janet *argv) {
|
||||
janet_arity(argc, 2, 3);
|
||||
JanetStream *stream = janet_getabstract(argv, 0, &StreamAT);
|
||||
int32_t n = janet_getnat(argv, 1);
|
||||
JanetBuffer *buffer = janet_optbuffer(argv, argc, 2, 10);
|
||||
janet_sched_read(stream, buffer, n, 0);
|
||||
}
|
||||
|
||||
static Janet cfun_stream_close(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 1);
|
||||
JanetStream *stream = janet_getabstract(argv, 0, &StreamAT);
|
||||
janet_stream_close(stream, 0);
|
||||
return janet_wrap_nil();
|
||||
}
|
||||
|
||||
static Janet cfun_stream_write(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 2);
|
||||
JanetStream *stream = janet_getabstract(argv, 0, &StreamAT);
|
||||
if (janet_checktype(argv[1], JANET_BUFFER)) {
|
||||
janet_sched_write_buffer(stream, janet_getbuffer(argv, 1));
|
||||
} else {
|
||||
JanetByteView bytes = janet_getbytes(argv, 1);
|
||||
janet_sched_write_stringlike(stream, bytes.bytes);
|
||||
}
|
||||
}
|
||||
|
||||
static const JanetMethod stream_methods[] = {
|
||||
{"chunk", cfun_stream_chunk},
|
||||
{"close", cfun_stream_close},
|
||||
{"read", cfun_stream_read},
|
||||
{"write", cfun_stream_write},
|
||||
{NULL, NULL}
|
||||
};
|
||||
|
||||
static int janet_stream_getter(void *p, Janet key, Janet *out) {
|
||||
(void) p;
|
||||
if (!janet_checktype(key, JANET_KEYWORD)) return 0;
|
||||
return janet_getmethod(janet_unwrap_keyword(key), stream_methods, out);
|
||||
}
|
||||
|
||||
static const JanetReg net_cfuns[] = {
|
||||
{
|
||||
"net/server", cfun_net_server,
|
||||
JDOC("(net/server host port handler)\n\n"
|
||||
"Start a TCP server. handler is a function that will be called with a stream "
|
||||
"on each connection to the server. Returns a new stream that is neither readable nor "
|
||||
"writeable.")
|
||||
},
|
||||
{
|
||||
"net/read", cfun_stream_read,
|
||||
JDOC("(net/read stream nbytes &opt buf)\n\n"
|
||||
"Read up to n bytes from a stream, suspending the current fiber until the bytes are available. "
|
||||
"If less than n bytes are available (and more than 0), will push those bytes and return early. "
|
||||
"Returns a buffer with up to n more bytes in it.")
|
||||
},
|
||||
{
|
||||
"net/chunk", cfun_stream_chunk,
|
||||
JDOC("(net/chunk stream nbytes &opt buf)\n\n"
|
||||
"Same a net/read, but will wait for all n bytes to arrive rather than return early.")
|
||||
},
|
||||
{
|
||||
"net/write", cfun_stream_write,
|
||||
JDOC("(net/write stream data)\n\n"
|
||||
"Write data to a stream, suspending the current fiber until the write "
|
||||
"completes. Returns stream.")
|
||||
},
|
||||
{
|
||||
"net/close", cfun_stream_close,
|
||||
JDOC("(net/close stream)\n\n"
|
||||
"Close a stream so that no further communication can occur.")
|
||||
},
|
||||
{
|
||||
"net/connect", cfun_net_connect,
|
||||
JDOC("(net/connect host port)\n\n"
|
||||
"Open a connection to communicate with a server. Returns a duplex stream "
|
||||
"that can be used to communicate with the server.")
|
||||
},
|
||||
{NULL, NULL, NULL}
|
||||
};
|
||||
|
||||
void janet_lib_net(JanetTable *env) {
|
||||
janet_vm_loop_count = 0;
|
||||
#ifdef JANET_WINDOWS
|
||||
WSADATA wsaData;
|
||||
janet_assert(!WSAStartup(MAKEWORD(2, 2), &wsaData), "could not start winsock");
|
||||
#endif
|
||||
janet_core_cfuns(env, NULL, net_cfuns);
|
||||
}
|
||||
|
||||
void janet_net_deinit(void) {
|
||||
#ifdef JANET_WINDOWS
|
||||
WSACleanup();
|
||||
#endif
|
||||
}
|
||||
298
src/core/os.c
298
src/core/os.c
@@ -182,18 +182,9 @@ static Janet os_exit(int32_t argc, Janet *argv) {
|
||||
return janet_wrap_nil();
|
||||
}
|
||||
|
||||
#ifdef JANET_REDUCED_OS
|
||||
/* Provide a dud os/getenv so boot.janet and init.janet work, but nothing else */
|
||||
|
||||
static Janet os_getenv(int32_t argc, Janet *argv) {
|
||||
(void) argv;
|
||||
janet_arity(argc, 1, 2);
|
||||
return janet_wrap_nil();
|
||||
}
|
||||
|
||||
#else
|
||||
/* Provide full os functionality */
|
||||
#ifndef JANET_REDUCED_OS
|
||||
|
||||
#ifndef JANET_NO_PROCESSES
|
||||
/* Get env for os_execute */
|
||||
static char **os_execute_env(int32_t argc, const Janet *argv) {
|
||||
char **envp = NULL;
|
||||
@@ -389,15 +380,26 @@ static Janet os_execute(int32_t argc, Janet *argv) {
|
||||
char *const *cargv = (char *const *)child_argv;
|
||||
|
||||
/* Use posix_spawn to spawn new process */
|
||||
|
||||
int use_environ = !janet_flag_at(flags, 0);
|
||||
|
||||
if (use_environ) {
|
||||
janet_lock_environ();
|
||||
}
|
||||
|
||||
pid_t pid;
|
||||
if (janet_flag_at(flags, 1)) {
|
||||
status = posix_spawnp(&pid,
|
||||
child_argv[0], NULL, NULL, cargv,
|
||||
janet_flag_at(flags, 0) ? envp : environ);
|
||||
use_environ ? environ : envp);
|
||||
} else {
|
||||
status = posix_spawn(&pid,
|
||||
child_argv[0], NULL, NULL, cargv,
|
||||
janet_flag_at(flags, 0) ? envp : environ);
|
||||
use_environ ? environ : envp);
|
||||
}
|
||||
|
||||
if (use_environ) {
|
||||
janet_unlock_environ();
|
||||
}
|
||||
|
||||
/* Wait for child */
|
||||
@@ -433,6 +435,8 @@ static Janet os_shell(int32_t argc, Janet *argv) {
|
||||
: janet_wrap_boolean(stat);
|
||||
}
|
||||
|
||||
#endif /* JANET_NO_PROCESSES */
|
||||
|
||||
static Janet os_environ(int32_t argc, Janet *argv) {
|
||||
(void) argv;
|
||||
janet_fixarity(argc, 0);
|
||||
@@ -606,7 +610,7 @@ static Janet os_cryptorand(int32_t argc, Janet *argv) {
|
||||
In both cases, use this fallback path for now... */
|
||||
int rc;
|
||||
int randfd;
|
||||
RETRY_EINTR(randfd, open("/dev/urandom", O_RDONLY));
|
||||
RETRY_EINTR(randfd, open("/dev/urandom", O_RDONLY | O_CLOEXEC));
|
||||
if (randfd < 0)
|
||||
janet_panic(genericerr);
|
||||
while (n > 0) {
|
||||
@@ -731,7 +735,10 @@ static timeint_t entry_getint(Janet env_entry, char *field) {
|
||||
static Janet os_mktime(int32_t argc, Janet *argv) {
|
||||
janet_arity(argc, 1, 2);
|
||||
time_t t;
|
||||
struct tm t_info = { 0 };
|
||||
struct tm t_info;
|
||||
|
||||
/* Use memset instead of = {0} to silence paranoid warning in macos */
|
||||
memset(&t_info, 0, sizeof(t_info));
|
||||
|
||||
if (!janet_checktype(argv[0], JANET_TABLE) &&
|
||||
!janet_checktype(argv[0], JANET_STRUCT))
|
||||
@@ -750,8 +757,8 @@ static Janet os_mktime(int32_t argc, Janet *argv) {
|
||||
t = mktime(&t_info);
|
||||
} else {
|
||||
/* utc time */
|
||||
#ifdef __sun
|
||||
janet_panic("os/mktime UTC not supported on Solaris");
|
||||
#ifdef JANET_NO_UTC_MKTIME
|
||||
janet_panic("os/mktime UTC not supported on this platform");
|
||||
return janet_wrap_nil();
|
||||
#else
|
||||
t = timegm(&t_info);
|
||||
@@ -765,6 +772,12 @@ static Janet os_mktime(int32_t argc, Janet *argv) {
|
||||
return janet_wrap_number((double)t);
|
||||
}
|
||||
|
||||
#ifdef JANET_NO_SYMLINKS
|
||||
#define j_symlink link
|
||||
#else
|
||||
#define j_symlink symlink
|
||||
#endif
|
||||
|
||||
static Janet os_link(int32_t argc, Janet *argv) {
|
||||
janet_arity(argc, 2, 3);
|
||||
#ifdef JANET_WINDOWS
|
||||
@@ -775,7 +788,7 @@ 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_truthy(argv[2])) ? symlink : link)(oldpath, newpath);
|
||||
int res = ((argc == 3 && janet_truthy(argv[2])) ? j_symlink : link)(oldpath, newpath);
|
||||
if (-1 == res) janet_panicf("%s: %s -> %s", strerror(errno), oldpath, newpath);
|
||||
return janet_wrap_nil();
|
||||
#endif
|
||||
@@ -791,12 +804,14 @@ static Janet os_symlink(int32_t argc, Janet *argv) {
|
||||
#else
|
||||
const char *oldpath = janet_getcstring(argv, 0);
|
||||
const char *newpath = janet_getcstring(argv, 1);
|
||||
int res = symlink(oldpath, newpath);
|
||||
int res = j_symlink(oldpath, newpath);
|
||||
if (-1 == res) janet_panicf("%s: %s -> %s", strerror(errno), oldpath, newpath);
|
||||
return janet_wrap_nil();
|
||||
#endif
|
||||
}
|
||||
|
||||
#undef j_symlink
|
||||
|
||||
static Janet os_mkdir(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 1);
|
||||
const char *path = janet_getcstring(argv, 0);
|
||||
@@ -880,40 +895,23 @@ static Janet os_readlink(int32_t argc, Janet *argv) {
|
||||
}
|
||||
|
||||
#ifdef JANET_WINDOWS
|
||||
static const uint8_t *janet_decode_permissions(unsigned short m) {
|
||||
uint8_t flags[9] = {0};
|
||||
flags[0] = flags[3] = flags[6] = (m & S_IREAD) ? 'r' : '-';
|
||||
flags[1] = flags[4] = flags[7] = (m & S_IWRITE) ? 'w' : '-';
|
||||
flags[2] = flags[5] = flags[8] = (m & S_IEXEC) ? 'x' : '-';
|
||||
return janet_string(flags, sizeof(flags));
|
||||
|
||||
typedef struct _stat jstat_t;
|
||||
typedef unsigned short jmode_t;
|
||||
|
||||
static int32_t janet_perm_to_unix(unsigned short m) {
|
||||
int32_t ret = 0;
|
||||
if (m & S_IEXEC) ret |= 0111;
|
||||
if (m & S_IWRITE) ret |= 0222;
|
||||
if (m & S_IREAD) ret |= 0444;
|
||||
return ret;
|
||||
}
|
||||
|
||||
static unsigned short janet_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);
|
||||
}
|
||||
static unsigned short janet_perm_from_unix(int32_t x) {
|
||||
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;
|
||||
if (x & 111) m |= S_IEXEC;
|
||||
if (x & 222) m |= S_IWRITE;
|
||||
if (x & 444) m |= S_IREAD;
|
||||
return m;
|
||||
}
|
||||
|
||||
@@ -924,44 +922,22 @@ static const uint8_t *janet_decode_mode(unsigned short m) {
|
||||
else if (m & _S_IFCHR) str = "character";
|
||||
return janet_ckeyword(str);
|
||||
}
|
||||
#else
|
||||
static const uint8_t *janet_decode_permissions(mode_t m) {
|
||||
uint8_t flags[9] = {0};
|
||||
flags[0] = (m & S_IRUSR) ? 'r' : '-';
|
||||
flags[1] = (m & S_IWUSR) ? 'w' : '-';
|
||||
flags[2] = (m & S_IXUSR) ? 'x' : '-';
|
||||
flags[3] = (m & S_IRGRP) ? 'r' : '-';
|
||||
flags[4] = (m & S_IWGRP) ? 'w' : '-';
|
||||
flags[5] = (m & S_IXGRP) ? 'x' : '-';
|
||||
flags[6] = (m & S_IROTH) ? 'r' : '-';
|
||||
flags[7] = (m & S_IWOTH) ? 'w' : '-';
|
||||
flags[8] = (m & S_IXOTH) ? 'x' : '-';
|
||||
return janet_string(flags, sizeof(flags));
|
||||
|
||||
static int32_t janet_decode_permissions(jmode_t mode) {
|
||||
return (int32_t)(mode & (S_IEXEC | S_IWRITE | S_IREAD));
|
||||
}
|
||||
|
||||
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;
|
||||
#else
|
||||
|
||||
typedef struct stat jstat_t;
|
||||
typedef mode_t jmode_t;
|
||||
|
||||
static int32_t janet_perm_to_unix(mode_t m) {
|
||||
return (int32_t) m;
|
||||
}
|
||||
|
||||
static mode_t janet_perm_from_unix(int32_t x) {
|
||||
return (mode_t) x;
|
||||
}
|
||||
|
||||
static const uint8_t *janet_decode_mode(mode_t m) {
|
||||
@@ -975,13 +951,64 @@ static const uint8_t *janet_decode_mode(mode_t m) {
|
||||
else if (S_ISCHR(m)) str = "character";
|
||||
return janet_ckeyword(str);
|
||||
}
|
||||
|
||||
static int32_t janet_decode_permissions(jmode_t mode) {
|
||||
return (int32_t)(mode & 0777);
|
||||
}
|
||||
|
||||
#endif
|
||||
|
||||
#ifdef JANET_WINDOWS
|
||||
typedef struct _stat jstat_t;
|
||||
#else
|
||||
typedef struct stat jstat_t;
|
||||
#endif
|
||||
static int32_t os_parse_permstring(const uint8_t *perm) {
|
||||
int32_t m = 0;
|
||||
if (perm[0] == 'r') m |= 0400;
|
||||
if (perm[1] == 'w') m |= 0200;
|
||||
if (perm[2] == 'x') m |= 0100;
|
||||
if (perm[3] == 'r') m |= 0040;
|
||||
if (perm[4] == 'w') m |= 0020;
|
||||
if (perm[5] == 'x') m |= 0010;
|
||||
if (perm[6] == 'r') m |= 0004;
|
||||
if (perm[7] == 'w') m |= 0002;
|
||||
if (perm[8] == 'x') m |= 0001;
|
||||
return m;
|
||||
}
|
||||
|
||||
static Janet os_make_permstring(int32_t permissions) {
|
||||
uint8_t bytes[9] = {0};
|
||||
bytes[0] = (permissions & 0400) ? 'r' : '-';
|
||||
bytes[1] = (permissions & 0200) ? 'w' : '-';
|
||||
bytes[2] = (permissions & 0100) ? 'x' : '-';
|
||||
bytes[3] = (permissions & 0040) ? 'r' : '-';
|
||||
bytes[4] = (permissions & 0020) ? 'w' : '-';
|
||||
bytes[5] = (permissions & 0010) ? 'x' : '-';
|
||||
bytes[6] = (permissions & 0004) ? 'r' : '-';
|
||||
bytes[7] = (permissions & 0002) ? 'w' : '-';
|
||||
bytes[8] = (permissions & 0001) ? 'x' : '-';
|
||||
return janet_stringv(bytes, sizeof(bytes));
|
||||
}
|
||||
|
||||
static int32_t os_get_unix_mode(const Janet *argv, int32_t n) {
|
||||
int32_t unix_mode;
|
||||
if (janet_checkint(argv[n])) {
|
||||
/* Integer mode */
|
||||
int32_t x = janet_unwrap_integer(argv[n]);
|
||||
if (x < 0 || x > 0777) {
|
||||
janet_panicf("bad slot #%d, expected integer in range [0, 8r777], got %v", n, argv[n]);
|
||||
}
|
||||
unix_mode = x;
|
||||
} else {
|
||||
/* Bytes mode */
|
||||
JanetByteView bytes = janet_getbytes(argv, n);
|
||||
if (bytes.len != 9) {
|
||||
janet_panicf("bad slot #%d: expected byte sequence of length 9, got %v", n, argv[n]);
|
||||
}
|
||||
unix_mode = os_parse_permstring(bytes.bytes);
|
||||
}
|
||||
return unix_mode;
|
||||
}
|
||||
|
||||
static jmode_t os_getmode(const Janet *argv, int32_t n) {
|
||||
return janet_perm_from_unix(os_get_unix_mode(argv, n));
|
||||
}
|
||||
|
||||
/* Getters */
|
||||
static Janet os_stat_dev(jstat_t *st) {
|
||||
@@ -993,8 +1020,11 @@ static Janet os_stat_inode(jstat_t *st) {
|
||||
static Janet os_stat_mode(jstat_t *st) {
|
||||
return janet_wrap_keyword(janet_decode_mode(st->st_mode));
|
||||
}
|
||||
static Janet os_stat_int_permissions(jstat_t *st) {
|
||||
return janet_wrap_integer(janet_perm_to_unix(janet_decode_permissions(st->st_mode)));
|
||||
}
|
||||
static Janet os_stat_permissions(jstat_t *st) {
|
||||
return janet_wrap_string(janet_decode_permissions(st->st_mode));
|
||||
return os_make_permstring(janet_perm_to_unix(janet_decode_permissions(st->st_mode)));
|
||||
}
|
||||
static Janet os_stat_uid(jstat_t *st) {
|
||||
return janet_wrap_number(st->st_uid);
|
||||
@@ -1045,6 +1075,7 @@ static const struct OsStatGetter os_stat_getters[] = {
|
||||
{"dev", os_stat_dev},
|
||||
{"inode", os_stat_inode},
|
||||
{"mode", os_stat_mode},
|
||||
{"int-permissions", os_stat_int_permissions},
|
||||
{"permissions", os_stat_permissions},
|
||||
{"uid", os_stat_uid},
|
||||
{"gid", os_stat_gid},
|
||||
@@ -1122,14 +1153,25 @@ 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));
|
||||
int res = _chmod(path, os_getmode(argv, 1));
|
||||
#else
|
||||
int res = chmod(path, janet_encode_permissions(argv, 1));
|
||||
int res = chmod(path, os_getmode(argv, 1));
|
||||
#endif
|
||||
if (-1 == res) janet_panicf("%s: %s", strerror(errno), path);
|
||||
return janet_wrap_nil();
|
||||
}
|
||||
|
||||
static Janet os_umask(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 1);
|
||||
int mask = (int) os_getmode(argv, 0);
|
||||
#ifdef JANET_WINDOWS
|
||||
int res = _umask(mask);
|
||||
#else
|
||||
int res = umask(mask);
|
||||
#endif
|
||||
return janet_wrap_integer(janet_perm_to_unix(res));
|
||||
}
|
||||
|
||||
static Janet os_dir(int32_t argc, Janet *argv) {
|
||||
janet_arity(argc, 1, 2);
|
||||
const char *dir = janet_getcstring(argv, 0);
|
||||
@@ -1191,6 +1233,16 @@ static Janet os_realpath(int32_t argc, Janet *argv) {
|
||||
#endif
|
||||
}
|
||||
|
||||
static Janet os_permission_string(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 1);
|
||||
return os_make_permstring(os_get_unix_mode(argv, 0));
|
||||
}
|
||||
|
||||
static Janet os_permission_int(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 1);
|
||||
return janet_wrap_integer(os_get_unix_mode(argv, 0));
|
||||
}
|
||||
|
||||
#endif /* JANET_REDUCED_OS */
|
||||
|
||||
static const JanetReg os_cfuns[] = {
|
||||
@@ -1211,12 +1263,8 @@ static const JanetReg os_cfuns[] = {
|
||||
"\t:freebsd\n"
|
||||
"\t:openbsd\n"
|
||||
"\t:netbsd\n"
|
||||
"\t:posix - A POSIX compatible system (default)")
|
||||
},
|
||||
{
|
||||
"os/getenv", os_getenv,
|
||||
JDOC("(os/getenv variable &opt dflt)\n\n"
|
||||
"Get the string value of an environment variable.")
|
||||
"\t:posix - A POSIX compatible system (default)\n\n"
|
||||
"May also return a custom keyword specified at build time.")
|
||||
},
|
||||
{
|
||||
"os/arch", os_arch,
|
||||
@@ -1236,11 +1284,16 @@ static const JanetReg os_cfuns[] = {
|
||||
JDOC("(os/environ)\n\n"
|
||||
"Get a copy of the os environment table.")
|
||||
},
|
||||
{
|
||||
"os/getenv", os_getenv,
|
||||
JDOC("(os/getenv variable &opt dflt)\n\n"
|
||||
"Get the string value of an environment variable.")
|
||||
},
|
||||
{
|
||||
"os/dir", os_dir,
|
||||
JDOC("(os/dir dir &opt array)\n\n"
|
||||
"Iterate over files and subdirectories in a directory. Returns an array of paths parts, "
|
||||
"with only the filename or directory name and no prefix.")
|
||||
"with only the file name or directory name and no prefix.")
|
||||
},
|
||||
{
|
||||
"os/stat", os_stat,
|
||||
@@ -1249,7 +1302,8 @@ static const JanetReg os_cfuns[] = {
|
||||
" only that information from stat. If the file or directory does not exist, returns nil. The keys are\n\n"
|
||||
"\t:dev - the device that the file is on\n"
|
||||
"\t:mode - the type of file, one of :file, :directory, :block, :character, :fifo, :socket, :link, or :other\n"
|
||||
"\t:permissions - A unix permission string like \"rwx--x--x\". On windows, a string like \"rwx\".\n"
|
||||
"\t:int-permissions - A Unix permission integer like 8r744\n"
|
||||
"\t:permissions - A Unix permission string like \"rwxr--r--\"\n"
|
||||
"\t:uid - File uid\n"
|
||||
"\t:gid - File gid\n"
|
||||
"\t:nlink - number of links to file\n"
|
||||
@@ -1258,7 +1312,7 @@ static const JanetReg os_cfuns[] = {
|
||||
"\t:blocks - number of blocks in file. 0 on windows\n"
|
||||
"\t:blocksize - size of blocks in file. 0 on windows\n"
|
||||
"\t:accessed - timestamp when file last accessed\n"
|
||||
"\t:changed - timestamp when file last chnaged (permissions changed)\n"
|
||||
"\t:changed - timestamp when file last changed (permissions changed)\n"
|
||||
"\t:modified - timestamp when file last modified (content changed)\n")
|
||||
},
|
||||
{
|
||||
@@ -1270,9 +1324,9 @@ static const JanetReg os_cfuns[] = {
|
||||
"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/perm-string, or an integer as returned by os/perm-int. "
|
||||
"When mode is an integer, it is interpreted as a Unix permission value, best specified in octal, like "
|
||||
"8r666 or 8r400. Windows will not differentiate between user, group, and other permissions, and thus will combine all of these permissions. Returns nil.")
|
||||
},
|
||||
{
|
||||
"os/touch", os_touch,
|
||||
@@ -1285,11 +1339,16 @@ static const JanetReg os_cfuns[] = {
|
||||
JDOC("(os/cd path)\n\n"
|
||||
"Change current directory to path. Returns nil on success, errors on failure.")
|
||||
},
|
||||
{
|
||||
"os/umask", os_umask,
|
||||
JDOC("(os/umask mask)\n\n"
|
||||
"Set a new umask, returns the old umask.")
|
||||
},
|
||||
{
|
||||
"os/mkdir", os_mkdir,
|
||||
JDOC("(os/mkdir path)\n\n"
|
||||
"Create a new directory. The path will be relative to the current directory if relative, otherwise "
|
||||
"it will be an absolute path. Returns true if the directory was create, false if the directoyr already exists, and "
|
||||
"it will be an absolute path. Returns true if the directory was created, false if the directory already exists, and "
|
||||
"errors otherwise.")
|
||||
},
|
||||
{
|
||||
@@ -1305,8 +1364,10 @@ 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, returning nil. The 3rd optional paramater "
|
||||
"enables a symlink iff truthy, hard link otherwise or if not provided. Does not work on Windows.")
|
||||
"Create a link at newpath that points to oldpath and returns nil. "
|
||||
"Iff symlink is truthy, creates a symlink. "
|
||||
"Iff symlink is falsey or not provided, "
|
||||
"creates a hard link. Does not work on Windows.")
|
||||
},
|
||||
{
|
||||
"os/symlink", os_symlink,
|
||||
@@ -1318,6 +1379,7 @@ static const JanetReg os_cfuns[] = {
|
||||
JDOC("(os/readlink path)\n\n"
|
||||
"Read the contents of a symbolic link. Does not work on Windows.\n")
|
||||
},
|
||||
#ifndef JANET_NO_PROCESSES
|
||||
{
|
||||
"os/execute", os_execute,
|
||||
JDOC("(os/execute args &opts flags env)\n\n"
|
||||
@@ -1335,6 +1397,7 @@ static const JanetReg os_cfuns[] = {
|
||||
JDOC("(os/shell str)\n\n"
|
||||
"Pass a command string str directly to the system shell.")
|
||||
},
|
||||
#endif
|
||||
{
|
||||
"os/setenv", os_setenv,
|
||||
JDOC("(os/setenv variable value)\n\n"
|
||||
@@ -1376,14 +1439,14 @@ static const JanetReg os_cfuns[] = {
|
||||
{
|
||||
"os/cryptorand", os_cryptorand,
|
||||
JDOC("(os/cryptorand n &opt buf)\n\n"
|
||||
"Get or append n bytes of good quality random data provided by the os. Returns a new buffer or buf.")
|
||||
"Get or append n bytes of good quality random data provided by the OS. Returns a new buffer or buf.")
|
||||
},
|
||||
{
|
||||
"os/date", os_date,
|
||||
JDOC("(os/date &opt time local)\n\n"
|
||||
"Returns the given time as a date struct, or the current time if no time is given. "
|
||||
"Returns a struct with following key values. Note that all numbers are 0-indexed. "
|
||||
"Date is given in UTC unless local is truthy, in which case the date is formated for "
|
||||
"Date is given in UTC unless local is truthy, in which case the date is formatted for "
|
||||
"the local timezone.\n\n"
|
||||
"\t:seconds - number of seconds [0-61]\n"
|
||||
"\t:minutes - number of minutes [0-59]\n"
|
||||
@@ -1406,6 +1469,19 @@ static const JanetReg os_cfuns[] = {
|
||||
"Get the absolute path for a given path, following ../, ./, and symlinks. "
|
||||
"Returns an absolute path as a string. Will raise an error on Windows.")
|
||||
},
|
||||
{
|
||||
"os/perm-string", os_permission_string,
|
||||
JDOC("(os/perm-string int)\n\n"
|
||||
"Convert a Unix octal permission value from a permission integer as returned by os/stat "
|
||||
"to a human readable string, that follows the formatting "
|
||||
"of unix tools like ls. Returns the string as a 9 character string of r, w, x and - characters. Does not "
|
||||
"include the file/directory/symlink character as rendered by `ls`.")
|
||||
},
|
||||
{
|
||||
"os/perm-int", os_permission_int,
|
||||
JDOC("(os/perm-int bytes)\n\n"
|
||||
"Parse a 9 character permission string and return an integer that can be used by chmod.")
|
||||
},
|
||||
#endif
|
||||
{NULL, NULL, NULL}
|
||||
};
|
||||
|
||||
121
src/core/parse.c
121
src/core/parse.c
@@ -26,6 +26,9 @@
|
||||
#include "util.h"
|
||||
#endif
|
||||
|
||||
#define JANET_PARSER_DEAD 0x1
|
||||
#define JANET_PARSER_GENERATED_ERROR 0x2
|
||||
|
||||
/* Check if a character is whitespace */
|
||||
static int is_whitespace(uint8_t c) {
|
||||
return c == ' '
|
||||
@@ -201,6 +204,8 @@ static int checkescape(uint8_t c) {
|
||||
default:
|
||||
return -1;
|
||||
case 'x':
|
||||
case 'u':
|
||||
case 'U':
|
||||
return 1;
|
||||
case 'n':
|
||||
return '\n';
|
||||
@@ -228,6 +233,24 @@ static int checkescape(uint8_t c) {
|
||||
/* Forward declare */
|
||||
static int stringchar(JanetParser *p, JanetParseState *state, uint8_t c);
|
||||
|
||||
static void write_codepoint(JanetParser *p, int32_t codepoint) {
|
||||
if (codepoint <= 0x7F) {
|
||||
push_buf(p, (uint8_t) codepoint);
|
||||
} else if (codepoint <= 0x7FF) {
|
||||
push_buf(p, (uint8_t)((codepoint >> 6) & 0x1F) | 0xC0);
|
||||
push_buf(p, (uint8_t)((codepoint >> 0) & 0x3F) | 0x80);
|
||||
} else if (codepoint <= 0xFFFF) {
|
||||
push_buf(p, (uint8_t)((codepoint >> 12) & 0x0F) | 0xE0);
|
||||
push_buf(p, (uint8_t)((codepoint >> 6) & 0x3F) | 0x80);
|
||||
push_buf(p, (uint8_t)((codepoint >> 0) & 0x3F) | 0x80);
|
||||
} else {
|
||||
push_buf(p, (uint8_t)((codepoint >> 18) & 0x07) | 0xF0);
|
||||
push_buf(p, (uint8_t)((codepoint >> 12) & 0x3F) | 0x80);
|
||||
push_buf(p, (uint8_t)((codepoint >> 6) & 0x3F) | 0x80);
|
||||
push_buf(p, (uint8_t)((codepoint >> 0) & 0x3F) | 0x80);
|
||||
}
|
||||
}
|
||||
|
||||
static int escapeh(JanetParser *p, JanetParseState *state, uint8_t c) {
|
||||
int digit = to_hex(c);
|
||||
if (digit < 0) {
|
||||
@@ -237,7 +260,27 @@ static int escapeh(JanetParser *p, JanetParseState *state, uint8_t c) {
|
||||
state->argn = (state->argn << 4) + digit;
|
||||
state->counter--;
|
||||
if (!state->counter) {
|
||||
push_buf(p, (state->argn & 0xFF));
|
||||
push_buf(p, (uint8_t)(state->argn & 0xFF));
|
||||
state->argn = 0;
|
||||
state->consumer = stringchar;
|
||||
}
|
||||
return 1;
|
||||
}
|
||||
|
||||
static int escapeu(JanetParser *p, JanetParseState *state, uint8_t c) {
|
||||
int digit = to_hex(c);
|
||||
if (digit < 0) {
|
||||
p->error = "invalid hex digit in unicode escape";
|
||||
return 1;
|
||||
}
|
||||
state->argn = (state->argn << 4) + digit;
|
||||
state->counter--;
|
||||
if (!state->counter) {
|
||||
if (state->argn > 0x10FFFF) {
|
||||
p->error = "invalid unicode codepoint";
|
||||
return 1;
|
||||
}
|
||||
write_codepoint(p, state->argn);
|
||||
state->argn = 0;
|
||||
state->consumer = stringchar;
|
||||
}
|
||||
@@ -254,6 +297,10 @@ static int escape1(JanetParser *p, JanetParseState *state, uint8_t c) {
|
||||
state->counter = 2;
|
||||
state->argn = 0;
|
||||
state->consumer = escapeh;
|
||||
} else if (c == 'u' || c == 'U') {
|
||||
state->counter = c == 'u' ? 4 : 6;
|
||||
state->argn = 0;
|
||||
state->consumer = escapeu;
|
||||
} else {
|
||||
push_buf(p, (uint8_t) e);
|
||||
state->consumer = stringchar;
|
||||
@@ -393,21 +440,23 @@ static Janet close_array(JanetParser *p, JanetParseState *state) {
|
||||
|
||||
static Janet close_struct(JanetParser *p, JanetParseState *state) {
|
||||
JanetKV *st = janet_struct_begin(state->argn >> 1);
|
||||
for (int32_t i = state->argn; i > 0; i -= 2) {
|
||||
Janet value = p->args[--p->argcount];
|
||||
Janet key = p->args[--p->argcount];
|
||||
for (size_t i = p->argcount - state->argn; i < p->argcount; i += 2) {
|
||||
Janet key = p->args[i];
|
||||
Janet value = p->args[i + 1];
|
||||
janet_struct_put(st, key, value);
|
||||
}
|
||||
p->argcount -= state->argn;
|
||||
return janet_wrap_struct(janet_struct_end(st));
|
||||
}
|
||||
|
||||
static Janet close_table(JanetParser *p, JanetParseState *state) {
|
||||
JanetTable *table = janet_table(state->argn >> 1);
|
||||
for (int32_t i = state->argn; i > 0; i -= 2) {
|
||||
Janet value = p->args[--p->argcount];
|
||||
Janet key = p->args[--p->argcount];
|
||||
for (size_t i = p->argcount - state->argn; i < p->argcount; i += 2) {
|
||||
Janet key = p->args[i];
|
||||
Janet value = p->args[i + 1];
|
||||
janet_table_put(table, key, value);
|
||||
}
|
||||
p->argcount -= state->argn;
|
||||
return janet_wrap_table(table);
|
||||
}
|
||||
|
||||
@@ -591,11 +640,30 @@ void janet_parser_eof(JanetParser *parser) {
|
||||
size_t oldline = parser->line;
|
||||
janet_parser_consume(parser, '\n');
|
||||
if (parser->statecount > 1) {
|
||||
parser->error = "unexpected end of source";
|
||||
JanetParseState *s = parser->states + (parser->statecount - 1);
|
||||
JanetBuffer *buffer = janet_buffer(40);
|
||||
janet_buffer_push_cstring(buffer, "unexpected end of source, ");
|
||||
if (s->flags & PFLAG_PARENS) {
|
||||
janet_buffer_push_u8(buffer, '(');
|
||||
} else if (s->flags & PFLAG_SQRBRACKETS) {
|
||||
janet_buffer_push_u8(buffer, '[');
|
||||
} else if (s->flags & PFLAG_CURLYBRACKETS) {
|
||||
janet_buffer_push_u8(buffer, '{');
|
||||
} else if (s->flags & PFLAG_STRING) {
|
||||
janet_buffer_push_u8(buffer, '"');
|
||||
} else if (s->flags & PFLAG_LONGSTRING) {
|
||||
int32_t i;
|
||||
for (i = 0; i < s->argn; i++) {
|
||||
janet_buffer_push_u8(buffer, '`');
|
||||
}
|
||||
}
|
||||
janet_formatb(buffer, " opened at line %d, column %d", s->line, s->column);
|
||||
parser->error = (const char *) janet_string(buffer->data, buffer->count);
|
||||
parser->flag |= JANET_PARSER_GENERATED_ERROR;
|
||||
}
|
||||
parser->line = oldline;
|
||||
parser->column = oldcolumn;
|
||||
parser->flag = 1;
|
||||
parser->flag |= JANET_PARSER_DEAD;
|
||||
}
|
||||
|
||||
enum JanetParserStatus janet_parser_status(JanetParser *parser) {
|
||||
@@ -617,6 +685,7 @@ const char *janet_parser_error(JanetParser *parser) {
|
||||
if (status == JANET_PARSE_ERROR) {
|
||||
const char *e = parser->error;
|
||||
parser->error = NULL;
|
||||
parser->flag &= ~JANET_PARSER_GENERATED_ERROR;
|
||||
janet_parser_flush(parser);
|
||||
return e;
|
||||
}
|
||||
@@ -720,6 +789,9 @@ static int parsermark(void *p, size_t size) {
|
||||
for (i = 0; i < parser->argcount; i++) {
|
||||
janet_mark(parser->args[i]);
|
||||
}
|
||||
if (parser->flag & JANET_PARSER_GENERATED_ERROR) {
|
||||
janet_mark(janet_wrap_string((const uint8_t *) parser->error));
|
||||
}
|
||||
return 0;
|
||||
}
|
||||
|
||||
@@ -854,7 +926,11 @@ static Janet cfun_parse_error(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 1);
|
||||
JanetParser *p = janet_getabstract(argv, 0, &janet_parser_type);
|
||||
const char *err = janet_parser_error(p);
|
||||
if (err) return janet_cstringv(err);
|
||||
if (err) {
|
||||
return (p->flag & JANET_PARSER_GENERATED_ERROR)
|
||||
? janet_wrap_string((const uint8_t *) err)
|
||||
: janet_cstringv(err);
|
||||
}
|
||||
return janet_wrap_nil();
|
||||
}
|
||||
|
||||
@@ -953,31 +1029,30 @@ struct ParserStateGetter {
|
||||
};
|
||||
|
||||
static Janet parser_state_delimiters(const JanetParser *_p) {
|
||||
JanetParser *clone = janet_abstract(&janet_parser_type, sizeof(JanetParser));
|
||||
janet_parser_clone(_p, clone);
|
||||
JanetParser *p = (JanetParser *)_p;
|
||||
size_t i;
|
||||
const uint8_t *str;
|
||||
size_t oldcount;
|
||||
oldcount = clone->bufcount;
|
||||
for (i = 0; i < clone->statecount; i++) {
|
||||
JanetParseState *s = clone->states + i;
|
||||
oldcount = p->bufcount;
|
||||
for (i = 0; i < p->statecount; i++) {
|
||||
JanetParseState *s = p->states + i;
|
||||
if (s->flags & PFLAG_PARENS) {
|
||||
push_buf(clone, '(');
|
||||
push_buf(p, '(');
|
||||
} else if (s->flags & PFLAG_SQRBRACKETS) {
|
||||
push_buf(clone, '[');
|
||||
push_buf(p, '[');
|
||||
} else if (s->flags & PFLAG_CURLYBRACKETS) {
|
||||
push_buf(clone, '{');
|
||||
push_buf(p, '{');
|
||||
} else if (s->flags & PFLAG_STRING) {
|
||||
push_buf(clone, '"');
|
||||
push_buf(p, '"');
|
||||
} else if (s->flags & PFLAG_LONGSTRING) {
|
||||
int32_t i;
|
||||
for (i = 0; i < s->argn; i++) {
|
||||
push_buf(clone, '`');
|
||||
push_buf(p, '`');
|
||||
}
|
||||
}
|
||||
}
|
||||
str = janet_string(clone->buf + oldcount, (int32_t)(clone->bufcount - oldcount));
|
||||
clone->bufcount = oldcount;
|
||||
str = janet_string(p->buf + oldcount, (int32_t)(p->bufcount - oldcount));
|
||||
p->bufcount = oldcount;
|
||||
return janet_wrap_string(str);
|
||||
}
|
||||
|
||||
@@ -1064,7 +1139,7 @@ static const JanetReg parse_cfuns[] = {
|
||||
"parser/new", cfun_parse_parser,
|
||||
JDOC("(parser/new)\n\n"
|
||||
"Creates and returns a new parser object. Parsers are state machines "
|
||||
"that can receive bytes, and generate a stream of janet values.")
|
||||
"that can receive bytes, and generate a stream of values.")
|
||||
},
|
||||
{
|
||||
"parser/clone", cfun_parse_clone,
|
||||
|
||||
@@ -413,6 +413,38 @@ tail:
|
||||
return NULL;
|
||||
}
|
||||
|
||||
case RULE_LENPREFIX: {
|
||||
int oldmode = s->mode;
|
||||
s->mode = PEG_MODE_NORMAL;
|
||||
const uint8_t *next_text;
|
||||
CapState cs = cap_save(s);
|
||||
down1(s);
|
||||
next_text = peg_rule(s, s->bytecode + rule[1], text);
|
||||
up1(s);
|
||||
if (NULL == next_text) return NULL;
|
||||
s->mode = oldmode;
|
||||
int32_t num_sub_captures = s->captures->count - cs.cap;
|
||||
Janet lencap;
|
||||
if (num_sub_captures <= 0 ||
|
||||
(lencap = s->captures->data[cs.cap], !janet_checkint(lencap))) {
|
||||
cap_load(s, cs);
|
||||
return NULL;
|
||||
}
|
||||
int32_t nrep = janet_unwrap_integer(lencap);
|
||||
/* drop captures from len pattern */
|
||||
cap_load(s, cs);
|
||||
for (int32_t i = 0; i < nrep; i++) {
|
||||
down1(s);
|
||||
next_text = peg_rule(s, s->bytecode + rule[2], next_text);
|
||||
up1(s);
|
||||
if (NULL == next_text) {
|
||||
cap_load(s, cs);
|
||||
return NULL;
|
||||
}
|
||||
}
|
||||
return next_text;
|
||||
}
|
||||
|
||||
}
|
||||
}
|
||||
|
||||
@@ -657,6 +689,9 @@ static void spec_if(Builder *b, int32_t argc, const Janet *argv) {
|
||||
static void spec_ifnot(Builder *b, int32_t argc, const Janet *argv) {
|
||||
spec_branch(b, argc, argv, RULE_IFNOT);
|
||||
}
|
||||
static void spec_lenprefix(Builder *b, int32_t argc, const Janet *argv) {
|
||||
spec_branch(b, argc, argv, RULE_LENPREFIX);
|
||||
}
|
||||
|
||||
static void spec_between(Builder *b, int32_t argc, const Janet *argv) {
|
||||
peg_fixarity(b, argc, 3);
|
||||
@@ -847,6 +882,7 @@ static const SpecialPair peg_specials[] = {
|
||||
{"group", spec_group},
|
||||
{"if", spec_if},
|
||||
{"if-not", spec_ifnot},
|
||||
{"lenprefix", spec_lenprefix},
|
||||
{"look", spec_look},
|
||||
{"not", spec_not},
|
||||
{"opt", spec_opt},
|
||||
@@ -1100,6 +1136,7 @@ static void *peg_unmarshal(JanetMarshalContext *ctx) {
|
||||
break;
|
||||
case RULE_IF:
|
||||
case RULE_IFNOT:
|
||||
case RULE_LENPREFIX:
|
||||
/* [rule_a, rule_b (b if not a)] */
|
||||
if (rule[1] >= blen) goto bad;
|
||||
if (rule[2] >= blen) goto bad;
|
||||
@@ -1283,8 +1320,7 @@ static const JanetReg peg_cfuns[] = {
|
||||
"peg/match", cfun_peg_match,
|
||||
JDOC("(peg/match peg text &opt start & args)\n\n"
|
||||
"Match a Parsing Expression Grammar to a byte string and return an array of captured values. "
|
||||
"Returns nil if text does not match the language defined by peg. The syntax of PEGs are very "
|
||||
"similar to those defined by LPeg, and have similar capabilities.")
|
||||
"Returns nil if text does not match the language defined by peg. The syntax of PEGs is documented on the Janet website.")
|
||||
},
|
||||
{NULL, NULL, NULL}
|
||||
};
|
||||
|
||||
@@ -155,8 +155,11 @@ static void janet_escape_string_impl(JanetBuffer *buffer, const uint8_t *str, in
|
||||
case '\\':
|
||||
janet_buffer_push_bytes(buffer, (const uint8_t *)"\\\\", 2);
|
||||
break;
|
||||
case '\t':
|
||||
janet_buffer_push_bytes(buffer, (const uint8_t *)"\\t", 2);
|
||||
break;
|
||||
default:
|
||||
if (c < 32 || c > 127) {
|
||||
if (c < 32 || c > 126) {
|
||||
uint8_t buf[4];
|
||||
buf[0] = '\\';
|
||||
buf[1] = 'x';
|
||||
@@ -459,8 +462,8 @@ static const char *janet_pretty_colors[] = {
|
||||
|
||||
#define JANET_PRETTY_DICT_ONELINE 4
|
||||
#define JANET_PRETTY_IND_ONELINE 10
|
||||
#define JANET_PRETTY_DICT_LIMIT 16
|
||||
#define JANET_PRETTY_ARRAY_LIMIT 16
|
||||
#define JANET_PRETTY_DICT_LIMIT 30
|
||||
#define JANET_PRETTY_ARRAY_LIMIT 160
|
||||
|
||||
/* Helper for pretty printing */
|
||||
static void janet_pretty_one(struct pretty *S, Janet x, int is_dict_value) {
|
||||
@@ -527,7 +530,7 @@ static void janet_pretty_one(struct pretty *S, Janet x, int is_dict_value) {
|
||||
if (!isarray && !(S->flags & JANET_PRETTY_ONELINE) && len >= JANET_PRETTY_IND_ONELINE)
|
||||
janet_buffer_push_u8(S->buffer, ' ');
|
||||
if (is_dict_value && len >= JANET_PRETTY_IND_ONELINE) print_newline(S, 0);
|
||||
if (len > JANET_PRETTY_ARRAY_LIMIT) {
|
||||
if (len > JANET_PRETTY_ARRAY_LIMIT && !(S->flags & JANET_PRETTY_NOTRUNC)) {
|
||||
for (i = 0; i < 3; i++) {
|
||||
if (i) print_newline(S, 0);
|
||||
janet_pretty_one(S, arr[i], 0);
|
||||
@@ -591,6 +594,11 @@ static void janet_pretty_one(struct pretty *S, Janet x, int is_dict_value) {
|
||||
if (is_dict_value && len >= JANET_PRETTY_DICT_ONELINE) print_newline(S, 0);
|
||||
for (i = 0; i < cap; i++) {
|
||||
if (!janet_checktype(kvs[i].key, JANET_NIL)) {
|
||||
if (counter == JANET_PRETTY_DICT_LIMIT && !(S->flags & JANET_PRETTY_NOTRUNC)) {
|
||||
print_newline(S, 0);
|
||||
janet_buffer_push_cstring(S->buffer, "...");
|
||||
break;
|
||||
}
|
||||
if (first_kv_pair) {
|
||||
first_kv_pair = 0;
|
||||
} else {
|
||||
@@ -600,11 +608,6 @@ static void janet_pretty_one(struct pretty *S, Janet x, int is_dict_value) {
|
||||
janet_buffer_push_u8(S->buffer, ' ');
|
||||
janet_pretty_one(S, kvs[i].value, 1);
|
||||
counter++;
|
||||
if (counter == 10) {
|
||||
print_newline(S, 0);
|
||||
janet_buffer_push_cstring(S->buffer, "...");
|
||||
break;
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
@@ -728,7 +731,7 @@ static const char *scanformat(
|
||||
return p;
|
||||
}
|
||||
|
||||
void janet_formatb(JanetBuffer *b, const char *format, va_list args) {
|
||||
void janet_formatbv(JanetBuffer *b, const char *format, va_list args) {
|
||||
const char *format_end = format + strlen(format);
|
||||
const char *c = format;
|
||||
int32_t startlen = b->count;
|
||||
@@ -751,7 +754,6 @@ void janet_formatb(JanetBuffer *b, const char *format, va_list args) {
|
||||
case 'd':
|
||||
case 'i':
|
||||
case 'o':
|
||||
case 'u':
|
||||
case 'x':
|
||||
case 'X': {
|
||||
int32_t n = va_arg(args, long);
|
||||
@@ -802,6 +804,10 @@ void janet_formatb(JanetBuffer *b, const char *format, va_list args) {
|
||||
pushtypes(b, types);
|
||||
break;
|
||||
}
|
||||
case 'M':
|
||||
case 'm':
|
||||
case 'N':
|
||||
case 'n':
|
||||
case 'Q':
|
||||
case 'q':
|
||||
case 'P':
|
||||
@@ -809,11 +815,13 @@ void janet_formatb(JanetBuffer *b, const char *format, va_list args) {
|
||||
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 has_color = (d == 'P') || (d == 'Q') || (d == 'M') || (d == 'N');
|
||||
int has_oneline = (d == 'Q') || (d == 'q') || (d == 'N') || (d == 'n');
|
||||
int has_notrunc = (d == 'M') || (d == 'm') || (d == 'N') || (d == 'n');
|
||||
int flags = 0;
|
||||
flags |= has_color ? JANET_PRETTY_COLOR : 0;
|
||||
flags |= has_oneline ? JANET_PRETTY_ONELINE : 0;
|
||||
flags |= has_notrunc ? JANET_PRETTY_NOTRUNC : 0;
|
||||
janet_pretty_(b, depth, flags, va_arg(args, Janet), startlen);
|
||||
break;
|
||||
}
|
||||
@@ -853,7 +861,7 @@ const uint8_t *janet_formatc(const char *format, ...) {
|
||||
va_start(args, format);
|
||||
|
||||
/* Run format */
|
||||
janet_formatb(&buffer, format, args);
|
||||
janet_formatbv(&buffer, format, args);
|
||||
|
||||
/* Iterate length */
|
||||
va_end(args);
|
||||
@@ -863,6 +871,14 @@ const uint8_t *janet_formatc(const char *format, ...) {
|
||||
return ret;
|
||||
}
|
||||
|
||||
JanetBuffer *janet_formatb(JanetBuffer *buffer, const char *format, ...) {
|
||||
va_list args;
|
||||
va_start(args, format);
|
||||
janet_formatbv(buffer, format, args);
|
||||
va_end(args);
|
||||
return buffer;
|
||||
}
|
||||
|
||||
/* Shared implementation between string/format and
|
||||
* buffer/format */
|
||||
void janet_buffer_format(
|
||||
@@ -896,7 +912,6 @@ void janet_buffer_format(
|
||||
case 'd':
|
||||
case 'i':
|
||||
case 'o':
|
||||
case 'u':
|
||||
case 'x':
|
||||
case 'X': {
|
||||
int32_t n = janet_getinteger(argv, arg);
|
||||
@@ -938,19 +953,24 @@ void janet_buffer_format(
|
||||
janet_description_b(b, argv[arg]);
|
||||
break;
|
||||
}
|
||||
case 'M':
|
||||
case 'm':
|
||||
case 'N':
|
||||
case 'n':
|
||||
case 'Q':
|
||||
case 'q':
|
||||
case 'P':
|
||||
case 'p': { /* janet pretty , precision = depth */
|
||||
int depth = atoi(precision);
|
||||
if (depth < 1)
|
||||
depth = 4;
|
||||
char c = strfrmt[-1];
|
||||
int has_color = (c == 'P') || (c == 'Q');
|
||||
int has_oneline = (c == 'Q') || (c == 'q');
|
||||
if (depth < 1) depth = 4;
|
||||
char d = strfrmt[-1];
|
||||
int has_color = (d == 'P') || (d == 'Q') || (d == 'M') || (d == 'N');
|
||||
int has_oneline = (d == 'Q') || (d == 'q') || (d == 'N') || (d == 'n');
|
||||
int has_notrunc = (d == 'M') || (d == 'm') || (d == 'N') || (d == 'n');
|
||||
int flags = 0;
|
||||
flags |= has_color ? JANET_PRETTY_COLOR : 0;
|
||||
flags |= has_oneline ? JANET_PRETTY_ONELINE : 0;
|
||||
flags |= has_notrunc ? JANET_PRETTY_NOTRUNC : 0;
|
||||
janet_pretty_(b, depth, flags, argv[arg], startlen);
|
||||
break;
|
||||
}
|
||||
|
||||
@@ -145,7 +145,7 @@ void janetc_regalloc_free(JanetcRegisterAllocator *ra, int32_t reg) {
|
||||
int32_t janetc_regalloc_temp(JanetcRegisterAllocator *ra, JanetcRegisterTemp nth) {
|
||||
int32_t oldmax = ra->max;
|
||||
if (ra->regtemps & (1 << nth)) {
|
||||
janet_exit("regtemp already allocated");
|
||||
JANET_EXIT("regtemp already allocated");
|
||||
}
|
||||
ra->regtemps |= 1 << nth;
|
||||
int32_t reg = janetc_regalloc_1(ra);
|
||||
|
||||
@@ -50,7 +50,7 @@ int janet_dobytes(JanetTable *env, const uint8_t *bytes, int32_t len, const char
|
||||
JanetFiber *fiber = janet_fiber(f, 64, 0, NULL);
|
||||
fiber->env = env;
|
||||
JanetSignal status = janet_continue(fiber, janet_wrap_nil(), &ret);
|
||||
if (status != JANET_SIGNAL_OK) {
|
||||
if (status != JANET_SIGNAL_OK && status != JANET_SIGNAL_EVENT) {
|
||||
janet_stacktrace(fiber, ret);
|
||||
errflags |= 0x01;
|
||||
done = 1;
|
||||
|
||||
@@ -43,6 +43,7 @@ extern JANET_THREAD_LOCAL int janet_vm_stackn;
|
||||
/* The current running fiber on the current thread.
|
||||
* Set and unset by janet_run. */
|
||||
extern JANET_THREAD_LOCAL JanetFiber *janet_vm_fiber;
|
||||
extern JANET_THREAD_LOCAL JanetFiber *janet_vm_root_fiber;
|
||||
|
||||
/* The current pointer to the inner most jmp_buf. The current
|
||||
* return point for panics. */
|
||||
@@ -79,6 +80,17 @@ extern JANET_THREAD_LOCAL JanetScratch **janet_scratch_mem;
|
||||
extern JANET_THREAD_LOCAL size_t janet_scratch_cap;
|
||||
extern JANET_THREAD_LOCAL size_t janet_scratch_len;
|
||||
|
||||
/* Recursionless traversal of data structures */
|
||||
typedef struct {
|
||||
JanetGCObject *self;
|
||||
JanetGCObject *other;
|
||||
int32_t index;
|
||||
int32_t index2;
|
||||
} JanetTraversalNode;
|
||||
extern JANET_THREAD_LOCAL JanetTraversalNode *janet_vm_traversal;
|
||||
extern JANET_THREAD_LOCAL JanetTraversalNode *janet_vm_traversal_top;
|
||||
extern JANET_THREAD_LOCAL JanetTraversalNode *janet_vm_traversal_base;
|
||||
|
||||
/* Setup / teardown */
|
||||
#ifdef JANET_THREADS
|
||||
void janet_threads_init(void);
|
||||
|
||||
@@ -542,7 +542,7 @@ static const JanetReg string_cfuns[] = {
|
||||
{
|
||||
"string/from-bytes", cfun_string_frombytes,
|
||||
JDOC("(string/from-bytes & byte-vals)\n\n"
|
||||
"Creates a string from integer params with byte values. All integers "
|
||||
"Creates a string from integer parameters with byte values. All integers "
|
||||
"will be coerced to the range of 1 byte 0-255.")
|
||||
},
|
||||
{
|
||||
@@ -573,7 +573,7 @@ static const JanetReg string_cfuns[] = {
|
||||
},
|
||||
{
|
||||
"string/find-all", cfun_string_findall,
|
||||
JDOC("(string/find patt str)\n\n"
|
||||
JDOC("(string/find-all patt str)\n\n"
|
||||
"Searches for all instances of pattern patt in string "
|
||||
"str. Returns an array of all indices of found patterns. Overlapping "
|
||||
"instances of the pattern are not counted, meaning a byte in string "
|
||||
@@ -627,7 +627,7 @@ static const JanetReg string_cfuns[] = {
|
||||
{
|
||||
"string/format", cfun_string_format,
|
||||
JDOC("(string/format format & values)\n\n"
|
||||
"Similar to snprintf, but specialized for operating with janet. Returns "
|
||||
"Similar to snprintf, but specialized for operating with Janet values. Returns "
|
||||
"a new string.")
|
||||
},
|
||||
{
|
||||
|
||||
@@ -208,9 +208,9 @@ static double convert(
|
||||
|
||||
/* Approximate exponent in base 2 of mant and exponent. This should get us a good estimate of the final size of the
|
||||
* number, within * 2^32 or so. */
|
||||
int32_t mant_exp2_approx = mant->n * 32 + 16;
|
||||
int32_t exp_exp2_approx = (int32_t)(floor(log2(base) * exponent));
|
||||
int32_t exp2_approx = mant_exp2_approx + exp_exp2_approx;
|
||||
int64_t mant_exp2_approx = mant->n * 32 + 16;
|
||||
int64_t exp_exp2_approx = (int64_t)(floor(log2(base) * exponent));
|
||||
int64_t exp2_approx = mant_exp2_approx + exp_exp2_approx;
|
||||
|
||||
/* Short circuit zero, huge, and small numbers. We use the exponent range of valid IEEE754 doubles (-1022, 1023)
|
||||
* with a healthy buffer to allow for inaccuracies in the approximation and denormailzed numbers. */
|
||||
|
||||
@@ -123,7 +123,8 @@ void janet_struct_put(JanetKV *st, Janet key, Janet value) {
|
||||
dist = otherdist;
|
||||
hash = otherhash;
|
||||
} else if (status == 0) {
|
||||
/* A key was added to the struct more than once */
|
||||
/* A key was added to the struct more than once - replace old value */
|
||||
kv->value = value;
|
||||
return;
|
||||
}
|
||||
}
|
||||
@@ -166,51 +167,3 @@ JanetTable *janet_struct_to_table(const JanetKV *st) {
|
||||
}
|
||||
return table;
|
||||
}
|
||||
|
||||
/* Check if two structs are equal */
|
||||
int janet_struct_equal(const JanetKV *lhs, const JanetKV *rhs) {
|
||||
int32_t index;
|
||||
int32_t llen = janet_struct_capacity(lhs);
|
||||
int32_t rlen = janet_struct_capacity(rhs);
|
||||
int32_t lhash = janet_struct_hash(lhs);
|
||||
int32_t rhash = janet_struct_hash(rhs);
|
||||
if (llen != rlen)
|
||||
return 0;
|
||||
if (lhash != rhash)
|
||||
return 0;
|
||||
for (index = 0; index < llen; index++) {
|
||||
const JanetKV *l = lhs + index;
|
||||
const JanetKV *r = rhs + index;
|
||||
if (!janet_equals(l->key, r->key))
|
||||
return 0;
|
||||
if (!janet_equals(l->value, r->value))
|
||||
return 0;
|
||||
}
|
||||
return 1;
|
||||
}
|
||||
|
||||
/* Compare structs */
|
||||
int janet_struct_compare(const JanetKV *lhs, const JanetKV *rhs) {
|
||||
int32_t i;
|
||||
int32_t lhash = janet_struct_hash(lhs);
|
||||
int32_t rhash = janet_struct_hash(rhs);
|
||||
int32_t llen = janet_struct_capacity(lhs);
|
||||
int32_t rlen = janet_struct_capacity(rhs);
|
||||
if (llen < rlen)
|
||||
return -1;
|
||||
if (llen > rlen)
|
||||
return 1;
|
||||
if (lhash < rhash)
|
||||
return -1;
|
||||
if (lhash > rhash)
|
||||
return 1;
|
||||
for (i = 0; i < llen; ++i) {
|
||||
const JanetKV *l = lhs + i;
|
||||
const JanetKV *r = rhs + i;
|
||||
int comp = janet_compare(l->key, r->key);
|
||||
if (comp != 0) return comp;
|
||||
comp = janet_compare(l->value, r->value);
|
||||
if (comp != 0) return comp;
|
||||
}
|
||||
return 0;
|
||||
}
|
||||
|
||||
@@ -329,7 +329,7 @@ int janet_thread_send(JanetThread *thread, Janet msg, double timeout) {
|
||||
msgbuf->count = 0;
|
||||
|
||||
/* Start panic zone */
|
||||
janet_marshal(msgbuf, msg, thread->encode, 0);
|
||||
janet_marshal(msgbuf, msg, thread->encode, JANET_MARSHAL_UNSAFE);
|
||||
/* End panic zone */
|
||||
|
||||
mailbox->messageNext = (mailbox->messageNext + 1) % mailbox->messageCapacity;
|
||||
@@ -379,7 +379,7 @@ int janet_thread_receive(Janet *msg_out, double timeout) {
|
||||
const uint8_t *nextItem = NULL;
|
||||
Janet item = janet_unmarshal(
|
||||
msgbuf->data, msgbuf->count,
|
||||
0, janet_thread_get_decode(), &nextItem);
|
||||
JANET_MARSHAL_UNSAFE, janet_thread_get_decode(), &nextItem);
|
||||
*msg_out = item;
|
||||
|
||||
/* Cleanup */
|
||||
@@ -465,11 +465,15 @@ static int thread_worker(JanetMailboxPair *pair) {
|
||||
Janet argv[1] = { parentv };
|
||||
fiber = janet_fiber(func, 64, 1, argv);
|
||||
JanetSignal sig = janet_continue(fiber, janet_wrap_nil(), &out);
|
||||
if (sig != JANET_SIGNAL_OK) {
|
||||
if (sig != JANET_SIGNAL_OK && sig < JANET_SIGNAL_USER0) {
|
||||
janet_eprintf("in thread %v: ", janet_wrap_abstract(janet_make_thread(pair->newbox, encode)));
|
||||
janet_stacktrace(fiber, out);
|
||||
}
|
||||
|
||||
#ifdef JANET_NET
|
||||
janet_loop();
|
||||
#endif
|
||||
|
||||
/* Normal exit */
|
||||
destroy_mailbox_pair(pair);
|
||||
janet_deinit();
|
||||
|
||||
@@ -53,45 +53,6 @@ const Janet *janet_tuple_n(const Janet *values, int32_t n) {
|
||||
return janet_tuple_end(t);
|
||||
}
|
||||
|
||||
/* Check if two tuples are equal */
|
||||
int janet_tuple_equal(const Janet *lhs, const Janet *rhs) {
|
||||
int32_t index;
|
||||
int32_t llen = janet_tuple_length(lhs);
|
||||
int32_t rlen = janet_tuple_length(rhs);
|
||||
int32_t lhash = janet_tuple_hash(lhs);
|
||||
int32_t rhash = janet_tuple_hash(rhs);
|
||||
if (lhash == 0)
|
||||
lhash = janet_tuple_hash(lhs) = janet_array_calchash(lhs, llen);
|
||||
if (rhash == 0)
|
||||
rhash = janet_tuple_hash(rhs) = janet_array_calchash(rhs, rlen);
|
||||
if (lhash != rhash)
|
||||
return 0;
|
||||
if (llen != rlen)
|
||||
return 0;
|
||||
for (index = 0; index < llen; index++) {
|
||||
if (!janet_equals(lhs[index], rhs[index]))
|
||||
return 0;
|
||||
}
|
||||
return 1;
|
||||
}
|
||||
|
||||
/* Compare tuples */
|
||||
int janet_tuple_compare(const Janet *lhs, const Janet *rhs) {
|
||||
int32_t i;
|
||||
int32_t llen = janet_tuple_length(lhs);
|
||||
int32_t rlen = janet_tuple_length(rhs);
|
||||
int32_t count = llen < rlen ? llen : rlen;
|
||||
for (i = 0; i < count; ++i) {
|
||||
int comp = janet_compare(lhs[i], rhs[i]);
|
||||
if (comp != 0) return comp;
|
||||
}
|
||||
if (llen < rlen)
|
||||
return -1;
|
||||
else if (llen > rlen)
|
||||
return 1;
|
||||
return 0;
|
||||
}
|
||||
|
||||
/* C Functions */
|
||||
|
||||
static Janet cfun_tuple_brackets(int32_t argc, Janet *argv) {
|
||||
|
||||
@@ -380,7 +380,7 @@ void janet_var(JanetTable *env, const char *name, Janet val, const char *doc) {
|
||||
}
|
||||
|
||||
/* Load many cfunctions at once */
|
||||
void janet_cfuns(JanetTable *env, const char *regprefix, const JanetReg *cfuns) {
|
||||
static void _janet_cfuns_prefix(JanetTable *env, const char *regprefix, const JanetReg *cfuns, int defprefix) {
|
||||
uint8_t *longname_buffer = NULL;
|
||||
size_t prefixlen = 0;
|
||||
size_t bufsize = 0;
|
||||
@@ -414,13 +414,29 @@ void janet_cfuns(JanetTable *env, const char *regprefix, const JanetReg *cfuns)
|
||||
name = janet_csymbolv(cfuns->name);
|
||||
}
|
||||
Janet fun = janet_wrap_cfunction(cfuns->cfun);
|
||||
janet_def(env, cfuns->name, fun, cfuns->documentation);
|
||||
if (defprefix) {
|
||||
JanetTable *subt = janet_table(2);
|
||||
janet_table_put(subt, janet_ckeywordv("value"), fun);
|
||||
if (cfuns->documentation)
|
||||
janet_table_put(subt, janet_ckeywordv("doc"), janet_cstringv(cfuns->documentation));
|
||||
janet_table_put(env, name, janet_wrap_table(subt));
|
||||
} else {
|
||||
janet_def(env, cfuns->name, fun, cfuns->documentation);
|
||||
}
|
||||
janet_table_put(janet_vm_registry, fun, name);
|
||||
cfuns++;
|
||||
}
|
||||
free(longname_buffer);
|
||||
}
|
||||
|
||||
void janet_cfuns_prefix(JanetTable *env, const char *regprefix, const JanetReg *cfuns) {
|
||||
_janet_cfuns_prefix(env, regprefix, cfuns, 1);
|
||||
}
|
||||
|
||||
void janet_cfuns(JanetTable *env, const char *regprefix, const JanetReg *cfuns) {
|
||||
_janet_cfuns_prefix(env, regprefix, cfuns, 0);
|
||||
}
|
||||
|
||||
/* Abstract type introspection */
|
||||
|
||||
void janet_register_abstract_type(const JanetAbstractType *at) {
|
||||
|
||||
@@ -32,10 +32,10 @@
|
||||
#include <errno.h>
|
||||
|
||||
/* Handle runtime errors */
|
||||
#ifndef janet_exit
|
||||
#ifndef JANET_EXIT
|
||||
#include <stdio.h>
|
||||
#define janet_exit(m) do { \
|
||||
printf("C runtime error at line %d in file %s: %s\n",\
|
||||
#define JANET_EXIT(m) do { \
|
||||
fprintf(stderr, "C runtime error at line %d in file %s: %s\n",\
|
||||
__LINE__,\
|
||||
__FILE__,\
|
||||
(m));\
|
||||
@@ -44,13 +44,13 @@
|
||||
#endif
|
||||
|
||||
#define janet_assert(c, m) do { \
|
||||
if (!(c)) janet_exit((m)); \
|
||||
if (!(c)) JANET_EXIT((m)); \
|
||||
} while (0)
|
||||
|
||||
/* What to do when out of memory */
|
||||
#ifndef JANET_OUT_OF_MEMORY
|
||||
#include <stdio.h>
|
||||
#define JANET_OUT_OF_MEMORY do { printf("janet out of memory\n"); exit(1); } while (0)
|
||||
#define JANET_OUT_OF_MEMORY do { fprintf(stderr, "janet out of memory\n"); exit(1); } while (0)
|
||||
#endif
|
||||
|
||||
/* Omit docstrings in some builds */
|
||||
@@ -126,5 +126,10 @@ void janet_lib_inttypes(JanetTable *env);
|
||||
#ifdef JANET_THREADS
|
||||
void janet_lib_thread(JanetTable *env);
|
||||
#endif
|
||||
#ifdef JANET_NET
|
||||
void janet_lib_net(JanetTable *env);
|
||||
void janet_net_deinit(void);
|
||||
void janet_net_markloop(void);
|
||||
#endif
|
||||
|
||||
#endif
|
||||
|
||||
209
src/core/value.c
209
src/core/value.c
@@ -23,9 +23,91 @@
|
||||
#ifndef JANET_AMALG
|
||||
#include "features.h"
|
||||
#include "util.h"
|
||||
#include "state.h"
|
||||
#include "gc.h"
|
||||
#include <janet.h>
|
||||
#endif
|
||||
|
||||
JANET_THREAD_LOCAL JanetTraversalNode *janet_vm_traversal = NULL;
|
||||
JANET_THREAD_LOCAL JanetTraversalNode *janet_vm_traversal_top = NULL;
|
||||
JANET_THREAD_LOCAL JanetTraversalNode *janet_vm_traversal_base = NULL;
|
||||
|
||||
static void push_traversal_node(void *lhs, void *rhs, int32_t index2) {
|
||||
JanetTraversalNode node;
|
||||
node.self = (JanetGCObject *) lhs;
|
||||
node.other = (JanetGCObject *) rhs;
|
||||
node.index = 0;
|
||||
node.index2 = index2;
|
||||
if (janet_vm_traversal + 1 >= janet_vm_traversal_top) {
|
||||
size_t oldsize = janet_vm_traversal - janet_vm_traversal_base;
|
||||
size_t newsize = 2 * oldsize + 1;
|
||||
if (newsize < 128) {
|
||||
newsize = 128;
|
||||
}
|
||||
JanetTraversalNode *tn = realloc(janet_vm_traversal_base, newsize * sizeof(JanetTraversalNode));
|
||||
if (tn == NULL) {
|
||||
JANET_OUT_OF_MEMORY;
|
||||
}
|
||||
janet_vm_traversal_base = tn;
|
||||
janet_vm_traversal_top = janet_vm_traversal_base + newsize;
|
||||
janet_vm_traversal = janet_vm_traversal_base + oldsize;
|
||||
}
|
||||
*(++janet_vm_traversal) = node;
|
||||
}
|
||||
|
||||
/*
|
||||
* Used for travsersing structs and tuples without recursion
|
||||
* Returns:
|
||||
* 0 - next node found
|
||||
* 1 - early stop - lhs < rhs
|
||||
* 2 - no next node found
|
||||
* 3 - early stop - lhs > rhs
|
||||
*/
|
||||
static int traversal_next(Janet *x, Janet *y) {
|
||||
JanetTraversalNode *t = janet_vm_traversal;
|
||||
while (t && t > janet_vm_traversal_base) {
|
||||
JanetGCObject *self = t->self;
|
||||
JanetTupleHead *tself = (JanetTupleHead *)self;
|
||||
JanetStructHead *sself = (JanetStructHead *)self;
|
||||
JanetGCObject *other = t->other;
|
||||
JanetTupleHead *tother = (JanetTupleHead *)other;
|
||||
JanetStructHead *sother = (JanetStructHead *)other;
|
||||
if ((self->flags & JANET_MEM_TYPEBITS) == JANET_MEMORY_TUPLE) {
|
||||
/* Node is a tuple at index t->index */
|
||||
if (t->index < tself->length && t->index < tother->length) {
|
||||
int32_t index = t->index++;
|
||||
*x = tself->data[index];
|
||||
*y = tother->data[index];
|
||||
janet_vm_traversal = t;
|
||||
return 0;
|
||||
}
|
||||
if (t->index2 && tself->length != tother->length) {
|
||||
return tself->length > tother->length ? 3 : 1;
|
||||
}
|
||||
} else {
|
||||
/* Node is a struct at index t->index: if t->index2 is true, we should return the values. */
|
||||
if (t->index2) {
|
||||
t->index2 = 0;
|
||||
int32_t index = t->index++;
|
||||
*x = sself->data[index].value;
|
||||
*y = sother->data[index].value;
|
||||
janet_vm_traversal = t;
|
||||
return 0;
|
||||
}
|
||||
for (int32_t i = t->index; i < sself->capacity; i++) {
|
||||
t->index2 = 1;
|
||||
*x = sself->data[t->index].key;
|
||||
*y = sother->data[t->index].key;
|
||||
janet_vm_traversal = t;
|
||||
return 0;
|
||||
}
|
||||
}
|
||||
t--;
|
||||
}
|
||||
janet_vm_traversal = t;
|
||||
return 2;
|
||||
}
|
||||
|
||||
/*
|
||||
* Define a number of functions that can be used internally on ANY Janet.
|
||||
*/
|
||||
@@ -111,41 +193,51 @@ static int janet_compare_abstract(JanetAbstract xx, JanetAbstract yy) {
|
||||
return xt->compare(xx, yy);
|
||||
}
|
||||
|
||||
/* Check if two values are equal. This is strict equality with no conversion. */
|
||||
int janet_equals(Janet x, Janet y) {
|
||||
int result = 0;
|
||||
if (janet_type(x) != janet_type(y)) {
|
||||
result = 0;
|
||||
} else {
|
||||
janet_vm_traversal = janet_vm_traversal_base;
|
||||
do {
|
||||
if (janet_type(x) != janet_type(y)) return 0;
|
||||
switch (janet_type(x)) {
|
||||
case JANET_NIL:
|
||||
result = 1;
|
||||
break;
|
||||
case JANET_BOOLEAN:
|
||||
result = (janet_unwrap_boolean(x) == janet_unwrap_boolean(y));
|
||||
if (janet_unwrap_boolean(x) != janet_unwrap_boolean(y)) return 0;
|
||||
break;
|
||||
case JANET_NUMBER:
|
||||
result = (janet_unwrap_number(x) == janet_unwrap_number(y));
|
||||
if (janet_unwrap_number(x) != janet_unwrap_number(y)) return 0;
|
||||
break;
|
||||
case JANET_STRING:
|
||||
result = janet_string_equal(janet_unwrap_string(x), janet_unwrap_string(y));
|
||||
break;
|
||||
case JANET_TUPLE:
|
||||
result = janet_tuple_equal(janet_unwrap_tuple(x), janet_unwrap_tuple(y));
|
||||
break;
|
||||
case JANET_STRUCT:
|
||||
result = janet_struct_equal(janet_unwrap_struct(x), janet_unwrap_struct(y));
|
||||
if (!janet_string_equal(janet_unwrap_string(x), janet_unwrap_string(y))) return 0;
|
||||
break;
|
||||
case JANET_ABSTRACT:
|
||||
result = !janet_compare_abstract(janet_unwrap_abstract(x), janet_unwrap_abstract(y));
|
||||
if (janet_compare_abstract(janet_unwrap_abstract(x), janet_unwrap_abstract(y))) return 0;
|
||||
break;
|
||||
default:
|
||||
/* compare pointers */
|
||||
result = (janet_unwrap_pointer(x) == janet_unwrap_pointer(y));
|
||||
if (janet_unwrap_pointer(x) != janet_unwrap_pointer(y)) return 0;
|
||||
break;
|
||||
case JANET_TUPLE: {
|
||||
const Janet *t1 = janet_unwrap_tuple(x);
|
||||
const Janet *t2 = janet_unwrap_tuple(y);
|
||||
if (t1 == t2) break;
|
||||
if (janet_tuple_hash(t1) != janet_tuple_hash(t2)) return 0;
|
||||
if (janet_tuple_length(t1) != janet_tuple_length(t2)) return 0;
|
||||
push_traversal_node(janet_tuple_head(t1), janet_tuple_head(t2), 0);
|
||||
break;
|
||||
}
|
||||
break;
|
||||
case JANET_STRUCT: {
|
||||
const JanetKV *s1 = janet_unwrap_struct(x);
|
||||
const JanetKV *s2 = janet_unwrap_struct(y);
|
||||
if (s1 == s2) break;
|
||||
if (janet_struct_hash(s1) != janet_struct_hash(s2)) return 0;
|
||||
if (janet_struct_length(s1) != janet_struct_length(s2)) return 0;
|
||||
push_traversal_node(janet_struct_head(s1), janet_struct_head(s2), 0);
|
||||
break;
|
||||
}
|
||||
break;
|
||||
}
|
||||
}
|
||||
return result;
|
||||
} while (!traversal_next(&x, &y));
|
||||
return 1;
|
||||
}
|
||||
|
||||
/* Computes a hash value for a function */
|
||||
@@ -201,38 +293,71 @@ int32_t janet_hash(Janet x) {
|
||||
* If y is less, returns 1. All types are comparable
|
||||
* and should have strict ordering, excepts NaNs. */
|
||||
int janet_compare(Janet x, Janet y) {
|
||||
if (janet_type(x) == janet_type(y)) {
|
||||
switch (janet_type(x)) {
|
||||
janet_vm_traversal = janet_vm_traversal_base;
|
||||
int status;
|
||||
do {
|
||||
JanetType tx = janet_type(x);
|
||||
JanetType ty = janet_type(y);
|
||||
if (tx != ty) return tx < ty ? -1 : 1;
|
||||
switch (tx) {
|
||||
case JANET_NIL:
|
||||
return 0;
|
||||
case JANET_BOOLEAN:
|
||||
return janet_unwrap_boolean(x) - janet_unwrap_boolean(y);
|
||||
break;
|
||||
case JANET_BOOLEAN: {
|
||||
int diff = janet_unwrap_boolean(x) - janet_unwrap_boolean(y);
|
||||
if (diff) return diff;
|
||||
break;
|
||||
}
|
||||
case JANET_NUMBER: {
|
||||
double xx = janet_unwrap_number(x);
|
||||
double yy = janet_unwrap_number(y);
|
||||
return xx == yy
|
||||
? 0
|
||||
: (xx < yy) ? -1 : 1;
|
||||
if (xx == yy) {
|
||||
break;
|
||||
} else {
|
||||
return (xx < yy) ? -1 : 1;
|
||||
}
|
||||
}
|
||||
case JANET_STRING:
|
||||
case JANET_SYMBOL:
|
||||
case JANET_KEYWORD:
|
||||
return janet_string_compare(janet_unwrap_string(x), janet_unwrap_string(y));
|
||||
case JANET_TUPLE:
|
||||
return janet_tuple_compare(janet_unwrap_tuple(x), janet_unwrap_tuple(y));
|
||||
case JANET_STRUCT:
|
||||
return janet_struct_compare(janet_unwrap_struct(x), janet_unwrap_struct(y));
|
||||
case JANET_ABSTRACT:
|
||||
return janet_compare_abstract(janet_unwrap_abstract(x), janet_unwrap_abstract(y));
|
||||
default:
|
||||
if (janet_unwrap_string(x) == janet_unwrap_string(y)) {
|
||||
return 0;
|
||||
case JANET_KEYWORD: {
|
||||
int diff = janet_string_compare(janet_unwrap_string(x), janet_unwrap_string(y));
|
||||
if (diff) return diff;
|
||||
break;
|
||||
}
|
||||
case JANET_ABSTRACT: {
|
||||
int diff = janet_compare_abstract(janet_unwrap_abstract(x), janet_unwrap_abstract(y));
|
||||
if (diff) return diff;
|
||||
break;
|
||||
}
|
||||
default: {
|
||||
if (janet_unwrap_pointer(x) == janet_unwrap_pointer(y)) {
|
||||
break;
|
||||
} else {
|
||||
return janet_unwrap_string(x) > janet_unwrap_string(y) ? 1 : -1;
|
||||
return janet_unwrap_pointer(x) > janet_unwrap_pointer(y) ? 1 : -1;
|
||||
}
|
||||
}
|
||||
case JANET_TUPLE: {
|
||||
const Janet *lhs = janet_unwrap_tuple(x);
|
||||
const Janet *rhs = janet_unwrap_tuple(y);
|
||||
push_traversal_node(janet_tuple_head(lhs), janet_tuple_head(rhs), 1);
|
||||
break;
|
||||
}
|
||||
case JANET_STRUCT: {
|
||||
const JanetKV *lhs = janet_unwrap_struct(x);
|
||||
const JanetKV *rhs = janet_unwrap_struct(y);
|
||||
int32_t llen = janet_struct_capacity(lhs);
|
||||
int32_t rlen = janet_struct_capacity(rhs);
|
||||
int32_t lhash = janet_struct_hash(lhs);
|
||||
int32_t rhash = janet_struct_hash(rhs);
|
||||
if (llen < rlen) return -1;
|
||||
if (llen > rlen) return 1;
|
||||
if (lhash < rhash) return -1;
|
||||
if (lhash > rhash) return 1;
|
||||
push_traversal_node(janet_struct_head(lhs), janet_struct_head(rhs), 0);
|
||||
break;
|
||||
}
|
||||
}
|
||||
}
|
||||
return (janet_type(x) < janet_type(y)) ? -1 : 1;
|
||||
} while (!(status = traversal_next(&x, &y)));
|
||||
return status - 2;
|
||||
}
|
||||
|
||||
static int32_t getter_checkint(Janet key, int32_t max) {
|
||||
|
||||
@@ -38,6 +38,7 @@ 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 JanetFiber *janet_vm_root_fiber = NULL;
|
||||
JANET_THREAD_LOCAL Janet *janet_vm_return_reg = NULL;
|
||||
JANET_THREAD_LOCAL jmp_buf *janet_vm_jmp_buf = NULL;
|
||||
|
||||
@@ -89,8 +90,8 @@ JANET_THREAD_LOCAL jmp_buf *janet_vm_jmp_buf = NULL;
|
||||
func = janet_stack_frame(stack)->func; \
|
||||
} while (0)
|
||||
#define vm_return(sig, val) do { \
|
||||
vm_commit(); \
|
||||
janet_vm_return_reg[0] = (val); \
|
||||
vm_commit(); \
|
||||
return (sig); \
|
||||
} while (0)
|
||||
|
||||
@@ -107,13 +108,13 @@ JANET_THREAD_LOCAL jmp_buf *janet_vm_jmp_buf = NULL;
|
||||
#define vm_assert_type(X, T) do { \
|
||||
if (!(janet_checktype((X), (T)))) { \
|
||||
vm_commit(); \
|
||||
janet_panicf("expected %T, got %t", (1 << (T)), (X)); \
|
||||
janet_panicf("expected %T, got %v", (1 << (T)), (X)); \
|
||||
} \
|
||||
} while (0)
|
||||
#define vm_assert_types(X, TS) do { \
|
||||
if (!(janet_checktypes((X), (TS)))) { \
|
||||
vm_commit(); \
|
||||
janet_panicf("expected %T, got %t", (TS), (X)); \
|
||||
janet_panicf("expected %T, got %v", (TS), (X)); \
|
||||
} \
|
||||
} while (0)
|
||||
|
||||
@@ -290,6 +291,10 @@ static Janet janet_binop_call(const char *lmethod, const char *rmethod, Janet lh
|
||||
}
|
||||
}
|
||||
|
||||
/* Forward declaration */
|
||||
static JanetSignal janet_check_can_resume(JanetFiber *fiber, Janet *out);
|
||||
static JanetSignal janet_continue_no_check(JanetFiber *fiber, Janet in, Janet *out);
|
||||
|
||||
/* Interpreter main loop */
|
||||
static JanetSignal run_vm(JanetFiber *fiber, Janet in) {
|
||||
|
||||
@@ -824,7 +829,8 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in) {
|
||||
vm_assert(func->def->environments_length > eindex, "invalid upvalue environment");
|
||||
env = func->envs[eindex];
|
||||
vm_assert(env->length > vindex, "invalid upvalue index");
|
||||
if (env->offset) {
|
||||
vm_assert(janet_env_valid(env), "invalid upvalue environment");
|
||||
if (env->offset > 0) {
|
||||
/* On stack */
|
||||
stack[A] = env->as.fiber->data[env->offset + vindex];
|
||||
} else {
|
||||
@@ -841,7 +847,8 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in) {
|
||||
vm_assert(func->def->environments_length > eindex, "invalid upvalue environment");
|
||||
env = func->envs[eindex];
|
||||
vm_assert(env->length > vindex, "invalid upvalue index");
|
||||
if (env->offset) {
|
||||
vm_assert(janet_env_valid(env), "invalid upvalue environment");
|
||||
if (env->offset > 0) {
|
||||
env->as.fiber->data[env->offset + vindex] = stack[A];
|
||||
} else {
|
||||
env->as.values[vindex] = stack[A];
|
||||
@@ -904,7 +911,7 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in) {
|
||||
if (janet_indexed_view(stack[D], &vals, &len)) {
|
||||
janet_fiber_pushn(fiber, vals, len);
|
||||
} else {
|
||||
janet_panicf("expected %T, got %t", JANET_TFLAG_INDEXED, stack[D]);
|
||||
janet_panicf("expected %T, got %v", JANET_TFLAG_INDEXED, stack[D]);
|
||||
}
|
||||
}
|
||||
stack = fiber->data + fiber->frame;
|
||||
@@ -997,8 +1004,12 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in) {
|
||||
Janet retreg;
|
||||
vm_assert_type(stack[B], JANET_FIBER);
|
||||
JanetFiber *child = janet_unwrap_fiber(stack[B]);
|
||||
if (janet_check_can_resume(child, &retreg)) {
|
||||
vm_commit();
|
||||
janet_panicv(retreg);
|
||||
}
|
||||
fiber->child = child;
|
||||
JanetSignal sig = janet_continue(child, stack[C], &retreg);
|
||||
JanetSignal sig = janet_continue_no_check(child, stack[C], &retreg);
|
||||
if (sig != JANET_SIGNAL_OK && !(child->flags & (1 << sig))) {
|
||||
vm_return(sig, retreg);
|
||||
}
|
||||
@@ -1234,15 +1245,14 @@ Janet janet_call(JanetFunction *fun, int32_t argc, const Janet *argv) {
|
||||
janet_vm_stackn = oldn;
|
||||
janet_gcunlock(handle);
|
||||
|
||||
if (signal != JANET_SIGNAL_OK) janet_panicv(*janet_vm_return_reg);
|
||||
if (signal != JANET_SIGNAL_OK) {
|
||||
janet_panicv(*janet_vm_return_reg);
|
||||
}
|
||||
|
||||
return *janet_vm_return_reg;
|
||||
}
|
||||
|
||||
/* Enter the main vm loop */
|
||||
JanetSignal janet_continue(JanetFiber *fiber, Janet in, Janet *out) {
|
||||
jmp_buf buf;
|
||||
|
||||
static JanetSignal janet_check_can_resume(JanetFiber *fiber, Janet *out) {
|
||||
/* Check conditions */
|
||||
JanetFiberStatus old_status = janet_fiber_status(fiber);
|
||||
if (janet_vm_stackn >= JANET_RECURSION_GUARD) {
|
||||
@@ -1259,13 +1269,22 @@ JanetSignal janet_continue(JanetFiber *fiber, Janet in, Janet *out) {
|
||||
*out = janet_wrap_string(str);
|
||||
return JANET_SIGNAL_ERROR;
|
||||
}
|
||||
return JANET_SIGNAL_OK;
|
||||
}
|
||||
|
||||
static JanetSignal janet_continue_no_check(JanetFiber *fiber, Janet in, Janet *out) {
|
||||
jmp_buf buf;
|
||||
|
||||
JanetFiberStatus old_status = janet_fiber_status(fiber);
|
||||
|
||||
/* Continue child fiber if it exists */
|
||||
if (fiber->child) {
|
||||
if (janet_vm_root_fiber == NULL) janet_vm_root_fiber = fiber;
|
||||
JanetFiber *child = fiber->child;
|
||||
janet_vm_stackn++;
|
||||
JanetSignal sig = janet_continue(child, in, &in);
|
||||
janet_vm_stackn--;
|
||||
if (janet_vm_root_fiber == fiber) janet_vm_root_fiber = NULL;
|
||||
if (sig != JANET_SIGNAL_OK && !(child->flags & (1 << sig))) {
|
||||
*out = in;
|
||||
return sig;
|
||||
@@ -1294,6 +1313,7 @@ JanetSignal janet_continue(JanetFiber *fiber, Janet in, Janet *out) {
|
||||
Janet *old_vm_return_reg = janet_vm_return_reg;
|
||||
|
||||
/* Setup fiber */
|
||||
if (janet_vm_root_fiber == NULL) janet_vm_root_fiber = fiber;
|
||||
janet_vm_fiber = fiber;
|
||||
janet_gcroot(janet_wrap_fiber(fiber));
|
||||
janet_fiber_set_status(fiber, JANET_STATUS_ALIVE);
|
||||
@@ -1319,6 +1339,7 @@ JanetSignal janet_continue(JanetFiber *fiber, Janet in, Janet *out) {
|
||||
janet_gcunroot(janet_wrap_fiber(fiber));
|
||||
|
||||
/* Restore global state */
|
||||
if (janet_vm_root_fiber == fiber) janet_vm_root_fiber = NULL;
|
||||
janet_vm_gc_suspend = handle;
|
||||
janet_vm_fiber = old_vm_fiber;
|
||||
janet_vm_stackn = oldn;
|
||||
@@ -1328,6 +1349,14 @@ JanetSignal janet_continue(JanetFiber *fiber, Janet in, Janet *out) {
|
||||
return signal;
|
||||
}
|
||||
|
||||
/* Enter the main vm loop */
|
||||
JanetSignal janet_continue(JanetFiber *fiber, Janet in, Janet *out) {
|
||||
/* Check conditions */
|
||||
JanetSignal tmp_signal = janet_check_can_resume(fiber, out);
|
||||
if (tmp_signal) return tmp_signal;
|
||||
return janet_continue_no_check(fiber, in, out);
|
||||
}
|
||||
|
||||
JanetSignal janet_pcall(
|
||||
JanetFunction *fun,
|
||||
int32_t argc,
|
||||
@@ -1384,10 +1413,18 @@ int janet_init(void) {
|
||||
janet_vm_abstract_registry = janet_table(0);
|
||||
janet_gcroot(janet_wrap_table(janet_vm_registry));
|
||||
janet_gcroot(janet_wrap_table(janet_vm_abstract_registry));
|
||||
/* Traversal */
|
||||
janet_vm_traversal = NULL;
|
||||
janet_vm_traversal_base = NULL;
|
||||
janet_vm_traversal_top = NULL;
|
||||
/* Core env */
|
||||
janet_vm_core_env = NULL;
|
||||
/* Seed RNG */
|
||||
janet_rng_seed(janet_default_rng(), 0);
|
||||
/* Fibers */
|
||||
janet_vm_fiber = NULL;
|
||||
janet_vm_root_fiber = NULL;
|
||||
janet_vm_stackn = 0;
|
||||
/* Threads */
|
||||
#ifdef JANET_THREADS
|
||||
janet_threads_init();
|
||||
@@ -1406,7 +1443,13 @@ void janet_deinit(void) {
|
||||
janet_vm_registry = NULL;
|
||||
janet_vm_abstract_registry = NULL;
|
||||
janet_vm_core_env = NULL;
|
||||
free(janet_vm_traversal_base);
|
||||
janet_vm_fiber = NULL;
|
||||
janet_vm_root_fiber = NULL;
|
||||
#ifdef JANET_THREADS
|
||||
janet_threads_deinit();
|
||||
#endif
|
||||
#ifdef JANET_NET
|
||||
janet_net_deinit();
|
||||
#endif
|
||||
}
|
||||
|
||||
@@ -27,6 +27,12 @@
|
||||
extern "C" {
|
||||
#endif
|
||||
|
||||
/* Variable length arrays are ok */
|
||||
#ifdef _MSC_VER
|
||||
#pragma warning( push )
|
||||
#pragma warning( disable : 4200 )
|
||||
#endif
|
||||
|
||||
/***** START SECTION CONFIG *****/
|
||||
|
||||
#include "janetconf.h"
|
||||
@@ -124,6 +130,12 @@ extern "C" {
|
||||
/* Check emscripten */
|
||||
#ifdef __EMSCRIPTEN__
|
||||
#define JANET_NO_DYNAMIC_MODULES
|
||||
#define JANET_NO_PROCESSES
|
||||
#endif
|
||||
|
||||
/* Check sun */
|
||||
#ifdef __sun
|
||||
#define JANET_NO_UTC_MKTIME
|
||||
#endif
|
||||
|
||||
/* Define how global janet state is declared */
|
||||
@@ -159,6 +171,11 @@ extern "C" {
|
||||
#define JANET_TYPED_ARRAY
|
||||
#endif
|
||||
|
||||
/* Enable or disable networking */
|
||||
#if !defined(JANET_NO_NET) && !defined(__EMSCRIPTEN__)
|
||||
#define JANET_NET
|
||||
#endif
|
||||
|
||||
/* Enable or disable large int types (for now 64 bit, maybe 128 / 256 bit integer types) */
|
||||
#ifndef JANET_NO_INT_TYPES
|
||||
#define JANET_INT_TYPES
|
||||
@@ -289,6 +306,8 @@ typedef enum {
|
||||
JANET_SIGNAL_USER9
|
||||
} JanetSignal;
|
||||
|
||||
#define JANET_SIGNAL_EVENT JANET_SIGNAL_USER9
|
||||
|
||||
/* Fiber statuses - mostly corresponds to signals. */
|
||||
typedef enum {
|
||||
JANET_STATUS_DEAD,
|
||||
@@ -309,14 +328,6 @@ typedef enum {
|
||||
JANET_STATUS_ALIVE
|
||||
} JanetFiberStatus;
|
||||
|
||||
#ifdef JANET_NANBOX_64
|
||||
typedef union Janet Janet;
|
||||
#elif defined(JANET_NANBOX_32)
|
||||
typedef union Janet Janet;
|
||||
#else
|
||||
typedef struct Janet Janet;
|
||||
#endif
|
||||
|
||||
/* Use type punning for GC objects */
|
||||
typedef struct JanetGCObject JanetGCObject;
|
||||
|
||||
@@ -347,6 +358,52 @@ typedef struct JanetByteView JanetByteView;
|
||||
typedef struct JanetDictView JanetDictView;
|
||||
typedef struct JanetRange JanetRange;
|
||||
typedef struct JanetRNG JanetRNG;
|
||||
|
||||
/* Recursive type (Janet) */
|
||||
#ifdef JANET_NANBOX_64
|
||||
typedef union Janet Janet;
|
||||
union Janet {
|
||||
uint64_t u64;
|
||||
int64_t i64;
|
||||
double number;
|
||||
void *pointer;
|
||||
};
|
||||
#elif defined(JANET_NANBOX_32)
|
||||
typedef union Janet Janet;
|
||||
union Janet {
|
||||
struct {
|
||||
#ifdef JANET_BIG_ENDIAN
|
||||
uint32_t type;
|
||||
union {
|
||||
int32_t integer;
|
||||
void *pointer;
|
||||
} payload;
|
||||
#else
|
||||
union {
|
||||
int32_t integer;
|
||||
void *pointer;
|
||||
} payload;
|
||||
uint32_t type;
|
||||
#endif
|
||||
} tagged;
|
||||
double number;
|
||||
uint64_t u64;
|
||||
};
|
||||
#else
|
||||
typedef struct Janet Janet;
|
||||
struct Janet {
|
||||
union {
|
||||
uint64_t u64;
|
||||
double number;
|
||||
int32_t integer;
|
||||
void *pointer;
|
||||
const void *cpointer;
|
||||
} as;
|
||||
JanetType type;
|
||||
};
|
||||
#endif
|
||||
|
||||
/* C functions */
|
||||
typedef Janet(*JanetCFunction)(int32_t argc, Janet *argv);
|
||||
|
||||
/* String and other aliased pointer types */
|
||||
@@ -485,13 +542,6 @@ JANET_API Janet janet_wrap_integer(int32_t x);
|
||||
|
||||
#include <math.h>
|
||||
|
||||
/* 64 Nanboxed Janet value */
|
||||
union Janet {
|
||||
uint64_t u64;
|
||||
int64_t i64;
|
||||
double number;
|
||||
void *pointer;
|
||||
};
|
||||
#define janet_u64(x) ((x).u64)
|
||||
|
||||
#define JANET_NANBOX_TAGBITS 0xFFFF800000000000llu
|
||||
@@ -576,27 +626,6 @@ JANET_API Janet janet_nanbox_from_bits(uint64_t bits);
|
||||
|
||||
#elif defined(JANET_NANBOX_32)
|
||||
|
||||
/* 32 bit nanboxed janet */
|
||||
union Janet {
|
||||
struct {
|
||||
#ifdef JANET_BIG_ENDIAN
|
||||
uint32_t type;
|
||||
union {
|
||||
int32_t integer;
|
||||
void *pointer;
|
||||
} payload;
|
||||
#else
|
||||
union {
|
||||
int32_t integer;
|
||||
void *pointer;
|
||||
} payload;
|
||||
uint32_t type;
|
||||
#endif
|
||||
} tagged;
|
||||
double number;
|
||||
uint64_t u64;
|
||||
};
|
||||
|
||||
#define JANET_DOUBLE_OFFSET 0xFFFF
|
||||
|
||||
#define janet_u64(x) ((x).u64)
|
||||
@@ -647,18 +676,6 @@ JANET_API Janet janet_nanbox32_from_tagp(uint32_t tag, void *pointer);
|
||||
|
||||
#else
|
||||
|
||||
/* A general janet value type for more standard C */
|
||||
struct Janet {
|
||||
union {
|
||||
uint64_t u64;
|
||||
double number;
|
||||
int32_t integer;
|
||||
void *pointer;
|
||||
const void *cpointer;
|
||||
} as;
|
||||
JanetType type;
|
||||
};
|
||||
|
||||
#define janet_u64(x) ((x).as.u64)
|
||||
#define janet_type(x) ((x).type)
|
||||
#define janet_checktype(x, t) ((x).type == (t))
|
||||
@@ -733,8 +750,9 @@ struct JanetStackFrame {
|
||||
int32_t flags;
|
||||
};
|
||||
|
||||
/* Number of Janets a frame takes up in the stack */
|
||||
#define JANET_FRAME_SIZE ((sizeof(JanetStackFrame) + sizeof(Janet) - 1) / sizeof(Janet))
|
||||
/* Number of Janets a frame takes up in the stack
|
||||
* Should be constant across architectures */
|
||||
#define JANET_FRAME_SIZE 4
|
||||
|
||||
/* A dynamic array type. */
|
||||
struct JanetArray {
|
||||
@@ -1110,6 +1128,11 @@ extern enum JanetInstructionType janet_instructions[JOP_INSTRUCTION_COUNT];
|
||||
|
||||
/***** START SECTION MAIN *****/
|
||||
|
||||
/* Event Loop */
|
||||
#ifdef JANET_NET
|
||||
JANET_API void janet_loop(void);
|
||||
#endif
|
||||
|
||||
/* Parsing */
|
||||
extern JANET_API const JanetAbstractType janet_parser_type;
|
||||
JANET_API void janet_parser_init(JanetParser *parser);
|
||||
@@ -1208,6 +1231,7 @@ JANET_API void janet_buffer_push_u64(JanetBuffer *buffer, uint64_t x);
|
||||
#define JANET_TUPLE_FLAG_BRACKETCTOR 0x10000
|
||||
|
||||
#define janet_tuple_head(t) ((JanetTupleHead *)((char *)t - offsetof(JanetTupleHead, data)))
|
||||
#define janet_tuple_from_head(gcobject) ((const Janet *)((char *)gcobject + offsetof(JanetTupleHead, data)))
|
||||
#define janet_tuple_length(t) (janet_tuple_head(t)->length)
|
||||
#define janet_tuple_hash(t) (janet_tuple_head(t)->hash)
|
||||
#define janet_tuple_sm_line(t) (janet_tuple_head(t)->sm_line)
|
||||
@@ -1216,8 +1240,6 @@ JANET_API void janet_buffer_push_u64(JanetBuffer *buffer, uint64_t x);
|
||||
JANET_API Janet *janet_tuple_begin(int32_t length);
|
||||
JANET_API JanetTuple janet_tuple_end(Janet *tuple);
|
||||
JANET_API JanetTuple janet_tuple_n(const Janet *values, int32_t n);
|
||||
JANET_API int janet_tuple_equal(JanetTuple lhs, JanetTuple rhs);
|
||||
JANET_API int janet_tuple_compare(JanetTuple lhs, JanetTuple rhs);
|
||||
|
||||
/* String/Symbol functions */
|
||||
#define janet_string_head(s) ((JanetStringHead *)((char *)s - offsetof(JanetStringHead, data)))
|
||||
@@ -1237,7 +1259,8 @@ JANET_API void janet_description_b(JanetBuffer *buffer, Janet x);
|
||||
#define janet_cstringv(cstr) janet_wrap_string(janet_cstring(cstr))
|
||||
#define janet_stringv(str, len) janet_wrap_string(janet_string((str), (len)))
|
||||
JANET_API JanetString janet_formatc(const char *format, ...);
|
||||
JANET_API void janet_formatb(JanetBuffer *bufp, const char *format, va_list args);
|
||||
JANET_API JanetBuffer *janet_formatb(JanetBuffer *bufp, const char *format, ...);
|
||||
JANET_API void janet_formatbv(JanetBuffer *bufp, const char *format, va_list args);
|
||||
|
||||
/* Symbol functions */
|
||||
JANET_API JanetSymbol janet_symbol(const uint8_t *str, int32_t len);
|
||||
@@ -1254,6 +1277,7 @@ JANET_API JanetSymbol janet_symbol_gen(void);
|
||||
|
||||
/* Structs */
|
||||
#define janet_struct_head(t) ((JanetStructHead *)((char *)t - offsetof(JanetStructHead, data)))
|
||||
#define janet_struct_from_head(t) ((const JanetKV *)((char *)gcobject + offsetof(JanetStructHead, data)))
|
||||
#define janet_struct_length(t) (janet_struct_head(t)->length)
|
||||
#define janet_struct_capacity(t) (janet_struct_head(t)->capacity)
|
||||
#define janet_struct_hash(t) (janet_struct_head(t)->hash)
|
||||
@@ -1262,8 +1286,6 @@ JANET_API void janet_struct_put(JanetKV *st, Janet key, Janet value);
|
||||
JANET_API JanetStruct janet_struct_end(JanetKV *st);
|
||||
JANET_API Janet janet_struct_get(JanetStruct st, Janet key);
|
||||
JANET_API JanetTable *janet_struct_to_table(JanetStruct st);
|
||||
JANET_API int janet_struct_equal(JanetStruct lhs, JanetStruct rhs);
|
||||
JANET_API int janet_struct_compare(JanetStruct lhs, JanetStruct rhs);
|
||||
JANET_API const JanetKV *janet_struct_find(JanetStruct st, Janet key);
|
||||
|
||||
/* Table functions */
|
||||
@@ -1286,6 +1308,7 @@ JANET_API JanetFiber *janet_fiber(JanetFunction *callee, int32_t capacity, int32
|
||||
JANET_API JanetFiber *janet_fiber_reset(JanetFiber *fiber, JanetFunction *callee, int32_t argc, const Janet *argv);
|
||||
JANET_API JanetFiberStatus janet_fiber_status(JanetFiber *fiber);
|
||||
JANET_API JanetFiber *janet_current_fiber(void);
|
||||
JANET_API JanetFiber *janet_root_fiber(void);
|
||||
|
||||
/* Treat similar types through uniform interfaces for iteration */
|
||||
JANET_API int janet_indexed_view(Janet seq, const Janet **data, int32_t *len);
|
||||
@@ -1296,6 +1319,7 @@ JANET_API const JanetKV *janet_dictionary_next(const JanetKV *kvs, int32_t cap,
|
||||
|
||||
/* Abstract */
|
||||
#define janet_abstract_head(u) ((JanetAbstractHead *)((char *)u - offsetof(JanetAbstractHead, data)))
|
||||
#define janet_abstract_from_head(gcobject) ((JanetAbstract)((char *)gcobject + offsetof(JanetAbstractHead, data)))
|
||||
#define janet_abstract_type(u) (janet_abstract_head(u)->type)
|
||||
#define janet_abstract_size(u) (janet_abstract_head(u)->size)
|
||||
JANET_API void *janet_abstract_begin(const JanetAbstractType *type, size_t size);
|
||||
@@ -1308,6 +1332,8 @@ typedef JanetBuildConfig(*JanetModconf)(void);
|
||||
JANET_API JanetModule janet_native(const char *name, JanetString *error);
|
||||
|
||||
/* Marshaling */
|
||||
#define JANET_MARSHAL_UNSAFE 0x20000
|
||||
|
||||
JANET_API void janet_marshal(
|
||||
JanetBuffer *buf,
|
||||
Janet x,
|
||||
@@ -1342,6 +1368,7 @@ JANET_API int janet_verify(JanetFuncDef *def);
|
||||
/* Pretty printing */
|
||||
#define JANET_PRETTY_COLOR 1
|
||||
#define JANET_PRETTY_ONELINE 2
|
||||
#define JANET_PRETTY_NOTRUNC 4
|
||||
JANET_API JanetBuffer *janet_pretty(JanetBuffer *buffer, int depth, int flags, Janet x);
|
||||
|
||||
/* Misc */
|
||||
@@ -1555,6 +1582,7 @@ typedef enum {
|
||||
RULE_ERROR, /* [rule] */
|
||||
RULE_DROP, /* [rule] */
|
||||
RULE_BACKMATCH, /* [tag] */
|
||||
RULE_LENPREFIX, /* [rule_a, rule_b (repeat rule_b rule_a times)] */
|
||||
} JanetPegOpcode;
|
||||
|
||||
typedef struct {
|
||||
@@ -1651,6 +1679,11 @@ JANET_API int janet_thread_send(JanetThread *thread, Janet msg, double timeout);
|
||||
|
||||
/***** END SECTION MAIN *****/
|
||||
|
||||
/* Re-enable popped variable length array warnings */
|
||||
#ifdef _MSC_VER
|
||||
#pragma warning( pop )
|
||||
#endif
|
||||
|
||||
#ifdef __cplusplus
|
||||
}
|
||||
#endif
|
||||
|
||||
@@ -515,6 +515,147 @@ static void check_specials(JanetByteView src) {
|
||||
check_cmatch(src, "while");
|
||||
}
|
||||
|
||||
static void resolve_format(JanetTable *entry) {
|
||||
int is_macro = janet_truthy(janet_table_get(entry, janet_ckeywordv("macro")));
|
||||
Janet refv = janet_table_get(entry, janet_ckeywordv("ref"));
|
||||
int is_ref = janet_checktype(refv, JANET_ARRAY);
|
||||
Janet value = janet_wrap_nil();
|
||||
if (is_ref) {
|
||||
JanetArray *a = janet_unwrap_array(refv);
|
||||
if (a->count) value = a->data[0];
|
||||
} else {
|
||||
value = janet_table_get(entry, janet_ckeywordv("value"));
|
||||
}
|
||||
if (is_macro) {
|
||||
fprintf(stderr, " macro\n");
|
||||
gbl_lines_below++;
|
||||
} else if (is_ref) {
|
||||
janet_eprintf(" var (%t)\n", value);
|
||||
gbl_lines_below++;
|
||||
} else {
|
||||
janet_eprintf(" %t\n", value);
|
||||
gbl_lines_below++;
|
||||
}
|
||||
Janet sm = janet_table_get(entry, janet_ckeywordv("source-map"));
|
||||
Janet path = janet_get(sm, janet_wrap_integer(0));
|
||||
Janet line = janet_get(sm, janet_wrap_integer(1));
|
||||
Janet col = janet_get(sm, janet_wrap_integer(2));
|
||||
if (janet_checktype(path, JANET_STRING) && janet_truthy(line) && janet_truthy(col)) {
|
||||
janet_eprintf(" %S on line %v, column %v\n", janet_unwrap_string(path), line, col);
|
||||
gbl_lines_below++;
|
||||
}
|
||||
}
|
||||
|
||||
static void doc_format(JanetString doc, int32_t width) {
|
||||
int32_t maxcol = width - 8;
|
||||
uint8_t wordbuf[256] = {0};
|
||||
int32_t wordp = 0;
|
||||
int32_t current = 0;
|
||||
if (maxcol > 200) maxcol = 200;
|
||||
fprintf(stderr, " ");
|
||||
for (int32_t i = 0; i < janet_string_length(doc); i++) {
|
||||
uint8_t b = doc[i];
|
||||
switch (b) {
|
||||
default: {
|
||||
if (maxcol <= current + wordp + 1) {
|
||||
if (!current) {
|
||||
fwrite(wordbuf, wordp, 1, stderr);
|
||||
wordp = 0;
|
||||
}
|
||||
fprintf(stderr, "\n ");
|
||||
gbl_lines_below++;
|
||||
current = 0;
|
||||
}
|
||||
wordbuf[wordp++] = b;
|
||||
break;
|
||||
}
|
||||
case '\t': {
|
||||
if (maxcol <= current + wordp + 2) {
|
||||
if (!current) {
|
||||
fwrite(wordbuf, wordp, 1, stderr);
|
||||
wordp = 0;
|
||||
}
|
||||
fprintf(stderr, "\n ");
|
||||
gbl_lines_below++;
|
||||
current = 0;
|
||||
}
|
||||
wordbuf[wordp++] = ' ';
|
||||
wordbuf[wordp++] = ' ';
|
||||
break;
|
||||
}
|
||||
case '\n':
|
||||
case ' ': {
|
||||
if (wordp) {
|
||||
int32_t oldcur = current;
|
||||
int spacer = maxcol > current + wordp + 1;
|
||||
if (spacer) current++;
|
||||
else current = 0;
|
||||
current += wordp;
|
||||
if (oldcur) fprintf(stderr, spacer ? " " : "\n ");
|
||||
if (oldcur && !spacer) gbl_lines_below++;
|
||||
fwrite(wordbuf, wordp, 1, stderr);
|
||||
wordp = 0;
|
||||
}
|
||||
if (b == '\n') {
|
||||
fprintf(stderr, "\n ");
|
||||
gbl_lines_below++;
|
||||
current = 0;
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
if (wordp) {
|
||||
int32_t oldcur = current;
|
||||
int spacer = maxcol > current + wordp + 1;
|
||||
if (spacer) current++;
|
||||
else current = 0;
|
||||
current += wordp + 1;
|
||||
if (oldcur) fprintf(stderr, spacer ? " " : "\n ");
|
||||
if (oldcur && !spacer) gbl_lines_below++;
|
||||
fwrite(wordbuf, wordp, 1, stderr);
|
||||
wordp = 0;
|
||||
}
|
||||
}
|
||||
|
||||
static void find_matches(JanetByteView prefix) {
|
||||
JanetTable *env = gbl_complete_env;
|
||||
gbl_match_count = 0;
|
||||
while (NULL != env) {
|
||||
JanetKV *kvend = env->data + env->capacity;
|
||||
for (JanetKV *kv = env->data; kv < kvend; kv++) {
|
||||
if (!janet_checktype(kv->key, JANET_SYMBOL)) continue;
|
||||
const uint8_t *sym = janet_unwrap_symbol(kv->key);
|
||||
check_match(prefix, sym, janet_string_length(sym));
|
||||
}
|
||||
env = env->proto;
|
||||
}
|
||||
}
|
||||
|
||||
static void kshowdoc(void) {
|
||||
if (!gbl_complete_env) return;
|
||||
while (is_symbol_char_gen(gbl_buf[gbl_pos])) gbl_pos++;
|
||||
JanetByteView prefix = get_symprefix();
|
||||
Janet symbol = janet_symbolv(prefix.bytes, prefix.len);
|
||||
Janet entry = janet_table_get(gbl_complete_env, symbol);
|
||||
if (!janet_checktype(entry, JANET_TABLE)) return;
|
||||
Janet doc = janet_table_get(janet_unwrap_table(entry), janet_ckeywordv("doc"));
|
||||
if (!janet_checktype(doc, JANET_STRING)) return;
|
||||
JanetString docs = janet_unwrap_string(doc);
|
||||
int num_cols = getcols();
|
||||
clearlines();
|
||||
fprintf(stderr, "\n\n\n");
|
||||
gbl_lines_below += 3;
|
||||
resolve_format(janet_unwrap_table(entry));
|
||||
fprintf(stderr, "\n");
|
||||
gbl_lines_below += 1;
|
||||
doc_format(docs, num_cols);
|
||||
fprintf(stderr, "\n\n");
|
||||
gbl_lines_below += 2;
|
||||
/* Go up to original line (zsh-like autocompletion) */
|
||||
fprintf(stderr, "\x1B[%dA", gbl_lines_below);
|
||||
fflush(stderr);
|
||||
}
|
||||
|
||||
static void kshowcomp(void) {
|
||||
JanetTable *env = gbl_complete_env;
|
||||
if (env == NULL) {
|
||||
@@ -528,19 +669,9 @@ static void kshowcomp(void) {
|
||||
gbl_pos++;
|
||||
|
||||
JanetByteView prefix = get_symprefix();
|
||||
if (prefix.len == 0) return;
|
||||
if (prefix.len == 0) return;
|
||||
|
||||
/* Find all matches */
|
||||
gbl_match_count = 0;
|
||||
while (NULL != env) {
|
||||
JanetKV *kvend = env->data + env->capacity;
|
||||
for (JanetKV *kv = env->data; kv < kvend; kv++) {
|
||||
if (!janet_checktype(kv->key, JANET_SYMBOL)) continue;
|
||||
const uint8_t *sym = janet_unwrap_symbol(kv->key);
|
||||
check_match(prefix, sym, janet_string_length(sym));
|
||||
}
|
||||
env = env->proto;
|
||||
}
|
||||
find_matches(prefix);
|
||||
|
||||
check_specials(prefix);
|
||||
|
||||
@@ -633,6 +764,10 @@ static int line() {
|
||||
case 6: /* ctrl-f */
|
||||
kright();
|
||||
break;
|
||||
case 7: /* ctrl-g */
|
||||
kshowdoc();
|
||||
refresh();
|
||||
break;
|
||||
case 127: /* backspace */
|
||||
case 8: /* ctrl-h */
|
||||
kbackspace(1);
|
||||
@@ -876,10 +1011,15 @@ int main(int argc, char **argv) {
|
||||
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) {
|
||||
if (status != JANET_SIGNAL_OK && status != JANET_SIGNAL_EVENT) {
|
||||
janet_stacktrace(fiber, out);
|
||||
}
|
||||
|
||||
#ifdef JANET_NET
|
||||
status = JANET_SIGNAL_OK;
|
||||
janet_loop();
|
||||
#endif
|
||||
|
||||
/* Deinitialize vm */
|
||||
janet_deinit();
|
||||
janet_line_deinit();
|
||||
|
||||
45
test/fuzzers/fuzz_dostring.c
Normal file
45
test/fuzzers/fuzz_dostring.c
Normal file
@@ -0,0 +1,45 @@
|
||||
#include <stdint.h>
|
||||
#include <string.h>
|
||||
#include <janet.h>
|
||||
|
||||
int LLVMFuzzerTestOneInput(const uint8_t *data, size_t size) {
|
||||
|
||||
/* init Janet */
|
||||
janet_init();
|
||||
|
||||
/* fuzz the parser */
|
||||
JanetParser parser;
|
||||
janet_parser_init(&parser);
|
||||
for (int i = 0, done = 0; i < size; i++) {
|
||||
switch (janet_parser_status(&parser)) {
|
||||
case JANET_PARSE_DEAD:
|
||||
case JANET_PARSE_ERROR:
|
||||
done = 1;
|
||||
break;
|
||||
case JANET_PARSE_PENDING:
|
||||
if (i == size) {
|
||||
janet_parser_eof(&parser);
|
||||
} else {
|
||||
janet_parser_consume(&parser, data[i]);
|
||||
}
|
||||
break;
|
||||
case JANET_PARSE_ROOT:
|
||||
if (i >= size) {
|
||||
janet_parser_eof(&parser);
|
||||
} else {
|
||||
janet_parser_consume(&parser, data[i]);
|
||||
}
|
||||
break;
|
||||
}
|
||||
|
||||
if (done == 1)
|
||||
break;
|
||||
}
|
||||
janet_parser_deinit(&parser);
|
||||
|
||||
/* cleanup Janet */
|
||||
janet_deinit();
|
||||
|
||||
return 0;
|
||||
}
|
||||
|
||||
@@ -8,7 +8,8 @@
|
||||
|
||||
(defn assert
|
||||
"Override's the default assert with some nice error handling."
|
||||
[x e]
|
||||
[x &opt e]
|
||||
(default e "assert error")
|
||||
(++ num-tests-run)
|
||||
(when x (++ num-tests-passed))
|
||||
(if x
|
||||
|
||||
1
test/install/.gitignore
vendored
1
test/install/.gitignore
vendored
@@ -1,4 +1,5 @@
|
||||
/build
|
||||
/modpath
|
||||
.cache
|
||||
.manifests
|
||||
json.*
|
||||
|
||||
@@ -206,6 +206,10 @@
|
||||
(def 🐮 :cow)
|
||||
(assert (= (string "🐼" 🦊 🐮) "🐼foxcow") "emojis 🙉 :)")
|
||||
(assert (not= 🦊 "🦊") "utf8 strings are not symbols and vice versa")
|
||||
(assert (= "\U01F637" "😷") "unicode escape 1")
|
||||
(assert (= "\u2623" "\U002623" "☣") "unicode escape 2")
|
||||
(assert (= "\u24c2" "\U0024c2" "Ⓜ") "unicode escape 3")
|
||||
(assert (= "\u0061" "a") "unicode escape 4")
|
||||
|
||||
# Symbols with @ character
|
||||
|
||||
@@ -250,6 +254,11 @@
|
||||
(assert (apply <= (merge @[1 3 5] @[2 4 6 6 6 9])) "merge sort merge 3")
|
||||
(assert (apply <= (merge '(1 3 5) @[2 4 6 6 6 9])) "merge sort merge 4")
|
||||
|
||||
(assert (deep= @[1 2 3 4 5] (sort @[5 3 4 1 2])) "sort 1")
|
||||
(assert (deep= @[{:a 1} {:a 4} {:a 7}] (sort-by |($ :a) @[{:a 4} {:a 7} {:a 1}])) "sort 2")
|
||||
(assert (deep= @[1 2 3 4 5] (sorted [5 3 4 1 2])) "sort 3")
|
||||
(assert (deep= @[{:a 1} {:a 4} {:a 7}] (sorted-by |($ :a) [{:a 4} {:a 7} {:a 1}])) "sort 4")
|
||||
|
||||
# Gensym tests
|
||||
|
||||
(assert (not= (gensym) (gensym)) "two gensyms not equal")
|
||||
@@ -319,5 +328,11 @@
|
||||
(assert (= true ;(map truthy? [0 "" true @{} {} [] '()])) "truthy values")
|
||||
(assert (= false ;(map truthy? [nil false])) "non-truthy values")
|
||||
|
||||
# Struct and Table duplicate elements
|
||||
(assert (= {:a 3 :b 2} {:a 1 :b 2 :a 3}) "struct literal duplicate keys")
|
||||
(assert (= {:a 3 :b 2} (struct :a 1 :b 2 :a 3)) "struct constructor duplicate keys")
|
||||
(assert (deep= @{:a 3 :b 2} @{:a 1 :b 2 :a 3}) "table literal duplicate keys")
|
||||
(assert (deep= @{:a 3 :b 2} (table :a 1 :b 2 :a 3)) "table constructor duplicate keys")
|
||||
|
||||
(end-suite)
|
||||
|
||||
|
||||
@@ -194,4 +194,91 @@
|
||||
(assert (deep= @[] (accumulate2 + [])) "accumulate2 2")
|
||||
(assert (deep= @[] (accumulate 0 + [])) "accumulate 2")
|
||||
|
||||
# Perm strings
|
||||
|
||||
(assert (= (os/perm-int "rwxrwxrwx") 8r777) "perm 1")
|
||||
(assert (= (os/perm-int "rwxr-xr-x") 8r755) "perm 2")
|
||||
(assert (= (os/perm-int "rw-r--r--") 8r644) "perm 3")
|
||||
|
||||
(assert (= (band (os/perm-int "rwxrwxrwx") 8r077) 8r077) "perm 4")
|
||||
(assert (= (band (os/perm-int "rwxr-xr-x") 8r077) 8r055) "perm 5")
|
||||
(assert (= (band (os/perm-int "rw-r--r--") 8r077) 8r044) "perm 6")
|
||||
|
||||
(assert (= (os/perm-string 8r777) "rwxrwxrwx") "perm 7")
|
||||
(assert (= (os/perm-string 8r755) "rwxr-xr-x") "perm 8")
|
||||
(assert (= (os/perm-string 8r644) "rw-r--r--") "perm 9")
|
||||
|
||||
# Issue #336 cases - don't segfault
|
||||
|
||||
(assert-error "unmarshal errors 1" (unmarshal @"\xd6\xb9\xb9"))
|
||||
(assert-error "unmarshal errors 2" (unmarshal @"\xd7bc"))
|
||||
(assert-error "unmarshal errors 3" (unmarshal "\xd3\x01\xd9\x01\x62\xcf\x03\x78\x79\x7a" load-image-dict))
|
||||
(assert-error "unmarshal errors 4"
|
||||
(unmarshal
|
||||
@"\xD7\xCD\0e/p\x98\0\0\x03\x01\x01\x01\x02\0\0\x04\0\xCEe/p../tools
|
||||
\0\0\0/afl\0\0\x01\0erate\xDE\xDE\xDE\xDE\xDE\xDE\xDE\xDE\xDE\xDE
|
||||
\xA8\xDE\xDE\xDE\xDE\xDE\xDE\0\0\0\xDE\xDE_unmarshal_testcase3.ja
|
||||
neldb\0\0\0\xD8\x05printG\x01\0\xDE\xDE\xDE'\x03\0marshal_tes/\x02
|
||||
\0\0\0\0\0*\xFE\x01\04\x02\0\0'\x03\0\r\0\r\0\r\0\r" load-image-dict))
|
||||
|
||||
# No segfault, valgrind clean.
|
||||
|
||||
(def x @"\xCC\xCD.nd\x80\0\r\x1C\xCDg!\0\x07\xCC\xCD\r\x1Ce\x10\0\r;\xCDb\x04\xFF9\xFF\x80\x04\x04\x04\x04\x04\x04\x04\x04\x04\x04\x04uu\x04\x04\x04\x04\x04\x04\x04\x04\x04\x04\x04\x04\x04\x04\0\x04\x04\x04\x04\x04\x04\x04\x04\x04\x04\x04\x04\x04\x04\x04\x04\x04\x04}\x04\x04\x04\x04\x04\x04\x04\x04#\x04\x04\x04\x04\x04\x04\x04\x04\x04\x04\x04\0\x01\0\0\x03\x04\x04\x04\xE2\x03\x04\x04\x04\x04\x04\x04\x04\x04\x04\x14\x1A\x04\x04\x04\x04\x04\x18\x04\x04!\x04\xE2\x03\x04\x04\x04\x04\x04\x04$\x04\x04\x04\x04\x04\x04\x04\x04\x04\x80\x04\x04\x04\x04\x04\x04\x04\x04\x04\x04\x04\x04\x04A\0\0\0\x03\0\0!\xBF\xFF")
|
||||
(unmarshal x load-image-dict)
|
||||
(gccollect)
|
||||
(marshal x make-image-dict)
|
||||
|
||||
(def b @"\xCC\xCD\0\x03\0\x08\x04\rm\xCD\x7F\xFF\xFF\xFF\x02\0\x02\xD7\xCD\0\x98\0\0\x05\x01\x01\x01\x01\x08\xCE\x01f\xCE../tools/afl/generate_unmarshal_testcases.janet\xCE\x012,\x01\0\0&\x03\0\06\x02\x03\x03)\x03\x01\0*\x04\0\00\x03\x04\0>\x03\0\0\x03\x03\0\0*\x05\0\x11\0\x11\0\x05\0\x05\0\x05\0\x05\0\x05\xC9\xDA\x04\xC9\xC9\xC9")
|
||||
(unmarshal b load-image-dict)
|
||||
(gccollect)
|
||||
|
||||
(def v (unmarshal
|
||||
@"\xD7\xCD0\xD4000000\0\x03\x01\xCE\00\0\x01\0\0000\x03\0\0\0000000000\xCC0\0000"
|
||||
load-image-dict))
|
||||
(gccollect)
|
||||
|
||||
# in vs get regression
|
||||
(assert (nil? (first @"")) "in vs get 1")
|
||||
(assert (nil? (last @"")) "in vs get 1")
|
||||
|
||||
# For undefined behavior sanitizer
|
||||
0xf&1fffFFFF
|
||||
|
||||
# Tuple comparison
|
||||
(assert (< [1 2 3] [2 2 3]) "tuple comparison 1")
|
||||
(assert (< [1 2 3] [2 2]) "tuple comparison 2")
|
||||
(assert (< [1 2 3] [2 2 3 4]) "tuple comparison 3")
|
||||
(assert (< [1 2 3] [1 2 3 4]) "tuple comparison 4")
|
||||
(assert (< [1 2 3] [1 2 3 -1]) "tuple comparison 5")
|
||||
(assert (> [1 2 3] [1 2]) "tuple comparison 6")
|
||||
|
||||
# Lenprefix rule
|
||||
|
||||
(def peg (peg/compile ~(* (lenprefix (/ (* '(any (if-not ":" 1)) ":") ,scan-number) 1) -1)))
|
||||
|
||||
(assert (peg/match peg "5:abcde") "lenprefix 1")
|
||||
(assert (not (peg/match peg "5:abcdef")) "lenprefix 2")
|
||||
(assert (not (peg/match peg "5:abcd")) "lenprefix 3")
|
||||
|
||||
# Packet capture
|
||||
|
||||
(def peg2
|
||||
(peg/compile
|
||||
~{# capture packet length in tag :header-len
|
||||
:packet-header (* (/ ':d+ ,scan-number :header-len) ":")
|
||||
|
||||
# capture n bytes from a backref :header-len
|
||||
:packet-body '(lenprefix (-> :header-len) 1)
|
||||
|
||||
# header, followed by body, and drop the :header-len capture
|
||||
:packet (/ (* :packet-header :packet-body) ,|$1)
|
||||
|
||||
# any exact seqence of packets (no extra characters)
|
||||
:main (* (any :packet) -1)}))
|
||||
|
||||
(assert (deep= @["a" "bb" "ccc"] (peg/match peg2 "1:a2:bb3:ccc")) "lenprefix 4")
|
||||
(assert (deep= @["a" "bb" "cccccc"] (peg/match peg2 "1:a2:bb6:cccccc")) "lenprefix 5")
|
||||
(assert (= nil (peg/match peg2 "1:a2:bb:5:cccccc")) "lenprefix 6")
|
||||
(assert (= nil (peg/match peg2 "1:a2:bb:7:cccccc")) "lenprefix 7")
|
||||
|
||||
(end-suite)
|
||||
|
||||
51
test/suite9.janet
Normal file
51
test/suite9.janet
Normal file
@@ -0,0 +1,51 @@
|
||||
# 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 9)
|
||||
|
||||
# Net testing
|
||||
|
||||
(defn handler
|
||||
"Simple handler for connections."
|
||||
[stream]
|
||||
(defer (:close stream)
|
||||
(def id (gensym))
|
||||
(def b @"")
|
||||
(:read stream 1024 b)
|
||||
(:write stream b)
|
||||
(buffer/clear b)))
|
||||
|
||||
(def s (net/server "127.0.0.1" "8000" handler))
|
||||
(assert s "made server 1")
|
||||
|
||||
(defn test-echo [msg]
|
||||
(with [conn (net/connect "127.0.0.1" "8000")]
|
||||
(:write conn msg)
|
||||
(def res (:read conn 1024))
|
||||
(assert (= (string res) msg) (string "echo " msg))))
|
||||
|
||||
(test-echo "hello")
|
||||
(test-echo "world")
|
||||
(test-echo (string/repeat "abcd" 200))
|
||||
|
||||
(:close s)
|
||||
|
||||
(end-suite)
|
||||
@@ -3,12 +3,26 @@
|
||||
To use these, you need to install afl (of course), and xterm. A tiling window manager helps manage
|
||||
many concurrent fuzzer instances.
|
||||
|
||||
Note, afl sometimes requires system configuration, if you find AFL quitting prematurely, try manually
|
||||
launching it and addressing any error messages.
|
||||
|
||||
## Fuzz the parser
|
||||
```
|
||||
$ sh ./tools/afl/prepare_to_fuzz.sh
|
||||
export NFUZZ=1
|
||||
$ export NFUZZ=1
|
||||
$ sh ./tools/afl/fuzz.sh parser
|
||||
Ctrl+C when done to close all fuzzer terminals.
|
||||
$ sh ./tools/afl/aggregate_cases.sh parser
|
||||
$ ls ./fuzz_out/parser_aggregated/
|
||||
```
|
||||
```
|
||||
|
||||
## Fuzz the unmarshaller
|
||||
```
|
||||
$ janet ./tools/afl/generate_unmarshal_testcases.janet
|
||||
$ sh ./tools/afl/prepare_to_fuzz.sh
|
||||
$ export NFUZZ=1
|
||||
$ sh ./tools/afl/fuzz.sh unmarshal
|
||||
Ctrl+C when done to close all fuzzer terminals.
|
||||
$ sh ./tools/afl/aggregate_cases.sh unmarshal
|
||||
$ ls ./fuzz_out/unmarshal_aggregated/
|
||||
```
|
||||
|
||||
49
tools/afl/generate_unmarshal_testcases.janet
Normal file
49
tools/afl/generate_unmarshal_testcases.janet
Normal file
@@ -0,0 +1,49 @@
|
||||
|
||||
(os/mkdir "./tools/afl/unmarshal_testcases/")
|
||||
|
||||
(defn spit-case [n v]
|
||||
(spit
|
||||
(string "./tools/afl/unmarshal_testcases/" (string n))
|
||||
(marshal v make-image-dict)))
|
||||
|
||||
(def cases [
|
||||
nil
|
||||
|
||||
"abc"
|
||||
|
||||
:def
|
||||
|
||||
'hij
|
||||
|
||||
123
|
||||
|
||||
(int/s64 123)
|
||||
|
||||
"7"
|
||||
|
||||
[1 2 3]
|
||||
|
||||
@[1 2 3]
|
||||
|
||||
{:a 123}
|
||||
|
||||
@{:b 'xyz}
|
||||
|
||||
(peg/compile
|
||||
'{:a (* "a" :b "a")
|
||||
:b (* "b" (+ :a 0) "b")
|
||||
:main (* "(" :b ")")})
|
||||
|
||||
(fn f [a] (fn [] {:ab a}))
|
||||
|
||||
(fn f [a] (print "hello world!"))
|
||||
|
||||
(do
|
||||
(defn f [a] (yield) @[1 "2"])
|
||||
(def fb (fiber/new f))
|
||||
(resume fb)
|
||||
fb)
|
||||
])
|
||||
|
||||
(eachk i cases
|
||||
(spit-case i (in cases i)))
|
||||
6
tools/afl/unmarshal_runner.janet
Normal file
6
tools/afl/unmarshal_runner.janet
Normal file
@@ -0,0 +1,6 @@
|
||||
# Unmarshal garbage.
|
||||
(def v (unmarshal (slurp ((dyn :args) 1)) load-image-dict))
|
||||
# Trigger leaks or use after free.
|
||||
(gccollect)
|
||||
# Attempt to use generated value.
|
||||
(marshal v make-image-dict)
|
||||
@@ -308,7 +308,7 @@
|
||||
<array>
|
||||
<dict>
|
||||
<key>match</key>
|
||||
<string>(\\[nevr0zft"\\']|\\x[0-9a-fA-F][0-9a-fA-f])</string>
|
||||
<string>(\\[nevr0zft"\\']|\\x[0-9a-fA-F]{2}|\\u[0-9a-fA-F]{4}|\\U[0-9a-fA-F]{6})</string>
|
||||
<key>name</key>
|
||||
<string>constant.character.escape.janet</string>
|
||||
</dict>
|
||||
|
||||
Reference in New Issue
Block a user