Prepare for 1.26.0 release

Add test files to meson suite 11 - 14

.builds/openbsd.yml

@@ -13,7 +13,7 @@ tasks:
     gmake test-install
 - meson_min: |
     cd janet
-    meson setup build_meson_min --buildtype=release -Dsingle_threaded=true -Dnanbox=false -Ddynamic_modules=false -Ddocstrings=false -Dnet=false -Dsourcemaps=false -Dpeg=false -Dassembler=false -Dint_types=false -Dtyped_array=false -Dreduced_os=true -Dffi=false
+    meson setup build_meson_min --buildtype=release -Dsingle_threaded=true -Dnanbox=false -Ddynamic_modules=false -Ddocstrings=false -Dnet=false -Dsourcemaps=false -Dpeg=false -Dassembler=false -Dint_types=false -Dreduced_os=true -Dffi=false
     cd build_meson_min
     ninja
 - meson_prf: |

.gitignore

@@ -68,10 +68,13 @@ tags
 vgcore.*
 *.out.*
 
-# Wix artifacts
+# WiX artifacts
 *.msi
 *.wixpdb
 
+# Makefile config
+/config.mk
+
 # Created by https://www.gitignore.io/api/c
 
 ### C ###

CHANGELOG.md

@@ -1,6 +1,50 @@
 # Changelog
 All notable changes to this project will be documented in this file.
 
+## 1.26.0 - 2023-01-07
+- Add `ffi/malloc` and `ffi/free`. Useful as tools of last resort.
+- Add `ffi/jitfn` to allow calling function pointers generated at runtime from machine code.
+  Bring your own assembler, though.
+- Channels can now be marshalled. Pending state is not saved, only items in the channel.
+- Use the new `.length` function pointer on abstract types for lengths. Adding
+  a `length` method will still work as well.
+- Support byte views on abstract types with the `.bytes` function pointer.
+- Add the `u` format specifier to printf family functions.
+- Allow printing 64 integer types in `printf` and `string/format` family functions.
+- Allow importing modules from custom directories more easily with the `@` prefix
+  to module paths. For example, if there is a dynamic binding :custom-modules that
+  is a file system path to a directory of modules, import from that directory with
+  `(import @custom-modules/mymod)`.
+- Fix error message bug in FFI library.
+
+## 1.25.1 - 2022-10-29
+- Add `memcmp` function to core library.
+- Fix bug in `os/open` with `:rw` permissions not correct on Linux.
+- Support config.mk for more easily configuring the Makefile.
+
+## 1.25.0 - 2022-10-10
+- Windows FFI fixes.
+- Fix PEG `if-not` combinator with captures in the condition
+- Fix bug with `os/date` with nil first argument
+- Fix bug with `net/accept` on Linux that could leak file descriptors to subprocesses
+- Reduce number of hash collisions from pointer hashing
+- Add optional parameter to `marshal` to skip cycle checking code
+
+## 1.24.1 - 2022-08-24
+- Fix FFI bug on Linux/Posix
+- Improve parse error messages for bad delimiters.
+- Add optional `name` parameter to the `short-fn` macro.
+
+## 1.24.0 - 2022-08-14
+- Add FFI support to 64-bit windows compiled with MSVC
+- Don't process shared object names passed to dlopen.
+- Add better support for windows console in the default shell.c for auto-completion and
+  other shell-like input features.
+- Improve default error message from `assert`.
+- Add the `tabseq` macro for simpler table comprehensions.
+- Allow setting `(dyn :task-id)` in fibers to improve context in supervisor messages. Prior to
+  this change, supervisor messages over threaded channels would be from ambiguous threads/fibers.
+
 ## 1.23.0 - 2022-06-20
 - Add experimental `ffi/` module for interfacing with dynamic libraries and raw function pointers. Only available
   on 64 bit linux, mac, and bsd systems.

LICENSE

@@ -1,4 +1,4 @@
-Copyright (c) 2021 Calvin Rose and contributors
+Copyright (c) 2023 Calvin Rose and contributors
 
 Permission is hereby granted, free of charge, to any person obtaining a copy of
 this software and associated documentation files (the "Software"), to deal in

Makefile

@@ -1,4 +1,4 @@
-# Copyright (c) 2021 Calvin Rose
+# Copyright (c) 2023 Calvin Rose
 #
 # Permission is hereby granted, free of charge, to any person obtaining a copy
 # of this software and associated documentation files (the "Software"), to
@@ -21,9 +21,10 @@
 ################################
 ##### Set global variables #####
 ################################
-
+sinclude config.mk
 PREFIX?=/usr/local
 
+JANETCONF_HEADER?=src/conf/janetconf.h
 INCLUDEDIR?=$(PREFIX)/include
 BINDIR?=$(PREFIX)/bin
 LIBDIR?=$(PREFIX)/lib
@@ -83,7 +84,7 @@ all: $(JANET_TARGET) $(JANET_LIBRARY) $(JANET_STATIC_LIBRARY) build/janet.h
 ##### Name Files #####
 ######################
 
-JANET_HEADERS=src/include/janet.h src/conf/janetconf.h
+JANET_HEADERS=src/include/janet.h $(JANETCONF_HEADER)
 
 JANET_LOCAL_HEADERS=src/core/features.h \
 					src/core/util.h \
@@ -168,24 +169,24 @@ build/c/janet.c: build/janet_boot src/boot/boot.janet
 ########################
 
 ifeq ($(UNAME), Darwin)
-SONAME=libjanet.1.23.dylib
+SONAME=libjanet.1.26.dylib
 else
-SONAME=libjanet.so.1.23
+SONAME=libjanet.so.1.26
 endif
 
 build/c/shell.c: src/mainclient/shell.c
 	cp $< $@
 
-build/janet.h: $(JANET_TARGET) src/include/janet.h src/conf/janetconf.h
-	./$(JANET_TARGET) tools/patch-header.janet src/include/janet.h src/conf/janetconf.h $@
+build/janet.h: $(JANET_TARGET) src/include/janet.h $(JANETCONF_HEADER)
+	./$(JANET_TARGET) tools/patch-header.janet src/include/janet.h $(JANETCONF_HEADER) $@
 
-build/janetconf.h: src/conf/janetconf.h
+build/janetconf.h: $(JANETCONF_HEADER)
 	cp $< $@
 
-build/janet.o: build/c/janet.c src/conf/janetconf.h src/include/janet.h
+build/janet.o: build/c/janet.c $(JANETCONF_HEADER) src/include/janet.h
 	$(HOSTCC) $(BUILD_CFLAGS) -c $< -o $@
 
-build/shell.o: build/c/shell.c src/conf/janetconf.h src/include/janet.h
+build/shell.o: build/c/shell.c $(JANETCONF_HEADER) src/include/janet.h
 	$(HOSTCC) $(BUILD_CFLAGS) -c $< -o $@
 
 $(JANET_TARGET): build/janet.o build/shell.o
@@ -283,7 +284,7 @@ install: $(JANET_TARGET) $(JANET_LIBRARY) $(JANET_STATIC_LIBRARY) build/janet.pc
 	cp $(JANET_TARGET) '$(DESTDIR)$(BINDIR)/janet'
 	mkdir -p '$(DESTDIR)$(INCLUDEDIR)/janet'
 	cp -r build/janet.h '$(DESTDIR)$(INCLUDEDIR)/janet'
-	ln -sf '$(DESTDIR)$(INCLUDEDIR)/janet/janet.h' '$(DESTDIR)$(INCLUDEDIR)/janet.h'
+	ln -sf -T ./janet/janet.h '$(DESTDIR)$(INCLUDEDIR)/janet.h' || true #fixme bsd
 	mkdir -p '$(DESTDIR)$(JANET_PATH)'
 	mkdir -p '$(DESTDIR)$(LIBDIR)'
 	if test $(UNAME) = Darwin ; then \
@@ -300,7 +301,7 @@ install: $(JANET_TARGET) $(JANET_LIBRARY) $(JANET_STATIC_LIBRARY) build/janet.pc
 	cp janet.1 '$(DESTDIR)$(JANET_MANPATH)'
 	mkdir -p '$(DESTDIR)$(JANET_PKG_CONFIG_PATH)'
 	cp build/janet.pc '$(DESTDIR)$(JANET_PKG_CONFIG_PATH)/janet.pc'
-	[ -z '$(DESTDIR)' ] && $(LDCONFIG) || true
+	[ -z '$(DESTDIR)' ] && $(LDCONFIG) || echo "You can ignore this error for non-Linux systems or local installs"
 
 install-jpm-git: $(JANET_TARGET)
 	mkdir -p build

examples/ffi/so.c

@@ -2,22 +2,68 @@
 #include <stdint.h>
 #include <string.h>
 
+#ifdef _WIN32
+#define EXPORTER __declspec(dllexport)
+#else
+#define EXPORTER
+#endif
+
+/* Structs */
+
+typedef struct {
+    int a, b;
+    float c, d;
+} Split;
+
+typedef struct {
+    float c, d;
+    int a, b;
+} SplitFlip;
+
+typedef struct {
+    int u, v, w, x, y, z;
+} SixInts;
+
+typedef struct {
+    int a;
+    int b;
+} intint;
+
+typedef struct {
+    int a;
+    int b;
+    int c;
+} intintint;
+
+typedef struct {
+    int64_t a;
+    int64_t b;
+    int64_t c;
+} big;
+
+/* Functions */
+
+EXPORTER
 int int_fn(int a, int b) {
     return (a << 2) + b;
 }
 
+EXPORTER
 double my_fn(int64_t a, int64_t b, const char *x) {
     return (double)(a + b) + 0.5 + strlen(x);
 }
 
+EXPORTER
 double double_fn(double x, double y, double z) {
     return (x + y) * z * 3;
 }
 
+EXPORTER
 double double_many(double x, double y, double z, double w, double a, double b) {
     return x + y + z + w + a + b;
 }
 
