mirrors
/
janet
mirror of https://github.com/janet-lang/janet
1
0
Fork 0
Code Issues 1 Releases Wiki Activity

Merge branch 'master' into compile-opt

This commit is contained in:
Calvin Rose 2024-05-04 16:14:35 -05:00
parent dfd05ddf7e f2d25a0da2
commit 3cc3312b7b
38 changed files with 1051 additions and 253 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
.builds/freebsd.yml
View File

@ -1,4 +1,4 @@
image: freebsd/12.x
image: freebsd/14.x
sources:
- https://git.sr.ht/~bakpakin/janet
packages:

38
.github/cosmo/build vendored Normal file
View File

@ -0,0 +1,38 @@
#!/bin/sh
set -eux
COSMO_DIR="/sc/cosmocc"
# build x86_64
X86_64_CC="/sc/cosmocc/bin/x86_64-unknown-cosmo-cc"
X86_64_AR="/sc/cosmocc/bin/x86_64-unknown-cosmo-ar"
mkdir -p /sc/cosmocc/x86_64
make -j CC="$X86_64_CC" AR="$X86_64_AR" HAS_SHARED=0 JANET_NO_AMALG=1
cp build/janet /sc/cosmocc/x86_64/janet
make clean
# build aarch64
AARCH64_CC="/sc/cosmocc/bin/aarch64-unknown-cosmo-cc"
AARCH64_AR="/sc/cosmocc/bin/aarch64-unknown-cosmo-ar"
mkdir -p /sc/cosmocc/aarch64
make -j CC="$AARCH64_CC" AR="$AARCH64_AR" HAS_SHARED=0 JANET_NO_AMALG=1
cp build/janet /sc/cosmocc/aarch64/janet
make clean
# fat binary
apefat () {
OUTPUT="$1"
OLDNAME_X86_64="$(basename -- "$2")"
OLDNAME_AARCH64="$(basename -- "$3")"
TARG_FOLD="$(dirname "$OUTPUT")"
"$COSMO_DIR/bin/apelink" -l "$COSMO_DIR/bin/ape-x86_64.elf" \
-l "$COSMO_DIR/bin/ape-aarch64.elf" \
-M "$COSMO_DIR/bin/ape-m1.c" \
-o "$OUTPUT" \
"$2" \
"$3"
cp "$2" "$TARG_FOLD/$OLDNAME_X86_64.x86_64"
cp "$3" "$TARG_FOLD/$OLDNAME_AARCH64.aarch64"
}
apefat /sc/cosmocc/janet.com /sc/cosmocc/x86_64/janet /sc/cosmocc/aarch64/janet

21
.github/cosmo/setup vendored Normal file
View File

@ -0,0 +1,21 @@
#!/bin/sh
set -e
sudo apt update
sudo apt-get install -y ca-certificates libssl-dev\
qemu qemu-utils qemu-user-static\
texinfo groff\
cmake ninja-build bison zip\
pkg-config build-essential autoconf re2c
# download cosmocc
cd /sc
wget https://github.com/jart/cosmopolitan/releases/download/3.3.3/cosmocc-3.3.3.zip
mkdir -p cosmocc
cd cosmocc
unzip ../cosmocc-3.3.3.zip
# register
cd /sc/cosmocc
sudo cp ./bin/ape-x86_64.elf /usr/bin/ape
sudo sh -c "echo ':APE:M::MZqFpD::/usr/bin/ape:' >/proc/sys/fs/binfmt_misc/register"

27
.github/workflows/release.yml vendored
View File

