Update asm.c

Upvalues are stored in the symbol slots structure as well, but
since they are always live, we repurpose the death_pc field to
refer to the environment index that we want to look at at runtime.

.github/workflows/codeql.yml

@@ -0,0 +1,41 @@
+name: "CodeQL"
+
+on:
+  push:
+    branches: [ "master" ]
+  pull_request:
+    branches: [ "master" ]
+  schedule:
+    - cron: "2 7 * * 4"
+
+jobs:
+  analyze:
+    name: Analyze
+    runs-on: ubuntu-latest
+    permissions:
+      actions: read
+      contents: read
+      security-events: write
+
+    strategy:
+      fail-fast: false
+      matrix:
+        language: [ cpp ]
+
+    steps:
+      - name: Checkout
+        uses: actions/checkout@v3
+
+      - name: Initialize CodeQL
+        uses: github/codeql-action/init@v2
+        with:
+          languages: ${{ matrix.language }}
+          queries: +security-and-quality
+
+      - name: Autobuild
+        uses: github/codeql-action/autobuild@v2
+
+      - name: Perform CodeQL Analysis
+        uses: github/codeql-action/analyze@v2
+        with:
+          category: "/language:${{ matrix.language }}"

.github/workflows/test.yml

@@ -35,3 +35,25 @@ jobs:
       - name: Test the project
         shell: cmd
         run: build_win test
+
+  test-mingw:
+    name: Build on Windows with Mingw (no test yet)
+    runs-on: windows-latest
+    defaults:
+      run:
+        shell: msys2 {0}
+    steps:
+      - name: Checkout the repository
+        uses: actions/checkout@master
+      - name: Setup Mingw
+        uses: msys2/setup-msys2@v2
+        with:
+          msystem: UCRT64
+          update: true
+          install: >-
+            base-devel
+            git
+            gcc
+      - name: Build the project
+        shell: cmd
+        run: make -j CC=gcc

.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,14 +1,52 @@
 # Changelog
 All notable changes to this project will be documented in this file.
 
-## 1.23.1 - ???
+## ??? - Unreleased
+- Add build-time detection for cygwin.
+
+## 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 autocompletion and
+- 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, supverisor messages over threaded channels would be from ambiguous threads/fibers.
+  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

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) 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
@@ -21,15 +21,17 @@
 ################################
 ##### Set global variables #####
 ################################
-
+sinclude config.mk
 PREFIX?=/usr/local
 
+JANETCONF_HEADER?=src/conf/janetconf.h
 INCLUDEDIR?=$(PREFIX)/include
 BINDIR?=$(PREFIX)/bin
 LIBDIR?=$(PREFIX)/lib
 JANET_BUILD?="\"$(shell git log --pretty=format:'%h' -n 1 2> /dev/null || echo local)\""
 CLIBS=-lm -lpthread
 JANET_TARGET=build/janet
+JANET_IMPORT_LIB=build/janet.lib
 JANET_LIBRARY=build/libjanet.so
 JANET_STATIC_LIBRARY=build/libjanet.a
 JANET_PATH?=$(LIBDIR)/janet
@@ -76,6 +78,12 @@ ifeq ($(shell uname -o), Android)
 endif
 endif
 
+# Mingw
+ifeq ($(findstring MINGW,$(UNAME)), MINGW)
+	CLIBS:=-lws2_32 -lpsapi -lwsock32
+	LDFLAGS:=-Wl,--out-implib,$(JANET_IMPORT_LIB)
+endif
+
 $(shell mkdir -p build/core build/c build/boot)
 all: $(JANET_TARGET) $(JANET_LIBRARY) $(JANET_STATIC_LIBRARY) build/janet.h
 
@@ -83,7 +91,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 +176,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
@@ -300,6 +308,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'
+	cp '$(JANET_IMPORT_LIB)' '$(DESTDIR)$(LIBDIR)' || echo 'no import lib to install (mingw only)'
 	[ -z '$(DESTDIR)' ] && $(LDCONFIG) || echo "You can ignore this error for non-Linux systems or local installs"
 
 install-jpm-git: $(JANET_TARGET)

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.1')
+  version : '1.26.1')
 
 # 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
 
 ###
 ###
@@ -839,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)))))
 
@@ -1749,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>)`,
@@ -2065,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)))
@@ -2177,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
@@ -2203,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))
 
 ###
 ###
@@ -2533,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]
@@ -2541,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))))
@@ -2581,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)
@@ -2595,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)))
@@ -2602,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)`.``
@@ -2641,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
@@ -2677,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:"))
@@ -2774,6 +2766,7 @@
   (put nextenv :fiber fiber)
   (put nextenv :debug-level level)
   (put nextenv :signal (fiber/last-value fiber))
+
   (merge-into nextenv debugger-env)
   (defn debugger-chunks [buf p]
     (def status (:state p :delimiters))
@@ -3382,11 +3375,16 @@
   (print))
 
 (defn .frame
-  "Show a stack frame."
+  "Show a stack frame"
   [&opt n]
   (def stack (debug/stack (.fiber)))
   (in stack (or n 0)))
 
+(defn .locals
+  "Show local bindings"
+  [&opt n]
+  (get (.frame n) :locals))
+
 (defn .fn
   "Get the current function."
   [&opt n]
@@ -3567,7 +3565,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)))
 
@@ -3591,13 +3589,18 @@
          (,ev/deadline ,deadline nil ,f)
          (,resume ,f))))
 
