mirror of
https://github.com/janet-lang/janet
synced 2025-10-29 06:37:41 +00:00
Compare commits
78 Commits
localbindi
...
v1.28.0
| Author | SHA1 | Date | |
|---|---|---|---|
|
|
358f5a03bf | ||
|
|
fba1fdabe4 | ||
|
|
d42afd21e5 | ||
|
|
20ada86761 | ||
|
|
3b353f1855 | ||
|
|
1467ab4f93 | ||
|
|
7e65c2bdad | ||
|
|
84a4e3e98a | ||
|
|
bcbeedb001 | ||
|
|
e04b103b5d | ||
|
|
ac75b94679 | ||
|
|
d3bb06cfd6 | ||
|
|
5cd729c4c1 | ||
|
|
c9fd2bdf39 | ||
|
|
e4be5992b3 | ||
|
|
2ac4988f1b | ||
|
|
19f14adb9e | ||
|
|
86de039492 | ||
|
|
2360164e4f | ||
|
|
c93ddceadb | ||
|
|
cd19dec44a | ||
|
|
53ba9c800a | ||
|
|
cabbaded68 | ||
|
|
9bb589f827 | ||
|
|
c3a06686c2 | ||
|
|
7d57f87007 | ||
|
|
4cc4a9d38b | ||
|
|
02c7cd0194 | ||
|
|
696efcb9e2 | ||
|
|
6e9cde8ac1 | ||
|
|
a9fae49671 | ||
|
|
440af9fd64 | ||
|
|
347721ae40 | ||
|
|
daea91044c | ||
|
|
4ed3f2c662 | ||
|
|
3641c8f60a | ||
|
|
e4b68cd940 | ||
|
|
b8c936e2fe | ||
|
|
83cd519702 | ||
|
|
54b54f85f3 | ||
|
|
ccd874fe4e | ||
|
|
9dc7e8ed3a | ||
|
|
485099fd6e | ||
|
|
d359c6b43e | ||
|
|
d9ed7a77f8 | ||
|
|
4238a4ca6a | ||
|
|
0902a5a981 | ||
|
|
f3192303ab | ||
|
|
bef5bd72c2 | ||
|
|
b6175e4296 | ||
|
|
3858b2e177 | ||
|
|
9a76e77981 | ||
|
|
8182d640cd | ||
|
|
1c6fda1a5c | ||
|
|
c51db1cf2f | ||
|
|
4e7930fc4c | ||
|
|
3563f8ccdb | ||
|
|
575af763f6 | ||
|
|
8b16b9b246 | ||
|
|
01aab66667 | ||
|
|
aa5c987a94 | ||
|
|
75229332c8 | ||
|
|
9d5b1ba838 | ||
|
|
f27b225b34 | ||
|
|
3c523d66e9 | ||
|
|
1144c27c54 | ||
|
|
b442b21d3f | ||
|
|
746ff5307d | ||
|
|
ef85b24d8f | ||
|
|
c55d93512b | ||
|
|
2e38f9ba61 | ||
|
|
1cadff8e58 | ||
|
|
d1eba60ba8 | ||
|
|
057dccad8f | ||
|
|
4285200b4b | ||
|
|
73c2fbbc2a | ||
|
|
37b7e170fa | ||
|
|
b032d94877 |
31
CHANGELOG.md
31
CHANGELOG.md
@@ -1,8 +1,35 @@
|
||||
# Changelog
|
||||
All notable changes to this project will be documented in this file.
|
||||
|
||||
## ??? - Unreleased
|
||||
- Add build-time detection for cygwin.
|
||||
## 1.28.0 - 2023-05-13
|
||||
- Various bug fixes
|
||||
- Make nested short-fn's behave a bit more predictably (it is still not recommended to nest short-fns).
|
||||
- Add `os/strftime` for date formatting.
|
||||
- Fix `ev/select` on threaded channels sometimes live-locking.
|
||||
- Support the `NO_COLOR` environment variable to turn off VT100 color codes in repl (and in scripts).
|
||||
See http://no-color.org/
|
||||
- Disallow using `(splice x)` in contexts where it doesn't make sense rather than silently coercing to `x`.
|
||||
Instead, raise a compiler error.
|
||||
- Change the names of `:user8` and `:user9` sigals to `:interrupt` and `:await`
|
||||
- Change the names of `:user8` and `:user9` fiber statuses to `:interrupted` and `:suspended`.
|
||||
- Add `ev/all-tasks` to see all currently suspended fibers.
|
||||
- Add `keep-syntax` and `keep-syntax!` functions to make writing macros easier.
|
||||
|
||||
## 1.27.0 - 2023-03-05
|
||||
- Change semantics around bracket tuples to no longer be equal to regular tuples.
|
||||
- Add `index` argument to `ffi/write` for symmetry with `ffi/read`.
|
||||
- Add `buffer/push-at`
|
||||
- Add `ffi/pointer-buffer` to convert pointers to buffers the cannot be reallocated. This
|
||||
allows easier manipulation of FFI memory, memory mapped files, and buffer memory shared between threads.
|
||||
- Calling `ev/cancel` on a fiber waiting on `ev/gather` will correctly
|
||||
cancel the child fibers.
|
||||
- Add `(sandbox ...)` function to core for permission based security. Also add `janet_sandbox` to C API.
|
||||
The sandbox allows limiting access to the file system, network, ffi, and OS resources at runtime.
|
||||
- Add `(.locals)` function to debugger to see currently bound local symbols.
|
||||
- Track symbol -> slot mapping so debugger can get symbolic information. This exposes local bindings
|
||||
in `debug/stack` and `disasm`.
|
||||
- Add `os/compiler` to detect what host compiler was used to compile the interpreter
|
||||
- Add support for mingw and cygwin builds (mingw support also added in jpm).
|
||||
|
||||
## 1.26.0 - 2023-01-07
|
||||
- Add `ffi/malloc` and `ffi/free`. Useful as tools of last resort.
|
||||
|
||||
32
Makefile
32
Makefile
@@ -31,6 +31,7 @@ LIBDIR?=$(PREFIX)/lib
|
||||
JANET_BUILD?="\"$(shell git log --pretty=format:'%h' -n 1 2> /dev/null || echo local)\""
|
||||
CLIBS=-lm -lpthread
|
||||
JANET_TARGET=build/janet
|
||||
JANET_BOOT=build/janet_boot
|
||||
JANET_IMPORT_LIB=build/janet.lib
|
||||
JANET_LIBRARY=build/libjanet.so
|
||||
JANET_STATIC_LIBRARY=build/libjanet.a
|
||||
@@ -47,6 +48,7 @@ HOSTCC?=$(CC)
|
||||
HOSTAR?=$(AR)
|
||||
CFLAGS?=-O2
|
||||
LDFLAGS?=-rdynamic
|
||||
RUN:=$(RUN)
|
||||
|
||||
COMMON_CFLAGS:=-std=c99 -Wall -Wextra -Isrc/include -Isrc/conf -fvisibility=hidden -fPIC
|
||||
BOOT_CFLAGS:=-DJANET_BOOTSTRAP -DJANET_BUILD=$(JANET_BUILD) -O0 -g $(COMMON_CFLAGS)
|
||||
@@ -56,7 +58,7 @@ BUILD_CFLAGS:=$(CFLAGS) $(COMMON_CFLAGS)
|
||||
LDCONFIG:=ldconfig "$(LIBDIR)"
|
||||
|
||||
# Check OS
|
||||
UNAME:=$(shell uname -s)
|
||||
UNAME?=$(shell uname -s)
|
||||
ifeq ($(UNAME), Darwin)
|
||||
CLIBS:=$(CLIBS) -ldl
|
||||
SONAME_SETTER:=-Wl,-install_name,
|
||||
@@ -82,6 +84,8 @@ endif
|
||||
ifeq ($(findstring MINGW,$(UNAME)), MINGW)
|
||||
CLIBS:=-lws2_32 -lpsapi -lwsock32
|
||||
LDFLAGS:=-Wl,--out-implib,$(JANET_IMPORT_LIB)
|
||||
JANET_TARGET:=$(JANET_TARGET).exe
|
||||
JANET_BOOT:=$(JANET_BOOT).exe
|
||||
endif
|
||||
|
||||
$(shell mkdir -p build/core build/c build/boot)
|
||||
@@ -163,12 +167,12 @@ $(JANET_BOOT_OBJECTS): $(JANET_BOOT_HEADERS)
|
||||
build/%.boot.o: src/%.c $(JANET_HEADERS) $(JANET_LOCAL_HEADERS) Makefile
|
||||
$(CC) $(BOOT_CFLAGS) -o $@ -c $<
|
||||
|
||||
build/janet_boot: $(JANET_BOOT_OBJECTS)
|
||||
$(JANET_BOOT): $(JANET_BOOT_OBJECTS)
|
||||
$(CC) $(BOOT_CFLAGS) -o $@ $(JANET_BOOT_OBJECTS) $(CLIBS)
|
||||
|
||||
# Now the reason we bootstrap in the first place
|
||||
build/c/janet.c: build/janet_boot src/boot/boot.janet
|
||||
build/janet_boot . JANET_PATH '$(JANET_PATH)' > $@
|
||||
build/c/janet.c: $(JANET_BOOT) src/boot/boot.janet
|
||||
$(RUN) $(JANET_BOOT) . JANET_PATH '$(JANET_PATH)' > $@
|
||||
cksum $@
|
||||
|
||||
########################
|
||||
@@ -176,16 +180,16 @@ build/c/janet.c: build/janet_boot src/boot/boot.janet
|
||||
########################
|
||||
|
||||
ifeq ($(UNAME), Darwin)
|
||||
SONAME=libjanet.1.26.dylib
|
||||
SONAME=libjanet.1.28.dylib
|
||||
else
|
||||
SONAME=libjanet.so.1.26
|
||||
SONAME=libjanet.so.1.28
|
||||
endif
|
||||
|
||||
build/c/shell.c: src/mainclient/shell.c
|
||||
cp $< $@
|
||||
|
||||
build/janet.h: $(JANET_TARGET) src/include/janet.h $(JANETCONF_HEADER)
|
||||
./$(JANET_TARGET) tools/patch-header.janet src/include/janet.h $(JANETCONF_HEADER) $@
|
||||
$(RUN) ./$(JANET_TARGET) tools/patch-header.janet src/include/janet.h $(JANETCONF_HEADER) $@
|
||||
|
||||
build/janetconf.h: $(JANETCONF_HEADER)
|
||||
cp $< $@
|
||||
@@ -214,7 +218,7 @@ $(JANET_STATIC_LIBRARY): build/janet.o build/shell.o
|
||||
TEST_SCRIPTS=$(wildcard test/suite*.janet)
|
||||
|
||||
repl: $(JANET_TARGET)
|
||||
./$(JANET_TARGET)
|
||||
$(RUN) ./$(JANET_TARGET)
|
||||
|
||||
debug: $(JANET_TARGET)
|
||||
$(DEBUGGER) ./$(JANET_TARGET)
|
||||
@@ -225,8 +229,8 @@ valgrind: $(JANET_TARGET)
|
||||
$(VALGRIND_COMMAND) ./$(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
|
||||
for f in test/suite*.janet; do $(RUN) ./$(JANET_TARGET) "$$f" || exit; done
|
||||
for f in examples/*.janet; do $(RUN) ./$(JANET_TARGET) -k "$$f"; done
|
||||
|
||||
valtest: $(JANET_TARGET) $(TEST_PROGRAMS)
|
||||
for f in test/suite*.janet; do $(VALGRIND_COMMAND) ./$(JANET_TARGET) "$$f" || exit; done
|
||||
@@ -265,7 +269,7 @@ build/janet-%.tar.gz: $(JANET_TARGET) \
|
||||
docs: build/doc.html
|
||||
|
||||
build/doc.html: $(JANET_TARGET) tools/gendoc.janet
|
||||
$(JANET_TARGET) tools/gendoc.janet > build/doc.html
|
||||
$(RUN) $(JANET_TARGET) tools/gendoc.janet > build/doc.html
|
||||
|
||||
########################
|
||||
##### Installation #####
|
||||
@@ -281,7 +285,7 @@ build/janet.pc: $(JANET_TARGET)
|
||||
echo "Name: janet" >> $@
|
||||
echo "Url: https://janet-lang.org" >> $@
|
||||
echo "Description: Library for the Janet programming language." >> $@
|
||||
$(JANET_TARGET) -e '(print "Version: " janet/version)' >> $@
|
||||
$(RUN) $(JANET_TARGET) -e '(print "Version: " janet/version)' >> $@
|
||||
echo 'Cflags: -I$${includedir}' >> $@
|
||||
echo 'Libs: -L$${libdir} -ljanet' >> $@
|
||||
echo 'Libs.private: $(CLIBS)' >> $@
|
||||
@@ -321,7 +325,7 @@ install-jpm-git: $(JANET_TARGET)
|
||||
JANET_HEADERPATH='$(INCLUDEDIR)/janet' \
|
||||
JANET_BINPATH='$(BINDIR)' \
|
||||
JANET_LIBPATH='$(LIBDIR)' \
|
||||
../../$(JANET_TARGET) ./bootstrap.janet
|
||||
$(RUN) ../../$(JANET_TARGET) ./bootstrap.janet
|
||||
|
||||
uninstall:
|
||||
-rm '$(DESTDIR)$(BINDIR)/janet'
|
||||
@@ -341,7 +345,7 @@ format:
|
||||
|
||||
grammar: build/janet.tmLanguage
|
||||
build/janet.tmLanguage: tools/tm_lang_gen.janet $(JANET_TARGET)
|
||||
$(JANET_TARGET) $< > $@
|
||||
$(RUN) $(JANET_TARGET) $< > $@
|
||||
|
||||
compile-commands:
|
||||
# Requires pip install copmiledb
|
||||
|
||||
83
README.md
83
README.md
@@ -7,14 +7,14 @@
|
||||
<img src="https://raw.githubusercontent.com/janet-lang/janet/master/assets/janet-w200.png" alt="Janet logo" width=200 align="left">
|
||||
|
||||
**Janet** is a functional and imperative programming language and bytecode interpreter. It is a
|
||||
lisp-like language, but lists are replaced
|
||||
Lisp-like language, but lists are replaced
|
||||
by other data structures (arrays, tables (hash table), struct (immutable hash table), tuples).
|
||||
The language also supports bridging to native code written in C, meta-programming with macros, and bytecode assembly.
|
||||
|
||||
There is a REPL for trying out the language, as well as the ability
|
||||
to run script files. This client program is separate from the core runtime, so
|
||||
Janet can be embedded in other programs. Try Janet in your browser at
|
||||
[https://janet-lang.org](https://janet-lang.org).
|
||||
<https://janet-lang.org>.
|
||||
|
||||
If you'd like to financially support the ongoing development of Janet, consider
|
||||
[sponsoring its primary author](https://github.com/sponsors/bakpakin) through GitHub.
|
||||
@@ -41,8 +41,8 @@ Lua, but smaller than GNU Guile or Python.
|
||||
* Macros
|
||||
* Multithreading
|
||||
* Per-thread event loop for efficient evented IO
|
||||
* Byte code interpreter with an assembly interface, as well as bytecode verification
|
||||
* Tail call Optimization
|
||||
* Bytecode interpreter with an assembly interface, as well as bytecode verification
|
||||
* Tail-call optimization
|
||||
* Direct interop with C via abstract types and C functions
|
||||
* Dynamically load C libraries
|
||||
* Functional and imperative standard library
|
||||
@@ -57,7 +57,7 @@ Lua, but smaller than GNU Guile or Python.
|
||||
## Documentation
|
||||
|
||||
* For a quick tutorial, see [the introduction](https://janet-lang.org/docs/index.html) for more details.
|
||||
* For the full API for all functions in the core library, see [the core API doc](https://janet-lang.org/api/index.html)
|
||||
* For the full API for all functions in the core library, see [the core API doc](https://janet-lang.org/api/index.html).
|
||||
|
||||
Documentation is also available locally in the REPL.
|
||||
Use the `(doc symbol-name)` macro to get API
|
||||
@@ -65,7 +65,7 @@ documentation for symbols in the core library. For example,
|
||||
```
|
||||
(doc apply)
|
||||
```
|
||||
Shows documentation for the `apply` function.
|
||||
shows documentation for the `apply` function.
|
||||
|
||||
To get a list of all bindings in the default
|
||||
environment, use the `(all-bindings)` function. You
|
||||
@@ -84,7 +84,7 @@ the SourceHut mirror is actively maintained.
|
||||
|
||||
The Makefile is non-portable and requires GNU-flavored make.
|
||||
|
||||
```
|
||||
```sh
|
||||
cd somewhere/my/projects/janet
|
||||
make
|
||||
make test
|
||||
@@ -100,7 +100,7 @@ Find out more about the available make targets by running `make help`.
|
||||
32-bit Haiku build instructions are the same as the UNIX-like build instructions,
|
||||
but you need to specify an alternative compiler, such as `gcc-x86`.
|
||||
|
||||
```
|
||||
```sh
|
||||
cd somewhere/my/projects/janet
|
||||
make CC=gcc-x86
|
||||
make test
|
||||
@@ -112,10 +112,9 @@ make install-jpm-git
|
||||
### FreeBSD
|
||||
|
||||
FreeBSD build instructions are the same as the UNIX-like build instructions,
|
||||
but you need `gmake` to compile. Alternatively, install directly from
|
||||
packages, using `pkg install lang/janet`.
|
||||
but you need `gmake` to compile. Alternatively, install the package directly with `pkg install lang/janet`.
|
||||
|
||||
```
|
||||
```sh
|
||||
cd somewhere/my/projects/janet
|
||||
gmake
|
||||
gmake test
|
||||
@@ -127,19 +126,19 @@ gmake install-jpm-git
|
||||
### NetBSD
|
||||
|
||||
NetBSD build instructions are the same as the FreeBSD build instructions.
|
||||
Alternatively, install directly from packages, using `pkgin install janet`.
|
||||
Alternatively, install the package directly with `pkgin install janet`.
|
||||
|
||||
### Windows
|
||||
|
||||
1. Install [Visual Studio](https://visualstudio.microsoft.com/thank-you-downloading-visual-studio/?sku=Community&rel=15#) or [Visual Studio Build Tools](https://visualstudio.microsoft.com/thank-you-downloading-visual-studio/?sku=BuildTools&rel=15#)
|
||||
2. Run a Visual Studio Command Prompt (cl.exe and link.exe need to be on the PATH) and cd to the directory with janet.
|
||||
3. Run `build_win` to compile janet.
|
||||
1. Install [Visual Studio](https://visualstudio.microsoft.com/thank-you-downloading-visual-studio/?sku=Community&rel=15#) or [Visual Studio Build Tools](https://visualstudio.microsoft.com/thank-you-downloading-visual-studio/?sku=BuildTools&rel=15#).
|
||||
2. Run a Visual Studio Command Prompt (`cl.exe` and `link.exe` need to be on your PATH) and `cd` to the directory with Janet.
|
||||
3. Run `build_win` to compile Janet.
|
||||
4. Run `build_win test` to make sure everything is working.
|
||||
|
||||
To build an `.msi` installer executable, in addition to the above steps, you will have to:
|
||||
|
||||
5. Install, or otherwise add to your PATH the [WiX 3.11 Toolset](https://github.com/wixtoolset/wix3/releases)
|
||||
6. run `build_win dist`
|
||||
5. Install, or otherwise add to your PATH the [WiX 3.11 Toolset](https://github.com/wixtoolset/wix3/releases).
|
||||
6. Run `build_win dist`.
|
||||
|
||||
Now you should have an `.msi`. You can run `build_win install` to install the `.msi`, or execute the file itself.
|
||||
|
||||
@@ -175,9 +174,9 @@ ninja -C build install
|
||||
|
||||
Janet can be hacked on with pretty much any environment you like, but for IDE
|
||||
lovers, [Gnome Builder](https://wiki.gnome.org/Apps/Builder) is probably the
|
||||
best option, as it has excellent meson integration. It also offers code completion
|
||||
best option, as it has excellent Meson integration. It also offers code completion
|
||||
for Janet's C API right out of the box, which is very useful for exploring. VSCode, Vim,
|
||||
Emacs, and Atom will have syntax packages for the Janet language, though.
|
||||
Emacs, and Atom each have syntax packages for the Janet language, though.
|
||||
|
||||
## Installation
|
||||
|
||||
@@ -186,8 +185,8 @@ to try out the language, you don't need to install anything. You can also move t
|
||||
|
||||
## Usage
|
||||
|
||||
A REPL is launched when the binary is invoked with no arguments. Pass the -h flag
|
||||
to display the usage information. Individual scripts can be run with `./janet myscript.janet`
|
||||
A REPL is launched when the binary is invoked with no arguments. Pass the `-h` flag
|
||||
to display the usage information. Individual scripts can be run with `./janet myscript.janet`.
|
||||
|
||||
If you are looking to explore, you can print a list of all available macros, functions, and constants
|
||||
by entering the command `(all-bindings)` into the REPL.
|
||||
@@ -202,20 +201,26 @@ Hello, World!
|
||||
nil
|
||||
janet:3:> (os/exit)
|
||||
$ janet -h
|
||||
usage: build/janet [options] script args...
|
||||
usage: janet [options] script args...
|
||||
Options are:
|
||||
-h : Show this help
|
||||
-v : Print the version string
|
||||
-s : Use raw stdin instead of getline like functionality
|
||||
-e code : Execute a string of janet
|
||||
-E code arguments... : Evaluate an expression as a short-fn with arguments
|
||||
-d : Set the debug flag in the REPL
|
||||
-r : Enter the REPL after running all scripts
|
||||
-R : Disables loading profile.janet when JANET_PROFILE is present
|
||||
-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
|
||||
-i : Load the script argument as an image file instead of source code
|
||||
-n : Disable ANSI color output in the REPL
|
||||
-l path : Execute code in a file before running the main script
|
||||
-l lib : Use a module before processing more arguments
|
||||
-w level : Set the lint warning level - default is "normal"
|
||||
-x level : Set the lint error level - default is "none"
|
||||
-- : Stop handling options
|
||||
```
|
||||
|
||||
@@ -226,8 +231,8 @@ If installed, you can also run `man janet` to get usage information.
|
||||
Janet can be embedded in a host program very easily. The normal build
|
||||
will create a file `build/janet.c`, which is a single C file
|
||||
that contains all the source to Janet. This file, along with
|
||||
`src/include/janet.h` and `src/conf/janetconf.h` can be dragged into any C
|
||||
project and compiled into the project. Janet should be compiled with `-std=c99`
|
||||
`src/include/janet.h` and `src/conf/janetconf.h`, can be dragged into any C
|
||||
project and compiled into it. Janet should be compiled with `-std=c99`
|
||||
on most compilers, and will need to be linked to the math library, `-lm`, and
|
||||
the dynamic linker, `-ldl`, if one wants to be able to load dynamic modules. If
|
||||
there is no need for dynamic modules, add the define
|
||||
@@ -237,24 +242,24 @@ See the [Embedding Section](https://janet-lang.org/capi/embedding.html) on the w
|
||||
|
||||
## Examples
|
||||
|
||||
See the examples directory for some example janet code.
|
||||
See the examples directory for some example Janet code.
|
||||
|
||||
## Discussion
|
||||
|
||||
Feel free to ask questions and join the discussion on the [Janet Gitter Channel](https://gitter.im/janet-language/community).
|
||||
Gitter provides Matrix and irc bridges as well.
|
||||
Feel free to ask questions and join the discussion on the [Janet Gitter channel](https://gitter.im/janet-language/community).
|
||||
Gitter provides Matrix and IRC bridges as well.
|
||||
|
||||
## FAQ
|
||||
|
||||
### Where is (favorite feature from other language)?
|
||||
|
||||
It may exist, it may not. If you want to propose major language features, go ahead and open an issue, but
|
||||
they will likely by closed as "will not implement". Often, such features make one usecase simpler at the expense
|
||||
It may exist, it may not. If you want to propose a major language feature, go ahead and open an issue, but
|
||||
it will likely be closed as "will not implement". Often, such features make one usecase simpler at the expense
|
||||
of 5 others by making the language more complicated.
|
||||
|
||||
### Is there a language spec?
|
||||
|
||||
There is not currently a spec besides the documentation at https://janet-lang.org.
|
||||
There is not currently a spec besides the documentation at <https://janet-lang.org>.
|
||||
|
||||
### Is this Scheme/Common Lisp? Where are the cons cells?
|
||||
|
||||
@@ -270,13 +275,13 @@ Internally, Janet is not at all like Clojure.
|
||||
No. They are immutable arrays and hash tables. Don't try and use them like Clojure's vectors
|
||||
and maps, instead they work well as table keys or other identifiers.
|
||||
|
||||
### Can I do Object Oriented programming with Janet?
|
||||
### Can I do object-oriented programming with Janet?
|
||||
|
||||
To some extent, yes. However, it is not the recommended method of abstraction, and performance may suffer.
|
||||
That said, tables can be used to make mutable objects with inheritance and polymorphism, where object
|
||||
methods are implemeted with keywords.
|
||||
methods are implemented with keywords.
|
||||
|
||||
```
|
||||
```clj
|
||||
(def Car @{:honk (fn [self msg] (print "car " self " goes " msg)) })
|
||||
(def my-car (table/setproto @{} Car))
|
||||
(:honk my-car "Beep!")
|
||||
@@ -287,9 +292,9 @@ methods are implemeted with keywords.
|
||||
Usually, one of a few reasons:
|
||||
- Often, it already exists in a different form and the Clojure port would be redundant.
|
||||
- Clojure programs often generate a lot of garbage and rely on the JVM to clean it up.
|
||||
Janet does not run on the JVM, and has a more primitive garbage collector.
|
||||
- We want to keep the Janet core small. With Lisps, usually a feature can be added as a library
|
||||
without feeling "bolted on", especially when compared to ALGOL like languages. Adding features
|
||||
Janet does not run on the JVM and has a more primitive garbage collector.
|
||||
- We want to keep the Janet core small. With Lisps, a feature can usually be added as a library
|
||||
without feeling "bolted on", especially when compared to ALGOL-like languages. Adding features
|
||||
to the core also makes it a bit more difficult to keep Janet maximally portable.
|
||||
|
||||
### Why is my terminal spitting out junk when I run the REPL?
|
||||
@@ -297,7 +302,7 @@ Usually, one of a few reasons:
|
||||
Make sure your terminal supports ANSI escape codes. Most modern terminals will
|
||||
support these, but some older terminals, Windows consoles, or embedded terminals
|
||||
will not. If your terminal does not support ANSI escape codes, run the REPL with
|
||||
the `-n` flag, which disables color output. You can also try the `-s` if further issues
|
||||
the `-n` flag, which disables color output. You can also try the `-s` flag if further issues
|
||||
ensue.
|
||||
|
||||
## Why is it called "Janet"?
|
||||
|
||||
10
janet.1
10
janet.1
@@ -183,6 +183,10 @@ default repl.
|
||||
.BR \-n
|
||||
Disable ANSI colors in the repl. Has no effect if no repl is run.
|
||||
|
||||
.TP
|
||||
.BR \-N
|
||||
Enable ANSI colors in the repl. Has no effect if no repl is run.
|
||||
|
||||
.TP
|
||||
.BR \-r
|
||||
Open a REPL (Read Eval Print Loop) after executing all sources. By default, if Janet is called with no
|
||||
@@ -268,5 +272,11 @@ This variable does nothing in the default configuration of Janet, as PRF is disa
|
||||
cannot be defined for this variable to have an effect.
|
||||
.RE
|
||||
|
||||
.B NO_COLOR
|
||||
.RS
|
||||
Turn off color by default in the repl and in the error handler of scripts. This can be changed at runtime
|
||||
via dynamic bindings *err-color* and *pretty-format*, or via the command line parameters -n and -N.
|
||||
.RE
|
||||
|
||||
.SH AUTHOR
|
||||
Written by Calvin Rose <calsrose@gmail.com>
|
||||
|
||||
@@ -20,7 +20,7 @@
|
||||
|
||||
project('janet', 'c',
|
||||
default_options : ['c_std=c99', 'build.c_std=c99', 'b_lundef=false', 'default_library=both'],
|
||||
version : '1.26.1')
|
||||
version : '1.28.0')
|
||||
|
||||
# Global settings
|
||||
janet_path = join_paths(get_option('prefix'), get_option('libdir'), 'janet')
|
||||
|
||||
@@ -129,20 +129,18 @@
|
||||
# For macros, we define an imcomplete odd? function that will be overriden.
|
||||
(defn odd? [x] (= 1 (mod x 2)))
|
||||
|
||||
(def idempotent?
|
||||
```
|
||||
(idempotent? x)
|
||||
(def- non-atomic-types
|
||||
{:array true
|
||||
:tuple true
|
||||
:table true
|
||||
:buffer true
|
||||
:symbol true
|
||||
:struct true})
|
||||
|
||||
Check if x is a value that evaluates to itself when compiled.
|
||||
```
|
||||
(do
|
||||
(def non-atomic-types
|
||||
{:array true
|
||||
:tuple true
|
||||
:table true
|
||||
:buffer true
|
||||
:struct true})
|
||||
(fn idempotent? [x] (not (in non-atomic-types (type x))))))
|
||||
(defn idempotent?
|
||||
"Check if x is a value that evaluates to itself when compiled."
|
||||
[x]
|
||||
(not (in non-atomic-types (type x))))
|
||||
|
||||
# C style macros and functions for imperative sugar. No bitwise though.
|
||||
(defn inc "Returns x + 1." [x] (+ x 1))
|
||||
@@ -282,7 +280,7 @@
|
||||
(while (> i 0)
|
||||
(-- i)
|
||||
(def v (in forms i))
|
||||
(set ret (if (= ret true)
|
||||
(set ret (if (= i (- len 1))
|
||||
v
|
||||
(if (idempotent? v)
|
||||
['if v ret v]
|
||||
@@ -613,6 +611,13 @@
|
||||
(def $accum (gensym))
|
||||
~(do (def ,$accum @[]) (loop ,head (,array/push ,$accum (do ,;body))) ,$accum))
|
||||
|
||||
(defmacro catseq
|
||||
``Similar to `loop`, but concatenates each element from the loop body into an array and returns that.
|
||||
See `loop` for details.``
|
||||
[head & body]
|
||||
(def $accum (gensym))
|
||||
~(do (def ,$accum @[]) (loop ,head (,array/concat ,$accum (do ,;body))) ,$accum))
|
||||
|
||||
(defmacro tabseq
|
||||
``Similar to `loop`, but accumulates key value pairs into a table.
|
||||
See `loop` for details.``
|
||||
@@ -1135,16 +1140,16 @@
|
||||
(take-until (complement pred) ind))
|
||||
|
||||
(defn drop
|
||||
``Drop the first n elements in an indexed or bytes type. Returns a new tuple or string
|
||||
instance, respectively.``
|
||||
``Drop the first `n elements in an indexed or bytes type. Returns a new tuple or string
|
||||
instance, respectively. If `n` is negative, drops the last `n` elements instead.``
|
||||
[n ind]
|
||||
(def use-str (bytes? ind))
|
||||
(def f (if use-str string/slice tuple/slice))
|
||||
(def len (length ind))
|
||||
# make sure start is in [0, len]
|
||||
(def m (if (> n 0) n 0))
|
||||
(def start (if (> m len) len m))
|
||||
(f ind start -1))
|
||||
(def negn (>= n 0))
|
||||
(def start (if negn (min n len) 0))
|
||||
(def end (if negn len (max 0 (+ len n))))
|
||||
(f ind start end))
|
||||
|
||||
(defn drop-until
|
||||
"Same as `(drop-while (complement pred) ind)`."
|
||||
@@ -1234,6 +1239,29 @@
|
||||
(,eprintf (,dyn :pretty-format "%q") ,s)
|
||||
,s))
|
||||
|
||||
(defn keep-syntax
|
||||
``Creates a tuple with the tuple type and sourcemap of `before` but the
|
||||
elements of `after`. If either one of its argements is not a tuple, returns
|
||||
`after` unmodified. Useful to preserve syntactic information when transforming
|
||||
an ast in macros.``
|
||||
[before after]
|
||||
(if (and (= :tuple (type before))
|
||||
(= :tuple (type after)))
|
||||
(do
|
||||
(def res (if (= :parens (tuple/type before))
|
||||
(tuple/slice after)
|
||||
(tuple/brackets ;after)))
|
||||
(tuple/setmap res ;(tuple/sourcemap before)))
|
||||
after))
|
||||
|
||||
(defn keep-syntax!
|
||||
``Like `keep-syntax`, but if `after` is an array, it is coerced into a tuple.
|
||||
Useful to preserve syntactic information when transforming an ast in macros.``
|
||||
[before after]
|
||||
(keep-syntax before (if (= :array (type after))
|
||||
(tuple/slice after)
|
||||
after)))
|
||||
|
||||
(defmacro ->
|
||||
``Threading macro. Inserts x as the second value in the first form
|
||||
in `forms`, and inserts the modified first form into the second form
|
||||
@@ -1244,7 +1272,7 @@
|
||||
(tuple (in n 0) (array/slice n 1))
|
||||
(tuple n @[])))
|
||||
(def parts (array/concat @[h last] t))
|
||||
(tuple/slice parts 0))
|
||||
(keep-syntax! n parts))
|
||||
(reduce fop x forms))
|
||||
|
||||
(defmacro ->>
|
||||
@@ -1257,7 +1285,7 @@
|
||||
(tuple (in n 0) (array/slice n 1))
|
||||
(tuple n @[])))
|
||||
(def parts (array/concat @[h] t @[last]))
|
||||
(tuple/slice parts 0))
|
||||
(keep-syntax! n parts))
|
||||
(reduce fop x forms))
|
||||
|
||||
(defmacro -?>
|
||||
@@ -1273,7 +1301,7 @@
|
||||
(tuple n @[])))
|
||||
(def sym (gensym))
|
||||
(def parts (array/concat @[h sym] t))
|
||||
~(let [,sym ,last] (if ,sym ,(tuple/slice parts 0))))
|
||||
~(let [,sym ,last] (if ,sym ,(keep-syntax! n parts))))
|
||||
(reduce fop x forms))
|
||||
|
||||
(defmacro -?>>
|
||||
@@ -1289,7 +1317,7 @@
|
||||
(tuple n @[])))
|
||||
(def sym (gensym))
|
||||
(def parts (array/concat @[h] t @[sym]))
|
||||
~(let [,sym ,last] (if ,sym ,(tuple/slice parts 0))))
|
||||
~(let [,sym ,last] (if ,sym ,(keep-syntax! n parts))))
|
||||
(reduce fop x forms))
|
||||
|
||||
(defn- walk-ind [f form]
|
||||
@@ -1313,10 +1341,7 @@
|
||||
:table (walk-dict f form)
|
||||
:struct (table/to-struct (walk-dict f form))
|
||||
:array (walk-ind f form)
|
||||
:tuple (let [x (walk-ind f form)]
|
||||
(if (= :parens (tuple/type form))
|
||||
(tuple/slice x)
|
||||
(tuple/brackets ;x)))
|
||||
:tuple (keep-syntax! form (walk-ind f form))
|
||||
form))
|
||||
|
||||
(defn postwalk
|
||||
@@ -2184,6 +2209,7 @@
|
||||
(defn saw-special-arg
|
||||
[num]
|
||||
(set max-param-seen (max max-param-seen num)))
|
||||
(def prefix (gensym))
|
||||
(defn on-binding
|
||||
[x]
|
||||
(if (string/has-prefix? '$ x)
|
||||
@@ -2191,22 +2217,24 @@
|
||||
(= '$ x)
|
||||
(do
|
||||
(saw-special-arg 0)
|
||||
'$0)
|
||||
(symbol prefix '$0))
|
||||
(= '$& x)
|
||||
(do
|
||||
(set vararg true)
|
||||
x)
|
||||
(symbol prefix x))
|
||||
:else
|
||||
(do
|
||||
(def num (scan-number (string/slice x 1)))
|
||||
(if (nat? num)
|
||||
(saw-special-arg num))
|
||||
x))
|
||||
(do
|
||||
(saw-special-arg num)
|
||||
(symbol prefix x))
|
||||
x)))
|
||||
x))
|
||||
(def expanded (macex arg on-binding))
|
||||
(def name-splice (if name [name] []))
|
||||
(def fn-args (seq [i :range [0 (+ 1 max-param-seen)]] (symbol '$ i)))
|
||||
~(fn ,;name-splice [,;fn-args ,;(if vararg ['& '$&] [])] ,expanded))
|
||||
(def fn-args (seq [i :range [0 (+ 1 max-param-seen)]] (symbol prefix '$ i)))
|
||||
~(fn ,;name-splice [,;fn-args ,;(if vararg ['& (symbol prefix '$&)] [])] ,expanded))
|
||||
|
||||
###
|
||||
###
|
||||
@@ -3830,6 +3858,7 @@
|
||||
|
||||
(if-let [jp (getenv-alias "JANET_PATH")] (setdyn *syspath* jp))
|
||||
(if-let [jprofile (getenv-alias "JANET_PROFILE")] (setdyn *profilepath* jprofile))
|
||||
(set colorize (not (getenv-alias "NO_COLOR")))
|
||||
|
||||
(defn- get-lint-level
|
||||
[i]
|
||||
@@ -3847,7 +3876,7 @@
|
||||
-v : Print the version string
|
||||
-s : Use raw stdin instead of getline like functionality
|
||||
-e code : Execute a string of janet
|
||||
-E code arguments... : Evaluate an expression as a short-fn with arguments
|
||||
-E code arguments... : Evaluate an expression as a short-fn with arguments
|
||||
-d : Set the debug flag in the REPL
|
||||
-r : Enter the REPL after running all scripts
|
||||
-R : Disables loading profile.janet when JANET_PROFILE is present
|
||||
@@ -3858,6 +3887,7 @@
|
||||
-c source output : Compile janet source code into an image
|
||||
-i : Load the script argument as an image file instead of source code
|
||||
-n : Disable ANSI color output in the REPL
|
||||
-N : Enable ANSI color output in the REPL
|
||||
-l lib : Use a module before processing more arguments
|
||||
-w level : Set the lint warning level - default is "normal"
|
||||
-x level : Set the lint error level - default is "none"
|
||||
@@ -3873,6 +3903,7 @@
|
||||
"i" (fn [&] (set expect-image true) 1)
|
||||
"k" (fn [&] (set compile-only true) (set exit-on-error false) 1)
|
||||
"n" (fn [&] (set colorize false) 1)
|
||||
"N" (fn [&] (set colorize true) 1)
|
||||
"m" (fn [i &] (setdyn *syspath* (in args (+ i 1))) 2)
|
||||
"c" (fn c-switch [i &]
|
||||
(def path (in args (+ i 1)))
|
||||
|
||||
@@ -4,10 +4,10 @@
|
||||
#define JANETCONF_H
|
||||
|
||||
#define JANET_VERSION_MAJOR 1
|
||||
#define JANET_VERSION_MINOR 26
|
||||
#define JANET_VERSION_PATCH 1
|
||||
#define JANET_VERSION_EXTRA "-dev"
|
||||
#define JANET_VERSION "1.26.1-dev"
|
||||
#define JANET_VERSION_MINOR 28
|
||||
#define JANET_VERSION_PATCH 0
|
||||
#define JANET_VERSION_EXTRA ""
|
||||
#define JANET_VERSION "1.28.0"
|
||||
|
||||
/* #define JANET_BUILD "local" */
|
||||
|
||||
|
||||
@@ -28,6 +28,13 @@
|
||||
#include "state.h"
|
||||
#endif
|
||||
|
||||
/* Allow for managed buffers that cannot realloc/free their backing memory */
|
||||
static void janet_buffer_can_realloc(JanetBuffer *buffer) {
|
||||
if (buffer->gc.flags & JANET_BUFFER_FLAG_NO_REALLOC) {
|
||||
janet_panic("buffer cannot reallocate foreign memory");
|
||||
}
|
||||
}
|
||||
|
||||
/* Initialize a buffer */
|
||||
static JanetBuffer *janet_buffer_init_impl(JanetBuffer *buffer, int32_t capacity) {
|
||||
uint8_t *data = NULL;
|
||||
@@ -51,9 +58,23 @@ JanetBuffer *janet_buffer_init(JanetBuffer *buffer, int32_t capacity) {
|
||||
return buffer;
|
||||
}
|
||||
|
||||
/* Initialize an unmanaged buffer */
|
||||
JanetBuffer *janet_pointer_buffer_unsafe(void *memory, int32_t capacity, int32_t count) {
|
||||
if (count < 0) janet_panic("count < 0");
|
||||
if (capacity < count) janet_panic("capacity < count");
|
||||
JanetBuffer *buffer = janet_gcalloc(JANET_MEMORY_BUFFER, sizeof(JanetBuffer));
|
||||
buffer->gc.flags |= JANET_BUFFER_FLAG_NO_REALLOC;
|
||||
buffer->capacity = capacity;
|
||||
buffer->count = count;
|
||||
buffer->data = (uint8_t *) memory;
|
||||
return buffer;
|
||||
}
|
||||
|
||||
/* Deinitialize a buffer (free data memory) */
|
||||
void janet_buffer_deinit(JanetBuffer *buffer) {
|
||||
janet_free(buffer->data);
|
||||
if (!(buffer->gc.flags & JANET_BUFFER_FLAG_NO_REALLOC)) {
|
||||
janet_free(buffer->data);
|
||||
}
|
||||
}
|
||||
|
||||
/* Initialize a buffer */
|
||||
@@ -67,6 +88,7 @@ void janet_buffer_ensure(JanetBuffer *buffer, int32_t capacity, int32_t growth)
|
||||
uint8_t *new_data;
|
||||
uint8_t *old = buffer->data;
|
||||
if (capacity <= buffer->capacity) return;
|
||||
janet_buffer_can_realloc(buffer);
|
||||
int64_t big_capacity = ((int64_t) capacity) * growth;
|
||||
capacity = big_capacity > INT32_MAX ? INT32_MAX : (int32_t) big_capacity;
|
||||
janet_gcpressure(capacity - buffer->capacity);
|
||||
@@ -99,6 +121,7 @@ void janet_buffer_extra(JanetBuffer *buffer, int32_t n) {
|
||||
}
|
||||
int32_t new_size = buffer->count + n;
|
||||
if (new_size > buffer->capacity) {
|
||||
janet_buffer_can_realloc(buffer);
|
||||
int32_t new_capacity = (new_size > (INT32_MAX / 2)) ? INT32_MAX : (new_size * 2);
|
||||
uint8_t *new_data = janet_realloc(buffer->data, new_capacity * sizeof(uint8_t));
|
||||
janet_gcpressure(new_capacity - buffer->capacity);
|
||||
@@ -220,6 +243,7 @@ JANET_CORE_FN(cfun_buffer_trim,
|
||||
"modified buffer.") {
|
||||
janet_fixarity(argc, 1);
|
||||
JanetBuffer *buffer = janet_getbuffer(argv, 0);
|
||||
janet_buffer_can_realloc(buffer);
|
||||
if (buffer->count < buffer->capacity) {
|
||||
int32_t newcap = buffer->count > 4 ? buffer->count : 4;
|
||||
uint8_t *newData = janet_realloc(buffer->data, newcap);
|
||||
@@ -283,17 +307,8 @@ JANET_CORE_FN(cfun_buffer_chars,
|
||||
return argv[0];
|
||||
}
|
||||
|
||||
JANET_CORE_FN(cfun_buffer_push,
|
||||
"(buffer/push buffer & xs)",
|
||||
"Push both individual bytes and byte sequences to a buffer. For each x in xs, "
|
||||
"push the byte if x is an integer, otherwise push the bytesequence to the buffer. "
|
||||
"Thus, this function behaves like both `buffer/push-string` and `buffer/push-byte`. "
|
||||
"Returns the modified buffer. "
|
||||
"Will throw an error if the buffer overflows.") {
|
||||
int32_t i;
|
||||
janet_arity(argc, 1, -1);
|
||||
JanetBuffer *buffer = janet_getbuffer(argv, 0);
|
||||
for (i = 1; i < argc; i++) {
|
||||
static void buffer_push_impl(JanetBuffer *buffer, Janet *argv, int32_t argc_offset, int32_t argc) {
|
||||
for (int32_t i = argc_offset; i < argc; i++) {
|
||||
if (janet_checktype(argv[i], JANET_NUMBER)) {
|
||||
janet_buffer_push_u8(buffer, (uint8_t)(janet_getinteger(argv, i) & 0xFF));
|
||||
} else {
|
||||
@@ -305,6 +320,36 @@ JANET_CORE_FN(cfun_buffer_push,
|
||||
janet_buffer_push_bytes(buffer, view.bytes, view.len);
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
JANET_CORE_FN(cfun_buffer_push_at,
|
||||
"(buffer/push-at buffer index & xs)",
|
||||
"Same as buffer/push, but inserts new data at index `index`.") {
|
||||
janet_arity(argc, 2, -1);
|
||||
JanetBuffer *buffer = janet_getbuffer(argv, 0);
|
||||
int32_t index = janet_getinteger(argv, 1);
|
||||
int32_t old_count = buffer->count;
|
||||
if (index < 0 || index > old_count) {
|
||||
janet_panicf("index out of range [0, %d)", old_count);
|
||||
}
|
||||
buffer->count = index;
|
||||
buffer_push_impl(buffer, argv, 2, argc);
|
||||
if (buffer->count < old_count) {
|
||||
buffer->count = old_count;
|
||||
}
|
||||
return argv[0];
|
||||
}
|
||||
|
||||
JANET_CORE_FN(cfun_buffer_push,
|
||||
"(buffer/push buffer & xs)",
|
||||
"Push both individual bytes and byte sequences to a buffer. For each x in xs, "
|
||||
"push the byte if x is an integer, otherwise push the bytesequence to the buffer. "
|
||||
"Thus, this function behaves like both `buffer/push-string` and `buffer/push-byte`. "
|
||||
"Returns the modified buffer. "
|
||||
"Will throw an error if the buffer overflows.") {
|
||||
janet_arity(argc, 1, -1);
|
||||
JanetBuffer *buffer = janet_getbuffer(argv, 0);
|
||||
buffer_push_impl(buffer, argv, 1, argc);
|
||||
return argv[0];
|
||||
}
|
||||
|
||||
@@ -468,6 +513,7 @@ void janet_lib_buffer(JanetTable *env) {
|
||||
JANET_CORE_REG("buffer/push-word", cfun_buffer_word),
|
||||
JANET_CORE_REG("buffer/push-string", cfun_buffer_chars),
|
||||
JANET_CORE_REG("buffer/push", cfun_buffer_push),
|
||||
JANET_CORE_REG("buffer/push-at", cfun_buffer_push_at),
|
||||
JANET_CORE_REG("buffer/popn", cfun_buffer_popn),
|
||||
JANET_CORE_REG("buffer/clear", cfun_buffer_clear),
|
||||
JANET_CORE_REG("buffer/slice", cfun_buffer_slice),
|
||||
|
||||
@@ -209,14 +209,28 @@ const char *janet_optcstring(const Janet *argv, int32_t argc, int32_t n, const c
|
||||
#undef DEFINE_OPTLEN
|
||||
|
||||
const char *janet_getcstring(const Janet *argv, int32_t n) {
|
||||
const uint8_t *jstr = janet_getstring(argv, n);
|
||||
const char *cstr = (const char *)jstr;
|
||||
if (strlen(cstr) != (size_t) janet_string_length(jstr)) {
|
||||
janet_panic("string contains embedded 0s");
|
||||
if (!janet_checktype(argv[n], JANET_STRING)) {
|
||||
janet_panic_type(argv[n], n, JANET_TFLAG_STRING);
|
||||
}
|
||||
return janet_getcbytes(argv, n);
|
||||
}
|
||||
|
||||
const char *janet_getcbytes(const Janet *argv, int32_t n) {
|
||||
JanetByteView view = janet_getbytes(argv, n);
|
||||
const char *cstr = (const char *)view.bytes;
|
||||
if (strlen(cstr) != (size_t) view.len) {
|
||||
janet_panic("bytes contain embedded 0s");
|
||||
}
|
||||
return cstr;
|
||||
}
|
||||
|
||||
const char *janet_optcbytes(const Janet *argv, int32_t argc, int32_t n, const char *dflt) {
|
||||
if (n >= argc || janet_checktype(argv[n], JANET_NIL)) {
|
||||
return dflt;
|
||||
}
|
||||
return janet_getcbytes(argv, n);
|
||||
}
|
||||
|
||||
int32_t janet_getnat(const Janet *argv, int32_t n) {
|
||||
Janet x = argv[n];
|
||||
if (!janet_checkint(x)) goto bad;
|
||||
|
||||
@@ -422,6 +422,7 @@ JanetSlot *janetc_toslots(JanetCompiler *c, const Janet *vals, int32_t len) {
|
||||
int32_t i;
|
||||
JanetSlot *ret = NULL;
|
||||
JanetFopts subopts = janetc_fopts_default(c);
|
||||
subopts.flags |= JANET_FOPTS_ACCEPT_SPLICE;
|
||||
for (i = 0; i < len; i++) {
|
||||
janet_v_push(ret, janetc_value(subopts, vals[i]));
|
||||
}
|
||||
@@ -432,6 +433,7 @@ JanetSlot *janetc_toslots(JanetCompiler *c, const Janet *vals, int32_t len) {
|
||||
JanetSlot *janetc_toslotskv(JanetCompiler *c, Janet ds) {
|
||||
JanetSlot *ret = NULL;
|
||||
JanetFopts subopts = janetc_fopts_default(c);
|
||||
subopts.flags |= JANET_FOPTS_ACCEPT_SPLICE;
|
||||
const JanetKV *kvs = NULL;
|
||||
int32_t cap = 0, len = 0;
|
||||
janet_dictionary_view(ds, &kvs, &len, &cap);
|
||||
|
||||
@@ -187,6 +187,7 @@ struct JanetCompiler {
|
||||
#define JANET_FOPTS_TAIL 0x10000
|
||||
#define JANET_FOPTS_HINT 0x20000
|
||||
#define JANET_FOPTS_DROP 0x40000
|
||||
#define JANET_FOPTS_ACCEPT_SPLICE 0x80000
|
||||
|
||||
/* Options for compiling a single form */
|
||||
struct JanetFopts {
|
||||
|
||||
@@ -43,6 +43,7 @@ extern size_t janet_core_image_size;
|
||||
#endif
|
||||
|
||||
JanetModule janet_native(const char *name, const uint8_t **error) {
|
||||
janet_sandbox_assert(JANET_SANDBOX_DYNAMIC_MODULES);
|
||||
char *processed_name = get_processed_name(name);
|
||||
Clib lib = load_clib(processed_name);
|
||||
JanetModule init;
|
||||
@@ -652,7 +653,7 @@ JANET_CORE_FN(janet_core_signal,
|
||||
|
||||
JANET_CORE_FN(janet_core_memcmp,
|
||||
"(memcmp a b &opt len offset-a offset-b)",
|
||||
"Compare memory. Takes to byte sequences `a` and `b`, and "
|
||||
"Compare memory. Takes two byte sequences `a` and `b`, and "
|
||||
"return 0 if they have identical contents, a negative integer if a is less than b, "
|
||||
"and a positive integer if a is greater than b. Optionally take a length and offsets "
|
||||
"to compare slices of the bytes sequences.") {
|
||||
@@ -667,6 +668,64 @@ JANET_CORE_FN(janet_core_memcmp,
|
||||
return janet_wrap_integer(memcmp(a.bytes + offset_a, b.bytes + offset_b, (size_t) len));
|
||||
}
|
||||
|
||||
typedef struct SandboxOption {
|
||||
const char *name;
|
||||
uint32_t flag;
|
||||
} SandboxOption;
|
||||
|
||||
static const SandboxOption sandbox_options[] = {
|
||||
{"all", JANET_SANDBOX_ALL},
|
||||
{"env", JANET_SANDBOX_ENV},
|
||||
{"ffi", JANET_SANDBOX_FFI},
|
||||
{"fs", JANET_SANDBOX_FS},
|
||||
{"fs-read", JANET_SANDBOX_FS_READ},
|
||||
{"fs-temp", JANET_SANDBOX_FS_TEMP},
|
||||
{"fs-write", JANET_SANDBOX_FS_WRITE},
|
||||
{"hrtime", JANET_SANDBOX_HRTIME},
|
||||
{"modules", JANET_SANDBOX_DYNAMIC_MODULES},
|
||||
{"net", JANET_SANDBOX_NET},
|
||||
{"net-connect", JANET_SANDBOX_NET_CONNECT},
|
||||
{"net-listen", JANET_SANDBOX_NET_LISTEN},
|
||||
{"sandbox", JANET_SANDBOX_SANDBOX},
|
||||
{"subprocess", JANET_SANDBOX_SUBPROCESS},
|
||||
{NULL, 0}
|
||||
};
|
||||
|
||||
JANET_CORE_FN(janet_core_sandbox,
|
||||
"(sandbox & forbidden-capabilities)",
|
||||
"Disable feature sets to prevent the interpreter from using certain system resources. "
|
||||
"Once a feature is disabled, there is no way to re-enable it. Capabilities can be:\n\n"
|
||||
"* :all - disallow all (except IO to stdout, stderr, and stdin)\n"
|
||||
"* :env - disallow reading and write env variables\n"
|
||||
"* :ffi - disallow FFI (recommended if disabling anything else)\n"
|
||||
"* :fs - disallow access to the file system\n"
|
||||
"* :fs-read - disallow read access to the file system\n"
|
||||
"* :fs-temp - disallow creating temporary files\n"
|
||||
"* :fs-write - disallow write access to the file system\n"
|
||||
"* :hrtime - disallow high-resolution timers\n"
|
||||
"* :modules - disallow load dynamic modules (natives)\n"
|
||||
"* :net - disallow network access\n"
|
||||
"* :net-connect - disallow making outbound network connections\n"
|
||||
"* :net-listen - disallow accepting inbound network connections\n"
|
||||
"* :sandbox - disallow calling this function\n"
|
||||
"* :subprocess - disallow running subprocesses") {
|
||||
uint32_t flags = 0;
|
||||
for (int32_t i = 0; i < argc; i++) {
|
||||
JanetKeyword kw = janet_getkeyword(argv, i);
|
||||
const SandboxOption *opt = sandbox_options;
|
||||
while (opt->name != NULL) {
|
||||
if (janet_cstrcmp(kw, opt->name) == 0) {
|
||||
flags |= opt->flag;
|
||||
break;
|
||||
}
|
||||
opt++;
|
||||
}
|
||||
if (opt->name == NULL) janet_panicf("unknown capability %v", argv[i]);
|
||||
}
|
||||
janet_sandbox(flags);
|
||||
return janet_wrap_nil();
|
||||
}
|
||||
|
||||
#ifdef JANET_BOOTSTRAP
|
||||
|
||||
/* Utility for inline assembly */
|
||||
@@ -970,6 +1029,7 @@ static void janet_load_libs(JanetTable *env) {
|
||||
JANET_CORE_REG("signal", janet_core_signal),
|
||||
JANET_CORE_REG("memcmp", janet_core_memcmp),
|
||||
JANET_CORE_REG("getproto", janet_core_getproto),
|
||||
JANET_CORE_REG("sandbox", janet_core_sandbox),
|
||||
JANET_REG_END
|
||||
};
|
||||
janet_core_cfuns_ext(env, NULL, corelib_cfuns);
|
||||
|
||||
156
src/core/ev.c
156
src/core/ev.c
@@ -472,8 +472,12 @@ const JanetAbstractType janet_stream_type = {
|
||||
/* Register a fiber to resume with value */
|
||||
void janet_schedule_signal(JanetFiber *fiber, Janet value, JanetSignal sig) {
|
||||
if (fiber->gc.flags & JANET_FIBER_EV_FLAG_CANCELED) return;
|
||||
fiber->gc.flags |= JANET_FIBER_FLAG_ROOT;
|
||||
if (!(fiber->gc.flags & JANET_FIBER_FLAG_ROOT)) {
|
||||
Janet task_element = janet_wrap_fiber(fiber);
|
||||
janet_table_put(&janet_vm.active_tasks, task_element, janet_wrap_true());
|
||||
}
|
||||
JanetTask t = { fiber, value, sig, ++fiber->sched_id };
|
||||
fiber->gc.flags |= JANET_FIBER_FLAG_ROOT;
|
||||
if (sig == JANET_SIGNAL_ERROR) fiber->gc.flags |= JANET_FIBER_EV_FLAG_CANCELED;
|
||||
janet_q_push(&janet_vm.spawn, &t, sizeof(t));
|
||||
}
|
||||
@@ -559,6 +563,7 @@ void janet_ev_init_common(void) {
|
||||
janet_vm.tq_count = 0;
|
||||
janet_vm.tq_capacity = 0;
|
||||
janet_table_init_raw(&janet_vm.threaded_abstracts, 0);
|
||||
janet_table_init_raw(&janet_vm.active_tasks, 0);
|
||||
janet_rng_seed(&janet_vm.ev_rng, 0);
|
||||
#ifndef JANET_WINDOWS
|
||||
pthread_attr_init(&janet_vm.new_thread_attr);
|
||||
@@ -573,13 +578,15 @@ void janet_ev_deinit_common(void) {
|
||||
janet_free(janet_vm.listeners);
|
||||
janet_vm.listeners = NULL;
|
||||
janet_table_deinit(&janet_vm.threaded_abstracts);
|
||||
janet_table_deinit(&janet_vm.active_tasks);
|
||||
#ifndef JANET_WINDOWS
|
||||
pthread_attr_destroy(&janet_vm.new_thread_attr);
|
||||
#endif
|
||||
}
|
||||
|
||||
/* Short hand to yield to event loop */
|
||||
/* Shorthand to yield to event loop */
|
||||
void janet_await(void) {
|
||||
/* Store the fiber in a gobal table */
|
||||
janet_signalv(JANET_SIGNAL_EVENT, janet_wrap_nil());
|
||||
}
|
||||
|
||||
@@ -665,19 +672,6 @@ static void janet_chan_init(JanetChannel *chan, int32_t limit, int threaded) {
|
||||
janet_os_mutex_init((JanetOSMutex *) &chan->lock);
|
||||
}
|
||||
|
||||
static void janet_chan_deinit(JanetChannel *chan) {
|
||||
janet_q_deinit(&chan->read_pending);
|
||||
janet_q_deinit(&chan->write_pending);
|
||||
if (janet_chan_is_threaded(chan)) {
|
||||
Janet item;
|
||||
while (!janet_q_pop(&chan->items, &item, sizeof(item))) {
|
||||
janet_chan_unpack(chan, &item, 1);
|
||||
}
|
||||
}
|
||||
janet_q_deinit(&chan->items);
|
||||
janet_os_mutex_deinit((JanetOSMutex *) &chan->lock);
|
||||
}
|
||||
|
||||
static void janet_chan_lock(JanetChannel *chan) {
|
||||
if (!janet_chan_is_threaded(chan)) return;
|
||||
janet_os_mutex_lock((JanetOSMutex *) &chan->lock);
|
||||
@@ -688,6 +682,25 @@ static void janet_chan_unlock(JanetChannel *chan) {
|
||||
janet_os_mutex_unlock((JanetOSMutex *) &chan->lock);
|
||||
}
|
||||
|
||||
static void janet_chan_deinit(JanetChannel *chan) {
|
||||
if (janet_chan_is_threaded(chan)) {
|
||||
Janet item;
|
||||
janet_chan_lock(chan);
|
||||
janet_q_deinit(&chan->read_pending);
|
||||
janet_q_deinit(&chan->write_pending);
|
||||
while (!janet_q_pop(&chan->items, &item, sizeof(item))) {
|
||||
janet_chan_unpack(chan, &item, 1);
|
||||
}
|
||||
janet_q_deinit(&chan->items);
|
||||
janet_chan_unlock(chan);
|
||||
} else {
|
||||
janet_q_deinit(&chan->read_pending);
|
||||
janet_q_deinit(&chan->write_pending);
|
||||
janet_q_deinit(&chan->items);
|
||||
}
|
||||
janet_os_mutex_deinit((JanetOSMutex *) &chan->lock);
|
||||
}
|
||||
|
||||
/*
|
||||
* Janet Channel abstract type
|
||||
*/
|
||||
@@ -764,6 +777,7 @@ static void janet_thread_chan_cb(JanetEVGenericMessage msg) {
|
||||
int mode = msg.tag;
|
||||
JanetChannel *channel = (JanetChannel *) msg.argp;
|
||||
Janet x = msg.argj;
|
||||
janet_chan_lock(channel);
|
||||
if (fiber->sched_id == sched_id) {
|
||||
if (mode == JANET_CP_MODE_CHOICE_READ) {
|
||||
janet_assert(!janet_chan_unpack(channel, &x, 0), "packing error");
|
||||
@@ -784,7 +798,6 @@ static void janet_thread_chan_cb(JanetEVGenericMessage msg) {
|
||||
int is_read = (mode == JANET_CP_MODE_CHOICE_READ) || (mode == JANET_CP_MODE_READ);
|
||||
if (is_read) {
|
||||
JanetChannelPending reader;
|
||||
janet_chan_lock(channel);
|
||||
if (!janet_q_pop(&channel->read_pending, &reader, sizeof(reader))) {
|
||||
JanetVM *vm = reader.thread;
|
||||
JanetEVGenericMessage msg;
|
||||
@@ -795,10 +808,8 @@ static void janet_thread_chan_cb(JanetEVGenericMessage msg) {
|
||||
msg.argj = x;
|
||||
janet_ev_post_event(vm, janet_thread_chan_cb, msg);
|
||||
}
|
||||
janet_chan_unlock(channel);
|
||||
} else {
|
||||
JanetChannelPending writer;
|
||||
janet_chan_lock(channel);
|
||||
if (!janet_q_pop(&channel->write_pending, &writer, sizeof(writer))) {
|
||||
JanetVM *vm = writer.thread;
|
||||
JanetEVGenericMessage msg;
|
||||
@@ -809,21 +820,21 @@ static void janet_thread_chan_cb(JanetEVGenericMessage msg) {
|
||||
msg.argj = janet_wrap_nil();
|
||||
janet_ev_post_event(vm, janet_thread_chan_cb, msg);
|
||||
}
|
||||
janet_chan_unlock(channel);
|
||||
}
|
||||
}
|
||||
janet_chan_unlock(channel);
|
||||
}
|
||||
|
||||
/* Push a value to a channel, and return 1 if channel should block, zero otherwise.
|
||||
* If the push would block, will add to the write_pending queue in the channel.
|
||||
* Handles both threaded and unthreaded channels. */
|
||||
static int janet_channel_push(JanetChannel *channel, Janet x, int mode) {
|
||||
static int janet_channel_push_with_lock(JanetChannel *channel, Janet x, int mode) {
|
||||
JanetChannelPending reader;
|
||||
int is_empty;
|
||||
if (janet_chan_pack(channel, &x)) {
|
||||
janet_chan_unlock(channel);
|
||||
janet_panicf("failed to pack value for channel: %v", x);
|
||||
}
|
||||
janet_chan_lock(channel);
|
||||
if (channel->closed) {
|
||||
janet_chan_unlock(channel);
|
||||
janet_panic("cannot write to closed channel");
|
||||
@@ -884,12 +895,16 @@ static int janet_channel_push(JanetChannel *channel, Janet x, int mode) {
|
||||
return 0;
|
||||
}
|
||||
|
||||
static int janet_channel_push(JanetChannel *channel, Janet x, int mode) {
|
||||
janet_chan_lock(channel);
|
||||
return janet_channel_push_with_lock(channel, x, mode);
|
||||
}
|
||||
|
||||
/* Pop from a channel - returns 1 if item was obtained, 0 otherwise. The item
|
||||
* is returned by reference. If the pop would block, will add to the read_pending
|
||||
* queue in the channel. */
|
||||
static int janet_channel_pop(JanetChannel *channel, Janet *item, int is_choice) {
|
||||
static int janet_channel_pop_with_lock(JanetChannel *channel, Janet *item, int is_choice) {
|
||||
JanetChannelPending writer;
|
||||
janet_chan_lock(channel);
|
||||
if (channel->closed) {
|
||||
janet_chan_unlock(channel);
|
||||
*item = janet_wrap_nil();
|
||||
@@ -934,6 +949,11 @@ static int janet_channel_pop(JanetChannel *channel, Janet *item, int is_choice)
|
||||
return 1;
|
||||
}
|
||||
|
||||
static int janet_channel_pop(JanetChannel *channel, Janet *item, int is_choice) {
|
||||
janet_chan_lock(channel);
|
||||
return janet_channel_pop_with_lock(channel, item, is_choice);
|
||||
}
|
||||
|
||||
JanetChannel *janet_channel_unwrap(void *abstract) {
|
||||
return abstract;
|
||||
}
|
||||
@@ -976,13 +996,32 @@ JANET_CORE_FN(cfun_channel_pop,
|
||||
janet_await();
|
||||
}
|
||||
|
||||
static void chan_unlock_args(const Janet *argv, int32_t n) {
|
||||
for (int32_t i = 0; i < n; i++) {
|
||||
int32_t len;
|
||||
const Janet *data;
|
||||
JanetChannel *chan;
|
||||
if (janet_indexed_view(argv[i], &data, &len) && len == 2) {
|
||||
chan = janet_getchannel(data, 0);
|
||||
} else {
|
||||
chan = janet_getchannel(argv, i);
|
||||
}
|
||||
janet_chan_unlock(chan);
|
||||
}
|
||||
}
|
||||
|
||||
JANET_CORE_FN(cfun_channel_choice,
|
||||
"(ev/select & clauses)",
|
||||
"Block until the first of several channel operations occur. Returns a tuple of the form [:give chan], [:take chan x], or [:close chan], where "
|
||||
"a :give tuple is the result of a write and :take tuple is the result of a read. Each clause must be either a channel (for "
|
||||
"a channel take operation) or a tuple [channel x] for a channel give operation. Operations are tried in order, such that the first "
|
||||
"clauses will take precedence over later clauses. Both and give and take operations can return a [:close chan] tuple, which indicates that "
|
||||
"the specified channel was closed while waiting, or that the channel was already closed.") {
|
||||
"Block until the first of several channel operations occur. Returns a "
|
||||
"tuple of the form [:give chan], [:take chan x], or [:close chan], "
|
||||
"where a :give tuple is the result of a write and a :take tuple is the "
|
||||
"result of a read. Each clause must be either a channel (for a channel "
|
||||
"take operation) or a tuple [channel x] (for a channel give operation). "
|
||||
"Operations are tried in order such that earlier clauses take "
|
||||
"precedence over later clauses. Both give and take operations can "
|
||||
"return a [:close chan] tuple, which indicates that the specified "
|
||||
"channel was closed while waiting, or that the channel was already "
|
||||
"closed.") {
|
||||
janet_arity(argc, 1, -1);
|
||||
int32_t len;
|
||||
const Janet *data;
|
||||
@@ -995,29 +1034,29 @@ JANET_CORE_FN(cfun_channel_choice,
|
||||
janet_chan_lock(chan);
|
||||
if (chan->closed) {
|
||||
janet_chan_unlock(chan);
|
||||
chan_unlock_args(argv, i);
|
||||
return make_close_result(chan);
|
||||
}
|
||||
if (janet_q_count(&chan->items) < chan->limit) {
|
||||
janet_chan_unlock(chan);
|
||||
janet_channel_push(chan, data[1], 1);
|
||||
janet_channel_push_with_lock(chan, data[1], 1);
|
||||
chan_unlock_args(argv, i);
|
||||
return make_write_result(chan);
|
||||
}
|
||||
janet_chan_unlock(chan);
|
||||
} else {
|
||||
/* Read */
|
||||
JanetChannel *chan = janet_getchannel(argv, i);
|
||||
janet_chan_lock(chan);
|
||||
if (chan->closed) {
|
||||
janet_chan_unlock(chan);
|
||||
chan_unlock_args(argv, i);
|
||||
return make_close_result(chan);
|
||||
}
|
||||
if (chan->items.head != chan->items.tail) {
|
||||
Janet item;
|
||||
janet_chan_unlock(chan);
|
||||
janet_channel_pop(chan, &item, 1);
|
||||
janet_channel_pop_with_lock(chan, &item, 1);
|
||||
chan_unlock_args(argv, i);
|
||||
return make_read_result(chan, item);
|
||||
}
|
||||
janet_chan_unlock(chan);
|
||||
}
|
||||
}
|
||||
|
||||
@@ -1026,12 +1065,12 @@ JANET_CORE_FN(cfun_channel_choice,
|
||||
if (janet_indexed_view(argv[i], &data, &len) && len == 2) {
|
||||
/* Write */
|
||||
JanetChannel *chan = janet_getchannel(data, 0);
|
||||
janet_channel_push(chan, data[1], 1);
|
||||
janet_channel_push_with_lock(chan, data[1], 1);
|
||||
} else {
|
||||
/* Read */
|
||||
Janet item;
|
||||
JanetChannel *chan = janet_getchannel(argv, i);
|
||||
janet_channel_pop(chan, &item, 1);
|
||||
janet_channel_pop_with_lock(chan, &item, 1);
|
||||
}
|
||||
}
|
||||
|
||||
@@ -1252,16 +1291,7 @@ JanetFiber *janet_loop1(void) {
|
||||
while (peek_timeout(&to) && to.when <= now) {
|
||||
pop_timeout(0);
|
||||
if (to.curr_fiber != NULL) {
|
||||
/* This is a deadline (for a fiber, not a function call) */
|
||||
JanetFiberStatus s = janet_fiber_status(to.curr_fiber);
|
||||
int isFinished = (s == JANET_STATUS_DEAD ||
|
||||
s == JANET_STATUS_ERROR ||
|
||||
s == JANET_STATUS_USER0 ||
|
||||
s == JANET_STATUS_USER1 ||
|
||||
s == JANET_STATUS_USER2 ||
|
||||
s == JANET_STATUS_USER3 ||
|
||||
s == JANET_STATUS_USER4);
|
||||
if (!isFinished) {
|
||||
if (janet_fiber_can_resume(to.curr_fiber)) {
|
||||
janet_cancel(to.fiber, janet_cstringv("deadline expired"));
|
||||
}
|
||||
} else {
|
||||
@@ -1285,6 +1315,9 @@ JanetFiber *janet_loop1(void) {
|
||||
if (task.expected_sched_id != task.fiber->sched_id) continue;
|
||||
Janet res;
|
||||
JanetSignal sig = janet_continue_signal(task.fiber, task.value, &res, task.sig);
|
||||
if (!janet_fiber_can_resume(task.fiber)) {
|
||||
janet_table_remove(&janet_vm.active_tasks, janet_wrap_fiber(task.fiber));
|
||||
}
|
||||
void *sv = task.fiber->supervisor_channel;
|
||||
int is_suspended = sig == JANET_SIGNAL_EVENT || sig == JANET_SIGNAL_YIELD || sig == JANET_SIGNAL_INTERRUPT;
|
||||
if (is_suspended) {
|
||||
@@ -1316,15 +1349,8 @@ JanetFiber *janet_loop1(void) {
|
||||
/* Drop timeouts that are no longer needed */
|
||||
while ((has_timeout = peek_timeout(&to))) {
|
||||
if (to.curr_fiber != NULL) {
|
||||
JanetFiberStatus s = janet_fiber_status(to.curr_fiber);
|
||||
int is_finished = (s == JANET_STATUS_DEAD ||
|
||||
s == JANET_STATUS_ERROR ||
|
||||
s == JANET_STATUS_USER0 ||
|
||||
s == JANET_STATUS_USER1 ||
|
||||
s == JANET_STATUS_USER2 ||
|
||||
s == JANET_STATUS_USER3 ||
|
||||
s == JANET_STATUS_USER4);
|
||||
if (is_finished) {
|
||||
if (!janet_fiber_can_resume(to.curr_fiber)) {
|
||||
janet_table_remove(&janet_vm.active_tasks, janet_wrap_fiber(to.curr_fiber));
|
||||
pop_timeout(0);
|
||||
continue;
|
||||
}
|
||||
@@ -2778,6 +2804,7 @@ static JanetEVGenericMessage janet_go_thread_subr(JanetEVGenericMessage args) {
|
||||
uint32_t flags = args.tag;
|
||||
args.tag = 0;
|
||||
janet_init();
|
||||
janet_vm.sandbox_flags = (uint32_t) args.argi;
|
||||
JanetTryState tstate;
|
||||
JanetSignal signal = janet_try(&tstate);
|
||||
if (!signal) {
|
||||
@@ -2930,13 +2957,13 @@ JANET_CORE_FN(cfun_ev_thread,
|
||||
JanetEVGenericMessage arguments;
|
||||
memset(&arguments, 0, sizeof(arguments));
|
||||
arguments.tag = (uint32_t) flags;
|
||||
arguments.argi = argc;
|
||||
arguments.argi = (uint32_t) janet_vm.sandbox_flags;
|
||||
arguments.argp = buffer;
|
||||
arguments.fiber = NULL;
|
||||
janet_ev_threaded_call(janet_go_thread_subr, arguments, janet_ev_default_threaded_callback);
|
||||
return janet_wrap_nil();
|
||||
} else {
|
||||
janet_ev_threaded_await(janet_go_thread_subr, (uint32_t) flags, argc, buffer);
|
||||
janet_ev_threaded_await(janet_go_thread_subr, (uint32_t) flags, (uint32_t) janet_vm.sandbox_flags, buffer);
|
||||
}
|
||||
}
|
||||
|
||||
@@ -3173,6 +3200,20 @@ JANET_CORE_FN(janet_cfun_rwlock_write_release,
|
||||
return argv[0];
|
||||
}
|
||||
|
||||
JANET_CORE_FN(janet_cfun_ev_all_tasks,
|
||||
"(ev/all-tasks)",
|
||||
"Get an array of all active fibers that are being used by the scheduler.") {
|
||||
janet_fixarity(argc, 0);
|
||||
(void) argv;
|
||||
JanetArray *array = janet_array(janet_vm.active_tasks.count);
|
||||
for (int32_t i = 0; i < janet_vm.active_tasks.capacity; i++) {
|
||||
if (!janet_checktype(janet_vm.active_tasks.data[i].key, JANET_NIL)) {
|
||||
janet_array_push(array, janet_vm.active_tasks.data[i].key);
|
||||
}
|
||||
}
|
||||
return janet_wrap_array(array);
|
||||
}
|
||||
|
||||
void janet_lib_ev(JanetTable *env) {
|
||||
JanetRegExt ev_cfuns_ext[] = {
|
||||
JANET_CORE_REG("ev/give", cfun_channel_push),
|
||||
@@ -3203,6 +3244,7 @@ void janet_lib_ev(JanetTable *env) {
|
||||
JANET_CORE_REG("ev/acquire-wlock", janet_cfun_rwlock_write_lock),
|
||||
JANET_CORE_REG("ev/release-rlock", janet_cfun_rwlock_read_release),
|
||||
JANET_CORE_REG("ev/release-wlock", janet_cfun_rwlock_write_release),
|
||||
JANET_CORE_REG("ev/all-tasks", janet_cfun_ev_all_tasks),
|
||||
JANET_REG_END
|
||||
};
|
||||
|
||||
|
||||
@@ -61,4 +61,9 @@
|
||||
#define _NETBSD_SOURCE
|
||||
#endif
|
||||
|
||||
/* Needed for several things when building with -std=c99. */
|
||||
#if !__BSD_VISIBLE && defined(__DragonFly__)
|
||||
#define __BSD_VISIBLE 1
|
||||
#endif
|
||||
|
||||
#endif
|
||||
|
||||
@@ -24,6 +24,7 @@
|
||||
#include "features.h"
|
||||
#include <janet.h>
|
||||
#include "util.h"
|
||||
#include "gc.h"
|
||||
#endif
|
||||
|
||||
#ifdef JANET_FFI
|
||||
@@ -309,6 +310,7 @@ static JanetFFIPrimType decode_ffi_prim(const uint8_t *name) {
|
||||
if (!janet_cstrcmp(name, "void")) return JANET_FFI_TYPE_VOID;
|
||||
if (!janet_cstrcmp(name, "bool")) return JANET_FFI_TYPE_BOOL;
|
||||
if (!janet_cstrcmp(name, "ptr")) return JANET_FFI_TYPE_PTR;
|
||||
if (!janet_cstrcmp(name, "pointer")) return JANET_FFI_TYPE_PTR;
|
||||
if (!janet_cstrcmp(name, "string")) return JANET_FFI_TYPE_STRING;
|
||||
if (!janet_cstrcmp(name, "float")) return JANET_FFI_TYPE_FLOAT;
|
||||
if (!janet_cstrcmp(name, "double")) return JANET_FFI_TYPE_DOUBLE;
|
||||
@@ -1301,6 +1303,7 @@ JANET_CORE_FN(cfun_ffi_jitfn,
|
||||
"(ffi/jitfn bytes)",
|
||||
"Create an abstract type that can be used as the pointer argument to `ffi/call`. The content "
|
||||
"of `bytes` is architecture specific machine code that will be copied into executable memory.") {
|
||||
janet_sandbox_assert(JANET_SANDBOX_FFI);
|
||||
janet_fixarity(argc, 1);
|
||||
JanetByteView bytes = janet_getbytes(argv, 0);
|
||||
|
||||
@@ -1308,7 +1311,11 @@ JANET_CORE_FN(cfun_ffi_jitfn,
|
||||
size_t alloc_size = ((size_t) bytes.len + FFI_PAGE_MASK) & ~FFI_PAGE_MASK;
|
||||
|
||||
#ifdef JANET_FFI_JIT
|
||||
#ifdef JANET_EV
|
||||
JanetFFIJittedFn *fn = janet_abstract_threaded(&janet_type_ffijit, sizeof(JanetFFIJittedFn));
|
||||
#else
|
||||
JanetFFIJittedFn *fn = janet_abstract(&janet_type_ffijit, sizeof(JanetFFIJittedFn));
|
||||
#endif
|
||||
fn->function_pointer = NULL;
|
||||
fn->size = 0;
|
||||
#ifdef JANET_WINDOWS
|
||||
@@ -1349,6 +1356,7 @@ JANET_CORE_FN(cfun_ffi_call,
|
||||
"(ffi/call pointer signature & args)",
|
||||
"Call a raw pointer as a function pointer. The function signature specifies "
|
||||
"how Janet values in `args` are converted to native machine types.") {
|
||||
janet_sandbox_assert(JANET_SANDBOX_FFI);
|
||||
janet_arity(argc, 2, -1);
|
||||
void *function_pointer = janet_ffi_get_callable_pointer(argv, 0);
|
||||
JanetFFISignature *signature = janet_getabstract(argv, 1, &janet_signature_type);
|
||||
@@ -1369,18 +1377,25 @@ JANET_CORE_FN(cfun_ffi_call,
|
||||
}
|
||||
|
||||
JANET_CORE_FN(cfun_ffi_buffer_write,
|
||||
"(ffi/write ffi-type data &opt buffer)",
|
||||
"Append a native tyep to a buffer such as it would appear in memory. This can be used "
|
||||
"(ffi/write ffi-type data &opt buffer index)",
|
||||
"Append a native type to a buffer such as it would appear in memory. This can be used "
|
||||
"to pass pointers to structs in the ffi, or send C/C++/native structs over the network "
|
||||
"or to files. Returns a modifed buffer or a new buffer if one is not supplied.") {
|
||||
janet_arity(argc, 2, 3);
|
||||
janet_sandbox_assert(JANET_SANDBOX_FFI);
|
||||
janet_arity(argc, 2, 4);
|
||||
JanetFFIType type = decode_ffi_type(argv[0]);
|
||||
uint32_t el_size = (uint32_t) type_size(type);
|
||||
JanetBuffer *buffer = janet_optbuffer(argv, argc, 2, el_size);
|
||||
int32_t index = janet_optnat(argv, argc, 3, 0);
|
||||
int32_t old_count = buffer->count;
|
||||
if (index > old_count) janet_panic("index out of bounds");
|
||||
buffer->count = index;
|
||||
janet_buffer_extra(buffer, el_size);
|
||||
memset(buffer->data, 0, el_size);
|
||||
janet_ffi_write_one(buffer->data, argv, 1, type, JANET_FFI_MAX_RECUR);
|
||||
buffer->count += el_size;
|
||||
buffer->count = old_count;
|
||||
memset(buffer->data + index, 0, el_size);
|
||||
janet_ffi_write_one(buffer->data + index, argv, 1, type, JANET_FFI_MAX_RECUR);
|
||||
index += el_size;
|
||||
if (buffer->count < index) buffer->count = index;
|
||||
return janet_wrap_buffer(buffer);
|
||||
}
|
||||
|
||||
@@ -1389,6 +1404,7 @@ JANET_CORE_FN(cfun_ffi_buffer_read,
|
||||
"Parse a native struct out of a buffer and convert it to normal Janet data structures. "
|
||||
"This function is the inverse of `ffi/write`. `bytes` can also be a raw pointer, although "
|
||||
"this is unsafe.") {
|
||||
janet_sandbox_assert(JANET_SANDBOX_FFI);
|
||||
janet_arity(argc, 2, 3);
|
||||
JanetFFIType type = decode_ffi_type(argv[0]);
|
||||
size_t offset = (size_t) janet_optnat(argv, argc, 2, 0);
|
||||
@@ -1435,6 +1451,7 @@ JANET_CORE_FN(janet_core_raw_native,
|
||||
" or run any code from it. This is different than `native`, which will "
|
||||
"run initialization code to get a module table. If `path` is nil, opens the current running binary. "
|
||||
"Returns a `core/native`.") {
|
||||
janet_sandbox_assert(JANET_SANDBOX_FFI);
|
||||
janet_arity(argc, 0, 1);
|
||||
const char *path = janet_optcstring(argv, argc, 0, NULL);
|
||||
Clib lib = load_clib(path);
|
||||
@@ -1450,6 +1467,7 @@ JANET_CORE_FN(janet_core_native_lookup,
|
||||
"(ffi/lookup native symbol-name)",
|
||||
"Lookup a symbol from a native object. All symbol lookups will return a raw pointer "
|
||||
"if the symbol is found, else nil.") {
|
||||
janet_sandbox_assert(JANET_SANDBOX_FFI);
|
||||
janet_fixarity(argc, 2);
|
||||
JanetAbstractNative *anative = janet_getabstract(argv, 0, &janet_native_type);
|
||||
const char *sym = janet_getcstring(argv, 1);
|
||||
@@ -1463,6 +1481,7 @@ JANET_CORE_FN(janet_core_native_close,
|
||||
"(ffi/close native)",
|
||||
"Free a native object. Dereferencing pointers to symbols in the object will have undefined "
|
||||
"behavior after freeing.") {
|
||||
janet_sandbox_assert(JANET_SANDBOX_FFI);
|
||||
janet_fixarity(argc, 1);
|
||||
JanetAbstractNative *anative = janet_getabstract(argv, 0, &janet_native_type);
|
||||
if (anative->closed) janet_panic("native object already closed");
|
||||
@@ -1474,23 +1493,42 @@ JANET_CORE_FN(janet_core_native_close,
|
||||
|
||||
JANET_CORE_FN(cfun_ffi_malloc,
|
||||
"(ffi/malloc size)",
|
||||
"Allocates memory directly using the system memory allocator. Memory allocated in this way must be freed manually! Returns a raw pointer, or nil if size = 0.") {
|
||||
"Allocates memory directly using the janet memory allocator. Memory allocated in this way must be freed manually! Returns a raw pointer, or nil if size = 0.") {
|
||||
janet_sandbox_assert(JANET_SANDBOX_FFI);
|
||||
janet_fixarity(argc, 1);
|
||||
size_t size = janet_getsize(argv, 0);
|
||||
if (size == 0) return janet_wrap_nil();
|
||||
return janet_wrap_pointer(malloc(size));
|
||||
return janet_wrap_pointer(janet_malloc(size));
|
||||
}
|
||||
|
||||
JANET_CORE_FN(cfun_ffi_free,
|
||||
"(ffi/free pointer)",
|
||||
"Free memory allocated with `ffi/malloc`.") {
|
||||
"Free memory allocated with `ffi/malloc`. Returns nil.") {
|
||||
janet_sandbox_assert(JANET_SANDBOX_FFI);
|
||||
janet_fixarity(argc, 1);
|
||||
if (janet_checktype(argv[0], JANET_NIL)) return janet_wrap_nil();
|
||||
void *pointer = janet_getpointer(argv, 0);
|
||||
free(pointer);
|
||||
janet_free(pointer);
|
||||
return janet_wrap_nil();
|
||||
}
|
||||
|
||||
JANET_CORE_FN(cfun_ffi_pointer_buffer,
|
||||
"(ffi/pointer-buffer pointer capacity &opt count offset)",
|
||||
"Create a buffer from a pointer. The underlying memory of the buffer will not be "
|
||||
"reallocated or freed by the garbage collector, allowing unmanaged, mutable memory "
|
||||
"to be manipulated with buffer functions. Attempts to resize or extend the buffer "
|
||||
"beyond its initial capacity will raise an error. As with many FFI functions, this is memory "
|
||||
"unsafe and can potentially allow out of bounds memory access. Returns a new buffer.") {
|
||||
janet_sandbox_assert(JANET_SANDBOX_FFI);
|
||||
janet_arity(argc, 2, 4);
|
||||
void *pointer = janet_getpointer(argv, 0);
|
||||
int32_t capacity = janet_getnat(argv, 1);
|
||||
int32_t count = janet_optnat(argv, argc, 2, 0);
|
||||
int64_t offset = janet_optinteger64(argv, argc, 3, 0);
|
||||
uint8_t *offset_pointer = ((uint8_t *) pointer) + offset;
|
||||
return janet_wrap_buffer(janet_pointer_buffer_unsafe(offset_pointer, capacity, count));
|
||||
}
|
||||
|
||||
void janet_lib_ffi(JanetTable *env) {
|
||||
JanetRegExt ffi_cfuns[] = {
|
||||
JANET_CORE_REG("ffi/native", janet_core_raw_native),
|
||||
@@ -1507,6 +1545,7 @@ void janet_lib_ffi(JanetTable *env) {
|
||||
JANET_CORE_REG("ffi/jitfn", cfun_ffi_jitfn),
|
||||
JANET_CORE_REG("ffi/malloc", cfun_ffi_malloc),
|
||||
JANET_CORE_REG("ffi/free", cfun_ffi_free),
|
||||
JANET_CORE_REG("ffi/pointer-buffer", cfun_ffi_pointer_buffer),
|
||||
JANET_REG_END
|
||||
};
|
||||
janet_core_cfuns_ext(env, NULL, ffi_cfuns);
|
||||
|
||||
@@ -495,6 +495,8 @@ JANET_CORE_FN(cfun_fiber_new,
|
||||
"* :t - block termination signals: error + user[0-4]\n"
|
||||
"* :u - block user signals\n"
|
||||
"* :y - block yield signals\n"
|
||||
"* :w - block await signals (user9)\n"
|
||||
"* :r - block interrupt signals (user8)\n"
|
||||
"* :0-9 - block a specific user signal\n\n"
|
||||
"The sigmask argument also can take environment flags. If any mutually "
|
||||
"exclusive flags are present, the last flag takes precedence.\n\n"
|
||||
@@ -518,7 +520,7 @@ JANET_CORE_FN(cfun_fiber_new,
|
||||
} else {
|
||||
switch (view.bytes[i]) {
|
||||
default:
|
||||
janet_panicf("invalid flag %c, expected a, t, d, e, u, y, i, or p", view.bytes[i]);
|
||||
janet_panicf("invalid flag %c, expected a, t, d, e, u, y, w, r, i, or p", view.bytes[i]);
|
||||
break;
|
||||
case 'a':
|
||||
fiber->flags |=
|
||||
@@ -548,6 +550,12 @@ JANET_CORE_FN(cfun_fiber_new,
|
||||
case 'y':
|
||||
fiber->flags |= JANET_FIBER_MASK_YIELD;
|
||||
break;
|
||||
case 'w':
|
||||
fiber->flags |= JANET_FIBER_MASK_USER9;
|
||||
break;
|
||||
case 'r':
|
||||
fiber->flags |= JANET_FIBER_MASK_USER8;
|
||||
break;
|
||||
case 'i':
|
||||
if (!janet_vm.fiber->env) {
|
||||
janet_vm.fiber->env = janet_table(0);
|
||||
@@ -575,7 +583,9 @@ JANET_CORE_FN(cfun_fiber_status,
|
||||
"* :error - the fiber has errored out\n"
|
||||
"* :debug - the fiber is suspended in debug mode\n"
|
||||
"* :pending - the fiber has been yielded\n"
|
||||
"* :user(0-9) - the fiber is suspended by a user signal\n"
|
||||
"* :user(0-7) - the fiber is suspended by a user signal\n"
|
||||
"* :interrupted - the fiber was interrupted\n"
|
||||
"* :suspended - the fiber is waiting to be resumed by the scheduler\n"
|
||||
"* :alive - the fiber is currently running and cannot be resumed\n"
|
||||
"* :new - the fiber has just been created and not yet run") {
|
||||
janet_fixarity(argc, 1);
|
||||
@@ -625,11 +635,7 @@ JANET_CORE_FN(cfun_fiber_setmaxstack,
|
||||
return argv[0];
|
||||
}
|
||||
|
||||
JANET_CORE_FN(cfun_fiber_can_resume,
|
||||
"(fiber/can-resume? fiber)",
|
||||
"Check if a fiber is finished and cannot be resumed.") {
|
||||
janet_fixarity(argc, 1);
|
||||
JanetFiber *fiber = janet_getfiber(argv, 0);
|
||||
int janet_fiber_can_resume(JanetFiber *fiber) {
|
||||
JanetFiberStatus s = janet_fiber_status(fiber);
|
||||
int isFinished = s == JANET_STATUS_DEAD ||
|
||||
s == JANET_STATUS_ERROR ||
|
||||
@@ -638,7 +644,15 @@ JANET_CORE_FN(cfun_fiber_can_resume,
|
||||
s == JANET_STATUS_USER2 ||
|
||||
s == JANET_STATUS_USER3 ||
|
||||
s == JANET_STATUS_USER4;
|
||||
return janet_wrap_boolean(!isFinished);
|
||||
return !isFinished;
|
||||
}
|
||||
|
||||
JANET_CORE_FN(cfun_fiber_can_resume,
|
||||
"(fiber/can-resume? fiber)",
|
||||
"Check if a fiber is finished and cannot be resumed.") {
|
||||
janet_fixarity(argc, 1);
|
||||
JanetFiber *fiber = janet_getfiber(argv, 0);
|
||||
return janet_wrap_boolean(janet_fiber_can_resume(fiber));
|
||||
}
|
||||
|
||||
JANET_CORE_FN(cfun_fiber_last_value,
|
||||
|
||||
@@ -502,6 +502,18 @@ static Janet cfun_it_s64_mod(int32_t argc, Janet *argv) {
|
||||
return janet_wrap_abstract(box);
|
||||
}
|
||||
|
||||
static Janet cfun_it_s64_modi(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 2);
|
||||
int64_t *box = janet_abstract(&janet_s64_type, sizeof(int64_t));
|
||||
int64_t op2 = janet_unwrap_s64(argv[0]);
|
||||
int64_t op1 = janet_unwrap_s64(argv[1]);
|
||||
int64_t x = op1 % op2;
|
||||
*box = (op1 > 0)
|
||||
? ((op2 > 0) ? x : (0 == x ? x : x + op2))
|
||||
: ((op2 > 0) ? (0 == x ? x : x + op2) : x);
|
||||
return janet_wrap_abstract(box);
|
||||
}
|
||||
|
||||
OPMETHOD(int64_t, s64, add, +)
|
||||
OPMETHOD(int64_t, s64, sub, -)
|
||||
OPMETHODINVERT(int64_t, s64, subi, -)
|
||||
@@ -509,6 +521,7 @@ OPMETHOD(int64_t, s64, mul, *)
|
||||
DIVMETHOD_SIGNED(int64_t, s64, div, /)
|
||||
DIVMETHOD_SIGNED(int64_t, s64, rem, %)
|
||||
DIVMETHODINVERT_SIGNED(int64_t, s64, divi, /)
|
||||
DIVMETHODINVERT_SIGNED(int64_t, s64, remi, %)
|
||||
OPMETHOD(int64_t, s64, and, &)
|
||||
OPMETHOD(int64_t, s64, or, |)
|
||||
OPMETHOD(int64_t, s64, xor, ^)
|
||||
@@ -521,6 +534,7 @@ OPMETHOD(uint64_t, u64, mul, *)
|
||||
DIVMETHOD(uint64_t, u64, div, /)
|
||||
DIVMETHOD(uint64_t, u64, mod, %)
|
||||
DIVMETHODINVERT(uint64_t, u64, divi, /)
|
||||
DIVMETHODINVERT(uint64_t, u64, modi, %)
|
||||
OPMETHOD(uint64_t, u64, and, &)
|
||||
OPMETHOD(uint64_t, u64, or, |)
|
||||
OPMETHOD(uint64_t, u64, xor, ^)
|
||||
@@ -542,9 +556,9 @@ static JanetMethod it_s64_methods[] = {
|
||||
{"/", cfun_it_s64_div},
|
||||
{"r/", cfun_it_s64_divi},
|
||||
{"mod", cfun_it_s64_mod},
|
||||
{"rmod", cfun_it_s64_mod},
|
||||
{"rmod", cfun_it_s64_modi},
|
||||
{"%", cfun_it_s64_rem},
|
||||
{"r%", cfun_it_s64_rem},
|
||||
{"r%", cfun_it_s64_remi},
|
||||
{"&", cfun_it_s64_and},
|
||||
{"r&", cfun_it_s64_and},
|
||||
{"|", cfun_it_s64_or},
|
||||
@@ -567,9 +581,9 @@ static JanetMethod it_u64_methods[] = {
|
||||
{"/", cfun_it_u64_div},
|
||||
{"r/", cfun_it_u64_divi},
|
||||
{"mod", cfun_it_u64_mod},
|
||||
{"rmod", cfun_it_u64_mod},
|
||||
{"rmod", cfun_it_u64_modi},
|
||||
{"%", cfun_it_u64_mod},
|
||||
{"r%", cfun_it_u64_mod},
|
||||
{"r%", cfun_it_u64_modi},
|
||||
{"&", cfun_it_u64_and},
|
||||
{"r&", cfun_it_u64_and},
|
||||
{"|", cfun_it_u64_or},
|
||||
|
||||
@@ -69,12 +69,15 @@ static int32_t checkflags(const uint8_t *str) {
|
||||
break;
|
||||
case 'w':
|
||||
flags |= JANET_FILE_WRITE;
|
||||
janet_sandbox_assert(JANET_SANDBOX_FS_WRITE);
|
||||
break;
|
||||
case 'a':
|
||||
flags |= JANET_FILE_APPEND;
|
||||
janet_sandbox_assert(JANET_SANDBOX_FS);
|
||||
break;
|
||||
case 'r':
|
||||
flags |= JANET_FILE_READ;
|
||||
janet_sandbox_assert(JANET_SANDBOX_FS_READ);
|
||||
break;
|
||||
}
|
||||
for (i = 1; i < len; i++) {
|
||||
@@ -84,6 +87,7 @@ static int32_t checkflags(const uint8_t *str) {
|
||||
break;
|
||||
case '+':
|
||||
if (flags & JANET_FILE_UPDATE) return -1;
|
||||
janet_sandbox_assert(JANET_SANDBOX_FS_WRITE);
|
||||
flags |= JANET_FILE_UPDATE;
|
||||
break;
|
||||
case 'b':
|
||||
@@ -116,6 +120,7 @@ JANET_CORE_FN(cfun_io_temp,
|
||||
"(file/temp)",
|
||||
"Open an anonymous temporary file that is removed on close. "
|
||||
"Raises an error on failure.") {
|
||||
janet_sandbox_assert(JANET_SANDBOX_FS_TEMP);
|
||||
(void)argv;
|
||||
janet_fixarity(argc, 0);
|
||||
// XXX use mkostemp when we can to avoid CLOEXEC race.
|
||||
@@ -148,6 +153,7 @@ JANET_CORE_FN(cfun_io_fopen,
|
||||
flags = checkflags(fmode);
|
||||
} else {
|
||||
fmode = (const uint8_t *)"r";
|
||||
janet_sandbox_assert(JANET_SANDBOX_FS_READ);
|
||||
flags = JANET_FILE_READ;
|
||||
}
|
||||
FILE *f = fopen((const char *)fname, (const char *)fmode);
|
||||
@@ -342,11 +348,24 @@ JANET_CORE_FN(cfun_io_fseek,
|
||||
return argv[0];
|
||||
}
|
||||
|
||||
JANET_CORE_FN(cfun_io_ftell,
|
||||
"(file/tell f)",
|
||||
"Get the current value of the file position for file `f`.") {
|
||||
janet_fixarity(argc, 1);
|
||||
JanetFile *iof = janet_getabstract(argv, 0, &janet_file_type);
|
||||
if (iof->flags & JANET_FILE_CLOSED)
|
||||
janet_panic("file is closed");
|
||||
long pos = ftell(iof->file);
|
||||
if (pos == -1) janet_panic("error getting position in file");
|
||||
return janet_wrap_number((double)pos);
|
||||
}
|
||||
|
||||
static JanetMethod io_file_methods[] = {
|
||||
{"close", cfun_io_fclose},
|
||||
{"flush", cfun_io_fflush},
|
||||
{"read", cfun_io_fread},
|
||||
{"seek", cfun_io_fseek},
|
||||
{"tell", cfun_io_ftell},
|
||||
{"write", cfun_io_fwrite},
|
||||
{NULL, NULL}
|
||||
};
|
||||
@@ -777,6 +796,7 @@ void janet_lib_io(JanetTable *env) {
|
||||
JANET_CORE_REG("file/write", cfun_io_fwrite),
|
||||
JANET_CORE_REG("file/flush", cfun_io_fflush),
|
||||
JANET_CORE_REG("file/seek", cfun_io_fseek),
|
||||
JANET_CORE_REG("file/tell", cfun_io_ftell),
|
||||
JANET_REG_END
|
||||
};
|
||||
janet_core_cfuns_ext(env, NULL, io_cfuns);
|
||||
|
||||
@@ -67,7 +67,8 @@ enum {
|
||||
LB_UNSAFE_POINTER, /* 222 */
|
||||
LB_STRUCT_PROTO, /* 223 */
|
||||
#ifdef JANET_EV
|
||||
LB_THREADED_ABSTRACT/* 224 */
|
||||
LB_THREADED_ABSTRACT, /* 224 */
|
||||
LB_POINTER_BUFFER, /* 224 */
|
||||
#endif
|
||||
} LeadBytes;
|
||||
|
||||
@@ -153,6 +154,10 @@ static void pushbytes(MarshalState *st, const uint8_t *bytes, int32_t len) {
|
||||
janet_buffer_push_bytes(st->buf, bytes, len);
|
||||
}
|
||||
|
||||
static void pushpointer(MarshalState *st, void *ptr) {
|
||||
janet_buffer_push_bytes(st->buf, (const uint8_t *) &ptr, sizeof(ptr));
|
||||
}
|
||||
|
||||
/* Marshal a size_t onto the buffer */
|
||||
static void push64(MarshalState *st, uint64_t x) {
|
||||
if (x <= 0xF0) {
|
||||
@@ -511,6 +516,16 @@ static void marshal_one(MarshalState *st, Janet x, int flags) {
|
||||
JanetBuffer *buffer = janet_unwrap_buffer(x);
|
||||
/* Record reference */
|
||||
MARK_SEEN();
|
||||
#ifdef JANET_EV
|
||||
if ((flags & JANET_MARSHAL_UNSAFE) &&
|
||||
(buffer->gc.flags & JANET_BUFFER_FLAG_NO_REALLOC)) {
|
||||
pushbyte(st, LB_POINTER_BUFFER);
|
||||
pushint(st, buffer->count);
|
||||
pushint(st, buffer->capacity);
|
||||
pushpointer(st, buffer->data);
|
||||
return;
|
||||
}
|
||||
#endif
|
||||
pushbyte(st, LB_BUFFER);
|
||||
pushint(st, buffer->count);
|
||||
pushbytes(st, buffer->data, buffer->count);
|
||||
@@ -606,8 +621,7 @@ static void marshal_one(MarshalState *st, Janet x, int flags) {
|
||||
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 *));
|
||||
pushpointer(st, janet_unwrap_pointer(x));
|
||||
return;
|
||||
}
|
||||
no_registry:
|
||||
@@ -1415,6 +1429,29 @@ static const uint8_t *unmarshal_one(
|
||||
janet_v_push(st->lookup, *out);
|
||||
return data;
|
||||
}
|
||||
#ifdef JANET_EV
|
||||
case LB_POINTER_BUFFER: {
|
||||
data++;
|
||||
int32_t count = readnat(st, &data);
|
||||
int32_t capacity = readnat(st, &data);
|
||||
MARSH_EOS(st, data + sizeof(void *));
|
||||
union {
|
||||
void *ptr;
|
||||
uint8_t bytes[sizeof(void *)];
|
||||
} u;
|
||||
if (!(flags & JANET_MARSHAL_UNSAFE)) {
|
||||
janet_panicf("unsafe flag not given, "
|
||||
"will not unmarshal raw pointer at index %d",
|
||||
(int)(data - st->start));
|
||||
}
|
||||
memcpy(u.bytes, data, sizeof(void *));
|
||||
data += sizeof(void *);
|
||||
JanetBuffer *buffer = janet_pointer_buffer_unsafe(u.ptr, capacity, count);
|
||||
*out = janet_wrap_buffer(buffer);
|
||||
janet_v_push(st->lookup, *out);
|
||||
return data;
|
||||
}
|
||||
#endif
|
||||
case LB_UNSAFE_CFUNCTION: {
|
||||
MARSH_EOS(st, data + sizeof(JanetCFunction));
|
||||
data++;
|
||||
|
||||
@@ -150,8 +150,8 @@ JANET_CORE_FN(cfun_rng_uniform,
|
||||
|
||||
JANET_CORE_FN(cfun_rng_int,
|
||||
"(math/rng-int rng &opt max)",
|
||||
"Extract a random random integer in the range [0, max] from the RNG. If "
|
||||
"no max is given, the default is 2^31 - 1."
|
||||
"Extract a random integer in the range [0, max) for max > 0 from the RNG. "
|
||||
"If max is 0, return 0. If no max is given, the default is 2^31 - 1."
|
||||
) {
|
||||
janet_arity(argc, 1, 2);
|
||||
JanetRNG *rng = janet_getabstract(argv, 0, &janet_rng_type);
|
||||
@@ -254,45 +254,45 @@ JANET_CORE_FN(janet_srand,
|
||||
return janet_wrap_nil();
|
||||
}
|
||||
|
||||
#define JANET_DEFINE_NAMED_MATHOP(c_name, janet_name, fop, doc)\
|
||||
JANET_CORE_FN(janet_##c_name, "(math/" #janet_name " x)", doc) {\
|
||||
#define JANET_DEFINE_NAMED_MATHOP(janet_name, fop, doc)\
|
||||
JANET_CORE_FN(janet_##fop, "(math/" janet_name " x)", doc) {\
|
||||
janet_fixarity(argc, 1); \
|
||||
double x = janet_getnumber(argv, 0); \
|
||||
return janet_wrap_number(fop(x)); \
|
||||
}
|
||||
|
||||
#define JANET_DEFINE_MATHOP(name, fop, doc) JANET_DEFINE_NAMED_MATHOP(name, name, fop, doc)
|
||||
#define JANET_DEFINE_MATHOP(fop, doc) JANET_DEFINE_NAMED_MATHOP(#fop, fop, doc)
|
||||
|
||||
JANET_DEFINE_MATHOP(acos, acos, "Returns the arccosine of x.")
|
||||
JANET_DEFINE_MATHOP(asin, asin, "Returns the arcsin of x.")
|
||||
JANET_DEFINE_MATHOP(atan, atan, "Returns the arctangent of x.")
|
||||
JANET_DEFINE_MATHOP(cos, cos, "Returns the cosine of x.")
|
||||
JANET_DEFINE_MATHOP(cosh, cosh, "Returns the hyperbolic cosine of x.")
|
||||
JANET_DEFINE_MATHOP(acosh, acosh, "Returns the hyperbolic arccosine of x.")
|
||||
JANET_DEFINE_MATHOP(sin, sin, "Returns the sine of x.")
|
||||
JANET_DEFINE_MATHOP(sinh, sinh, "Returns the hyperbolic sine of x.")
|
||||
JANET_DEFINE_MATHOP(asinh, asinh, "Returns the hyperbolic arcsine of x.")
|
||||
JANET_DEFINE_MATHOP(tan, tan, "Returns the tangent of x.")
|
||||
JANET_DEFINE_MATHOP(tanh, tanh, "Returns the hyperbolic tangent of x.")
|
||||
JANET_DEFINE_MATHOP(atanh, atanh, "Returns the hyperbolic arctangent of x.")
|
||||
JANET_DEFINE_MATHOP(exp, exp, "Returns e to the power of x.")
|
||||
JANET_DEFINE_MATHOP(exp2, exp2, "Returns 2 to the power of x.")
|
||||
JANET_DEFINE_MATHOP(expm1, expm1, "Returns e to the power of x minus 1.")
|
||||
JANET_DEFINE_MATHOP(log, log, "Returns the natural logarithm of x.")
|
||||
JANET_DEFINE_MATHOP(log10, log10, "Returns the log base 10 of x.")
|
||||
JANET_DEFINE_MATHOP(log2, log2, "Returns the log base 2 of x.")
|
||||
JANET_DEFINE_MATHOP(sqrt, sqrt, "Returns the square root of x.")
|
||||
JANET_DEFINE_MATHOP(cbrt, cbrt, "Returns the cube root of x.")
|
||||
JANET_DEFINE_MATHOP(ceil, ceil, "Returns the smallest integer value number that is not less than x.")
|
||||
JANET_DEFINE_MATHOP(abs, fabs, "Return the absolute value of x.")
|
||||
JANET_DEFINE_MATHOP(floor, floor, "Returns the largest integer value number that is not greater than x.")
|
||||
JANET_DEFINE_MATHOP(trunc, trunc, "Returns the integer between x and 0 nearest to x.")
|
||||
JANET_DEFINE_MATHOP(round, round, "Returns the integer nearest to x.")
|
||||
JANET_DEFINE_MATHOP(gamma, tgamma, "Returns gamma(x).")
|
||||
JANET_DEFINE_NAMED_MATHOP(lgamma, "log-gamma", lgamma, "Returns log-gamma(x).")
|
||||
JANET_DEFINE_MATHOP(log1p, log1p, "Returns (log base e of x) + 1 more accurately than (+ (math/log x) 1)")
|
||||
JANET_DEFINE_MATHOP(erf, erf, "Returns the error function of x.")
|
||||
JANET_DEFINE_MATHOP(erfc, erfc, "Returns the complementary error function of x.")
|
||||
JANET_DEFINE_MATHOP(acos, "Returns the arccosine of x.")
|
||||
JANET_DEFINE_MATHOP(asin, "Returns the arcsin of x.")
|
||||
JANET_DEFINE_MATHOP(atan, "Returns the arctangent of x.")
|
||||
JANET_DEFINE_MATHOP(cos, "Returns the cosine of x.")
|
||||
JANET_DEFINE_MATHOP(cosh, "Returns the hyperbolic cosine of x.")
|
||||
JANET_DEFINE_MATHOP(acosh, "Returns the hyperbolic arccosine of x.")
|
||||
JANET_DEFINE_MATHOP(sin, "Returns the sine of x.")
|
||||
JANET_DEFINE_MATHOP(sinh, "Returns the hyperbolic sine of x.")
|
||||
JANET_DEFINE_MATHOP(asinh, "Returns the hyperbolic arcsine of x.")
|
||||
JANET_DEFINE_MATHOP(tan, "Returns the tangent of x.")
|
||||
JANET_DEFINE_MATHOP(tanh, "Returns the hyperbolic tangent of x.")
|
||||
JANET_DEFINE_MATHOP(atanh, "Returns the hyperbolic arctangent of x.")
|
||||
JANET_DEFINE_MATHOP(exp, "Returns e to the power of x.")
|
||||
JANET_DEFINE_MATHOP(exp2, "Returns 2 to the power of x.")
|
||||
JANET_DEFINE_MATHOP(expm1, "Returns e to the power of x minus 1.")
|
||||
JANET_DEFINE_MATHOP(log, "Returns the natural logarithm of x.")
|
||||
JANET_DEFINE_MATHOP(log10, "Returns the log base 10 of x.")
|
||||
JANET_DEFINE_MATHOP(log2, "Returns the log base 2 of x.")
|
||||
JANET_DEFINE_MATHOP(sqrt, "Returns the square root of x.")
|
||||
JANET_DEFINE_MATHOP(cbrt, "Returns the cube root of x.")
|
||||
JANET_DEFINE_MATHOP(ceil, "Returns the smallest integer value number that is not less than x.")
|
||||
JANET_DEFINE_MATHOP(floor, "Returns the largest integer value number that is not greater than x.")
|
||||
JANET_DEFINE_MATHOP(trunc, "Returns the integer between x and 0 nearest to x.")
|
||||
JANET_DEFINE_MATHOP(round, "Returns the integer nearest to x.")
|
||||
JANET_DEFINE_MATHOP(log1p, "Returns (log base e of x) + 1 more accurately than (+ (math/log x) 1)")
|
||||
JANET_DEFINE_MATHOP(erf, "Returns the error function of x.")
|
||||
JANET_DEFINE_MATHOP(erfc, "Returns the complementary error function of x.")
|
||||
JANET_DEFINE_NAMED_MATHOP("log-gamma", lgamma, "Returns log-gamma(x).")
|
||||
JANET_DEFINE_NAMED_MATHOP("abs", fabs, "Return the absolute value of x.")
|
||||
JANET_DEFINE_NAMED_MATHOP("gamma", tgamma, "Returns gamma(x).")
|
||||
|
||||
#define JANET_DEFINE_MATH2OP(name, fop, signature, doc)\
|
||||
JANET_CORE_FN(janet_##name, signature, doc) {\
|
||||
@@ -317,7 +317,7 @@ static double janet_gcd(double x, double y) {
|
||||
#ifdef NAN
|
||||
return NAN;
|
||||
#else
|
||||
return 0.0 \ 0.0;
|
||||
return 0.0 / 0.0;
|
||||
#endif
|
||||
}
|
||||
if (isinf(x) || isinf(y)) return INFINITY;
|
||||
@@ -370,7 +370,7 @@ void janet_lib_math(JanetTable *env) {
|
||||
JANET_CORE_REG("math/floor", janet_floor),
|
||||
JANET_CORE_REG("math/ceil", janet_ceil),
|
||||
JANET_CORE_REG("math/pow", janet_pow),
|
||||
JANET_CORE_REG("math/abs", janet_abs),
|
||||
JANET_CORE_REG("math/abs", janet_fabs),
|
||||
JANET_CORE_REG("math/sinh", janet_sinh),
|
||||
JANET_CORE_REG("math/cosh", janet_cosh),
|
||||
JANET_CORE_REG("math/tanh", janet_tanh),
|
||||
@@ -385,7 +385,7 @@ void janet_lib_math(JanetTable *env) {
|
||||
JANET_CORE_REG("math/hypot", janet_hypot),
|
||||
JANET_CORE_REG("math/exp2", janet_exp2),
|
||||
JANET_CORE_REG("math/log1p", janet_log1p),
|
||||
JANET_CORE_REG("math/gamma", janet_gamma),
|
||||
JANET_CORE_REG("math/gamma", janet_tgamma),
|
||||
JANET_CORE_REG("math/log-gamma", janet_lgamma),
|
||||
JANET_CORE_REG("math/erfc", janet_erfc),
|
||||
JANET_CORE_REG("math/erf", janet_erf),
|
||||
|
||||
@@ -334,6 +334,7 @@ JANET_CORE_FN(cfun_net_sockaddr,
|
||||
"given in the port argument. On Linux, abstract "
|
||||
"unix domain sockets are specified with a leading '@' character in port. If `multi` is truthy, will "
|
||||
"return all address that match in an array instead of just the first.") {
|
||||
janet_sandbox_assert(JANET_SANDBOX_NET_CONNECT); /* connect OR listen */
|
||||
janet_arity(argc, 2, 4);
|
||||
int socktype = janet_get_sockettype(argv, argc, 2);
|
||||
int is_unix = 0;
|
||||
@@ -379,6 +380,7 @@ JANET_CORE_FN(cfun_net_connect,
|
||||
"to specify a connection type, either :stream or :datagram. The default is :stream. "
|
||||
"Bindhost is an optional string to select from what address to make the outgoing "
|
||||
"connection, with the default being the same as using the OS's preferred address. ") {
|
||||
janet_sandbox_assert(JANET_SANDBOX_NET_CONNECT);
|
||||
janet_arity(argc, 2, 5);
|
||||
|
||||
/* Check arguments */
|
||||
@@ -573,6 +575,7 @@ JANET_CORE_FN(cfun_net_listen,
|
||||
"The type parameter specifies the type of network connection, either "
|
||||
"a :stream (usually tcp), or :datagram (usually udp). If not specified, the default is "
|
||||
":stream. The host and port arguments are the same as in net/address.") {
|
||||
janet_sandbox_assert(JANET_SANDBOX_NET_LISTEN);
|
||||
janet_arity(argc, 2, 3);
|
||||
|
||||
/* Get host, port, and handler*/
|
||||
|
||||
175
src/core/os.c
175
src/core/os.c
@@ -126,6 +126,8 @@ JANET_CORE_FN(os_which,
|
||||
"* :freebsd\n\n"
|
||||
"* :openbsd\n\n"
|
||||
"* :netbsd\n\n"
|
||||
"* :dragonfly\n\n"
|
||||
"* :bsd\n\n"
|
||||
"* :posix - A POSIX compatible system (default)\n\n"
|
||||
"May also return a custom keyword specified at build time.") {
|
||||
janet_fixarity(argc, 0);
|
||||
@@ -150,6 +152,8 @@ JANET_CORE_FN(os_which,
|
||||
return janet_ckeywordv("netbsd");
|
||||
#elif defined(__OpenBSD__)
|
||||
return janet_ckeywordv("openbsd");
|
||||
#elif defined(__DragonFly__)
|
||||
return janet_ckeywordv("dragonfly");
|
||||
#elif defined(JANET_BSD)
|
||||
return janet_ckeywordv("bsd");
|
||||
#else
|
||||
@@ -878,6 +882,7 @@ static JanetFile *get_stdio_for_handle(JanetHandle handle, void *orig, int iswri
|
||||
#endif
|
||||
|
||||
static Janet os_execute_impl(int32_t argc, Janet *argv, int is_spawn) {
|
||||
janet_sandbox_assert(JANET_SANDBOX_SUBPROCESS);
|
||||
janet_arity(argc, 1, 3);
|
||||
|
||||
/* Get flags */
|
||||
@@ -1038,21 +1043,21 @@ static Janet os_execute_impl(int32_t argc, Janet *argv, int is_spawn) {
|
||||
if (pipe_in != JANET_HANDLE_NONE) {
|
||||
posix_spawn_file_actions_adddup2(&actions, pipe_in, 0);
|
||||
posix_spawn_file_actions_addclose(&actions, pipe_in);
|
||||
} else if (new_in != JANET_HANDLE_NONE) {
|
||||
} else if (new_in != JANET_HANDLE_NONE && new_in != 0) {
|
||||
posix_spawn_file_actions_adddup2(&actions, new_in, 0);
|
||||
posix_spawn_file_actions_addclose(&actions, new_in);
|
||||
}
|
||||
if (pipe_out != JANET_HANDLE_NONE) {
|
||||
posix_spawn_file_actions_adddup2(&actions, pipe_out, 1);
|
||||
posix_spawn_file_actions_addclose(&actions, pipe_out);
|
||||
} else if (new_out != JANET_HANDLE_NONE) {
|
||||
} else if (new_out != JANET_HANDLE_NONE && new_out != 1) {
|
||||
posix_spawn_file_actions_adddup2(&actions, new_out, 1);
|
||||
posix_spawn_file_actions_addclose(&actions, new_out);
|
||||
}
|
||||
if (pipe_err != JANET_HANDLE_NONE) {
|
||||
posix_spawn_file_actions_adddup2(&actions, pipe_err, 2);
|
||||
posix_spawn_file_actions_addclose(&actions, pipe_err);
|
||||
} else if (new_err != JANET_HANDLE_NONE) {
|
||||
} else if (new_err != JANET_HANDLE_NONE && new_err != 2) {
|
||||
posix_spawn_file_actions_adddup2(&actions, new_err, 2);
|
||||
posix_spawn_file_actions_addclose(&actions, new_err);
|
||||
}
|
||||
@@ -1080,7 +1085,8 @@ static Janet os_execute_impl(int32_t argc, Janet *argv, int is_spawn) {
|
||||
|
||||
os_execute_cleanup(envp, child_argv);
|
||||
if (status) {
|
||||
janet_panicf("%p: %s", argv[0], strerror(errno));
|
||||
/* correct for macos bug where errno is not set */
|
||||
janet_panicf("%p: %s", argv[0], strerror(errno ? errno : ENOENT));
|
||||
}
|
||||
|
||||
#endif
|
||||
@@ -1171,6 +1177,7 @@ static JanetEVGenericMessage os_shell_subr(JanetEVGenericMessage args) {
|
||||
JANET_CORE_FN(os_shell,
|
||||
"(os/shell str)",
|
||||
"Pass a command string str directly to the system shell.") {
|
||||
janet_sandbox_assert(JANET_SANDBOX_SUBPROCESS);
|
||||
janet_arity(argc, 0, 1);
|
||||
const char *cmd = argc
|
||||
? janet_getcstring(argv, 0)
|
||||
@@ -1190,6 +1197,7 @@ JANET_CORE_FN(os_shell,
|
||||
JANET_CORE_FN(os_environ,
|
||||
"(os/environ)",
|
||||
"Get a copy of the OS environment table.") {
|
||||
janet_sandbox_assert(JANET_SANDBOX_ENV);
|
||||
(void) argv;
|
||||
janet_fixarity(argc, 0);
|
||||
int32_t nenv = 0;
|
||||
@@ -1221,6 +1229,7 @@ JANET_CORE_FN(os_environ,
|
||||
JANET_CORE_FN(os_getenv,
|
||||
"(os/getenv variable &opt dflt)",
|
||||
"Get the string value of an environment variable.") {
|
||||
janet_sandbox_assert(JANET_SANDBOX_ENV);
|
||||
janet_arity(argc, 1, 2);
|
||||
const char *cstr = janet_getcstring(argv, 0);
|
||||
const char *res = getenv(cstr);
|
||||
@@ -1244,6 +1253,7 @@ JANET_CORE_FN(os_setenv,
|
||||
#define SETENV(K,V) setenv(K, V, 1)
|
||||
#define UNSETENV(K) unsetenv(K)
|
||||
#endif
|
||||
janet_sandbox_assert(JANET_SANDBOX_ENV);
|
||||
janet_arity(argc, 1, 2);
|
||||
const char *ks = janet_getcstring(argv, 0);
|
||||
const char *vs = janet_optcstring(argv, argc, 1, NULL);
|
||||
@@ -1271,6 +1281,7 @@ JANET_CORE_FN(os_clock,
|
||||
"(os/clock)",
|
||||
"Return the number of whole + fractional seconds since some fixed point in time. The clock "
|
||||
"is guaranteed to be non-decreasing in real time.") {
|
||||
janet_sandbox_assert(JANET_SANDBOX_HRTIME);
|
||||
janet_fixarity(argc, 0);
|
||||
(void) argv;
|
||||
struct timespec tv;
|
||||
@@ -1340,6 +1351,40 @@ JANET_CORE_FN(os_cryptorand,
|
||||
return janet_wrap_buffer(buffer);
|
||||
}
|
||||
|
||||
/* Helper function to get given or current time as local or UTC struct tm.
|
||||
* - arg n+0: optional time_t to be converted, uses current time if not given
|
||||
* - arg n+1: optional truthy to indicate the convnersion uses local time */
|
||||
static struct tm *time_to_tm(const Janet *argv, int32_t argc, int32_t n, struct tm *t_infos) {
|
||||
time_t t;
|
||||
if (argc > n && !janet_checktype(argv[n], JANET_NIL)) {
|
||||
int64_t integer = janet_getinteger64(argv, n);
|
||||
t = (time_t) integer;
|
||||
} else {
|
||||
time(&t);
|
||||
}
|
||||
struct tm *t_info = NULL;
|
||||
if (argc > n + 1 && janet_truthy(argv[n + 1])) {
|
||||
/* local time */
|
||||
#ifdef JANET_WINDOWS
|
||||
_tzset();
|
||||
localtime_s(t_infos, &t);
|
||||
t_info = t_infos;
|
||||
#else
|
||||
tzset();
|
||||
t_info = localtime_r(&t, t_infos);
|
||||
#endif
|
||||
} else {
|
||||
/* utc time */
|
||||
#ifdef JANET_WINDOWS
|
||||
gmtime_s(t_infos, &t);
|
||||
t_info = t_infos;
|
||||
#else
|
||||
t_info = gmtime_r(&t, t_infos);
|
||||
#endif
|
||||
}
|
||||
return t_info;
|
||||
}
|
||||
|
||||
JANET_CORE_FN(os_date,
|
||||
"(os/date &opt time local)",
|
||||
"Returns the given time as a date struct, or the current time if `time` is not given. "
|
||||
@@ -1357,34 +1402,8 @@ JANET_CORE_FN(os_date,
|
||||
"* :dst - if Day Light Savings is in effect") {
|
||||
janet_arity(argc, 0, 2);
|
||||
(void) argv;
|
||||
time_t t;
|
||||
struct tm t_infos;
|
||||
struct tm *t_info = NULL;
|
||||
if (argc && !janet_checktype(argv[0], JANET_NIL)) {
|
||||
int64_t integer = janet_getinteger64(argv, 0);
|
||||
t = (time_t) integer;
|
||||
} else {
|
||||
time(&t);
|
||||
}
|
||||
if (argc >= 2 && janet_truthy(argv[1])) {
|
||||
/* local time */
|
||||
#ifdef JANET_WINDOWS
|
||||
_tzset();
|
||||
localtime_s(&t_infos, &t);
|
||||
t_info = &t_infos;
|
||||
#else
|
||||
tzset();
|
||||
t_info = localtime_r(&t, &t_infos);
|
||||
#endif
|
||||
} else {
|
||||
/* utc time */
|
||||
#ifdef JANET_WINDOWS
|
||||
gmtime_s(&t_infos, &t);
|
||||
t_info = &t_infos;
|
||||
#else
|
||||
t_info = gmtime_r(&t, &t_infos);
|
||||
#endif
|
||||
}
|
||||
struct tm *t_info = time_to_tm(argv, argc, 0, &t_infos);
|
||||
JanetKV *st = janet_struct_begin(9);
|
||||
janet_struct_put(st, janet_ckeywordv("seconds"), janet_wrap_number(t_info->tm_sec));
|
||||
janet_struct_put(st, janet_ckeywordv("minutes"), janet_wrap_number(t_info->tm_min));
|
||||
@@ -1398,6 +1417,34 @@ JANET_CORE_FN(os_date,
|
||||
return janet_wrap_struct(janet_struct_end(st));
|
||||
}
|
||||
|
||||
#define SIZETIMEFMT 250
|
||||
|
||||
JANET_CORE_FN(os_strftime,
|
||||
"(os/strftime fmt &opt time local)",
|
||||
"Format the given time as a string, or the current time if `time` is not given. "
|
||||
"The time is formatted according to the same rules as the ISO C89 function strftime(). "
|
||||
"The time is formatted in UTC unless `local` is truthy, in which case the date is formatted for "
|
||||
"the local timezone.") {
|
||||
janet_arity(argc, 1, 3);
|
||||
const char *fmt = janet_getcstring(argv, 0);
|
||||
/* ANSI X3.159-1989, section 4.12.3.5 "The strftime function" */
|
||||
static const char *valid = "aAbBcdHIjmMpSUwWxXyYZ%";
|
||||
const char *p = fmt;
|
||||
while (*p) {
|
||||
if (*p++ == '%') {
|
||||
if (!strchr(valid, *p)) {
|
||||
janet_panicf("invalid conversion specifier '%%%c'", *p);
|
||||
}
|
||||
p++;
|
||||
}
|
||||
}
|
||||
struct tm t_infos;
|
||||
struct tm *t_info = time_to_tm(argv, argc, 1, &t_infos);
|
||||
char buf[SIZETIMEFMT];
|
||||
(void)strftime(buf, SIZETIMEFMT, fmt, t_info);
|
||||
return janet_cstringv(buf);
|
||||
}
|
||||
|
||||
static int entry_getdst(Janet env_entry) {
|
||||
Janet v;
|
||||
if (janet_checktype(env_entry, JANET_TABLE)) {
|
||||
@@ -1512,6 +1559,7 @@ JANET_CORE_FN(os_link,
|
||||
"Iff symlink is truthy, creates a symlink. "
|
||||
"Iff symlink is falsey or not provided, "
|
||||
"creates a hard link. Does not work on Windows.") {
|
||||
janet_sandbox_assert(JANET_SANDBOX_FS_WRITE);
|
||||
janet_arity(argc, 2, 3);
|
||||
#ifdef JANET_WINDOWS
|
||||
(void) argc;
|
||||
@@ -1530,6 +1578,7 @@ JANET_CORE_FN(os_link,
|
||||
JANET_CORE_FN(os_symlink,
|
||||
"(os/symlink oldpath newpath)",
|
||||
"Create a symlink from oldpath to newpath, returning nil. Same as `(os/link oldpath newpath true)`.") {
|
||||
janet_sandbox_assert(JANET_SANDBOX_FS_WRITE);
|
||||
janet_fixarity(argc, 2);
|
||||
#ifdef JANET_WINDOWS
|
||||
(void) argc;
|
||||
@@ -1552,6 +1601,7 @@ JANET_CORE_FN(os_mkdir,
|
||||
"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 created, false if the directory already exists, and "
|
||||
"errors otherwise.") {
|
||||
janet_sandbox_assert(JANET_SANDBOX_FS_WRITE);
|
||||
janet_fixarity(argc, 1);
|
||||
const char *path = janet_getcstring(argv, 0);
|
||||
#ifdef JANET_WINDOWS
|
||||
@@ -1567,6 +1617,7 @@ JANET_CORE_FN(os_mkdir,
|
||||
JANET_CORE_FN(os_rmdir,
|
||||
"(os/rmdir path)",
|
||||
"Delete a directory. The directory must be empty to succeed.") {
|
||||
janet_sandbox_assert(JANET_SANDBOX_FS_WRITE);
|
||||
janet_fixarity(argc, 1);
|
||||
const char *path = janet_getcstring(argv, 0);
|
||||
#ifdef JANET_WINDOWS
|
||||
@@ -1581,6 +1632,7 @@ JANET_CORE_FN(os_rmdir,
|
||||
JANET_CORE_FN(os_cd,
|
||||
"(os/cd path)",
|
||||
"Change current directory to path. Returns nil on success, errors on failure.") {
|
||||
janet_sandbox_assert(JANET_SANDBOX_FS_READ);
|
||||
janet_fixarity(argc, 1);
|
||||
const char *path = janet_getcstring(argv, 0);
|
||||
#ifdef JANET_WINDOWS
|
||||
@@ -1596,6 +1648,7 @@ JANET_CORE_FN(os_touch,
|
||||
"(os/touch path &opt actime modtime)",
|
||||
"Update the access time and modification times for a file. By default, sets "
|
||||
"times to the current time.") {
|
||||
janet_sandbox_assert(JANET_SANDBOX_FS_WRITE);
|
||||
janet_arity(argc, 1, 3);
|
||||
const char *path = janet_getcstring(argv, 0);
|
||||
struct utimbuf timebuf, *bufp;
|
||||
@@ -1845,6 +1898,7 @@ static const struct OsStatGetter os_stat_getters[] = {
|
||||
};
|
||||
|
||||
static Janet os_stat_or_lstat(int do_lstat, int32_t argc, Janet *argv) {
|
||||
janet_sandbox_assert(JANET_SANDBOX_FS_READ);
|
||||
janet_arity(argc, 1, 2);
|
||||
const char *path = janet_getcstring(argv, 0);
|
||||
JanetTable *tab = NULL;
|
||||
@@ -1926,6 +1980,7 @@ JANET_CORE_FN(os_chmod,
|
||||
"`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.") {
|
||||
janet_sandbox_assert(JANET_SANDBOX_FS_WRITE);
|
||||
janet_fixarity(argc, 2);
|
||||
const char *path = janet_getcstring(argv, 0);
|
||||
#ifdef JANET_WINDOWS
|
||||
@@ -1941,6 +1996,7 @@ JANET_CORE_FN(os_chmod,
|
||||
JANET_CORE_FN(os_umask,
|
||||
"(os/umask mask)",
|
||||
"Set a new umask, returns the old umask.") {
|
||||
janet_sandbox_assert(JANET_SANDBOX_FS_WRITE);
|
||||
janet_fixarity(argc, 1);
|
||||
int mask = (int) os_getmode(argv, 0);
|
||||
#ifdef JANET_WINDOWS
|
||||
@@ -1956,6 +2012,7 @@ JANET_CORE_FN(os_dir,
|
||||
"(os/dir dir &opt array)",
|
||||
"Iterate over files and subdirectories in a directory. Returns an array of paths parts, "
|
||||
"with only the file name or directory name and no prefix.") {
|
||||
janet_sandbox_assert(JANET_SANDBOX_FS_READ);
|
||||
janet_arity(argc, 1, 2);
|
||||
const char *dir = janet_getcstring(argv, 0);
|
||||
JanetArray *paths = (argc == 2) ? janet_getarray(argv, 1) : janet_array(0);
|
||||
@@ -1993,6 +2050,7 @@ JANET_CORE_FN(os_dir,
|
||||
JANET_CORE_FN(os_rename,
|
||||
"(os/rename oldname newname)",
|
||||
"Rename a file on disk to a new path. Returns nil.") {
|
||||
janet_sandbox_assert(JANET_SANDBOX_FS_WRITE);
|
||||
janet_fixarity(argc, 2);
|
||||
const char *src = janet_getcstring(argv, 0);
|
||||
const char *dest = janet_getcstring(argv, 1);
|
||||
@@ -2007,6 +2065,7 @@ JANET_CORE_FN(os_realpath,
|
||||
"(os/realpath path)",
|
||||
"Get the absolute path for a given path, following ../, ./, and symlinks. "
|
||||
"Returns an absolute path as a string.") {
|
||||
janet_sandbox_assert(JANET_SANDBOX_FS_READ);
|
||||
janet_fixarity(argc, 1);
|
||||
const char *src = janet_getcstring(argv, 0);
|
||||
#ifdef JANET_NO_REALPATH
|
||||
@@ -2101,19 +2160,23 @@ JANET_CORE_FN(os_open,
|
||||
case 'r':
|
||||
desiredAccess |= GENERIC_READ;
|
||||
stream_flags |= JANET_STREAM_READABLE;
|
||||
janet_sandbox_assert(JANET_SANDBOX_FS_READ);
|
||||
break;
|
||||
case 'w':
|
||||
desiredAccess |= GENERIC_WRITE;
|
||||
stream_flags |= JANET_STREAM_WRITABLE;
|
||||
janet_sandbox_assert(JANET_SANDBOX_FS_WRITE);
|
||||
break;
|
||||
case 'c':
|
||||
creatUnix |= OCREAT;
|
||||
janet_sandbox_assert(JANET_SANDBOX_FS_WRITE);
|
||||
break;
|
||||
case 'e':
|
||||
creatUnix |= OEXCL;
|
||||
break;
|
||||
case 't':
|
||||
creatUnix |= OTRUNC;
|
||||
janet_sandbox_assert(JANET_SANDBOX_FS_WRITE);
|
||||
break;
|
||||
/* Windows only flags */
|
||||
case 'D':
|
||||
@@ -2183,19 +2246,23 @@ JANET_CORE_FN(os_open,
|
||||
case 'r':
|
||||
read_flag = 1;
|
||||
stream_flags |= JANET_STREAM_READABLE;
|
||||
janet_sandbox_assert(JANET_SANDBOX_FS_READ);
|
||||
break;
|
||||
case 'w':
|
||||
write_flag = 1;
|
||||
stream_flags |= JANET_STREAM_WRITABLE;
|
||||
janet_sandbox_assert(JANET_SANDBOX_FS_WRITE);
|
||||
break;
|
||||
case 'c':
|
||||
open_flags |= O_CREAT;
|
||||
janet_sandbox_assert(JANET_SANDBOX_FS_WRITE);
|
||||
break;
|
||||
case 'e':
|
||||
open_flags |= O_EXCL;
|
||||
break;
|
||||
case 't':
|
||||
open_flags |= O_TRUNC;
|
||||
janet_sandbox_assert(JANET_SANDBOX_FS_WRITE);
|
||||
break;
|
||||
/* posix only */
|
||||
case 'x':
|
||||
@@ -2270,48 +2337,66 @@ void janet_lib_os(JanetTable *env) {
|
||||
JANET_CORE_REG("os/arch", os_arch),
|
||||
JANET_CORE_REG("os/compiler", os_compiler),
|
||||
#ifndef JANET_REDUCED_OS
|
||||
|
||||
/* misc (un-sandboxed) */
|
||||
JANET_CORE_REG("os/cpu-count", os_cpu_count),
|
||||
JANET_CORE_REG("os/cwd", os_cwd),
|
||||
JANET_CORE_REG("os/cryptorand", os_cryptorand),
|
||||
JANET_CORE_REG("os/perm-string", os_permission_string),
|
||||
JANET_CORE_REG("os/perm-int", os_permission_int),
|
||||
JANET_CORE_REG("os/mktime", os_mktime),
|
||||
JANET_CORE_REG("os/time", os_time), /* not high resolution */
|
||||
JANET_CORE_REG("os/date", os_date), /* not high resolution */
|
||||
JANET_CORE_REG("os/strftime", os_strftime),
|
||||
JANET_CORE_REG("os/sleep", os_sleep),
|
||||
|
||||
/* env functions */
|
||||
JANET_CORE_REG("os/environ", os_environ),
|
||||
JANET_CORE_REG("os/getenv", os_getenv),
|
||||
JANET_CORE_REG("os/setenv", os_setenv),
|
||||
|
||||
/* fs read */
|
||||
JANET_CORE_REG("os/dir", os_dir),
|
||||
JANET_CORE_REG("os/stat", os_stat),
|
||||
JANET_CORE_REG("os/lstat", os_lstat),
|
||||
JANET_CORE_REG("os/chmod", os_chmod),
|
||||
JANET_CORE_REG("os/touch", os_touch),
|
||||
JANET_CORE_REG("os/realpath", os_realpath),
|
||||
JANET_CORE_REG("os/cd", os_cd),
|
||||
JANET_CORE_REG("os/cpu-count", os_cpu_count),
|
||||
#ifndef JANET_NO_UMASK
|
||||
JANET_CORE_REG("os/umask", os_umask),
|
||||
#endif
|
||||
#ifndef JANET_NO_SYMLINKS
|
||||
JANET_CORE_REG("os/readlink", os_readlink),
|
||||
#endif
|
||||
|
||||
/* fs write */
|
||||
JANET_CORE_REG("os/mkdir", os_mkdir),
|
||||
JANET_CORE_REG("os/rmdir", os_rmdir),
|
||||
JANET_CORE_REG("os/rm", os_remove),
|
||||
JANET_CORE_REG("os/link", os_link),
|
||||
JANET_CORE_REG("os/rename", os_rename),
|
||||
#ifndef JANET_NO_SYMLINKS
|
||||
JANET_CORE_REG("os/symlink", os_symlink),
|
||||
JANET_CORE_REG("os/readlink", os_readlink),
|
||||
#endif
|
||||
|
||||
/* processes */
|
||||
#ifndef JANET_NO_PROCESSES
|
||||
JANET_CORE_REG("os/execute", os_execute),
|
||||
JANET_CORE_REG("os/spawn", os_spawn),
|
||||
JANET_CORE_REG("os/shell", os_shell),
|
||||
/* no need to sandbox process management if you can't create processes
|
||||
* (allows for limited functionality if use exposes C-functions to create specific processes) */
|
||||
JANET_CORE_REG("os/proc-wait", os_proc_wait),
|
||||
JANET_CORE_REG("os/proc-kill", os_proc_kill),
|
||||
JANET_CORE_REG("os/proc-close", os_proc_close),
|
||||
#endif
|
||||
JANET_CORE_REG("os/setenv", os_setenv),
|
||||
JANET_CORE_REG("os/time", os_time),
|
||||
JANET_CORE_REG("os/mktime", os_mktime),
|
||||
|
||||
/* high resolution timers */
|
||||
JANET_CORE_REG("os/clock", os_clock),
|
||||
JANET_CORE_REG("os/sleep", os_sleep),
|
||||
JANET_CORE_REG("os/cwd", os_cwd),
|
||||
JANET_CORE_REG("os/cryptorand", os_cryptorand),
|
||||
JANET_CORE_REG("os/date", os_date),
|
||||
JANET_CORE_REG("os/rename", os_rename),
|
||||
JANET_CORE_REG("os/realpath", os_realpath),
|
||||
JANET_CORE_REG("os/perm-string", os_permission_string),
|
||||
JANET_CORE_REG("os/perm-int", os_permission_int),
|
||||
|
||||
#ifdef JANET_EV
|
||||
JANET_CORE_REG("os/open", os_open),
|
||||
JANET_CORE_REG("os/open", os_open), /* fs read and write */
|
||||
JANET_CORE_REG("os/pipe", os_pipe),
|
||||
#endif
|
||||
#endif
|
||||
|
||||
@@ -1194,7 +1194,8 @@ static Janet parser_state_delimiters(const JanetParser *_p) {
|
||||
}
|
||||
}
|
||||
}
|
||||
str = janet_string(p->buf + oldcount, (int32_t)(p->bufcount - oldcount));
|
||||
/* avoid ptr arithmetic on NULL */
|
||||
str = janet_string(oldcount ? p->buf + oldcount : p->buf, (int32_t)(p->bufcount - oldcount));
|
||||
p->bufcount = oldcount;
|
||||
return janet_wrap_string(str);
|
||||
}
|
||||
@@ -1205,10 +1206,11 @@ static Janet parser_state_frames(const JanetParser *p) {
|
||||
states->count = count;
|
||||
uint8_t *buf = p->buf;
|
||||
/* Iterate arg stack backwards */
|
||||
Janet *args = p->args + p->argcount;
|
||||
Janet *args = p->argcount ? p->args + p->argcount : p->args; /* avoid ptr arithmetic on NULL */
|
||||
for (int32_t i = count - 1; i >= 0; --i) {
|
||||
JanetParseState *s = p->states + i;
|
||||
if (s->flags & PFLAG_CONTAINER) {
|
||||
/* avoid ptr arithmetic on args if NULL */
|
||||
if ((s->flags & PFLAG_CONTAINER) && s->argn) {
|
||||
args -= s->argn;
|
||||
}
|
||||
states->data[i] = janet_wrap_parse_state(s, args, buf, (uint32_t) p->bufcount);
|
||||
|
||||
@@ -1034,7 +1034,7 @@ static void spec_capture_number(Builder *b, int32_t argc, const Janet *argv) {
|
||||
emit_3(r, RULE_CAPTURE_NUM, rule, base, tag);
|
||||
return;
|
||||
error:
|
||||
peg_panicf(b, "expected integer between 2 and 36, got %v", argv[2]);
|
||||
peg_panicf(b, "expected integer between 2 and 36, got %v", argv[1]);
|
||||
}
|
||||
|
||||
static void spec_reference(Builder *b, int32_t argc, const Janet *argv) {
|
||||
@@ -1637,7 +1637,7 @@ typedef struct {
|
||||
JanetPeg *peg;
|
||||
PegState s;
|
||||
JanetByteView bytes;
|
||||
JanetByteView repl;
|
||||
Janet subst;
|
||||
int32_t start;
|
||||
} PegCall;
|
||||
|
||||
@@ -1653,7 +1653,7 @@ static PegCall peg_cfun_init(int32_t argc, Janet *argv, int get_replace) {
|
||||
ret.peg = compile_peg(argv[0]);
|
||||
}
|
||||
if (get_replace) {
|
||||
ret.repl = janet_getbytes(argv, 1);
|
||||
ret.subst = argv[1];
|
||||
ret.bytes = janet_getbytes(argv, 2);
|
||||
} else {
|
||||
ret.bytes = janet_getbytes(argv, 1);
|
||||
@@ -1738,7 +1738,8 @@ static Janet cfun_peg_replace_generic(int32_t argc, Janet *argv, int only_one) {
|
||||
trail = i;
|
||||
}
|
||||
int32_t nexti = (int32_t)(result - c.bytes.bytes);
|
||||
janet_buffer_push_bytes(ret, c.repl.bytes, c.repl.len);
|
||||
JanetByteView subst = janet_text_substitution(&c.subst, c.bytes.bytes + i, nexti - i, c.s.captures);
|
||||
janet_buffer_push_bytes(ret, subst.bytes, subst.len);
|
||||
trail = nexti;
|
||||
if (nexti == i) nexti++;
|
||||
i = nexti;
|
||||
@@ -1754,14 +1755,20 @@ static Janet cfun_peg_replace_generic(int32_t argc, Janet *argv, int only_one) {
|
||||
}
|
||||
|
||||
JANET_CORE_FN(cfun_peg_replace_all,
|
||||
"(peg/replace-all peg repl text &opt start & args)",
|
||||
"Replace all matches of peg in text with repl, returning a new buffer. The peg does not need to make captures to do replacement.") {
|
||||
"(peg/replace-all peg subst text &opt start & args)",
|
||||
"Replace all matches of `peg` in `text` with `subst`, returning a new buffer. "
|
||||
"The peg does not need to make captures to do replacement. "
|
||||
"If `subst` is a function, it will be called with the "
|
||||
"matching text followed by any captures.") {
|
||||
return cfun_peg_replace_generic(argc, argv, 0);
|
||||
}
|
||||
|
||||
JANET_CORE_FN(cfun_peg_replace,
|
||||
"(peg/replace peg repl text &opt start & args)",
|
||||
"Replace first match of peg in text with repl, returning a new buffer. The peg does not need to make captures to do replacement. "
|
||||
"Replace first match of `peg` in `text` with `subst`, returning a new buffer. "
|
||||
"The peg does not need to make captures to do replacement. "
|
||||
"If `subst` is a function, it will be called with the "
|
||||
"matching text followed by any captures. "
|
||||
"If no matches are found, returns the input string in a new buffer.") {
|
||||
return cfun_peg_replace_generic(argc, argv, 1);
|
||||
}
|
||||
|
||||
@@ -637,7 +637,7 @@ static void janet_pretty_one(struct pretty *S, Janet x, int is_dict_value) {
|
||||
}
|
||||
}
|
||||
|
||||
janet_sorted_keys(kvs, cap, S->keysort_buffer + ks_start);
|
||||
janet_sorted_keys(kvs, cap, S->keysort_buffer == NULL ? NULL : S->keysort_buffer + ks_start);
|
||||
S->keysort_start += len;
|
||||
if (!(S->flags & JANET_PRETTY_NOTRUNC) && (len > JANET_PRETTY_DICT_LIMIT)) {
|
||||
len = JANET_PRETTY_DICT_LIMIT;
|
||||
@@ -809,7 +809,8 @@ static const char *scanformat(
|
||||
*(form++) = '%';
|
||||
const char *p2 = strfrmt;
|
||||
while (p2 <= p) {
|
||||
if (strchr(FMT_REPLACE_INTTYPES, *p2) != NULL) {
|
||||
char *loc = strchr(FMT_REPLACE_INTTYPES, *p2);
|
||||
if (loc != NULL && *loc != '\0') {
|
||||
const char *mapping = get_fmt_mapping(*p2++);
|
||||
size_t len = strlen(mapping);
|
||||
strcpy(form, mapping);
|
||||
|
||||
@@ -39,6 +39,10 @@ static JanetSlot janetc_quote(JanetFopts opts, int32_t argn, const Janet *argv)
|
||||
|
||||
static JanetSlot janetc_splice(JanetFopts opts, int32_t argn, const Janet *argv) {
|
||||
JanetSlot ret;
|
||||
if (!(opts.flags & JANET_FOPTS_ACCEPT_SPLICE)) {
|
||||
janetc_cerror(opts.compiler, "splice can only be used in function parameters and data constructors, it has no effect here");
|
||||
return janetc_cslot(janet_wrap_nil());
|
||||
}
|
||||
if (argn != 1) {
|
||||
janetc_cerror(opts.compiler, "expected 1 argument to splice");
|
||||
return janetc_cslot(janet_wrap_nil());
|
||||
@@ -75,7 +79,9 @@ static JanetSlot quasiquote(JanetFopts opts, Janet x, int depth, int level) {
|
||||
const uint8_t *head = janet_unwrap_symbol(tup[0]);
|
||||
if (!janet_cstrcmp(head, "unquote")) {
|
||||
if (level == 0) {
|
||||
return janetc_value(janetc_fopts_default(opts.compiler), tup[1]);
|
||||
JanetFopts subopts = janetc_fopts_default(opts.compiler);
|
||||
subopts.flags |= JANET_FOPTS_ACCEPT_SPLICE;
|
||||
return janetc_value(subopts, tup[1]);
|
||||
} else {
|
||||
level--;
|
||||
}
|
||||
@@ -203,8 +209,9 @@ static int destructure(JanetCompiler *c,
|
||||
janetc_emit(c, JOP_JUMP);
|
||||
int32_t label_loop_exit = janet_v_count(c->buffer);
|
||||
|
||||
c->buffer[label_loop_cond_jump] |= (label_loop_exit - label_loop_cond_jump) << 16;
|
||||
c->buffer[label_loop_loop] |= (label_loop_start - label_loop_loop) << 8;
|
||||
/* avoid shifting negative numbers */
|
||||
c->buffer[label_loop_cond_jump] |= (uint32_t)(label_loop_exit - label_loop_cond_jump) << 16;
|
||||
c->buffer[label_loop_loop] |= (uint32_t)(label_loop_start - label_loop_loop) << 8;
|
||||
|
||||
janetc_freeslot(c, argi);
|
||||
janetc_freeslot(c, arg);
|
||||
@@ -487,6 +494,7 @@ static JanetSlot janetc_if(JanetFopts opts, int32_t argn, const Janet *argv) {
|
||||
/* Get options */
|
||||
condopts = janetc_fopts_default(c);
|
||||
bodyopts = opts;
|
||||
bodyopts.flags &= ~JANET_FOPTS_ACCEPT_SPLICE;
|
||||
|
||||
/* Set target for compilation */
|
||||
target = (drop || tail)
|
||||
@@ -563,6 +571,7 @@ static JanetSlot janetc_do(JanetFopts opts, int32_t argn, const Janet *argv) {
|
||||
subopts.flags = JANET_FOPTS_DROP;
|
||||
} else {
|
||||
subopts = opts;
|
||||
subopts.flags &= ~JANET_FOPTS_ACCEPT_SPLICE;
|
||||
}
|
||||
ret = janetc_value(subopts, argv[i]);
|
||||
if (i != argn - 1) {
|
||||
@@ -586,6 +595,7 @@ static JanetSlot janetc_upscope(JanetFopts opts, int32_t argn, const Janet *argv
|
||||
subopts.flags = JANET_FOPTS_DROP;
|
||||
} else {
|
||||
subopts = opts;
|
||||
subopts.flags &= ~JANET_FOPTS_ACCEPT_SPLICE;
|
||||
}
|
||||
ret = janetc_value(subopts, argv[i]);
|
||||
if (i != argn - 1) {
|
||||
@@ -958,12 +968,26 @@ static JanetSlot janetc_fn(JanetFopts opts, int32_t argn, const Janet *argv) {
|
||||
max_arity = (vararg || allow_extra) ? INT32_MAX : arity;
|
||||
if (!seenopt) min_arity = arity;
|
||||
|
||||
/* Check for self ref */
|
||||
/* Check for self ref (also avoid if arguments shadow own name) */
|
||||
if (selfref) {
|
||||
JanetSlot slot = janetc_farslot(c);
|
||||
slot.flags = JANET_SLOT_NAMED | JANET_FUNCTION;
|
||||
janetc_emit_s(c, JOP_LOAD_SELF, slot, 1);
|
||||
janetc_nameslot(c, janet_unwrap_symbol(head), slot);
|
||||
/* Check if the parameters shadow the function name. If so, don't
|
||||
* emit JOP_LOAD_SELF and add a binding since that most users
|
||||
* seem to expect that function parameters take precedence over the
|
||||
* function name */
|
||||
const uint8_t *sym = janet_unwrap_symbol(head);
|
||||
int32_t len = janet_v_count(c->scope->syms);
|
||||
int found = 0;
|
||||
for (int32_t i = 0; i < len; i++) {
|
||||
if (c->scope->syms[i].sym == sym) {
|
||||
found = 1;
|
||||
}
|
||||
}
|
||||
if (!found) {
|
||||
JanetSlot slot = janetc_farslot(c);
|
||||
slot.flags = JANET_SLOT_NAMED | JANET_FUNCTION;
|
||||
janetc_emit_s(c, JOP_LOAD_SELF, slot, 1);
|
||||
janetc_nameslot(c, sym, slot);
|
||||
}
|
||||
}
|
||||
|
||||
/* Compile function body */
|
||||
|
||||
@@ -23,6 +23,7 @@
|
||||
#ifndef JANET_STATE_H_defined
|
||||
#define JANET_STATE_H_defined
|
||||
|
||||
#include <janet.h>
|
||||
#include <stdint.h>
|
||||
|
||||
#ifdef JANET_EV
|
||||
@@ -135,6 +136,9 @@ struct JanetVM {
|
||||
size_t scratch_cap;
|
||||
size_t scratch_len;
|
||||
|
||||
/* Sandbox flags */
|
||||
uint32_t sandbox_flags;
|
||||
|
||||
/* Random number generator */
|
||||
JanetRNG rng;
|
||||
|
||||
@@ -155,6 +159,7 @@ struct JanetVM {
|
||||
size_t listener_cap;
|
||||
size_t extra_listeners;
|
||||
JanetTable threaded_abstracts; /* All abstract types that can be shared between threads (used in this thread) */
|
||||
JanetTable active_tasks; /* All possibly live task fibers - used just for tracking */
|
||||
#ifdef JANET_WINDOWS
|
||||
void **iocp;
|
||||
#elif defined(JANET_EV_EPOLL)
|
||||
|
||||
@@ -364,14 +364,13 @@ JANET_CORE_FN(cfun_string_findall,
|
||||
|
||||
struct replace_state {
|
||||
struct kmp_state kmp;
|
||||
const uint8_t *subst;
|
||||
int32_t substlen;
|
||||
Janet subst;
|
||||
};
|
||||
|
||||
static void replacesetup(int32_t argc, Janet *argv, struct replace_state *s) {
|
||||
janet_arity(argc, 3, 4);
|
||||
JanetByteView pat = janet_getbytes(argv, 0);
|
||||
JanetByteView subst = janet_getbytes(argv, 1);
|
||||
Janet subst = argv[1];
|
||||
JanetByteView text = janet_getbytes(argv, 2);
|
||||
int32_t start = 0;
|
||||
if (argc == 4) {
|
||||
@@ -380,13 +379,14 @@ static void replacesetup(int32_t argc, Janet *argv, struct replace_state *s) {
|
||||
}
|
||||
kmp_init(&s->kmp, text.bytes, text.len, pat.bytes, pat.len);
|
||||
s->kmp.i = start;
|
||||
s->subst = subst.bytes;
|
||||
s->substlen = subst.len;
|
||||
s->subst = subst;
|
||||
}
|
||||
|
||||
JANET_CORE_FN(cfun_string_replace,
|
||||
"(string/replace patt subst str)",
|
||||
"Replace the first occurrence of `patt` with `subst` in the string `str`. "
|
||||
"If `subst` is a function, it will be called with `patt` only if a match is found, "
|
||||
"and should return the actual replacement text to use. "
|
||||
"Will return the new string if `patt` is found, otherwise returns `str`.") {
|
||||
int32_t result;
|
||||
struct replace_state s;
|
||||
@@ -397,10 +397,11 @@ JANET_CORE_FN(cfun_string_replace,
|
||||
kmp_deinit(&s.kmp);
|
||||
return janet_stringv(s.kmp.text, s.kmp.textlen);
|
||||
}
|
||||
buf = janet_string_begin(s.kmp.textlen - s.kmp.patlen + s.substlen);
|
||||
JanetByteView subst = janet_text_substitution(&s.subst, s.kmp.text + result, s.kmp.patlen, NULL);
|
||||
buf = janet_string_begin(s.kmp.textlen - s.kmp.patlen + subst.len);
|
||||
safe_memcpy(buf, s.kmp.text, result);
|
||||
safe_memcpy(buf + result, s.subst, s.substlen);
|
||||
safe_memcpy(buf + result + s.substlen,
|
||||
safe_memcpy(buf + result, subst.bytes, subst.len);
|
||||
safe_memcpy(buf + result + subst.len,
|
||||
s.kmp.text + result + s.kmp.patlen,
|
||||
s.kmp.textlen - result - s.kmp.patlen);
|
||||
kmp_deinit(&s.kmp);
|
||||
@@ -411,6 +412,8 @@ JANET_CORE_FN(cfun_string_replaceall,
|
||||
"(string/replace-all patt subst str)",
|
||||
"Replace all instances of `patt` with `subst` in the string `str`. Overlapping "
|
||||
"matches will not be counted, only the first match in such a span will be replaced. "
|
||||
"If `subst` is a function, it will be called with `patt` once for each match, "
|
||||
"and should return the actual replacement text to use. "
|
||||
"Will return the new string if `patt` is found, otherwise returns `str`.") {
|
||||
int32_t result;
|
||||
struct replace_state s;
|
||||
@@ -419,8 +422,9 @@ JANET_CORE_FN(cfun_string_replaceall,
|
||||
replacesetup(argc, argv, &s);
|
||||
janet_buffer_init(&b, s.kmp.textlen);
|
||||
while ((result = kmp_next(&s.kmp)) >= 0) {
|
||||
JanetByteView subst = janet_text_substitution(&s.subst, s.kmp.text + result, s.kmp.patlen, NULL);
|
||||
janet_buffer_push_bytes(&b, s.kmp.text + lastindex, result - lastindex);
|
||||
janet_buffer_push_bytes(&b, s.subst, s.substlen);
|
||||
janet_buffer_push_bytes(&b, subst.bytes, subst.len);
|
||||
lastindex = result + s.kmp.patlen;
|
||||
kmp_seti(&s.kmp, lastindex);
|
||||
}
|
||||
|
||||
@@ -92,8 +92,8 @@ const char *const janet_signal_names[14] = {
|
||||
"user5",
|
||||
"user6",
|
||||
"user7",
|
||||
"user8",
|
||||
"user9"
|
||||
"interrupt",
|
||||
"await"
|
||||
};
|
||||
|
||||
const char *const janet_status_names[16] = {
|
||||
@@ -109,8 +109,8 @@ const char *const janet_status_names[16] = {
|
||||
"user5",
|
||||
"user6",
|
||||
"user7",
|
||||
"user8",
|
||||
"user9",
|
||||
"interrupted",
|
||||
"suspended",
|
||||
"new",
|
||||
"alive"
|
||||
};
|
||||
@@ -118,6 +118,7 @@ const char *const janet_status_names[16] = {
|
||||
#ifndef JANET_PRF
|
||||
|
||||
int32_t janet_string_calchash(const uint8_t *str, int32_t len) {
|
||||
if (NULL == str) return 5381;
|
||||
const uint8_t *end = str + len;
|
||||
uint32_t hash = 5381;
|
||||
while (str < end)
|
||||
@@ -662,6 +663,59 @@ JanetBinding janet_binding_from_entry(Janet entry) {
|
||||
return binding;
|
||||
}
|
||||
|
||||
/* If the value at the given address can be coerced to a byte view,
|
||||
return that byte view. If it can't, replace the value at the address
|
||||
with the result of janet_to_string, and return a byte view over that
|
||||
string. */
|
||||
static JanetByteView memoize_byte_view(Janet *value) {
|
||||
JanetByteView result;
|
||||
if (!janet_bytes_view(*value, &result.bytes, &result.len)) {
|
||||
JanetString str = janet_to_string(*value);
|
||||
*value = janet_wrap_string(str);
|
||||
result.bytes = str;
|
||||
result.len = janet_string_length(str);
|
||||
}
|
||||
return result;
|
||||
}
|
||||
|
||||
static JanetByteView to_byte_view(Janet value) {
|
||||
JanetByteView result;
|
||||
if (!janet_bytes_view(value, &result.bytes, &result.len)) {
|
||||
JanetString str = janet_to_string(value);
|
||||
result.bytes = str;
|
||||
result.len = janet_string_length(str);
|
||||
}
|
||||
return result;
|
||||
}
|
||||
|
||||
JanetByteView janet_text_substitution(
|
||||
Janet *subst,
|
||||
const uint8_t *bytes,
|
||||
uint32_t len,
|
||||
JanetArray *extra_argv) {
|
||||
int32_t extra_argc = extra_argv == NULL ? 0 : extra_argv->count;
|
||||
JanetType type = janet_type(*subst);
|
||||
switch (type) {
|
||||
case JANET_FUNCTION:
|
||||
case JANET_CFUNCTION: {
|
||||
int32_t argc = 1 + extra_argc;
|
||||
Janet *argv = janet_tuple_begin(argc);
|
||||
argv[0] = janet_stringv(bytes, len);
|
||||
for (int32_t i = 0; i < extra_argc; i++) {
|
||||
argv[i + 1] = extra_argv->data[i];
|
||||
}
|
||||
janet_tuple_end(argv);
|
||||
if (type == JANET_FUNCTION) {
|
||||
return to_byte_view(janet_call(janet_unwrap_function(*subst), argc, argv));
|
||||
} else {
|
||||
return to_byte_view(janet_unwrap_cfunction(*subst)(argc, argv));
|
||||
}
|
||||
}
|
||||
default:
|
||||
return memoize_byte_view(subst);
|
||||
}
|
||||
}
|
||||
|
||||
JanetBinding janet_resolve_ext(JanetTable *env, const uint8_t *sym) {
|
||||
Janet entry = janet_table_get(env, janet_wrap_symbol(sym));
|
||||
return janet_binding_from_entry(entry);
|
||||
|
||||
@@ -93,6 +93,11 @@ void janet_buffer_format(
|
||||
Janet *argv);
|
||||
Janet janet_next_impl(Janet ds, Janet key, int is_interpreter);
|
||||
JanetBinding janet_binding_from_entry(Janet entry);
|
||||
JanetByteView janet_text_substitution(
|
||||
Janet *subst,
|
||||
const uint8_t *bytes,
|
||||
uint32_t len,
|
||||
JanetArray *extra_args);
|
||||
|
||||
/* Registry functions */
|
||||
void janet_registry_put(
|
||||
|
||||
@@ -272,6 +272,7 @@ int janet_equals(Janet x, Janet y) {
|
||||
const Janet *t1 = janet_unwrap_tuple(x);
|
||||
const Janet *t2 = janet_unwrap_tuple(y);
|
||||
if (t1 == t2) break;
|
||||
if (JANET_TUPLE_FLAG_BRACKETCTOR & (janet_tuple_flag(t1) ^ janet_tuple_flag(t2))) return 0;
|
||||
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);
|
||||
@@ -321,6 +322,7 @@ int32_t janet_hash(Janet x) {
|
||||
break;
|
||||
case JANET_TUPLE:
|
||||
hash = janet_tuple_hash(janet_unwrap_tuple(x));
|
||||
hash += (janet_tuple_flag(janet_unwrap_tuple(x)) & JANET_TUPLE_FLAG_BRACKETCTOR) ? 1 : 0;
|
||||
break;
|
||||
case JANET_STRUCT:
|
||||
hash = janet_struct_hash(janet_unwrap_struct(x));
|
||||
@@ -412,6 +414,9 @@ int janet_compare(Janet x, Janet y) {
|
||||
case JANET_TUPLE: {
|
||||
const Janet *lhs = janet_unwrap_tuple(x);
|
||||
const Janet *rhs = janet_unwrap_tuple(y);
|
||||
if (JANET_TUPLE_FLAG_BRACKETCTOR & (janet_tuple_flag(lhs) ^ janet_tuple_flag(rhs))) {
|
||||
return (janet_tuple_flag(lhs) & JANET_TUPLE_FLAG_BRACKETCTOR) ? 1 : -1;
|
||||
}
|
||||
push_traversal_node(janet_tuple_head(lhs), janet_tuple_head(rhs), 1);
|
||||
break;
|
||||
}
|
||||
|
||||
@@ -1559,6 +1559,9 @@ int janet_init(void) {
|
||||
janet_vm.scratch_len = 0;
|
||||
janet_vm.scratch_cap = 0;
|
||||
|
||||
/* Sandbox flags */
|
||||
janet_vm.sandbox_flags = 0;
|
||||
|
||||
/* Initialize registry */
|
||||
janet_vm.registry = NULL;
|
||||
janet_vm.registry_cap = 0;
|
||||
@@ -1600,6 +1603,18 @@ int janet_init(void) {
|
||||
return 0;
|
||||
}
|
||||
|
||||
/* Disable some features at runtime with no way to re-enable them */
|
||||
void janet_sandbox(uint32_t flags) {
|
||||
janet_sandbox_assert(JANET_SANDBOX_SANDBOX);
|
||||
janet_vm.sandbox_flags |= flags;
|
||||
}
|
||||
|
||||
void janet_sandbox_assert(uint32_t forbidden_flags) {
|
||||
if (forbidden_flags & janet_vm.sandbox_flags) {
|
||||
janet_panic("operation forbidden by sandbox");
|
||||
}
|
||||
}
|
||||
|
||||
/* Clear all memory associated with the VM */
|
||||
void janet_deinit(void) {
|
||||
janet_clear_memory();
|
||||
|
||||
@@ -280,10 +280,11 @@ extern "C" {
|
||||
#ifndef JANET_NO_NANBOX
|
||||
#ifdef JANET_32
|
||||
#define JANET_NANBOX_32
|
||||
#elif defined(__x86_64__) || defined(_WIN64)
|
||||
#elif defined(__x86_64__) || defined(_WIN64) || defined(__riscv)
|
||||
/* We will only enable nanboxing by default on 64 bit systems
|
||||
* on x86. This is mainly because the approach is tied to the
|
||||
* implicit 47 bit address space. */
|
||||
* for x64 and risc-v. This is mainly because the approach is tied to the
|
||||
* implicit 47 bit address space. Many arches allow/require this, but not all,
|
||||
* and it requires cooperation from the OS. ARM should also work in many configurations. */
|
||||
#define JANET_NANBOX_64
|
||||
#endif
|
||||
#endif
|
||||
@@ -1584,8 +1585,10 @@ JANET_API Janet janet_array_pop(JanetArray *array);
|
||||
JANET_API Janet janet_array_peek(JanetArray *array);
|
||||
|
||||
/* Buffer functions */
|
||||
#define JANET_BUFFER_FLAG_NO_REALLOC 0x10000
|
||||
JANET_API JanetBuffer *janet_buffer(int32_t capacity);
|
||||
JANET_API JanetBuffer *janet_buffer_init(JanetBuffer *buffer, int32_t capacity);
|
||||
JANET_API JanetBuffer *janet_pointer_buffer_unsafe(void *memory, int32_t capacity, int32_t count);
|
||||
JANET_API void janet_buffer_deinit(JanetBuffer *buffer);
|
||||
JANET_API void janet_buffer_ensure(JanetBuffer *buffer, int32_t capacity, int32_t growth);
|
||||
JANET_API void janet_buffer_setcount(JanetBuffer *buffer, int32_t count);
|
||||
@@ -1684,6 +1687,7 @@ JANET_API void janet_table_clear(JanetTable *table);
|
||||
JANET_API JanetFiber *janet_fiber(JanetFunction *callee, int32_t capacity, int32_t argc, const Janet *argv);
|
||||
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 int janet_fiber_can_resume(JanetFiber *fiber);
|
||||
JANET_API JanetFiber *janet_current_fiber(void);
|
||||
JANET_API JanetFiber *janet_root_fiber(void);
|
||||
|
||||
@@ -1798,6 +1802,24 @@ JANET_API Janet janet_mcall(const char *name, int32_t argc, Janet *argv);
|
||||
JANET_API void janet_stacktrace(JanetFiber *fiber, Janet err);
|
||||
JANET_API void janet_stacktrace_ext(JanetFiber *fiber, Janet err, const char *prefix);
|
||||
|
||||
/* Sandboxing API */
|
||||
#define JANET_SANDBOX_SANDBOX 1
|
||||
#define JANET_SANDBOX_SUBPROCESS 2
|
||||
#define JANET_SANDBOX_NET_CONNECT 4
|
||||
#define JANET_SANDBOX_NET_LISTEN 8
|
||||
#define JANET_SANDBOX_FFI 16
|
||||
#define JANET_SANDBOX_FS_WRITE 32
|
||||
#define JANET_SANDBOX_FS_READ 64
|
||||
#define JANET_SANDBOX_HRTIME 128
|
||||
#define JANET_SANDBOX_ENV 256
|
||||
#define JANET_SANDBOX_DYNAMIC_MODULES 512
|
||||
#define JANET_SANDBOX_FS_TEMP 1024
|
||||
#define JANET_SANDBOX_FS (JANET_SANDBOX_FS_WRITE | JANET_SANDBOX_FS_READ | JANET_SANDBOX_FS_TEMP)
|
||||
#define JANET_SANDBOX_NET (JANET_SANDBOX_NET_CONNECT | JANET_SANDBOX_NET_LISTEN)
|
||||
#define JANET_SANDBOX_ALL (UINT32_MAX)
|
||||
JANET_API void janet_sandbox(uint32_t flags);
|
||||
JANET_API void janet_sandbox_assert(uint32_t forbidden_flags);
|
||||
|
||||
/* Scratch Memory API */
|
||||
typedef void (*JanetScratchFinalizer)(void *);
|
||||
|
||||
@@ -1856,7 +1878,7 @@ JANET_API Janet janet_resolve_core(const char *name);
|
||||
/* sourcemaps only */
|
||||
#define JANET_REG_S(JNAME, CNAME) {JNAME, CNAME, NULL, __FILE__, CNAME##_sourceline_}
|
||||
#define JANET_FN_S(CNAME, USAGE, DOCSTRING) \
|
||||
static int32_t CNAME##_sourceline_ = __LINE__; \
|
||||
static const int32_t CNAME##_sourceline_ = __LINE__; \
|
||||
Janet CNAME (int32_t argc, Janet *argv)
|
||||
#define JANET_DEF_S(ENV, JNAME, VAL, DOC) \
|
||||
janet_def_sm(ENV, JNAME, VAL, NULL, __FILE__, __LINE__)
|
||||
@@ -1872,7 +1894,7 @@ JANET_API Janet janet_resolve_core(const char *name);
|
||||
/* sourcemaps and docstrings */
|
||||
#define JANET_REG_SD(JNAME, CNAME) {JNAME, CNAME, CNAME##_docstring_, __FILE__, CNAME##_sourceline_}
|
||||
#define JANET_FN_SD(CNAME, USAGE, DOCSTRING) \
|
||||
static int32_t CNAME##_sourceline_ = __LINE__; \
|
||||
static const int32_t CNAME##_sourceline_ = __LINE__; \
|
||||
static const char CNAME##_docstring_[] = USAGE "\n\n" DOCSTRING; \
|
||||
Janet CNAME (int32_t argc, Janet *argv)
|
||||
#define JANET_DEF_SD(ENV, JNAME, VAL, DOC) \
|
||||
@@ -1946,6 +1968,7 @@ JANET_API JanetTable *janet_gettable(const Janet *argv, int32_t n);
|
||||
JANET_API JanetStruct janet_getstruct(const Janet *argv, int32_t n);
|
||||
JANET_API JanetString janet_getstring(const Janet *argv, int32_t n);
|
||||
JANET_API const char *janet_getcstring(const Janet *argv, int32_t n);
|
||||
JANET_API const char *janet_getcbytes(const Janet *argv, int32_t n);
|
||||
JANET_API JanetSymbol janet_getsymbol(const Janet *argv, int32_t n);
|
||||
JANET_API JanetKeyword janet_getkeyword(const Janet *argv, int32_t n);
|
||||
JANET_API JanetBuffer *janet_getbuffer(const Janet *argv, int32_t n);
|
||||
@@ -1975,6 +1998,7 @@ JANET_API JanetTuple janet_opttuple(const Janet *argv, int32_t argc, int32_t n,
|
||||
JANET_API JanetStruct janet_optstruct(const Janet *argv, int32_t argc, int32_t n, JanetStruct dflt);
|
||||
JANET_API JanetString janet_optstring(const Janet *argv, int32_t argc, int32_t n, JanetString dflt);
|
||||
JANET_API const char *janet_optcstring(const Janet *argv, int32_t argc, int32_t n, const char *dflt);
|
||||
JANET_API const char *janet_optcbytes(const Janet *argv, int32_t argc, int32_t n, const char *dflt);
|
||||
JANET_API JanetSymbol janet_optsymbol(const Janet *argv, int32_t argc, int32_t n, JanetString dflt);
|
||||
JANET_API JanetKeyword janet_optkeyword(const Janet *argv, int32_t argc, int32_t n, JanetString dflt);
|
||||
JANET_API JanetFiber *janet_optfiber(const Janet *argv, int32_t argc, int32_t n, JanetFiber *dflt);
|
||||
|
||||
@@ -30,6 +30,7 @@
|
||||
#ifdef _WIN32
|
||||
#include <windows.h>
|
||||
#include <shlwapi.h>
|
||||
#include <versionhelpers.h>
|
||||
#ifndef ENABLE_VIRTUAL_TERMINAL_PROCESSING
|
||||
#define ENABLE_VIRTUAL_TERMINAL_PROCESSING 0x0004
|
||||
#endif
|
||||
@@ -146,9 +147,13 @@ static void setup_console_output(void) {
|
||||
HANDLE hOut = GetStdHandle(STD_OUTPUT_HANDLE);
|
||||
DWORD dwMode = 0;
|
||||
GetConsoleMode(hOut, &dwMode);
|
||||
dwMode |= ENABLE_VIRTUAL_TERMINAL_PROCESSING;
|
||||
if (IsWindows10OrGreater()) {
|
||||
dwMode |= ENABLE_VIRTUAL_TERMINAL_PROCESSING;
|
||||
}
|
||||
SetConsoleMode(hOut, dwMode);
|
||||
SetConsoleOutputCP(65001);
|
||||
if (IsValidCodePage(65001)) {
|
||||
SetConsoleOutputCP(65001);
|
||||
}
|
||||
}
|
||||
|
||||
/* Ansi terminal raw mode */
|
||||
@@ -160,8 +165,10 @@ static int rawmode(void) {
|
||||
dwMode &= ~ENABLE_LINE_INPUT;
|
||||
dwMode &= ~ENABLE_INSERT_MODE;
|
||||
dwMode &= ~ENABLE_ECHO_INPUT;
|
||||
dwMode |= ENABLE_VIRTUAL_TERMINAL_INPUT;
|
||||
dwMode &= ~ENABLE_PROCESSED_INPUT;
|
||||
if (IsWindows10OrGreater()) {
|
||||
dwMode |= ENABLE_VIRTUAL_TERMINAL_INPUT;
|
||||
dwMode &= ~ENABLE_PROCESSED_INPUT;
|
||||
}
|
||||
if (!SetConsoleMode(hOut, dwMode)) return 1;
|
||||
gbl_israwmode = 1;
|
||||
return 0;
|
||||
@@ -176,8 +183,10 @@ static void norawmode(void) {
|
||||
dwMode |= ENABLE_LINE_INPUT;
|
||||
dwMode |= ENABLE_INSERT_MODE;
|
||||
dwMode |= ENABLE_ECHO_INPUT;
|
||||
dwMode &= ~ENABLE_VIRTUAL_TERMINAL_INPUT;
|
||||
dwMode |= ENABLE_PROCESSED_INPUT;
|
||||
if (IsWindows10OrGreater()) {
|
||||
dwMode &= ~ENABLE_VIRTUAL_TERMINAL_INPUT;
|
||||
dwMode |= ENABLE_PROCESSED_INPUT;
|
||||
}
|
||||
SetConsoleMode(hOut, dwMode);
|
||||
gbl_israwmode = 0;
|
||||
}
|
||||
|
||||
@@ -24,6 +24,11 @@
|
||||
(def errsym (keyword (gensym)))
|
||||
~(assert (= ,errsym (try (do ,;forms) ([_] ,errsym))) ,msg))
|
||||
|
||||
(defn check-compile-error
|
||||
[form]
|
||||
(def result (compile form))
|
||||
(assert (table? result) (string/format "expected compilation error for %j, but compiled without error" form)))
|
||||
|
||||
(defmacro assert-no-error
|
||||
[msg & forms]
|
||||
(def errsym (keyword (gensym)))
|
||||
|
||||
@@ -228,7 +228,7 @@
|
||||
|
||||
(assert (= 14 (sum (map inc @[1 2 3 4]))) "sum map")
|
||||
(def myfun (juxt + - * /))
|
||||
(assert (= '[2 -2 2 0.5] (myfun 2)) "juxt")
|
||||
(assert (= [2 -2 2 0.5] (myfun 2)) "juxt")
|
||||
|
||||
# Case statements
|
||||
(assert
|
||||
@@ -252,6 +252,9 @@
|
||||
(def xs (apply tuple (seq [x :down [8 -2] :when (even? x)] (tuple (/ x 2) x))))
|
||||
(assert (= xs '((4 8) (3 6) (2 4) (1 2) (0 0))) "seq macro 2")
|
||||
|
||||
(def xs (catseq [x :range [0 3]] [x x]))
|
||||
(assert (deep= xs @[0 0 1 1 2 2]) "catseq")
|
||||
|
||||
# :range-to and :down-to
|
||||
(assert (deep= (seq [x :range-to [0 10]] x) (seq [x :range [0 11]] x)) "loop :range-to")
|
||||
(assert (deep= (seq [x :down-to [10 0]] x) (seq [x :down [10 -1]] x)) "loop :down-to")
|
||||
@@ -342,6 +345,8 @@
|
||||
(assert (= (and 0 1 nil) nil) "and 0 1 nil")
|
||||
(assert (= (and 1) 1) "and 1")
|
||||
(assert (= (and) true) "and with no arguments")
|
||||
(assert (= (and 1 true) true) "and with trailing true")
|
||||
(assert (= (and 1 true 2) 2) "and with internal true")
|
||||
|
||||
(assert (= (or true true) true) "or true true")
|
||||
(assert (= (or true false) true) "or true false")
|
||||
|
||||
@@ -41,10 +41,10 @@
|
||||
|
||||
# Looping idea
|
||||
(def xs
|
||||
(seq [x :in '[-1 0 1] y :in '[-1 0 1] :when (not= x y 0)] (tuple x y)))
|
||||
(seq [x :in [-1 0 1] y :in [-1 0 1] :when (not= x y 0)] (tuple x y)))
|
||||
(def txs (apply tuple xs))
|
||||
|
||||
(assert (= txs '[[-1 -1] [-1 0] [-1 1] [0 -1] [0 1] [1 -1] [1 0] [1 1]]) "nested seq")
|
||||
(assert (= txs [[-1 -1] [-1 0] [-1 1] [0 -1] [0 1] [1 -1] [1 0] [1 1]]) "nested seq")
|
||||
|
||||
# Generators
|
||||
(def gen (generate [x :range [0 100] :when (pos? (% x 4))] x))
|
||||
@@ -72,6 +72,10 @@
|
||||
(assert (= (string/replace "X" "." "XXX...XXX...XXX") ".XX...XXX...XXX") "string/replace 1")
|
||||
(assert (= (string/replace-all "X" "." "XXX...XXX...XXX") "...............") "string/replace-all 1")
|
||||
(assert (= (string/replace-all "XX" "." "XXX...XXX...XXX") ".X....X....X") "string/replace-all 2")
|
||||
(assert (= (string/replace "xx" string/ascii-upper "xxyxyxyxxxy") "XXyxyxyxxxy") "string/replace function")
|
||||
(assert (= (string/replace-all "xx" string/ascii-upper "xxyxyxyxxxy") "XXyxyxyXXxy") "string/replace-all function")
|
||||
(assert (= (string/replace "x" 12 "xyx") "12yx") "string/replace stringable")
|
||||
(assert (= (string/replace-all "x" 12 "xyx") "12y12") "string/replace-all stringable")
|
||||
(assert (= (string/ascii-lower "ABCabc&^%!@:;.") "abcabc&^%!@:;.") "string/ascii-lower")
|
||||
(assert (= (string/ascii-upper "ABCabc&^%!@:;.") "ABCABC&^%!@:;.") "string/ascii-lower")
|
||||
(assert (= (string/reverse "") "") "string/reverse 1")
|
||||
|
||||
@@ -349,7 +349,7 @@
|
||||
(def janet-longstring
|
||||
~{:delim (some "`")
|
||||
:open (capture :delim :n)
|
||||
:close (cmt (* (not (> -1 "`")) (-> :n) (<- :delim)) ,=)
|
||||
:close (cmt (* (not (> -1 "`")) (-> :n) (<- (backmatch :n))) ,=)
|
||||
:main (* :open (any (if-not :close 1)) :close -1)})
|
||||
|
||||
(check-match janet-longstring "`john" false)
|
||||
@@ -359,6 +359,7 @@
|
||||
(check-match janet-longstring "`` ``" true)
|
||||
(check-match janet-longstring "``` `` ```" true)
|
||||
(check-match janet-longstring "`` ```" false)
|
||||
(check-match janet-longstring "`a``b`" false)
|
||||
|
||||
# Line and column capture
|
||||
|
||||
|
||||
@@ -83,8 +83,13 @@
|
||||
(assert (deep= (drop 10 []) []) "drop 2")
|
||||
(assert (deep= (drop 0 [1 2 3 4 5]) [1 2 3 4 5]) "drop 3")
|
||||
(assert (deep= (drop 10 [1 2 3]) []) "drop 4")
|
||||
(assert (deep= (drop -2 [:a :b :c]) [:a :b :c]) "drop 5")
|
||||
(assert-error :invalid-type (drop 3 {}) "drop 6")
|
||||
(assert (deep= (drop -1 [1 2 3]) [1 2]) "drop 5")
|
||||
(assert (deep= (drop -10 [1 2 3]) []) "drop 6")
|
||||
(assert (deep= (drop 1 "abc") "bc") "drop 7")
|
||||
(assert (deep= (drop 10 "abc") "") "drop 8")
|
||||
(assert (deep= (drop -1 "abc") "ab") "drop 9")
|
||||
(assert (deep= (drop -10 "abc") "") "drop 10")
|
||||
(assert-error :invalid-type (drop 3 {}) "drop 11")
|
||||
|
||||
# drop-until
|
||||
|
||||
@@ -98,4 +103,18 @@
|
||||
# Quasiquote bracketed tuples
|
||||
(assert (= (tuple/type ~[1 2 3]) (tuple/type '[1 2 3])) "quasiquote bracket tuples")
|
||||
|
||||
# No useless splices
|
||||
(check-compile-error '((splice [1 2 3]) 0))
|
||||
(check-compile-error '(if ;[1 2] 5))
|
||||
(check-compile-error '(while ;[1 2 3] (print :hi)))
|
||||
(check-compile-error '(def x ;[1 2 3]))
|
||||
(check-compile-error '(fn [x] ;[x 1 2 3]))
|
||||
|
||||
# No splice propagation
|
||||
(check-compile-error '(+ 1 (do ;[2 3 4]) 5))
|
||||
(check-compile-error '(+ 1 (upscope ;[2 3 4]) 5))
|
||||
# compiler inlines when condition is constant, ensure that optimization doesn't break
|
||||
(check-compile-error '(+ 1 (if true ;[3 4])))
|
||||
(check-compile-error '(+ 1 (if false nil ;[3 4])))
|
||||
|
||||
(end-suite)
|
||||
|
||||
@@ -261,4 +261,12 @@
|
||||
(modcheck -10 3)
|
||||
(modcheck -10 -3)
|
||||
|
||||
# Check for issue #1130
|
||||
(var d (int/s64 7))
|
||||
(mod 0 d)
|
||||
|
||||
(var d (int/s64 7))
|
||||
(def result (seq [n :in (range -21 0)] (mod n d)))
|
||||
(assert (deep= result (map int/s64 @[0 1 2 3 4 5 6 0 1 2 3 4 5 6 0 1 2 3 4 5 6])) "issue #1130")
|
||||
|
||||
(end-suite)
|
||||
|
||||
@@ -60,7 +60,7 @@
|
||||
:buffer (/ '(* "@" :bytes) (constant :string))
|
||||
:long-bytes {:delim (some "`")
|
||||
:open (capture :delim :n)
|
||||
:close (cmt (* (not (> -1 "`")) (-> :n) ':delim) ,=)
|
||||
:close (cmt (* (not (> -1 "`")) (-> :n) '(backmatch :n)) ,=)
|
||||
:main (drop (* :open (any (if-not :close 1)) :close))}
|
||||
:long-string (/ ':long-bytes (constant :string))
|
||||
:long-buffer (/ '(* "@" :long-bytes) (constant :string))
|
||||
@@ -239,6 +239,12 @@
|
||||
(assert (= (os/mktime (os/date now true) true) now) "local os/mktime")
|
||||
(assert (= (os/mktime {:year 1970}) 0) "os/mktime default values")
|
||||
|
||||
# OS strftime test
|
||||
|
||||
(assert (= (os/strftime "%Y-%m-%d %H:%M:%S" 0) "1970-01-01 00:00:00") "strftime UTC epoch")
|
||||
(assert (= (os/strftime "%Y-%m-%d %H:%M:%S" 1388608200) "2014-01-01 20:30:00") "strftime january 2014")
|
||||
(assert (= (try (os/strftime "%%%d%t") ([err] err)) "invalid conversion specifier '%t'") "invalid conversion specifier")
|
||||
|
||||
# Appending buffer to self
|
||||
|
||||
(with-dyns [:out @""]
|
||||
@@ -294,9 +300,12 @@
|
||||
(assert-error "comptime issue" (eval '(comptime (error "oops"))))
|
||||
|
||||
(with [f (file/temp)]
|
||||
(assert (= 0 (file/tell f)) "start of file")
|
||||
(file/write f "foo\n")
|
||||
(assert (= 4 (file/tell f)) "after written string")
|
||||
(file/flush f)
|
||||
(file/seek f :set 0)
|
||||
(assert (= 0 (file/tell f)) "start of file again")
|
||||
(assert (= (string (file/read f :all)) "foo\n") "temp files work"))
|
||||
|
||||
(var counter 0)
|
||||
|
||||
@@ -330,7 +330,6 @@ neldb\0\0\0\xD8\x05printG\x01\0\xDE\xDE\xDE'\x03\0marshal_tes/\x02
|
||||
(assert (deep= (peg/find-all '"/" p) @[0 4 10 14]) "peg find-all")
|
||||
|
||||
# Peg replace and replace-all
|
||||
(var ti 0)
|
||||
(defn check-replacer
|
||||
[x y z]
|
||||
(assert (= (string/replace x y z) (string (peg/replace x y z))) "replacer test replace")
|
||||
@@ -339,6 +338,32 @@ neldb\0\0\0\xD8\x05printG\x01\0\xDE\xDE\xDE'\x03\0marshal_tes/\x02
|
||||
(check-replacer "abc" "Z" "")
|
||||
(check-replacer "aba" "ZZZZZZ" "ababababababa")
|
||||
(check-replacer "aba" "" "ababababababa")
|
||||
(check-replacer "aba" string/ascii-upper "ababababababa")
|
||||
(check-replacer "aba" 123 "ababababababa")
|
||||
|
||||
(assert (= (string (peg/replace-all ~(set "ab") string/ascii-upper "abcaa"))
|
||||
"ABcAA")
|
||||
"peg/replace-all cfunction")
|
||||
(assert (= (string (peg/replace-all ~(set "ab") |$ "abcaa"))
|
||||
"abcaa")
|
||||
"peg/replace-all function")
|
||||
|
||||
(defn peg-test [name f peg subst text expected]
|
||||
(assert (= (string (f peg subst text)) expected) name))
|
||||
|
||||
(peg-test "peg/replace has access to captures"
|
||||
peg/replace
|
||||
~(sequence "." (capture (set "ab")))
|
||||
(fn [str char] (string/format "%s -> %s, " str (string/ascii-upper char)))
|
||||
".a.b.c"
|
||||
".a -> A, .b.c")
|
||||
|
||||
(peg-test "peg/replace-all has access to captures"
|
||||
peg/replace-all
|
||||
~(sequence "." (capture (set "ab")))
|
||||
(fn [str char] (string/format "%s -> %s, " str (string/ascii-upper char)))
|
||||
".a.b.c"
|
||||
".a -> A, .b -> B, .c")
|
||||
|
||||
# Peg bug
|
||||
(assert (deep= @[] (peg/match '(any 1) @"")) "peg empty pattern 1")
|
||||
|
||||
@@ -44,6 +44,43 @@
|
||||
(assert (= :brackets (tuple/type (1 (macex1 '~[1 2 3 4])))) "macex1 qq bracket tuple")
|
||||
(assert (deep= (macex1 '~@[1 2 3 4 ,blah]) '~@[1 2 3 4 ,blah]) "macex1 qq array")
|
||||
|
||||
# Sourcemaps in threading macros
|
||||
(defn check-threading [macro expansion]
|
||||
(def expanded (macex1 (tuple macro 0 '(x) '(y))))
|
||||
(assert (= expanded expansion) (string macro " expansion value"))
|
||||
(def smap-x (tuple/sourcemap (get expanded 1)))
|
||||
(def smap-y (tuple/sourcemap expanded))
|
||||
(def line first)
|
||||
(defn column [t] (t 1))
|
||||
(assert (not= smap-x [-1 -1]) (string macro " x sourcemap existence"))
|
||||
(assert (not= smap-y [-1 -1]) (string macro " y sourcemap existence"))
|
||||
(assert (or (< (line smap-x) (line smap-y))
|
||||
(and (= (line smap-x) (line smap-y))
|
||||
(< (column smap-x) (column smap-y))))
|
||||
(string macro " relation between x and y sourcemap")))
|
||||
|
||||
(check-threading '-> '(y (x 0)))
|
||||
(check-threading '->> '(y (x 0)))
|
||||
|
||||
# keep-syntax
|
||||
(let [brak '[1 2 3]
|
||||
par '(1 2 3)]
|
||||
|
||||
(tuple/setmap brak 2 1)
|
||||
|
||||
(assert (deep= (keep-syntax brak @[1 2 3]) @[1 2 3]) "keep-syntax brackets ignore array")
|
||||
(assert (= (keep-syntax! brak @[1 2 3]) '[1 2 3]) "keep-syntax! brackets replace array")
|
||||
|
||||
(assert (= (keep-syntax! par (map inc @[1 2 3])) '(2 3 4)) "keep-syntax! parens coerce array")
|
||||
(assert (not= (keep-syntax! brak @[1 2 3]) '(1 2 3)) "keep-syntax! brackets not parens")
|
||||
(assert (not= (keep-syntax! par @[1 2 3]) '[1 2 3]) "keep-syntax! parens not brackets")
|
||||
(assert (= (tuple/sourcemap brak)
|
||||
(tuple/sourcemap (keep-syntax! brak @[1 2 3]))) "keep-syntax! brackets source map")
|
||||
|
||||
(keep-syntax par brak)
|
||||
(assert (not= (tuple/sourcemap brak) (tuple/sourcemap par)) "keep-syntax no mutate")
|
||||
(assert (= (keep-syntax 1 brak) brak) "keep-syntax brackets ignore type"))
|
||||
|
||||
# Cancel test
|
||||
(def f (fiber/new (fn [&] (yield 1) (yield 2) (yield 3) 4) :yti))
|
||||
(assert (= 1 (resume f)) "cancel resume 1")
|
||||
|
||||
@@ -19,7 +19,6 @@
|
||||
symbolslots)
|
||||
"symbolslots survive disasm/asm")
|
||||
|
||||
# need to fix upvalues
|
||||
(comment
|
||||
(setdyn *debug* true)
|
||||
(setdyn :pretty-format "%.40M")
|
||||
@@ -41,4 +40,9 @@
|
||||
[3 7 4 'z]])
|
||||
"arg & inner symbolslots")
|
||||
|
||||
# buffer/push-at
|
||||
(assert (deep= @"abc456" (buffer/push-at @"abc123" 3 "456")) "buffer/push-at 1")
|
||||
(assert (deep= @"abc456789" (buffer/push-at @"abc123" 3 "456789")) "buffer/push-at 2")
|
||||
(assert (deep= @"abc423" (buffer/push-at @"abc123" 3 "4")) "buffer/push-at 3")
|
||||
|
||||
(end-suite)
|
||||
|
||||
Reference in New Issue
Block a user