+EXPORTER
 double double_lots(
     double a,
     double b,
@@ -32,31 +78,49 @@ double double_lots(
     return i + j;
 }
 
+
+EXPORTER
+double double_lots_2(
+    double a,
+    double b,
+    double c,
+    double d,
+    double e,
+    double f,
+    double g,
+    double h,
+    double i,
+    double j) {
+    return a +
+           10.0 * b +
+           100.0 * c +
+           1000.0 * d +
+           10000.0 * e +
+           100000.0 * f +
+           1000000.0 * g +
+           10000000.0 * h +
+           100000000.0 * i +
+           1000000000.0 * j;
+}
+
+EXPORTER
 double float_fn(float x, float y, float z) {
     return (x + y) * z;
 }
 
-typedef struct {
-    int a;
-    int b;
-} intint;
-
-typedef struct {
-    int a;
-    int b;
-    int c;
-} intintint;
-
+EXPORTER
 int intint_fn(double x, intint ii) {
     printf("double: %g\n", x);
     return ii.a + ii.b;
 }
 
+EXPORTER
 int intintint_fn(double x, intintint iii) {
     printf("double: %g\n", x);
     return iii.a + iii.b + iii.c;
 }
 
+EXPORTER
 intint return_struct(int i) {
     intint ret;
     ret.a = i;
@@ -64,12 +128,7 @@ intint return_struct(int i) {
     return ret;
 }
 
-typedef struct {
-    int64_t a;
-    int64_t b;
-    int64_t c;
-} big;
-
+EXPORTER
 big struct_big(int i, double d) {
     big ret;
     ret.a = i;
@@ -78,10 +137,72 @@ big struct_big(int i, double d) {
     return ret;
 }
 
+EXPORTER
 void void_fn(void) {
     printf("void fn ran\n");
 }
 
+EXPORTER
+void void_fn_2(double y) {
+    printf("y = %f\n", y);
+}
+
+EXPORTER
 void void_ret_fn(int x) {
     printf("void fn ran: %d\n", x);
 }
+
+EXPORTER
+int intintint_fn_2(intintint iii, int i) {
+    fprintf(stderr, "iii.a = %d, iii.b = %d, iii.c = %d, i = %d\n", iii.a, iii.b, iii.c, i);
+    return i * (iii.a + iii.b + iii.c);
+}
+
+EXPORTER
+float split_fn(Split s) {
+    return s.a * s.c + s.b * s.d;
+}
+
+EXPORTER
+float split_flip_fn(SplitFlip s) {
+    return s.a * s.c + s.b * s.d;
+}
+
+EXPORTER
+Split split_ret_fn(int x, float y) {
+    Split ret;
+    ret.a = x;
+    ret.b = x;
+    ret.c = y;
+    ret.d = y;
+    return ret;
+}
+
+EXPORTER
+SplitFlip split_flip_ret_fn(int x, float y) {
+    SplitFlip ret;
+    ret.a = x;
+    ret.b = x;
+    ret.c = y;
+    ret.d = y;
+    return ret;
+}
+
+EXPORTER
+SixInts sixints_fn(void) {
+    return (SixInts) {
+        6666, 1111, 2222, 3333, 4444, 5555
+    };
+}
+
+EXPORTER
+int sixints_fn_2(int x, SixInts s) {
+    return x + s.u + s.v + s.w + s.x + s.y + s.z;
+}
+
+EXPORTER
+int sixints_fn_3(SixInts s, int x) {
+    return x + s.u + s.v + s.w + s.x + s.y + s.z;
+}
+
+

examples/ffi/test.janet

@@ -2,96 +2,59 @@
 # Simple FFI test script that tests against a simple shared object
 #
 
-(def ffi/loc "examples/ffi/so.so")
+(def is-windows (= :windows (os/which)))
+(def ffi/loc (string "examples/ffi/so." (if is-windows "dll" "so")))
 (def ffi/source-loc "examples/ffi/so.c")
 
-(os/execute ["cc" ffi/source-loc "-shared" "-o" ffi/loc] :px)
-(def module (ffi/native ffi/loc))
+(if is-windows
+  (os/execute ["cl.exe" "/nologo" "/LD" ffi/source-loc "/link" "/DLL" (string "/OUT:" ffi/loc)] :px)
+  (os/execute ["cc" ffi/source-loc "-shared" "-o" ffi/loc] :px))
 
-(def int-fn-sig (ffi/signature :default :int :int :int))
-(def int-fn-pointer (ffi/lookup module "int_fn"))
-(defn int-fn
-  [x y]
-  (ffi/call int-fn-pointer int-fn-sig x y))
-
-(def double-fn-sig (ffi/signature :default :double :double :double :double))
-(def double-fn-pointer (ffi/lookup module "double_fn"))
-(defn double-fn
-  [x y z]
-  (ffi/call double-fn-pointer double-fn-sig x y z))
-
-(def double-many-sig (ffi/signature :default :double :double :double :double :double :double :double))
-(def double-many-pointer (ffi/lookup module "double_many"))
-(defn double-many
-  [x y z w a b]
-  (ffi/call double-many-pointer double-many-sig x y z w a b))
-
-(def double-lots-sig (ffi/signature :default :double
-                                    :double :double :double :double :double
-                                    :double :double :double :double :double))
-(def double-lots-pointer (ffi/lookup module "double_lots"))
-(defn double-lots
-  [a b c d e f g h i j]
-  (ffi/call double-lots-pointer double-lots-sig a b c d e f g h i j))
-
-(def float-fn-sig (ffi/signature :default :double :float :float :float))
-(def float-fn-pointer (ffi/lookup module "float_fn"))
-(defn float-fn
-  [x y z]
-  (ffi/call float-fn-pointer float-fn-sig x y z))
-
-(def intint-fn-sig (ffi/signature :default :int :double [:int :int]))
-(def intint-fn-pointer (ffi/lookup module "intint_fn"))
-(defn intint-fn
-  [x ii]
-  (ffi/call intint-fn-pointer intint-fn-sig x ii))
-
-(def return-struct-sig (ffi/signature :default [:int :int] :int))
-(def return-struct-pointer (ffi/lookup module "return_struct"))
-(defn return-struct-fn
-  [i]
-  (ffi/call return-struct-pointer return-struct-sig i))
+(ffi/context ffi/loc)
 
 (def intintint (ffi/struct :int :int :int))
-(def intintint-fn-sig (ffi/signature :default :int :double intintint))
-(def intintint-fn-pointer (ffi/lookup module "intintint_fn"))
-(defn intintint-fn
-  [x iii]
-  (ffi/call intintint-fn-pointer intintint-fn-sig x iii))
-
 (def big (ffi/struct :s64 :s64 :s64))
-(def struct-big-fn-sig (ffi/signature :default big :int :double))
-(def struct-big-fn-pointer (ffi/lookup module "struct_big"))
-(defn struct-big-fn
-  [i d]
-  (ffi/call struct-big-fn-pointer struct-big-fn-sig i d))
+(def split (ffi/struct :int :int :float :float))
+(def split-flip (ffi/struct :float :float :int :int))
+(def six-ints (ffi/struct :int :int :int :int :int :int))
 
-(def void-fn-pointer (ffi/lookup module "void_fn"))
-(def void-fn-sig (ffi/signature :default :void))
-(defn void-fn
-  []
-  (ffi/call void-fn-pointer void-fn-sig))
-
-#
-# Call functions
-#
-
-(pp (void-fn))
-(pp (int-fn 10 20))
-(pp (double-fn 1.5 2.5 3.5))
-(pp (double-many 1 2 3 4 5 6))
-(pp (double-lots 1 2 3 4 5 6 7 8 9 10))
-(pp (float-fn 8 4 17))
-(pp (intint-fn 123.456 [10 20]))
-(pp (intintint-fn 123.456 [10 20 30]))
-(pp (return-struct-fn 42))
-(pp (struct-big-fn 11 99.5))
-
-(assert (= 60 (int-fn 10 20)))
-(assert (= 42 (double-fn 1.5 2.5 3.5)))
-(assert (= 21 (double-many 1 2 3 4 5 6)))
-(assert (= 19 (double-lots 1 2 3 4 5 6 7 8 9 10)))
-(assert (= 204 (float-fn 8 4 17)))
+(ffi/defbind int-fn :int [a :int b :int])
+(ffi/defbind double-fn :double [a :double b :double c :double])
+(ffi/defbind double-many :double
+  [x :double y :double z :double w :double a :double b :double])
+(ffi/defbind double-lots :double
+  [a :double b :double c :double d :double e :double f :double g :double h :double i :double j :double])
+(ffi/defbind float-fn :double
+  [x :float y :float z :float])
+(ffi/defbind intint-fn :int
+  [x :double ii [:int :int]])
+(ffi/defbind return-struct [:int :int]
+  [i :int])
+(ffi/defbind intintint-fn :int
+  [x :double iii intintint])
+(ffi/defbind struct-big big
+  [i :int d :double])
+(ffi/defbind void-fn :void [])
+(ffi/defbind double-lots-2 :double
+  [a :double
+   b :double
+   c :double
+   d :double
+   e :double
+   f :double
+   g :double
+   h :double
+   i :double
+   j :double])
+(ffi/defbind void-fn-2 :void [y :double])
+(ffi/defbind intintint-fn-2 :int [iii intintint i :int])
+(ffi/defbind split-fn :float [s split])
+(ffi/defbind split-flip-fn :float [s split-flip])
+(ffi/defbind split-ret-fn split [x :int y :float])
+(ffi/defbind split-flip-ret-fn split-flip [x :int y :float])
+(ffi/defbind sixints-fn six-ints [])
+(ffi/defbind sixints-fn-2 :int [x :int s six-ints])
+(ffi/defbind sixints-fn-3 :int [s six-ints x :int])
 
 #
 # Struct reading and writing
@@ -129,4 +92,43 @@
 (check-round-trip s [1 3 5 123.5])
 (check-round-trip s [-1 -3 -5 -123.5])
 
+#
+# Call functions
+#
+
+(tracev (sixints-fn))
+(tracev (sixints-fn-2 100 [1 2 3 4 5 6]))
+(tracev (sixints-fn-3 [1 2 3 4 5 6] 200))
+(tracev (split-ret-fn 10 12))
+(tracev (split-flip-ret-fn 10 12))
+(tracev (split-flip-ret-fn 12 10))
+(tracev (intintint-fn-2 [10 20 30] 3))
+(tracev (split-fn [5 6 1.2 3.4]))
+(tracev (void-fn-2 10.3))
+(tracev (double-many 1 2 3 4 5 6))
+(tracev (string/format "%.17g" (double-many 1 2 3 4 5 6)))
+(tracev (type (double-many 1 2 3 4 5 6)))
+(tracev (double-lots-2 0 1 2 3 4 5 6 7 8 9))
+(tracev (void-fn))
+(tracev (int-fn 10 20))
+(tracev (double-fn 1.5 2.5 3.5))
+(tracev (double-lots 1 2 3 4 5 6 7 8 9 10))
+(tracev (float-fn 8 4 17))
+(tracev (intint-fn 123.456 [10 20]))
+(tracev (intintint-fn 123.456 [10 20 30]))
+(tracev (return-struct 42))
+(tracev (double-lots 1 2 3 4 5 6 700 800 9 10))
+(tracev (struct-big 11 99.5))
+
+(assert (= [10 10 12 12] (split-ret-fn 10 12)))
+(assert (= [12 12 10 10] (split-flip-ret-fn 10 12)))
+(assert (= 183 (intintint-fn-2 [10 20 31] 3)))
+(assert (= 264 (math/round (* 10 (split-fn [5 6 1.2 3.4])))))
+(assert (= 9876543210 (double-lots-2 0 1 2 3 4 5 6 7 8 9)))
+(assert (= 60 (int-fn 10 20)))
+(assert (= 42 (double-fn 1.5 2.5 3.5)))
+(assert (= 21 (math/round (double-many 1 2 3 4 5 6.01))))
+(assert (= 19 (double-lots 1 2 3 4 5 6 7 8 9 10)))
+(assert (= 204 (float-fn 8 4 17)))
+
 (print "Done.")

examples/ffi/win32.janet

@@ -0,0 +1,7 @@
+(ffi/context "user32.dll")
+
+(ffi/defbind MessageBoxA :int
+  [w :ptr text :string cap :string typ :int])
+
+(MessageBoxA nil "Hello, World!" "Test" 0)
+

examples/jitfn/hello.nasm

@@ -0,0 +1,17 @@
+BITS 64
+
+;;;
+;;; Code
+;;;
+mov rax, 1          ; write(
+mov rdi, 1          ;   STDOUT_FILENO,
+lea rsi, [rel msg]  ;   msg,
+mov rdx, msglen     ;   sizeof(msg)
+syscall             ; );
+ret                 ; return;
+
+;;;
+;;; Constants
+;;;
+msg: db "Hello, world!", 10
+msglen: equ $ - msg

examples/jitfn/jitfn.janet

@@ -0,0 +1,13 @@
+###
+### Relies on NASM being installed to assemble code.
+### Only works on x86-64 Linux.
+###
+### Before running, compile hello.nasm to hello.bin with
+### $ nasm hello.nasm -o hello.bin
+
+(def bin (slurp "hello.bin"))
+(def f (ffi/jitfn bin))
+(def signature (ffi/signature :default :void))
+(ffi/call f signature)
+(print "called a jitted function with FFI!")
+(print "machine code: " (describe (string/slice f)))

examples/lineloop.janet

@@ -0,0 +1,2 @@
+(while (not (empty? (def line (getline))))
+  (prin "line: " line))

examples/marshal-stress.janet

@@ -0,0 +1,30 @@
+(defn init-db [c]
+  (def res @{:clients @{}})
+  (var i 0)
+  (repeat c
+    (def n (string "client" i))
+    (put-in res [:clients n] @{:name n :projects @{}})
+    (++ i)
+    (repeat c
+      (def pn (string "project" i))
+      (put-in res [:clients n :projects pn] @{:name pn})
+      (++ i)
+      (repeat c
+        (def tn (string "task" i))
+        (put-in res [:clients n :projects pn :tasks tn] @{:name pn})
+        (++ i))))
+  res)
+
+(loop [c :range [30 80 1]]
+  (var s (os/clock))
+  (print "Marshal DB with " c " clients, "
+         (* c c) " projects and "
+         (* c c c) " tasks. "
+         "Total " (+ (* c c c) (* c c) c) " tables")
+  (def buf (marshal (init-db c) @{} @""))
+  (print "Buffer is " (length buf) " bytes")
+  (print "Duration " (- (os/clock) s))
+  (set s (os/clock))
+  (gccollect)
+  (print "Collected garbage in " (- (os/clock) s)))
+

janet.1

@@ -164,10 +164,15 @@ Execute a string of Janet source. Source code is executed in the order it is enc
 arguments are executed before later ones.
 
 .TP
-.BR \-E\ code arguments
+.BR \-E\ code\ arguments...
 Execute a single Janet expression as a Janet short-fn, passing the remaining command line arguments to the expression. This allows
 more concise one-liners with command line arguments.
 
+Example: janet -E '(print $0)' 12 is equivalent to '((short-fn (print $0)) 12)', which is in turn equivalent to
+`((fn [k] (print k)) 12)`
+
+See docs for the `short-fn` function for more details.
+
 .TP
 .BR \-d
 Enable debug mode. On all terminating signals as well the debug signal, this will

meson.build

@@ -1,4 +1,4 @@
-# Copyright (c) 2021 Calvin Rose and contributors
+# Copyright (c) 2023 Calvin Rose and contributors
 #
 # Permission is hereby granted, free of charge, to any person obtaining a copy
 # of this software and associated documentation files (the "Software"), to
@@ -20,7 +20,7 @@
 
 project('janet', 'c',
   default_options : ['c_std=c99', 'build.c_std=c99', 'b_lundef=false', 'default_library=both'],
-  version : '1.23.0')
+  version : '1.26.0')
 
 # Global settings
 janet_path = join_paths(get_option('prefix'), get_option('libdir'), 'janet')
@@ -77,6 +77,7 @@ conf.set('JANET_EV_NO_EPOLL', not get_option('epoll'))
 conf.set('JANET_EV_NO_KQUEUE', not get_option('kqueue'))
 conf.set('JANET_NO_INTERPRETER_INTERRUPT', not get_option('interpreter_interrupt'))
 conf.set('JANET_NO_FFI', not get_option('ffi'))
+conf.set('JANET_NO_FFI_JIT', not get_option('ffi_jit'))
 if get_option('os_name') != ''
   conf.set('JANET_OS_NAME', get_option('os_name'))
 endif
@@ -236,7 +237,11 @@ test_files = [
   'test/suite0007.janet',
   'test/suite0008.janet',
   'test/suite0009.janet',
-  'test/suite0010.janet'
+  'test/suite0010.janet',
+  'test/suite0011.janet',
+  'test/suite0012.janet',
+  'test/suite0013.janet',
+  'test/suite0014.janet'
 ]
 foreach t : test_files
   test(t, janet_nativeclient, args : files([t]), workdir : meson.current_source_dir())

meson_options.txt

@@ -20,6 +20,7 @@ option('epoll', type : 'boolean', value : false)
 option('kqueue', type : 'boolean', value : false)
 option('interpreter_interrupt', type : 'boolean', value : false)
 option('ffi', type : 'boolean', value : true)
+option('ffi_jit', type : 'boolean', value : true)
 
 option('recursion_guard', type : 'integer', min : 10, max : 8000, value : 1024)
 option('max_proto_depth', type : 'integer', min : 10, max : 8000, value : 200)

src/boot/array_test.c

@@ -1,5 +1,5 @@
 /*
-* Copyright (c) 2022 Calvin Rose
+* Copyright (c) 2023 Calvin Rose
 *
 * Permission is hereby granted, free of charge, to any person obtaining a copy
 * of this software and associated documentation files (the "Software"), to

src/boot/boot.c

@@ -1,5 +1,5 @@
 /*
-* Copyright (c) 2022 Calvin Rose
+* Copyright (c) 2023 Calvin Rose
 *
 * Permission is hereby granted, free of charge, to any person obtaining a copy
 * of this software and associated documentation files (the "Software"), to

src/boot/boot.janet

@@ -1,5 +1,5 @@
 # The core janet library
-# Copyright 2022 © Calvin Rose
+# Copyright 2023 © Calvin Rose
 
 ###
 ###
@@ -76,6 +76,11 @@
   [name & more]
   ~(var ,name :private ,;more))
 
+(defmacro toggle
+  "Set a value to its boolean inverse. Same as `(set value (not value))`."
+  [value]
+  ~(set ,value (,not ,value)))
+
 (defn defglobal
   "Dynamically create a global def."
   [name value]
@@ -158,7 +163,7 @@
      (def ,v ,x)
      (if ,v
        ,v
-       (,error ,(if err err "assert failure")))))
+       (,error ,(if err err (string/format "assert failure in %j" x))))))
 
 (defn errorf
   "A combination of `error` and `string/format`. Equivalent to `(error (string/format fmt ;args))`."
@@ -606,13 +611,20 @@
   See `loop` for details.``
   [head & body]
   (def $accum (gensym))
-  ~(do (def ,$accum @[]) (loop ,head (array/push ,$accum (do ,;body))) ,$accum))
+  ~(do (def ,$accum @[]) (loop ,head (,array/push ,$accum (do ,;body))) ,$accum))
+
+(defmacro tabseq
+  ``Similar to `loop`, but accumulates key value pairs into a table.
+  See `loop` for details.``
+  [head key-body & value-body]
+  (def $accum (gensym))
+  ~(do (def ,$accum @{}) (loop ,head (,put ,$accum ,key-body (do ,;value-body))) ,$accum))
 
 (defmacro generate
   ``Create a generator expression using the `loop` syntax. Returns a fiber
   that yields all values inside the loop in order. See `loop` for details.``
   [head & body]
-  ~(fiber/new (fn [] (loop ,head (yield (do ,;body)))) :yi))
+  ~(,fiber/new (fn [] (loop ,head (yield (do ,;body)))) :yi))
 
 (defmacro coro
   "A wrapper for making fibers that may yield multiple values (coroutine). Same as `(fiber/new (fn [] ;body) :yi)`."
@@ -827,15 +839,15 @@
   a)
 
 (defn sort
-  ``Sort `ind` in-place, and return it. Uses quick-sort and is not a stable sort.
+  ``Sorts `ind` in-place, and returns it. Uses quick-sort and is not a stable sort.
   If a `before?` comparator function is provided, sorts elements using that,
   otherwise uses `<`.``
   [ind &opt before?]
   (sort-help ind 0 (- (length ind) 1) (or before? <)))
 
 (defn sort-by
-  ``Returns `ind` sorted by calling
-  a function `f` on each element and comparing the result with `<`.``
+  ``Sorts `ind` in-place by calling a function `f` on each element and
+  comparing the result with `<`.``
   [f ind]
   (sort ind (fn [x y] (< (f x) (f y)))))
 
@@ -1737,7 +1749,7 @@
   * tuple -- a tuple pattern will match if its first element matches, and the
     following elements are treated as predicates and are true.
 
-  * `\_` symbol -- the last special case is the `\_` symbol, which is a wildcard
+  * `_` symbol -- the last special case is the `_` symbol, which is a wildcard
     that will match any value without creating a binding.
 
   While a symbol pattern will ordinarily match any value, the pattern `(@ <sym>)`,
@@ -2053,8 +2065,9 @@
   ret)
 
 (defn all
-  ``Returns true if all `xs` are truthy, otherwise the result of first
-  falsey predicate value, `(pred x)`.``
+  ``Returns true if `(pred item)` returns a truthy value for every item in `xs`.
+  Otherwise, returns the first falsey `(pred item)` result encountered.
+  Returns true if `xs` is empty.``
   [pred xs]
   (var ret true)
   (loop [x :in xs :while ret] (set ret (pred x)))
@@ -2165,7 +2178,7 @@
       |(+ $ $) # use pipe reader macro for terse function literals.
       |(+ $&)  # variadic functions
   ```
-  [arg]
+  [arg &opt name]
   (var max-param-seen -1)
   (var vararg false)
   (defn saw-special-arg
@@ -2191,8 +2204,9 @@
           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 [,;fn-args ,;(if vararg ['& '$&] [])] ,expanded))
+  ~(fn ,;name-splice [,;fn-args ,;(if vararg ['& '$&] [])] ,expanded))
 
 ###
 ###
@@ -2521,7 +2535,7 @@
   (in env :exit-value env))
 
 (defn quit
-  ``Tries to exit from the current repl or context. Does not always exit the application.
+  ``Tries to exit from the current repl or run-context. Does not always exit the application.
   Works by setting the :exit dynamic binding to true. Passing a non-nil `value` here will cause the outer
   run-context to return that value.``
   [&opt value]
@@ -2529,36 +2543,11 @@
   (setdyn :exit-value value)
   nil)
 
-(defn eval-string
-  ``Evaluates a string in the current environment. If more control over the
-  environment is needed, use `run-context`.``
-  [str]
-  (var state (string str))
-  (defn chunks [buf _]
-    (def ret state)
-    (set state nil)
-    (when ret
-      (buffer/push-string buf str)
-      (buffer/push-string buf "\n")))
-  (var returnval nil)
-  (run-context {:chunks chunks
-                :on-compile-error (fn compile-error [msg errf &]
-                                    (error (string "compile error: " msg)))
-                :on-parse-error (fn parse-error [p x]
-                                  (error (string "parse error: " (:error p))))
-                :fiber-flags :i
-                :on-status (fn on-status [f val]
-                             (if-not (= (fiber/status f) :dead)
-                               (error val))
-                             (set returnval val))
-                :source :eval-string})
-  returnval)
-
 (defn eval
   ``Evaluates a form in the current environment. If more control over the
   environment is needed, use `run-context`.``
   [form]
-  (def res (compile form (fiber/getenv (fiber/current)) :eval))
+  (def res (compile form nil :eval))
   (if (= (type res) :function)
     (res)
     (error (get res :error))))
@@ -2569,6 +2558,8 @@
   [str]
   (let [p (parser/new)]
     (parser/consume p str)
+    (if (= :error (parser/status p))
+      (error (parser/error p)))
     (parser/eof p)
     (if (parser/has-more p)
       (parser/produce p)
@@ -2583,6 +2574,8 @@
   (let [p (parser/new)
         ret @[]]
     (parser/consume p str)
+    (if (= :error (parser/status p))
+      (error (parser/error p)))
     (parser/eof p)
     (while (parser/has-more p)
       (array/push ret (parser/produce p)))
@@ -2590,6 +2583,14 @@
       (error (parser/error p))
       ret)))
 
+(defn eval-string
+  ``Evaluates a string in the current environment. If more control over the
+  environment is needed, use `run-context`.``
+  [str]
+  (var ret nil)
+  (each x (parse-all str) (set ret (eval x)))
+  ret)
+
 (def load-image-dict
   ``A table used in combination with `unmarshal` to unmarshal byte sequences created
   by `make-image`, such that `(load-image bytes)` is the same as `(unmarshal bytes load-image-dict)`.``
@@ -2629,9 +2630,10 @@
   [image]
   (unmarshal image load-image-dict))
 
+(defn- check-dyn-relative [x] (if (string/has-prefix? "@" x) x))
 (defn- check-relative [x] (if (string/has-prefix? "." x) x))
 (defn- check-not-relative [x] (if-not (string/has-prefix? "." x) x))
-(defn- check-is-dep [x] (unless (or (string/has-prefix? "/" x) (string/has-prefix? "." x)) x))
+(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))
 
 (def module/cache
@@ -2665,6 +2667,8 @@
   (defn- find-prefix
     [pre]
     (or (find-index |(and (string? ($ 0)) (string/has-prefix? pre ($ 0))) module/paths) 0))
+  (def dyn-index (find-prefix ":@all:"))
+  (array/insert module/paths 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])
   (def sys-index (find-prefix ":sys:"))
@@ -2768,13 +2772,13 @@
     (def c ((:where p) 0))
     (def prpt (string "debug[" level "]:" c ":" status "> "))
     (getline prpt buf nextenv))
-  (print "entering debug[" level "] - (quit) to exit")
+  (eprint "entering debug[" level "] - (quit) to exit")
   (flush)
   (run-context
     {:chunks debugger-chunks
      :on-status (debugger-on-status-var nextenv (+ 1 level) true)
      :env nextenv})
-  (print "exiting debug[" level "]")
+  (eprint "exiting debug[" level "]")
   (flush)
   (nextenv :resume-value))
 
@@ -3013,7 +3017,7 @@
        :italics ["*" "*"]
        :bold ["**" "**"]}))
   (def modes @{})
-  (defn toggle [mode]
+  (defn toggle-mode [mode]
     (def active (get modes mode))
     (def delims (get delimiters mode))
     (put modes mode (not active))
@@ -3123,7 +3127,7 @@
     (def token @"")
     (var token-length 0)
     (defn delim [mode]
-      (def d (toggle mode))
+      (def d (toggle-mode mode))
       (if-not has-color (+= token-length (length d)))
       (buffer/push token d))
     (defn endtoken []
@@ -3134,16 +3138,18 @@
       (def b (get line i))
       (cond
         (or (= b (chr "\n")) (= b (chr " "))) (endtoken)
-        (= b (chr `\`)) (do
-                          (++ token-length)
-                          (buffer/push token (get line (++ i))))
-        (= b (chr "_")) (delim :underline)
         (= b (chr "`")) (delim :code)
-        (= b (chr "*"))
-        (if (= (chr "*") (get line (+ i 1)))
-          (do (++ i)
-            (delim :bold))
-          (delim :italics))
+        (not (modes :code)) (cond
+          (= b (chr `\`)) (do
+                            (++ token-length)
+                            (buffer/push token (get line (++ i))))
+          (= b (chr "_")) (delim :underline)
+          (= b (chr "*"))
+            (if (= (chr "*") (get line (+ i 1)))
+              (do (++ i)
+                (delim :bold))
+              (delim :italics))
+          (do (++ token-length) (buffer/push token b)))
         (do (++ token-length) (buffer/push token b))))
     (endtoken)
     (tuple/slice tokens))
@@ -3553,7 +3559,7 @@
     (ev/go (fn _call [&] (f ;args))))
 
   (defmacro ev/spawn
-    "Run some code in a new fiber. This is shorthand for `(ev/call (fn [] ;body))`."
+    "Run some code in a new fiber. This is shorthand for `(ev/go (fn [] ;body))`."
     [& body]
     ~(,ev/go (fn _spawn [&] ,;body)))
 
@@ -3657,6 +3663,7 @@
   (defmacro ffi/defbind
     "Generate bindings for native functions in a convenient manner."
     [name ret-type & body]
+    (def real-ret-type (eval ret-type))
     (def meta (slice body 0 -2))
     (def arg-pairs (partition 2 (last body)))
     (def formal-args (map 0 arg-pairs))
@@ -3668,9 +3675,9 @@
           :map-symbols ms} (assert (dyn *ffi-context*) "no ffi context found"))
     (def raw-symbol (ms name))
     (defn make-sig []
-      (ffi/signature :default ret-type ;computed-type-args))
+      (ffi/signature :default real-ret-type ;computed-type-args))
     (defn make-ptr []
-      (assert (ffi/lookup (if lazy (llib) lib) raw-symbol) "failed to find symbol"))
+      (assert (ffi/lookup (if lazy (llib) lib) raw-symbol) (string "failed to find ffi symbol " raw-symbol)))
     (if lazy
         ~(defn ,name ,;meta [,;formal-args]
            (,ffi/call (,(delay (make-ptr))) (,(delay (make-sig))) ,;formal-args))
@@ -3871,7 +3878,7 @@
      "E" (fn E-switch [i &]
            (set no-file false)
            (def subargs (array/slice args (+ i 2)))
-           (def src ~|,(parse (in args (+ i 1))))
+           (def src ~(short-fn ,(parse (in args (+ i 1))) E-expression))
            (def thunk (compile src))
            (if (function? thunk)
              ((thunk) ;subargs)

src/boot/buffer_test.c

@@ -1,5 +1,5 @@
 /*
-* Copyright (c) 2022 Calvin Rose
+* Copyright (c) 2023 Calvin Rose
 *
 * Permission is hereby granted, free of charge, to any person obtaining a copy
 * of this software and associated documentation files (the "Software"), to

src/boot/number_test.c

@@ -1,5 +1,5 @@
 /*
-* Copyright (c) 2022 Calvin Rose
+* Copyright (c) 2023 Calvin Rose
 *
 * Permission is hereby granted, free of charge, to any person obtaining a copy
 * of this software and associated documentation files (the "Software"), to

src/boot/system_test.c

@@ -1,5 +1,5 @@
 /*
-* Copyright (c) 2022 Calvin Rose
+* Copyright (c) 2023 Calvin Rose
 *
 * Permission is hereby granted, free of charge, to any person obtaining a copy
 * of this software and associated documentation files (the "Software"), to

src/boot/table_test.c

@@ -1,5 +1,5 @@
 /*
-* Copyright (c) 2022 Calvin Rose
+* Copyright (c) 2023 Calvin Rose
 *
 * Permission is hereby granted, free of charge, to any person obtaining a copy
 * of this software and associated documentation files (the "Software"), to

src/conf/janetconf.h

@@ -4,10 +4,10 @@
 #define JANETCONF_H
 
 #define JANET_VERSION_MAJOR 1
-#define JANET_VERSION_MINOR 23
+#define JANET_VERSION_MINOR 26
 #define JANET_VERSION_PATCH 0
 #define JANET_VERSION_EXTRA ""
-#define JANET_VERSION "1.23.0"
+#define JANET_VERSION "1.26.0"
 
 /* #define JANET_BUILD "local" */
 
@@ -33,6 +33,8 @@
 /* #define JANET_NO_SYMLINKS */
 /* #define JANET_NO_UMASK */
 /* #define JANET_NO_THREADS */
+/* #define JANET_NO_FFI */
+/* #define JANET_NO_FFI_JIT */
 
 /* Other settings */
 /* #define JANET_DEBUG */

src/core/abstract.c

@@ -1,5 +1,5 @@
 /*
-* Copyright (c) 2022 Calvin Rose
+* Copyright (c) 2023 Calvin Rose
 *
 * Permission is hereby granted, free of charge, to any person obtaining a copy
 * of this software and associated documentation files (the "Software"), to
@@ -31,6 +31,8 @@
 #ifdef JANET_EV
 #ifdef JANET_WINDOWS
 #include <windows.h>
+#else
+#include <stdatomic.h>
 #endif
 #endif
 

src/core/array.c

@@ -1,5 +1,5 @@
 /*
-* Copyright (c) 2022 Calvin Rose
+* Copyright (c) 2023 Calvin Rose
 *
 * Permission is hereby granted, free of charge, to any person obtaining a copy
 * of this software and associated documentation files (the "Software"), to

src/core/asm.c

@@ -1,5 +1,5 @@
 /*
-* Copyright (c) 2022 Calvin Rose
+* Copyright (c) 2023 Calvin Rose
 *
 * Permission is hereby granted, free of charge, to any person obtaining a copy
 * of this software and associated documentation files (the "Software"), to

src/core/buffer.c

@@ -1,5 +1,5 @@
 /*
-* Copyright (c) 2022 Calvin Rose
+* Copyright (c) 2023 Calvin Rose
 *
 * Permission is hereby granted, free of charge, to any person obtaining a copy
 * of this software and associated documentation files (the "Software"), to

src/core/bytecode.c

@@ -1,5 +1,5 @@
 /*
-* Copyright (c) 2022 Calvin Rose
+* Copyright (c) 2023 Calvin Rose
 *
 * Permission is hereby granted, free of charge, to any person obtaining a copy
 * of this software and associated documentation files (the "Software"), to

src/core/capi.c

@@ -1,5 +1,5 @@
 /*
-* Copyright (c) 2022 Calvin Rose
+* Copyright (c) 2023 Calvin Rose
 *
 * Permission is hereby granted, free of charge, to any person obtaining a copy
 * of this software and associated documentation files (the "Software"), to
@@ -260,7 +260,7 @@ int32_t janet_getinteger(const Janet *argv, int32_t n) {
 }
 
 int64_t janet_getinteger64(const Janet *argv, int32_t n) {
-#ifdef JANET_INTTYPES
+#ifdef JANET_INT_TYPES
     return janet_unwrap_s64(argv[n]);
 #else
     Janet x = argv[n];
@@ -272,7 +272,7 @@ int64_t janet_getinteger64(const Janet *argv, int32_t n) {
 }
 
 uint64_t janet_getuinteger64(const Janet *argv, int32_t n) {
-#ifdef JANET_INTTYPES
+#ifdef JANET_INT_TYPES
     return janet_unwrap_u64(argv[n]);
 #else
     Janet x = argv[n];

src/core/cfuns.c

@@ -1,5 +1,5 @@
 /*
-* Copyright (c) 2022 Calvin Rose
+* Copyright (c) 2023 Calvin Rose
 *
 * Permission is hereby granted, free of charge, to any person obtaining a copy
 * of this software and associated documentation files (the "Software"), to

src/core/compile.c

@@ -1,5 +1,5 @@
 /*
-* Copyright (c) 2022 Calvin Rose
+* Copyright (c) 2023 Calvin Rose
 *
 * Permission is hereby granted, free of charge, to any person obtaining a copy
 * of this software and associated documentation files (the "Software"), to
@@ -996,7 +996,7 @@ JanetCompileResult janet_compile(Janet source, JanetTable *env, const uint8_t *w
 }
 
 /* C Function for compiling */
-JANET_CORE_FN(cfun,
+JANET_CORE_FN(cfun_compile,
               "(compile ast &opt env source lints)",
               "Compiles an Abstract Syntax Tree (ast) into a function. "
               "Pair the compile function with parsing functionality to implement "
@@ -1005,7 +1005,8 @@ JANET_CORE_FN(cfun,
               "If a `lints` array is given, linting messages will be appended to the array. "
               "Each message will be a tuple of the form `(level line col message)`.") {
     janet_arity(argc, 1, 4);
-    JanetTable *env = argc > 1 ? janet_gettable(argv, 1) : janet_vm.fiber->env;
+    JanetTable *env = (argc > 1 && !janet_checktype(argv[1], JANET_NIL))
+                      ? janet_gettable(argv, 1) : janet_vm.fiber->env;
     if (NULL == env) {
         env = janet_table(0);
         janet_vm.fiber->env = env;
@@ -1017,11 +1018,12 @@ JANET_CORE_FN(cfun,
             source = janet_unwrap_string(x);
         } else if (janet_checktype(x, JANET_KEYWORD)) {
             source = janet_unwrap_keyword(x);
-        } else {
+        } else if (!janet_checktype(x, JANET_NIL)) {
             janet_panic_type(x, 2, JANET_TFLAG_STRING | JANET_TFLAG_KEYWORD);
         }
     }
-    JanetArray *lints = (argc >= 4) ? janet_getarray(argv, 3) : NULL;
+    JanetArray *lints = (argc >= 4 && !janet_checktype(argv[3], JANET_NIL))
+                        ? janet_getarray(argv, 3) : NULL;
     JanetCompileResult res = janet_compile_lint(argv[0], env, source, lints);
     if (res.status == JANET_COMPILE_OK) {
         return janet_wrap_function(janet_thunk(res.funcdef));
@@ -1043,7 +1045,7 @@ JANET_CORE_FN(cfun,
 
 void janet_lib_compile(JanetTable *env) {
     JanetRegExt cfuns[] = {
-        JANET_CORE_REG("compile", cfun),
+        JANET_CORE_REG("compile", cfun_compile),
         JANET_REG_END
     };
     janet_core_cfuns_ext(env, NULL, cfuns);

src/core/compile.h

@@ -1,5 +1,5 @@
 /*
-* Copyright (c) 2022 Calvin Rose
+* Copyright (c) 2023 Calvin Rose
 *
 * Permission is hereby granted, free of charge, to any person obtaining a copy
 * of this software and associated documentation files (the "Software"), to

src/core/corelib.c

@@ -1,5 +1,5 @@
 /*
-* Copyright (c) 2022 Calvin Rose
+* Copyright (c) 2023 Calvin Rose
 *
 * Permission is hereby granted, free of charge, to any person obtaining a copy
 * of this software and associated documentation files (the "Software"), to
@@ -111,7 +111,10 @@ JANET_CORE_FN(janet_core_expand_path,
               "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"
-              "* :all: -- the value of path verbatim\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"
               "* :name: -- the name component of path, with extension if given\n\n"
@@ -157,6 +160,21 @@ JANET_CORE_FN(janet_core_expand_path,
             if (strncmp(template + i, ":all:", 5) == 0) {
                 janet_buffer_push_cstring(out, input);
                 i += 4;
+            } else if (strncmp(template + i, ":@all:", 6) == 0) {
+                if (input[0] == '@') {
+                    const char *p = input;
+                    while (*p && !is_path_sep(*p)) p++;
+                    size_t len = p - input - 1;
+                    char *str = janet_smalloc(len + 1);
+                    memcpy(str, input + 1, len);
+                    str[len] = '\0';
+                    janet_formatb(out, "%V", janet_dyn(str));
+                    janet_sfree(str);
+                    janet_buffer_push_cstring(out, p);
+                } else {
+                    janet_buffer_push_cstring(out, input);
+                }
+                i += 5;
             } else if (strncmp(template + i, ":cur:", 5) == 0) {
                 janet_buffer_push_bytes(out, (const uint8_t *)curdir, curlen);
                 i += 4;
@@ -614,27 +632,39 @@ JANET_CORE_FN(janet_core_signal,
               "(signal what x)",
               "Raise a signal with payload x. ") {
     janet_arity(argc, 1, 2);
-    int sig;
+    Janet payload = argc == 2 ? argv[1] : janet_wrap_nil();
     if (janet_checkint(argv[0])) {
         int32_t s = janet_unwrap_integer(argv[0]);
         if (s < 0 || s > 9) {
             janet_panicf("expected user signal between 0 and 9, got %d", s);
         }
-        sig = JANET_SIGNAL_USER0 + s;
+        janet_signalv(JANET_SIGNAL_USER0 + s, payload);
     } else {
         JanetKeyword kw = janet_getkeyword(argv, 0);
-        if (!janet_cstrcmp(kw, "yield")) {
-            sig = JANET_SIGNAL_YIELD;
-        } else if (!janet_cstrcmp(kw, "error")) {
-            sig = JANET_SIGNAL_ERROR;
-        } else if (!janet_cstrcmp(kw, "debug")) {
-            sig = JANET_SIGNAL_DEBUG;
-        } else {
-            janet_panicf("unknown signal, expected :yield, :error, or :debug, got %v", argv[0]);
+        for (unsigned i = 0; i < sizeof(janet_signal_names) / sizeof(char *); i++) {
+            if (!janet_cstrcmp(kw, janet_signal_names[i])) {
+                janet_signalv((JanetSignal) i, payload);
+            }
         }
     }
-    Janet payload = argc == 2 ? argv[1] : janet_wrap_nil();
-    janet_signalv(sig, payload);
+    janet_panicf("unknown signal %v", argv[0]);
+}
+
+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 "
+              "return 0 if they have identical contents, a negative integer if a is less than b, "
+              "and a positive integer if a is greather than b. Optionally take a length and offsets "
+              "to compare slices of the bytes sequences.") {
+    janet_arity(argc, 2, 5);
+    JanetByteView a = janet_getbytes(argv, 0);
+    JanetByteView b = janet_getbytes(argv, 1);
+    int32_t len = janet_optnat(argv, argc, 2, a.len < b.len ? a.len : b.len);
+    int32_t offset_a = janet_optnat(argv, argc, 3, 0);
+    int32_t offset_b = janet_optnat(argv, argc, 4, 0);
+    if (offset_a + len > a.len) janet_panicf("invalid offset-a: %d", offset_a);
+    if (offset_b + len > b.len) janet_panicf("invalid offset-b: %d", offset_b);
+    return janet_wrap_integer(memcmp(a.bytes + offset_a, b.bytes + offset_b, (size_t) len));
 }
 
 #ifdef JANET_BOOTSTRAP
@@ -938,6 +968,7 @@ static void janet_load_libs(JanetTable *env) {
         JANET_CORE_REG("nat?", janet_core_check_nat),
         JANET_CORE_REG("slice", janet_core_slice),
         JANET_CORE_REG("signal", janet_core_signal),
+        JANET_CORE_REG("memcmp", janet_core_memcmp),
         JANET_CORE_REG("getproto", janet_core_getproto),
         JANET_REG_END
     };

src/core/debug.c

@@ -1,5 +1,5 @@
 /*
-* Copyright (c) 2022 Calvin Rose
+* Copyright (c) 2023 Calvin Rose
 *
 * Permission is hereby granted, free of charge, to any person obtaining a copy
 * of this software and associated documentation files (the "Software"), to

src/core/emit.c

@@ -1,5 +1,5 @@
 /*
-* Copyright (c) 2022 Calvin Rose
+* Copyright (c) 2023 Calvin Rose
 *
 * Permission is hereby granted, free of charge, to any person obtaining a copy
 * of this software and associated documentation files (the "Software"), to

src/core/emit.h

@@ -1,5 +1,5 @@
 /*
-* Copyright (c) 2022 Calvin Rose
+* Copyright (c) 2023 Calvin Rose
 *
 * Permission is hereby granted, free of charge, to any person obtaining a copy
 * of this software and associated documentation files (the "Software"), to

src/core/ev.c

@@ -1,5 +1,5 @@
 /*
-* Copyright (c) 2022 Calvin Rose
+* Copyright (c) 2023 Calvin Rose
 *
 * Permission is hereby granted, free of charge, to any person obtaining a copy
 * of this software and associated documentation files (the "Software"), to
@@ -535,10 +535,15 @@ static int janet_channel_push(JanetChannel *channel, Janet x, int mode);
 static int janet_channel_pop(JanetChannel *channel, Janet *item, int is_choice);
 
 static Janet make_supervisor_event(const char *name, JanetFiber *fiber, int threaded) {
-    Janet tup[2];
+    Janet tup[3];
     tup[0] = janet_ckeywordv(name);
     tup[1] = threaded ? fiber->last_value : janet_wrap_fiber(fiber) ;
-    return janet_wrap_tuple(janet_tuple_n(tup, 2));
+    if (fiber->env != NULL) {
+        tup[2] = janet_table_get(fiber->env, janet_ckeywordv("task-id"));
+    } else {
+        tup[2] = janet_wrap_nil();
+    }
+    return janet_wrap_tuple(janet_tuple_n(tup, 3));
 }
 
 /* Common init code */
@@ -552,6 +557,10 @@ void janet_ev_init_common(void) {
     janet_vm.tq_capacity = 0;
     janet_table_init_raw(&janet_vm.threaded_abstracts, 0);
     janet_rng_seed(&janet_vm.ev_rng, 0);
+#ifndef JANET_WINDOWS
+    pthread_attr_init(&janet_vm.new_thread_attr);
+    pthread_attr_setdetachstate(&janet_vm.new_thread_attr, PTHREAD_CREATE_DETACHED);
+#endif
 }
 
 /* Common deinit code */
@@ -561,6 +570,9 @@ void janet_ev_deinit_common(void) {
     janet_free(janet_vm.listeners);
     janet_vm.listeners = NULL;
     janet_table_deinit(&janet_vm.threaded_abstracts);
+#ifndef JANET_WINDOWS
+    pthread_attr_destroy(&janet_vm.new_thread_attr);
+#endif
 }
 
 /* Short hand to yield to event loop */
@@ -1170,14 +1182,48 @@ static Janet janet_chanat_next(void *p, Janet key) {
     return janet_nextmethod(ev_chanat_methods, key);
 }
 
+static void janet_chanat_marshal(void *p, JanetMarshalContext *ctx) {
+    JanetChannel *channel = (JanetChannel *)p;
+    janet_marshal_byte(ctx, channel->closed);
+    janet_marshal_int(ctx, channel->limit);
+    int32_t count = janet_q_count(&channel->items);
+    janet_marshal_int(ctx, count);
+    JanetQueue *items = &channel->items;
+    Janet *data = channel->items.data;
+    if (items->head <= items->tail) {
+        for (int32_t i = items->head; i < items->tail; i++)
+            janet_marshal_janet(ctx, data[i]);
+    } else {
+        for (int32_t i = items->head; i < items->capacity; i++)
+            janet_marshal_janet(ctx, data[i]);
+        for (int32_t i = 0; i < items->tail; i++)
+            janet_marshal_janet(ctx, data[i]);
+    }
+}
+
+static void *janet_chanat_unmarshal(JanetMarshalContext *ctx) {
+    JanetChannel *abst = janet_unmarshal_abstract(ctx, sizeof(JanetChannel));
+    uint8_t is_closed = janet_unmarshal_byte(ctx);
+    int32_t limit = janet_unmarshal_int(ctx);
+    int32_t count = janet_unmarshal_int(ctx);
+    if (count < 0) janet_panic("invalid negative channel count");
+    janet_chan_init(abst, limit, 0);
+    abst->closed = !!is_closed;
+    for (int32_t i = 0; i < count; i++) {
+        Janet item = janet_unmarshal_janet(ctx);
+        janet_q_push(&abst->items, &item, sizeof(item));
+    }
+    return abst;
+}
+
 const JanetAbstractType janet_channel_type = {
     "core/channel",
     janet_chanat_gc,
     janet_chanat_mark,
     janet_chanat_get,
     NULL, /* put */
-    NULL, /* marshal */
-    NULL, /* unmarshal */
+    janet_chanat_marshal,
+    janet_chanat_unmarshal,
     NULL, /* tostring */
     NULL, /* compare */
     NULL, /* hash */
@@ -2033,12 +2079,11 @@ void janet_ev_threaded_call(JanetThreadedSubroutine fp, JanetEVGenericMessage ar
 #else
     init->write_pipe = janet_vm.selfpipe[1];
     pthread_t waiter_thread;
-    int err = pthread_create(&waiter_thread, NULL, janet_thread_body, init);
+    int err = pthread_create(&waiter_thread, &janet_vm.new_thread_attr, janet_thread_body, init);
     if (err) {
         janet_free(init);
         janet_panicf("%s", strerror(err));
     }
-    pthread_detach(waiter_thread);
 #endif
 
     /* Increment ev refcount so we don't quit while waiting for a subprocess */
@@ -2682,9 +2727,10 @@ error:
 /* C functions */
 
 JANET_CORE_FN(cfun_ev_go,
-              "(ev/go fiber &opt value supervisor)",
-              "Put a fiber on the event loop to be resumed later. Optionally pass "
-              "a value to resume with, otherwise resumes with nil. Returns the fiber. "
+              "(ev/go fiber-or-fun &opt value supervisor)",
+              "Put a fiber on the event loop to be resumed later. If a function is used, it is wrapped"
+              "with `fiber/new` first. "
+              "Optionally pass a value to resume with, otherwise resumes with nil. Returns the fiber. "
               "An optional `core/channel` can be provided as a supervisor. When various "
               "events occur in the newly scheduled fiber, an event will be pushed to the supervisor. "
               "If not provided, the new fiber will inherit the current supervisor.") {
@@ -2719,6 +2765,8 @@ JANET_CORE_FN(cfun_ev_go,
     return janet_wrap_fiber(fiber);
 }
 
+#define JANET_THREAD_SUPERVISOR_FLAG 0x100
+
 /* For ev/thread - Run an interpreter in the new thread. */
 static JanetEVGenericMessage janet_go_thread_subr(JanetEVGenericMessage args) {
     JanetBuffer *buffer = (JanetBuffer *) args.argp;
@@ -2741,7 +2789,7 @@ static JanetEVGenericMessage janet_go_thread_subr(JanetEVGenericMessage args) {
         }
 
         /* Get supervsior */
-        if (flags & 0x8) {
+        if (flags & JANET_THREAD_SUPERVISOR_FLAG) {
             Janet sup =
                 janet_unmarshal(nextbytes, endbytes - nextbytes,
                                 JANET_MARSHAL_UNSAFE, NULL, &nextbytes);
@@ -2793,6 +2841,10 @@ static JanetEVGenericMessage janet_go_thread_subr(JanetEVGenericMessage args) {
         } else {
             fiber = janet_unwrap_fiber(fiberv);
         }
+        if (flags & 0x8) {
+            if (NULL == fiber->env) fiber->env = janet_table(0);
+            janet_table_put(fiber->env, janet_ckeywordv("task-id"), value);
+        }
         fiber->supervisor_channel = janet_vm.user;
         janet_schedule(fiber, value);
         janet_loop();
@@ -2837,6 +2889,7 @@ JANET_CORE_FN(cfun_ev_thread,
               "If you want to run the thread without waiting for a result, pass the `:n` flag to return nil immediately. "
               "Otherwise, returns nil. Available flags:\n\n"
               "* `:n` - return immediately\n"
+              "* `:t` - set the task-id of the new thread to value. The task-id is passed in messages to the supervisor channel.\n"
               "* `:a` - don't copy abstract registry to new thread (performance optimization)\n"
               "* `:c` - don't copy cfunction registry to new thread (performance optimization)") {
     janet_arity(argc, 1, 4);
@@ -2844,10 +2897,10 @@ JANET_CORE_FN(cfun_ev_thread,
     if (!janet_checktype(argv[0], JANET_FUNCTION)) janet_getfiber(argv, 0);
     uint64_t flags = 0;
     if (argc >= 3) {
-        flags = janet_getflags(argv, 2, "nac");
+        flags = janet_getflags(argv, 2, "nact");
     }
     void *supervisor = janet_optabstract(argv, argc, 3, &janet_channel_type, janet_vm.root_fiber->supervisor_channel);
-    if (NULL != supervisor) flags |= 0x8;
+    if (NULL != supervisor) flags |= JANET_THREAD_SUPERVISOR_FLAG;
 
     /* Marshal arguments for the new thread. */
     JanetBuffer *buffer = janet_malloc(sizeof(JanetBuffer));
@@ -2858,7 +2911,7 @@ JANET_CORE_FN(cfun_ev_thread,
     if (!(flags & 0x2)) {
         janet_marshal(buffer, janet_wrap_table(janet_vm.abstract_registry), NULL, JANET_MARSHAL_UNSAFE);
     }
-    if (flags & 0x8) {
+    if (flags & JANET_THREAD_SUPERVISOR_FLAG) {
         janet_marshal(buffer, janet_wrap_abstract(supervisor), NULL, JANET_MARSHAL_UNSAFE);
     }
     if (!(flags & 0x4)) {

src/core/features.h

@@ -1,5 +1,5 @@
 /*
-* Copyright (c) 2022 Calvin Rose
+* Copyright (c) 2023 Calvin Rose
 *
 * Permission is hereby granted, free of charge, to any person obtaining a copy
 * of this software and associated documentation files (the "Software"), to

src/core/ffi.c

@@ -1,5 +1,5 @@
 /*
-* Copyright (c) 2022 Calvin Rose
+* Copyright (c) 2023 Calvin Rose
 *
 * Permission is hereby granted, free of charge, to any person obtaining a copy
 * of this software and associated documentation files (the "Software"), to
@@ -37,6 +37,13 @@
 #define alloca __builtin_alloca
 #endif
 
+/* FFI jit includes */
+#ifdef JANET_FFI_JIT
+#ifndef JANET_WINDOWS
+#include <sys/mman.h>
+#endif
+#endif
+
 #define JANET_FFI_MAX_RECUR 64
 
 /* Compiler, OS, and arch detection. Used
@@ -123,9 +130,10 @@ typedef enum {
     JANET_SYSV64_INTEGER,
     JANET_SYSV64_SSE,
     JANET_SYSV64_SSEUP,
-    JANET_SYSV64_X87,
-    JANET_SYSV64_X87UP,
-    JANET_SYSV64_COMPLEX_X87,
+    JANET_SYSV64_PAIR_INTINT,
+    JANET_SYSV64_PAIR_INTSSE,
+    JANET_SYSV64_PAIR_SSEINT,
+    JANET_SYSV64_PAIR_SSESSE,
     JANET_SYSV64_NO_CLASS,
     JANET_SYSV64_MEMORY,
     JANET_WIN64_REGISTER,
@@ -201,6 +209,11 @@ int struct_mark(void *p, size_t s) {
     return 0;
 }
 
+typedef struct {
+    void *function_pointer;
+    size_t size;
+} JanetFFIJittedFn;
+
 static const JanetAbstractType janet_struct_type = {
     "core/ffi-struct",
     NULL,
@@ -208,6 +221,42 @@ static const JanetAbstractType janet_struct_type = {
     JANET_ATEND_GCMARK
 };
 
+static int janet_ffijit_gc(void *p, size_t s) {
+    (void) s;
+    JanetFFIJittedFn *fn = p;
+    if (fn->function_pointer == NULL) return 0;
+#ifdef JANET_FFI_JIT
+#ifdef JANET_WINDOWS
+    VirtualFree(fn->function_pointer, fn->size, MEM_RELEASE);
+#else
+    munmap(fn->function_pointer, fn->size);
+#endif
+#endif
+    return 0;
+}
+
+static JanetByteView janet_ffijit_getbytes(void *p, size_t s) {
+    (void) s;
+    JanetFFIJittedFn *fn = p;
+    JanetByteView bytes;
+    bytes.bytes = fn->function_pointer;
+    bytes.len = (int32_t) fn->size;
+    return bytes;
+}
+
+static size_t janet_ffijit_length(void *p, size_t s) {
+    (void) s;
+    JanetFFIJittedFn *fn = p;
+    return fn->size;
+}
+
+const JanetAbstractType janet_type_ffijit = {
+    .name = "ffi/jitfn",
+    .gc = janet_ffijit_gc,
+    .bytes = janet_ffijit_getbytes,
+    .length = janet_ffijit_length
+};
+
 typedef struct {
     Clib clib;
     int closed;
@@ -355,11 +404,11 @@ static JanetFFIStruct *build_struct_type(int32_t argc, const Janet *argv) {
         if (all_packed || pack_one) {
             if (st->size % el_align != 0) is_aligned = 0;
             st->fields[i].offset = st->size;
-            st->size += el_size;
+            st->size += (uint32_t) el_size;
         } else {
-            if (el_align > st->align) st->align = el_align;
-            st->fields[i].offset = (((st->size + el_align - 1) / el_align) * el_align);
-            st->size = el_size + st->fields[i].offset;
+            if (el_align > st->align) st->align = (uint32_t) el_align;
+            st->fields[i].offset = (uint32_t)(((st->size + el_align - 1) / el_align) * el_align);
+            st->size = (uint32_t)(el_size + st->fields[i].offset);
         }
         i++;
     }
@@ -424,13 +473,15 @@ JANET_CORE_FN(cfun_ffi_align,
 static void *janet_ffi_getpointer(const Janet *argv, int32_t n) {
     switch (janet_type(argv[n])) {
         default:
-            janet_panicf("bad slot #%d, expected ffi pointer convertable type, got %v", argv[n]);
+            janet_panicf("bad slot #%d, expected ffi pointer convertable type, got %v", n, argv[n]);
         case JANET_POINTER:
         case JANET_STRING:
         case JANET_KEYWORD:
         case JANET_SYMBOL:
-        case JANET_ABSTRACT:
+        case JANET_CFUNCTION:
             return janet_unwrap_pointer(argv[n]);
+        case JANET_ABSTRACT:
+            return (void *) janet_getbytes(argv, n).bytes;
         case JANET_BUFFER:
             return janet_unwrap_buffer(argv[n])->data;
         case JANET_FUNCTION:
@@ -443,6 +494,19 @@ static void *janet_ffi_getpointer(const Janet *argv, int32_t n) {
     }
 }
 
+static void *janet_ffi_get_callable_pointer(const Janet *argv, int32_t n) {
+    switch (janet_type(argv[n])) {
+        default:
+            break;
+        case JANET_POINTER:
+            return janet_unwrap_pointer(argv[n]);
+        case JANET_ABSTRACT:
+            if (!janet_checkabstract(argv[n], &janet_type_ffijit)) break;
+            return ((JanetFFIJittedFn *)janet_unwrap_abstract(argv[n]))->function_pointer;
+    }
+    janet_panicf("bad slot #%d, expected ffi callable pointer type, got %v", n, argv[n]);
+}
+
 /* Write a value given by some Janet values and an FFI type as it would appear in memory.
  * The alignment and space available is assumed to already be sufficient */
 static void janet_ffi_write_one(void *to, const Janet *argv, int32_t n, JanetFFIType type, int recur) {
@@ -477,7 +541,7 @@ static void janet_ffi_write_one(void *to, const Janet *argv, int32_t n, JanetFFI
             }
             for (int32_t i = 0; i < els.len; i++) {
                 JanetFFIType tp = st->fields[i].type;
-                janet_ffi_write_one(to + st->fields[i].offset, els.items, i, tp, recur - 1);
+                janet_ffi_write_one((char *) to + st->fields[i].offset, els.items, i, tp, recur - 1);
             }
         }
         break;
@@ -485,7 +549,7 @@ static void janet_ffi_write_one(void *to, const Janet *argv, int32_t n, JanetFFI
             ((double *)(to))[0] = janet_getnumber(argv, n);
             break;
         case JANET_FFI_TYPE_FLOAT:
-            ((float *)(to))[0] = janet_getnumber(argv, n);
+            ((float *)(to))[0] = (float) janet_getnumber(argv, n);
             break;
         case JANET_FFI_TYPE_PTR:
             ((void **)(to))[0] = janet_ffi_getpointer(argv, n);
@@ -509,13 +573,13 @@ static void janet_ffi_write_one(void *to, const Janet *argv, int32_t n, JanetFFI
             ((int64_t *)(to))[0] = janet_getinteger64(argv, n);
             break;
         case JANET_FFI_TYPE_UINT8:
-            ((uint8_t *)(to))[0] = janet_getuinteger64(argv, n);
+            ((uint8_t *)(to))[0] = (uint8_t) janet_getuinteger64(argv, n);
             break;
         case JANET_FFI_TYPE_UINT16:
-            ((uint16_t *)(to))[0] = janet_getuinteger64(argv, n);
+            ((uint16_t *)(to))[0] = (uint16_t) janet_getuinteger64(argv, n);
             break;
         case JANET_FFI_TYPE_UINT32:
-            ((uint32_t *)(to))[0] = janet_getuinteger64(argv, n);
+            ((uint32_t *)(to))[0] = (uint32_t) janet_getuinteger64(argv, n);
             break;
         case JANET_FFI_TYPE_UINT64:
             ((uint64_t *)(to))[0] = janet_getuinteger64(argv, n);
@@ -601,7 +665,7 @@ static JanetFFIMapping void_mapping(void) {
 #ifdef JANET_FFI_SYSV64_ENABLED
 /* AMD64 ABI Draft 0.99.7 – November 17, 2014 – 15:08
  * See section 3.2.3 Parameter Passing */
-static JanetFFIWordSpec sysv64_classify(JanetFFIType type) {
+static JanetFFIWordSpec sysv64_classify_ext(JanetFFIType type, size_t shift) {
     switch (type.prim) {
         case JANET_FFI_TYPE_PTR:
         case JANET_FFI_TYPE_STRING:
@@ -623,20 +687,63 @@ static JanetFFIWordSpec sysv64_classify(JanetFFIType type) {
             if (st->size > 16) return JANET_SYSV64_MEMORY;
             if (!st->is_aligned) return JANET_SYSV64_MEMORY;
             JanetFFIWordSpec clazz = JANET_SYSV64_NO_CLASS;
-            for (uint32_t i = 0; i < st->field_count; i++) {
-                JanetFFIWordSpec next_class = sysv64_classify(st->fields[i].type);
-                if (next_class != clazz) {
-                    if (clazz == JANET_SYSV64_NO_CLASS) {
-                        clazz = next_class;
-                    } else if (clazz == JANET_SYSV64_MEMORY || next_class == JANET_SYSV64_MEMORY) {
-                        clazz = JANET_SYSV64_MEMORY;
-                    } else if (clazz == JANET_SYSV64_INTEGER || next_class == JANET_SYSV64_INTEGER) {
-                        clazz = JANET_SYSV64_INTEGER;
-                    } else if (next_class == JANET_SYSV64_X87 || next_class == JANET_SYSV64_X87UP
-                               || next_class == JANET_SYSV64_COMPLEX_X87) {
-                        clazz = JANET_SYSV64_MEMORY;
-                    } else {
-                        clazz = JANET_SYSV64_SSE;
+            if (st->size > 8 && st->size <= 16) {
+                /* map to pair classification */
+                int has_int_lo = 0;
+                int has_int_hi = 0;
+                for (uint32_t i = 0; i < st->field_count; i++) {
+                    JanetFFIWordSpec next_class = sysv64_classify_ext(st->fields[i].type, shift + st->fields[i].offset);
+                    switch (next_class) {
+                        default:
+                            break;
+                        case JANET_SYSV64_INTEGER:
+                            if (shift + st->fields[i].offset + type_size(st->fields[i].type) <= 8) {
+                                has_int_lo = 1;
+                            } else {
+                                has_int_hi = 2;
+                            }
+                            break;
+                        case JANET_SYSV64_PAIR_INTINT:
+                            has_int_lo = 1;
+                            has_int_hi = 2;
+                            break;
+                        case JANET_SYSV64_PAIR_INTSSE:
+                            has_int_lo = 1;
+                            break;
+                        case JANET_SYSV64_PAIR_SSEINT:
+                            has_int_hi = 2;
+                            break;
+                            break;
+                    }
+                }
+                switch (has_int_hi + has_int_lo) {
+                    case 0:
+                        clazz = JANET_SYSV64_PAIR_SSESSE;
+                        break;
+                    case 1:
+                        clazz = JANET_SYSV64_PAIR_INTSSE;
+                        break;
+                    case 2:
+                        clazz = JANET_SYSV64_PAIR_SSEINT;
+                        break;
+                    case 3:
+                        clazz = JANET_SYSV64_PAIR_INTINT;
+                        break;
+                }
+            } else {
+                /* Normal struct classification */
+                for (uint32_t i = 0; i < st->field_count; i++) {
+                    JanetFFIWordSpec next_class = sysv64_classify_ext(st->fields[i].type, shift + st->fields[i].offset);
+                    if (next_class != clazz) {
+                        if (clazz == JANET_SYSV64_NO_CLASS) {
+                            clazz = next_class;
+                        } else if (clazz == JANET_SYSV64_MEMORY || next_class == JANET_SYSV64_MEMORY) {
+                            clazz = JANET_SYSV64_MEMORY;
+                        } else if (clazz == JANET_SYSV64_INTEGER || next_class == JANET_SYSV64_INTEGER) {
+                            clazz = JANET_SYSV64_INTEGER;
+                        } else {
+                            clazz = JANET_SYSV64_SSE;
+                        }
                     }
                 }
             }
@@ -649,6 +756,9 @@ static JanetFFIWordSpec sysv64_classify(JanetFFIType type) {
             return JANET_SYSV64_NO_CLASS;
     }
 }
+static JanetFFIWordSpec sysv64_classify(JanetFFIType type) {
+    return sysv64_classify_ext(type, 0);
+}
 #endif
 
 JANET_CORE_FN(cfun_ffi_signature,
@@ -684,10 +794,10 @@ JANET_CORE_FN(cfun_ffi_signature,
 #ifdef JANET_FFI_WIN64_ENABLED
         case JANET_FFI_CC_WIN_64: {
             size_t ret_size = type_size(ret.type);
-            size_t ref_stack_count = 0;
+            uint32_t ref_stack_count = 0;
             ret.spec = JANET_WIN64_REGISTER;
             uint32_t next_register = 0;
-            if (ret_size != 1 && ret_size != 2 && ret_size != 4 && ret_size != 8) {
+            if (ret_size != 0 && ret_size != 1 && ret_size != 2 && ret_size != 4 && ret_size != 8) {
                 ret.spec = JANET_WIN64_REGISTER_REF;
                 next_register++;
             } else if (ret.type.prim == JANET_FFI_TYPE_FLOAT ||
@@ -699,20 +809,19 @@ JANET_CORE_FN(cfun_ffi_signature,
                 size_t el_size = type_size(mappings[i].type);
                 int is_register_sized = (el_size == 1 || el_size == 2 || el_size == 4 || el_size == 8);
                 if (next_register < 4) {
-                    mappings[i].offset = next_register++;
+                    mappings[i].offset = next_register;
                     if (is_register_sized) {
                         mappings[i].spec = JANET_WIN64_REGISTER;
-
-                        /* Select variant based on position of floating point arguments */
                         if (mappings[i].type.prim == JANET_FFI_TYPE_FLOAT ||
                                 mappings[i].type.prim == JANET_FFI_TYPE_DOUBLE) {
-                            variant += 1 << next_register;
+                            variant += 1 << (3 - next_register);
                         }
                     } else {
                         mappings[i].spec = JANET_WIN64_REGISTER_REF;
                         mappings[i].offset2 = ref_stack_count;
-                        ref_stack_count += (el_size + 15) / 16;
+                        ref_stack_count += (uint32_t)((el_size + 15) / 16);
                     }
+                    next_register++;
                 } else {
                     if (is_register_sized) {
                         mappings[i].spec = JANET_WIN64_STACK;
@@ -723,30 +832,25 @@ JANET_CORE_FN(cfun_ffi_signature,
                         mappings[i].offset = stack_count;
                         stack_count++;
                         mappings[i].offset2 = ref_stack_count;
-                        ref_stack_count += (el_size + 15) / 16;
+                        ref_stack_count += (uint32_t)((el_size + 15) / 16);
                     }
                 }
             }
 
-            /* Take into account reference arguments and align to 16 bytes just in case */
+            /* Add reference items */
+            size_t old_stack_count = stack_count;
             stack_count += 2 * ref_stack_count;
-            if (stack_count & 1) {
+            if (stack_count & 0x1) {
                 stack_count++;
             }
 
             /* Invert stack
              * Offsets are in units of 8-bytes */
             for (uint32_t i = 0; i < arg_count; i++) {
-                uint32_t old_offset = mappings[i].offset;
-                if (mappings[i].spec == JANET_WIN64_STACK) {
-                    mappings[i].offset = stack_count - 1 - old_offset;
-                } else if (mappings[i].spec == JANET_WIN64_STACK_REF) {
-                    mappings[i].offset = stack_count - 1 - old_offset;
-                }
                 if (mappings[i].spec == JANET_WIN64_STACK_REF || mappings[i].spec == JANET_WIN64_REGISTER_REF) {
                     /* Align size to 16 bytes */
                     size_t size = (type_size(mappings[i].type) + 15) & ~0xFUL;
-                    mappings[i].offset2 = stack_count - mappings[i].offset2 - (size / 8);
+                    mappings[i].offset2 = (uint32_t)(stack_count - mappings[i].offset2 - (size / 8));
                 }
             }
 
@@ -759,6 +863,8 @@ JANET_CORE_FN(cfun_ffi_signature,
             JanetFFIWordSpec ret_spec = sysv64_classify(ret.type);
             ret.spec = ret_spec;
             if (ret_spec == JANET_SYSV64_SSE) variant = 1;
+            if (ret_spec == JANET_SYSV64_PAIR_INTSSE) variant = 2;
+            if (ret_spec == JANET_SYSV64_PAIR_SSEINT) variant = 3;
             /* Spill register overflow to memory */
             uint32_t next_register = 0;
             uint32_t next_fp_register = 0;
@@ -787,8 +893,8 @@ JANET_CORE_FN(cfun_ffi_signature,
                             mappings[i].offset = stack_count;
                             stack_count += el_size;
                         }
-                        break;
                     }
+                    break;
                     case JANET_SYSV64_SSE: {
                         if (next_fp_register < max_fp_regs) {
                             mappings[i].offset = next_fp_register++;
@@ -797,21 +903,57 @@ JANET_CORE_FN(cfun_ffi_signature,
                             mappings[i].offset = stack_count;
                             stack_count += el_size;
                         }
-                        break;
                     }
+                    break;
                     case JANET_SYSV64_MEMORY: {
                         mappings[i].offset = stack_count;
                         stack_count += el_size;
                     }
-                }
-            }
-
-            /* Invert stack */
-            for (uint32_t i = 0; i < arg_count; i++) {
-                if (mappings[i].spec == JANET_SYSV64_MEMORY) {
-                    uint32_t old_offset = mappings[i].offset;
-                    size_t el_size = type_size(mappings[i].type);
-                    mappings[i].offset = stack_count - ((el_size + 7) / 8) - old_offset;
+                    break;
+                    case JANET_SYSV64_PAIR_INTINT: {
+                        if (next_register + 1 < max_regs) {
+                            mappings[i].offset = next_register++;
+                            mappings[i].offset2 = next_register++;
+                        } else {
+                            mappings[i].spec = JANET_SYSV64_MEMORY;
+                            mappings[i].offset = stack_count;
+                            stack_count += el_size;
+                        }
+                    }
+                    break;
+                    case JANET_SYSV64_PAIR_INTSSE: {
+                        if (next_register < max_regs && next_fp_register < max_fp_regs) {
+                            mappings[i].offset = next_register++;
+                            mappings[i].offset2 = next_fp_register++;
+                        } else {
+                            mappings[i].spec = JANET_SYSV64_MEMORY;
+                            mappings[i].offset = stack_count;
+                            stack_count += el_size;
+                        }
+                    }
+                    break;
+                    case JANET_SYSV64_PAIR_SSEINT: {
+                        if (next_register < max_regs && next_fp_register < max_fp_regs) {
+                            mappings[i].offset = next_fp_register++;
+                            mappings[i].offset2 = next_register++;
+                        } else {
+                            mappings[i].spec = JANET_SYSV64_MEMORY;
+                            mappings[i].offset = stack_count;
+                            stack_count += el_size;
+                        }
+                    }
+                    break;
+                    case JANET_SYSV64_PAIR_SSESSE: {
+                        if (next_fp_register < max_fp_regs) {
+                            mappings[i].offset = next_fp_register++;
+                            mappings[i].offset2 = next_fp_register++;
+                        } else {
+                            mappings[i].spec = JANET_SYSV64_MEMORY;
+                            mappings[i].offset = stack_count;
+                            stack_count += el_size;
+                        }
+                    }
+                    break;
                 }
             }
         }
@@ -847,23 +989,38 @@ typedef struct {
     double x;
     double y;
 } sysv64_sse_return;
+typedef struct {
+    uint64_t x;
+    double y;
+} sysv64_intsse_return;
+typedef struct {
+    double y;
+    uint64_t x;
+} sysv64_sseint_return;
 typedef sysv64_int_return janet_sysv64_variant_1(uint64_t a, uint64_t b, uint64_t c, uint64_t d, uint64_t e, uint64_t f,
         double r1, double r2, double r3, double r4, double r5, double r6, double r7, double r8);
 typedef sysv64_sse_return janet_sysv64_variant_2(uint64_t a, uint64_t b, uint64_t c, uint64_t d, uint64_t e, uint64_t f,
         double r1, double r2, double r3, double r4, double r5, double r6, double r7, double r8);
+typedef sysv64_intsse_return janet_sysv64_variant_3(uint64_t a, uint64_t b, uint64_t c, uint64_t d, uint64_t e, uint64_t f,
+        double r1, double r2, double r3, double r4, double r5, double r6, double r7, double r8);
+typedef sysv64_sseint_return janet_sysv64_variant_4(uint64_t a, uint64_t b, uint64_t c, uint64_t d, uint64_t e, uint64_t f,
+        double r1, double r2, double r3, double r4, double r5, double r6, double r7, double r8);
 
 static Janet janet_ffi_sysv64(JanetFFISignature *signature, void *function_pointer, const Janet *argv) {
-    sysv64_int_return int_return;
-    sysv64_sse_return sse_return;
+    union {
+        sysv64_int_return int_return;
+        sysv64_sse_return sse_return;
+        sysv64_sseint_return sseint_return;
+        sysv64_intsse_return intsse_return;
+    } retu;
+    uint64_t pair[2];
     uint64_t regs[6];
     double fp_regs[8];
     JanetFFIWordSpec ret_spec = signature->ret.spec;
-    void *ret_mem = &int_return;
+    void *ret_mem = &retu.int_return;
     if (ret_spec == JANET_SYSV64_MEMORY) {
         ret_mem = alloca(type_size(signature->ret.type));
         regs[0] = (uint64_t) ret_mem;
-    } else if (ret_spec == JANET_SYSV64_SSE) {
-        ret_mem = &sse_return;
     }
     uint64_t *stack = alloca(sizeof(uint64_t) * signature->stack_count);
     for (uint32_t i = 0; i < signature->arg_count; i++) {
@@ -882,21 +1039,55 @@ static Janet janet_ffi_sysv64(JanetFFISignature *signature, void *function_point
             case JANET_SYSV64_MEMORY:
                 to = stack + arg.offset;
                 break;
+            case JANET_SYSV64_PAIR_INTINT:
+                janet_ffi_write_one(pair, argv, n, arg.type, JANET_FFI_MAX_RECUR);
+                regs[arg.offset] = pair[0];
+                regs[arg.offset2] = pair[1];
+                continue;
+            case JANET_SYSV64_PAIR_INTSSE:
+                janet_ffi_write_one(pair, argv, n, arg.type, JANET_FFI_MAX_RECUR);
+                regs[arg.offset] = pair[0];
+                ((uint64_t *) fp_regs)[arg.offset2] = pair[1];
+                continue;
+            case JANET_SYSV64_PAIR_SSEINT:
+                janet_ffi_write_one(pair, argv, n, arg.type, JANET_FFI_MAX_RECUR);
+                ((uint64_t *) fp_regs)[arg.offset] = pair[0];
+                regs[arg.offset2] = pair[1];
+                continue;
+            case JANET_SYSV64_PAIR_SSESSE:
+                janet_ffi_write_one(pair, argv, n, arg.type, JANET_FFI_MAX_RECUR);
+                ((uint64_t *) fp_regs)[arg.offset] = pair[0];
+                ((uint64_t *) fp_regs)[arg.offset2] = pair[1];
+                continue;
         }
         janet_ffi_write_one(to, argv, n, arg.type, JANET_FFI_MAX_RECUR);
     }
 
-    if (signature->variant) {
-        sse_return = ((janet_sysv64_variant_2 *)(function_pointer))(
-                         regs[0], regs[1], regs[2], regs[3], regs[4], regs[5],
-                         fp_regs[0], fp_regs[1], fp_regs[2], fp_regs[3],
-                         fp_regs[4], fp_regs[5], fp_regs[6], fp_regs[7]);
-    } else {
-        int_return = ((janet_sysv64_variant_1 *)(function_pointer))(
-                         regs[0], regs[1], regs[2], regs[3], regs[4], regs[5],
-                         fp_regs[0], fp_regs[1], fp_regs[2], fp_regs[3],
-                         fp_regs[4], fp_regs[5], fp_regs[6], fp_regs[7]);
-
+    switch (signature->variant) {
+        case 0:
+            retu.int_return = ((janet_sysv64_variant_1 *)(function_pointer))(
+                                  regs[0], regs[1], regs[2], regs[3], regs[4], regs[5],
+                                  fp_regs[0], fp_regs[1], fp_regs[2], fp_regs[3],
+                                  fp_regs[4], fp_regs[5], fp_regs[6], fp_regs[7]);
+            break;
+        case 1:
+            retu.sse_return = ((janet_sysv64_variant_2 *)(function_pointer))(
+                                  regs[0], regs[1], regs[2], regs[3], regs[4], regs[5],
+                                  fp_regs[0], fp_regs[1], fp_regs[2], fp_regs[3],
+                                  fp_regs[4], fp_regs[5], fp_regs[6], fp_regs[7]);
+            break;
+        case 2:
+            retu.intsse_return = ((janet_sysv64_variant_3 *)(function_pointer))(
+                                     regs[0], regs[1], regs[2], regs[3], regs[4], regs[5],
+                                     fp_regs[0], fp_regs[1], fp_regs[2], fp_regs[3],
+                                     fp_regs[4], fp_regs[5], fp_regs[6], fp_regs[7]);
+            break;
+        case 3:
+            retu.sseint_return = ((janet_sysv64_variant_4 *)(function_pointer))(
+                                     regs[0], regs[1], regs[2], regs[3], regs[4], regs[5],
+                                     fp_regs[0], fp_regs[1], fp_regs[2], fp_regs[3],
+                                     fp_regs[4], fp_regs[5], fp_regs[6], fp_regs[7]);
+            break;
     }
 
     return janet_ffi_read_one(ret_mem, signature->ret.type, JANET_FFI_MAX_RECUR);
@@ -961,33 +1152,38 @@ static Janet janet_ffi_win64(JanetFFISignature *signature, void *function_pointe
     } ret_reg;
     JanetFFIWordSpec ret_spec = signature->ret.spec;
     void *ret_mem = &ret_reg.integer;
-    if (ret_spec == JANET_WIN64_STACK) {
+    if (ret_spec == JANET_WIN64_REGISTER_REF) {
         ret_mem = alloca(type_size(signature->ret.type));
         regs[0].integer = (uint64_t) ret_mem;
     }
-    uint64_t *stack = alloca(signature->stack_count * 8);
+    size_t stack_size = signature->stack_count * 8;
+    size_t stack_shift = 2;
+    uint64_t *stack = alloca(stack_size);
     for (uint32_t i = 0; i < signature->arg_count; i++) {
         int32_t n = i + 2;
         JanetFFIMapping arg = signature->args[i];
         if (arg.spec == JANET_WIN64_STACK) {
             janet_ffi_write_one(stack + arg.offset, argv, n, arg.type, JANET_FFI_MAX_RECUR);
         } else if (arg.spec == JANET_WIN64_STACK_REF) {
-            uint8_t *ptr = (uint8_t *)(stack + args.offset2);
+            uint8_t *ptr = (uint8_t *)(stack + arg.offset2);
             janet_ffi_write_one(ptr, argv, n, arg.type, JANET_FFI_MAX_RECUR);
-            stack[args.offset] = (uint64_t) ptr;
+            stack[arg.offset] = (uint64_t)(ptr - stack_shift * sizeof(uint64_t));
         } else if (arg.spec == JANET_WIN64_REGISTER_REF) {
-            uint8_t *ptr = (uint8_t *)(stack + args.offset2);
+            uint8_t *ptr = (uint8_t *)(stack + arg.offset2);
             janet_ffi_write_one(ptr, argv, n, arg.type, JANET_FFI_MAX_RECUR);
-            regs[args.offset].integer = (uint64_t) ptr;
+            regs[arg.offset].integer = (uint64_t)(ptr - stack_shift * sizeof(uint64_t));
         } else {
             janet_ffi_write_one((uint8_t *) &regs[arg.offset].integer, argv, n, arg.type, JANET_FFI_MAX_RECUR);
         }
     }
 
-    /* the seasoned programmer who cut their teeth on assembly is probably quietly shaking their head by now... */
+    /* hack to get proper stack placement and avoid clobbering from logic above - shift stack down, otherwise we have issues.
+     * Technically, this writes into 16 bytes of unallocated stack memory */
+    if (stack_size) memmove(stack - stack_shift, stack, stack_size);
+
     switch (signature->variant) {
         default:
-            janet_panic("unknown variant");
+            janet_panicf("unknown variant %d", signature->variant);
         case 0:
             ret_reg.integer = ((win64_variant_i_iiii *) function_pointer)(regs[0].integer, regs[1].integer, regs[2].integer, regs[3].integer);
             break;
@@ -1091,12 +1287,65 @@ static Janet janet_ffi_win64(JanetFFISignature *signature, void *function_pointe
 
 #endif
 
+/* Allocate executable memory chunks in sizes of a page. Ideally we would keep
+ * an allocator around so that multiple JIT allocations would point to the same
+ * region but it isn't really worth it. */
+#define FFI_PAGE_MASK 0xFFF
+
+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_fixarity(argc, 1);
+    JanetByteView bytes = janet_getbytes(argv, 0);
+
+    /* Quick hack to align to page boundary, we should query OS. FIXME */
+    size_t alloc_size = ((size_t) bytes.len + FFI_PAGE_MASK) & ~FFI_PAGE_MASK;
+
+#ifdef JANET_FFI_JIT
+    JanetFFIJittedFn *fn = janet_abstract_threaded(&janet_type_ffijit, sizeof(JanetFFIJittedFn));
+    fn->function_pointer = NULL;
+    fn->size = 0;
+#ifdef JANET_WINDOWS
+    void *ptr = VirtualAlloc(NULL, alloc_size, MEM_COMMIT | MEM_RESERVE, PAGE_READWRITE);
+#elif defined(MAP_ANONYMOUS)
+    void *ptr = mmap(0, alloc_size, PROT_READ | PROT_WRITE, MAP_PRIVATE | MAP_ANONYMOUS, -1, 0);
+#elif defined(MAP_ANON)
+    /* macos doesn't have MAP_ANONYMOUS */
+    void *ptr = mmap(0, alloc_size, PROT_READ | PROT_WRITE, MAP_PRIVATE | MAP_ANON, -1, 0);
+#else
+    /* -std=c99 gets in the way */
+    /* #define MAP_ANONYMOUS 0x20 should work, though. */
+    void *ptr = mmap(0, alloc_size, PROT_READ | PROT_WRITE, MAP_PRIVATE, -1, 0);
+#endif
+    if (!ptr) {
+        janet_panic("failed to memory map writable memory");
+    }
+    memcpy(ptr, bytes.bytes, bytes.len);
+#ifdef JANET_WINDOWS
+    DWORD old = 0;
+    if (!VirtualProtect(ptr, alloc_size, PAGE_EXECUTE_READ, &old)) {
+        janet_panic("failed to make mapped memory executable");
+    }
+#else
+    if (mprotect(ptr, alloc_size, PROT_READ | PROT_EXEC) == -1) {
+        janet_panic("failed to make mapped memory executable");
+    }
+#endif
+    fn->size = alloc_size;
+    fn->function_pointer = ptr;
+    return janet_wrap_abstract(fn);
+#else
+    janet_panic("ffi/jitfn not available on this platform");
+#endif
+}
+
 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_arity(argc, 2, -1);
-    void *function_pointer = janet_getpointer(argv, 0);
+    void *function_pointer = janet_ffi_get_callable_pointer(argv, 0);
     JanetFFISignature *signature = janet_getabstract(argv, 1, &janet_signature_type);
     janet_fixarity(argc - 2, signature->arg_count);
     switch (signature->cc) {
@@ -1121,7 +1370,7 @@ JANET_CORE_FN(cfun_ffi_buffer_write,
               "or to files. Returns a modifed buffer or a new buffer if one is not supplied.") {
     janet_arity(argc, 2, 3);
     JanetFFIType type = decode_ffi_type(argv[0]);
-    size_t el_size = type_size(type);
+    uint32_t el_size = (uint32_t) type_size(type);
     JanetBuffer *buffer = janet_optbuffer(argv, argc, 2, el_size);
     janet_buffer_extra(buffer, el_size);
     memset(buffer->data, 0, el_size);
@@ -1183,9 +1432,7 @@ JANET_CORE_FN(janet_core_raw_native,
               "Returns a `core/native`.") {
     janet_arity(argc, 0, 1);
     const char *path = janet_optcstring(argv, argc, 0, NULL);
-    char *processed_name = (NULL == path) ? NULL : get_processed_name(path);
-    Clib lib = load_clib(processed_name);
-    if (NULL != path && path != processed_name) janet_free(processed_name);
+    Clib lib = load_clib(path);
     if (!lib) janet_panic(error_clib());
     JanetAbstractNative *anative = janet_abstract(&janet_native_type, sizeof(JanetAbstractNative));
     anative->clib = lib;
@@ -1220,6 +1467,25 @@ JANET_CORE_FN(janet_core_native_close,
     return janet_wrap_nil();
 }
 
+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.") {
+    janet_fixarity(argc, 1);
+    size_t size = janet_getsize(argv, 0);
+    if (size == 0) return janet_wrap_nil();
+    return janet_wrap_pointer(malloc(size));
+}
+
+JANET_CORE_FN(cfun_ffi_free,
+              "(ffi/free pointer)",
+              "Free memory allocated with `ffi/malloc`.") {
+    janet_fixarity(argc, 1);
+    if (janet_checktype(argv[0], JANET_NIL)) return janet_wrap_nil();
+    void *pointer = janet_getpointer(argv, 0);
+    free(pointer);
+    return janet_wrap_nil();
+}
+
 void janet_lib_ffi(JanetTable *env) {
     JanetRegExt ffi_cfuns[] = {
         JANET_CORE_REG("ffi/native", janet_core_raw_native),
@@ -1233,6 +1499,9 @@ void janet_lib_ffi(JanetTable *env) {
         JANET_CORE_REG("ffi/size", cfun_ffi_size),
         JANET_CORE_REG("ffi/align", cfun_ffi_align),
         JANET_CORE_REG("ffi/trampoline", cfun_ffi_get_callback_trampoline),
+        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_REG_END
     };
     janet_core_cfuns_ext(env, NULL, ffi_cfuns);

src/core/fiber.c

@@ -1,5 +1,5 @@
 /*
-* Copyright (c) 2022 Calvin Rose
+* Copyright (c) 2023 Calvin Rose
 *
 * Permission is hereby granted, free of charge, to any person obtaining a copy
 * of this software and associated documentation files (the "Software"), to

src/core/fiber.h

@@ -1,5 +1,5 @@
 /*
-* Copyright (c) 2022 Calvin Rose
+* Copyright (c) 2023 Calvin Rose
 *
 * Permission is hereby granted, free of charge, to any person obtaining a copy
 * of this software and associated documentation files (the "Software"), to

src/core/gc.c

@@ -1,5 +1,5 @@
 /*
-* Copyright (c) 2022 Calvin Rose
+* Copyright (c) 2023 Calvin Rose
 *
 * Permission is hereby granted, free of charge, to any person obtaining a copy
 * of this software and associated documentation files (the "Software"), to

src/core/gc.h

@@ -1,5 +1,5 @@
 /*
-* Copyright (c) 2022 Calvin Rose
+* Copyright (c) 2023 Calvin Rose
 *
 * Permission is hereby granted, free of charge, to any person obtaining a copy
 * of this software and associated documentation files (the "Software"), to

src/core/inttypes.c

@@ -1,5 +1,5 @@
 /*
-* Copyright (c) 2022 Calvin Rose & contributors
+* Copyright (c) 2023 Calvin Rose & contributors
 *
 * Permission is hereby granted, free of charge, to any person obtaining a copy
 * of this software and associated documentation files (the "Software"), to
@@ -407,13 +407,26 @@ static Janet cfun_it_u64_compare(int32_t argc, Janet *argv) {
     return janet_wrap_nil();
 }
 
+/*
+ * In C, signed arithmetic overflow is undefined behvior
+ * but unsigned arithmetic overflow is twos complement
+ *
+ * Reference:
+ * https://en.cppreference.com/w/cpp/language/ub
+ * http://blog.llvm.org/2011/05/what-every-c-programmer-should-know.html
+ *
+ * This means OPMETHOD & OPMETHODINVERT must always use
+ * unsigned arithmetic internally, regardless of the true type.
+ * This will not affect the end result (property of twos complement).
+ */
 #define OPMETHOD(T, type, name, oper) \
 static Janet cfun_it_##type##_##name(int32_t argc, Janet *argv) { \
     janet_arity(argc, 2, -1); \
     T *box = janet_abstract(&janet_##type##_type, sizeof(T)); \
     *box = janet_unwrap_##type(argv[0]); \
     for (int32_t i = 1; i < argc; i++) \
-        *box oper##= janet_unwrap_##type(argv[i]); \
+        /* This avoids undefined behavior. See above for why. */ \
+        *box = (T) ((uint64_t) (*box)) oper ((uint64_t) janet_unwrap_##type(argv[i])); \
     return janet_wrap_abstract(box); \
 } \
 
@@ -422,7 +435,8 @@ static Janet cfun_it_##type##_##name(int32_t argc, Janet *argv) { \
     janet_fixarity(argc, 2); \
     T *box = janet_abstract(&janet_##type##_type, sizeof(T)); \
     *box = janet_unwrap_##type(argv[1]); \
-    *box oper##= janet_unwrap_##type(argv[0]); \
+    /* This avoids undefined behavior. See above for why. */ \
+    *box = (T) ((uint64_t) *box) oper ((uint64_t) janet_unwrap_##type(argv[0])); \
     return janet_wrap_abstract(box); \
 } \
 
@@ -518,7 +532,6 @@ OPMETHOD(uint64_t, u64, rshift, >>)
 #undef DIVMETHOD_SIGNED
 #undef COMPMETHOD
 
-
 static JanetMethod it_s64_methods[] = {
     {"+", cfun_it_s64_add},
     {"r+", cfun_it_s64_add},
@@ -541,7 +554,6 @@ static JanetMethod it_s64_methods[] = {
     {"<<", cfun_it_s64_lshift},
     {">>", cfun_it_s64_rshift},
     {"compare", cfun_it_s64_compare},
-
     {NULL, NULL}
 };
 
@@ -567,7 +579,6 @@ static JanetMethod it_u64_methods[] = {
     {"<<", cfun_it_u64_lshift},
     {">>", cfun_it_u64_rshift},
     {"compare", cfun_it_u64_compare},
-
     {NULL, NULL}
 };
 

src/core/io.c

@@ -1,5 +1,5 @@
 /*
-* Copyright (c) 2022 Calvin Rose
+* Copyright (c) 2023 Calvin Rose
 *
 * Permission is hereby granted, free of charge, to any person obtaining a copy
 * of this software and associated documentation files (the "Software"), to
@@ -545,6 +545,16 @@ static Janet cfun_io_printf_impl_x(int32_t argc, Janet *argv, int newline,
             if (newline) janet_buffer_push_u8(buf, '\n');
             return janet_wrap_nil();
         }
+        case JANET_FUNCTION: {
+            /* Special case function */
+            JanetFunction *fun = janet_unwrap_function(x);
+            JanetBuffer *buf = janet_buffer(0);
+            janet_buffer_format(buf, fmt, offset, argc, argv);
+            if (newline) janet_buffer_push_u8(buf, '\n');
+            Janet args[1] = { janet_wrap_buffer(buf) };
+            janet_call(fun, 1, args);
+            return janet_wrap_nil();
+        }
         case JANET_NIL:
             f = dflt_file;
             if (f == NULL) janet_panic("cannot print to nil");
@@ -684,6 +694,16 @@ void janet_dynprintf(const char *name, FILE *dflt_file, const char *format, ...)
             janet_buffer_deinit(&buffer);
             break;
         }
+        case JANET_FUNCTION: {
+            JanetFunction *fun = janet_unwrap_function(x);
+            int32_t len = 0;
+            while (format[len]) len++;
+            JanetBuffer *buf = janet_buffer(len);
+            janet_formatbv(buf, format, args);
+            Janet args[1] = { janet_wrap_buffer(buf) };
+            janet_call(fun, 1, args);
+            break;
+        }
         case JANET_BUFFER:
             janet_formatbv(janet_unwrap_buffer(x), format, args);
             break;

src/core/marsh.c

@@ -1,5 +1,5 @@
 /*
-* Copyright (c) 2022 Calvin Rose
+* Copyright (c) 2023 Calvin Rose
 *
 * Permission is hereby granted, free of charge, to any person obtaining a copy
 * of this software and associated documentation files (the "Software"), to
@@ -37,6 +37,7 @@ typedef struct {
     JanetFuncEnv **seen_envs;
     JanetFuncDef **seen_defs;
     int32_t nextid;
+    int maybe_cycles;
 } MarshalState;
 
 /* Lead bytes in marshaling protocol */
@@ -364,13 +365,15 @@ void janet_marshal_janet(JanetMarshalContext *ctx, Janet x) {
 
 void janet_marshal_abstract(JanetMarshalContext *ctx, void *abstract) {
     MarshalState *st = (MarshalState *)(ctx->m_state);
-    janet_table_put(&st->seen,
-                    janet_wrap_abstract(abstract),
-                    janet_wrap_integer(st->nextid++));
+    if (st->maybe_cycles) {
+        janet_table_put(&st->seen,
+                        janet_wrap_abstract(abstract),
+                        janet_wrap_integer(st->nextid++));
+    }
 }
 
 #define MARK_SEEN() \
-    janet_table_put(&st->seen, x, janet_wrap_integer(st->nextid++))
+    do { if (st->maybe_cycles) janet_table_put(&st->seen, x, janet_wrap_integer(st->nextid++)); } while (0)
 
 static void marshal_one_abstract(MarshalState *st, Janet x, int flags) {
     void *abstract = janet_unwrap_abstract(x);
@@ -428,11 +431,14 @@ static void marshal_one(MarshalState *st, Janet x, int flags) {
 
     /* Check reference and registry value */
     {
-        Janet check = janet_table_get(&st->seen, x);
-        if (janet_checkint(check)) {
-            pushbyte(st, LB_REFERENCE);
-            pushint(st, janet_unwrap_integer(check));
-            return;
+        Janet check;
+        if (st->maybe_cycles) {
+            check = janet_table_get(&st->seen, x);
+            if (janet_checkint(check)) {
+                pushbyte(st, LB_REFERENCE);
+                pushint(st, janet_unwrap_integer(check));
+                return;
+            }
         }
         if (st->rreg) {
             check = janet_table_get(st->rreg, x);
@@ -613,6 +619,7 @@ void janet_marshal(
     st.seen_defs = NULL;
     st.seen_envs = NULL;
     st.rreg = rreg;
+    st.maybe_cycles = !(flags & JANET_MARSHAL_NO_CYCLES);
     janet_table_init(&st.seen, 0);
     marshal_one(&st, x, flags);
     janet_table_deinit(&st.seen);
@@ -1471,16 +1478,17 @@ JANET_CORE_FN(cfun_env_lookup,
 }
 
 JANET_CORE_FN(cfun_marshal,
-              "(marshal x &opt reverse-lookup buffer)",
+              "(marshal x &opt reverse-lookup buffer no-cycles)",
               "Marshal a value into a buffer and return the buffer. The buffer "
               "can then later be unmarshalled to reconstruct the initial value. "
               "Optionally, one can pass in a reverse lookup table to not marshal "
               "aliased values that are found in the table. Then a forward "
               "lookup table can be used to recover the original value when "
               "unmarshalling.") {
-    janet_arity(argc, 1, 3);
+    janet_arity(argc, 1, 4);
     JanetBuffer *buffer;
     JanetTable *rreg = NULL;
+    uint32_t flags = 0;
     if (argc > 1) {
         rreg = janet_gettable(argv, 1);
     }
@@ -1489,7 +1497,10 @@ JANET_CORE_FN(cfun_marshal,
     } else {
         buffer = janet_buffer(10);
     }
-    janet_marshal(buffer, argv[0], rreg, 0);
+    if (argc > 3 && janet_truthy(argv[3])) {
+        flags |= JANET_MARSHAL_NO_CYCLES;
+    }
+    janet_marshal(buffer, argv[0], rreg, flags);
     return janet_wrap_buffer(buffer);
 }
 

src/core/math.c

@@ -1,5 +1,5 @@
 /*
-* Copyright (c) 2022 Calvin Rose
+* Copyright (c) 2023 Calvin Rose
 *
 * Permission is hereby granted, free of charge, to any person obtaining a copy
 * of this software and associated documentation files (the "Software"), to
@@ -282,7 +282,7 @@ 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(fabs, fabs, "Return the absolute value of 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.")
@@ -368,7 +368,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_fabs),
+        JANET_CORE_REG("math/abs", janet_abs),
         JANET_CORE_REG("math/sinh", janet_sinh),
         JANET_CORE_REG("math/cosh", janet_cosh),
         JANET_CORE_REG("math/tanh", janet_tanh),

src/core/net.c

@@ -1,5 +1,5 @@
 /*
-* Copyright (c) 2022 Calvin Rose and contributors.
+* Copyright (c) 2023 Calvin Rose and contributors.
 *
 * Permission is hereby granted, free of charge, to any person obtaining a copy
 * of this software and associated documentation files (the "Software"), to
@@ -224,7 +224,12 @@ JanetAsyncStatus net_machine_accept(JanetListenerState *s, JanetAsyncEvent event
             janet_schedule(s->fiber, janet_wrap_nil());
             return JANET_ASYNC_STATUS_DONE;
         case JANET_ASYNC_EVENT_READ: {
+#if defined(JANET_LINUX)
+            JSock connfd = accept4(s->stream->handle, NULL, NULL, SOCK_CLOEXEC);
+#else
+            /* On BSDs, CLOEXEC should be inherited from server socket */
             JSock connfd = accept(s->stream->handle, NULL, NULL);
+#endif
             if (JSOCKVALID(connfd)) {
                 janet_net_socknoblock(connfd);
                 JanetStream *stream = make_stream(connfd, JANET_STREAM_READABLE | JANET_STREAM_WRITABLE);

src/core/os.c

@@ -1,5 +1,5 @@
 /*
-* Copyright (c) 2022 Calvin Rose and contributors.
+* Copyright (c) 2023 Calvin Rose and contributors.
 *
 * Permission is hereby granted, free of charge, to any person obtaining a copy
 * of this software and associated documentation files (the "Software"), to
@@ -209,6 +209,8 @@ JANET_CORE_FN(os_exit,
     return janet_wrap_nil();
 }
 
+#ifndef JANET_REDUCED_OS
+
 JANET_CORE_FN(os_cpu_count,
               "(os/cpu-count &opt dflt)",
               "Get an approximate number of CPUs available on for this process to use. If "
@@ -250,7 +252,6 @@ JANET_CORE_FN(os_cpu_count,
 #endif
 }
 
-#ifndef JANET_REDUCED_OS
 
 #ifndef JANET_NO_PROCESSES
 
@@ -470,15 +471,7 @@ static int proc_get_status(JanetProc *proc) {
 /* Function that is called in separate thread to wait on a pid */
 static JanetEVGenericMessage janet_proc_wait_subr(JanetEVGenericMessage args) {
     JanetProc *proc = (JanetProc *) args.argp;
-#ifdef WNOWAIT
-    pid_t result;
-    int status = 0;
-    do {
-        result = waitpid(proc->pid, &status, WNOWAIT);
-    } while (result == -1 && errno == EINTR);
-#else
     args.tag = proc_get_status(proc);
-#endif
     return args;
 }
 
@@ -489,11 +482,7 @@ static void janet_proc_wait_cb(JanetEVGenericMessage args) {
     janet_ev_dec_refcount();
     JanetProc *proc = (JanetProc *) args.argp;
     if (NULL != proc) {
-#ifdef WNOWAIT
-        int status = proc_get_status(proc);
-#else
         int status = args.tag;
-#endif
         proc->return_code = (int32_t) status;
         proc->flags |= JANET_PROC_WAITED;
         proc->flags &= ~JANET_PROC_WAITING;
@@ -1121,8 +1110,8 @@ JANET_CORE_FN(os_spawn,
               "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."
+              "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)`.") {
@@ -1336,7 +1325,7 @@ JANET_CORE_FN(os_date,
     time_t t;
     struct tm t_infos;
     struct tm *t_info = NULL;
-    if (argc) {
+    if (argc && !janet_checktype(argv[0], JANET_NIL)) {
         int64_t integer = janet_getinteger64(argv, 0);
         t = (time_t) integer;
     } else {
@@ -1822,11 +1811,9 @@ static Janet os_stat_or_lstat(int do_lstat, int32_t argc, Janet *argv) {
     janet_arity(argc, 1, 2);
     const char *path = janet_getcstring(argv, 0);
     JanetTable *tab = NULL;
-    int getall = 1;
-    const uint8_t *key;
+    const uint8_t *key = NULL;
     if (argc == 2) {
         if (janet_checktype(argv[1], JANET_KEYWORD)) {
-            getall = 0;
             key = janet_getkeyword(argv, 1);
         } else {
             tab = janet_gettable(argv, 1);
@@ -1852,7 +1839,7 @@ static Janet os_stat_or_lstat(int do_lstat, int32_t argc, Janet *argv) {
         return janet_wrap_nil();
     }
 
-    if (getall) {
+    if (NULL == key) {
         /* Put results in table */
         for (const struct OsStatGetter *sg = os_stat_getters; sg->name != NULL; sg++) {
             janet_table_put(tab, janet_ckeywordv(sg->name), sg->fn(&st));
@@ -2036,23 +2023,23 @@ JANET_CORE_FN(os_open,
               "Allowed flags are as follows:\n\n"
               "  * :r - open this file for reading\n"
               "  * :w - open this file for writing\n"
-              "  * :c - create a new file (O_CREATE)\n"
-              "  * :e - fail if the file exists (O_EXCL)\n"
-              "  * :t - shorten an existing file to length 0 (O_TRUNC)\n\n"
+              "  * :c - create a new file (O\\_CREATE)\n"
+              "  * :e - fail if the file exists (O\\_EXCL)\n"
+              "  * :t - shorten an existing file to length 0 (O\\_TRUNC)\n\n"
               "Posix-only flags:\n\n"
-              "  * :a - append to a file (O_APPEND)\n"
-              "  * :x - O_SYNC\n"
-              "  * :C - O_NOCTTY\n\n"
+              "  * :a - append to a file (O\\_APPEND)\n"
+              "  * :x - O\\_SYNC\n"
+              "  * :C - O\\_NOCTTY\n\n"
               "Windows-only flags:\n\n"
-              "  * :R - share reads (FILE_SHARE_READ)\n"
-              "  * :W - share writes (FILE_SHARE_WRITE)\n"
-              "  * :D - share deletes (FILE_SHARE_DELETE)\n"
-              "  * :H - FILE_ATTRIBUTE_HIDDEN\n"
-              "  * :O - FILE_ATTRIBUTE_READONLY\n"
-              "  * :F - FILE_ATTRIBUTE_OFFLINE\n"
-              "  * :T - FILE_ATTRIBUTE_TEMPORARY\n"
-              "  * :d - FILE_FLAG_DELETE_ON_CLOSE\n"
-              "  * :b - FILE_FLAG_NO_BUFFERING\n") {
+              "  * :R - share reads (FILE\\_SHARE\\_READ)\n"
+              "  * :W - share writes (FILE\\_SHARE\\_WRITE)\n"
+              "  * :D - share deletes (FILE\\_SHARE\\_DELETE)\n"
+              "  * :H - FILE\\_ATTRIBUTE\\_HIDDEN\n"
+              "  * :O - FILE\\_ATTRIBUTE\\_READONLY\n"
+              "  * :F - FILE\\_ATTRIBUTE\\_OFFLINE\n"
+              "  * :T - FILE\\_ATTRIBUTE\\_TEMPORARY\n"
+              "  * :d - FILE\\_FLAG\\_DELETE\\_ON\\_CLOSE\n"
+              "  * :b - FILE\\_FLAG\\_NO\\_BUFFERING\n") {
     janet_arity(argc, 1, 3);
     const char *path = janet_getcstring(argv, 0);
     const uint8_t *opt_flags = janet_optkeyword(argv, argc, 1, (const uint8_t *) "r");
@@ -2149,20 +2136,18 @@ JANET_CORE_FN(os_open,
 #ifdef JANET_LINUX
     open_flags |= O_CLOEXEC;
 #endif
+    int read_flag = 0;
+    int write_flag = 0;
     for (const uint8_t *c = opt_flags; *c; c++) {
         switch (*c) {
             default:
                 break;
             case 'r':
-                open_flags = (open_flags & O_WRONLY)
-                             ? ((open_flags & ~O_WRONLY) | O_RDWR)
-                             : (open_flags | O_RDONLY);
+                read_flag = 1;
                 stream_flags |= JANET_STREAM_READABLE;
                 break;
             case 'w':
-                open_flags = (open_flags & O_RDONLY)
-                             ? ((open_flags & ~O_RDONLY) | O_RDWR)
-                             : (open_flags | O_WRONLY);
+                write_flag = 1;
                 stream_flags |= JANET_STREAM_WRITABLE;
                 break;
             case 'c':
@@ -2186,6 +2171,15 @@ JANET_CORE_FN(os_open,
                 break;
         }
     }
+    /* If both read and write, fix up to O_RDWR */
+    if (read_flag && !write_flag) {
+        open_flags |= O_RDONLY;
+    } else if (write_flag && !read_flag) {
+        open_flags |= O_WRONLY;
+    } else {
+        open_flags = O_RDWR;
+    }
+
     do {
         fd = open(path, open_flags, mode);
     } while (fd == -1 && errno == EINTR);

src/core/parse.c

@@ -1,5 +1,5 @@
 /*
-* Copyright (c) 2022 Calvin Rose
+* Copyright (c) 2023 Calvin Rose
 *
 * Permission is hereby granted, free of charge, to any person obtaining a copy
 * of this software and associated documentation files (the "Software"), to
@@ -206,6 +206,37 @@ static void popstate(JanetParser *p, Janet val) {
     }
 }
 
+static void delim_error(JanetParser *parser, size_t stack_index, char c, const char *msg) {
+    JanetParseState *s = parser->states + stack_index;
+    JanetBuffer *buffer = janet_buffer(40);
+    if (msg) {
+        janet_buffer_push_cstring(buffer, msg);
+    }
+    if (c) {
+        janet_buffer_push_u8(buffer, c);
+    }
+    if (stack_index > 0) {
+        janet_buffer_push_cstring(buffer, ", ");
+        if (s->flags & PFLAG_PARENS) {
+            janet_buffer_push_u8(buffer, '(');
+        } else if (s->flags & PFLAG_SQRBRACKETS) {
+            janet_buffer_push_u8(buffer, '[');
+        } else if (s->flags & PFLAG_CURLYBRACKETS) {
+            janet_buffer_push_u8(buffer, '{');
+        } else if (s->flags & PFLAG_STRING) {
+            janet_buffer_push_u8(buffer, '"');
+        } else if (s->flags & PFLAG_LONGSTRING) {
+            int32_t i;
+            for (i = 0; i < s->argn; i++) {
+                janet_buffer_push_u8(buffer, '`');
+            }
+        }
+        janet_formatb(buffer, " opened at line %d, column %d", s->line, s->column);
+    }
+    parser->error = (const char *) janet_string(buffer->data, buffer->count);
+    parser->flag |= JANET_PARSER_GENERATED_ERROR;
+}
+
 static int checkescape(uint8_t c) {
     switch (c) {
         default:
@@ -612,7 +643,7 @@ static int root(JanetParser *p, JanetParseState *state, uint8_t c) {
         case '}': {
             Janet ds;
             if (p->statecount == 1) {
-                p->error = "unexpected delimiter";
+                delim_error(p, 0, c, "unexpected closing delimiter ");
                 return 1;
             }
             if ((c == ')' && (state->flags & PFLAG_PARENS)) ||
@@ -633,7 +664,7 @@ static int root(JanetParser *p, JanetParseState *state, uint8_t c) {
                     ds = close_struct(p, state);
                 }
             } else {
-                p->error = "mismatched delimiter";
+                delim_error(p, p->statecount - 1, c, "mismatched delimiter ");
                 return 1;
             }
             popstate(p, ds);
@@ -684,26 +715,7 @@ void janet_parser_eof(JanetParser *parser) {
     size_t oldline = parser->line;
     janet_parser_consume(parser, '\n');
     if (parser->statecount > 1) {
-        JanetParseState *s = parser->states + (parser->statecount - 1);
-        JanetBuffer *buffer = janet_buffer(40);
-        janet_buffer_push_cstring(buffer, "unexpected end of source, ");
-        if (s->flags & PFLAG_PARENS) {
-            janet_buffer_push_u8(buffer, '(');
-        } else if (s->flags & PFLAG_SQRBRACKETS) {
-            janet_buffer_push_u8(buffer, '[');
-        } else if (s->flags & PFLAG_CURLYBRACKETS) {
-            janet_buffer_push_u8(buffer, '{');
-        } else if (s->flags & PFLAG_STRING) {
-            janet_buffer_push_u8(buffer, '"');
-        } else if (s->flags & PFLAG_LONGSTRING) {
-            int32_t i;
-            for (i = 0; i < s->argn; i++) {
-                janet_buffer_push_u8(buffer, '`');
-            }
-        }
-        janet_formatb(buffer, " opened at line %d, column %d", s->line, s->column);
-        parser->error = (const char *) janet_string(buffer->data, buffer->count);
-        parser->flag |= JANET_PARSER_GENERATED_ERROR;
+        delim_error(parser, parser->statecount - 1, 0, "unexpected end of source");
     }
     parser->line = oldline;
     parser->column = oldcolumn;

src/core/peg.c

@@ -1,5 +1,5 @@
 /*
-* Copyright (c) 2022 Calvin Rose
+* Copyright (c) 2023 Calvin Rose
 *
 * Permission is hereby granted, free of charge, to any person obtaining a copy
 * of this software and associated documentation files (the "Software"), to
@@ -211,9 +211,10 @@ tail:
         }
 
         case RULE_SET: {
+            if (text >= s->text_end) return NULL;
             uint32_t word = rule[1 + (text[0] >> 5)];
             uint32_t mask = (uint32_t)1 << (text[0] & 0x1F);
-            return (text < s->text_end && (word & mask))
+            return (word & mask)
                    ? text + 1
                    : NULL;
         }
@@ -260,30 +261,52 @@ tail:
             goto tail;
         }
 
-        case RULE_IF:
-        case RULE_IFNOT: {
+        case RULE_IF: {
             const uint32_t *rule_a = s->bytecode + rule[1];
             const uint32_t *rule_b = s->bytecode + rule[2];
             down1(s);
             const uint8_t *result = peg_rule(s, rule_a, text);
             up1(s);
-            if (rule[0] == RULE_IF ? !result : !!result) return NULL;
+            if (!result) return NULL;
             rule = rule_b;
             goto tail;
         }
+        case RULE_IFNOT: {
+            const uint32_t *rule_a = s->bytecode + rule[1];
+            const uint32_t *rule_b = s->bytecode + rule[2];
+            down1(s);
+            CapState cs = cap_save(s);
+            const uint8_t *result = peg_rule(s, rule_a, text);
+            if (!!result) {
+                up1(s);
+                return NULL;
+            } else {
+                cap_load(s, cs);
+                up1(s);
+                rule = rule_b;
+                goto tail;
+            }
+        }
 
         case RULE_NOT: {
             const uint32_t *rule_a = s->bytecode + rule[1];
             down1(s);
+            CapState cs = cap_save(s);
             const uint8_t *result = peg_rule(s, rule_a, text);
-            up1(s);
-            return (result) ? NULL : text;
+            if (result) {
+                up1(s);
+                return NULL;
+            } else {
+                cap_load(s, cs);
+                up1(s);
+                return text;
+            }
         }
 
         case RULE_THRU:
         case RULE_TO: {
             const uint32_t *rule_a = s->bytecode + rule[1];
-            const uint8_t *next_text;
+            const uint8_t *next_text = NULL;
             CapState cs = cap_save(s);
             down1(s);
             while (text <= s->text_end) {
@@ -1661,7 +1684,9 @@ static PegCall peg_cfun_init(int32_t argc, Janet *argv, int get_replace) {
 }
 
 static void peg_call_reset(PegCall *c) {
+    c->s.depth = JANET_RECURSION_GUARD;
     c->s.captures->count = 0;
+    c->s.tagged_captures->count = 0;
     c->s.scratch->count = 0;
     c->s.tags->count = 0;
 }

src/core/pp.c

@@ -1,5 +1,5 @@
 /*
-* Copyright (c) 2022 Calvin Rose
+* Copyright (c) 2023 Calvin Rose
 *
 * Permission is hereby granted, free of charge, to any person obtaining a copy
 * of this software and associated documentation files (the "Software"), to
@@ -30,6 +30,7 @@
 
 #include <string.h>
 #include <ctype.h>
+#include <inttypes.h>
 
 /* Implements a pretty printer for Janet. The pretty printer
  * is simple and not that flexible, but fast. */
@@ -750,20 +751,46 @@ static void pushtypes(JanetBuffer *buffer, int types) {
 
 #define MAX_ITEM  256
 #define FMT_FLAGS "-+ #0"
+#define FMT_REPLACE_INTTYPES "diouxX"
 #define MAX_FORMAT 32
 
+struct FmtMapping {
+    char c;
+    const char *mapping;
+};
+
+/* Janet uses fixed width integer types for most things, so map
+ * format specifiers to these fixed sizes */
+static const struct FmtMapping format_mappings[] = {
+    {'d', PRId64},
+    {'i', PRIi64},
+    {'o', PRIo64},
+    {'u', PRIu64},
+    {'x', PRIx64},
+    {'X', PRIX64},
+};
+
+static const char *get_fmt_mapping(char c) {
+    for (size_t i = 0; i < (sizeof(format_mappings) / sizeof(struct FmtMapping)); i++) {
+        if (format_mappings[i].c == c)
+            return format_mappings[i].mapping;
+    }
+    return NULL;
+}
+
 static const char *scanformat(
     const char *strfrmt,
     char *form,
     char width[3],
     char precision[3]) {
     const char *p = strfrmt;
+
+    /* Parse strfrmt */
     memset(width, '\0', 3);
     memset(precision, '\0', 3);
     while (*p != '\0' && strchr(FMT_FLAGS, *p) != NULL)
         p++; /* skip flags */
-    if ((size_t)(p - strfrmt) >= sizeof(FMT_FLAGS) / sizeof(char))
-        janet_panic("invalid format (repeated flags)");
+    if ((size_t)(p - strfrmt) >= sizeof(FMT_FLAGS)) janet_panic("invalid format (repeated flags)");
     if (isdigit((int)(*p)))
         width[0] = *p++; /* skip width */
     if (isdigit((int)(*p)))
@@ -777,10 +804,22 @@ static const char *scanformat(
     }
     if (isdigit((int)(*p)))
         janet_panic("invalid format (width or precision too long)");
+
+    /* Write to form - replace characters with fixed size stuff */
     *(form++) = '%';
-    memcpy(form, strfrmt, ((p - strfrmt) + 1) * sizeof(char));
-    form += (p - strfrmt) + 1;
+    const char *p2 = strfrmt;
+    while (p2 <= p) {
+        if (strchr(FMT_REPLACE_INTTYPES, *p2) != NULL) {
+            const char *mapping = get_fmt_mapping(*p2++);
+            size_t len = strlen(mapping);
+            strcpy(form, mapping);
+            form += len;
+        } else {
+            *(form++) = *(p2++);
+        }
+    }
     *form = '\0';
+
     return p;
 }
 
@@ -805,11 +844,16 @@ void janet_formatbv(JanetBuffer *b, const char *format, va_list args) {
                     break;
                 }
                 case 'd':
-                case 'i':
-                case 'o':
+                case 'i': {
+                    int64_t n = va_arg(args, long);
+                    nb = snprintf(item, MAX_ITEM, form, n);
+                    break;
+                }
                 case 'x':
-                case 'X': {
-                    int32_t n = va_arg(args, long);
+                case 'X':
+                case 'o':
+                case 'u': {
+                    uint64_t n = va_arg(args, unsigned long);
                     nb = snprintf(item, MAX_ITEM, form, n);
                     break;
                 }
@@ -963,11 +1007,16 @@ void janet_buffer_format(
                     break;
                 }
                 case 'd':
-                case 'i':
-                case 'o':
+                case 'i': {
+                    int64_t n = janet_getinteger64(argv, arg);
+                    nb = snprintf(item, MAX_ITEM, form, n);
+                    break;
+                }
                 case 'x':
-                case 'X': {
-                    int32_t n = janet_getinteger(argv, arg);
+                case 'X':
+                case 'o':
+                case 'u': {
+                    uint64_t n = janet_getuinteger64(argv, arg);
                     nb = snprintf(item, MAX_ITEM, form, n);
                     break;
                 }

src/core/regalloc.c

@@ -1,5 +1,5 @@
 /*
-* Copyright (c) 2022 Calvin Rose
+* Copyright (c) 2023 Calvin Rose
 *
 * Permission is hereby granted, free of charge, to any person obtaining a copy
 * of this software and associated documentation files (the "Software"), to

src/core/regalloc.h

@@ -1,5 +1,5 @@
 /*
-* Copyright (c) 2022 Calvin Rose
+* Copyright (c) 2023 Calvin Rose
 *
 * Permission is hereby granted, free of charge, to any person obtaining a copy
 * of this software and associated documentation files (the "Software"), to

src/core/run.c

@@ -1,5 +1,5 @@
 /*
-* Copyright (c) 2022 Calvin Rose
+* Copyright (c) 2023 Calvin Rose
 *
 * Permission is hereby granted, free of charge, to any person obtaining a copy
 * of this software and associated documentation files (the "Software"), to
@@ -80,9 +80,9 @@ int janet_dobytes(JanetTable *env, const uint8_t *bytes, int32_t len, const char
                 const char *e = janet_parser_error(&parser);
                 errflags |= 0x04;
                 ret = janet_cstringv(e);
-                size_t line = parser.line;
-                size_t col = parser.column;
-                janet_eprintf("%s:%lu:%lu: parse error: %s\n", sourcePath, line, col, e);
+                int32_t line = (int32_t) parser.line;
+                int32_t col = (int32_t) parser.column;
+                janet_eprintf("%s:%d:%d: parse error: %s\n", sourcePath, line, col, e);
                 done = 1;
                 break;
             }

src/core/specials.c

@@ -1,5 +1,5 @@
 /*
-* Copyright (c) 2022 Calvin Rose
+* Copyright (c) 2023 Calvin Rose
 *
 * Permission is hereby granted, free of charge, to any person obtaining a copy
 * of this software and associated documentation files (the "Software"), to
@@ -813,7 +813,7 @@ static JanetSlot janetc_fn(JanetFopts opts, int32_t argn, const Janet *argv) {
     JanetSlot ret;
     Janet head;
     JanetScope fnscope;
-    int32_t paramcount, argi, parami, arity, min_arity, max_arity, defindex, i;
+    int32_t paramcount, argi, parami, arity, min_arity = 0, max_arity, defindex, i;
     JanetFopts subopts = janetc_fopts_default(c);
     const Janet *params;
     const char *errmsg = NULL;

src/core/state.c

@@ -1,5 +1,5 @@
 /*
-* Copyright (c) 2022 Calvin Rose
+* Copyright (c) 2023 Calvin Rose
 *
 * Permission is hereby granted, free of charge, to any person obtaining a copy
 * of this software and associated documentation files (the "Software"), to

src/core/state.h

@@ -1,5 +1,5 @@
 /*
-* Copyright (c) 2022 Calvin Rose
+* Copyright (c) 2023 Calvin Rose
 *
 * Permission is hereby granted, free of charge, to any person obtaining a copy
 * of this software and associated documentation files (the "Software"), to
@@ -25,6 +25,12 @@
 
 #include <stdint.h>
 
+#ifdef JANET_EV
+#ifndef JANET_WINDOWS
+#include <pthread.h>
+#endif
+#endif
+
 typedef int64_t JanetTimestamp;
 
 typedef struct JanetScratch {
@@ -152,16 +158,19 @@ struct JanetVM {
 #ifdef JANET_WINDOWS
     void **iocp;
 #elif defined(JANET_EV_EPOLL)
+    pthread_attr_t new_thread_attr;
     JanetHandle selfpipe[2];
     int epoll;
     int timerfd;
     int timer_enabled;
 #elif defined(JANET_EV_KQUEUE)
+    pthread_attr_t new_thread_attr;
     JanetHandle selfpipe[2];
     int kq;
     int timer;
     int timer_enabled;
 #else
+    pthread_attr_t new_thread_attr;
     JanetHandle selfpipe[2];
     struct pollfd *fds;
 #endif

src/core/string.c

@@ -1,5 +1,5 @@
 /*
-* Copyright (c) 2022 Calvin Rose
+* Copyright (c) 2023 Calvin Rose
 *
 * Permission is hereby granted, free of charge, to any person obtaining a copy
 * of this software and associated documentation files (the "Software"), to
@@ -530,7 +530,7 @@ JANET_CORE_FN(cfun_string_join,
 
 JANET_CORE_FN(cfun_string_format,
               "(string/format format & values)",
-              "Similar to `snprintf`, but specialized for operating with Janet values. Returns "
+              "Similar to C's `snprintf`, but specialized for operating with Janet values. Returns "
               "a new string.") {
     janet_arity(argc, 1, -1);
     JanetBuffer *buffer = janet_buffer(0);

src/core/strtod.c

@@ -1,5 +1,5 @@
 /*
-* Copyright (c) 2022 Calvin Rose
+* Copyright (c) 2023 Calvin Rose
 *
 * Permission is hereby granted, free of charge, to any person obtaining a copy
 * of this software and associated documentation files (the "Software"), to

src/core/struct.c

@@ -1,5 +1,5 @@
 /*
-* Copyright (c) 2022 Calvin Rose
+* Copyright (c) 2023 Calvin Rose
 *
 * Permission is hereby granted, free of charge, to any person obtaining a copy
 * of this software and associated documentation files (the "Software"), to

src/core/symcache.c

@@ -1,5 +1,5 @@
 /*
-* Copyright (c) 2022 Calvin Rose
+* Copyright (c) 2023 Calvin Rose
 *
 * Permission is hereby granted, free of charge, to any person obtaining a copy
 * of this software and associated documentation files (the "Software"), to

src/core/symcache.h

@@ -1,5 +1,5 @@
 /*
-* Copyright (c) 2022 Calvin Rose
+* Copyright (c) 2023 Calvin Rose
 *
 * Permission is hereby granted, free of charge, to any person obtaining a copy
 * of this software and associated documentation files (the "Software"), to

src/core/table.c

@@ -1,5 +1,5 @@
 /*
-* Copyright (c) 2022 Calvin Rose
+* Copyright (c) 2023 Calvin Rose
 *
 * Permission is hereby granted, free of charge, to any person obtaining a copy
 * of this software and associated documentation files (the "Software"), to

src/core/tuple.c

@@ -1,5 +1,5 @@
 /*
-* Copyright (c) 2022 Calvin Rose
+* Copyright (c) 2023 Calvin Rose
 *
 * Permission is hereby granted, free of charge, to any person obtaining a copy
 * of this software and associated documentation files (the "Software"), to

src/core/util.c

@@ -1,5 +1,5 @@
 /*
-* Copyright (c) 2022 Calvin Rose
+* Copyright (c) 2023 Calvin Rose
 *
 * Permission is hereby granted, free of charge, to any person obtaining a copy
 * of this software and associated documentation files (the "Software"), to
@@ -36,6 +36,13 @@
 #endif
 #endif
 
+#ifdef JANET_WINDOWS
+#ifdef JANET_DYNAMIC_MODULES
+#include <psapi.h>
+#pragma comment (lib, "Psapi.lib")
+#endif
+#endif
+
 #ifdef JANET_APPLE
 #include <AvailabilityMacros.h>
 #endif
@@ -694,15 +701,25 @@ int janet_indexed_view(Janet seq, const Janet **data, int32_t *len) {
 /* Read both strings and buffer as unsigned character array + int32_t len.
  * Returns 1 if the view can be constructed and 0 if the type is invalid. */
 int janet_bytes_view(Janet str, const uint8_t **data, int32_t *len) {
-    if (janet_checktype(str, JANET_STRING) || janet_checktype(str, JANET_SYMBOL) ||
-            janet_checktype(str, JANET_KEYWORD)) {
+    JanetType t = janet_type(str);
+    if (t == JANET_STRING || t == JANET_SYMBOL || t == JANET_KEYWORD) {
         *data = janet_unwrap_string(str);
         *len = janet_string_length(janet_unwrap_string(str));
         return 1;
-    } else if (janet_checktype(str, JANET_BUFFER)) {
+    } else if (t == JANET_BUFFER) {
         *data = janet_unwrap_buffer(str)->data;
         *len = janet_unwrap_buffer(str)->count;
         return 1;
+    } else if (t == JANET_ABSTRACT) {
+        void *abst = janet_unwrap_abstract(str);
+        const JanetAbstractType *atype = janet_abstract_type(abst);
+        if (NULL == atype->bytes) {
+            return 0;
+        }
+        JanetByteView view = atype->bytes(abst, janet_abstract_size(abst));
+        *data = view.bytes;
+        *len = view.len;
+        return 1;
     }
     return 0;
 }
@@ -904,6 +921,7 @@ char *get_processed_name(const char *name) {
 }
 
 #if defined(JANET_WINDOWS)
+
 static char error_clib_buf[256];
 char *error_clib(void) {
     FormatMessageA(FORMAT_MESSAGE_FROM_SYSTEM | FORMAT_MESSAGE_IGNORE_INSERTS,
@@ -920,6 +938,35 @@ Clib load_clib(const char *name) {
         return LoadLibrary(name);
     }
 }
+
+void free_clib(HINSTANCE clib) {
+    if (clib != GetModuleHandle(NULL)) {
+        FreeLibrary(clib);
+    }
+}
+
+void *symbol_clib(HINSTANCE clib, const char *sym) {
+    if (clib != GetModuleHandle(NULL)) {
+        return GetProcAddress(clib, sym);
+    } else {
+        /* Look up symbols from all loaded modules */
+        HMODULE hMods[1024];
+        DWORD needed = 0;
+        if (EnumProcessModules(GetCurrentProcess(), hMods, sizeof(hMods), &needed)) {
+            needed /= sizeof(HMODULE);
+            for (DWORD i = 0; i < needed; i++) {
+                void *address = GetProcAddress(hMods[i], sym);
+                if (NULL != address) {
+                    return address;
+                }
+            }
+        } else {
+            janet_panicf("ffi: %s", error_clib());
+        }
+        return NULL;
+    }
+}
+
 #endif
 
 /* Alloc function macro fills */

src/core/util.h

@@ -1,5 +1,5 @@
 /*
-* Copyright (c) 2022 Calvin Rose
+* Copyright (c) 2023 Calvin Rose
 *
 * Permission is hereby granted, free of charge, to any person obtaining a copy
 * of this software and associated documentation files (the "Software"), to
@@ -140,8 +140,8 @@ typedef int Clib;
 #elif defined(JANET_WINDOWS)
 #include <windows.h>
 typedef HINSTANCE Clib;
-#define free_clib(c) FreeLibrary((c))
-#define symbol_clib(lib, sym) GetProcAddress((lib), (sym))
+void *symbol_clib(Clib clib, const char *sym);
+void free_clib(Clib clib);
 Clib load_clib(const char *name);
 char *error_clib(void);
 #else

src/core/value.c

@@ -1,5 +1,5 @@
 /*
-* Copyright (c) 2022 Calvin Rose
+* Copyright (c) 2023 Calvin Rose
 *
 * Permission is hereby granted, free of charge, to any person obtaining a copy
 * of this software and associated documentation files (the "Software"), to
@@ -295,6 +295,15 @@ int janet_equals(Janet x, Janet y) {
     return 1;
 }
 
+static uint64_t murmur64(uint64_t h) {
+    h ^= h >> 33;
+    h *= 0xff51afd7ed558ccdUL;
+    h ^= h >> 33;
+    h *= 0xc4ceb9fe1a85ec53UL;
+    h ^= h >> 33;
+    return h;
+}
+
 /* Computes a hash value for a function */
 int32_t janet_hash(Janet x) {
     int32_t hash = 0;
@@ -341,14 +350,11 @@ int32_t janet_hash(Janet x) {
         default:
             if (sizeof(double) == sizeof(void *)) {
                 /* Assuming 8 byte pointer (8 byte aligned) */
-                uint64_t i = janet_u64(x);
-                uint32_t lo = (uint32_t)(i & 0xFFFFFFFF);
-                uint32_t hi = (uint32_t)(i >> 32);
-                uint32_t hilo = (hi ^ lo) * 2654435769u;
-                hash = (int32_t)((hilo << 16) | (hilo >> 16));
+                uint64_t i = murmur64(janet_u64(x));
+                hash = (int32_t)(i >> 32);
             } else {
                 /* Assuming 4 byte pointer (or smaller) */
-                ptrdiff_t diff = ((char *)janet_unwrap_pointer(x) - (char *)0);
+                uintptr_t diff = (uintptr_t) janet_unwrap_pointer(x);
                 uint32_t hilo = (uint32_t) diff * 2654435769u;
                 hash = (int32_t)((hilo << 16) | (hilo >> 16));
             }
@@ -645,6 +651,15 @@ int32_t janet_length(Janet x) {
         case JANET_TABLE:
             return janet_unwrap_table(x)->count;
         case JANET_ABSTRACT: {
+            void *abst = janet_unwrap_abstract(x);
+            const JanetAbstractType *type = janet_abstract_type(abst);
+            if (type->length != NULL) {
+                size_t len = type->length(abst, janet_abstract_size(abst));
+                if (len > INT32_MAX) {
+                    janet_panicf("invalid integer length %u", len);
+                }
+                return (int32_t)(len);
+            }
             Janet argv[1] = { x };
             Janet len = janet_mcall("length", 1, argv);
             if (!janet_checkint(len))
@@ -673,6 +688,16 @@ Janet janet_lengthv(Janet x) {
         case JANET_TABLE:
             return janet_wrap_integer(janet_unwrap_table(x)->count);
         case JANET_ABSTRACT: {
+            void *abst = janet_unwrap_abstract(x);
+            const JanetAbstractType *type = janet_abstract_type(abst);
+            if (type->length != NULL) {
+                size_t len = type->length(abst, janet_abstract_size(abst));
+                if ((uint64_t) len <= (uint64_t) JANET_INTMAX_INT64) {
+                    return janet_wrap_number((double) len);
+                } else {
+                    janet_panicf("integer length %u too large", len);
+                }
+            }
             Janet argv[1] = { x };
             return janet_mcall("length", 1, argv);
         }

src/core/vector.c

@@ -1,5 +1,5 @@
 /*
-* Copyright (c) 2022 Calvin Rose
+* Copyright (c) 2023 Calvin Rose
 *
 * Permission is hereby granted, free of charge, to any person obtaining a copy
 * of this software and associated documentation files (the "Software"), to

src/core/vector.h

@@ -1,5 +1,5 @@
 /*
-* Copyright (c) 2022 Calvin Rose
+* Copyright (c) 2023 Calvin Rose
 *
 * Permission is hereby granted, free of charge, to any person obtaining a copy
 * of this software and associated documentation files (the "Software"), to

src/core/vm.c

@@ -1,5 +1,5 @@
 /*
-* Copyright (c) 2022 Calvin Rose
+* Copyright (c) 2023 Calvin Rose
 *
 * Permission is hereby granted, free of charge, to any person obtaining a copy
 * of this software and associated documentation files (the "Software"), to
@@ -220,14 +220,14 @@
 /* Trace a function call */
 static void vm_do_trace(JanetFunction *func, int32_t argc, const Janet *argv) {
     if (func->def->name) {
-        janet_printf("trace (%S", func->def->name);
+        janet_eprintf("trace (%S", func->def->name);
     } else {
-        janet_printf("trace (%p", janet_wrap_function(func));
+        janet_eprintf("trace (%p", janet_wrap_function(func));
     }
     for (int32_t i = 0; i < argc; i++) {
-        janet_printf(" %p", argv[i]);
+        janet_eprintf(" %p", argv[i]);
     }
-    janet_printf(")\n");
+    janet_eprintf(")\n");
 }
 
 /* Invoke a method once we have looked it up */
@@ -1285,6 +1285,12 @@ JanetSignal janet_step(JanetFiber *fiber, Janet in, Janet *out) {
     return signal;
 }
 
+static Janet void_cfunction(int32_t argc, Janet *argv) {
+    (void) argc;
+    (void) argv;
+    janet_panic("placeholder");
+}
+
 Janet janet_call(JanetFunction *fun, int32_t argc, const Janet *argv) {
     /* Check entry conditions */
     if (!janet_vm.fiber)
@@ -1292,9 +1298,17 @@ Janet janet_call(JanetFunction *fun, int32_t argc, const Janet *argv) {
     if (janet_vm.stackn >= JANET_RECURSION_GUARD)
         janet_panic("C stack recursed too deeply");
 
+    /* Dirty stack */
+    int32_t dirty_stack = janet_vm.fiber->stacktop - janet_vm.fiber->stackstart;
+    if (dirty_stack) {
+        janet_fiber_cframe(janet_vm.fiber, void_cfunction);
+    }
+
     /* Tracing */
     if (fun->gc.flags & JANET_FUNCFLAG_TRACE) {
+        janet_vm.stackn++;
         vm_do_trace(fun, argc, argv);
+        janet_vm.stackn--;
     }
 
     /* Push frame */
@@ -1322,6 +1336,10 @@ Janet janet_call(JanetFunction *fun, int32_t argc, const Janet *argv) {
     /* Teardown */
     janet_vm.stackn = oldn;
     janet_gcunlock(handle);
+    if (dirty_stack) {
+        janet_fiber_popframe(janet_vm.fiber);
+        janet_vm.fiber->stacktop += dirty_stack;
+    }
 
     if (signal != JANET_SIGNAL_OK) {
         janet_panicv(*janet_vm.return_reg);

src/core/wrap.c

@@ -1,5 +1,5 @@
 /*
-* Copyright (c) 2022 Calvin Rose
+* Copyright (c) 2023 Calvin Rose
 *
 * Permission is hereby granted, free of charge, to any person obtaining a copy
 * of this software and associated documentation files (the "Software"), to

src/include/janet.h

@@ -1,5 +1,5 @@
 /*
-* Copyright (c) 2022 Calvin Rose
+* Copyright (c) 2023 Calvin Rose
 *
 * Permission is hereby granted, free of charge, to any person obtaining a copy
 * of this software and associated documentation files (the "Software"), to
@@ -164,13 +164,20 @@ extern "C" {
 #endif
 
 /* Enable or disable the FFI library. Currently, FFI only enabled on
- * x86-64, non-windows operating systems. */
+ * x86-64 operating systems. */
 #ifndef JANET_NO_FFI
-#if !defined(JANET_WINDOWS) && !defined(__EMSCRIPTEN__) && (defined(__x86_64__) || defined(_M_X64))
+#if !defined(__EMSCRIPTEN__) && (defined(__x86_64__) || defined(_M_X64))
 #define JANET_FFI
 #endif
 #endif
 
+/* If FFI is enabled and FFI-JIT is not disabled... */
+#ifdef JANET_FFI
+#ifndef JANET_NO_FFI_JIT
+#define JANET_FFI_JIT
+#endif
+#endif
+
 /* Enable or disable the assembler. Enabled by default. */
 #ifndef JANET_NO_ASSEMBLER
 #define JANET_ASSEMBLER
@@ -236,7 +243,7 @@ extern "C" {
 /* Maximum depth to follow table prototypes before giving up and returning nil. */
 #define JANET_MAX_PROTO_DEPTH 200
 
-/* Maximum depth to follow table prototypes before giving up and returning nil. */
+/* Prevent macros to expand too deeply and error out. */
 #define JANET_MAX_MACRO_EXPAND 200
 
 /* Define default max stack size for stacks before raising a stack overflow error.
@@ -1093,6 +1100,8 @@ struct JanetAbstractType {
     int32_t (*hash)(void *p, size_t len);
     Janet(*next)(void *p, Janet key);
     Janet(*call)(void *p, int32_t argc, Janet *argv);
+    size_t (*length)(void *p, size_t len);
+    JanetByteView(*bytes)(void *p, size_t len);
 };
 
 /* Some macros to let us add extra types to JanetAbstract types without
@@ -1110,7 +1119,9 @@ struct JanetAbstractType {
 #define JANET_ATEND_COMPARE     NULL,JANET_ATEND_HASH
 #define JANET_ATEND_HASH        NULL,JANET_ATEND_NEXT
 #define JANET_ATEND_NEXT        NULL,JANET_ATEND_CALL
-#define JANET_ATEND_CALL
+#define JANET_ATEND_CALL        NULL,JANET_ATEND_LENGTH
+#define JANET_ATEND_LENGTH      NULL,JANET_ATEND_BYTES
+#define JANET_ATEND_BYTES
 
 struct JanetReg {
     const char *name;
@@ -1671,6 +1682,7 @@ JANET_API JanetModule janet_native(const char *name, JanetString *error);
 
 /* Marshaling */
 #define JANET_MARSHAL_UNSAFE 0x20000
+#define JANET_MARSHAL_NO_CYCLES 0x40000
 
 JANET_API void janet_marshal(
     JanetBuffer *buf,

src/mainclient/shell.c

@@ -1,5 +1,5 @@
 /*
-* Copyright (c) 2022 Calvin Rose
+* Copyright (c) 2023 Calvin Rose
 *
 * Permission is hereby granted, free of charge, to any person obtaining a copy
 * of this software and associated documentation files (the "Software"), to
@@ -87,8 +87,30 @@ static void simpleline(JanetBuffer *buffer) {
     }
 }
 
-/* Windows */
-#if defined(JANET_WINDOWS) || defined(JANET_SIMPLE_GETLINE)
+/* State */
+
+#ifndef JANET_SIMPLE_GETLINE
+/* static state */
+#define JANET_LINE_MAX 1024
+#define JANET_MATCH_MAX 256
+#define JANET_HISTORY_MAX 100
+static JANET_THREAD_LOCAL int gbl_israwmode = 0;
+static JANET_THREAD_LOCAL const char *gbl_prompt = "> ";
+static JANET_THREAD_LOCAL int gbl_plen = 2;
+static JANET_THREAD_LOCAL char gbl_buf[JANET_LINE_MAX];
+static JANET_THREAD_LOCAL int gbl_len = 0;
+static JANET_THREAD_LOCAL int gbl_pos = 0;
+static JANET_THREAD_LOCAL int gbl_cols = 80;
+static JANET_THREAD_LOCAL char *gbl_history[JANET_HISTORY_MAX];
+static JANET_THREAD_LOCAL int gbl_history_count = 0;
+static JANET_THREAD_LOCAL int gbl_historyi = 0;
+static JANET_THREAD_LOCAL JanetByteView gbl_matches[JANET_MATCH_MAX];
+static JANET_THREAD_LOCAL int gbl_match_count = 0;
+static JANET_THREAD_LOCAL int gbl_lines_below = 0;
+#endif
+
+/* Fallback */
+#if defined(JANET_SIMPLE_GETLINE)
 
 void janet_line_init() {
     ;
@@ -105,6 +127,80 @@ void janet_line_get(const char *p, JanetBuffer *buffer) {
     simpleline(buffer);
 }
 
+/* Rich implementation */
+#else
+
+/* Windows */
+#ifdef _WIN32
+
+#include <stdbool.h>
+#include <stdio.h>
+#include <stdlib.h>
+#include <io.h>
+
+static void setup_console_output(void) {
+    /* Enable color console on windows 10 console and utf8 output and other processing */
+    HANDLE hOut = GetStdHandle(STD_OUTPUT_HANDLE);
+    DWORD dwMode = 0;
+    GetConsoleMode(hOut, &dwMode);
+    dwMode |= ENABLE_VIRTUAL_TERMINAL_PROCESSING;
+    SetConsoleMode(hOut, dwMode);
+    SetConsoleOutputCP(65001);
+}
+
+/* Ansi terminal raw mode */
+static int rawmode(void) {
+    if (gbl_israwmode) return 0;
+    HANDLE hOut = GetStdHandle(STD_INPUT_HANDLE);
+    DWORD dwMode = 0;
+    GetConsoleMode(hOut, &dwMode);
+    dwMode &= ~ENABLE_LINE_INPUT;
+    dwMode &= ~ENABLE_INSERT_MODE;
+    dwMode &= ~ENABLE_ECHO_INPUT;
+    dwMode |= ENABLE_VIRTUAL_TERMINAL_INPUT;
+    dwMode &= ~ENABLE_PROCESSED_INPUT;
+    if (!SetConsoleMode(hOut, dwMode)) return 1;
+    gbl_israwmode = 1;
+    return 0;
+}
+
+/* Disable raw mode */
+static void norawmode(void) {
+    if (!gbl_israwmode) return;
+    HANDLE hOut = GetStdHandle(STD_INPUT_HANDLE);
+    DWORD dwMode = 0;
+    GetConsoleMode(hOut, &dwMode);
+    dwMode |= ENABLE_LINE_INPUT;
+    dwMode |= ENABLE_INSERT_MODE;
+    dwMode |= ENABLE_ECHO_INPUT;
+    dwMode &= ~ENABLE_VIRTUAL_TERMINAL_INPUT;
+    dwMode |= ENABLE_PROCESSED_INPUT;
+    SetConsoleMode(hOut, dwMode);
+    gbl_israwmode = 0;
+}
+
+static long write_console(const char *bytes, size_t n) {
+    DWORD nwritten = 0;
+    BOOL result = WriteConsole(GetStdHandle(STD_OUTPUT_HANDLE), bytes, (DWORD) n, &nwritten, NULL);
+    if (!result) return -1; /* error */
+    return (long)nwritten;
+}
+
+static long read_console(char *into, size_t n) {
+    DWORD numread;
+    BOOL result = ReadConsole(GetStdHandle(STD_INPUT_HANDLE), into, (DWORD) n, &numread, NULL);
+    if (!result) return -1; /* error */
+    return (long)numread;
+}
+
+static int check_simpleline(JanetBuffer *buffer) {
+    if (!_isatty(_fileno(stdin)) || rawmode()) {
+        simpleline(buffer);
+        return 1;
+    }
+    return 0;
+}
+
 /* Posix */
 #else
 
@@ -125,24 +221,7 @@ https://github.com/antirez/linenoise/blob/master/linenoise.c
 #include <string.h>
 #include <signal.h>
 
-/* static state */
-#define JANET_LINE_MAX 1024
-#define JANET_MATCH_MAX 256
-#define JANET_HISTORY_MAX 100
-static JANET_THREAD_LOCAL int gbl_israwmode = 0;
-static JANET_THREAD_LOCAL const char *gbl_prompt = "> ";
-static JANET_THREAD_LOCAL int gbl_plen = 2;
-static JANET_THREAD_LOCAL char gbl_buf[JANET_LINE_MAX];
-static JANET_THREAD_LOCAL int gbl_len = 0;
-static JANET_THREAD_LOCAL int gbl_pos = 0;
-static JANET_THREAD_LOCAL int gbl_cols = 80;
-static JANET_THREAD_LOCAL char *gbl_history[JANET_HISTORY_MAX];
-static JANET_THREAD_LOCAL int gbl_history_count = 0;
-static JANET_THREAD_LOCAL int gbl_historyi = 0;
 static JANET_THREAD_LOCAL struct termios gbl_termios_start;
-static JANET_THREAD_LOCAL JanetByteView gbl_matches[JANET_MATCH_MAX];
-static JANET_THREAD_LOCAL int gbl_match_count = 0;
-static JANET_THREAD_LOCAL int gbl_lines_below = 0;
 
 /* Unsupported terminal list from linenoise */
 static const char *badterms[] = {
@@ -152,15 +231,6 @@ static const char *badterms[] = {
     NULL
 };
 
-static char *sdup(const char *s) {
-    size_t len = strlen(s) + 1;
-    char *mem = janet_malloc(len);
-    if (!mem) {
-        return NULL;
-    }
-    return memcpy(mem, s, len);
-}
-
 /* Ansi terminal raw mode */
 static int rawmode(void) {
     struct termios t;
@@ -186,13 +256,53 @@ static void norawmode(void) {
         gbl_israwmode = 0;
 }
 
+static int checktermsupport() {
+    const char *t = getenv("TERM");
+    int i;
+    if (!t) return 1;
+    for (i = 0; badterms[i]; i++)
+        if (!strcmp(t, badterms[i])) return 0;
+    return 1;
+}
+
+static long write_console(char *bytes, size_t n) {
+    return write(STDOUT_FILENO, bytes, n);
+}
+
+static long read_console(char *into, size_t n) {
+    return read(STDIN_FILENO, into, n);
+}
+
+static int check_simpleline(JanetBuffer *buffer) {
+    if (!isatty(STDIN_FILENO) || !checktermsupport()) {
+        simpleline(buffer);
+        return 1;
+    }
+    if (rawmode()) {
+        simpleline(buffer);
+        return 1;
+    }
+    return 0;
+}
+
+#endif
+
+static char *sdup(const char *s) {
+    size_t len = strlen(s) + 1;
+    char *mem = janet_malloc(len);
+    if (!mem) {
+        return NULL;
+    }
+    return memcpy(mem, s, len);
+}
+
 static int curpos(void) {
     char buf[32];
     int cols, rows;
     unsigned int i = 0;
-    if (write(STDOUT_FILENO, "\x1b[6n", 4) != 4) return -1;
+    if (write_console("\x1b[6n", 4) != 4) return -1;
     while (i < sizeof(buf) - 1) {
-        if (read(STDIN_FILENO, buf + i, 1) != 1) break;
+        if (read_console(buf + i, 1) != 1) break;
         if (buf[i] == 'R') break;
         i++;
     }
@@ -203,18 +313,23 @@ static int curpos(void) {
 }
 
 static int getcols(void) {
+#ifdef _WIN32
+    CONSOLE_SCREEN_BUFFER_INFO csbi;
+    GetConsoleScreenBufferInfo(GetStdHandle(STD_OUTPUT_HANDLE), &csbi);
+    return (int)(csbi.srWindow.Right - csbi.srWindow.Left + 1);
+#else
     struct winsize ws;
     if (ioctl(1, TIOCGWINSZ, &ws) == -1 || ws.ws_col == 0) {
         int start, cols;
         start = curpos();
         if (start == -1) goto failed;
-        if (write(STDOUT_FILENO, "\x1b[999C", 6) != 6) goto failed;
+        if (write_console("\x1b[999C", 6) != 6) goto failed;
         cols = curpos();
         if (cols == -1) goto failed;
         if (cols > start) {
             char seq[32];
             snprintf(seq, 32, "\x1b[%dD", cols - start);
-            if (write(STDOUT_FILENO, seq, strlen(seq)) == -1) {
+            if (write_console(seq, strlen(seq)) == -1) {
                 exit(1);
             }
         }
@@ -224,10 +339,11 @@ static int getcols(void) {
     }
 failed:
     return 80;
+#endif
 }
 
 static void clear(void) {
-    if (write(STDOUT_FILENO, "\x1b[H\x1b[2J", 7) <= 0) {
+    if (write_console("\x1b[H\x1b[2J", 7) <= 0) {
         exit(1);
     }
 }
@@ -259,7 +375,7 @@ static void refresh(void) {
     /* Move cursor to original position. */
     snprintf(seq, 64, "\r\x1b[%dC", (int)(_pos + gbl_plen));
     janet_buffer_push_cstring(&b, seq);
-    if (write(STDOUT_FILENO, b.data, b.count) == -1) {
+    if (write_console((char *) b.data, b.count) == -1) {
         exit(1);
     }
     janet_buffer_deinit(&b);
@@ -285,7 +401,7 @@ static int insert(char c, int draw) {
                 if (gbl_plen + gbl_len < gbl_cols) {
                     /* Avoid a full update of the line in the
                      * trivial case. */
-                    if (write(STDOUT_FILENO, &c, 1) == -1) return -1;
+                    if (write_console(&c, 1) == -1) return -1;
                 } else {
                     refresh();
                 }
@@ -312,7 +428,7 @@ static void historymove(int delta) {
             gbl_historyi = gbl_history_count - 1;
         }
         strncpy(gbl_buf, gbl_history[gbl_historyi], JANET_LINE_MAX - 1);
-        gbl_pos = gbl_len = strlen(gbl_buf);
+        gbl_pos = gbl_len = (int) strlen(gbl_buf);
         gbl_buf[gbl_len] = '\0';
 
         refresh();
@@ -527,6 +643,7 @@ static void check_specials(JanetByteView src) {
     check_cmatch(src, "unquote");
     check_cmatch(src, "var");
     check_cmatch(src, "while");
+    check_cmatch(src, "upscope");
 }
 
 static void resolve_format(JanetTable *entry) {
@@ -740,14 +857,14 @@ static int line() {
 
     addhistory();
 
-    if (write(STDOUT_FILENO, gbl_prompt, gbl_plen) == -1) return -1;
+    if (write_console((char *) gbl_prompt, gbl_plen) == -1) return -1;
     for (;;) {
         char c;
         char seq[3];
 
         int rc;
         do {
-            rc = read(STDIN_FILENO, &c, 1);
+            rc = read_console(&c, 1);
         } while (rc < 0 && errno == EINTR);
         if (rc <= 0) return -1;
 
@@ -764,8 +881,13 @@ static int line() {
                 kleft();
                 break;
             case 3:     /* ctrl-c */
+                clearlines();
                 norawmode();
+#ifdef _WIN32
+                ExitProcess(1);
+#else
                 kill(getpid(), SIGINT);
+#endif
             /* fallthrough */
             case 17:    /* ctrl-q */
                 gbl_cancel_current_repl_form = 1;
@@ -826,23 +948,25 @@ static int line() {
             case 23: /* ctrl-w */
                 kbackspacew();
                 break;
+#ifndef _WIN32
             case 26: /* ctrl-z */
                 norawmode();
                 kill(getpid(), SIGSTOP);
                 rawmode();
                 refresh();
                 break;
+#endif
             case 27:    /* escape sequence */
                 /* Read the next two bytes representing the escape sequence.
                  * Use two calls to handle slow terminals returning the two
                  * chars at different times. */
-                if (read(STDIN_FILENO, seq, 1) == -1) break;
+                if (read_console(seq, 1) == -1) break;
                 /* Esc[ = Control Sequence Introducer (CSI) */
                 if (seq[0] == '[') {
-                    if (read(STDIN_FILENO, seq + 1, 1) == -1) break;
+                    if (read_console(seq + 1, 1) == -1) break;
                     if (seq[1] >= '0' && seq[1] <= '9') {
                         /* Extended escape, read additional byte. */
-                        if (read(STDIN_FILENO, seq + 2, 1) == -1) break;
+                        if (read_console(seq + 2, 1) == -1) break;
                         if (seq[2] == '~') {
                             switch (seq[1]) {
                                 case '1': /* Home */
@@ -861,7 +985,7 @@ static int line() {
                             }
                         }
                     } else if (seq[0] == 'O') {
-                        if (read(STDIN_FILENO, seq + 1, 1) == -1) break;
+                        if (read_console(seq + 1, 1) == -1) break;
                         switch (seq[1]) {
                             default:
                                 break;
@@ -944,28 +1068,12 @@ void janet_line_deinit() {
     gbl_historyi = 0;
 }
 
-static int checktermsupport() {
-    const char *t = getenv("TERM");
-    int i;
-    if (!t) return 1;
-    for (i = 0; badterms[i]; i++)
-        if (!strcmp(t, badterms[i])) return 0;
-    return 1;
-}
-
 void janet_line_get(const char *p, JanetBuffer *buffer) {
     gbl_prompt = p;
     buffer->count = 0;
     gbl_historyi = 0;
+    if (check_simpleline(buffer)) return;
     FILE *out = janet_dynfile("err", stderr);
-    if (!isatty(STDIN_FILENO) || !checktermsupport()) {
-        simpleline(buffer);
-        return;
-    }
-    if (rawmode()) {
-        simpleline(buffer);
-        return;
-    }
     if (line()) {
         norawmode();
         fputc('\n', out);
@@ -981,6 +1089,13 @@ void janet_line_get(const char *p, JanetBuffer *buffer) {
     replacehistory();
 }
 
+static void clear_at_exit(void) {
+    if (!gbl_israwmode) {
+        clearlines();
+        norawmode();
+    }
+}
+
 #endif
 
 /*
@@ -993,18 +1108,11 @@ int main(int argc, char **argv) {
     JanetTable *env;
 
 #ifdef _WIN32
-    /* Enable color console on windows 10 console and utf8 output. */
-    HANDLE hOut = GetStdHandle(STD_OUTPUT_HANDLE);
-    DWORD dwMode = 0;
-    GetConsoleMode(hOut, &dwMode);
-    dwMode |= ENABLE_VIRTUAL_TERMINAL_PROCESSING;
-    SetConsoleMode(hOut, dwMode);
-    SetConsoleOutputCP(65001);
+    setup_console_output();
 #endif
 
-#if !defined(JANET_WINDOWS) && !defined(JANET_SIMPLE_GETLINE)
-    /* Try and not leave the terminal in a bad state */
-    atexit(norawmode);
+#if !defined(JANET_SIMPLE_GETLINE)
+    atexit(clear_at_exit);
 #endif
 
 #if defined(JANET_PRF)

test/amalg/main.c

@@ -1,5 +1,5 @@
 /*
-* Copyright (c) 2021 Calvin Rose
+* Copyright (c) 2023 Calvin Rose
 *
 * Permission is hereby granted, free of charge, to any person obtaining a copy
 * of this software and associated documentation files (the "Software"), to

test/suite0000.janet

@@ -1,4 +1,4 @@
-# Copyright (c) 2021 Calvin Rose
+# Copyright (c) 2023 Calvin Rose
 #
 # Permission is hereby granted, free of charge, to any person obtaining a copy
 # of this software and associated documentation files (the "Software"), to

test/suite0001.janet

@@ -1,4 +1,4 @@
-# Copyright (c) 2021 Calvin Rose
+# Copyright (c) 2023 Calvin Rose
 #
 # Permission is hereby granted, free of charge, to any person obtaining a copy
 # of this software and associated documentation files (the "Software"), to

test/suite0002.janet

@@ -1,4 +1,4 @@
-# Copyright (c) 2021 Calvin Rose
+# Copyright (c) 2023 Calvin Rose
 #
 # Permission is hereby granted, free of charge, to any person obtaining a copy
 # of this software and associated documentation files (the "Software"), to

test/suite0003.janet

@@ -1,4 +1,4 @@
-# Copyright (c) 2021 Calvin Rose
+# Copyright (c) 2023 Calvin Rose
 #
 # Permission is hereby granted, free of charge, to any person obtaining a copy
 # of this software and associated documentation files (the "Software"), to

test/suite0004.janet

@@ -1,4 +1,4 @@
-# Copyright (c) 2021 Calvin Rose
+# Copyright (c) 2023 Calvin Rose
 #
 # Permission is hereby granted, free of charge, to any person obtaining a copy
 # of this software and associated documentation files (the "Software"), to

test/suite0005.janet

@@ -1,4 +1,4 @@
-# Copyright (c) 2021 Calvin Rose & contributors
+# Copyright (c) 2023 Calvin Rose & contributors
 #
 # Permission is hereby granted, free of charge, to any person obtaining a copy
 # of this software and associated documentation files (the "Software"), to

test/suite0006.janet

@@ -1,4 +1,4 @@
-# Copyright (c) 2021 Calvin Rose & contributors
+# Copyright (c) 2023 Calvin Rose & contributors
 #
 # Permission is hereby granted, free of charge, to any person obtaining a copy
 # of this software and associated documentation files (the "Software"), to

test/suite0007.janet

@@ -1,4 +1,4 @@
-# Copyright (c) 2021 Calvin Rose & contributors
+# Copyright (c) 2023 Calvin Rose & contributors
 #
 # Permission is hereby granted, free of charge, to any person obtaining a copy
 # of this software and associated documentation files (the "Software"), to

test/suite0008.janet

@@ -1,4 +1,4 @@
-# Copyright (c) 2021 Calvin Rose & contributors
+# Copyright (c) 2023 Calvin Rose & contributors
 #
 # Permission is hereby granted, free of charge, to any person obtaining a copy
 # of this software and associated documentation files (the "Software"), to

test/suite0009.janet

@@ -1,4 +1,4 @@
-# Copyright (c) 2021 Calvin Rose & contributors
+# Copyright (c) 2023 Calvin Rose & contributors
 #
 # Permission is hereby granted, free of charge, to any person obtaining a copy
 # of this software and associated documentation files (the "Software"), to
@@ -265,4 +265,15 @@
 (ev/do-thread
   (assert (ev/take ch) "channel packing bug for threaded abstracts on threaded channels."))
 
+# marshal channels
+
+(def ch (ev/chan 10))
+(ev/give ch "hello")
+(ev/give ch "world")
+(def ch2 (-> ch marshal unmarshal))
+(def item1 (ev/take ch2))
+(def item2 (ev/take ch2))
+(assert (= item1 "hello"))
+(assert (= item2 "world"))
+
 (end-suite)

test/suite0010.janet

@@ -1,4 +1,4 @@
-# Copyright (c) 2021 Calvin Rose & contributors
+# Copyright (c) 2023 Calvin Rose & contributors
 #
 # Permission is hereby granted, free of charge, to any person obtaining a copy
 # of this software and associated documentation files (the "Software"), to

test/suite0011.janet

@@ -1,4 +1,4 @@
-# Copyright (c) 2022 Calvin Rose & contributors
+# Copyright (c) 2023 Calvin Rose & contributors
 #
 # Permission is hereby granted, free of charge, to any person obtaining a copy
 # of this software and associated documentation files (the "Software"), to
@@ -93,5 +93,14 @@
 
 (assert (= 10 (named-opt-arguments 1 :a 2 :b 3 :c 4)) "named arguments 2")
 
+(let [b @""]
+  (defn dummy [a b c]
+    (+ a b c))
+  (trace dummy)
+  (defn errout [arg]
+    (buffer/push b arg))
+  (assert (= 6 (with-dyns [*err* errout] (dummy 1 2 3))) "trace to custom err function")
+  (assert (deep= @"trace (dummy 1 2 3)\n" b) "trace buffer correct"))
+
 (end-suite)
 

test/suite0012.janet

@@ -1,4 +1,4 @@
-# Copyright (c) 2022 Calvin Rose & contributors
+# Copyright (c) 2023 Calvin Rose & contributors
 #
 # Permission is hereby granted, free of charge, to any person obtaining a copy
 # of this software and associated documentation files (the "Software"), to
@@ -33,6 +33,7 @@
 # FFI check
 (compwhen has-ffi
   (ffi/context))
+
 (compwhen has-ffi
   (ffi/defbind memcpy :ptr [dest :ptr src :ptr n :size]))
 (compwhen has-ffi

test/suite0013.janet

@@ -0,0 +1,43 @@
+# Copyright (c) 2023 Calvin Rose & contributors
+#
+# Permission is hereby granted, free of charge, to any person obtaining a copy
+# of this software and associated documentation files (the "Software"), to
+# deal in the Software without restriction, including without limitation the
+# rights to use, copy, modify, merge, publish, distribute, sublicense, and/or
+# sell copies of the Software, and to permit persons to whom the Software is
+# furnished to do so, subject to the following conditions:
+#
+# The above copyright notice and this permission notice shall be included in
+# all copies or substantial portions of the Software.
+#
+# THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+# IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+# FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
+# AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
+# LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
+# FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS
+# IN THE SOFTWARE.
+
+(import ./helper :prefix "" :exit true)
+(start-suite 13)
+
+(assert (deep= (tabseq [i :in (range 3)] i (* 3 i))
+               @{0 0 1 3 2 6}))
+
+(assert (deep= (tabseq [i :in (range 3)] i)
+               @{}))
+
+(def- sym-prefix-peg
+  (peg/compile
+    ~{:symchar (+ (range "\x80\xff" "AZ" "az" "09") (set "!$%&*+-./:<?=>@^_"))
+      :anchor (drop (cmt ($) ,|(= $ 0)))
+      :cap (* (+ (> -1 (not :symchar)) :anchor) (* ($) '(some :symchar)))
+      :recur (+ :cap (> -1 :recur))
+      :main (> -1 :recur)}))
+
+(assert (deep= (peg/match sym-prefix-peg @"123" 3) @[0 "123"]) "peg lookback")
+(assert (deep= (peg/match sym-prefix-peg @"1234" 4) @[0 "1234"]) "peg lookback 2")
+
+(assert (deep= (peg/replace-all '(* (<- 1) 1 (backmatch)) "xxx" "aba cdc efa") @"xxx xxx efa") "peg replace-all 1")
+
+(end-suite)

test/suite0014.janet

@@ -0,0 +1,20 @@
+(import ./helper :prefix "" :exit true)
+(start-suite 14)
+
+(assert (deep=
+  (peg/match '(not (* (constant 7) "a")) "hello")
+  @[]) "peg not")
+
+(assert (deep=
+  (peg/match '(if-not (* (constant 7) "a") "hello") "hello")
+  @[]) "peg if-not")
+
+(assert (deep=
+  (peg/match '(if-not (drop (* (constant 7) "a")) "hello") "hello")
+  @[]) "peg if-not drop")
+
+(assert (deep=
+  (peg/match '(if (not (* (constant 7) "a")) "hello") "hello")
+  @[]) "peg if not")
+
+(end-suite)

tools/msi/janet.wxs

@@ -159,6 +159,7 @@
             <Condition>ALLUSERS=1</Condition>
             <Environment Id="PATH_PERMACHINE" Name="PATH" Value="[BinDir]" Action="set" Permanent="no" System="yes" Part="last"/>
             <Environment Id="JANET_BINPATH_PERMACHINE" Name="JANET_BINPATH" Value="[BinDir]" Action="set" Permanent="no" System="yes"/>
+            <Environment Id="JANET_MANPATH_PERMACHINE" Name="JANET_MANPATH" Value="[DocsDir]" Action="set" Permanent="no" System="yes"/>
             <Environment Id="JANET_PATH_PERMACHINE" Name="JANET_PATH" Value="[LibraryDir]" Action="set" Permanent="no" System="yes" />
             <Environment Id="JANET_HEADERPATH_PERMACHINE" Name="JANET_HEADERPATH" Value="[CDir]" Action="set" Permanent="no" System="yes"/>
             <Environment Id="JANET_LIBPATH_PERMACHINE" Name="JANET_LIBPATH" Value="[CDir]" Action="set" Permanent="no" System="yes"/>
@@ -167,6 +168,7 @@
             <Condition>NOT ALLUSERS=1</Condition>
             <Environment Id="PATH_PERUSER" Name="PATH" Value="[BinDir]" Action="set" Permanent="no" System="no" Part="last"/>
             <Environment Id="JANET_BINPATH_PERUSER" Name="JANET_BINPATH" Value="[BinDir]" Action="set" Permanent="no" System="no"/>
+            <Environment Id="JANET_MANPATH_PERUSER" Name="JANET_MANPATH" Value="[DocsDir]" Action="set" Permanent="no" System="no"/>
             <Environment Id="JANET_PATH_PERUSER" Name="JANET_PATH" Value="[LibraryDir]" Action="set" Permanent="no" System="no" />
             <Environment Id="JANET_HEADERPATH_PERUSER" Name="JANET_HEADERPATH" Value="[CDir]" Action="set" Permanent="no" System="no"/>
             <Environment Id="JANET_LIBPATH_PERUSER" Name="JANET_LIBPATH" Value="[CDir]" Action="set" Permanent="no" System="no"/>

tools/symcharsgen.c

@@ -1,5 +1,5 @@
 /*
-* Copyright (c) 2021 Calvin Rose
+* Copyright (c) 2023 Calvin Rose
 *
 * Permission is hereby granted, free of charge, to any person obtaining a copy
 * of this software and associated documentation files (the "Software"), to