@ -60,3 +60,30 @@ jobs:
./dist/*.zip
./*.zip
./*.msi
release-cosmo:
permissions:
contents: write # for softprops/action-gh-release to create GitHub release
name: Build release binaries for Cosmo
runs-on: ubuntu-latest
steps:
- name: Checkout the repository
uses: actions/checkout@master
- name: create build folder
run: |
sudo mkdir -p /sc
sudo chmod -R 0777 /sc
- name: setup Cosmopolitan Libc
run: bash ./.github/cosmo/setup
- name: Set the version
run: echo "version=${GITHUB_REF/refs\/tags\//}" >> $GITHUB_ENV
- name: Set the platform
run: echo "platform=cosmo" >> $GITHUB_ENV
- name: build Janet APE binary
run: bash ./.github/cosmo/build
- name: push binary to github
uses: softprops/action-gh-release@v1
with:
draft: true
files: |
/sc/cosmocc/janet.com

3
.gitignore vendored
View File

@ -134,6 +134,9 @@ Module.symvers
Mkfile.old
dkms.conf
# Coverage files
*.cov
# End of https://www.gitignore.io/api/c
# Created by https://www.gitignore.io/api/cmake

41
CHANGELOG.md
View File

@ -1,6 +1,47 @@
# Changelog
All notable changes to this project will be documented in this file.
## Unreleased - ???
- Add long form command line options for readable CLI usage
- Fix bug with `net/accept-loop` that would sometimes miss connections.
## 1.34.0 - 2024-03-22
- Add a new (split) PEG special by @ianthehenry
- Add buffer/push-* sized int and float by @pnelson
- Documentation improvements: @amano-kenji, @llmII, @MaxGyver83, @pepe, @sogaiu.
- Expose _exit to skip certain cleanup with os/exit.
- Swap set / body order for each by @sogaiu.
- Abort on assert failure instead of exit.
- Fix: os/proc-wait by @llmII.
- Fix macex1 to keep syntax location for all tuples.
- Restore if-let tail calls.
- Don't try and resume fibers that can't be resumed.
- Register stream on unmarshal.
- Fix asm roundtrip issue.
## 1.33.0 - 2024-01-07
- Add more + and * keywords to default-peg-grammar by @sogaiu.
- Use libc strlen in janet_buffer_push_cstring by @williewillus.
- Be a bit safer with reference counting.
- Add support for atomic loads in Janet's atomic abstraction.
- Fix poll event loop CPU usage issue.
- Add ipv6, shared, and cryptorand options to meson.
- Add more ipv6 feature detection.
- Fix loop for forever loop.
- Cleaned up unused NetStateConnect, fixed janet_async_end() ev refcount by @zevv.
- Fix warnings w/ MSVC and format.
- Fix marshal_one_env w/ JANET_MARSHAL_UNSAFE.
- Fix `(default)`.
- Fix cannot marshal fiber with c stackframe, in a dynamic way that is fairly conservative.
- Fix typo for SIGALARM in os/proc-kill.
- Prevent bytecode optimization from remove mk* instructions.
- Fix arity typo in peg.c by @pepe.
- Update Makefile for MinGW.
- Fix canceling waiting fiber.
- Add a new (sub) PEG special by @ianthehenry.
- Fix if net/server's handler has incorrect arity.
- Fix macex raising on ().
## 1.32.1 - 2023-10-15
- Fix return value from C function `janet_dobytes` when called on Janet functions that yield to event loop.
- Change C API for event loop interaction - get rid of JanetListener and instead use `janet_async_start` and `janet_async_end`.

11
Makefile
View File

@ -33,6 +33,7 @@ CLIBS=-lm -lpthread
JANET_TARGET=build/janet
JANET_BOOT=build/janet_boot
JANET_IMPORT_LIB=build/janet.lib
JANET_LIBRARY_IMPORT_LIB=build/libjanet.lib
JANET_LIBRARY=build/libjanet.so
JANET_STATIC_LIBRARY=build/libjanet.a
JANET_PATH?=$(LIBDIR)/janet
@ -52,6 +53,7 @@ HOSTAR?=$(AR)
# Symbols are (optionally) removed later, keep -g as default!
CFLAGS?=-O2 -g
LDFLAGS?=-rdynamic
LIBJANET_LDFLAGS?=$(LD_FLAGS)
RUN:=$(RUN)
COMMON_CFLAGS:=-std=c99 -Wall -Wextra -Isrc/include -Isrc/conf -fvisibility=hidden -fPIC
@ -94,10 +96,12 @@ endif
ifeq ($(findstring MINGW,$(UNAME)), MINGW)
CLIBS:=-lws2_32 -lpsapi -lwsock32
LDFLAGS:=-Wl,--out-implib,$(JANET_IMPORT_LIB)
LIBJANET_LDFLAGS:=-Wl,--out-implib,$(JANET_LIBRARY_IMPORT_LIB)
JANET_TARGET:=$(JANET_TARGET).exe
JANET_BOOT:=$(JANET_BOOT).exe
endif
$(shell mkdir -p build/core build/c build/boot build/mainclient)
all: $(JANET_TARGET) $(JANET_STATIC_LIBRARY) build/janet.h
ifeq ($(HAS_SHARED), 1)
@ -201,9 +205,9 @@ build/%.bin.o: src/%.c $(JANET_HEADERS) $(JANET_LOCAL_HEADERS) Makefile
########################
ifeq ($(UNAME), Darwin)
SONAME=libjanet.1.32.dylib
SONAME=libjanet.1.34.dylib
else
SONAME=libjanet.so.1.32
SONAME=libjanet.so.1.34
endif
build/c/shell.c: src/mainclient/shell.c
@ -225,7 +229,7 @@ $(JANET_TARGET): $(JANET_TARGET_OBJECTS)
$(HOSTCC) $(LDFLAGS) $(BUILD_CFLAGS) -o $@ $^ $(CLIBS)
$(JANET_LIBRARY): $(JANET_TARGET_OBJECTS)
$(HOSTCC) $(LDFLAGS) $(BUILD_CFLAGS) $(SONAME_SETTER)$(SONAME) -shared -o $@ $^ $(CLIBS)
$(HOSTCC) $(LIBJANET_LDFLAGS) $(BUILD_CFLAGS) $(SONAME_SETTER)$(SONAME) -shared -o $@ $^ $(CLIBS)
$(JANET_STATIC_LIBRARY): $(JANET_TARGET_OBJECTS)
$(HOSTAR) rcs $@ $^
@ -340,6 +344,7 @@ install: $(JANET_TARGET) $(JANET_LIBRARY) $(JANET_STATIC_LIBRARY) build/janet.pc
mkdir -p '$(DESTDIR)$(JANET_PKG_CONFIG_PATH)'
cp build/janet.pc '$(DESTDIR)$(JANET_PKG_CONFIG_PATH)/janet.pc'
cp '$(JANET_IMPORT_LIB)' '$(DESTDIR)$(LIBDIR)' || echo 'no import lib to install (mingw only)'
cp '$(JANET_LIBRARY_IMPORT_LIB)' '$(DESTDIR)$(LIBDIR)' || echo 'no import lib to install (mingw only)'
[ -z '$(DESTDIR)' ] && $(LDCONFIG) || echo "You can ignore this error for non-Linux systems or local installs"
install-jpm-git: $(JANET_TARGET)

3
README.md
View File

@ -315,8 +315,7 @@ See the [Embedding Section](https://janet-lang.org/capi/embedding.html) on the w
## 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 Zulip Instance](https://janet.zulipchat.com/)
## FAQ

4
build_win.bat
View File

@ -91,7 +91,9 @@ exit /b 0
:CLEAN
del *.exe *.lib *.exp
rd /s /q build
rd /s /q dist
if exist dist (
rd /s /q dist
)
exit /b 0
@rem Run tests

2
meson.build
View File

@ -20,7 +20,7 @@
project('janet', 'c',
default_options : ['c_std=c99', 'build.c_std=c99', 'b_lundef=false', 'default_library=both'],
version : '1.32.1')
version : '1.34.0')
# Global settings
janet_path = join_paths(get_option('prefix'), get_option('libdir'), 'janet')

4
meson_options.txt
View File

@ -17,8 +17,8 @@ option('processes', type : 'boolean', value : true)
option('umask', type : 'boolean', value : true)
option('realpath', type : 'boolean', value : true)
option('simple_getline', type : 'boolean', value : false)
option('epoll', type : 'boolean', value : false)
option('kqueue', type : 'boolean', value : false)
option('epoll', type : 'boolean', value : true)
option('kqueue', type : 'boolean', value : true)
option('interpreter_interrupt', type : 'boolean', value : true)
option('ffi', type : 'boolean', value : true)
option('ffi_jit', type : 'boolean', value : true)

179
src/boot/boot.janet
View File

@ -162,7 +162,7 @@
``Define a default value for an optional argument.
Expands to `(def sym (if (= nil sym) val sym))`.``
[sym val]
~(def ,sym (if (= nil ,sym) ,val ,sym)))
~(def ,sym (if (,= nil ,sym) ,val ,sym)))
(defmacro comment
"Ignores the body of the comment."
@ -420,10 +420,14 @@
(defn- range-template
[binding object kind rest op comparison]
(let [[start stop step] (check-indexed object)]
(case kind
:range (for-template binding (if stop start 0) (or stop start) (or step 1) comparison op [rest])
:down (for-template binding start (or stop 0) (or step 1) comparison op [rest]))))
(check-indexed object)
(def [a b c] object)
(def [start stop step]
(case (length object)
1 (case kind :range [0 a 1] :down [a 0 1])
2 [a b 1]
[a b c]))
(for-template binding start stop step comparison op [rest]))
(defn- each-template
[binding inx kind body]
@ -438,8 +442,8 @@
:each ~(,in ,ds ,k)
:keys k
:pairs ~[,k (,in ,ds ,k)]))
(set ,k (,next ,ds ,k))
,;body))))
,;body
(set ,k (,next ,ds ,k))))))
(defn- iterate-template
[binding expr body]
@ -661,6 +665,9 @@
(each x xs (*= accum x))
accum)
# declare ahead of time
(var- macexvar nil)
(defmacro if-let
``Make multiple bindings, and if all are truthy,
evaluate the `tru` form. If any are false or nil, evaluate
@ -669,20 +676,19 @@
(def len (length bindings))
(if (= 0 len) (error "expected at least 1 binding"))
(if (odd? len) (error "expected an even number of bindings"))
(def res (gensym))
(def fal2 (if macexvar (macexvar fal) fal))
(defn aux [i]
(if (>= i len)
~(do (set ,res ,tru) true)
tru
(do
(def bl (in bindings i))
(def br (in bindings (+ 1 i)))
(if (symbol? bl)
~(if (def ,bl ,br) ,(aux (+ 2 i)))
~(if (def ,bl ,br) ,(aux (+ 2 i)) ,fal2)
~(if (def ,(def sym (gensym)) ,br)
(do (def ,bl ,sym) ,(aux (+ 2 i))))))))
~(do
(var ,res nil)
(if ,(aux 0) ,res ,fal)))
(do (def ,bl ,sym) ,(aux (+ 2 i)))
,fal2)))))
(aux 0))
(defmacro when-let
"Same as `(if-let bindings (do ;body))`."
@ -2123,21 +2129,22 @@
'upscope expandall})
(defn dotup [t]
(if (= nil (next t)) (break ()))
(def h (in t 0))
(def s (in specs h))
(def entry (or (dyn h) {}))
(def m (do (def r (get entry :ref)) (if r (in r 0) (get entry :value))))
(def m? (in entry :macro))
(cond
s (s t)
s (keep-syntax t (s t))
m? (do (setdyn *macro-form* t) (m ;(tuple/slice t 1)))
(tuple/slice (map recur t))))
(keep-syntax! t (map recur t))))
(def ret
(case (type x)
:tuple (if (= (tuple/type x) :brackets)
(tuple/brackets ;(map recur x))
(dotup x))
(tuple/brackets ;(map recur x))
(dotup x))
:array (map recur x)
:struct (table/to-struct (dotable x recur))
:table (dotable x recur)
@ -2243,6 +2250,8 @@
(set current (macex1 current on-binding)))
current)
(set macexvar macex)
(defmacro varfn
``Create a function that can be rebound. `varfn` has the same signature
as `defn`, but defines functions in the environment as vars. If a var `name`
@ -2758,6 +2767,11 @@
(defn- check-is-dep [x] (unless (or (string/has-prefix? "/" x) (string/has-prefix? "@" x) (string/has-prefix? "." x)) x))
(defn- check-project-relative [x] (if (string/has-prefix? "/" x) x))
(defdyn *module/cache* "Dynamic binding for overriding `module/cache`")
(defdyn *module/paths* "Dynamic binding for overriding `module/cache`")
(defdyn *module/loading* "Dynamic binding for overriding `module/cache`")
(defdyn *module/loaders* "Dynamic binding for overriding `module/loaders`")
(def module/cache
"A table, mapping loaded module identifiers to their environments."
@{})
@ -2786,24 +2800,25 @@
keyword name of a loader in `module/loaders`. Returns the modified `module/paths`.
```
[ext loader]
(def mp (dyn *module/paths* module/paths))
(defn- find-prefix
[pre]
(or (find-index |(and (string? ($ 0)) (string/has-prefix? pre ($ 0))) module/paths) 0))
(or (find-index |(and (string? ($ 0)) (string/has-prefix? pre ($ 0))) mp) 0))
(def dyn-index (find-prefix ":@all:"))
(array/insert module/paths dyn-index [(string ":@all:" ext) loader check-dyn-relative])
(array/insert mp dyn-index [(string ":@all:" ext) loader check-dyn-relative])
(def all-index (find-prefix ".:all:"))
(array/insert module/paths all-index [(string ".:all:" ext) loader check-project-relative])
(array/insert mp all-index [(string ".:all:" ext) loader check-project-relative])
(def sys-index (find-prefix ":sys:"))
(array/insert module/paths sys-index [(string ":sys:/:all:" ext) loader check-is-dep])
(array/insert mp sys-index [(string ":sys:/:all:" ext) loader check-is-dep])
(def curall-index (find-prefix ":cur:/:all:"))
(array/insert module/paths curall-index [(string ":cur:/:all:" ext) loader check-relative])
module/paths)
(array/insert mp curall-index [(string ":cur:/:all:" ext) loader check-relative])
mp)
(module/add-paths ":native:" :native)
(module/add-paths "/init.janet" :source)
(module/add-paths ".janet" :source)
(module/add-paths ".jimage" :image)
(array/insert module/paths 0 [(fn is-cached [path] (if (in module/cache path) path)) :preload check-not-relative])
(array/insert module/paths 0 [(fn is-cached [path] (if (in (dyn *module/cache* module/cache) path) path)) :preload check-not-relative])
# Version of fexists that works even with a reduced OS
(defn- fexists
@ -2833,7 +2848,8 @@
```
[path]
(var ret nil)
(each [p mod-kind checker] module/paths
(def mp (dyn *module/paths* module/paths))
(each [p mod-kind checker] mp
(when (mod-filter checker path)
(if (function? p)
(when-let [res (p path)]
@ -2849,7 +2865,7 @@
(when (string? t)
(when (mod-filter chk path)
(module/expand-path path t))))
paths (filter identity (map expander module/paths))
paths (filter identity (map expander mp))
str-parts (interpose "\n " paths)]
[nil (string "could not find module " path ":\n " ;str-parts)])))
@ -3004,13 +3020,15 @@
of files as modules.``
@{:native (fn native-loader [path &] (native path (make-env)))
:source (fn source-loader [path args]
(put module/loading path true)
(defer (put module/loading path nil)
(def ml (dyn *module/loading* module/loading))
(put ml path true)
(defer (put ml path nil)
(dofile path ;args)))
:preload (fn preload-loader [path & args]
(when-let [m (in module/cache path)]
(def mc (dyn *module/cache* module/cache))
(when-let [m (in mc path)]
(if (function? m)
(set (module/cache path) (m path ;args))
(set (mc path) (m path ;args))
m)))
:image (fn image-loader [path &] (load-image (slurp path)))})
@ -3018,15 +3036,18 @@
[path args kargs]
(def [fullpath mod-kind] (module/find path))
(unless fullpath (error mod-kind))
(if-let [check (if-not (kargs :fresh) (in module/cache fullpath))]
(def mc (dyn *module/cache* module/cache))
(def ml (dyn *module/loading* module/loading))
(def mls (dyn *module/loaders* module/loaders))
(if-let [check (if-not (kargs :fresh) (in mc fullpath))]
check
(if (module/loading fullpath)
(if (ml fullpath)
(error (string "circular dependency " fullpath " detected"))
(do
(def loader (if (keyword? mod-kind) (module/loaders mod-kind) mod-kind))
(def loader (if (keyword? mod-kind) (mls mod-kind) mod-kind))
(unless loader (error (string "module type " mod-kind " unknown")))
(def env (loader fullpath args))
(put module/cache fullpath env)
(put mc fullpath env)
env))))
(defn require
@ -3423,9 +3444,9 @@
(defn- print-special-form-entry
[x]
(print "\n\n"
(string " special form\n\n")
(string " (" x " ...)\n\n")
(string " See https://janet-lang.org/docs/specials.html\n\n")))
" special form\n\n"
" (" x " ...)\n\n"
" See https://janet-lang.org/docs/specials.html\n\n"))
(defn doc*
"Get the documentation for a symbol in a given environment. Function form of `doc`."
@ -3727,12 +3748,20 @@
~(,ev/thread (fn _spawn-thread [&] ,;body) nil :n))
(defmacro ev/with-deadline
`Run a body of code with a deadline, such that if the code does not complete before
the deadline is up, it will be canceled.`
[deadline & body]
``
Create a fiber to execute `body`, schedule the event loop to cancel
the task (root fiber) associated with `body`'s fiber, and start
`body`'s fiber by resuming it.
The event loop will try to cancel the root fiber if `body`'s fiber
has not completed after at least `sec` seconds.
`sec` is a number that can have a fractional part.
``
[sec & body]
(with-syms [f]
~(let [,f (coro ,;body)]
(,ev/deadline ,deadline nil ,f)
(,ev/deadline ,sec nil ,f)
(,resume ,f))))
(defn- cancel-all [chan fibers reason]
@ -3991,6 +4020,28 @@
(def x (in args (+ i 1)))
(or (scan-number x) (keyword x)))
(def- long-to-short
"map long options to short options"
{"-help" "h"
"-version" "v"
"-stdin" "s"
"-eval" "e"
"-expression" "E"
"-debug" "d"
"-repl" "r"
"-noprofile" "R"
"-persistent" "p"
"-quiet" "q"
"-flycheck" "k"
"-syspath" "m"
"-compile" "c"
"-image" "i"
"-nocolor" "n"
"-color" "N"
"-library" "l"
"-lint-warn" "w"
"-lint-error" "x"})
# Flag handlers
(def handlers
{"h" (fn [&]
@ -3998,26 +4049,26 @@
(print
```
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 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
-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"
-- : Stop handling options
--help (-h) : Show this help
--version (-v) : Print the version string
--stdin (-s) : Use raw stdin instead of getline like functionality
--eval (-e) code : Execute a string of janet
--expression (-E) code arguments... : Evaluate an expression as a short-fn with arguments
--debug (-d) : Set the debug flag in the REPL
--repl (-r) : Enter the REPL after running all scripts
--noprofile (-R) : Disables loading profile.janet when JANET_PROFILE is present
--persistent (-p) : Keep on executing if there is a top-level error (persistent)
--quiet (-q) : Hide logo (quiet)
--flycheck (-k) : Compile scripts but do not execute (flycheck)
--syspath (-m) syspath : Set system path for loading global modules
--compile (-c) source output : Compile janet source code into an image
--image (-i) : Load the script argument as an image file instead of source code
--nocolor (-n) : Disable ANSI color output in the REPL
--color (-N) : Enable ANSI color output in the REPL
--library (-l) lib : Use a module before processing more arguments
--lint-warn (-w) level : Set the lint warning level - default is "normal"
--lint-error (-x) level : Set the lint error level - default is "none"
-- : Stop handling options
```)
(os/exit 0)
1)
@ -4061,8 +4112,8 @@
"R" (fn [&] (setdyn *profilepath* nil) 1)})
(defn- dohandler [n i &]
(def h (in handlers n))
(if h (h i) (do (print "unknown flag -" n) ((in handlers "h")))))
(def h (in handlers (get long-to-short n n)))
(if h (h i handlers) (do (print "unknown flag -" n) ((in handlers "h")))))
# Process arguments
(var i 0)

7
src/conf/janetconf.h
View File

@ -4,10 +4,10 @@
#define JANETCONF_H
#define JANET_VERSION_MAJOR 1
#define JANET_VERSION_MINOR 32
#define JANET_VERSION_PATCH 1
#define JANET_VERSION_MINOR 34
#define JANET_VERSION_PATCH 0
#define JANET_VERSION_EXTRA ""
#define JANET_VERSION "1.32.1"
#define JANET_VERSION "1.34.0"
/* #define JANET_BUILD "local" */
@ -54,6 +54,7 @@
/* #define JANET_NO_INTERPRETER_INTERRUPT */
/* #define JANET_NO_IPV6 */
/* #define JANET_NO_CRYPTORAND */
/* #define JANET_USE_STDATOMIC */
/* Custom vm allocator support */
/* #include <mimalloc.h> */