+  (defn- cancel-all [fibers reason] (each f fibers (ev/cancel f reason) (put fibers f nil)))
+
   (defn- wait-for-fibers
     [chan fibers]
-    (repeat (length fibers)
-      (def [sig fiber] (ev/take chan))
-      (unless (= sig :ok)
-        (each f fibers (ev/cancel f "sibling canceled"))
-        (propagate (fiber/last-value fiber) fiber))))
+    (defer (cancel-all fibers "parent canceled")
+      (repeat (length fibers)
+        (def [sig fiber] (ev/take chan))
+        (if (= sig :ok)
+          (put fibers fiber nil)
+          (do
+            (cancel-all fibers "sibling canceled")
+            (propagate (fiber/last-value fiber) fiber))))))
 
   (defmacro ev/gather
     ``
@@ -3605,13 +3608,16 @@
     Returns the gathered results in an array.
     ``
     [& bodies]
-    (with-syms [chan res]
+    (with-syms [chan res fset ftemp]
       ~(do
+         (def ,fset @{})
          (def ,chan (,ev/chan))
          (def ,res @[])
-         (,wait-for-fibers ,chan
-                           ,(seq [[i body] :pairs bodies]
-                              ~(,ev/go (fn [] (put ,res ,i ,body)) nil ,chan)))
+         ,;(seq [[i body] :pairs bodies]
+             ~(do
+                (def ,ftemp (,ev/go (fn [] (put ,res ,i ,body)) nil ,chan))
+                (,put ,fset ,ftemp ,ftemp)))
+         (,wait-for-fibers ,chan ,fset)
          ,res))))
 
 (compwhen (dyn 'net/listen)
@@ -3671,6 +3677,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))
@@ -3682,9 +3689,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))
@@ -3885,7 +3892,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)
@@ -3940,7 +3947,7 @@
       compile-only (flycheck stdin :source :stdin :exit exit-on-error)
       (do
         (if-not quiet
-          (print "Janet " janet/version "-" janet/build " " (os/which) "/" (os/arch) " - '(doc)' for help"))
+          (print "Janet " janet/version "-" janet/build " " (os/which) "/" (os/arch) "/" (os/compiler) " - '(doc)' for help"))
         (flush)
         (defn getprompt [p]
           (def [line] (parser/where p))

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 1
 #define JANET_VERSION_EXTRA "-dev"
-#define JANET_VERSION "1.23.1-dev"
+#define JANET_VERSION "1.26.1-dev"
 
 /* #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
 
@@ -96,11 +98,11 @@ size_t janet_os_rwlock_size(void) {
 }
 
 static int32_t janet_incref(JanetAbstractHead *ab) {
-    return InterlockedIncrement(&ab->gc.data.refcount);
+    return InterlockedIncrement((LONG volatile *) &ab->gc.data.refcount);
 }
 
 static int32_t janet_decref(JanetAbstractHead *ab) {
-    return InterlockedDecrement(&ab->gc.data.refcount);
+    return InterlockedDecrement((LONG volatile *) &ab->gc.data.refcount);
 }
 
 void janet_os_mutex_init(JanetOSMutex *mutex) {

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
@@ -187,7 +187,11 @@ static void janet_asm_longjmp(JanetAssembler *a) {
 
 /* Throw some kind of assembly error */
 static void janet_asm_error(JanetAssembler *a, const char *message) {
-    a->errmessage = janet_formatc("%s, instruction %d", message, a->errindex);
+    if (a->errindex < 0) {
+        a->errmessage = janet_formatc("%s", message);
+    } else {
+        a->errmessage = janet_formatc("%s, instruction %d", message, a->errindex);
+    }
     janet_asm_longjmp(a);
 }
 #define janet_asm_assert(a, c, m) do { if (!(c)) janet_asm_error((a), (m)); } while (0)
@@ -516,6 +520,7 @@ static JanetAssembleResult janet_asm1(JanetAssembler *parent, Janet source, int
 #endif
         if (NULL != a.parent) {
             janet_asm_deinit(&a);
+            a.parent->errmessage = a.errmessage;
             janet_asm_longjmp(a.parent);
         }
         result.funcdef = NULL;
@@ -601,6 +606,9 @@ static JanetAssembleResult janet_asm1(JanetAssembler *parent, Janet source, int
 
     /* Parse sub funcdefs */
     x = janet_get1(s, janet_ckeywordv("closures"));
+    if (janet_checktype(x, JANET_NIL)) {
+        x = janet_get1(s, janet_ckeywordv("defs"));
+    }
     if (janet_indexed_view(x, &arr, &count)) {
         int32_t i;
         for (i = 0; i < count; i++) {
@@ -713,10 +721,63 @@ static JanetAssembleResult janet_asm1(JanetAssembler *parent, Janet source, int
         }
     }
 
+    /* Set symbolmap */
+    def->symbolmap = NULL;
+    def->symbolmap_length = 0;
+    x = janet_get1(s, janet_ckeywordv("symbolmap"));
+    if (janet_indexed_view(x, &arr, &count)) {
+        def->symbolmap_length = count;
+        def->symbolmap = janet_malloc(sizeof(JanetSymbolMap) * (size_t)count);
+        if (NULL == def->symbolmap) {
+            JANET_OUT_OF_MEMORY;
+        }
+        for (i = 0; i < count; i++) {
+            const Janet *tup;
+            Janet entry = arr[i];
+            JanetSymbolMap ss;
+            if (!janet_checktype(entry, JANET_TUPLE)) {
+                janet_asm_error(&a, "expected tuple");
+            }
+            tup = janet_unwrap_tuple(entry);
+            if (janet_keyeq(tup[0], "upvalue")) {
+                ss.birth_pc = UINT32_MAX;
+            } else if (!janet_checkint(tup[0])) {
+                janet_asm_error(&a, "expected integer");
+            } else {
+                ss.birth_pc = janet_unwrap_integer(tup[0]);
+            }
+            if (!janet_checkint(tup[1])) {
+                janet_asm_error(&a, "expected integer");
+            }
+            if (!janet_checkint(tup[2])) {
+                janet_asm_error(&a, "expected integer");
+            }
+            if (!janet_checktype(tup[3], JANET_SYMBOL)) {
+                janet_asm_error(&a, "expected symbol");
+            }
+            ss.death_pc = janet_unwrap_integer(tup[1]);
+            ss.slot_index = janet_unwrap_integer(tup[2]);
+            ss.symbol = janet_unwrap_symbol(tup[3]);
+            def->symbolmap[i] = ss;
+        }
+    }
+    if (def->symbolmap_length) def->flags |= JANET_FUNCDEF_FLAG_HASSYMBOLMAP;
+
     /* Set environments */
-    def->environments =
-        janet_realloc(def->environments, def->environments_length * sizeof(int32_t));
-    if (NULL == def->environments) {
+    x = janet_get1(s, janet_ckeywordv("environments"));
+    if (janet_indexed_view(x, &arr, &count)) {
+        def->environments_length = count;
+        if (def->environments_length) {
+            def->environments = janet_realloc(def->environments, def->environments_length * sizeof(int32_t));
+        }
+        for (int32_t i = 0; i < count; i++) {
+            if (!janet_checkint(arr[i])) {
+                janet_asm_error(&a, "expected integer");
+            }
+            def->environments[i] = janet_unwrap_integer(arr[i]);
+        }
+    }
+    if (def->environments_length && NULL == def->environments) {
         JANET_OUT_OF_MEMORY;
     }
 
@@ -865,6 +926,30 @@ static Janet janet_disasm_slotcount(JanetFuncDef *def) {
     return janet_wrap_integer(def->slotcount);
 }
 
+static Janet janet_disasm_symbolslots(JanetFuncDef *def) {
+    if (def->symbolmap == NULL) {
+        return janet_wrap_nil();
+    }
+    JanetArray *symbolslots = janet_array(def->symbolmap_length);
+    Janet upvaluekw = janet_ckeywordv("upvalue");
+    for (int32_t i = 0; i < def->symbolmap_length; i++) {
+        JanetSymbolMap ss = def->symbolmap[i];
+        Janet *t = janet_tuple_begin(4);
+        if (ss.birth_pc == UINT32_MAX) {
+            t[0] = upvaluekw;
+        } else {
+            t[0] = janet_wrap_integer(ss.birth_pc);
+        }
+        t[1] = janet_wrap_integer(ss.death_pc);
+        t[2] = janet_wrap_integer(ss.slot_index);
+        t[3] = janet_wrap_symbol(ss.symbol);
+        symbolslots->data[i] = janet_wrap_tuple(janet_tuple_end(t));
+    }
+    symbolslots->count = def->symbolmap_length;
+    return janet_wrap_array(symbolslots);
+}
+
+
 static Janet janet_disasm_bytecode(JanetFuncDef *def) {
     JanetArray *bcode = janet_array(def->bytecode_length);
     for (int32_t i = 0; i < def->bytecode_length; i++) {
@@ -944,6 +1029,7 @@ Janet janet_disasm(JanetFuncDef *def) {
     janet_table_put(ret, janet_ckeywordv("structarg"), janet_disasm_structarg(def));
     janet_table_put(ret, janet_ckeywordv("name"), janet_disasm_name(def));
     janet_table_put(ret, janet_ckeywordv("slotcount"), janet_disasm_slotcount(def));
+    janet_table_put(ret, janet_ckeywordv("symbolmap"), janet_disasm_symbolslots(def));
     janet_table_put(ret, janet_ckeywordv("constants"), janet_disasm_constants(def));
     janet_table_put(ret, janet_ckeywordv("sourcemap"), janet_disasm_sourcemap(def));
     janet_table_put(ret, janet_ckeywordv("environments"), janet_disasm_environments(def));
@@ -961,7 +1047,7 @@ JANET_CORE_FN(cfun_asm,
     JanetAssembleResult res;
     res = janet_asm(argv[0], 0);
     if (res.status != JANET_ASSEMBLE_OK) {
-        janet_panics(res.error);
+        janet_panics(res.error ? res.error : janet_cstring("invalid assembly"));
     }
     return janet_wrap_function(janet_thunk(res.funcdef));
 }
@@ -980,6 +1066,7 @@ JANET_CORE_FN(cfun_disasm,
               "* :source - name of source file that this function was compiled from.\n"
               "* :name - name of function.\n"
               "* :slotcount - how many virtual registers, or slots, this function uses. Corresponds to stack space used by function.\n"
+              "* :symbolmap - all symbols and their slots.\n"
               "* :constants - an array of constants referenced by this function.\n"
               "* :sourcemap - a mapping of each bytecode instruction to a line and column in the source file.\n"
               "* :environments - an internal mapping of which enclosing functions are referenced for bindings.\n"

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
@@ -29,7 +29,7 @@
 #endif
 
 /* Initialize a buffer */
-JanetBuffer *janet_buffer_init(JanetBuffer *buffer, int32_t capacity) {
+static JanetBuffer *janet_buffer_init_impl(JanetBuffer *buffer, int32_t capacity) {
     uint8_t *data = NULL;
     if (capacity < 4) capacity = 4;
     janet_gcpressure(capacity);
@@ -43,6 +43,14 @@ JanetBuffer *janet_buffer_init(JanetBuffer *buffer, int32_t capacity) {
     return buffer;
 }
 
+/* Initialize a buffer */
+JanetBuffer *janet_buffer_init(JanetBuffer *buffer, int32_t capacity) {
+    janet_buffer_init_impl(buffer, capacity);
+    buffer->gc.data.next = NULL;
+    buffer->gc.flags = JANET_MEM_DISABLED;
+    return buffer;
+}
+
 /* Deinitialize a buffer (free data memory) */
 void janet_buffer_deinit(JanetBuffer *buffer) {
     janet_free(buffer->data);
@@ -51,7 +59,7 @@ void janet_buffer_deinit(JanetBuffer *buffer) {
 /* Initialize a buffer */
 JanetBuffer *janet_buffer(int32_t capacity) {
     JanetBuffer *buffer = janet_gcalloc(JANET_MEMORY_BUFFER, sizeof(JanetBuffer));
-    return janet_buffer_init(buffer, capacity);
+    return janet_buffer_init_impl(buffer, capacity);
 }
 
 /* Ensure that the buffer has enough internal capacity */
@@ -442,7 +450,7 @@ JANET_CORE_FN(cfun_buffer_blit,
 JANET_CORE_FN(cfun_buffer_format,
               "(buffer/format buffer format & args)",
               "Snprintf like functionality for printing values into a buffer. Returns "
-              " the modified buffer.") {
+              "the modified buffer.") {
     janet_arity(argc, 2, -1);
     JanetBuffer *buffer = janet_getbuffer(argv, 0);
     const char *strfrmt = (const char *) janet_getstring(argv, 1);

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
@@ -218,6 +218,7 @@ JanetFuncDef *janet_funcdef_alloc(void) {
     def->closure_bitset = NULL;
     def->flags = 0;
     def->slotcount = 0;
+    def->symbolmap = NULL;
     def->arity = 0;
     def->min_arity = 0;
     def->max_arity = INT32_MAX;
@@ -229,6 +230,7 @@ JanetFuncDef *janet_funcdef_alloc(void) {
     def->constants_length = 0;
     def->bytecode_length = 0;
     def->environments_length = 0;
+    def->symbolmap_length = 0;
     return def;
 }
 

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
@@ -93,10 +93,14 @@ void janetc_freeslot(JanetCompiler *c, JanetSlot s) {
 /* Add a slot to a scope with a symbol associated with it (def or var). */
 void janetc_nameslot(JanetCompiler *c, const uint8_t *sym, JanetSlot s) {
     SymPair sp;
+    int32_t cnt = janet_v_count(c->buffer);
     sp.sym = sym;
+    sp.sym2 = sym;
     sp.slot = s;
     sp.keep = 0;
     sp.slot.flags |= JANET_SLOT_NAMED;
+    sp.birth_pc = cnt ? cnt - 1 : 0;
+    sp.death_pc = UINT32_MAX;
     janet_v_push(c->scope->syms, sp);
 }
 
@@ -159,21 +163,27 @@ void janetc_popscope(JanetCompiler *c) {
         if (oldscope->flags & JANET_SCOPE_CLOSURE) {
             newscope->flags |= JANET_SCOPE_CLOSURE;
         }
-        if (newscope->ra.max < oldscope->ra.max)
+        if (newscope->ra.max < oldscope->ra.max) {
             newscope->ra.max = oldscope->ra.max;
-
-        /* Keep upvalue slots */
-        for (int32_t i = 0; i < janet_v_count(oldscope->syms); i++) {
-            SymPair pair = oldscope->syms[i];
-            if (pair.keep) {
-                /* The variable should not be lexically accessible */
-                pair.sym = NULL;
-                janet_v_push(newscope->syms, pair);
-                janetc_regalloc_touch(&newscope->ra, pair.slot.index);
-            }
         }
 
+        /* Keep upvalue slots and symbols for debugging. */
+        for (int32_t i = 0; i < janet_v_count(oldscope->syms); i++) {
+            SymPair pair = oldscope->syms[i];
+            /* The variable should not be lexically accessible */
+            pair.sym = NULL;
+            if (pair.death_pc == UINT32_MAX) {
+                pair.death_pc = (uint32_t) janet_v_count(c->buffer);
+            }
+            if (pair.keep) {
+                /* The variable should also not be included in the locals */
+                pair.sym2 = NULL;
+                janetc_regalloc_touch(&newscope->ra, pair.slot.index);
+            }
+            janet_v_push(newscope->syms, pair);
+        }
     }
+
     /* Free the old scope */
     janet_v_free(oldscope->consts);
     janet_v_free(oldscope->syms);
@@ -334,6 +344,7 @@ found:
     }
 
     /* non-local scope needs to expose its environment */
+    JanetScope *original_scope = scope;
     pair->keep = 1;
     while (scope && !(scope->flags & JANET_SCOPE_FUNCTION))
         scope = scope->parent;
@@ -355,7 +366,7 @@ found:
             /* Check if scope already has env. If so, break */
             len = janet_v_count(scope->envs);
             for (j = 0; j < len; j++) {
-                if (scope->envs[j] == envindex) {
+                if (scope->envs[j].envindex == envindex) {
                     scopefound = 1;
                     envindex = j;
                     break;
@@ -364,7 +375,10 @@ found:
             /* Add the environment if it is not already referenced */
             if (!scopefound) {
                 len = janet_v_count(scope->envs);
-                janet_v_push(scope->envs, envindex);
+                JanetEnvRef ref;
+                ref.envindex = envindex;
+                ref.scope = original_scope;
+                janet_v_push(scope->envs, ref);
                 envindex = len;
             }
         }
@@ -868,7 +882,10 @@ JanetFuncDef *janetc_pop_funcdef(JanetCompiler *c) {
 
     /* Copy envs */
     def->environments_length = janet_v_count(scope->envs);
-    def->environments = janet_v_flatten(scope->envs);
+    def->environments = janet_malloc(sizeof(int32_t) * def->environments_length);
+    for (int32_t i = 0; i < def->environments_length; i++) {
+        def->environments[i] = scope->envs[i].envindex;
+    }
 
     def->constants_length = janet_v_count(scope->consts);
     def->constants = janet_v_flatten(scope->consts);
@@ -923,6 +940,50 @@ JanetFuncDef *janetc_pop_funcdef(JanetCompiler *c) {
         def->closure_bitset = chunks;
     }
 
+    /* Capture symbol to local mapping */
+    JanetSymbolMap *locals = NULL;
+
+    /* Symbol -> upvalue mapping */
+    JanetScope *top = c->scope;
+    while (top->parent) top = top->parent;
+    for (JanetScope *s = top; s != NULL; s = s->child) {
+        for (int32_t j = 0; j < janet_v_count(scope->envs); j++) {
+            JanetEnvRef ref = scope->envs[j];
+            JanetScope *upscope = ref.scope;
+            if (upscope != s) continue;
+            for (int32_t i = 0; i < janet_v_count(upscope->syms); i++) {
+                SymPair pair = upscope->syms[i];
+                if (pair.sym2) {
+                    JanetSymbolMap jsm;
+                    jsm.birth_pc = UINT32_MAX;
+                    jsm.death_pc = j;
+                    jsm.slot_index = pair.slot.index;
+                    jsm.symbol = pair.sym2;
+                    janet_v_push(locals, jsm);
+                }
+            }
+        }
+    }
+
+    /* Symbol -> slot mapping */
+    for (int32_t i = 0; i < janet_v_count(scope->syms); i++) {
+        SymPair pair = scope->syms[i];
+        if (pair.sym2) {
+            if (pair.death_pc == UINT32_MAX) {
+                pair.death_pc = def->bytecode_length;
+            }
+            JanetSymbolMap jsm;
+            jsm.birth_pc = pair.birth_pc;
+            jsm.death_pc = pair.death_pc;
+            jsm.slot_index = pair.slot.index;
+            jsm.symbol = pair.sym2;
+            janet_v_push(locals, jsm);
+        }
+    }
+    def->symbolmap_length = janet_v_count(locals);
+    def->symbolmap = janet_v_flatten(locals);
+    if (def->symbolmap_length) def->flags |= JANET_FUNCDEF_FLAG_HASSYMBOLMAP;
+
     /* Pop the scope */
     janetc_popscope(c);
 
@@ -996,7 +1057,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 +1066,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 +1079,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 +1106,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
@@ -111,13 +111,21 @@ struct JanetSlot {
 typedef struct SymPair {
     JanetSlot slot;
     const uint8_t *sym;
+    const uint8_t *sym2;
     int keep;
+    uint32_t birth_pc;
+    uint32_t death_pc;
 } SymPair;
 
+typedef struct JanetEnvRef {
+    int32_t envindex;
+    JanetScope *scope;
+} JanetEnvRef;
+
 /* A lexical scope during compilation */
 struct JanetScope {
 
-    /* For debugging */
+    /* For debugging the compiler */
     const char *name;
 
     /* Scopes are doubly linked list */
@@ -133,7 +141,7 @@ struct JanetScope {
     /* FuncDefs */
     JanetFuncDef **defs;
 
-    /* Regsiter allocator */
+    /* Register allocator */
     JanetcRegisterAllocator ra;
 
     /* Upvalue allocator */
@@ -142,7 +150,7 @@ struct JanetScope {
     /* Referenced closure environments. The values at each index correspond
      * to which index to get the environment from in the parent. The environment
      * that corresponds to the direct parent's stack will always have value 0. */
-    int32_t *envs;
+    JanetEnvRef *envs;
 
     int32_t bytecode_start;
     int flags;
@@ -227,7 +235,7 @@ JanetSlot *janetc_toslots(JanetCompiler *c, const Janet *vals, int32_t len);
 /* Get a bunch of slots for function arguments */
 JanetSlot *janetc_toslotskv(JanetCompiler *c, Janet ds);
 
-/* Push slots load via janetc_toslots. */
+/* Push slots loaded via janetc_toslots. */
 int32_t janetc_pushslots(JanetCompiler *c, JanetSlot *slots);
 
 /* Free slots loaded via janetc_toslots */

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 greater 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
@@ -131,9 +131,9 @@ void janet_stacktrace_ext(JanetFiber *fiber, Janet err, const char *prefix) {
             if (!wrote_error) {
                 JanetFiberStatus status = janet_fiber_status(fiber);
                 janet_eprintf("%s%s: %s\n",
-                              prefix,
+                              prefix ? prefix : "",
                               janet_status_names[status],
-                              errstr);
+                              errstr ? errstr : janet_status_names[status]);
                 wrote_error = 1;
             }
 
@@ -329,6 +329,27 @@ static Janet doframe(JanetStackFrame *frame) {
         safe_memcpy(slots->data, stack, sizeof(Janet) * def->slotcount);
         slots->count = def->slotcount;
         janet_table_put(t, janet_ckeywordv("slots"), janet_wrap_array(slots));
+        /* Add local bindings */
+        if (def->symbolmap) {
+            JanetTable *local_bindings = janet_table(0);
+            for (int32_t i = def->symbolmap_length - 1; i >= 0; i--) {
+                JanetSymbolMap jsm = def->symbolmap[i];
+                Janet value = janet_wrap_nil();
+                uint32_t pc = (uint32_t)(frame->pc - def->bytecode);
+                if (jsm.birth_pc == UINT32_MAX) {
+                    JanetFuncEnv *env = frame->func->envs[jsm.death_pc];
+                    if (env->offset > 0) {
+                        value = env->as.fiber->data[env->offset + jsm.slot_index];
+                    } else {
+                        value = env->as.values[jsm.slot_index];
+                    }
+                } else if (pc >= jsm.birth_pc && pc < jsm.death_pc) {
+                    value = stack[jsm.slot_index];
+                }
+                janet_table_put(local_bindings, janet_wrap_symbol(jsm.symbol), value);
+            }
+            janet_table_put(t, janet_ckeywordv("locals"), janet_wrap_table(local_bindings));
+        }
     }
     return janet_wrap_table(t);
 }

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
@@ -172,6 +172,9 @@ static JanetTimestamp ts_now(void);
 
 /* Get current timestamp + an interval (millisecond precision) */
 static JanetTimestamp ts_delta(JanetTimestamp ts, double delta) {
+    if (isinf(delta)) {
+        return delta < 0 ? ts : INT64_MAX;
+    }
     ts += (int64_t)round(delta * 1000);
     return ts;
 }
@@ -557,6 +560,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 */
@@ -566,6 +573,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 */
@@ -1175,14 +1185,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 */
@@ -2038,12 +2082,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 */
@@ -2172,9 +2215,9 @@ typedef struct {
     JanetReadMode mode;
 #ifdef JANET_WINDOWS
     OVERLAPPED overlapped;
+    DWORD flags;
 #ifdef JANET_NET
     WSABUF wbuf;
-    DWORD flags;
     struct sockaddr from;
     int fromlen;
 #endif
@@ -2233,7 +2276,7 @@ JanetAsyncStatus ev_machine_read(JanetListenerState *s, JanetAsyncEvent event) {
 #ifdef JANET_NET
             if (state->mode == JANET_ASYNC_READMODE_RECVFROM) {
                 state->wbuf.len = (ULONG) chunk_size;
-                state->wbuf.buf = state->chunk_buf;
+                state->wbuf.buf = (char *) state->chunk_buf;
                 status = WSARecvFrom((SOCKET) s->stream->handle, &state->wbuf, 1,
                                      NULL, &state->flags, &state->from, &state->fromlen, &state->overlapped, NULL);
                 if (status && (WSA_IO_PENDING != WSAGetLastError())) {
@@ -2248,8 +2291,8 @@ JanetAsyncStatus ev_machine_read(JanetListenerState *s, JanetAsyncEvent event) {
                 state->overlapped.Offset = (DWORD) state->bytes_read;
 
                 status = ReadFile(s->stream->handle, state->chunk_buf, chunk_size, NULL, &state->overlapped);
-                if (!status && (ERROR_IO_PENDING != WSAGetLastError())) {
-                    if (WSAGetLastError() == ERROR_BROKEN_PIPE) {
+                if (!status && (ERROR_IO_PENDING != GetLastError())) {
+                    if (GetLastError() == ERROR_BROKEN_PIPE) {
                         if (state->bytes_read) {
                             janet_schedule(s->fiber, janet_wrap_buffer(state->buf));
                         } else {
@@ -2401,9 +2444,9 @@ typedef struct {
     void *dest_abst;
 #ifdef JANET_WINDOWS
     OVERLAPPED overlapped;
+    DWORD flags;
 #ifdef JANET_NET
     WSABUF wbuf;
-    DWORD flags;
 #endif
 #else
     int flags;
@@ -2488,7 +2531,7 @@ JanetAsyncStatus ev_machine_write(JanetListenerState *s, JanetAsyncEvent event)
                 state->overlapped.Offset = (DWORD) 0xFFFFFFFF;
                 state->overlapped.OffsetHigh = (DWORD) 0xFFFFFFFF;
                 status = WriteFile(s->stream->handle, bytes, len, NULL, &state->overlapped);
-                if (!status && (ERROR_IO_PENDING != WSAGetLastError())) {
+                if (!status && (ERROR_IO_PENDING != GetLastError())) {
                     janet_cancel(s->fiber, janet_ev_lasterr());
                     return JANET_ASYNC_STATUS_DONE;
                 }
@@ -2624,15 +2667,15 @@ int janet_make_pipe(JanetHandle handles[2], int mode) {
      * so we lift from the windows source code and modify for our own version.
      */
     JanetHandle shandle, chandle;
-    UCHAR PipeNameBuffer[MAX_PATH];
+    CHAR PipeNameBuffer[MAX_PATH];
     SECURITY_ATTRIBUTES saAttr;
     memset(&saAttr, 0, sizeof(saAttr));
     saAttr.nLength = sizeof(saAttr);
     saAttr.bInheritHandle = TRUE;
     sprintf(PipeNameBuffer,
             "\\\\.\\Pipe\\JanetPipeFile.%08x.%08x",
-            GetCurrentProcessId(),
-            InterlockedIncrement(&PipeSerialNumber));
+            (unsigned int) GetCurrentProcessId(),
+            (unsigned int) InterlockedIncrement(&PipeSerialNumber));
 
     /* server handle goes to subprocess */
     shandle = CreateNamedPipeA(
@@ -2687,9 +2730,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.") {
@@ -2898,7 +2942,7 @@ JANET_CORE_FN(cfun_ev_thread,
 
 JANET_CORE_FN(cfun_ev_give_supervisor,
               "(ev/give-supervisor tag & payload)",
-              "Send a message to the current supervior channel if there is one. The message will be a "
+              "Send a message to the current supervisor channel if there is one. The message will be a "
               "tuple of all of the arguments combined into a single message, where the first element is tag. "
               "By convention, tag should be a keyword indicating the type of message. Returns nil.") {
     janet_arity(argc, 1, -1);

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,24 @@ 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 */
             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 +862,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 +892,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 +902,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 +988,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 +1038,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 +1151,44 @@ 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 */
+#ifdef JANET_MINGW
+#pragma GCC diagnostic ignored "-Wstringop-overflow"
+#endif
+    if (stack_size) memmove(stack - stack_shift, stack, stack_size);
+#ifdef JANET_MINGW
+#pragma GCC diagnostic pop
+#endif
+
     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 +1292,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 +1375,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);
@@ -1218,6 +1472,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),
@@ -1231,6 +1504,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
@@ -209,6 +209,12 @@ static void janet_mark_funcdef(JanetFuncDef *def) {
         janet_mark_string(def->source);
     if (def->name)
         janet_mark_string(def->name);
+    if (def->symbolmap) {
+        for (int i = 0; i < def->symbolmap_length; i++) {
+            janet_mark_string(def->symbolmap[i].symbol);
+        }
+    }
+
 }
 
 static void janet_mark_function(JanetFunction *func) {
@@ -314,6 +320,7 @@ static void janet_deinit_block(JanetGCObject *mem) {
             janet_free(def->bytecode);
             janet_free(def->sourcemap);
             janet_free(def->closure_bitset);
+            janet_free(def->symbolmap);
         }
         break;
     }

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
@@ -243,6 +243,13 @@ JANET_CORE_FN(cfun_io_fwrite,
     return argv[0];
 }
 
+static void io_assert_writeable(JanetFile *iof) {
+    if (iof->flags & JANET_FILE_CLOSED)
+        janet_panic("file is closed");
+    if (!(iof->flags & (JANET_FILE_WRITE | JANET_FILE_APPEND | JANET_FILE_UPDATE)))
+        janet_panic("file is not writeable");
+}
+
 /* Flush the bytes in the file */
 JANET_CORE_FN(cfun_io_fflush,
               "(file/flush f)",
@@ -250,10 +257,7 @@ JANET_CORE_FN(cfun_io_fflush,
               "buffered for efficiency reasons. Returns the file handle.") {
     janet_fixarity(argc, 1);
     JanetFile *iof = janet_getabstract(argv, 0, &janet_file_type);
-    if (iof->flags & JANET_FILE_CLOSED)
-        janet_panic("file is closed");
-    if (!(iof->flags & (JANET_FILE_WRITE | JANET_FILE_APPEND | JANET_FILE_UPDATE)))
-        janet_panic("file is not writeable");
+    io_assert_writeable(iof);
     if (fflush(iof->file))
         janet_panic("could not flush file");
     return argv[0];
@@ -269,6 +273,7 @@ int janet_file_close(JanetFile *file) {
     if (!(file->flags & (JANET_FILE_NOT_CLOSEABLE | JANET_FILE_CLOSED))) {
         ret = fclose(file->file);
         file->flags |= JANET_FILE_CLOSED;
+        file->file = NULL; /* NULL derefence is easier to debug then other problems */
         return ret;
     }
     return 0;
@@ -449,6 +454,7 @@ static Janet cfun_io_print_impl_x(int32_t argc, Janet *argv, int newline,
             if (janet_abstract_type(abstract) != &janet_file_type)
                 return janet_wrap_nil();
             JanetFile *iofile = abstract;
+            io_assert_writeable(iofile);
             f = iofile->file;
             break;
         }
@@ -564,6 +570,10 @@ static Janet cfun_io_printf_impl_x(int32_t argc, Janet *argv, int newline,
             if (janet_abstract_type(abstract) != &janet_file_type)
                 return janet_wrap_nil();
             JanetFile *iofile = abstract;
+            if (iofile->flags & JANET_FILE_CLOSED) {
+                janet_panic("cannot print to closed file");
+            }
+            io_assert_writeable(iofile);
             f = iofile->file;
             break;
         }
@@ -688,6 +698,7 @@ void janet_dynprintf(const char *name, FILE *dflt_file, const char *format, ...)
                 if (janet_abstract_type(abstract) != &janet_file_type)
                     break;
                 JanetFile *iofile = abstract;
+                io_assert_writeable(iofile);
                 f = iofile->file;
             }
             fwrite(buffer.data, buffer.count, 1, f);
@@ -718,17 +729,17 @@ JanetFile *janet_getjfile(const Janet *argv, int32_t n) {
     return janet_getabstract(argv, n, &janet_file_type);
 }
 
-FILE *janet_getfile(const Janet *argv, int32_t n, int *flags) {
+FILE *janet_getfile(const Janet *argv, int32_t n, int32_t *flags) {
     JanetFile *iof = janet_getabstract(argv, n, &janet_file_type);
     if (NULL != flags) *flags = iof->flags;
     return iof->file;
 }
 
-JanetFile *janet_makejfile(FILE *f, int flags) {
+JanetFile *janet_makejfile(FILE *f, int32_t flags) {
     return makef(f, flags);
 }
 
-Janet janet_makefile(FILE *f, int flags) {
+Janet janet_makefile(FILE *f, int32_t flags) {
     return janet_wrap_abstract(makef(f, flags));
 }
 
@@ -736,7 +747,7 @@ JanetAbstract janet_checkfile(Janet j) {
     return janet_checkabstract(j, &janet_file_type);
 }
 
-FILE *janet_unwrapfile(Janet j, int *flags) {
+FILE *janet_unwrapfile(Janet j, int32_t *flags) {
     JanetFile *iof = janet_unwrap_abstract(j);
     if (NULL != flags) *flags = iof->flags;
     return iof->file;

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 */
@@ -251,6 +252,8 @@ static void marshal_one_def(MarshalState *st, JanetFuncDef *def, int flags) {
         pushint(st, def->environments_length);
     if (def->flags & JANET_FUNCDEF_FLAG_HASDEFS)
         pushint(st, def->defs_length);
+    if (def->flags & JANET_FUNCDEF_FLAG_HASSYMBOLMAP)
+        pushint(st, def->symbolmap_length);
     if (def->flags & JANET_FUNCDEF_FLAG_HASNAME)
         marshal_one(st, janet_wrap_string(def->name), flags);
     if (def->flags & JANET_FUNCDEF_FLAG_HASSOURCE)
@@ -260,6 +263,14 @@ static void marshal_one_def(MarshalState *st, JanetFuncDef *def, int flags) {
     for (int32_t i = 0; i < def->constants_length; i++)
         marshal_one(st, def->constants[i], flags);
 
+    /* Marshal symbol map, if needed */
+    for (int32_t i = 0; i < def->symbolmap_length; i++) {
+        pushint(st, (int32_t) def->symbolmap[i].birth_pc);
+        pushint(st, (int32_t) def->symbolmap[i].death_pc);
+        pushint(st, (int32_t) def->symbolmap[i].slot_index);
+        marshal_one(st, janet_wrap_symbol(def->symbolmap[i].symbol), flags);
+    }
+
     /* marshal the bytecode */
     janet_marshal_u32s(st, def->bytecode, def->bytecode_length);
 
@@ -269,7 +280,7 @@ static void marshal_one_def(MarshalState *st, JanetFuncDef *def, int flags) {
 
     /* marshal the sub funcdefs if needed */
     for (int32_t i = 0; i < def->defs_length; i++)
-        marshal_one_def(st, def->defs[i], flags);
+        marshal_one_def(st, def->defs[i], flags + 1);
 
     /* marshal source maps if needed */
     if (def->flags & JANET_FUNCDEF_FLAG_HASSOURCEMAP) {
@@ -364,13 +375,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 +441,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 +629,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);
@@ -817,6 +834,8 @@ static const uint8_t *unmarshal_one_def(
         def->constants = NULL;
         def->bytecode = NULL;
         def->sourcemap = NULL;
+        def->symbolmap = NULL;
+        def->symbolmap_length = 0;
         janet_v_push(st->lookup_defs, def);
 
         /* Set default lengths to zero */
@@ -824,6 +843,7 @@ static const uint8_t *unmarshal_one_def(
         int32_t constants_length = 0;
         int32_t environments_length = 0;
         int32_t defs_length = 0;
+        int32_t symbolmap_length = 0;
 
         /* Read flags and other fixed values */
         def->flags = readint(st, &data);
@@ -839,6 +859,8 @@ static const uint8_t *unmarshal_one_def(
             environments_length = readnat(st, &data);
         if (def->flags & JANET_FUNCDEF_FLAG_HASDEFS)
             defs_length = readnat(st, &data);
+        if (def->flags & JANET_FUNCDEF_FLAG_HASSYMBOLMAP)
+            symbolmap_length = readnat(st, &data);
 
         /* Check name and source (optional) */
         if (def->flags & JANET_FUNCDEF_FLAG_HASNAME) {
@@ -867,6 +889,26 @@ static const uint8_t *unmarshal_one_def(
         }
         def->constants_length = constants_length;
 
+        /* Unmarshal symbol map, if needed */
+        if (def->flags & JANET_FUNCDEF_FLAG_HASSYMBOLMAP) {
+            size_t size = sizeof(JanetSymbolMap) * symbolmap_length;
+            def->symbolmap = janet_malloc(size);
+            if (def->symbolmap == NULL) {
+                JANET_OUT_OF_MEMORY;
+            }
+            for (int32_t i = 0; i < symbolmap_length; i++) {
+                def->symbolmap[i].birth_pc = (uint32_t) readint(st, &data);
+                def->symbolmap[i].death_pc = (uint32_t) readint(st, &data);
+                def->symbolmap[i].slot_index = (uint32_t) readint(st, &data);
+                Janet value;
+                data = unmarshal_one(st, data, &value, flags + 1);
+                if (!janet_checktype(value, JANET_SYMBOL))
+                    janet_panic("expected symbol in symbol map");
+                def->symbolmap[i].symbol = janet_unwrap_symbol(value);
+            }
+            def->symbolmap_length = (uint32_t) symbolmap_length;
+        }
+
         /* Unmarshal bytecode */
         def->bytecode = janet_malloc(sizeof(uint32_t) * bytecode_length);
         if (!def->bytecode) {
@@ -1471,16 +1513,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 +1532,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
@@ -254,13 +254,15 @@ JANET_CORE_FN(janet_srand,
     return janet_wrap_nil();
 }
 
-#define JANET_DEFINE_MATHOP(name, fop, doc)\
-JANET_CORE_FN(janet_##name, "(math/" #name " x)", doc) {\
+#define JANET_DEFINE_NAMED_MATHOP(c_name, janet_name, fop, doc)\
+JANET_CORE_FN(janet_##c_name, "(math/" #janet_name " x)", doc) {\
     janet_fixarity(argc, 1); \
     double x = janet_getnumber(argv, 0); \
     return janet_wrap_number(fop(x)); \
 }
 
+#define JANET_DEFINE_MATHOP(name, fop, doc) JANET_DEFINE_NAMED_MATHOP(name, name, fop, doc)
+
 JANET_DEFINE_MATHOP(acos, acos, "Returns the arccosine of x.")
 JANET_DEFINE_MATHOP(asin, asin, "Returns the arcsin of x.")
 JANET_DEFINE_MATHOP(atan, atan, "Returns the arctangent of x.")
@@ -269,7 +271,7 @@ JANET_DEFINE_MATHOP(cosh, cosh, "Returns the hyperbolic cosine of x.")
 JANET_DEFINE_MATHOP(acosh, acosh, "Returns the hyperbolic arccosine of x.")
 JANET_DEFINE_MATHOP(sin, sin, "Returns the sine of x.")
 JANET_DEFINE_MATHOP(sinh, sinh, "Returns the hyperbolic sine of x.")
-JANET_DEFINE_MATHOP(asinh, asinh, "Returns the hypberbolic arcsine of x.")
+JANET_DEFINE_MATHOP(asinh, asinh, "Returns the hyperbolic arcsine of x.")
 JANET_DEFINE_MATHOP(tan, tan, "Returns the tangent of x.")
 JANET_DEFINE_MATHOP(tanh, tanh, "Returns the hyperbolic tangent of x.")
 JANET_DEFINE_MATHOP(atanh, atanh, "Returns the hyperbolic arctangent of x.")
@@ -282,12 +284,12 @@ 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.")
 JANET_DEFINE_MATHOP(gamma, tgamma, "Returns gamma(x).")
-JANET_DEFINE_MATHOP(lgamma, lgamma, "Returns log-gamma(x).")
+JANET_DEFINE_NAMED_MATHOP(lgamma, "log-gamma", lgamma, "Returns log-gamma(x).")
 JANET_DEFINE_MATHOP(log1p, log1p, "Returns (log base e of x) + 1 more accurately than (+ (math/log x) 1)")
 JANET_DEFINE_MATHOP(erf, erf, "Returns the error function of x.")
 JANET_DEFINE_MATHOP(erfc, erfc, "Returns the complementary error function of x.")
@@ -303,7 +305,7 @@ JANET_CORE_FN(janet_##name, signature, doc) {\
 JANET_DEFINE_MATH2OP(atan2, atan2, "(math/atan2 y x)", "Returns the arctangent of y/x. Works even when x is 0.")
 JANET_DEFINE_MATH2OP(pow, pow, "(math/pow a x)", "Returns a to the power of x.")
 JANET_DEFINE_MATH2OP(hypot, hypot, "(math/hypot a b)", "Returns c from the equation c^2 = a^2 + b^2.")
-JANET_DEFINE_MATH2OP(nextafter, nextafter,  "(math/next x y)", "Returns the next representable floating point vaue after x in the direction of y.")
+JANET_DEFINE_MATH2OP(nextafter, nextafter,  "(math/next x y)", "Returns the next representable floating point value after x in the direction of y.")
 
 JANET_CORE_FN(janet_not, "(not x)", "Returns the boolean inverse of x.") {
     janet_fixarity(argc, 1);
@@ -368,7 +370,7 @@ void janet_lib_math(JanetTable *env) {
         JANET_CORE_REG("math/floor", janet_floor),
         JANET_CORE_REG("math/ceil", janet_ceil),
         JANET_CORE_REG("math/pow", janet_pow),
-        JANET_CORE_REG("math/abs", janet_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
@@ -34,9 +34,11 @@
 #include <windows.h>
 #include <ws2tcpip.h>
 #include <mswsock.h>
+#ifdef JANET_MSVC
 #pragma comment (lib, "Ws2_32.lib")
 #pragma comment (lib, "Mswsock.lib")
 #pragma comment (lib, "Advapi32.lib")
+#endif
 #else
 #include <arpa/inet.h>
 #include <unistd.h>
@@ -173,7 +175,6 @@ JanetAsyncStatus net_machine_accept(JanetListenerState *s, JanetAsyncEvent event
 
 JANET_NO_RETURN static void janet_sched_accept(JanetStream *stream, JanetFunction *fun) {
     Janet err;
-    SOCKET lsock = (SOCKET) stream->handle;
     JanetListenerState *s = janet_listen(stream, net_machine_accept, JANET_ASYNC_LISTEN_READ, sizeof(NetStateAccept), NULL);
     NetStateAccept *state = (NetStateAccept *)s;
     memset(&state->overlapped, 0, sizeof(WSAOVERLAPPED));
@@ -224,7 +225,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);
@@ -701,7 +707,7 @@ JANET_CORE_FN(cfun_net_getsockname,
     if (getsockname((JSock)js->handle, (struct sockaddr *) &ss, &slen)) {
         janet_panicf("Failed to get localname on %v: %V", argv[0], janet_ev_lasterr());
     }
-    janet_assert(slen <= sizeof(ss), "socket address truncated");
+    janet_assert(slen <= (socklen_t) sizeof(ss), "socket address truncated");
     return janet_so_getname(&ss);
 }
 
@@ -717,13 +723,13 @@ JANET_CORE_FN(cfun_net_getpeername,
     if (getpeername((JSock)js->handle, (struct sockaddr *)&ss, &slen)) {
         janet_panicf("Failed to get peername on %v: %V", argv[0], janet_ev_lasterr());
     }
-    janet_assert(slen <= sizeof(ss), "socket address truncated");
+    janet_assert(slen <= (socklen_t) sizeof(ss), "socket address truncated");
     return janet_so_getname(&ss);
 }
 
 JANET_CORE_FN(cfun_net_address_unpack,
               "(net/address-unpack address)",
-              "Given an address returned by net/adress, return a host, port pair. Unix domain sockets "
+              "Given an address returned by net/address, return a host, port pair. Unix domain sockets "
               "will have only the path in the returned tuple.") {
     janet_fixarity(argc, 1);
     struct sockaddr *sa = janet_getabstract(argv, 0, &janet_address_type);
@@ -793,7 +799,7 @@ JANET_CORE_FN(cfun_stream_chunk,
 }
 
 JANET_CORE_FN(cfun_stream_recv_from,
-              "(net/recv-from stream nbytes buf &opt timoeut)",
+              "(net/recv-from stream nbytes buf &opt timeout)",
               "Receives data from a server stream and puts it into a buffer. Returns the socket-address the "
               "packet came from. Takes an optional timeout in seconds, after which will return nil.") {
     janet_arity(argc, 3, 4);

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
@@ -118,6 +118,8 @@ JANET_CORE_FN(os_which,
               "(os/which)",
               "Check the current operating system. Returns one of:\n\n"
               "* :windows\n\n"
+              "* :mingw\n\n"
+              "* :cygwin\n\n"
               "* :macos\n\n"
               "* :web - Web assembly (emscripten)\n\n"
               "* :linux\n\n"
@@ -130,6 +132,10 @@ JANET_CORE_FN(os_which,
     (void) argv;
 #if defined(JANET_OS_NAME)
     return janet_ckeywordv(janet_stringify(JANET_OS_NAME));
+#elif defined(JANET_MINGW)
+    return janet_ckeywordv("mingw");
+#elif defined(JANET_CYGWIN)
+    return janet_ckeywordv("cygwin");
 #elif defined(JANET_WINDOWS)
     return janet_ckeywordv("windows");
 #elif defined(JANET_APPLE)
@@ -159,6 +165,8 @@ JANET_CORE_FN(os_arch,
               "* :x64\n\n"
               "* :arm\n\n"
               "* :aarch64\n\n"
+              "* :riscv32\n\n"
+              "* :riscv64\n\n"
               "* :sparc\n\n"
               "* :wasm\n\n"
               "* :unknown\n") {
@@ -177,6 +185,10 @@ JANET_CORE_FN(os_arch,
     return janet_ckeywordv("aarch64");
 #elif defined(_M_ARM) || defined(__arm__)
     return janet_ckeywordv("arm");
+#elif (defined(__riscv) && (__riscv_xlen == 64))
+    return janet_ckeywordv("riscv64");
+#elif (defined(__riscv) && (__riscv_xlen == 32))
+    return janet_ckeywordv("riscv32");
 #elif (defined(__sparc__))
     return janet_ckeywordv("sparc");
 #elif (defined(__ppc__))
@@ -188,6 +200,27 @@ JANET_CORE_FN(os_arch,
 #endif
 }
 
+/* Detect the compiler used to build the interpreter */
+JANET_CORE_FN(os_compiler,
+              "(os/compiler)",
+              "Get the compiler used to compile the interpreter. Returns one of:\n\n"
+              "* :gcc\n\n"
+              "* :clang\n\n"
+              "* :msvc\n\n"
+              "* :unknown\n\n") {
+    janet_fixarity(argc, 0);
+    (void) argv;
+#if defined(_MSC_VER)
+    return janet_ckeywordv("msvc");
+#elif defined(__clang__)
+    return janet_ckeywordv("clang");
+#elif defined(__GNUC__)
+    return janet_ckeywordv("gcc");
+#else
+    return janet_ckeywordv("unknown");
+#endif
+}
+
 #undef janet_stringify1
 #undef janet_stringify
 
@@ -209,6 +242,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 +285,6 @@ JANET_CORE_FN(os_cpu_count,
 #endif
 }
 
-#ifndef JANET_REDUCED_OS
 
 #ifndef JANET_NO_PROCESSES
 
@@ -444,7 +478,9 @@ typedef struct {
 static JanetEVGenericMessage janet_proc_wait_subr(JanetEVGenericMessage args) {
     JanetProc *proc = (JanetProc *) args.argp;
     WaitForSingleObject(proc->pHandle, INFINITE);
-    GetExitCodeProcess(proc->pHandle, &args.tag);
+    DWORD exitcode = 0;
+    GetExitCodeProcess(proc->pHandle, &exitcode);
+    args.tag = (int32_t) exitcode;
     return args;
 }
 
@@ -470,15 +506,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 +517,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;
@@ -913,9 +937,6 @@ static Janet os_execute_impl(int32_t argc, Janet *argv, int is_spawn) {
         janet_panic("failed to create pipes");
     }
 
-    /* Result */
-    int status = 0;
-
 #ifdef JANET_WINDOWS
 
     HANDLE pHandle, tHandle;
@@ -994,6 +1015,9 @@ static Janet os_execute_impl(int32_t argc, Janet *argv, int is_spawn) {
 
 #else
 
+    /* Result */
+    int status = 0;
+
     const char **child_argv = janet_smalloc(sizeof(char *) * ((size_t) exargs.len + 1));
     for (int32_t i = 0; i < exargs.len; i++)
         child_argv[i] = janet_getcstring(exargs.items, i);
@@ -1336,7 +1360,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 {
@@ -1780,9 +1804,11 @@ static Janet os_stat_changed(jstat_t *st) {
 }
 #ifdef JANET_WINDOWS
 static Janet os_stat_blocks(jstat_t *st) {
+    (void) st;
     return janet_wrap_number(0);
 }
 static Janet os_stat_blocksize(jstat_t *st) {
+    (void) st;
     return janet_wrap_number(0);
 }
 #else
@@ -1822,11 +1848,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 +1876,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));
@@ -1872,7 +1896,7 @@ static Janet os_stat_or_lstat(int do_lstat, int32_t argc, Janet *argv) {
 JANET_CORE_FN(os_stat,
               "(os/stat path &opt tab|key)",
               "Gets information about a file or directory. Returns a table if the second argument is a keyword, returns "
-              " only that information from stat. If the file or directory does not exist, returns nil. The keys are:\n\n"
+              "only that information from stat. If the file or directory does not exist, returns nil. The keys are:\n\n"
               "* :dev - the device that the file is on\n\n"
               "* :mode - the type of file, one of :file, :directory, :block, :character, :fifo, :socket, :link, or :other\n\n"
               "* :int-permissions - A Unix permission integer like 8r744\n\n"
@@ -1982,7 +2006,7 @@ JANET_CORE_FN(os_rename,
 JANET_CORE_FN(os_realpath,
               "(os/realpath path)",
               "Get the absolute path for a given path, following ../, ./, and symlinks. "
-              "Returns an absolute path as a string. Will raise an error on Windows.") {
+              "Returns an absolute path as a string.") {
     janet_fixarity(argc, 1);
     const char *src = janet_getcstring(argv, 0);
 #ifdef JANET_NO_REALPATH
@@ -2060,6 +2084,7 @@ JANET_CORE_FN(os_open,
     uint32_t stream_flags = 0;
     JanetHandle fd;
 #ifdef JANET_WINDOWS
+    (void) mode;
     DWORD desiredAccess = 0;
     DWORD shareMode = 0;
     DWORD creationDisp = 0;
@@ -2149,20 +2174,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 +2209,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);
@@ -2236,6 +2268,7 @@ void janet_lib_os(JanetTable *env) {
         JANET_CORE_REG("os/exit", os_exit),
         JANET_CORE_REG("os/which", os_which),
         JANET_CORE_REG("os/arch", os_arch),
+        JANET_CORE_REG("os/compiler", os_compiler),
 #ifndef JANET_REDUCED_OS
         JANET_CORE_REG("os/environ", os_environ),
         JANET_CORE_REG("os/getenv", os_getenv),

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. */
@@ -108,7 +109,7 @@ static void string_description_b(JanetBuffer *buffer, const char *title, void *p
     pbuf.p = pointer;
     *c++ = '<';
     /* Maximum of 32 bytes for abstract type name */
-    for (i = 0; title[i] && i < 32; ++i)
+    for (i = 0; i < 32 && title[i]; ++i)
         *c++ = ((uint8_t *)title) [i];
     *c++ = ' ';
     *c++ = '0';
@@ -750,14 +751,41 @@ 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)
@@ -776,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;
 }
 
@@ -804,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;
                 }
@@ -962,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 {
@@ -54,7 +60,7 @@ typedef struct {
     int is_error;
 } JanetTimeout;
 
-/* Registry table for C functions - containts metadata that can
+/* Registry table for C functions - contains metadata that can
  * be looked up by cfunction pointer. All strings here are pointing to
  * static memory not managed by Janet. */
 typedef struct {
@@ -85,7 +91,7 @@ struct JanetVM {
     int auto_suspend;
 
     /* The current running fiber on the current thread.
-     * Set and unset by janet_run. */
+     * Set and unset by functions in vm.c */
     JanetFiber *fiber;
     JanetFiber *root_fiber;
 
@@ -101,7 +107,7 @@ struct JanetVM {
     size_t registry_count;
     int registry_dirty;
 
-    /* Registry for abstract abstract types that can be marshalled.
+    /* Registry for abstract types that can be marshalled.
      * We need this to look up the constructors when unmarshalling. */
     JanetTable *abstract_registry;
 
@@ -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

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,15 @@
 #endif
 #endif
 
+#ifdef JANET_WINDOWS
+#ifdef JANET_DYNAMIC_MODULES
+#include <psapi.h>
+#ifdef JANET_MSVC
+#pragma comment (lib, "Psapi.lib")
+#endif
+#endif
+#endif
+
 #ifdef JANET_APPLE
 #include <AvailabilityMacros.h>
 #endif
@@ -694,15 +703,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;
 }
@@ -846,13 +865,13 @@ int janet_cryptorand(uint8_t *out, size_t n) {
         unsigned int v;
         if (rand_s(&v))
             return -1;
-        for (int32_t j = 0; (j < sizeof(unsigned int)) && (i + j < n); j++) {
+        for (int32_t j = 0; (j < (int32_t) sizeof(unsigned int)) && (i + j < n); j++) {
             out[i + j] = v & 0xff;
             v = v >> 8;
         }
     }
     return 0;
-#elif defined(JANET_LINUX) || ( defined(JANET_APPLE) && !defined(MAC_OS_X_VERSION_10_7) )
+#elif defined(JANET_LINUX) || defined(JANET_CYGWIN) || ( defined(JANET_APPLE) && !defined(MAC_OS_X_VERSION_10_7) )
     /* We should be able to call getrandom on linux, but it doesn't seem
        to be uniformly supported on linux distros.
        On Mac, arc4random_buf wasn't available on until 10.7.
@@ -903,7 +922,15 @@ char *get_processed_name(const char *name) {
     return ret;
 }
 
+#if defined(JANET_NO_DYNAMIC_MODULES)
+
+const char *error_clib(void) {
+    return "dynamic modules not supported";
+}
+
+#else
 #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 +947,36 @@ 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
 #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
@@ -135,13 +135,13 @@ int janet_gettime(struct timespec *spec);
 typedef int Clib;
 #define load_clib(name) ((void) name, 0)
 #define symbol_clib(lib, sym) ((void) lib, (void) sym, NULL)
-#define error_clib() "dynamic libraries not supported"
+const char *error_clib(void);
 #define free_clib(c) ((void) (c), 0)
 #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
@@ -150,7 +150,7 @@ typedef void *Clib;
 #define load_clib(name) dlopen((name), RTLD_NOW)
 #define free_clib(lib) dlclose((lib))
 #define symbol_clib(lib, sym) dlsym((lib), (sym))
-#define error_clib() dlerror()
+#define error_clib dlerror
 #endif
 char *get_processed_name(const char *name);
 

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,11 +350,8 @@ 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) */
                 uintptr_t diff = (uintptr_t) janet_unwrap_pointer(x);
@@ -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
@@ -918,7 +918,7 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in) {
             int32_t i;
             for (i = 0; i < elen; ++i) {
                 int32_t inherit = fd->environments[i];
-                if (inherit == -1) {
+                if (inherit == -1 || inherit >= func->def->environments_length) {
                     JanetStackFrame *frame = janet_stack_frame(stack);
                     if (!frame->env) {
                         /* Lazy capture of current stack frame */

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
@@ -67,6 +67,11 @@ extern "C" {
 #define JANET_LINUX 1
 #endif
 
+/* Check for Cygwin */
+#if defined(__CYGWIN__)
+#define JANET_CYGWIN 1
+#endif
+
 /* Check Unix */
 #if defined(_AIX) \
     || defined(__APPLE__) /* Darwin */ \
@@ -87,6 +92,16 @@ extern "C" {
 #define JANET_WINDOWS 1
 #endif
 
+/* Check if compiling with MSVC - else assume a GCC-like compiler by default */
+#ifdef _MSC_VER
+#define JANET_MSVC
+#endif
+
+/* Check Mingw 32-bit and 64-bit */
+#ifdef __MINGW32__
+#define JANET_MINGW
+#endif
+
 /* Check 64-bit vs 32-bit */
 #if ((defined(__x86_64__) || defined(_M_X64)) \
      && (defined(JANET_POSIX) || defined(JANET_WINDOWS))) \
@@ -96,7 +111,8 @@ extern "C" {
     || (defined(__sparc__) && defined(__arch64__) || defined (__sparcv9)) /* BE */ \
     || defined(__s390x__) /* S390 64-bit (BE) */ \
     || (defined(__ppc64__) || defined(__PPC64__)) \
-    || defined(__aarch64__) /* ARM 64-bit */
+    || defined(__aarch64__) /* ARM 64-bit */ \
+    || (defined(__riscv) && (__riscv_xlen == 64)) /* RISC-V 64-bit */
 #define JANET_64 1
 #else
 #define JANET_32 1
@@ -164,13 +180,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 +259,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.
@@ -333,7 +356,7 @@ typedef struct JanetOSRWLock JanetOSRWLock;
 
 /* What to do when out of memory */
 #ifndef JANET_OUT_OF_MEMORY
-#define JANET_OUT_OF_MEMORY do { fprintf(stderr, "janet out of memory\n"); exit(1); } while (0)
+#define JANET_OUT_OF_MEMORY do { fprintf(stderr, "%s:%d - janet out of memory\n", __FILE__, __LINE__); exit(1); } while (0)
 #endif
 
 #ifdef JANET_BSD
@@ -425,6 +448,7 @@ typedef struct JanetReg JanetReg;
 typedef struct JanetRegExt JanetRegExt;
 typedef struct JanetMethod JanetMethod;
 typedef struct JanetSourceMapping JanetSourceMapping;
+typedef struct JanetSymbolMap JanetSymbolMap;
 typedef struct JanetView JanetView;
 typedef struct JanetByteView JanetByteView;
 typedef struct JanetDictView JanetDictView;
@@ -980,6 +1004,7 @@ struct JanetAbstractHead {
 /* Some function definition flags */
 #define JANET_FUNCDEF_FLAG_VARARG 0x10000
 #define JANET_FUNCDEF_FLAG_NEEDSENV 0x20000
+#define JANET_FUNCDEF_FLAG_HASSYMBOLMAP 0x40000
 #define JANET_FUNCDEF_FLAG_HASNAME 0x80000
 #define JANET_FUNCDEF_FLAG_HASSOURCE 0x100000
 #define JANET_FUNCDEF_FLAG_HASDEFS 0x200000
@@ -995,6 +1020,14 @@ struct JanetSourceMapping {
     int32_t column;
 };
 
+/* Symbol to slot mapping & lifetime structure. */
+struct JanetSymbolMap {
+    uint32_t birth_pc;
+    uint32_t death_pc;
+    uint32_t slot_index;
+    const uint8_t *symbol;
+};
+
 /* A function definition. Contains information needed to instantiate closures. */
 struct JanetFuncDef {
     JanetGCObject gc;
@@ -1008,6 +1041,7 @@ struct JanetFuncDef {
     JanetSourceMapping *sourcemap;
     JanetString source;
     JanetString name;
+    JanetSymbolMap *symbolmap;
 
     int32_t flags;
     int32_t slotcount; /* The amount of stack space required for the function */
@@ -1018,6 +1052,7 @@ struct JanetFuncDef {
     int32_t bytecode_length;
     int32_t environments_length;
     int32_t defs_length;
+    int32_t symbolmap_length;
 };
 
 /* A function environment */
@@ -1093,6 +1128,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 +1147,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 +1710,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
@@ -33,6 +33,9 @@
 #ifndef ENABLE_VIRTUAL_TERMINAL_PROCESSING
 #define ENABLE_VIRTUAL_TERMINAL_PROCESSING 0x0004
 #endif
+#ifndef ENABLE_VIRTUAL_TERMINAL_INPUT
+#define ENABLE_VIRTUAL_TERMINAL_INPUT 0x0200
+#endif
 #endif
 
 void janet_line_init();
@@ -296,6 +299,7 @@ static char *sdup(const char *s) {
     return memcpy(mem, s, len);
 }
 
+#ifndef _WIN32
 static int curpos(void) {
     char buf[32];
     int cols, rows;
@@ -311,6 +315,7 @@ static int curpos(void) {
     if (sscanf(buf + 2, "%d;%d", &rows, &cols) != 2) return -1;
     return cols;
 }
+#endif
 
 static int getcols(void) {
 #ifdef _WIN32
@@ -950,6 +955,7 @@ static int line() {
                 break;
 #ifndef _WIN32
             case 26: /* ctrl-z */
+                clearlines();
                 norawmode();
                 kill(getpid(), SIGSTOP);
                 rawmode();

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
@@ -144,7 +144,7 @@
 (assert (< 1000 1e23) "greater than immediate 2")
 
 # os/execute with environment variables
-(assert (= 0 (os/execute [(dyn :executable) "-e" "(+ 1 2 3)"] :pe {"HELLO" "WORLD"})) "os/execute with env")
+(assert (= 0 (os/execute [(dyn :executable) "-e" "(+ 1 2 3)"] :pe (merge (os/environ) {"HELLO" "WORLD"}))) "os/execute with env")
 
 # Regression #638
 (compwhen

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
@@ -102,5 +102,7 @@
   (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)
+(def f (asm (disasm (fn [x] (fn [y] (+ x y))))))
+(assert (= ((f 10) 37) 47) "asm environment tables")
 
+(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

@@ -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
@@ -27,4 +27,17 @@
 (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)

test/suite0015.janet

@@ -0,0 +1,44 @@
+# test *debug* flags
+
+(import ./helper :prefix "" :exit true)
+(start-suite 15)
+
+(assert (deep= (in (disasm (defn a [] (def x 10) x)) :symbolmap)
+               @[[0 3 0 'a] [1 3 1 'x]])
+        "symbolslots when *debug* is true")
+
+(defn a [arg]
+  (def x 10)
+  (do
+    (def y 20)
+    (def z 30)
+    (+ x y z)))
+(def symbolslots (in (disasm a) :symbolslots))
+(def f (asm (disasm a)))
+(assert (deep= (in (disasm f) :symbolslots)
+               symbolslots)
+        "symbolslots survive disasm/asm")
+
+# need to fix upvalues
+(comment
+  (setdyn *debug* true)
+  (setdyn :pretty-format "%.40M")
+  (def f (fn [x] (fn [y] (+ x y))))
+  (assert (deep= (map last (in (disasm (f 10)) :symbolmap))
+                 @['x 'y])
+          "symbolslots upvalues"))
+
+(assert (deep= (in (disasm (defn a [arg]
+                             (def x 10)
+                             (do
+                               (def y 20)
+                               (def z 30)
+                               (+ x y z)))) :symbolmap)
+               @[[0 7 0 'arg]
+                 [0 7 1 'a]
+                 [1 7 2 'x]
+                 [2 7 3 'y]
+                 [3 7 4 'z]])
+        "arg & inner symbolslots")
+
+(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