2
src/core/abstract.c
View File

@ -31,8 +31,6 @@
#ifdef JANET_EV
#ifdef JANET_WINDOWS
#include <windows.h>
#else
#include <stdatomic.h>
#endif
#endif

8
src/core/asm.c
View File

@ -560,6 +560,9 @@ static JanetAssembleResult janet_asm1(JanetAssembler *parent, Janet source, int
x = janet_get1(s, janet_ckeywordv("vararg"));
if (janet_truthy(x)) def->flags |= JANET_FUNCDEF_FLAG_VARARG;
/* Initialize slotcount */
def->slotcount = !!(def->flags & JANET_FUNCDEF_FLAG_VARARG) + def->arity;
/* Check structarg */
x = janet_get1(s, janet_ckeywordv("structarg"));
if (janet_truthy(x)) def->flags |= JANET_FUNCDEF_FLAG_STRUCTARG;
@ -784,8 +787,9 @@ static JanetAssembleResult janet_asm1(JanetAssembler *parent, Janet source, int
}
/* Verify the func def */
if (janet_verify(def)) {
janet_asm_error(&a, "invalid assembly");
int verify_status = janet_verify(def);
if (verify_status) {
janet_asm_errorv(&a, janet_formatc("invalid assembly (%d)", verify_status));
}
/* Add final flags */

144
src/core/buffer.c
View File

@ -135,7 +135,7 @@ void janet_buffer_extra(JanetBuffer *buffer, int32_t n) {
/* Push a cstring to buffer */
void janet_buffer_push_cstring(JanetBuffer *buffer, const char *cstring) {
int32_t len = strlen(cstring);
int32_t len = (int32_t) strlen(cstring);
janet_buffer_push_bytes(buffer, (const uint8_t *) cstring, len);
}
@ -320,6 +320,143 @@ JANET_CORE_FN(cfun_buffer_chars,
return argv[0];
}
static int should_reverse_bytes(const Janet *argv, int32_t argc) {
JanetKeyword order_kw = janet_getkeyword(argv, argc);
if (!janet_cstrcmp(order_kw, "le")) {
#if JANET_BIG_ENDIAN
return 1;
#endif
} else if (!janet_cstrcmp(order_kw, "be")) {
#if JANET_LITTLE_ENDIAN
return 1;
#endif
} else if (!janet_cstrcmp(order_kw, "native")) {
return 0;
} else {
janet_panicf("expected endianness :le, :be or :native, got %v", argv[1]);
}
return 0;
}
static void reverse_u32(uint8_t bytes[4]) {
uint8_t temp;
temp = bytes[3];
bytes[3] = bytes[0];
bytes[0] = temp;
temp = bytes[2];
bytes[2] = bytes[1];
bytes[1] = temp;
}
static void reverse_u64(uint8_t bytes[8]) {
uint8_t temp;
temp = bytes[7];
bytes[7] = bytes[0];
bytes[0] = temp;
temp = bytes[6];
bytes[6] = bytes[1];
bytes[1] = temp;
temp = bytes[5];
bytes[5] = bytes[2];
bytes[2] = temp;
temp = bytes[4];
bytes[4] = bytes[3];
bytes[3] = temp;
}
JANET_CORE_FN(cfun_buffer_push_uint16,
"(buffer/push-uint16 buffer order data)",
"Push a 16 bit unsigned integer data onto the end of the buffer. "
"Returns the modified buffer.") {
janet_fixarity(argc, 3);
JanetBuffer *buffer = janet_getbuffer(argv, 0);
int reverse = should_reverse_bytes(argv, 1);
union {
uint16_t data;
uint8_t bytes[2];
} u;
u.data = (uint16_t) janet_getinteger(argv, 2);
if (reverse) {
uint8_t temp = u.bytes[1];
u.bytes[1] = u.bytes[0];
u.bytes[0] = temp;
}
janet_buffer_push_u16(buffer, *(uint16_t *) u.bytes);
return argv[0];
}
JANET_CORE_FN(cfun_buffer_push_uint32,
"(buffer/push-uint32 buffer order data)",
"Push a 32 bit unsigned integer data onto the end of the buffer. "
"Returns the modified buffer.") {
janet_fixarity(argc, 3);
JanetBuffer *buffer = janet_getbuffer(argv, 0);
int reverse = should_reverse_bytes(argv, 1);
union {
uint32_t data;
uint8_t bytes[4];
} u;
u.data = (uint32_t) janet_getinteger(argv, 2);
if (reverse)
reverse_u32(u.bytes);
janet_buffer_push_u32(buffer, *(uint32_t *) u.bytes);
return argv[0];
}
JANET_CORE_FN(cfun_buffer_push_uint64,
"(buffer/push-uint64 buffer order data)",
"Push a 64 bit unsigned integer data onto the end of the buffer. "
"Returns the modified buffer.") {
janet_fixarity(argc, 3);
JanetBuffer *buffer = janet_getbuffer(argv, 0);
int reverse = should_reverse_bytes(argv, 1);
union {
uint64_t data;
uint8_t bytes[8];
} u;
u.data = (uint64_t) janet_getuinteger64(argv, 2);
if (reverse)
reverse_u64(u.bytes);
janet_buffer_push_u64(buffer, *(uint64_t *) u.bytes);
return argv[0];
}
JANET_CORE_FN(cfun_buffer_push_float32,
"(buffer/push-float32 buffer order data)",
"Push the underlying bytes of a 32 bit float data onto the end of the buffer. "
"Returns the modified buffer.") {
janet_fixarity(argc, 3);
JanetBuffer *buffer = janet_getbuffer(argv, 0);
int reverse = should_reverse_bytes(argv, 1);
union {
float data;
uint8_t bytes[4];
} u;
u.data = (float) janet_getnumber(argv, 2);
if (reverse)
reverse_u32(u.bytes);
janet_buffer_push_u32(buffer, *(uint32_t *) u.bytes);
return argv[0];
}
JANET_CORE_FN(cfun_buffer_push_float64,
"(buffer/push-float64 buffer order data)",
"Push the underlying bytes of a 64 bit float data onto the end of the buffer. "
"Returns the modified buffer.") {
janet_fixarity(argc, 3);
JanetBuffer *buffer = janet_getbuffer(argv, 0);
int reverse = should_reverse_bytes(argv, 1);
union {
double data;
uint8_t bytes[8];
} u;
u.data = janet_getnumber(argv, 2);
if (reverse)
reverse_u64(u.bytes);
janet_buffer_push_u64(buffer, *(uint64_t *) u.bytes);
return argv[0];
}
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)) {
@ -528,6 +665,11 @@ void janet_lib_buffer(JanetTable *env) {
JANET_CORE_REG("buffer/push-byte", cfun_buffer_u8),
JANET_CORE_REG("buffer/push-word", cfun_buffer_word),
JANET_CORE_REG("buffer/push-string", cfun_buffer_chars),
JANET_CORE_REG("buffer/push-uint16", cfun_buffer_push_uint16),
JANET_CORE_REG("buffer/push-uint32", cfun_buffer_push_uint32),
JANET_CORE_REG("buffer/push-uint64", cfun_buffer_push_uint64),
JANET_CORE_REG("buffer/push-float32", cfun_buffer_push_float32),
JANET_CORE_REG("buffer/push-float64", cfun_buffer_push_float64),
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),

3
src/core/bytecode.c
View File

@ -226,6 +226,7 @@ void janet_bytecode_movopt(JanetFuncDef *def) {
case JOP_LOAD_TRUE:
case JOP_LOAD_FALSE:
case JOP_LOAD_SELF:
break;
case JOP_MAKE_ARRAY:
case JOP_MAKE_BUFFER:
case JOP_MAKE_STRING:
@ -233,6 +234,8 @@ void janet_bytecode_movopt(JanetFuncDef *def) {
case JOP_MAKE_TABLE:
case JOP_MAKE_TUPLE:
case JOP_MAKE_BRACKET_TUPLE:
/* Reads from the stack, don't remove */
janetc_regalloc_touch(&ra, DD);
break;
/* Read A */

13
src/core/capi.c
View File

@ -35,6 +35,13 @@
#endif
#endif
#ifdef JANET_USE_STDATOMIC
#include <stdatomic.h>
/* We don't need stdatomic on most compilers since we use compiler builtins for atomic operations.
* Some (TCC), explicitly require using stdatomic.h and don't have any exposed builtins (that I know of).
* For TCC and similar compilers, one would need -std=c11 or similar then to get access. */
#endif
JANET_NO_RETURN static void janet_top_level_signal(const char *msg) {
#ifdef JANET_TOP_LEVEL_SIGNAL
JANET_TOP_LEVEL_SIGNAL(msg);
@ -496,6 +503,8 @@ void *janet_optabstract(const Janet *argv, int32_t argc, int32_t n, const JanetA
JanetAtomicInt janet_atomic_inc(JanetAtomicInt volatile *x) {
#ifdef JANET_WINDOWS
return InterlockedIncrement(x);
#elif defined(JANET_USE_STDATOMIC)
return atomic_fetch_add_explicit(x, 1, memory_order_relaxed) + 1;
#else
return __atomic_add_fetch(x, 1, __ATOMIC_RELAXED);
#endif
@ -504,6 +513,8 @@ JanetAtomicInt janet_atomic_inc(JanetAtomicInt volatile *x) {
JanetAtomicInt janet_atomic_dec(JanetAtomicInt volatile *x) {
#ifdef JANET_WINDOWS
return InterlockedDecrement(x);
#elif defined(JANET_USE_STDATOMIC)
return atomic_fetch_add_explicit(x, -1, memory_order_acq_rel) - 1;
#else
return __atomic_add_fetch(x, -1, __ATOMIC_ACQ_REL);
#endif
@ -512,6 +523,8 @@ JanetAtomicInt janet_atomic_dec(JanetAtomicInt volatile *x) {
JanetAtomicInt janet_atomic_load(JanetAtomicInt volatile *x) {
#ifdef JANET_WINDOWS
return InterlockedOr(x, 0);
#elif defined(JANET_USE_STDATOMIC)
return atomic_load_explicit(x, memory_order_acquire);
#else
return __atomic_load_n(x, __ATOMIC_ACQUIRE);
#endif

47
src/core/corelib.c
View File

@ -69,15 +69,15 @@ JanetModule janet_native(const char *name, const uint8_t **error) {
host.minor < modconf.minor ||
host.bits != modconf.bits) {
char errbuf[128];
sprintf(errbuf, "config mismatch - host %d.%.d.%d(%.4x) vs. module %d.%d.%d(%.4x)",
host.major,
host.minor,
host.patch,
host.bits,
modconf.major,
modconf.minor,
modconf.patch,
modconf.bits);
snprintf(errbuf, sizeof(errbuf), "config mismatch - host %d.%.d.%d(%.4x) vs. module %d.%d.%d(%.4x)",
host.major,
host.minor,
host.patch,
host.bits,
modconf.major,
modconf.minor,
modconf.patch,
modconf.bits);
*error = janet_cstring(errbuf);
return NULL;
}
@ -110,14 +110,14 @@ JANET_CORE_FN(janet_core_expand_path,
"(module/expand-path path template)",
"Expands a path template as found in `module/paths` for `module/find`. "
"This takes in a path (the argument to require) and a template string, "
"to expand the path to a path that can be "
"used for importing files. The replacements are as follows:\n\n"
"to expand the path to a path that can be used for importing files. "
"The replacements are as follows:\n\n"
"* :all: -- the value of path verbatim.\n\n"
"* :@all: -- Same as :all:, but if `path` starts with the @ character,\n"
" the first path segment is replaced with a dynamic binding\n"
" `(dyn <first path segment as keyword>)`.\n\n"
"* :cur: -- the current file, or (dyn :current-file)\n\n"
"* :dir: -- the directory containing the current file\n\n"
"* :@all: -- Same as :all:, but if `path` starts with the @ character, "
"the first path segment is replaced with a dynamic binding "
"`(dyn <first path segment as keyword>)`.\n\n"
"* :cur: -- the directory portion, if any, of (dyn :current-file)\n\n"
"* :dir: -- the directory portion, if any, of the path argument\n\n"
"* :name: -- the name component of path, with extension if given\n\n"
"* :native: -- the extension used to load natives, .so or .dll\n\n"
"* :sys: -- the system path, or (dyn :syspath)") {
@ -1144,17 +1144,20 @@ JanetTable *janet_core_env(JanetTable *replacements) {
JDOC("(next ds &opt key)\n\n"
"Gets the next key in a data structure. Can be used to iterate through "
"the keys of a data structure in an unspecified order. Keys are guaranteed "
"to be seen only once per iteration if they data structure is not mutated "
"to be seen only once per iteration if the data structure is not mutated "
"during iteration. If key is nil, next returns the first key. If next "
"returns nil, there are no more keys to iterate through."));
janet_quick_asm(env, JANET_FUN_PROP,
"propagate", 2, 2, 2, 2, propagate_asm, sizeof(propagate_asm),
JDOC("(propagate x fiber)\n\n"
"Propagate a signal from a fiber to the current fiber. The resulting "
"stack trace from the current fiber will include frames from fiber. If "
"fiber is in a state that can be resumed, resuming the current fiber will "
"first resume fiber. This function can be used to re-raise an error without "
"losing the original stack trace."));
"Propagate a signal from a fiber to the current fiber and "
"set the last value of the current fiber to `x`. The signal "
"value is then available as the status of the current fiber. "
"The resulting stack trace from the current fiber will include "
"frames from fiber. If fiber is in a state that can be resumed, "
"resuming the current fiber will first resume `fiber`. "
"This function can be used to re-raise an error without losing "
"the original stack trace."));
janet_quick_asm(env, JANET_FUN_DEBUG,
"debug", 1, 0, 1, 1, debug_asm, sizeof(debug_asm),
JDOC("(debug &opt x)\n\n"

4
src/core/debug.c
View File

@ -388,8 +388,8 @@ JANET_CORE_FN(cfun_debug_stack,
JANET_CORE_FN(cfun_debug_stacktrace,
"(debug/stacktrace fiber &opt err prefix)",
"Prints a nice looking stacktrace for a fiber. Can optionally provide "
"an error value to print the stack trace with. If `err` is nil or not "
"provided, and no prefix is given, will skip the error line. Returns the fiber.") {
"an error value to print the stack trace with. If `prefix` is nil or not "
"provided, will skip the error line. Returns the fiber.") {
janet_arity(argc, 1, 3);
JanetFiber *fiber = janet_getfiber(argv, 0);
Janet x = argc == 1 ? janet_wrap_nil() : argv[1];

198
src/core/ev.c
View File

@ -258,12 +258,12 @@ void janet_async_end(JanetFiber *fiber) {
fiber->ev_callback(fiber, JANET_ASYNC_EVENT_DEINIT);
janet_gcunroot(janet_wrap_abstract(fiber->ev_stream));
fiber->ev_callback = NULL;
if (fiber->ev_state) {
if (!(fiber->flags & JANET_FIBER_EV_FLAG_IN_FLIGHT)) {
if (!(fiber->flags & JANET_FIBER_EV_FLAG_IN_FLIGHT)) {
if (fiber->ev_state) {
janet_free(fiber->ev_state);
janet_ev_dec_refcount();
fiber->ev_state = NULL;
}
fiber->ev_state = NULL;
janet_ev_dec_refcount();
}
}
}
@ -279,8 +279,16 @@ void janet_async_in_flight(JanetFiber *fiber) {
void janet_async_start(JanetStream *stream, JanetAsyncMode mode, JanetEVCallback callback, void *state) {
JanetFiber *fiber = janet_vm.root_fiber;
janet_assert(!fiber->ev_callback, "double async on fiber");
if (mode & JANET_ASYNC_LISTEN_READ) stream->read_fiber = fiber;
if (mode & JANET_ASYNC_LISTEN_WRITE) stream->write_fiber = fiber;
if (mode & JANET_ASYNC_LISTEN_READ) {
stream->read_fiber = fiber;
} else {
stream->read_fiber = NULL;
}
if (mode & JANET_ASYNC_LISTEN_WRITE) {
stream->write_fiber = fiber;
} else {
stream->write_fiber = NULL;
}
fiber->ev_callback = callback;
fiber->ev_stream = stream;
janet_ev_inc_refcount();
@ -450,6 +458,9 @@ static void *janet_stream_unmarshal(JanetMarshalContext *ctx) {
p->handle = (JanetHandle) janet_unmarshal_int64(ctx);
#else
p->handle = (JanetHandle) janet_unmarshal_int(ctx);
#endif
#ifdef JANET_EV_POLL
janet_register_stream(p);
#endif
return p;
}
@ -459,6 +470,12 @@ static Janet janet_stream_next(void *p, Janet key) {
return janet_nextmethod(stream->methods, key);
}
static void janet_stream_tostring(void *p, JanetBuffer *buffer) {
JanetStream *stream = p;
/* Let user print the file descriptor for debugging */
janet_formatb(buffer, "<core/stream handle=%d>", stream->handle);
}
const JanetAbstractType janet_stream_type = {
"core/stream",
janet_stream_gc,
@ -467,7 +484,7 @@ const JanetAbstractType janet_stream_type = {
NULL,
janet_stream_marshal,
janet_stream_unmarshal,
NULL,
janet_stream_tostring,
NULL,
NULL,
janet_stream_next,
@ -1166,10 +1183,12 @@ JANET_CORE_FN(cfun_channel_close,
msg.argj = janet_wrap_nil();
janet_ev_post_event(vm, janet_thread_chan_cb, msg);
} else {
if (writer.mode == JANET_CP_MODE_CHOICE_WRITE) {
janet_schedule(writer.fiber, make_close_result(channel));
} else {
janet_schedule(writer.fiber, janet_wrap_nil());
if (janet_fiber_can_resume(writer.fiber)) {
if (writer.mode == JANET_CP_MODE_CHOICE_WRITE) {
janet_schedule(writer.fiber, make_close_result(channel));
} else {
janet_schedule(writer.fiber, janet_wrap_nil());
}
}
}
}
@ -1185,10 +1204,12 @@ JANET_CORE_FN(cfun_channel_close,
msg.argj = janet_wrap_nil();
janet_ev_post_event(vm, janet_thread_chan_cb, msg);
} else {
if (reader.mode == JANET_CP_MODE_CHOICE_READ) {
janet_schedule(reader.fiber, make_close_result(channel));
} else {
janet_schedule(reader.fiber, janet_wrap_nil());
if (janet_fiber_can_resume(reader.fiber)) {
if (reader.mode == JANET_CP_MODE_CHOICE_READ) {
janet_schedule(reader.fiber, make_close_result(channel));
} else {
janet_schedule(reader.fiber, janet_wrap_nil());
}
}
}
}
@ -1452,7 +1473,7 @@ void janet_ev_deinit(void) {
CloseHandle(janet_vm.iocp);
}
void janet_register_stream(JanetStream *stream) {
static void janet_register_stream(JanetStream *stream) {
if (NULL == CreateIoCompletionPort(stream->handle, janet_vm.iocp, (ULONG_PTR) stream, 0)) {
janet_panicf("failed to listen for events: %V", janet_ev_lasterr());
}
@ -1509,6 +1530,14 @@ void janet_loop1_impl(int has_timeout, JanetTimestamp to) {
}
}
void janet_stream_edge_triggered(JanetStream *stream) {
(void) stream;
}
void janet_stream_level_triggered(JanetStream *stream) {
(void) stream;
}
#elif defined(JANET_EV_EPOLL)
static JanetTimestamp ts_now(void) {
@ -1520,15 +1549,15 @@ static JanetTimestamp ts_now(void) {
}
/* Wait for the next event */
static void janet_register_stream(JanetStream *stream) {
static void janet_register_stream_impl(JanetStream *stream, int mod, int edge_trigger) {
struct epoll_event ev;
ev.events = EPOLLET;
ev.events = edge_trigger ? EPOLLET : 0;
if (stream->flags & (JANET_STREAM_READABLE | JANET_STREAM_ACCEPTABLE)) ev.events |= EPOLLIN;
if (stream->flags & JANET_STREAM_WRITABLE) ev.events |= EPOLLOUT;
ev.data.ptr = stream;
int status;
do {
status = epoll_ctl(janet_vm.epoll, EPOLL_CTL_ADD, stream->handle, &ev);
status = epoll_ctl(janet_vm.epoll, mod ? EPOLL_CTL_MOD : EPOLL_CTL_ADD, stream->handle, &ev);
} while (status == -1 && errno == EINTR);
if (status == -1) {
if (errno == EPERM) {
@ -1542,6 +1571,18 @@ static void janet_register_stream(JanetStream *stream) {
}
}
static void janet_register_stream(JanetStream *stream) {
janet_register_stream_impl(stream, 0, 1);
}
void janet_stream_edge_triggered(JanetStream *stream) {
janet_register_stream_impl(stream, 1, 1);
}
void janet_stream_level_triggered(JanetStream *stream) {
janet_register_stream_impl(stream, 1, 0);
}
#define JANET_EPOLL_MAX_EVENTS 64
void janet_loop1_impl(int has_timeout, JanetTimestamp timeout) {
struct itimerspec its;
@ -1671,14 +1712,15 @@ static void timestamp2timespec(struct timespec *t, JanetTimestamp ts) {
t->tv_nsec = ts == 0 ? 0 : (ts % 1000) * 1000000;
}
void janet_register_stream(JanetStream *stream) {
void janet_register_stream_impl(JanetStream *stream, int edge_trigger) {
struct kevent kevs[2];
int length = 0;
int clear = edge_trigger ? EV_CLEAR : 0;
if (stream->flags & (JANET_STREAM_READABLE | JANET_STREAM_ACCEPTABLE)) {
EV_SETx(&kevs[length++], stream->handle, EVFILT_READ, EV_ADD | EV_ENABLE | EV_CLEAR, 0, 0, stream);
EV_SETx(&kevs[length++], stream->handle, EVFILT_READ, EV_ADD | EV_ENABLE | clear, 0, 0, stream);
}
if (stream->flags & JANET_STREAM_WRITABLE) {
EV_SETx(&kevs[length++], stream->handle, EVFILT_WRITE, EV_ADD | EV_ENABLE | EV_CLEAR, 0, 0, stream);
EV_SETx(&kevs[length++], stream->handle, EVFILT_WRITE, EV_ADD | EV_ENABLE | clear, 0, 0, stream);
}
int status;
do {
@ -1689,6 +1731,18 @@ void janet_register_stream(JanetStream *stream) {
}
}
void janet_register_stream(JanetStream *stream) {
janet_register_stream_impl(stream, 1);
}
void janet_stream_edge_triggered(JanetStream *stream) {
janet_register_stream_impl(stream, 1);
}
void janet_stream_level_triggered(JanetStream *stream) {
janet_register_stream_impl(stream, 0);
}
#define JANET_KQUEUE_MAX_EVENTS 64
void janet_loop1_impl(int has_timeout, JanetTimestamp timeout) {
@ -1811,15 +1865,30 @@ void janet_register_stream(JanetStream *stream) {
janet_vm.stream_count = new_count;
}
void janet_stream_edge_triggered(JanetStream *stream) {
(void) stream;
}
void janet_stream_level_triggered(JanetStream *stream) {
(void) stream;
}
void janet_loop1_impl(int has_timeout, JanetTimestamp timeout) {
/* set event flags */
for (size_t i = 0; i < janet_vm.stream_count; i++) {
JanetStream *stream = janet_vm.streams[i];
janet_vm.fds[i + 1].events = 0;
janet_vm.fds[i + 1].revents = 0;
if (stream->read_fiber && stream->read_fiber->ev_callback) janet_vm.fds[i + 1].events |= POLLIN;
if (stream->write_fiber && stream->write_fiber->ev_callback) janet_vm.fds[i + 1].events |= POLLOUT;
struct pollfd *pfd = janet_vm.fds + i + 1;
pfd->events = 0;
pfd->revents = 0;
JanetFiber *rf = stream->read_fiber;
JanetFiber *wf = stream->write_fiber;
if (rf && rf->ev_callback) pfd->events |= POLLIN;
if (wf && wf->ev_callback) pfd->events |= POLLOUT;
/* Hack to ignore a file descriptor - make file descriptor negative if we want to ignore */
if (!pfd->events) {
pfd->fd = -pfd->fd;
}
}
/* Poll for events */
@ -1836,6 +1905,14 @@ void janet_loop1_impl(int has_timeout, JanetTimestamp timeout) {
JANET_EXIT("failed to poll events");
}
/* Undo negative hack */
for (size_t i = 0; i < janet_vm.stream_count; i++) {
struct pollfd *pfd = janet_vm.fds + i + 1;
if (pfd->fd < 0) {
pfd->fd = -pfd->fd;
}
}
/* Check selfpipe */
if (janet_vm.fds[0].revents & POLLIN) {
janet_vm.fds[0].revents = 0;
@ -2031,33 +2108,35 @@ void janet_ev_default_threaded_callback(JanetEVGenericMessage return_value) {
if (return_value.fiber == NULL) {
return;
}
switch (return_value.tag) {
default:
case JANET_EV_TCTAG_NIL:
janet_schedule(return_value.fiber, janet_wrap_nil());
break;
case JANET_EV_TCTAG_INTEGER:
janet_schedule(return_value.fiber, janet_wrap_integer(return_value.argi));
break;
case JANET_EV_TCTAG_STRING:
case JANET_EV_TCTAG_STRINGF:
janet_schedule(return_value.fiber, janet_cstringv((const char *) return_value.argp));
if (return_value.tag == JANET_EV_TCTAG_STRINGF) janet_free(return_value.argp);
break;
case JANET_EV_TCTAG_KEYWORD:
janet_schedule(return_value.fiber, janet_ckeywordv((const char *) return_value.argp));
break;
case JANET_EV_TCTAG_ERR_STRING:
case JANET_EV_TCTAG_ERR_STRINGF:
janet_cancel(return_value.fiber, janet_cstringv((const char *) return_value.argp));
if (return_value.tag == JANET_EV_TCTAG_STRINGF) janet_free(return_value.argp);
break;
case JANET_EV_TCTAG_ERR_KEYWORD:
janet_cancel(return_value.fiber, janet_ckeywordv((const char *) return_value.argp));
break;
case JANET_EV_TCTAG_BOOLEAN:
janet_schedule(return_value.fiber, janet_wrap_boolean(return_value.argi));
break;
if (janet_fiber_can_resume(return_value.fiber)) {
switch (return_value.tag) {
default:
case JANET_EV_TCTAG_NIL:
janet_schedule(return_value.fiber, janet_wrap_nil());
break;
case JANET_EV_TCTAG_INTEGER:
janet_schedule(return_value.fiber, janet_wrap_integer(return_value.argi));
break;
case JANET_EV_TCTAG_STRING:
case JANET_EV_TCTAG_STRINGF:
janet_schedule(return_value.fiber, janet_cstringv((const char *) return_value.argp));
if (return_value.tag == JANET_EV_TCTAG_STRINGF) janet_free(return_value.argp);
break;
case JANET_EV_TCTAG_KEYWORD:
janet_schedule(return_value.fiber, janet_ckeywordv((const char *) return_value.argp));
break;
case JANET_EV_TCTAG_ERR_STRING:
case JANET_EV_TCTAG_ERR_STRINGF:
janet_cancel(return_value.fiber, janet_cstringv((const char *) return_value.argp));
if (return_value.tag == JANET_EV_TCTAG_STRINGF) janet_free(return_value.argp);
break;
case JANET_EV_TCTAG_ERR_KEYWORD:
janet_cancel(return_value.fiber, janet_ckeywordv((const char *) return_value.argp));
break;
case JANET_EV_TCTAG_BOOLEAN:
janet_schedule(return_value.fiber, janet_wrap_boolean(return_value.argi));
break;
}
}
janet_gcunroot(janet_wrap_fiber(return_value.fiber));
}
@ -2943,10 +3022,15 @@ JANET_CORE_FN(cfun_ev_sleep,
JANET_CORE_FN(cfun_ev_deadline,
"(ev/deadline sec &opt tocancel tocheck)",
"Set a deadline for a fiber `tocheck`. If `tocheck` is not finished after `sec` seconds, "
"`tocancel` will be canceled as with `ev/cancel`. "
"If `tocancel` and `tocheck` are not given, they default to `(fiber/root)` and "
"`(fiber/current)` respectively. Returns `tocancel`.") {
"Schedules the event loop to try to cancel the `tocancel` "
"task as with `ev/cancel`. After `sec` seconds, the event "
"loop will attempt cancellation of `tocancel` if the "
"`tocheck` fiber is resumable. `sec` is a number that can "
"have a fractional part. `tocancel` defaults to "
"`(fiber/root)`, but if specified, must be a task (root "
"fiber). `tocheck` defaults to `(fiber/current)`, but if "
"specified, should be a fiber. Returns `tocancel` "
"immediately.") {
janet_arity(argc, 1, 3);
double sec = janet_getnumber(argv, 0);
JanetFiber *tocancel = janet_optfiber(argv, argc, 1, janet_vm.root_fiber);

2
src/core/fiber.c
View File

@ -662,7 +662,7 @@ JANET_CORE_FN(cfun_fiber_can_resume,
}
JANET_CORE_FN(cfun_fiber_last_value,
"(fiber/last-value)",
"(fiber/last-value fiber)",
"Get the last value returned or signaled from the fiber.") {
janet_fixarity(argc, 1);
JanetFiber *fiber = janet_getfiber(argv, 0);

19
src/core/marsh.c
View File

@ -185,6 +185,19 @@ static void marshal_one_env(MarshalState *st, JanetFuncEnv *env, int flags);
/* Prevent stack overflows */
#define MARSH_STACKCHECK if ((flags & 0xFFFF) > JANET_RECURSION_GUARD) janet_panic("stack overflow")
/* Quick check if a fiber cannot be marshalled. This is will
* have no false positives, but may have false negatives. */
static int fiber_cannot_be_marshalled(JanetFiber *fiber) {
if (janet_fiber_status(fiber) == JANET_STATUS_ALIVE) return 1;
int32_t i = fiber->frame;
while (i > 0) {
JanetStackFrame *frame = (JanetStackFrame *)(fiber->data + i - JANET_FRAME_SIZE);
if (!frame->func) return 1; /* has cfunction on stack */
i = frame->prevframe;
}
return 0;
}
/* Marshal a function env */
static void marshal_one_env(MarshalState *st, JanetFuncEnv *env, int flags) {
MARSH_STACKCHECK;
@ -197,7 +210,9 @@ static void marshal_one_env(MarshalState *st, JanetFuncEnv *env, int flags) {
}
janet_env_valid(env);
janet_v_push(st->seen_envs, env);
if (env->offset > 0 && (JANET_STATUS_ALIVE == janet_fiber_status(env->as.fiber))) {
/* Special case for early detachment */
if (env->offset > 0 && fiber_cannot_be_marshalled(env->as.fiber)) {
pushint(st, 0);
pushint(st, env->length);
Janet *values = env->as.fiber->data + env->offset;
@ -328,7 +343,7 @@ static void marshal_one_fiber(MarshalState *st, JanetFiber *fiber, int flags) {
while (i > 0) {
JanetStackFrame *frame = (JanetStackFrame *)(fiber->data + i - JANET_FRAME_SIZE);
if (frame->env) frame->flags |= JANET_STACKFRAME_HASENV;
if (!frame->func) janet_panic("cannot marshal fiber with c stackframe");
if (!frame->func) janet_panicf("cannot marshal fiber with c stackframe (%v)", janet_wrap_cfunction((JanetCFunction) frame->pc));
pushint(st, frame->flags);
pushint(st, frame->prevframe);
int32_t pcdiff = (int32_t)(frame->pc - frame->func->def->bytecode);

22
src/core/net.c
View File

@ -79,12 +79,20 @@ const JanetAbstractType janet_address_type = {
/* maximum number of bytes in a socket address host (post name resolution) */
#ifdef JANET_WINDOWS
#ifdef JANET_NO_IPV6
#define SA_ADDRSTRLEN (INET_ADDRSTRLEN + 1)
#else
#define SA_ADDRSTRLEN (INET6_ADDRSTRLEN + 1)
#endif
typedef unsigned short in_port_t;
#else
#define JANET_SA_MAX(a, b) (((a) > (b))? (a) : (b))
#ifdef JANET_NO_IPV6
#define SA_ADDRSTRLEN JANET_SA_MAX(INET_ADDRSTRLEN + 1, (sizeof ((struct sockaddr_un *)0)->sun_path) + 1)
#else
#define SA_ADDRSTRLEN JANET_SA_MAX(INET6_ADDRSTRLEN + 1, (sizeof ((struct sockaddr_un *)0)->sun_path) + 1)
#endif
#endif
static JanetStream *make_stream(JSock handle, uint32_t flags);
@ -114,13 +122,8 @@ static void janet_net_socknoblock(JSock s) {
/* State machine for async connect */
typedef struct {
int did_connect;
} NetStateConnect;
void net_callback_connect(JanetFiber *fiber, JanetAsyncEvent event) {
JanetStream *stream = fiber->ev_stream;
NetStateConnect *state = (NetStateConnect *)fiber->ev_state;
switch (event) {
default:
break;
@ -147,7 +150,6 @@ void net_callback_connect(JanetFiber *fiber, JanetAsyncEvent event) {
#endif
if (r == 0) {
if (res == 0) {
state->did_connect = 1;
janet_schedule(fiber, janet_wrap_abstract(stream));
} else {
janet_cancel(fiber, janet_cstringv(strerror(res)));
@ -161,9 +163,7 @@ void net_callback_connect(JanetFiber *fiber, JanetAsyncEvent event) {
}
static JANET_NO_RETURN void net_sched_connect(JanetStream *stream) {
NetStateConnect *state = janet_malloc(sizeof(NetStateConnect));
state->did_connect = 0;
janet_async_start(stream, JANET_ASYNC_LISTEN_WRITE, net_callback_connect, state);
janet_async_start(stream, JANET_ASYNC_LISTEN_WRITE, net_callback_connect, NULL);
}
/* State machine for accepting connections. */
@ -319,6 +319,7 @@ JANET_NO_RETURN static void janet_sched_accept(JanetStream *stream, JanetFunctio
NetStateAccept *state = janet_malloc(sizeof(NetStateAccept));
memset(state, 0, sizeof(NetStateAccept));
state->function = fun;
if (fun) janet_stream_level_triggered(stream);
janet_async_start(stream, JANET_ASYNC_LISTEN_READ, net_callback_accept, state);
}
@ -745,6 +746,7 @@ static Janet janet_so_getname(const void *sa_any) {
Janet pair[2] = {janet_cstringv(buffer), janet_wrap_integer(ntohs(sai->sin_port))};
return janet_wrap_tuple(janet_tuple_n(pair, 2));
}
#ifndef JANET_NO_IPV6
case AF_INET6: {
const struct sockaddr_in6 *sai6 = sa_any;
if (!inet_ntop(AF_INET6, &(sai6->sin6_addr), buffer, sizeof(buffer))) {
@ -753,6 +755,7 @@ static Janet janet_so_getname(const void *sa_any) {
Janet pair[2] = {janet_cstringv(buffer), janet_wrap_integer(ntohs(sai6->sin6_port))};
return janet_wrap_tuple(janet_tuple_n(pair, 2));
}
#endif
#ifndef JANET_WINDOWS
case AF_UNIX: {
const struct sockaddr_un *sun = sa_any;
@ -819,6 +822,7 @@ JANET_CORE_FN(cfun_stream_accept_loop,
JanetStream *stream = janet_getabstract(argv, 0, &janet_stream_type);
janet_stream_flags(stream, JANET_STREAM_ACCEPTABLE | JANET_STREAM_SOCKET);
JanetFunction *fun = janet_getfunction(argv, 1);
if (fun->def->min_arity < 1) janet_panic("handler function must take at least 1 argument");
janet_sched_accept(stream, fun);
}

123
src/core/os.c
View File

@ -229,10 +229,11 @@ JANET_CORE_FN(os_compiler,
#undef janet_stringify
JANET_CORE_FN(os_exit,
"(os/exit &opt x)",
"(os/exit &opt x force)",
"Exit from janet with an exit code equal to x. If x is not an integer, "
"the exit with status equal the hash of x.") {
janet_arity(argc, 0, 1);
"the exit with status equal the hash of x. If `force` is truthy will exit immediately and "
"skip cleanup code.") {
janet_arity(argc, 0, 2);
int status;
if (argc == 0) {
status = EXIT_SUCCESS;
@ -242,7 +243,11 @@ JANET_CORE_FN(os_exit,
status = EXIT_FAILURE;
}
janet_deinit();
exit(status);
if (argc >= 2 && janet_truthy(argv[1])) {
_exit(status);
} else {
exit(status);
}
return janet_wrap_nil();
}
@ -500,8 +505,11 @@ static int proc_get_status(JanetProc *proc) {
status = WEXITSTATUS(status);
} else if (WIFSTOPPED(status)) {
status = WSTOPSIG(status) + 128;
} else {
} else if (WIFSIGNALED(status)) {
status = WTERMSIG(status) + 128;
} else {
/* Could possibly return -1 but for now, just panic */
janet_panicf("Undefined status code for process termination, %d.", status);
}
return status;
}
@ -529,7 +537,9 @@ static void janet_proc_wait_cb(JanetEVGenericMessage args) {
JanetString s = janet_formatc("command failed with non-zero exit code %d", status);
janet_cancel(args.fiber, janet_wrap_string(s));
} else {
janet_schedule(args.fiber, janet_wrap_integer(status));
if (janet_fiber_can_resume(args.fiber)) {
janet_schedule(args.fiber, janet_wrap_integer(status));
}
}
}
}
@ -611,7 +621,11 @@ os_proc_wait_impl(JanetProc *proc) {
JANET_CORE_FN(os_proc_wait,
"(os/proc-wait proc)",
"Block until the subprocess completes. Returns the subprocess return code.") {
"Suspend the current fiber until the subprocess completes. Returns the subprocess return code. "
"os/proc-wait cannot be called twice on the same process. If `ev/with-deadline` cancels `os/proc-wait` "
"with an error or os/proc-wait is cancelled with any error caused by anything else, os/proc-wait still "
"finishes in the background. Only after os/proc-wait finishes, a process is cleaned up by the operating "
"system. Thus, a process becomes a zombie process if os/proc-wait is not called.") {
janet_fixarity(argc, 1);
JanetProc *proc = janet_getabstract(argv, 0, &ProcAT);
#ifdef JANET_EV
@ -640,7 +654,7 @@ static const struct keyword_signal signal_keywords[] = {
#ifdef SIGTERM
{"term", SIGTERM},
#endif
#ifdef SIGARLM
#ifdef SIGALRM
{"alrm", SIGALRM},
#endif
#ifdef SIGHUP
@ -722,10 +736,11 @@ static int get_signal_kw(const Janet *argv, int32_t n) {
JANET_CORE_FN(os_proc_kill,
"(os/proc-kill proc &opt wait signal)",
"Kill a subprocess by sending SIGKILL to it on posix systems, or by closing the process "
"handle on windows. If `wait` is truthy, will wait for the process to finish and "
"returns the exit code. Otherwise, returns `proc`. If signal is specified send it instead."
"Signal keywords are named after their C counterparts but in lowercase with the leading "
"`SIG` stripped. Signals are ignored on windows.") {
"handle on windows. If os/proc-wait already finished for proc, os/proc-kill raises an error. After "
"sending signal to proc, if `wait` is truthy, will wait for the process to finish and return the exit "
"code by calling os/proc-wait. Otherwise, returns `proc`. If signal is specified, send it instead. "
"Signal keywords are named after their C counterparts but in lowercase with the leading `SIG` stripped. "
"Signals are ignored on windows.") {
janet_arity(argc, 1, 3);
JanetProc *proc = janet_getabstract(argv, 0, &ProcAT);
if (proc->flags & JANET_PROC_WAITED) {
@ -764,8 +779,9 @@ JANET_CORE_FN(os_proc_kill,
JANET_CORE_FN(os_proc_close,
"(os/proc-close proc)",
"Wait on a process if it has not been waited on, and close pipes created by `os/spawn` "
"if they have not been closed. Returns nil.") {
"Close pipes created by `os/spawn` if they have not been closed. Then, if os/proc-wait was not already "
"called on proc, os/proc-wait is called on it, and it returns the exit code returned by os/proc-wait. "
"Otherwise, returns nil.") {
janet_fixarity(argc, 1);
JanetProc *proc = janet_getabstract(argv, 0, &ProcAT);
#ifdef JANET_EV
@ -875,8 +891,9 @@ JANET_CORE_FN(os_sigaction,
}
struct sigaction action;
sigset_t mask;
sigfillset(&mask);
sigaddset(&mask, sig);
memset(&action, 0, sizeof(action));
action.sa_flags |= SA_RESTART;
if (can_interrupt) {
#ifdef JANET_NO_INTERPRETER_INTERRUPT
janet_panic("interpreter interrupt not enabled");
@ -1369,21 +1386,26 @@ JANET_CORE_FN(os_execute,
"* :d - Don't try and terminate the process on garbage collection (allow spawning zombies).\n"
"`env` is a table or struct mapping environment variables to values. It can also "
"contain the keys :in, :out, and :err, which allow redirecting stdio in the subprocess. "
"These arguments should be core/file values. "
"Returns the exit status of the program.") {
":in, :out, and :err should be core/file values or core/stream values. core/file values and core/stream "
"values passed to :in, :out, and :err should be closed manually because os/execute doesn't close them. "
"Returns the exit code of the program.") {
return os_execute_impl(argc, argv, JANET_EXECUTE_EXECUTE);
}
JANET_CORE_FN(os_spawn,
"(os/spawn args &opt flags env)",
"Execute a program on the system and return a handle to the process. Otherwise, takes the "
"same arguments as `os/execute`. Does not wait for the process. "
"For each of the :in, :out, and :err keys to the `env` argument, one "
"can also pass in the keyword `:pipe` "
"to get streams for standard IO of the subprocess that can be read from and written to. "
"The returned value `proc` has the fields :in, :out, :err, :return-code, and "
"the additional field :pid on unix-like platforms. Use `(os/proc-wait proc)` to rejoin the "
"subprocess or `(os/proc-kill proc)`.") {
"same arguments as `os/execute`. Does not wait for the process. For each of the :in, :out, and :err keys "
"of the `env` argument, one can also pass in the keyword `:pipe` to get streams for standard IO of the "
"subprocess that can be read from and written to. The returned value `proc` has the fields :in, :out, "
":err, and the additional field :pid on unix-like platforms. `(os/proc-wait proc)` must be called to "
"rejoin the subprocess. After `(os/proc-wait proc)` finishes, proc gains a new field, :return-code. "
"If :x flag is passed to os/spawn, non-zero exit code will cause os/proc-wait to raise an error. "
"If pipe streams created with :pipe keyword are not closed in time, janet can run out of file "
"descriptors. They can be closed individually, or `os/proc-close` can close all pipe streams on proc. "
"If pipe streams aren't read before `os/proc-wait` finishes, then pipe buffers become full, and the "
"process cannot finish because the process cannot print more on pipe buffers which are already full. "
"If the process cannot finish, os/proc-wait cannot finish, either.") {
return os_execute_impl(argc, argv, JANET_EXECUTE_SPAWN);
}
@ -1542,34 +1564,51 @@ JANET_CORE_FN(os_time,
}
JANET_CORE_FN(os_clock,
"(os/clock &opt source)",
"Return the number of whole + fractional seconds of the requested clock source.\n\n"
"(os/clock &opt source format)",
"Return the current time of the requested clock source.\n\n"
"The `source` argument selects the clock source to use, when not specified the default "
"is `:realtime`:\n"
"- :realtime: Return the real (i.e., wall-clock) time. This clock is affected by discontinuous "
" jumps in the system time\n"
"- :monotonic: Return the number of whole + fractional seconds since some fixed point in "
" time. The clock is guaranteed to be non-decreasing in real time.\n"
"- :cputime: Return the CPU time consumed by this process (i.e. all threads in the process)\n") {
"- :cputime: Return the CPU time consumed by this process (i.e. all threads in the process)\n"
"The `format` argument selects the type of output, when not specified the default is `:double`:\n"
"- :double: Return the number of seconds + fractional seconds as a double\n"
"- :int: Return the number of seconds as an integer\n"
"- :tuple: Return a 2 integer tuple [seconds, nanoseconds]\n") {
enum JanetTimeSource source;
janet_sandbox_assert(JANET_SANDBOX_HRTIME);
janet_arity(argc, 0, 1);
enum JanetTimeSource source = JANET_TIME_REALTIME;
if (argc == 1) {
JanetKeyword sourcestr = janet_getkeyword(argv, 0);
if (janet_cstrcmp(sourcestr, "realtime") == 0) {
source = JANET_TIME_REALTIME;
} else if (janet_cstrcmp(sourcestr, "monotonic") == 0) {
source = JANET_TIME_MONOTONIC;
} else if (janet_cstrcmp(sourcestr, "cputime") == 0) {
source = JANET_TIME_CPUTIME;
} else {
janet_panicf("expected :realtime, :monotonic, or :cputime, got %v", argv[0]);
}
janet_arity(argc, 0, 2);
JanetKeyword sourcestr = janet_optkeyword(argv, argc, 0, (const uint8_t *) "realtime");
if (janet_cstrcmp(sourcestr, "realtime") == 0) {
source = JANET_TIME_REALTIME;
} else if (janet_cstrcmp(sourcestr, "monotonic") == 0) {
source = JANET_TIME_MONOTONIC;
} else if (janet_cstrcmp(sourcestr, "cputime") == 0) {
source = JANET_TIME_CPUTIME;
} else {
janet_panicf("expected :realtime, :monotonic, or :cputime, got %v", argv[0]);
}
struct timespec tv;
if (janet_gettime(&tv, source)) janet_panic("could not get time");
double dtime = tv.tv_sec + (tv.tv_nsec / 1E9);
return janet_wrap_number(dtime);
JanetKeyword formatstr = janet_optkeyword(argv, argc, 1, (const uint8_t *) "double");
if (janet_cstrcmp(formatstr, "double") == 0) {
double dtime = (double)(tv.tv_sec + (tv.tv_nsec / 1E9));
return janet_wrap_number(dtime);
} else if (janet_cstrcmp(formatstr, "int") == 0) {
return janet_wrap_number((double)(tv.tv_sec));
} else if (janet_cstrcmp(formatstr, "tuple") == 0) {
Janet tup[2] = {janet_wrap_number((double)tv.tv_sec),
janet_wrap_number((double)tv.tv_nsec)
};
return janet_wrap_tuple(janet_tuple_n(tup, 2));
} else {
janet_panicf("expected :double, :int, or :tuple, got %v", argv[1]);
}
}
JANET_CORE_FN(os_sleep,

106
src/core/peg.c
View File

@ -39,6 +39,10 @@
typedef struct {
const uint8_t *text_start;
const uint8_t *text_end;
/* text_end can be restricted by some rules, but
outer_text_end will always contain the real end of
input, which we need to generate a line mapping */
const uint8_t *outer_text_end;
const uint32_t *bytecode;
const Janet *constants;
JanetArray *captures;
@ -114,12 +118,12 @@ static LineCol get_linecol_from_position(PegState *s, int32_t position) {
/* Generate if not made yet */
if (s->linemaplen < 0) {
int32_t newline_count = 0;
for (const uint8_t *c = s->text_start; c < s->text_end; c++) {
for (const uint8_t *c = s->text_start; c < s->outer_text_end; c++) {
if (*c == '\n') newline_count++;
}
int32_t *mem = janet_smalloc(sizeof(int32_t) * newline_count);
size_t index = 0;
for (const uint8_t *c = s->text_start; c < s->text_end; c++) {
for (const uint8_t *c = s->text_start; c < s->outer_text_end; c++) {
if (*c == '\n') mem[index++] = (int32_t)(c - s->text_start);
}
s->linemaplen = newline_count;
@ -179,7 +183,7 @@ static const uint8_t *peg_rule(
const uint32_t *rule,
const uint8_t *text) {
tail:
switch (*rule & 0x1F) {
switch (*rule) {
default:
janet_panic("unexpected opcode");
return NULL;
@ -482,6 +486,68 @@ tail:
return result;
}
case RULE_SUB: {
const uint8_t *text_start = text;
const uint32_t *rule_window = s->bytecode + rule[1];
const uint32_t *rule_subpattern = s->bytecode + rule[2];
down1(s);
const uint8_t *window_end = peg_rule(s, rule_window, text);
up1(s);
if (!window_end) {
return NULL;
}
const uint8_t *saved_end = s->text_end;
s->text_end = window_end;
down1(s);
const uint8_t *next_text = peg_rule(s, rule_subpattern, text_start);
up1(s);
s->text_end = saved_end;
if (!next_text) {
return NULL;
}
return window_end;
}
case RULE_SPLIT: {
const uint8_t *saved_end = s->text_end;
const uint32_t *rule_separator = s->bytecode + rule[1];
const uint32_t *rule_subpattern = s->bytecode + rule[2];
const uint8_t *separator_end = NULL;
do {
const uint8_t *text_start = text;
CapState cs = cap_save(s);
down1(s);
while (text <= s->text_end) {
separator_end = peg_rule(s, rule_separator, text);
cap_load(s, cs);
if (separator_end) {
break;
}
text++;
}
up1(s);
if (separator_end) {
s->text_end = text;
text = separator_end;
}
down1(s);
const uint8_t *subpattern_end = peg_rule(s, rule_subpattern, text_start);
up1(s);
s->text_end = saved_end;
if (!subpattern_end) {
return NULL;
}
} while (separator_end);
return s->text_end;
}
case RULE_REPLACE:
case RULE_MATCHTIME: {
uint32_t tag = rule[3];
@ -1107,6 +1173,22 @@ static void spec_matchtime(Builder *b, int32_t argc, const Janet *argv) {
emit_3(r, RULE_MATCHTIME, subrule, cindex, tag);
}
static void spec_sub(Builder *b, int32_t argc, const Janet *argv) {
peg_fixarity(b, argc, 2);
Reserve r = reserve(b, 3);
uint32_t subrule1 = peg_compile1(b, argv[0]);
uint32_t subrule2 = peg_compile1(b, argv[1]);
emit_2(r, RULE_SUB, subrule1, subrule2);
}
static void spec_split(Builder *b, int32_t argc, const Janet *argv) {
peg_fixarity(b, argc, 2);
Reserve r = reserve(b, 3);
uint32_t subrule1 = peg_compile1(b, argv[0]);
uint32_t subrule2 = peg_compile1(b, argv[1]);
emit_2(r, RULE_SPLIT, subrule1, subrule2);
}
#ifdef JANET_INT_TYPES
#define JANET_MAX_READINT_WIDTH 8
#else
@ -1190,6 +1272,8 @@ static const SpecialPair peg_specials[] = {
{"sequence", spec_sequence},
{"set", spec_set},
{"some", spec_some},
{"split", spec_split},
{"sub", spec_sub},
{"thru", spec_thru},
{"to", spec_to},
{"uint", spec_uint_le},
@ -1431,7 +1515,7 @@ static void *peg_unmarshal(JanetMarshalContext *ctx) {
uint32_t instr = bytecode[i];
uint32_t *rule = bytecode + i;
op_flags[i] |= 0x02;
switch (instr & 0x1F) {
switch (instr) {
case RULE_LITERAL:
i += 2 + ((rule[1] + 3) >> 2);
break;
@ -1524,6 +1608,15 @@ static void *peg_unmarshal(JanetMarshalContext *ctx) {
op_flags[rule[1]] |= 0x01;
i += 4;
break;
case RULE_SUB:
case RULE_SPLIT:
/* [rule, rule] */
if (rule[1] >= blen) goto bad;
if (rule[2] >= blen) goto bad;
op_flags[rule[1]] |= 0x01;
op_flags[rule[2]] |= 0x01;
i += 3;
break;
case RULE_ERROR:
case RULE_DROP:
case RULE_NOT:
@ -1652,7 +1745,7 @@ typedef struct {
static PegCall peg_cfun_init(int32_t argc, Janet *argv, int get_replace) {
PegCall ret;
int32_t min = get_replace ? 3 : 2;
janet_arity(argc, get_replace, -1);
janet_arity(argc, min, -1);
if (janet_checktype(argv[0], JANET_ABSTRACT) &&
janet_abstract_type(janet_unwrap_abstract(argv[0])) == &janet_peg_type) {
ret.peg = janet_unwrap_abstract(argv[0]);
@ -1677,6 +1770,7 @@ static PegCall peg_cfun_init(int32_t argc, Janet *argv, int get_replace) {
ret.s.mode = PEG_MODE_NORMAL;
ret.s.text_start = ret.bytes.bytes;
ret.s.text_end = ret.bytes.bytes + ret.bytes.len;
ret.s.outer_text_end = ret.s.text_end;
ret.s.depth = JANET_RECURSION_GUARD;
ret.s.captures = janet_array(0);
ret.s.tagged_captures = janet_array(0);
@ -1771,7 +1865,7 @@ JANET_CORE_FN(cfun_peg_replace_all,
}
JANET_CORE_FN(cfun_peg_replace,
"(peg/replace peg repl text &opt start & args)",
"(peg/replace peg subst text &opt start & args)",
"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 "

25
src/core/specials.c
View File

@ -149,7 +149,7 @@ static int destructure(JanetCompiler *c,
JanetTable *attr) {
switch (janet_type(left)) {
default:
janetc_error(c, janet_formatc("unexpected type in destruction, got %v", left));
janetc_error(c, janet_formatc("unexpected type in destructuring, got %v", left));
return 1;
case JANET_SYMBOL:
/* Leaf, assign right to left */
@ -531,17 +531,11 @@ static JanetSlot janetc_def(JanetFopts opts, int32_t argn, const Janet *argv) {
}
/* Check if a form matches the pattern (= nil _) or (not= nil _) */
static int janetc_check_nil_form(JanetFopts opts, Janet x, Janet *capture, uint32_t fun_tag) {
static int janetc_check_nil_form(Janet x, Janet *capture, uint32_t fun_tag) {
if (!janet_checktype(x, JANET_TUPLE)) return 0;
JanetTuple tup = janet_unwrap_tuple(x);
if (3 != janet_tuple_length(tup)) return 0;
Janet op1 = tup[0];
if (janet_checktype(op1, JANET_SYMBOL)) {
Janet entry = janet_table_get(opts.compiler->env, op1);
if (janet_checktype(entry, JANET_TABLE)) {
op1 = janet_table_get(janet_unwrap_table(entry), janet_ckeywordv("value"));
}
}
if (!janet_checktype(op1, JANET_FUNCTION)) return 0;
JanetFunction *fun = janet_unwrap_function(op1);
uint32_t tag = fun->def->flags & JANET_FUNCDEF_FLAG_TAG;
@ -601,10 +595,9 @@ static JanetSlot janetc_if(JanetFopts opts, int32_t argn, const Janet *argv) {
janetc_scope(&condscope, c, 0, "if");
Janet condform = argv[0];
if (janetc_check_nil_form(opts, condform, &condform, JANET_FUN_EQ)) {
if (janetc_check_nil_form(condform, &condform, JANET_FUN_EQ)) {
ifnjmp = JOP_JUMP_IF_NOT_NIL;
}
if (janetc_check_nil_form(opts, condform, &condform, JANET_FUN_NEQ)) {
} else if (janetc_check_nil_form(condform, &condform, JANET_FUN_NEQ)) {
ifnjmp = JOP_JUMP_IF_NIL;
}
@ -613,7 +606,11 @@ static JanetSlot janetc_if(JanetFopts opts, int32_t argn, const Janet *argv) {
/* Check constant condition. */
/* TODO: Use type info for more short circuits */
if (cond.flags & JANET_SLOT_CONSTANT) {
if (!janet_truthy(cond.constant)) {
int swap_condition = 0;
if (ifnjmp == JOP_JUMP_IF_NOT && !janet_truthy(cond.constant)) swap_condition = 1;
if (ifnjmp == JOP_JUMP_IF_NIL && janet_checktype(cond.constant, JANET_NIL)) swap_condition = 1;
if (ifnjmp == JOP_JUMP_IF_NOT_NIL && !janet_checktype(cond.constant, JANET_NIL)) swap_condition = 1;
if (swap_condition) {
/* Swap the true and false bodies */
Janet temp = falsebody;
falsebody = truebody;
@ -808,12 +805,12 @@ static JanetSlot janetc_while(JanetFopts opts, int32_t argn, const Janet *argv)
* jmpnl or jmpnn instructions. This let's us implement `(each ...)`
* more efficiently. */
Janet condform = argv[0];
if (janetc_check_nil_form(opts, condform, &condform, JANET_FUN_EQ)) {
if (janetc_check_nil_form(condform, &condform, JANET_FUN_EQ)) {
is_nil_form = 1;
ifjmp = JOP_JUMP_IF_NIL;
ifnjmp = JOP_JUMP_IF_NOT_NIL;
}
if (janetc_check_nil_form(opts, condform, &condform, JANET_FUN_NEQ)) {
if (janetc_check_nil_form(condform, &condform, JANET_FUN_NEQ)) {
is_notnil_form = 1;
ifjmp = JOP_JUMP_IF_NOT_NIL;
ifnjmp = JOP_JUMP_IF_NIL;

4
src/core/string.c
View File

@ -549,8 +549,8 @@ JANET_CORE_FN(cfun_string_format,
"- `a`, `A`: floating point number, formatted as a hexadecimal number.\n"
"- `s`: formatted as a string, precision indicates padding and maximum length.\n"
"- `t`: emit the type of the given value.\n"
"- `v`: format with (describe x)"
"- `V`: format with (string x)"
"- `v`: format with (describe x)\n"
"- `V`: format with (string x)\n"
"- `j`: format to jdn (Janet data notation).\n"
"\n"
"The following conversion specifiers are used for \"pretty-printing\", where the upper-case "

1
src/core/symcache.c
View File

@ -234,6 +234,7 @@ const uint8_t *janet_symbol_gen(void) {
head->hash = hash;
sym = (uint8_t *)(head->data);
memcpy(sym, janet_vm.gensym_counter, sizeof(janet_vm.gensym_counter));
sym[head->length] = 0;
janet_symcache_put((const uint8_t *)sym, bucket);
return (const uint8_t *)sym;
}

4
src/core/util.h
View File

@ -49,11 +49,11 @@
#ifndef JANET_EXIT
#include <stdio.h>
#define JANET_EXIT(m) do { \
fprintf(stderr, "janet interpreter runtime error at line %d in file %s: %s\n",\
fprintf(stderr, "janet internal error at line %d in file %s: %s\n",\
__LINE__,\
__FILE__,\
(m));\
exit(1);\
abort();\
} while (0)
#endif

10
src/include/janet.h
View File

@ -636,6 +636,12 @@ JANET_API void janet_async_end(JanetFiber *fiber);
/* Needed for windows to mark a fiber as waiting for an IOCP completion event. Noop on other platforms. */
JANET_API void janet_async_in_flight(JanetFiber *fiber);
/* On some platforms, it is important to be able to control if a stream is edge-trigger or level triggered.
* For example, a server that is accepting connections might want to be level triggered or edge-triggered
* depending on expected service. */
JANET_API void janet_stream_edge_triggered(JanetStream *stream);
JANET_API void janet_stream_level_triggered(JanetStream *stream);
#endif
/* Janet uses atomic integers in several places for synchronization between threads and
@ -2140,7 +2146,9 @@ typedef enum {
RULE_LINE, /* [tag] */
RULE_COLUMN, /* [tag] */
RULE_UNREF, /* [rule, tag] */
RULE_CAPTURE_NUM /* [rule, tag] */
RULE_CAPTURE_NUM, /* [rule, tag] */
RULE_SUB, /* [rule, rule] */
RULE_SPLIT /* [rule, rule] */
} JanetPegOpcod;
typedef struct {

8
test/suite-asm.janet
View File

@ -51,5 +51,13 @@
(def f (asm (disasm (fn [x] (fn [y] (+ x y))))))
(assert (= ((f 10) 37) 47) "asm environment tables")
# issue #1424
(assert-no-error "arity > used slots (issue #1424)"
(asm
(disasm
(fn []
(def foo (fn [one two] one))
(foo 100 200)))))
(end-suite)

39
test/suite-boot.janet
View File

@ -241,6 +241,16 @@
(assert (pos? (% x 4)) "generate in loop"))
(assert (= gencount 75) "generate loop count")
# more loop checks
(assert (deep= (seq [i :range [0 10]] i) @[0 1 2 3 4 5 6 7 8 9]) "seq 1")
(assert (deep= (seq [i :range [0 10 2]] i) @[0 2 4 6 8]) "seq 2")
(assert (deep= (seq [i :range [10]] i) @[0 1 2 3 4 5 6 7 8 9]) "seq 3")
(assert (deep= (seq [i :range-to [10]] i) @[0 1 2 3 4 5 6 7 8 9 10]) "seq 4")
(def gen (generate [x :range-to [0 nil 2]] x))
(assert (deep= (take 5 gen) @[0 2 4 6 8]) "generate nil limit")
(def gen (generate [x :range [0 nil 2]] x))
(assert (deep= (take 5 gen) @[0 2 4 6 8]) "generate nil limit 2")
# Even and odd
# ff163a5ae
(assert (odd? 9) "odd? 1")
@ -354,7 +364,7 @@
"sort 5")
(assert (<= ;(sort (map (fn [x] (math/random)) (range 1000)))) "sort 6")
# #1283
# #1283
(assert (deep=
(partition 2 (generate [ i :in [:a :b :c :d :e]] i))
'@[(:a :b) (:c :d) (:e)]))
@ -945,10 +955,37 @@
(defn case-4 [&]
(def x (break (break (break)))))
(bytecode-roundtrip case-4)
(defn case-5 []
(def foo (fn [one two] one))
(foo 100 200))
(bytecode-roundtrip case-5)
# Debug bytecode of these functions
# (pp (disasm case-1))
# (pp (disasm case-2))
# (pp (disasm case-3))
# Regression #1330
(defn regress-1330 [&]
(def a [1 2 3])
(def b [;a])
(identity a))
(assert (= [1 2 3] (regress-1330)) "regression 1330")
# Issue 1341
(assert (= () '() (macex '())) "macex ()")
(assert (= '[] (macex '[])) "macex []")
# Knuth man or boy test
(var a nil)
(defn man-or-boy [x] (a x |1 |-1 |-1 |1 |0))
(varfn a [k x1 x2 x3 x4 x5]
(var k k)
(defn b [] (-- k) (a k b x1 x2 x3 x4))
(if (<= k 0)
(+ (x4) (x5))
(b)))
(assert (= -2 (man-or-boy 2)))
(assert (= -67 (man-or-boy 10)))
(end-suite)

40
test/suite-buffer.janet
View File

@ -77,6 +77,46 @@
(buffer/push-string b5 "456" @"789")
(assert (= "123456789" (string b5)) "buffer/push-buffer 2")
(def buffer-uint16-be @"")
(buffer/push-uint16 buffer-uint16-be :be 0x0102)
(assert (= "\x01\x02" (string buffer-uint16-be)) "buffer/push-uint16 big endian")
(def buffer-uint16-le @"")
(buffer/push-uint16 buffer-uint16-le :le 0x0102)
(assert (= "\x02\x01" (string buffer-uint16-le)) "buffer/push-uint16 little endian")
(def buffer-uint16-negative @"")
(buffer/push-uint16 buffer-uint16-negative :be -1)
(assert (= "\xff\xff" (string buffer-uint16-negative)) "buffer/push-uint16 negative")
(def buffer-uint32-be @"")
(buffer/push-uint32 buffer-uint32-be :be 0x01020304)
(assert (= "\x01\x02\x03\x04" (string buffer-uint32-be)) "buffer/push-uint32 big endian")
(def buffer-uint32-le @"")
(buffer/push-uint32 buffer-uint32-le :le 0x01020304)
(assert (= "\x04\x03\x02\x01" (string buffer-uint32-le)) "buffer/push-uint32 little endian")
(def buffer-uint32-negative @"")
(buffer/push-uint32 buffer-uint32-negative :be -1)
(assert (= "\xff\xff\xff\xff" (string buffer-uint32-negative)) "buffer/push-uint32 negative")
(def buffer-float32-be @"")
(buffer/push-float32 buffer-float32-be :be 1.234)
(assert (= "\x3f\x9d\xf3\xb6" (string buffer-float32-be)) "buffer/push-float32 big endian")
(def buffer-float32-le @"")
(buffer/push-float32 buffer-float32-le :le 1.234)
(assert (= "\xb6\xf3\x9d\x3f" (string buffer-float32-le)) "buffer/push-float32 little endian")
(def buffer-float64-be @"")
(buffer/push-float64 buffer-float64-be :be 1.234)
(assert (= "\x3f\xf3\xbe\x76\xc8\xb4\x39\x58" (string buffer-float64-be)) "buffer/push-float64 big endian")
(def buffer-float64-le @"")
(buffer/push-float64 buffer-float64-le :le 1.234)
(assert (= "\x58\x39\xb4\xc8\x76\xbe\xf3\x3f" (string buffer-float64-le)) "buffer/push-float64 little endian")
# Buffer from bytes
(assert (deep= @"" (buffer/from-bytes)) "buffer/from-bytes 1")
(assert (deep= @"ABC" (buffer/from-bytes 65 66 67)) "buffer/from-bytes 2")

25
test/suite-ev.janet
View File

@ -21,6 +21,9 @@
(import ./helper :prefix "" :exit true)
(start-suite)
(def test-port (os/getenv "JANET_TEST_PORT" "8761"))
(def test-host (os/getenv "JANET_TEST_HOST" "127.0.0.1"))
# Subprocess
# 5e1a8c86f
(def janet (dyn *executable*))
@ -192,11 +195,11 @@
(net/write stream b)
(buffer/clear b)))
(def s (net/server "127.0.0.1" "8000" handler))
(def s (net/server test-host test-port handler))
(assert s "made server 1")
(defn test-echo [msg]
(with [conn (net/connect "127.0.0.1" "8000")]
(with [conn (net/connect test-host test-port)]
(net/write conn msg)
(def res (net/read conn 1024))
(assert (= (string res) msg) (string "echo " msg))))
@ -216,18 +219,18 @@
# prevent immediate close
(ev/read stream 1)
(def [host port] (net/localname stream))
(assert (= host "127.0.0.1") "localname host server")
(assert (= port 8000) "localname port server")))
(assert (= host test-host) "localname host server")
(assert (= port (scan-number test-port)) "localname port server")))
# Test localname and peername
# 077bf5eba
(repeat 10
(with [s (net/server "127.0.0.1" "8000" names-handler)]
(with [s (net/server test-host test-port names-handler)]
(repeat 10
(with [conn (net/connect "127.0.0.1" "8000")]
(with [conn (net/connect test-host test-port)]
(def [host port] (net/peername conn))
(assert (= host "127.0.0.1") "peername host client ")
(assert (= port 8000) "peername port client")
(assert (= host test-host) "peername host client ")
(assert (= port (scan-number test-port)) "peername port client")
# let server close
(ev/write conn " "))))
(gccollect))
@ -366,4 +369,10 @@
(exec-slurp ;run janet "-e" "(print :hi)")))
"exec-slurp 1"))
# valgrind-able check for #1337
(def superv (ev/chan 10))
(def f (ev/go |(ev/sleep 1e9) nil superv))
(ev/cancel f (gensym))
(ev/take superv)
(end-suite)

13
test/suite-os.janet
View File

@ -96,11 +96,23 @@
(assert (= (in buf 0) 0) "cryptorand doesn't overwrite buffer")
(assert (= (length buf) 2) "cryptorand appends to buffer"))
(assert-no-error "realtime clock" (os/clock))
(assert-no-error "realtime clock" (os/clock nil))
(assert-no-error "realtime clock" (os/clock nil nil))
# 80db68210
(assert-no-error "realtime clock" (os/clock :realtime))
(assert-no-error "cputime clock" (os/clock :cputime))
(assert-no-error "monotonic clock" (os/clock :monotonic))
(assert-no-error "realtime clock double output" (os/clock nil :double))
(assert-no-error "realtime clock int output" (os/clock nil :int))
(assert-no-error "realtime clock tuple output" (os/clock nil :tuple))
(assert-error "invalid clock" (os/clock :a))
(assert-error "invalid output" (os/clock :realtime :b))
(assert-error "invalid clock and output" (os/clock :a :b))
(def before (os/clock :monotonic))
(def after (os/clock :monotonic))
(assert (>= after before) "monotonic clock is monotonic")
@ -148,4 +160,3 @@
{:out dn :err dn})))
(end-suite)

96
test/suite-peg.janet
View File

@ -263,6 +263,9 @@
(marshpeg '(if-not "abcdf" 123))
(marshpeg ~(cmt "abcdf" ,identity))
(marshpeg '(group "abc"))
(marshpeg '(sub "abcdf" "abc"))
(marshpeg '(* (sub 1 1)))
(marshpeg '(split "," (+ "a" "b" "c")))
# Peg swallowing errors
# 159651117
@ -660,5 +663,98 @@
(peg/match '(if (not (* (constant 7) "a")) "hello") "hello")
@[]) "peg if not")
(defn test [name peg input expected]
(assert (deep= (peg/match peg input) expected) name))
(test "sub: matches the same input twice"
~(sub "abcd" "abc")
"abcdef"
@[])
(test "sub: second pattern cannot match more than the first pattern"
~(sub "abcd" "abcde")
"abcdef"
nil)
(test "sub: fails if first pattern fails"
~(sub "x" "abc")
"abcdef"
nil)
(test "sub: fails if second pattern fails"
~(sub "abc" "x")
"abcdef"
nil)
(test "sub: keeps captures from both patterns"
~(sub '"abcd" '"abc")
"abcdef"
@["abcd" "abc"])
(test "sub: second pattern can reference captures from first"
~(* (constant 5 :tag) (sub (capture "abc" :tag) (backref :tag)))
"abcdef"
@[5 "abc" "abc"])
(test "sub: second pattern can't see past what the first pattern matches"
~(sub "abc" (* "abc" -1))
"abcdef"
@[])
(test "sub: positions inside second match are still relative to the entire input"
~(* "one\ntw" (sub "o" (* ($) (line) (column))))
"one\ntwo\nthree\n"
@[6 2 3])
(test "sub: advances to the end of the first pattern's match"
~(* (sub "abc" "ab") "d")
"abcdef"
@[])
(test "split: basic functionality"
~(split "," '1)
"a,b,c"
@["a" "b" "c"])
(test "split: drops captures from separator pattern"
~(split '"," '1)
"a,b,c"
@["a" "b" "c"])
(test "split: can match empty subpatterns"
~(split "," ':w*)
",a,,bar,,,c,,"
@["" "a" "" "bar" "" "" "c" "" ""])
(test "split: subpattern is limited to only text before the separator"
~(split "," '(to -1))
"a,,bar,c"
@["a" "" "bar" "c"])
(test "split: fails if any subpattern fails"
~(split "," '"a")
"a,a,b"
nil)
(test "split: separator does not have to match anything"
~(split "x" '(to -1))
"a,a,b"
@["a,a,b"])
(test "split: always consumes entire input"
~(split 1 '"")
"abc"
@["" "" "" ""])
(test "split: separator can be an arbitrary PEG"
~(split :s+ '(to -1))
"a b c"
@["a" "b" "c"])
(test "split: does not advance past the end of the input"
~(* (split "," ':w+) 0)
"a,b,c"
@["a" "b" "c"])
(end-suite)

6
test/suite-specials.janet
View File

@ -198,5 +198,9 @@
(assert (= (test) '(1 ())) "issue #919")
(end-suite)
# Regression #1327
(def x "A")
(def x (if (= nil x) "B" x))
(assert (= x "A"))
(end-suite)