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.

.builds/freebsd.yml

@@ -9,4 +9,3 @@ tasks:
     gmake
     gmake test
     sudo gmake install
-    gmake test-install

.builds/linux.yml

@@ -19,5 +19,3 @@ tasks:
     ninja
     ninja test
     sudo ninja install
-    sudo jpm --verbose install circlet
-    sudo jpm --verbose install spork

.builds/openbsd.yml

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

.gitattributes

@@ -1,5 +1,4 @@
-*.janet linguist-language=Clojure
-
+*.janet linguist-language=Janet
 *.janet text eol=lf
 *.c text eol=lf
 *.h text eol=lf

.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/release.yml

@@ -0,0 +1,62 @@
+name: Release
+
+on:
+  push:
+    tags:
+      - "v*.*.*"
+
+permissions:
+  contents: read
+
+jobs:
+
+  release:
+    permissions:
+      contents: write  # for softprops/action-gh-release to create GitHub release
+    name: Build release binaries
+    runs-on: ${{ matrix.os }}
+    strategy:
+      matrix:
+        os: [ ubuntu-latest, macos-latest ]
+    steps:
+      - name: Checkout the repository
+        uses: actions/checkout@master
+      - name: Set the version
+        run: echo "version=${GITHUB_REF/refs\/tags\//}" >> $GITHUB_ENV
+      - name: Set the platform
+        run: echo "platform=$(tr '[A-Z]' '[a-z]' <<< $RUNNER_OS)" >> $GITHUB_ENV
+      - name: Compile the project
+        run: make clean && make
+      - name: Build the artifact
+        run: JANET_DIST_DIR=janet-${{ env.version }}-${{ env.platform }} make build/janet-${{ env.version }}-${{ env.platform }}-x64.tar.gz
+      - name: Draft the release
+        uses: softprops/action-gh-release@v1
+        with:
+          draft: true
+          files: |
+            build/*.gz
+            build/janet.h
+            build/c/janet.c
+            build/c/shell.c
+
+  release-windows:
+    permissions:
+      contents: write  # for softprops/action-gh-release to create GitHub release
+    name: Build release binaries for windows
+    runs-on: windows-latest
+    steps:
+      - name: Checkout the repository
+        uses: actions/checkout@master
+      - name: Setup MSVC
+        uses: ilammy/msvc-dev-cmd@v1
+      - name: Build the project
+        shell: cmd
+        run: build_win all
+      - name: Draft the release
+        uses: softprops/action-gh-release@v1
+        with:
+          draft: true
+          files: |
+            ./dist/*.zip
+            ./*.zip
+            ./*.msi

.github/workflows/test.yml

@@ -0,0 +1,59 @@
+name: Test
+
+on: [push, pull_request]
+
+permissions:
+  contents: read
+
+jobs:
+
+  test-posix:
+    name: Build and test on POSIX systems
+    runs-on: ${{ matrix.os }}
+    strategy:
+      matrix:
+        os: [ ubuntu-latest, macos-latest ]
+    steps:
+      - name: Checkout the repository
+        uses: actions/checkout@master
+      - name: Compile the project
+        run: make clean && make
+      - name: Test the project
+        run: make test
+
+  test-windows:
+    name: Build and test on Windows
+    runs-on: windows-latest
+    steps:
+      - name: Checkout the repository
+        uses: actions/checkout@master
+      - name: Setup MSVC
+        uses: ilammy/msvc-dev-cmd@v1
+      - name: Build the project
+        shell: cmd
+        run: build_win
+      - 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

@@ -34,6 +34,7 @@ local
 
 # Common test files I use.
 temp.janet
+temp*.janet
 scratch.janet
 
 # Emscripten
@@ -67,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 ###

.travis.yml

@@ -1,25 +0,0 @@
-language: c
-script:
-- make
-- make test
-- sudo make install
-- make test-install
-- JANET_DIST_DIR=janet-${TRAVIS_TAG}-${TRAVIS_OS_NAME} make build/janet-${TRAVIS_TAG}-${TRAVIS_OS_NAME}.tar.gz
-compiler:
-- clang
-- gcc
-os:
-- linux
-- osx
-before_deploy: 
-deploy:
-  provider: releases
-  api_key:
-    secure: JSqAOTH1jmfVlbOuPO3BbY1BhPq+ddiBNPCxuAyKHoVwfO4eNAmq9COI+UwCMWY3dg+YlspufRwkHj//B7QQ6hPbSsKu+Mapu6gr/CAE/jxbfO/E98LkIkUwbGjplwtzw2kiBkHN/Bu6J5X76cwo4D8nwQ1JIcV3nWtoG87t7H4W0R4AYQkbLGAPylgUFr11YMPx2cRBBqCdLAGIrny7kQ/0cRBfkN81R/gUJv/q3OjmUvY7sALXp7mFdZb75QPSilKIDuVUU5hLvPYTeRl6cWI/M+m5SmGZx1rjv5S9Qaw070XoNyt9JAADtbOUnADKvDguDZIP1FCuT1Gb+cnJPzrvk6+OBU9s8UjCTFtgV+LKlhmRZcwV5YQBE94PKRMJNC6VvIWM7UeQ8Zhm1jmQS6ONNWbuoUAlkZP57NtDQa2x0GT2wkubNSQKlaY+6/gwTD9KAJIzaZG7HYXH7b+4g7VbccCyhDAtDZtXgrOIS4WAkNc8rWezRO4H0qHMyON9aCEb0eTE8hWIufbx6ymG4gUxnYO+AkrEYMCwQvU6lS8BsevkaMTVtSShqlQtJ9FRlmJA3MA2ONyqzQXJENqRydyVbpFrKSv+0HbMyhEc5BoKbt0QcTh/slouNV4eASNar/GKN7aP8XKGUeMwIoCcRpP+3ehmwX9SUw7Ah5S42pA=
-  file: build/janet-${TRAVIS_TAG}-${TRAVIS_OS_NAME}.tar.gz
-  draft: true
-  skip_cleanup: true
-  on:
-    tags: true
-    repo: janet-lang/janet
-    condition: "$CC = clang"

CHANGELOG.md

@@ -1,6 +1,168 @@
 # Changelog
 All notable changes to this project will be documented in this file.
 
+## ??? - 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 auto-completion and
+  other shell-like input features.
+- Improve default error message from `assert`.
+- Add the `tabseq` macro for simpler table comprehensions.
+- Allow setting `(dyn :task-id)` in fibers to improve context in supervisor messages. Prior to
+  this change, supervisor messages over threaded channels would be from ambiguous threads/fibers.
+
+## 1.23.0 - 2022-06-20
+- Add experimental `ffi/` module for interfacing with dynamic libraries and raw function pointers. Only available
+  on 64 bit linux, mac, and bsd systems.
+- Allow using `&named` in function prototypes for named arguments. This is a more ergonomic
+  variant of `&keys` that isn't as redundant, more self documenting, and allows extension to
+  things like default arguments.
+- Add `delay` macro for lazy evaluate-and-save thunks.
+- Remove pthread.h from janet.h for easier includes.
+- Add `debugger` - an easy to use debugger function that just takes a fiber.
+- `dofile` will now start a debugger on errors if the environment it is passed has `:debug` set.
+- Add `debugger-on-status` function, which can be passed to `run-context` to start a debugger on
+  abnormal fiber signals.
+- Allow running scripts with the `-d` flag to use the built-in debugger on errors and breakpoints.
+- Add mutexes (locks) and reader-writer locks to ev module for thread coordination.
+- Add `parse-all` as a generalization of the `parse` function.
+- Add `os/cpu-count` to get the number of available processors on a machine
+
+## 1.22.0 - 2022-05-09
+- Prohibit negative size argument to `table/new`.
+- Add `module/value`.
+- Remove `file/popen`. Use `os/spawn` with the `:pipe` options instead.
+- Fix bug in peg `thru` and `to` combinators.
+- Fix printing issue in `doc` macro.
+- Numerous updates to function docstrings
+- Add `defdyn` aliases for various dynamic bindings used in core.
+- Install `janet.h` symlink to make Janet native libraries and applications
+  easier to build without `jpm`.
+
+## 1.21.2 - 2022-04-01
+- C functions `janet_dobytes` and `janet_dostring` will now enter the event loop if it is enabled.
+- Fix hashing regression - hash of negative 0 must be the same as positive 0 since they are equal.
+- The `flycheck` function no longer pollutes the module/cache
+- Fix quasiquote bug in compiler
+- Disallow use of `cancel` and `resume` on fibers scheduled or created with `ev/go`, as well as the root
+  fiber.
+
+## 1.20.0 - 2022-1-27
+- Add `:missing-symbol` hook to `compile` that will act as a catch-all macro for undefined symbols.
+- Add `:redef` dynamic binding that will allow users to redefine top-level bindings with late binding. This
+  is intended for development use.
+- Fix a bug with reading from a stream returned by `os/open` on Windows and Linux.
+- Add `:ppc64` as a detectable OS type.
+- Add `& more` support for destructuring in the match macro.
+- Add `& more` support for destructuring in all binding forms (`def`).
+
+## 1.19.2 - 2021-12-06
+- Fix bug with missing status lines in some stack traces.
+- Update hash function to have better statistical properties.
+
+## 1.19.1 - 2021-12-04
+- Add an optional `prefix` parameter to `debug/stacktrace` to allow printing prettier error messages.
+- Remove appveyor for CI pipeline
+- Fixed a bug that prevented sending threaded abstracts over threaded channels.
+- Fix bug in the `map` function with arity at least 3.
+
+## 1.19.0 - 2021-11-27
+- Add `math/log-gamma` to replace `math/gamma`, and change `math/gamma` to be the expected gamma function.
+- Fix leaking file-descriptors in os/spawn and os/execute.
+- Ctrl-C will now raise SIGINT.
+- Allow quoted literals in the `match` macro to behave as expected in patterns.
+- Fix windows net related bug for TCP servers.
+- Allow evaluating ev streams with dofile.
+- Fix `ev` related bug with operations on already closed file descriptors.
+- Add struct and table agnostic `getproto` function.
+- Add a number of functions related to structs.
+- Add prototypes to structs. Structs can now inherit from other structs, just like tables.
+- Create a struct with a prototype with `struct/with-proto`.
+- Deadlocked channels will no longer exit early - instead they will hang, which is more intuitive.
+
+## 1.18.1 - 2021-10-16
+- Fix some documentation typos
+- Fix - Set pipes passed to subprocess to blocking mode.
+- Fix `-r` switch in repl.
+
+## 1.18.0 - 2021-10-10
+- Allow `ev/cancel` to work on already scheduled fibers.
+- Fix bugs with ev/ module.
+- Add optional `base` argument to scan-number
+- Add `-i` flag to janet binary to make it easier to run image files from the command line
+- Remove `thread/` module.
+- Add `(number ...)` pattern to peg for more efficient number parsing using Janet's
+  scan-number function without immediate string creation.
+
+## 1.17.2 - 2021-09-18
+- Remove include of windows.h from janet.h. This caused issues on certain projects.
+- Fix formatting in doc-format to better handle special characters in signatures.
+- Fix some marshalling bugs.
+- Add optional Makefile target to install jpm as well.
+- Supervisor channels in threads will no longer include a wasteful copy of the fiber in every
+  message across a thread.
+- Allow passing a closure to `ev/thread` as well as a whole fiber.
+- Allow passing a closure directly to `ev/go` to spawn fibers on the event loop.
+
+## 1.17.1 - 2021-08-29
+- Fix docstring typos
+- Add `make install-jpm-git` to make jpm co-install simpler if using the Makefile.
+- Fix bugs with starting ev/threads and fiber marshaling.
+
+## 1.17.0 - 2021-08-21
+- Add the `-E` flag for one-liners with the `short-fn` syntax for argument passing.
+- Add support for threaded abstract types. Threaded abstract types can easily be shared between threads.
+- Deprecate the `thread` library. Use threaded channels and ev instead.
+- Channels can now be marshalled.
+- Add the ability to close channels with `ev/chan-close` (or `:close`).
+- Add threaded channels with `ev/thread-chan`.
+- Add `JANET_FN` and `JANET_REG` macros to more easily define C functions that export their source mapping information.
+- Add `janet_interpreter_interupt` and `janet_loop1_interrupt` to interrupt the interpreter while running.
+- Add `table/clear`
+- Add build option to disable the threading library without disabling all threads.
+- Remove JPM from the main Janet distribution. Instead, JPM must be installed
+  separately like any other package.
+- Fix issue with `ev/go` when called with an initial value and supervisor.
+- Add the C API functions `janet_vm_save` and `janet_vm_load` to allow
+saving and restoring the entire VM state.
+
 ## 1.16.1 - 2021-06-09
 - Add `maclintf` - a utility for adding linting messages when inside macros.
 - Print source code of offending line on compiler warnings and errors.
@@ -20,7 +182,7 @@ All notable changes to this project will be documented in this file.
 - Add compiler warnings and deprecation levels.
 - Add `as-macro` to make using macros within quasiquote easier to do hygienically.
 - Expose `JANET_OUT_OF_MEMORY` as part of the Janet API.
-- Add `native-deps` option to `decalre-native` in `jpm`. This lets native libraries link to other
+- Add `native-deps` option to `declare-native` in `jpm`. This lets native libraries link to other
   native libraries when building with jpm.
 - Remove the `tarray` module. The functionality of typed arrays will be moved to an external module
   that can be installed via `jpm`.

CONTRIBUTING.md

@@ -43,7 +43,7 @@ For changes to the VM and Core code, you will probably need to know C. Janet is
 a subset of C99 that works with Microsoft Visual C++. This means most of C99 but with the following
 omissions.
 
-* No `restrict` 
+* No `restrict`
 * Certain functions in the standard library are not always available
 
 In practice, this means programming for both MSVC on one hand and everything else on the other.
@@ -64,6 +64,23 @@ ensure a consistent code style for C.
 All janet code in the project should be formatted similar to the code in core.janet.
 The auto formatting from janet.vim will work well.
 
+## Typo Fixing and One-Line changes
+
+Typo fixes are welcome, as are simple one line fixes. Do not open many separate pull requests for each
+individual typo fix. This is incredibly annoying to deal with as someone needs to review each PR, run
+CI, and merge. Instead, accumulate batches of typo fixes into a single PR. If there are objections to
+specific changes, these can be addressed in the review process before the final merge, if the changes
+are accepted.
+
+Similarly, low effort and bad faith changes are annoying to developers and such issues may be closed
+immediately without response.
+
+## Contributions from Automated Tools
+
+People making changes found or generated by automated tools MUST note this when opening an issue
+or creating a pull request. This can help give context to developers if the change/issue is
+confusing or nonsensical.
+
 ## Suggesting Changes
 
 To suggest changes, open an issue on GitHub. Check GitHub for other issues

LICENSE

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

Makefile

@@ -1,4 +1,4 @@
-# Copyright (c) 2021 Calvin Rose
+# Copyright (c) 2023 Calvin Rose
 #
 # Permission is hereby granted, free of charge, to any person obtaining a copy
 # of this software and associated documentation files (the "Software"), to
@@ -21,21 +21,24 @@
 ################################
 ##### 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
 JANET_MANPATH?=$(PREFIX)/share/man/man1/
 JANET_PKG_CONFIG_PATH?=$(LIBDIR)/pkgconfig
 JANET_DIST_DIR?=janet-dist
+JPM_TAG?=master
 DEBUGGER=gdb
 SONAME_SETTER=-Wl,-soname,
 
@@ -57,15 +60,29 @@ UNAME:=$(shell uname -s)
 ifeq ($(UNAME), Darwin)
 	CLIBS:=$(CLIBS) -ldl
 	SONAME_SETTER:=-Wl,-install_name,
+	JANET_LIBRARY=build/libjanet.dylib
 	LDCONFIG:=true
 else ifeq ($(UNAME), Linux)
 	CLIBS:=$(CLIBS) -lrt -ldl
 endif
+
 # For other unix likes, add flags here!
 ifeq ($(UNAME), Haiku)
 	LDCONFIG:=true
 	LDFLAGS=-Wl,--export-dynamic
 endif
+# For Android (termux)
+ifeq ($(UNAME), Linux) # uname on Darwin doesn't recognise -o
+ifeq ($(shell uname -o), Android)
+	CLIBS:=$(CLIBS) -landroid-spawn
+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
@@ -74,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 \
@@ -99,6 +116,7 @@ JANET_CORE_SOURCES=src/core/abstract.c \
 				   src/core/debug.c \
 				   src/core/emit.c \
 				   src/core/ev.c \
+				   src/core/ffi.c \
 				   src/core/fiber.c \
 				   src/core/gc.c \
 				   src/core/inttypes.c \
@@ -113,12 +131,12 @@ JANET_CORE_SOURCES=src/core/abstract.c \
 				   src/core/regalloc.c \
 				   src/core/run.c \
 				   src/core/specials.c \
+				   src/core/state.c \
 				   src/core/string.c \
 				   src/core/strtod.c \
 				   src/core/struct.c \
 				   src/core/symcache.c \
 				   src/core/table.c \
-				   src/core/thread.c \
 				   src/core/tuple.c \
 				   src/core/util.c \
 				   src/core/value.c \
@@ -157,21 +175,25 @@ build/c/janet.c: build/janet_boot src/boot/boot.janet
 ##### Amalgamation #####
 ########################
 
-SONAME=libjanet.so.1.16
+ifeq ($(UNAME), Darwin)
+SONAME=libjanet.1.26.dylib
+else
+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
@@ -205,12 +227,10 @@ valgrind: $(JANET_TARGET)
 test: $(JANET_TARGET) $(TEST_PROGRAMS)
 	for f in test/suite*.janet; do ./$(JANET_TARGET) "$$f" || exit; done
 	for f in examples/*.janet; do ./$(JANET_TARGET) -k "$$f"; done
-	./$(JANET_TARGET) -k jpm
 
 valtest: $(JANET_TARGET) $(TEST_PROGRAMS)
 	for f in test/suite*.janet; do $(VALGRIND_COMMAND) ./$(JANET_TARGET) "$$f" || exit; done
 	for f in examples/*.janet; do ./$(JANET_TARGET) -k "$$f"; done
-	$(VALGRIND_COMMAND) ./$(JANET_TARGET) -k jpm
 
 callgrind: $(JANET_TARGET)
 	for f in test/suite*.janet; do valgrind --tool=callgrind ./$(JANET_TARGET) "$$f" || exit; done
@@ -223,17 +243,16 @@ dist: build/janet-dist.tar.gz
 
 build/janet-%.tar.gz: $(JANET_TARGET) \
 	build/janet.h \
-	jpm.1 janet.1 LICENSE CONTRIBUTING.md $(JANET_LIBRARY) $(JANET_STATIC_LIBRARY) \
-	README.md build/c/janet.c build/c/shell.c jpm
+	janet.1 LICENSE CONTRIBUTING.md $(JANET_LIBRARY) $(JANET_STATIC_LIBRARY) \
+	README.md build/c/janet.c build/c/shell.c
 	mkdir -p build/$(JANET_DIST_DIR)/bin
 	cp $(JANET_TARGET) build/$(JANET_DIST_DIR)/bin/
-	cp jpm build/$(JANET_DIST_DIR)/bin/
 	mkdir -p build/$(JANET_DIST_DIR)/include
 	cp build/janet.h build/$(JANET_DIST_DIR)/include/
 	mkdir -p build/$(JANET_DIST_DIR)/lib/
 	cp $(JANET_LIBRARY) $(JANET_STATIC_LIBRARY) build/$(JANET_DIST_DIR)/lib/
 	mkdir -p build/$(JANET_DIST_DIR)/man/man1/
-	cp janet.1 jpm.1 build/$(JANET_DIST_DIR)/man/man1/
+	cp janet.1 build/$(JANET_DIST_DIR)/man/man1/janet.1
 	mkdir -p build/$(JANET_DIST_DIR)/src/
 	cp build/c/janet.c build/c/shell.c build/$(JANET_DIST_DIR)/src/
 	cp CONTRIBUTING.md LICENSE README.md build/$(JANET_DIST_DIR)/
@@ -252,10 +271,6 @@ build/doc.html: $(JANET_TARGET) tools/gendoc.janet
 ##### Installation #####
 ########################
 
-build/jpm: jpm $(JANET_TARGET)
-	$(JANET_TARGET) tools/patch-jpm.janet jpm build/jpm "--libpath=$(LIBDIR)" "--headerpath=$(INCLUDEDIR)/janet" "--binpath=$(BINDIR)"
-	chmod +x build/jpm
-
 .INTERMEDIATE: build/janet.pc
 build/janet.pc: $(JANET_TARGET)
 	echo 'prefix=$(PREFIX)' > $@
@@ -271,33 +286,50 @@ build/janet.pc: $(JANET_TARGET)
 	echo 'Libs: -L$${libdir} -ljanet' >> $@
 	echo 'Libs.private: $(CLIBS)' >> $@
 
-install: $(JANET_TARGET) $(JANET_LIBRARY) $(JANET_STATIC_LIBRARY) build/janet.pc build/jpm build/janet.h
+install: $(JANET_TARGET) $(JANET_LIBRARY) $(JANET_STATIC_LIBRARY) build/janet.pc build/janet.h
 	mkdir -p '$(DESTDIR)$(BINDIR)'
 	cp $(JANET_TARGET) '$(DESTDIR)$(BINDIR)/janet'
 	mkdir -p '$(DESTDIR)$(INCLUDEDIR)/janet'
 	cp -r build/janet.h '$(DESTDIR)$(INCLUDEDIR)/janet'
+	ln -sf -T ./janet/janet.h '$(DESTDIR)$(INCLUDEDIR)/janet.h' || true #fixme bsd
 	mkdir -p '$(DESTDIR)$(JANET_PATH)'
 	mkdir -p '$(DESTDIR)$(LIBDIR)'
-	cp $(JANET_LIBRARY) '$(DESTDIR)$(LIBDIR)/libjanet.so.$(shell $(JANET_TARGET) -e '(print janet/version)')'
+	if test $(UNAME) = Darwin ; then \
+		cp $(JANET_LIBRARY) '$(DESTDIR)$(LIBDIR)/libjanet.$(shell $(JANET_TARGET) -e '(print janet/version)').dylib' ; \
+		ln -sf $(SONAME) '$(DESTDIR)$(LIBDIR)/libjanet.dylib' ; \
+		ln -sf libjanet.$(shell $(JANET_TARGET) -e '(print janet/version)').dylib $(DESTDIR)$(LIBDIR)/$(SONAME) ; \
+	else \
+		cp $(JANET_LIBRARY) '$(DESTDIR)$(LIBDIR)/libjanet.so.$(shell $(JANET_TARGET) -e '(print janet/version)')' ; \
+		ln -sf $(SONAME) '$(DESTDIR)$(LIBDIR)/libjanet.so' ; \
+		ln -sf libjanet.so.$(shell $(JANET_TARGET) -e '(print janet/version)') $(DESTDIR)$(LIBDIR)/$(SONAME) ; \
+	fi
 	cp $(JANET_STATIC_LIBRARY) '$(DESTDIR)$(LIBDIR)/libjanet.a'
-	ln -sf $(SONAME) '$(DESTDIR)$(LIBDIR)/libjanet.so'
-	ln -sf libjanet.so.$(shell $(JANET_TARGET) -e '(print janet/version)') $(DESTDIR)$(LIBDIR)/$(SONAME)
-	cp -rf build/jpm '$(DESTDIR)$(BINDIR)'
 	mkdir -p '$(DESTDIR)$(JANET_MANPATH)'
 	cp janet.1 '$(DESTDIR)$(JANET_MANPATH)'
-	cp jpm.1 '$(DESTDIR)$(JANET_MANPATH)'
 	mkdir -p '$(DESTDIR)$(JANET_PKG_CONFIG_PATH)'
 	cp build/janet.pc '$(DESTDIR)$(JANET_PKG_CONFIG_PATH)/janet.pc'
-	[ -z '$(DESTDIR)' ] && $(LDCONFIG) || true
+	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)
+	mkdir -p build
+	rm -rf build/jpm
+	git clone --depth=1 --branch='$(JPM_TAG)' https://github.com/janet-lang/jpm.git build/jpm
+	cd build/jpm && PREFIX='$(PREFIX)' \
+		DESTDIR=$(DESTDIR) \
+		JANET_MANPATH='$(JANET_MANPATH)' \
+		JANET_HEADERPATH='$(INCLUDEDIR)/janet' \
+		JANET_BINPATH='$(BINDIR)' \
+		JANET_LIBPATH='$(LIBDIR)' \
+		../../$(JANET_TARGET) ./bootstrap.janet
 
 uninstall:
 	-rm '$(DESTDIR)$(BINDIR)/janet'
-	-rm '$(DESTDIR)$(BINDIR)/jpm'
 	-rm -rf '$(DESTDIR)$(INCLUDEDIR)/janet'
+	-rm -rf '$(DESTDIR)$(INCLUDEDIR)/janet.h'
 	-rm -rf '$(DESTDIR)$(LIBDIR)'/libjanet.*
 	-rm '$(DESTDIR)$(JANET_PKG_CONFIG_PATH)/janet.pc'
 	-rm '$(DESTDIR)$(JANET_MANPATH)/janet.1'
-	-rm '$(DESTDIR)$(JANET_MANPATH)/jpm.1'
 	# -rm -rf '$(DESTDIR)$(JANET_PATH)'/* - err on the side of correctness here
 
 #################
@@ -320,18 +352,7 @@ clean:
 	-rm -rf test/install/build test/install/modpath
 
 test-install:
-	cd test/install \
-		&& rm -rf build .cache .manifests \
-		&& jpm --verbose build \
-		&& jpm --verbose test \
-		&& build/testexec \
-		&& jpm --verbose quickbin testexec.janet build/testexec2 \
-		&& build/testexec2 \
-		&& mkdir -p modpath \
-		&& jpm --verbose --testdeps --modpath=./modpath install https://github.com/janet-lang/json.git
-	cd test/install && jpm --verbose --test --modpath=./modpath install https://github.com/janet-lang/jhydro.git
-	cd test/install && jpm --verbose --test --modpath=./modpath install https://github.com/janet-lang/path.git
-	cd test/install && jpm --verbose --test --modpath=./modpath install https://github.com/janet-lang/argparse.git
+	echo "JPM has been removed from default install."
 
 help:
 	@echo

README.md

@@ -1,9 +1,8 @@
 [![Join the chat](https://badges.gitter.im/janet-language/community.svg)](https://gitter.im/janet-language/community)
  
-[![Appveyor Status](https://ci.appveyor.com/api/projects/status/bjraxrxexmt3sxyv/branch/master?svg=true)](https://ci.appveyor.com/project/bakpakin/janet/branch/master)
-[![Build Status](https://travis-ci.org/janet-lang/janet.svg?branch=master)](https://travis-ci.org/janet-lang/janet)
-[![builds.sr.ht status](https://builds.sr.ht/~bakpakin/janet/commits/freebsd.yml.svg)](https://builds.sr.ht/~bakpakin/janet/commits/freebsd.yml?)
-[![builds.sr.ht status](https://builds.sr.ht/~bakpakin/janet/commits/openbsd.yml.svg)](https://builds.sr.ht/~bakpakin/janet/commits/openbsd.yml?)
+[![builds.sr.ht status](https://builds.sr.ht/~bakpakin/janet/commits/master/freebsd.yml.svg)](https://builds.sr.ht/~bakpakin/janet/commits/master/freebsd.yml?)
+[![builds.sr.ht status](https://builds.sr.ht/~bakpakin/janet/commits/master/openbsd.yml.svg)](https://builds.sr.ht/~bakpakin/janet/commits/master/openbsd.yml?)
+[![Actions Status](https://github.com/janet-lang/janet/actions/workflows/test.yml/badge.svg)](https://github.com/janet-lang/janet/actions/workflows/test.yml)
 
 <img src="https://raw.githubusercontent.com/janet-lang/janet/master/assets/janet-w200.png" alt="Janet logo" width=200 align="left">
 
@@ -30,6 +29,7 @@ Lua, but smaller than GNU Guile or Python.
 
 ## Features
 
+* Configurable at build time - turn features on or off for a smaller or more featureful build
 * Minimal setup - one binary and you are good to go!
 * First-class closures
 * Garbage collection
@@ -39,6 +39,8 @@ Lua, but smaller than GNU Guile or Python.
 * Mutable and immutable hashtables (table/struct)
 * Mutable and immutable strings (buffer/string)
 * Macros
+* Multithreading
+* Per-thread event loop for efficient evented IO
 * Byte code interpreter with an assembly interface, as well as bytecode verification
 * Tail call Optimization
 * Direct interop with C via abstract types and C functions
@@ -87,6 +89,8 @@ cd somewhere/my/projects/janet
 make
 make test
 make repl
+make install
+make install-jpm-git
 ```
 
 Find out more about the available make targets by running `make help`.
@@ -101,6 +105,8 @@ cd somewhere/my/projects/janet
 make CC=gcc-x86
 make test
 make repl
+make install
+make install-jpm-git
 ```
 
 ### FreeBSD
@@ -114,6 +120,8 @@ cd somewhere/my/projects/janet
 gmake
 gmake test
 gmake repl
+gmake install
+gmake install-jpm-git
 ```
 
 ### NetBSD
@@ -211,7 +219,7 @@ Options are:
   -- : Stop handling options
 ```
 
-If installed, you can also run `man janet` and `man jpm` to get usage information.
+If installed, you can also run `man janet` to get usage information.
 
 ## Embedding
 
@@ -238,6 +246,52 @@ Gitter provides Matrix and irc bridges as well.
 
 ## FAQ
 
+### Where is (favorite feature from other language)?
+
+It may exist, it may not. If you want to propose major language features, go ahead and open an issue, but
+they will likely by closed as "will not implement". Often, such features make one usecase simpler at the expense
+of 5 others by making the language more complicated.
+
+### Is there a language spec?
+
+There is not currently a spec besides the documentation at https://janet-lang.org.
+
+### Is this Scheme/Common Lisp? Where are the cons cells?
+
+Nope. There are no cons cells here.
+
+### Is this a Clojure port?
+
+No. It's similar to Clojure superficially because I like Lisps and I like the aesthetics.
+Internally, Janet is not at all like Clojure.
+
+### Are the immutable data structures (tuples and structs) implemented as hash tries?
+
+No. They are immutable arrays and hash tables. Don't try and use them like Clojure's vectors
+and maps, instead they work well as table keys or other identifiers.
+
+### Can I do Object Oriented programming with Janet?
+
+To some extent, yes. However, it is not the recommended method of abstraction, and performance may suffer.
+That said, tables can be used to make mutable objects with inheritance and polymorphism, where object
+methods are implemeted with keywords.
+
+```
+(def Car @{:honk (fn [self msg] (print "car " self " goes " msg)) })
+(def my-car (table/setproto @{} Car))
+(:honk my-car "Beep!")
+```
+
+### Why can't we add (feature from Clojure) into the core?
+
+Usually, one of a few reasons:
+- Often, it already exists in a different form and the Clojure port would be redundant.
+- Clojure programs often generate a lot of garbage and rely on the JVM to clean it up.
+  Janet does not run on the JVM, and has a more primitive garbage collector.
+- We want to keep the Janet core small. With Lisps, usually a feature can be added as a library
+  without feeling "bolted on", especially when compared to ALGOL like languages. Adding features
+  to the core also makes it a bit more difficult to keep Janet maximally portable.
+
 ### Why is my terminal spitting out junk when I run the REPL?
 
 Make sure your terminal supports ANSI escape codes. Most modern terminals will
@@ -246,35 +300,6 @@ will not. If your terminal does not support ANSI escape codes, run the REPL with
 the `-n` flag, which disables color output. You can also try the `-s` if further issues
 ensue.
 
-### Where is (favorite feature from other language)?
-
-It may exist, it may not. If you want to propose major language features, go ahead and open an issue, but
-they will likely by closed as "will not implement". Often, such features make one usecase simpler at the expense
-of 5 others by making the language more complicated.
-
-### Where is the example code?
-
-In the examples directory.
-
-### Is this a Clojure port?
-
-No. It's similar to Clojure superficially because I like Lisps and I like the asthetics.
-Internally, Janet is not at all like Clojure.
-
-### Are the immutable data structures (tuples and structs) implemented as hash tries?
-
-No. They are immutable arrays and hash tables. Don't try and use them like Clojure's vectors
-and maps, instead they work well as table keys or other identifiers.
-
-### Why can't we add (feature from Clojure) into the core?
-
-Usually, one of a few reasons:
-- Often, it already exists in a different form and the Clojure port would be redundant.
-- Clojure programs often generate a lot of garbage and rely on the JVM to clean it up.
-  Janet does not run on the JVM. We admittedly have a much more primitive GC.
-- We want to keep the Janet core small. With Lisps, usually a feature can be added as a library
-  without feeling "bolted on", especially when compared to ALGOL like languages.
-
 ## Why is it called "Janet"?
 
 Janet is named after the almost omniscient and friendly artificial being in [The Good Place](https://en.wikipedia.org/wiki/The_Good_Place).

appveyor.yml

@@ -1,55 +0,0 @@
-version: build-{build}
-clone_folder: c:\projects\janet
-image:
-- Visual Studio 2019
-configuration:
-- Release
-platform:
-- x64
-- x86
-environment:
-  matrix:
-  - arch: Win64
-matrix:
-  fast_finish: true
-
-# skip unsupported combinations
-init:
-    - call "C:\Program Files (x86)\Microsoft Visual Studio\2019\Community\VC\Auxiliary\Build\vcvarsall.bat" %platform%
-
-install:
-    - set JANET_BUILD=%appveyor_repo_commit:~0,7%
-    - build_win all
-    - refreshenv
-    # We need to reload vcvars after refreshing
-    - call "C:\Program Files (x86)\Microsoft Visual Studio\2019\Community\VC\Auxiliary\Build\vcvarsall.bat" %platform%
-    - build_win test-install
-    - set janet_outname=%appveyor_repo_tag_name%
-    - if "%janet_outname%"=="" set /P janet_outname=<build\version.txt
-build: off
-
-artifacts:
-    - name: janet.c
-      path: dist\janet.c
-      type: File
-    - name: janet.h
-      path: dist\janet.h
-      type: File
-    - name: shell.c
-      path: dist\shell.c
-      type: File
-    - name: "janet-$(janet_outname)-windows-%platform%"
-      path: dist
-      type: Zip
-    - path: "janet-$(janet_outname)-windows-%platform%-installer.msi"
-      type: File
-
-deploy:
-  description: 'The Janet Programming Language.'
-  provider: GitHub
-  auth_token:
-    secure: lwEXy09qhj2jSH9s1C/KvCkAUqJSma8phFR+0kbsfUc3rVxpNK5uD3z9Md0SjYRx
-  artifact: /(janet|shell).*/
-  draft: true
-  on:
-      APPVEYOR_REPO_TAG: true

build_win.bat

@@ -14,13 +14,18 @@
 @if "%1"=="test" goto TEST
 @if "%1"=="dist" goto DIST
 @if "%1"=="install" goto INSTALL
-@if "%1"=="test-install" goto TESTINSTALL
 @if "%1"=="all" goto ALL
 
 @rem Set compile and link options here
 @setlocal
+
+@rem Example use asan
+@rem set JANET_COMPILE=cl /nologo /Isrc\include /Isrc\conf /c /O2 /W3 /D_CRT_SECURE_NO_WARNINGS /MD /fsanitize=address /Zi
+@rem set JANET_LINK=link /nologo clang_rt.asan_dynamic-x86_64.lib clang_rt.asan_dynamic_runtime_thunk-x86_64.lib
+
 @set JANET_COMPILE=cl /nologo /Isrc\include /Isrc\conf /c /O2 /W3 /D_CRT_SECURE_NO_WARNINGS /MD
 @set JANET_LINK=link /nologo
+
 @set JANET_LINK_STATIC=lib /nologo
 
 @rem Add janet build tag
@@ -82,7 +87,7 @@ exit /b 1
 @echo command prompt.
 exit /b 0
 
-@rem Clean build artifacts 
+@rem Clean build artifacts
 :CLEAN
 del *.exe *.lib *.exp
 rd /s /q build
@@ -117,8 +122,6 @@ janet.exe tools\patch-header.janet src\include\janet.h src\conf\janetconf.h buil
 copy build\janet.h dist\janet.h
 copy build\libjanet.lib dist\libjanet.lib
 
-copy .\jpm dist\jpm
-
 @rem Create installer
 janet.exe -e "(->> janet/version (peg/match ''(* :d+ `.` :d+ `.` :d+)) first print)" > build\version.txt
 janet.exe -e "(print (os/arch))" > build\arch.txt
@@ -147,34 +150,6 @@ FOR %%a in (janet-*-windows-*-installer.msi) DO (
 )
 exit /b 0
 
-@rem Test the installation.
-:TESTINSTALL
-pushd test\install
-call jpm clean
-@if errorlevel 1 goto :TESTINSTALLFAIL
-call jpm test
-@if errorlevel 1 goto :TESTINSTALLFAIL
-call jpm --verbose --modpath=. install https://github.com/janet-lang/json.git
-@if errorlevel 1 goto :TESTINSTALLFAIL
-call build\testexec
-@if errorlevel 1 goto :TESTINSTALLFAIL
-call jpm --verbose quickbin testexec.janet build\testexec2.exe
-@if errorlevel 1 goto :TESTINSTALLFAIL
-call build\testexec2.exe
-@if errorlevel 1 goto :TESTINSTALLFAIL
-call jpm --verbose --test --modpath=. install https://github.com/janet-lang/jhydro.git
-@if errorlevel 1 goto :TESTINSTALLFAIL
-call jpm --verbose --test --modpath=. install https://github.com/janet-lang/path.git
-@if errorlevel 1 goto :TESTINSTALLFAIL
-call jpm --verbose --test --modpath=. install https://github.com/janet-lang/argparse.git
-@if errorlevel 1 goto :TESTINSTALLFAIL
-popd
-exit /b 0
-
-:TESTINSTALLFAIL
-popd
-goto :TESTFAIL
-
 @rem build, test, dist, install. Useful for local dev.
 :ALL
 call %0 build

examples/async-execute.janet

@@ -1,6 +1,6 @@
 (defn dowork [name n]
   (print name " starting work...")
-  (os/execute [(dyn :executable) "-e" (string "(os/sleep " n ")")])
+  (os/execute [(dyn :executable) "-e" (string "(os/sleep " n ")")] :p)
   (print name " finished work!"))
 
 # Will be done in parallel

examples/evlocks.janet

@@ -0,0 +1,45 @@
+(defn sleep
+  "Sleep the entire thread, not just a single fiber."
+  [n]
+  (os/sleep (* 0.1 n)))
+
+(defn work [lock n]
+  (ev/acquire-lock lock)
+  (print "working " n "...")
+  (sleep n)
+  (print "done working...")
+  (ev/release-lock lock))
+
+(defn reader
+  [rwlock n]
+  (ev/acquire-rlock rwlock)
+  (print "reading " n "...")
+  (sleep n)
+  (print "done reading " n "...")
+  (ev/release-rlock rwlock))
+
+(defn writer
+  [rwlock n]
+  (ev/acquire-wlock rwlock)
+  (print "writing " n "...")
+  (sleep n)
+  (print "done writing...")
+  (ev/release-wlock rwlock))
+
+(defn test-lock
+  []
+  (def lock (ev/lock))
+  (for i 3 7
+    (ev/spawn-thread
+      (work lock i))))
+
+(defn test-rwlock
+  []
+  (def rwlock (ev/rwlock))
+  (for i 0 20
+    (if (> 0.1 (math/random))
+      (ev/spawn-thread (writer rwlock i))
+      (ev/spawn-thread (reader rwlock i)))))
+
+(test-rwlock)
+(test-lock)

examples/evsleep.janet

@@ -10,3 +10,13 @@
 (ev/call worker :b 5)
 (ev/sleep 0.3)
 (ev/call worker :c 12)
+
+(defn worker2
+  [name]
+  (repeat 10
+    (ev/sleep 0.2)
+    (print name " working")))
+
+(ev/go worker2 :bob)
+(ev/go worker2 :joe)
+(ev/go worker2 :sally)

examples/ffi/gtk.janet

@@ -0,0 +1,71 @@
+# :lazy true needed for jpm quickbin
+# lazily loads library on first function use
+# so the `main` function
+# can be marshalled.
+(ffi/context "/usr/lib/libgtk-3.so" :lazy true)
+
+(ffi/defbind
+  gtk-application-new :ptr
+  "Add docstrings as needed."
+  [title :string flags :uint])
+
+(ffi/defbind
+  g-signal-connect-data :ulong
+  [a :ptr b :ptr c :ptr d :ptr e :ptr f :int])
+
+(ffi/defbind
+  g-application-run :int
+  [app :ptr argc :int argv :ptr])
+
+(ffi/defbind
+  gtk-application-window-new :ptr
+  [a :ptr])
+
+(ffi/defbind
+  gtk-button-new-with-label :ptr
+  [a :ptr])
+
+(ffi/defbind
+  gtk-container-add :void
+  [a :ptr b :ptr])
+
+(ffi/defbind
+  gtk-widget-show-all :void
+  [a :ptr])
+
+(ffi/defbind
+  gtk-button-set-label :void
+  [a :ptr b :ptr])
+
+(def cb (delay (ffi/trampoline :default)))
+
+(defn ffi/array
+  ``Convert a janet array to a buffer that can be passed to FFI functions.
+  For example, to create an array of type `char *` (array of c strings), one
+  could use `(ffi/array ["hello" "world"] :ptr)`. One needs to be careful that
+  array elements are not garbage collected though - the GC can't follow references
+  inside an arbitrary byte buffer.``
+  [arr ctype &opt buf]
+  (default buf @"")
+  (each el arr
+    (ffi/write ctype el buf))
+  buf)
+
+(defn on-active
+  [app]
+  (def window (gtk-application-window-new app))
+  (def btn (gtk-button-new-with-label "Click Me!"))
+  (g-signal-connect-data btn "clicked" (cb)
+                         (fn [btn] (gtk-button-set-label btn "Hello World"))
+                         nil 1)
+  (gtk-container-add window btn)
+  (gtk-widget-show-all window))
+
+(defn main
+  [&]
+  (def app (gtk-application-new "org.janet-lang.example.HelloApp" 0))
+  (g-signal-connect-data app "activate" (cb) on-active nil 1)
+  # manually build an array with ffi/write
+  # - we are responsible for preventing gc when the arg array is used
+  (def argv (ffi/array (dyn *args*) :string))
+  (g-application-run app (length (dyn *args*)) argv))

examples/ffi/so.c

@@ -0,0 +1,208 @@
+#include <stdio.h>
+#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,
+    double c,
+    double d,
+    double e,
+    double f,
+    double g,
+    double h,
+    double i,
+    double j) {
+    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;
+}
+
+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;
+    ret.b = i * i;
+    return ret;
+}
+
+EXPORTER
+big struct_big(int i, double d) {
+    big ret;
+    ret.a = i;
+    ret.b = (int64_t) d;
+    ret.c = ret.a + ret.b + 1000;
+    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

@@ -0,0 +1,134 @@
+#
+# Simple FFI test script that tests against a simple shared object
+#
+
+(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")
+
+(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))
+
+(ffi/context ffi/loc)
+
+(def intintint (ffi/struct :int :int :int))
+(def big (ffi/struct :s64 :s64 :s64))
+(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))
+
+(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
+#
+
+(defn check-round-trip
+  [t value]
+  (def buf (ffi/write t value))
+  (def same-value (ffi/read t buf))
+  (assert (deep= value same-value)
+          (string/format "round trip %j (got %j)" value same-value)))
+
+(check-round-trip :bool true)
+(check-round-trip :bool false)
+(check-round-trip :void nil)
+(check-round-trip :void nil)
+(check-round-trip :s8 10)
+(check-round-trip :s8 0)
+(check-round-trip :s8 -10)
+(check-round-trip :u8 10)
+(check-round-trip :u8 0)
+(check-round-trip :s16 10)
+(check-round-trip :s16 0)
+(check-round-trip :s16 -12312)
+(check-round-trip :u16 10)
+(check-round-trip :u16 0)
+(check-round-trip :u32 0)
+(check-round-trip :u32 10)
+(check-round-trip :u32 0xFFFF7777)
+(check-round-trip :s32 0x7FFF7777)
+(check-round-trip :s32 0)
+(check-round-trip :s32 -1234567)
+
+(def s (ffi/struct :s8 :s8 :s8 :float))
+(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)))
+

examples/numarray/numarray.c

@@ -76,9 +76,16 @@ void num_array_put(void *p, Janet key, Janet value) {
     }
 }
 
+static Janet num_array_length(int32_t argc, Janet *argv) {
+    janet_fixarity(argc, 1);
+    num_array *array = (num_array *)janet_getabstract(argv, 0, &num_array_type);
+    return janet_wrap_number(array->size);
+}
+
 static const JanetMethod methods[] = {
     {"scale", num_array_scale},
     {"sum", num_array_sum},
+    {"length", num_array_length},
     {NULL, NULL}
 };
 
@@ -109,6 +116,11 @@ static const JanetReg cfuns[] = {
         "(numarray/scale numarray factor)\n\n"
         "scale numarray by factor"
     },
+    {
+        "sum", num_array_sum,
+        "(numarray/sum numarray)\n\n"
+        "sums numarray"
+    },
     {NULL, NULL, NULL}
 };
 

examples/numarray/test/numarray_tests.janet

@@ -1,4 +1,4 @@
-(import build/numarray)
+(import /build/numarray)
 
 (def a (numarray/new 30))
 (print (get a 20))

examples/threaded-channels.janet

@@ -0,0 +1,22 @@
+(def chan (ev/thread-chan 10))
+
+(ev/spawn
+  (ev/sleep 0)
+  (print "started fiber!")
+  (ev/give chan (math/random))
+  (ev/give chan (math/random))
+  (ev/give chan (math/random))
+  (ev/sleep 0.5)
+  (for i 0 10
+    (print "giving to channel...")
+    (ev/give chan (math/random))
+    (ev/sleep 1))
+  (print "finished fiber!")
+  (:close chan))
+
+(ev/do-thread
+  (print "started thread!")
+  (ev/sleep 1)
+  (while (def x (do (print "taking from channel...") (ev/take chan)))
+    (print "got " x " from thread!"))
+  (print "finished thread!"))

examples/threads.janet

@@ -1,68 +0,0 @@
-(defn worker-main
-  "Sends 11 messages back to parent"
-  [parent]
-  (def name (thread/receive))
-  (def interval (thread/receive))
-  (for i 0 10
-    (os/sleep interval)
-    (:send parent (string/format "thread %s wakeup no. %d" name i)))
-  (:send parent name))
-
-(defn make-worker
-  [name interval]
-  (-> (thread/new worker-main)
-      (:send name)
-      (:send interval)))
-
-(def bob (make-worker "bob" 0.02))
-(def joe (make-worker "joe" 0.03))
-(def sam (make-worker "sam" 0.05))
-
-# Receive out of order
-(for i 0 33
-  (print (thread/receive)))
-
-#
-# Recursive Thread Tree - should pause for a bit, and then print a cool zigzag.
-#
-
-(def rng (math/rng (os/cryptorand 16)))
-
-(defn choose [& xs]
-  (in xs (:int rng (length xs))))
-
-(defn worker-tree
-  [parent]
-  (def name (thread/receive))
-  (def depth (thread/receive))
-  (if (< depth 5)
-    (do
-    (defn subtree []
-      (-> (thread/new worker-tree)
-          (:send (string name "/" (choose "bob" "marley" "harry" "suki" "anna" "yu")))
-          (:send (inc depth))))
-    (let [l (subtree)
-          r (subtree)
-          lrep (thread/receive)
-          rrep (thread/receive)]
-      (:send parent [name ;lrep ;rrep])))
-    (do
-      (:send parent [name]))))
-
-(-> (thread/new worker-tree) (:send "adam") (:send 0))
-(def lines (thread/receive))
-(map print lines)
-
-#
-# Receive timeout
-#
-
-(def slow (make-worker "slow-loras" 0.5))
-(for i 0 50
-  (try
-    (let [msg (thread/receive 0.1)]
-      (print "\n" msg))
-    ([err] (prin ".") (:flush stdout))))
-
-(print "\ndone timing, timeouts ending.")
-(try (while true (print (thread/receive))) ([err] (print "done")))

examples/urlloader.janet

@@ -1,10 +1,10 @@
-# An example of using Janet's extensible module system
-# to import files from URL. To try this, run `janet -l examples/urlloader.janet`
-# from the repl, and then:
+# An example of using Janet's extensible module system to import files from
+# URL. To try this, run `janet -l ./examples/urlloader.janet` from the command
+# line, and then at the REPL type:
 #
 # (import https://raw.githubusercontent.com/janet-lang/janet/master/examples/colors.janet :as c)
 #
-# This will import a file using curl. You can then try
+# This will import a file using curl. You can then try:
 #
 # (print (c/color :green "Hello!"))
 #
@@ -13,9 +13,9 @@
 
 (defn- load-url
   [url args]
-  (def f (file/popen (string "curl " url)))
-  (def res (dofile f :source url ;args))
-  (try (file/close f) ([err] nil))
+  (def p (os/spawn ["curl" url "-s"] :p {:out :pipe}))
+  (def res (dofile (p :out) :source url ;args))
+  (:wait p)
   res)
 
 (defn- check-http-url

janet.1

@@ -3,8 +3,9 @@
 janet \- run the Janet language abstract machine
 .SH SYNOPSIS
 .B janet
-[\fB\-hvsrpnqk\fR]
+[\fB\-hvsrpnqik\fR]
 [\fB\-e\fR \fISOURCE\fR]
+[\fB\-E\fR \fISOURCE ...ARGUMENTS\fR]
 [\fB\-l\fR \fIMODULE\fR]
 [\fB\-m\fR \fIPATH\fR]
 [\fB\-c\fR \fIMODULE JIMAGE\fR]
@@ -162,6 +163,16 @@ Read raw input from stdin and forgo prompt history and other readline-like featu
 Execute a string of Janet source. Source code is executed in the order it is encountered, so earlier
 arguments are executed before later ones.
 
+.TP
+.BR \-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
@@ -207,6 +218,11 @@ Precompiles Janet source code into an image, a binary dump that can be efficient
 Source should be a path to the Janet module to compile, and output should be the file path of
 resulting image. Output should usually end with the .jimage extension.
 
+.TP
+.BR \-i
+When this flag is passed, a script passed to the interpreter will be treated as a janet image file
+rather than a janet source file.
+
 .TP
 .BR \-l\ lib
 Import a Janet module before running a script or repl. Multiple files can be loaded

jpm.1

@@ -1,298 +0,0 @@
-.TH JPM 1
-.SH NAME
-jpm \- the Janet Project Manager, a build tool for Janet 
-.SH SYNOPSIS
-.B jpm
-[\fB\-\-flag ...\fR]
-[\fB\-\-option=value ...\fR]
-.IR command
-.IR args ...
-.SH DESCRIPTION
-jpm is the build tool that ships with a standard Janet install. It is
-used for building Janet projects, installing dependencies, installing
-projects, building native modules, and exporting your Janet project to a
-standalone executable. Although not required for working with Janet, it
-removes much of the boilerplate with installing dependencies and
-building native modules. jpm requires only Janet to run, and uses git
-to install dependencies (jpm will work without git installed).
-.SH DOCUMENTATION
-
-jpm has several subcommands, each used for managing either a single Janet project or
-all Janet modules installed on the system. Global commands, those that manage modules
-at the system level, do things like install and uninstall packages, as well as clear the cache.
-More interesting are the local commands. For more information on jpm usage, see https://janet-lang.org/docs/index.html
-
-.SH FLAGS
-
-.TP
-.BR \-\-nocolor
-Disable color in the jpm debug repl.
-
-.TP
-.BR \-\-verbose
-Print detailed messages of what jpm is doing, including compilation commands and other shell commands.
-
-.TP
-.BR \-\-test
-If passed to jpm install, runs tests before installing. Will run tests recursively on dependencies.
-
-.TP
-.BR \-\-offline
-Prevents jpm from going to network to get dependencies - all dependencies should be in the cache or this command will fail.
-Use this flag with the deps and update-pkgs subcommands. This is not a surefire way to prevent a build script from accessing
-the network, for example, a build script that invokes curl will still have network access.
-
-.TP
-.BR \-\-auto\-shebang
-Prepends installed scripts with a generated shebang line, such that they will use a janet binary located in JANET_BINPATH.
-
-.SH OPTIONS
-
-.TP
-.BR \-\-modpath=/some/path
-Set the path to install modules to. Defaults to $JANET_MODPATH, $JANET_PATH, or (dyn :syspath) in that order. You most likely don't need this.
-
-.TP
-.BR \-\-headerpath=/some/path
-Set the path the jpm will include when building C source code. This lets
-you specify the location of janet.h and janetconf.h on your system. On a
-normal install, this option is not needed.
-
-.TP
-.BR \-\-binpath=/some/path
-Set the path that jpm will install scripts and standalone executables to. Executables
-defined via declare-execuatble or scripts declared via declare-binscript will be installed
-here when jpm install is run. Defaults to $JANET_BINPATH, or a reasonable default for the system.
-See JANET_BINPATH for more.
-
-.TP
-.BR \-\-libpath=/some/path
-Sets the path jpm will use to look for libjanet.a for building standalone executables. libjanet.so
-is \fBnot\fR used for building native modules or standalone executables, only
-for linking into applications that want to embed janet as a dynamic module.
-Linking statically might be a better idea, even in that case. Defaults to
-$JANET_LIBPATH, or a reasonable default. See JANET_LIBPATH for more.
-
-.TP
-.BR \-\-compiler=$CC
-Sets the C compiler used for compiling native modules and standalone executables. Defaults
-to cc.
-
-.TP
-.BR \-\-cpp\-compiler=$CXX
-Sets the C++ compiler used for compiling native modules and standalone executables. Defaults
-to c++..
-
-.TP
-.BR \-\-linker
-Sets the linker used to create native modules and executables. Only used on windows, where
-it defaults to link.exe.
-
-.TP
-.BR \-\-pkglist=https://github.com/janet-lang/pkgs.git
-Sets the git repository for the package listing used to resolve shorthand package names.
-
-.TP
-.BR \-\-archiver=$AR
-Sets the command used for creating static libraries, use for linking into the standalone executable.
-Native modules are compiled twice, once a normal native module (shared object), and once as an
-archive. Defaults to ar.
-
-.SH COMMANDS
-.TP
-.BR help
-Shows the usage text and exits immediately.
-
-.TP
-.BR build
-Builds all artifacts specified in the project.janet file in the current directory. Artifacts will
-be created in the ./build/ directory.
-
-.TP
-.BR install\ [\fBrepo...\fR]
-When run with no arguments, installs all installable artifacts in the current project to
-the current JANET_MODPATH for modules and JANET_BINPATH for executables and scripts. Can also
-take an optional git repository URL and will install all artifacts in that repository instead.
-When run with an argument, install does not need to be run from a jpm project directory. Will also
-install multiple dependencies in one command.
-
-.TP
-.BR uninstall\ [\fBname...\fR]
-Uninstall a project installed with install. uninstall expects the name of the project, not the
-repository url, path to installed file, or executable name. The name of the project must be specified
-at the top of the project.janet file in the declare-project form. If no name is given, uninstalls
-the current project if installed. Will also uninstall multiple packages in one command.
-
-.TP
-.BR clean
-Remove all artifacts created by jpm. This just deletes the build folder.
-
-.TP
-.BR test
-Runs jpm tests. jpm will run all janet source files in the test directory as tests. A test
-is considered failing if it exits with a non-zero exit code.
-
-.TP
-.BR deps
-Install all dependencies that this project requires recursively. jpm does not
-resolve dependency issues, like conflicting versions of the same module are required, or
-different modules with the same name. Dependencies are installed with git, so deps requires
-git to be on the PATH.
-
-.TP
-.BR clear-cache
-jpm caches git repositories that are needed to install modules from a remote
-source in a global cache ($JANET_PATH/.cache). If these dependencies are out of
-date or too large, clear-cache will remove the cache and jpm will rebuild it
-when needed. clear-cache is a global command, so a project.janet is not
-required.
-
-.TP
-.BR list-installed
-List all installed packages in the current syspath.
-
-.TP
-.BR list-pkgs\ [\fBsearch\fR]
-List all package aliases in the current package listing that contain the given search string.
-If no search string is given, prints the entire listing.
-
-.TP
-.BR clear-manifest
-jpm creates a manifest directory that contains a list of all installed files.
-By deleting this directory, jpm will think that nothing is installed and will
-try reinstalling everything on the jpm deps or jpm load-lockfile commands. Be careful with
-this command, as it may leave extra files on your system and shouldn't be needed
-most of the time in a healthy install.
-
-.TP
-.BR run\ [\fBrule\fR]
-Run a given rule defined in project.janet. Project definitions files (project.janet) usually
-contain a few artifact declarations, which set up rules that jpm can then resolve, or execute.
-A project.janet can also create custom rules to create arbitrary files or run arbitrary code, much
-like make. run will run a single rule or build a single file.
-
-.TP
-.BR rules
-List all rules that can be run via run. This is useful for exploring rules in the project.
-
-.TP
-.BR rule-tree\ [\fBroot\fR]\ [\fBdepth\fR]
-Show rule dependency tree in a pretty format. Optionally provide a rule to use as the tree
-root, as well as a max depth to print. By default, prints the full tree for all rules. This
-can be quite long, so it is recommended to give a root rule.
-
-.TP
-.BR show-paths
-Show all of the paths used when installing and building artifacts.
-
-.TP
-.BR update-pkgs
-Update the package listing by installing the 'pkgs' package. Same as jpm install pkgs
-
-.TP
-.BR quickbin\ [\fBentry\fR]\ [\fBexecutable\fR]
-Create a standalone, statically linked executable from a Janet source file that contains a main function.
-The main function is the entry point of the program and will receive command line arguments
-as function arguments. The entry file can import other modules, including native C modules, and
-jpm will attempt to include the dependencies into the generated executable.
-
-.TP
-.BR debug-repl
-Load the current project.janet file and start a repl in it's environment. This lets a user better
-debug the project file, as well as run rules manually.
-
-.TP
-.BR make-lockfile\ [\fBfilename\fR]
-Create a lockfile. A lockfile is a record that describes what dependencies were installed at the
-time of the lockfile's creation, including exact versions. A lockfile can then be later used
-to set up that environment on a different machine via load-lockfile. By default, the lockfile
-is created at lockfile.jdn, although any path can be used.
-
-.TP
-.BR load-lockfile\ [\fBfilename\fR]
-Install dependencies from a lockfile previously created with make-lockfile. By default, will look
-for a lockfile at lockfile.jdn, although any path can be used.
-
-.SH ENVIRONMENT
-
-.B JANET_PATH
-.RS
-The location to look for Janet libraries. This is the only environment variable Janet needs to
-find native and source code modules. If no JANET_PATH is set, Janet will look in
-the default location set at compile time, which can be determined with (dyn :syspath)
-.RE
-
-.B JANET_MODPATH
-.RS
-The location that jpm will use to install libraries to. Defaults to JANET_PATH, but you could
-set this to a different directory if you want to. Doing so would let you import Janet modules
-on the normal system path (JANET_PATH or (dyn :syspath)), but install to a different directory. It is also a more reliable way to install.
-This variable is overwritten by the --modpath=/some/path if it is provided.
-.RE
-
-.B JANET_HEADERPATH
-.RS
-The location that jpm will look for janet header files (janet.h and janetconf.h) that are used
-to build native modules and standalone executables. If janet.h and janetconf.h are available as
-default includes on your system, this value is not required. If not provided, will default to
-<jpm script location>/../include/janet. The --headerpath=/some/path option will override this
-variable.
-.RE
-
-.B JANET_LIBPATH
-.RS
-Similar to JANET_HEADERPATH, this path is where jpm will look for
-libjanet.a for creating standalone executables. This does not need to be
-set on a normal install. 
-If not provided, this will default to <jpm script location>/../lib.
-The --libpath=/some/path option will override this variable.
-.RE
-
-.B JANET_BINPATH
-.RS
-The directory where jpm will install binary scripts and executables to.
-Defaults to
-(dyn :syspath)/bin
-The --binpath=/some/path will override this variable.
-.RE
-
-.B JANET_PKGLIST
-.RS
-The git repository URL that contains a listing of packages. This allows installing packages with shortnames, which
-is mostly a convenience. However, package dependencies can use short names, package listings
-can be used to choose a particular set of dependency versions for a whole project.
-.RE
-
-.B JANET_GIT
-.RS
-An optional path to a git executable to use to clone git dependencies. By default, uses "git" on the current $PATH. You shouldn't need to set this
-if you have a normal install of git.
-.RE
-
-.B JPM_OS_WHICH
-.RS
-Use this option to override the C compiler and build system auto-detection for the host operating system. For example, set this
-environment variable to "posix" to make sure that on platforms like MinGW, you will use GCC instead of MSVC. On most platforms, users will not need to
-set this environment variable. Set this to one of the following
-strings:
-.IP
-\- windows
-.IP
-\- macos
-.IP
-\- linux
-.IP
-\- freebsd
-.IP
-\- openbsd
-.IP
-\- netbsd
-.IP
-\- bsd
-.IP
-\- posix
-.RE
-
-
-.SH AUTHOR
-Written by Calvin Rose <calsrose@gmail.com>

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.16.1')
+  version : '1.26.1')
 
 # Global settings
 janet_path = join_paths(get_option('prefix'), get_option('libdir'), 'janet')
@@ -30,6 +30,7 @@ header_path = join_paths(get_option('prefix'), get_option('includedir'), 'janet'
 cc = meson.get_compiler('c')
 m_dep = cc.find_library('m', required : false)
 dl_dep = cc.find_library('dl', required : false)
+android_spawn_dep = cc.find_library('android-spawn', required : false)
 thread_dep = dependency('threads')
 
 # Link options
@@ -72,7 +73,11 @@ conf.set('JANET_NO_UMASK', not get_option('umask'))
 conf.set('JANET_NO_REALPATH', not get_option('realpath'))
 conf.set('JANET_NO_PROCESSES', not get_option('processes'))
 conf.set('JANET_SIMPLE_GETLINE', get_option('simple_getline'))
-conf.set('JANET_EV_EPOLL', get_option('epoll'))
+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
@@ -113,6 +118,7 @@ core_src = [
   'src/core/debug.c',
   'src/core/emit.c',
   'src/core/ev.c',
+  'src/core/ffi.c',
   'src/core/fiber.c',
   'src/core/gc.c',
   'src/core/inttypes.c',
@@ -127,12 +133,12 @@ core_src = [
   'src/core/regalloc.c',
   'src/core/run.c',
   'src/core/specials.c',
+  'src/core/state.c',
   'src/core/string.c',
   'src/core/strtod.c',
   'src/core/struct.c',
   'src/core/symcache.c',
   'src/core/table.c',
-  'src/core/thread.c',
   'src/core/tuple.c',
   'src/core/util.c',
   'src/core/value.c',
@@ -158,7 +164,7 @@ mainclient_src = [
 janet_boot = executable('janet-boot', core_src, boot_src,
   include_directories : incdir,
   c_args : '-DJANET_BOOTSTRAP',
-  dependencies : [m_dep, dl_dep, thread_dep],
+  dependencies : [m_dep, dl_dep, thread_dep, android_spawn_dep],
   native : true)
 
 # Build janet.c
@@ -168,10 +174,10 @@ janetc = custom_target('janetc',
   capture : true,
   command : [
     janet_boot, meson.current_source_dir(),
-    'JANET_PATH', janet_path, 'JANET_HEADERPATH', header_path
+    'JANET_PATH', janet_path
   ])
 
-janet_dependencies = [m_dep, dl_dep]
+janet_dependencies = [m_dep, dl_dep, android_spawn_dep]
 if not get_option('single_threaded')
   janet_dependencies += thread_dep
 endif
@@ -231,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())
@@ -260,16 +270,9 @@ patched_janet = custom_target('patched-janeth',
   build_by_default : true,
   output : ['janet.h'],
   command : [janet_nativeclient, '@INPUT@', '@OUTPUT@'])
-if get_option('peg') and not get_option('reduced_os') and get_option('processes')
-  install_man('jpm.1')
-  patched_jpm = custom_target('patched-jpm',
-    input : ['tools/patch-jpm.janet', 'jpm'],
-    install : true,
-    install_dir : get_option('bindir'),
-    build_by_default : true,
-    output : ['jpm'],
-    command : [janet_nativeclient, '@INPUT@', '@OUTPUT@',
-      '--binpath=' + join_paths(get_option('prefix'), get_option('bindir')),
-      '--libpath=' + join_paths(get_option('prefix'), get_option('libdir')),
-      '--headerpath=' + join_paths(get_option('prefix'), get_option('includedir'))])
+
+# Create a version of the janet.h header that matches what jpm often expects
+if meson.version().version_compare('>=0.61')
+  install_symlink('janet.h', pointing_to: 'janet/janet.h', install_dir: get_option('includedir'))
 endif
+

meson_options.txt

@@ -17,6 +17,10 @@ option('umask', type : 'boolean', value : true)
 option('realpath', type : 'boolean', value : true)
 option('simple_getline', type : 'boolean', value : false)
 option('epoll', type : 'boolean', value : false)
+option('kqueue', type : 'boolean', value : false)
+option('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) 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

src/boot/boot.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

src/boot/buffer_test.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

src/boot/number_test.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

src/boot/system_test.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

src/boot/table_test.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

src/conf/janetconf.h

@@ -4,10 +4,10 @@
 #define JANETCONF_H
 
 #define JANET_VERSION_MAJOR 1
-#define JANET_VERSION_MINOR 16
+#define JANET_VERSION_MINOR 26
 #define JANET_VERSION_PATCH 1
-#define JANET_VERSION_EXTRA ""
-#define JANET_VERSION "1.16.1"
+#define JANET_VERSION_EXTRA "-dev"
+#define JANET_VERSION "1.26.1-dev"
 
 /* #define JANET_BUILD "local" */
 
@@ -32,6 +32,9 @@
 /* #define JANET_NO_REALPATH */
 /* #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 */
@@ -46,7 +49,9 @@
 /* #define JANET_STACK_MAX 16384 */
 /* #define JANET_OS_NAME my-custom-os */
 /* #define JANET_ARCH_NAME pdp-8 */
-/* #define JANET_EV_EPOLL */
+/* #define JANET_EV_NO_EPOLL */
+/* #define JANET_EV_NO_KQUEUE */
+/* #define JANET_NO_INTERPRETER_INTERRUPT */
 
 /* Custom vm allocator support */
 /* #include <mimalloc.h> */

src/core/abstract.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
@@ -23,7 +23,17 @@
 #ifndef JANET_AMALG
 #include "features.h"
 #include <janet.h>
+#include "util.h"
 #include "gc.h"
+#include "state.h"
+#endif
+
+#ifdef JANET_EV
+#ifdef JANET_WINDOWS
+#include <windows.h>
+#else
+#include <stdatomic.h>
+#endif
 #endif
 
 /* Create new userdata */
@@ -43,3 +53,170 @@ void *janet_abstract_end(void *x) {
 void *janet_abstract(const JanetAbstractType *atype, size_t size) {
     return janet_abstract_end(janet_abstract_begin(atype, size));
 }
+
+#ifdef JANET_EV
+
+/*
+ * Threaded abstracts
+ */
+
+void *janet_abstract_begin_threaded(const JanetAbstractType *atype, size_t size) {
+    JanetAbstractHead *header = janet_malloc(sizeof(JanetAbstractHead) + size);
+    if (NULL == header) {
+        JANET_OUT_OF_MEMORY;
+    }
+    janet_vm.next_collection += size + sizeof(JanetAbstractHead);
+    header->gc.flags = JANET_MEMORY_THREADED_ABSTRACT;
+    header->gc.data.next = NULL; /* Clear memory for address sanitizers */
+    header->gc.data.refcount = 1;
+    header->size = size;
+    header->type = atype;
+    void *abstract = (void *) & (header->data);
+    janet_table_put(&janet_vm.threaded_abstracts, janet_wrap_abstract(abstract), janet_wrap_false());
+    return abstract;
+}
+
+void *janet_abstract_end_threaded(void *x) {
+    janet_gc_settype((void *)(janet_abstract_head(x)), JANET_MEMORY_THREADED_ABSTRACT);
+    return x;
+}
+
+void *janet_abstract_threaded(const JanetAbstractType *atype, size_t size) {
+    return janet_abstract_end_threaded(janet_abstract_begin_threaded(atype, size));
+}
+
+/* Refcounting primitives and sync primitives */
+
+#ifdef JANET_WINDOWS
+
+size_t janet_os_mutex_size(void) {
+    return sizeof(CRITICAL_SECTION);
+}
+
+size_t janet_os_rwlock_size(void) {
+    return sizeof(void *);
+}
+
+static int32_t janet_incref(JanetAbstractHead *ab) {
+    return InterlockedIncrement((LONG volatile *) &ab->gc.data.refcount);
+}
+
+static int32_t janet_decref(JanetAbstractHead *ab) {
+    return InterlockedDecrement((LONG volatile *) &ab->gc.data.refcount);
+}
+
+void janet_os_mutex_init(JanetOSMutex *mutex) {
+    InitializeCriticalSection((CRITICAL_SECTION *) mutex);
+}
+
+void janet_os_mutex_deinit(JanetOSMutex *mutex) {
+    DeleteCriticalSection((CRITICAL_SECTION *) mutex);
+}
+
+void janet_os_mutex_lock(JanetOSMutex *mutex) {
+    EnterCriticalSection((CRITICAL_SECTION *) mutex);
+}
+
+void janet_os_mutex_unlock(JanetOSMutex *mutex) {
+    /* error handling? May want to keep counter */
+    LeaveCriticalSection((CRITICAL_SECTION *) mutex);
+}
+
+void janet_os_rwlock_init(JanetOSRWLock *rwlock) {
+    InitializeSRWLock((PSRWLOCK) rwlock);
+}
+
+void janet_os_rwlock_deinit(JanetOSRWLock *rwlock) {
+    /* no op? */
+    (void) rwlock;
+}
+
+void janet_os_rwlock_rlock(JanetOSRWLock *rwlock) {
+    AcquireSRWLockShared((PSRWLOCK) rwlock);
+}
+
+void janet_os_rwlock_wlock(JanetOSRWLock *rwlock) {
+    AcquireSRWLockExclusive((PSRWLOCK) rwlock);
+}
+
+void janet_os_rwlock_runlock(JanetOSRWLock *rwlock) {
+    ReleaseSRWLockShared((PSRWLOCK) rwlock);
+}
+
+void janet_os_rwlock_wunlock(JanetOSRWLock *rwlock) {
+    ReleaseSRWLockExclusive((PSRWLOCK) rwlock);
+}
+
+#else
+
+size_t janet_os_mutex_size(void) {
+    return sizeof(pthread_mutex_t);
+}
+
+size_t janet_os_rwlock_size(void) {
+    return sizeof(pthread_rwlock_t);
+}
+
+static int32_t janet_incref(JanetAbstractHead *ab) {
+    return __atomic_add_fetch(&ab->gc.data.refcount, 1, __ATOMIC_RELAXED);
+}
+
+static int32_t janet_decref(JanetAbstractHead *ab) {
+    return __atomic_add_fetch(&ab->gc.data.refcount, -1, __ATOMIC_RELAXED);
+}
+
+void janet_os_mutex_init(JanetOSMutex *mutex) {
+    pthread_mutexattr_t attr;
+    pthread_mutexattr_init(&attr);
+    pthread_mutexattr_settype(&attr, PTHREAD_MUTEX_RECURSIVE);
+    pthread_mutex_init((pthread_mutex_t *) mutex, &attr);
+}
+
+void janet_os_mutex_deinit(JanetOSMutex *mutex) {
+    pthread_mutex_destroy((pthread_mutex_t *) mutex);
+}
+
+void janet_os_mutex_lock(JanetOSMutex *mutex) {
+    pthread_mutex_lock((pthread_mutex_t *) mutex);
+}
+
+void janet_os_mutex_unlock(JanetOSMutex *mutex) {
+    int ret = pthread_mutex_unlock((pthread_mutex_t *) mutex);
+    if (ret) janet_panic("cannot release lock");
+}
+
+void janet_os_rwlock_init(JanetOSRWLock *rwlock) {
+    pthread_rwlock_init((pthread_rwlock_t *) rwlock, NULL);
+}
+
+void janet_os_rwlock_deinit(JanetOSRWLock *rwlock) {
+    pthread_rwlock_destroy((pthread_rwlock_t *) rwlock);
+}
+
+void janet_os_rwlock_rlock(JanetOSRWLock *rwlock) {
+    pthread_rwlock_rdlock((pthread_rwlock_t *) rwlock);
+}
+
+void janet_os_rwlock_wlock(JanetOSRWLock *rwlock) {
+    pthread_rwlock_wrlock((pthread_rwlock_t *) rwlock);
+}
+
+void janet_os_rwlock_runlock(JanetOSRWLock *rwlock) {
+    pthread_rwlock_unlock((pthread_rwlock_t *) rwlock);
+}
+
+void janet_os_rwlock_wunlock(JanetOSRWLock *rwlock) {
+    pthread_rwlock_unlock((pthread_rwlock_t *) rwlock);
+}
+
+#endif
+
+int32_t janet_abstract_incref(void *abst) {
+    return janet_incref(janet_abstract_head(abst));
+}
+
+int32_t janet_abstract_decref(void *abst) {
+    return janet_decref(janet_abstract_head(abst));
+}
+
+#endif

src/core/array.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
@@ -35,7 +35,7 @@ JanetArray *janet_array(int32_t capacity) {
     JanetArray *array = janet_gcalloc(JANET_MEMORY_ARRAY, sizeof(JanetArray));
     Janet *data = NULL;
     if (capacity > 0) {
-        janet_vm_next_collection += capacity * sizeof(Janet);
+        janet_vm.next_collection += capacity * sizeof(Janet);
         data = (Janet *) janet_malloc(sizeof(Janet) * (size_t) capacity);
         if (NULL == data) {
             JANET_OUT_OF_MEMORY;
@@ -72,7 +72,7 @@ void janet_array_ensure(JanetArray *array, int32_t capacity, int32_t growth) {
     if (NULL == newData) {
         JANET_OUT_OF_MEMORY;
     }
-    janet_vm_next_collection += (capacity - array->capacity) * sizeof(Janet);
+    janet_vm.next_collection += (capacity - array->capacity) * sizeof(Janet);
     array->data = newData;
     array->capacity = capacity;
 }
@@ -122,16 +122,21 @@ Janet janet_array_peek(JanetArray *array) {
 
 /* C Functions */
 
-static Janet cfun_array_new(int32_t argc, Janet *argv) {
+JANET_CORE_FN(cfun_array_new,
+              "(array/new capacity)",
+              "Creates a new empty array with a pre-allocated capacity. The same as "
+              "`(array)` but can be more efficient if the maximum size of an array is known.") {
     janet_fixarity(argc, 1);
     int32_t cap = janet_getinteger(argv, 0);
     JanetArray *array = janet_array(cap);
     return janet_wrap_array(array);
 }
 
-static Janet cfun_array_new_filled(int32_t argc, Janet *argv) {
+JANET_CORE_FN(cfun_array_new_filled,
+              "(array/new-filled count &opt value)",
+              "Creates a new array of `count` elements, all set to `value`, which defaults to nil. Returns the new array.") {
     janet_arity(argc, 1, 2);
-    int32_t count = janet_getinteger(argv, 0);
+    int32_t count = janet_getnat(argv, 0);
     Janet x = (argc == 2) ? argv[1] : janet_wrap_nil();
     JanetArray *array = janet_array(count);
     for (int32_t i = 0; i < count; i++) {
@@ -141,7 +146,10 @@ static Janet cfun_array_new_filled(int32_t argc, Janet *argv) {
     return janet_wrap_array(array);
 }
 
-static Janet cfun_array_fill(int32_t argc, Janet *argv) {
+JANET_CORE_FN(cfun_array_fill,
+              "(array/fill arr &opt value)",
+              "Replace all elements of an array with `value` (defaulting to nil) without changing the length of the array. "
+              "Returns the modified array.") {
     janet_arity(argc, 1, 2);
     JanetArray *array = janet_getarray(argv, 0);
     Janet x = (argc == 2) ? argv[1] : janet_wrap_nil();
@@ -151,19 +159,26 @@ static Janet cfun_array_fill(int32_t argc, Janet *argv) {
     return argv[0];
 }
 
-static Janet cfun_array_pop(int32_t argc, Janet *argv) {
+JANET_CORE_FN(cfun_array_pop,
+              "(array/pop arr)",
+              "Remove the last element of the array and return it. If the array is empty, will return nil. Modifies "
+              "the input array.") {
     janet_fixarity(argc, 1);
     JanetArray *array = janet_getarray(argv, 0);
     return janet_array_pop(array);
 }
 
-static Janet cfun_array_peek(int32_t argc, Janet *argv) {
+JANET_CORE_FN(cfun_array_peek,
+              "(array/peek arr)",
+              "Returns the last element of the array. Does not modify the array.") {
     janet_fixarity(argc, 1);
     JanetArray *array = janet_getarray(argv, 0);
     return janet_array_peek(array);
 }
 
-static Janet cfun_array_push(int32_t argc, Janet *argv) {
+JANET_CORE_FN(cfun_array_push,
+              "(array/push arr x)",
+              "Insert an element in the end of an array. Modifies the input array and returns it.") {
     janet_arity(argc, 1, -1);
     JanetArray *array = janet_getarray(argv, 0);
     if (INT32_MAX - argc + 1 <= array->count) {
@@ -176,7 +191,12 @@ static Janet cfun_array_push(int32_t argc, Janet *argv) {
     return argv[0];
 }
 
-static Janet cfun_array_ensure(int32_t argc, Janet *argv) {
+JANET_CORE_FN(cfun_array_ensure,
+              "(array/ensure arr capacity growth)",
+              "Ensures that the memory backing the array is large enough for `capacity` "
+              "items at the given rate of growth. `capacity` and `growth` must be integers. "
+              "If the backing capacity is already enough, then this function does nothing. "
+              "Otherwise, the backing memory will be reallocated so that there is enough space.") {
     janet_fixarity(argc, 3);
     JanetArray *array = janet_getarray(argv, 0);
     int32_t newcount = janet_getinteger(argv, 1);
@@ -186,7 +206,13 @@ static Janet cfun_array_ensure(int32_t argc, Janet *argv) {
     return argv[0];
 }
 
-static Janet cfun_array_slice(int32_t argc, Janet *argv) {
+JANET_CORE_FN(cfun_array_slice,
+              "(array/slice arrtup &opt start end)",
+              "Takes a slice of array or tuple from `start` to `end`. The range is half open, "
+              "[start, end). Indexes can also be negative, indicating indexing from the "
+              "end of the array. By default, `start` is 0 and `end` is the length of the array. "
+              "Note that index -1 is synonymous with index `(length arrtup)` to allow a full "
+              "negative slice range. Returns a new array.") {
     JanetView view = janet_getindexed(argv, 0);
     JanetRange range = janet_getslice(argc, argv);
     JanetArray *array = janet_array(range.end - range.start);
@@ -196,7 +222,12 @@ static Janet cfun_array_slice(int32_t argc, Janet *argv) {
     return janet_wrap_array(array);
 }
 
-static Janet cfun_array_concat(int32_t argc, Janet *argv) {
+JANET_CORE_FN(cfun_array_concat,
+              "(array/concat arr & parts)",
+              "Concatenates a variable number of arrays (and tuples) into the first argument, "
+              "which must be an array. If any of the parts are arrays or tuples, their elements will "
+              "be inserted into the array. Otherwise, each part in `parts` will be appended to `arr` in order. "
+              "Return the modified array `arr`.") {
     int32_t i;
     janet_arity(argc, 1, -1);
     JanetArray *array = janet_getarray(argv, 0);
@@ -210,6 +241,11 @@ static Janet cfun_array_concat(int32_t argc, Janet *argv) {
                 int32_t j, len = 0;
                 const Janet *vals = NULL;
                 janet_indexed_view(argv[i], &vals, &len);
+                if (array->data == vals) {
+                    int32_t newcount = array->count + len;
+                    janet_array_ensure(array, newcount, 2);
+                    janet_indexed_view(argv[i], &vals, &len);
+                }
                 for (j = 0; j < len; j++)
                     janet_array_push(array, vals[j]);
             }
@@ -219,7 +255,12 @@ static Janet cfun_array_concat(int32_t argc, Janet *argv) {
     return janet_wrap_array(array);
 }
 
-static Janet cfun_array_insert(int32_t argc, Janet *argv) {
+JANET_CORE_FN(cfun_array_insert,
+              "(array/insert arr at & xs)",
+              "Insert all `xs` into array `arr` at index `at`. `at` should be an integer between "
+              "0 and the length of the array. A negative value for `at` will index backwards from "
+              "the end of the array, such that inserting at -1 appends to the array. "
+              "Returns the array.") {
     size_t chunksize, restsize;
     janet_arity(argc, 2, -1);
     JanetArray *array = janet_getarray(argv, 0);
@@ -245,7 +286,12 @@ static Janet cfun_array_insert(int32_t argc, Janet *argv) {
     return argv[0];
 }
 
-static Janet cfun_array_remove(int32_t argc, Janet *argv) {
+JANET_CORE_FN(cfun_array_remove,
+              "(array/remove arr at &opt n)",
+              "Remove up to `n` elements starting at index `at` in array `arr`. `at` can index from "
+              "the end of the array with a negative index, and `n` must be a non-negative integer. "
+              "By default, `n` is 1. "
+              "Returns the array.") {
     janet_arity(argc, 2, 3);
     JanetArray *array = janet_getarray(argv, 0);
     int32_t at = janet_getinteger(argv, 1);
@@ -270,7 +316,9 @@ static Janet cfun_array_remove(int32_t argc, Janet *argv) {
     return argv[0];
 }
 
-static Janet cfun_array_trim(int32_t argc, Janet *argv) {
+JANET_CORE_FN(cfun_array_trim,
+              "(array/trim arr)",
+              "Set the backing capacity of an array to its current length. Returns the modified array.") {
     janet_fixarity(argc, 1);
     JanetArray *array = janet_getarray(argv, 0);
     if (array->count) {
@@ -290,103 +338,33 @@ static Janet cfun_array_trim(int32_t argc, Janet *argv) {
     return argv[0];
 }
 
-static Janet cfun_array_clear(int32_t argc, Janet *argv) {
+JANET_CORE_FN(cfun_array_clear,
+              "(array/clear arr)",
+              "Empties an array, setting it's count to 0 but does not free the backing capacity. "
+              "Returns the modified array.") {
     janet_fixarity(argc, 1);
     JanetArray *array = janet_getarray(argv, 0);
     array->count = 0;
     return argv[0];
 }
 
-static const JanetReg array_cfuns[] = {
-    {
-        "array/new", cfun_array_new,
-        JDOC("(array/new capacity)\n\n"
-             "Creates a new empty array with a pre-allocated capacity. The same as "
-             "(array) but can be more efficient if the maximum size of an array is known.")
-    },
-    {
-        "array/new-filled", cfun_array_new_filled,
-        JDOC("(array/new-filled count &opt value)\n\n"
-             "Creates a new array of count elements, all set to value, which defaults to nil. Returns the new array.")
-    },
-    {
-        "array/fill", cfun_array_fill,
-        JDOC("(array/fill arr &opt value)\n\n"
-             "Replace all elements of an array with value (defaulting to nil) without changing the length of the array. "
-             "Returns the modified array.")
-    },
-    {
-        "array/pop", cfun_array_pop,
-        JDOC("(array/pop arr)\n\n"
-             "Remove the last element of the array and return it. If the array is empty, will return nil. Modifies "
-             "the input array.")
-    },
-    {
-        "array/peek", cfun_array_peek,
-        JDOC("(array/peek arr)\n\n"
-             "Returns the last element of the array. Does not modify the array.")
-    },
-    {
-        "array/push", cfun_array_push,
-        JDOC("(array/push arr x)\n\n"
-             "Insert an element in the end of an array. Modifies the input array and returns it.")
-    },
-    {
-        "array/ensure", cfun_array_ensure,
-        JDOC("(array/ensure arr capacity growth)\n\n"
-             "Ensures that the memory backing the array is large enough for capacity "
-             "items at the given rate of growth. Capacity and growth must be integers. "
-             "If the backing capacity is already enough, then this function does nothing. "
-             "Otherwise, the backing memory will be reallocated so that there is enough space.")
-    },
-    {
-        "array/slice", cfun_array_slice,
-        JDOC("(array/slice arrtup &opt start end)\n\n"
-             "Takes a slice of array or tuple from start to end. The range is half open, "
-             "[start, end). Indexes can also be negative, indicating indexing from the end of the "
-             "end of the array. By default, start is 0 and end is the length of the array. "
-             "Note that index -1 is synonymous with index (length arrtup) to allow a full "
-             "negative slice range. Returns a new array.")
-    },
-    {
-        "array/concat", cfun_array_concat,
-        JDOC("(array/concat arr & parts)\n\n"
-             "Concatenates a variable number of arrays (and tuples) into the first argument "
-             "which must be an array. If any of the parts are arrays or tuples, their elements will "
-             "be inserted into the array. Otherwise, each part in parts will be appended to arr in order. "
-             "Return the modified array arr.")
-    },
-    {
-        "array/insert", cfun_array_insert,
-        JDOC("(array/insert arr at & xs)\n\n"
-             "Insert all xs into array arr at index at. at should be an integer between "
-             "0 and the length of the array. A negative value for at will index backwards from "
-             "the end of the array, such that inserting at -1 appends to the array. "
-             "Returns the array.")
-    },
-    {
-        "array/remove", cfun_array_remove,
-        JDOC("(array/remove arr at &opt n)\n\n"
-             "Remove up to n elements starting at index at in array arr. at can index from "
-             "the end of the array with a negative index, and n must be a non-negative integer. "
-             "By default, n is 1. "
-             "Returns the array.")
-    },
-    {
-        "array/trim", cfun_array_trim,
-        JDOC("(array/trim arr)\n\n"
-             "Set the backing capacity of an array to its current length. Returns the modified array.")
-    },
-    {
-        "array/clear", cfun_array_clear,
-        JDOC("(array/clear arr)\n\n"
-             "Empties an array, setting it's count to 0 but does not free the backing capacity. "
-             "Returns the modified array.")
-    },
-    {NULL, NULL, NULL}
-};
-
 /* Load the array module */
 void janet_lib_array(JanetTable *env) {
-    janet_core_cfuns(env, NULL, array_cfuns);
+    JanetRegExt array_cfuns[] = {
+        JANET_CORE_REG("array/new", cfun_array_new),
+        JANET_CORE_REG("array/new-filled", cfun_array_new_filled),
+        JANET_CORE_REG("array/fill", cfun_array_fill),
+        JANET_CORE_REG("array/pop", cfun_array_pop),
+        JANET_CORE_REG("array/peek", cfun_array_peek),
+        JANET_CORE_REG("array/push", cfun_array_push),
+        JANET_CORE_REG("array/ensure", cfun_array_ensure),
+        JANET_CORE_REG("array/slice", cfun_array_slice),
+        JANET_CORE_REG("array/concat", cfun_array_concat),
+        JANET_CORE_REG("array/insert", cfun_array_insert),
+        JANET_CORE_REG("array/remove", cfun_array_remove),
+        JANET_CORE_REG("array/trim", cfun_array_trim),
+        JANET_CORE_REG("array/clear", cfun_array_clear),
+        JANET_REG_END
+    };
+    janet_core_cfuns_ext(env, NULL, array_cfuns);
 }

src/core/asm.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
@@ -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;
@@ -553,6 +558,10 @@ static JanetAssembleResult janet_asm1(JanetAssembler *parent, Janet source, int
     x = janet_get1(s, janet_ckeywordv("vararg"));
     if (janet_truthy(x)) def->flags |= JANET_FUNCDEF_FLAG_VARARG;
 
+    /* Check structarg */
+    x = janet_get1(s, janet_ckeywordv("structarg"));
+    if (janet_truthy(x)) def->flags |= JANET_FUNCDEF_FLAG_STRUCTARG;
+
     /* Check source */
     x = janet_get1(s, janet_ckeywordv("source"));
     if (janet_checktype(x, JANET_STRING)) def->source = janet_unwrap_string(x);
@@ -597,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++) {
@@ -709,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;
     }
 
@@ -861,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++) {
@@ -884,6 +973,10 @@ static Janet janet_disasm_vararg(JanetFuncDef *def) {
     return janet_wrap_boolean(def->flags & JANET_FUNCDEF_FLAG_VARARG);
 }
 
+static Janet janet_disasm_structarg(JanetFuncDef *def) {
+    return janet_wrap_boolean(def->flags & JANET_FUNCDEF_FLAG_STRUCTARG);
+}
+
 static Janet janet_disasm_constants(JanetFuncDef *def) {
     JanetArray *constants = janet_array(def->constants_length);
     for (int32_t i = 0; i < def->constants_length; i++) {
@@ -933,8 +1026,10 @@ Janet janet_disasm(JanetFuncDef *def) {
     janet_table_put(ret, janet_ckeywordv("bytecode"), janet_disasm_bytecode(def));
     janet_table_put(ret, janet_ckeywordv("source"), janet_disasm_source(def));
     janet_table_put(ret, janet_ckeywordv("vararg"), janet_disasm_vararg(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));
@@ -942,18 +1037,40 @@ Janet janet_disasm(JanetFuncDef *def) {
     return janet_wrap_struct(janet_table_to_struct(ret));
 }
 
-/* C Function for assembly */
-static Janet cfun_asm(int32_t argc, Janet *argv) {
+JANET_CORE_FN(cfun_asm,
+              "(asm assembly)",
+              "Returns a new function that is the compiled result of the assembly.\n"
+              "The syntax for the assembly can be found on the Janet website, and should correspond\n"
+              "to the return value of disasm. Will throw an\n"
+              "error on invalid assembly.") {
     janet_fixarity(argc, 1);
     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));
 }
 
-static Janet cfun_disasm(int32_t argc, Janet *argv) {
+JANET_CORE_FN(cfun_disasm,
+              "(disasm func &opt field)",
+              "Returns assembly that could be used to compile the given function. "
+              "func must be a function, not a c function. Will throw on error on a badly "
+              "typed argument. If given a field name, will only return that part of the function assembly. "
+              "Possible fields are:\n\n"
+              "* :arity - number of required and optional arguments.\n"
+              "* :min-arity - minimum number of arguments function can be called with.\n"
+              "* :max-arity - maximum number of arguments function can be called with.\n"
+              "* :vararg - true if function can take a variable number of arguments.\n"
+              "* :bytecode - array of parsed bytecode instructions. Each instruction is a tuple.\n"
+              "* :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"
+              "* :defs - other function definitions that this function may instantiate.\n") {
     janet_arity(argc, 1, 2);
     JanetFunction *f = janet_getfunction(argv, 0);
     if (argc == 2) {
@@ -965,6 +1082,7 @@ static Janet cfun_disasm(int32_t argc, Janet *argv) {
         if (!janet_cstrcmp(kw, "source")) return janet_disasm_source(f->def);
         if (!janet_cstrcmp(kw, "name")) return janet_disasm_name(f->def);
         if (!janet_cstrcmp(kw, "vararg")) return janet_disasm_vararg(f->def);
+        if (!janet_cstrcmp(kw, "structarg")) return janet_disasm_structarg(f->def);
         if (!janet_cstrcmp(kw, "slotcount")) return janet_disasm_slotcount(f->def);
         if (!janet_cstrcmp(kw, "constants")) return janet_disasm_constants(f->def);
         if (!janet_cstrcmp(kw, "sourcemap")) return janet_disasm_sourcemap(f->def);
@@ -976,41 +1094,14 @@ static Janet cfun_disasm(int32_t argc, Janet *argv) {
     }
 }
 
-static const JanetReg asm_cfuns[] = {
-    {
-        "asm", cfun_asm,
-        JDOC("(asm assembly)\n\n"
-             "Returns a new function that is the compiled result of the assembly.\n"
-             "The syntax for the assembly can be found on the Janet website, and should correspond\n"
-             "to the return value of disasm. Will throw an\n"
-             "error on invalid assembly.")
-    },
-    {
-        "disasm", cfun_disasm,
-        JDOC("(disasm func &opt field)\n\n"
-             "Returns assembly that could be used to compile the given function.\n"
-             "func must be a function, not a c function. Will throw on error on a badly\n"
-             "typed argument. If given a field name, will only return that part of the function assembly.\n"
-             "Possible fields are:\n\n"
-             "* :arity - number of required and optional arguments.\n\n"
-             "* :min-arity - minimum number of arguments function can be called with.\n\n"
-             "* :max-arity - maximum number of arguments function can be called with.\n\n"
-             "* :vararg - true if function can take a variable number of arguments.\n\n"
-             "* :bytecode - array of parsed bytecode instructions. Each instruction is a tuple.\n\n"
-             "* :source - name of source file that this function was compiled from.\n\n"
-             "* :name - name of function.\n\n"
-             "* :slotcount - how many virtual registers, or slots, this function uses. Corresponds to stack space used by function.\n\n"
-             "* :constants - an array of constants referenced by this function.\n\n"
-             "* :sourcemap - a mapping of each bytecode instruction to a line and column in the source file.\n\n"
-             "* :environments - an internal mapping of which enclosing functions are referenced for bindings.\n\n"
-             "* :defs - other function definitions that this function may instantiate.\n")
-    },
-    {NULL, NULL, NULL}
-};
-
 /* Load the library */
 void janet_lib_asm(JanetTable *env) {
-    janet_core_cfuns(env, NULL, asm_cfuns);
+    JanetRegExt asm_cfuns[] = {
+        JANET_CORE_REG("asm", cfun_asm),
+        JANET_CORE_REG("disasm", cfun_disasm),
+        JANET_REG_END
+    };
+    janet_core_cfuns_ext(env, NULL, asm_cfuns);
 }
 
 #endif

src/core/buffer.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
@@ -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 */
@@ -162,28 +170,38 @@ void janet_buffer_push_u64(JanetBuffer *buffer, uint64_t x) {
 
 /* C functions */
 
-static Janet cfun_buffer_new(int32_t argc, Janet *argv) {
+JANET_CORE_FN(cfun_buffer_new,
+              "(buffer/new capacity)",
+              "Creates a new, empty buffer with enough backing memory for `capacity` bytes. "
+              "Returns a new buffer of length 0.") {
     janet_fixarity(argc, 1);
     int32_t cap = janet_getinteger(argv, 0);
     JanetBuffer *buffer = janet_buffer(cap);
     return janet_wrap_buffer(buffer);
 }
 
-static Janet cfun_buffer_new_filled(int32_t argc, Janet *argv) {
+JANET_CORE_FN(cfun_buffer_new_filled,
+              "(buffer/new-filled count &opt byte)",
+              "Creates a new buffer of length `count` filled with `byte`. By default, `byte` is 0. "
+              "Returns the new buffer.") {
     janet_arity(argc, 1, 2);
     int32_t count = janet_getinteger(argv, 0);
+    if (count < 0) count = 0;
     int32_t byte = 0;
     if (argc == 2) {
         byte = janet_getinteger(argv, 1) & 0xFF;
     }
     JanetBuffer *buffer = janet_buffer(count);
-    if (buffer->data)
+    if (buffer->data && count > 0)
         memset(buffer->data, byte, count);
     buffer->count = count;
     return janet_wrap_buffer(buffer);
 }
 
-static Janet cfun_buffer_fill(int32_t argc, Janet *argv) {
+JANET_CORE_FN(cfun_buffer_fill,
+              "(buffer/fill buffer &opt byte)",
+              "Fill up a buffer with bytes, defaulting to 0s. Does not change the buffer's length. "
+              "Returns the modified buffer.") {
     janet_arity(argc, 1, 2);
     JanetBuffer *buffer = janet_getbuffer(argv, 0);
     int32_t byte = 0;
@@ -196,7 +214,10 @@ static Janet cfun_buffer_fill(int32_t argc, Janet *argv) {
     return argv[0];
 }
 
-static Janet cfun_buffer_trim(int32_t argc, Janet *argv) {
+JANET_CORE_FN(cfun_buffer_trim,
+              "(buffer/trim buffer)",
+              "Set the backing capacity of the buffer to the current length of the buffer. Returns the "
+              "modified buffer.") {
     janet_fixarity(argc, 1);
     JanetBuffer *buffer = janet_getbuffer(argv, 0);
     if (buffer->count < buffer->capacity) {
@@ -211,7 +232,10 @@ static Janet cfun_buffer_trim(int32_t argc, Janet *argv) {
     return argv[0];
 }
 
-static Janet cfun_buffer_u8(int32_t argc, Janet *argv) {
+JANET_CORE_FN(cfun_buffer_u8,
+              "(buffer/push-byte buffer & xs)",
+              "Append bytes to a buffer. Will expand the buffer as necessary. "
+              "Returns the modified buffer. Will throw an error if the buffer overflows.") {
     int32_t i;
     janet_arity(argc, 1, -1);
     JanetBuffer *buffer = janet_getbuffer(argv, 0);
@@ -221,7 +245,11 @@ static Janet cfun_buffer_u8(int32_t argc, Janet *argv) {
     return argv[0];
 }
 
-static Janet cfun_buffer_word(int32_t argc, Janet *argv) {
+JANET_CORE_FN(cfun_buffer_word,
+              "(buffer/push-word buffer & xs)",
+              "Append machine words to a buffer. The 4 bytes of the integer are appended "
+              "in twos complement, little endian order, unsigned for all x. Returns the modified buffer. Will "
+              "throw an error if the buffer overflows.") {
     int32_t i;
     janet_arity(argc, 1, -1);
     JanetBuffer *buffer = janet_getbuffer(argv, 0);
@@ -235,7 +263,12 @@ static Janet cfun_buffer_word(int32_t argc, Janet *argv) {
     return argv[0];
 }
 
-static Janet cfun_buffer_chars(int32_t argc, Janet *argv) {
+JANET_CORE_FN(cfun_buffer_chars,
+              "(buffer/push-string buffer & xs)",
+              "Push byte sequences onto the end of a buffer. "
+              "Will accept any of strings, keywords, symbols, and buffers. "
+              "Returns the modified buffer. "
+              "Will throw an error if the buffer overflows.") {
     int32_t i;
     janet_arity(argc, 1, -1);
     JanetBuffer *buffer = janet_getbuffer(argv, 0);
@@ -250,7 +283,13 @@ static Janet cfun_buffer_chars(int32_t argc, Janet *argv) {
     return argv[0];
 }
 
-static Janet cfun_buffer_push(int32_t argc, Janet *argv) {
+JANET_CORE_FN(cfun_buffer_push,
+              "(buffer/push buffer & xs)",
+              "Push both individual bytes and byte sequences to a buffer. For each x in xs, "
+              "push the byte if x is an integer, otherwise push the bytesequence to the buffer. "
+              "Thus, this function behaves like both `buffer/push-string` and `buffer/push-byte`. "
+              "Returns the modified buffer. "
+              "Will throw an error if the buffer overflows.") {
     int32_t i;
     janet_arity(argc, 1, -1);
     JanetBuffer *buffer = janet_getbuffer(argv, 0);
@@ -270,14 +309,19 @@ static Janet cfun_buffer_push(int32_t argc, Janet *argv) {
 }
 
 
-static Janet cfun_buffer_clear(int32_t argc, Janet *argv) {
+JANET_CORE_FN(cfun_buffer_clear,
+              "(buffer/clear buffer)",
+              "Sets the size of a buffer to 0 and empties it. The buffer retains "
+              "its memory so it can be efficiently refilled. Returns the modified buffer.") {
     janet_fixarity(argc, 1);
     JanetBuffer *buffer = janet_getbuffer(argv, 0);
     buffer->count = 0;
     return argv[0];
 }
 
-static Janet cfun_buffer_popn(int32_t argc, Janet *argv) {
+JANET_CORE_FN(cfun_buffer_popn,
+              "(buffer/popn buffer n)",
+              "Removes the last `n` bytes from the buffer. Returns the modified buffer.") {
     janet_fixarity(argc, 2);
     JanetBuffer *buffer = janet_getbuffer(argv, 0);
     int32_t n = janet_getinteger(argv, 1);
@@ -290,7 +334,12 @@ static Janet cfun_buffer_popn(int32_t argc, Janet *argv) {
     return argv[0];
 }
 
-static Janet cfun_buffer_slice(int32_t argc, Janet *argv) {
+JANET_CORE_FN(cfun_buffer_slice,
+              "(buffer/slice bytes &opt start end)",
+              "Takes a slice of a byte sequence from `start` to `end`. The range is half open, "
+              "[start, end). Indexes can also be negative, indicating indexing from the end of the "
+              "end of the array. By default, `start` is 0 and `end` is the length of the buffer. "
+              "Returns a new buffer.") {
     JanetByteView view = janet_getbytes(argv, 0);
     JanetRange range = janet_getslice(argc, argv);
     JanetBuffer *buffer = janet_buffer(range.end - range.start);
@@ -314,7 +363,9 @@ static void bitloc(int32_t argc, Janet *argv, JanetBuffer **b, int32_t *index, i
     *bit = which_bit;
 }
 
-static Janet cfun_buffer_bitset(int32_t argc, Janet *argv) {
+JANET_CORE_FN(cfun_buffer_bitset,
+              "(buffer/bit-set buffer index)",
+              "Sets the bit at the given bit-index. Returns the buffer.") {
     int bit;
     int32_t index;
     JanetBuffer *buffer;
@@ -323,7 +374,9 @@ static Janet cfun_buffer_bitset(int32_t argc, Janet *argv) {
     return argv[0];
 }
 
-static Janet cfun_buffer_bitclear(int32_t argc, Janet *argv) {
+JANET_CORE_FN(cfun_buffer_bitclear,
+              "(buffer/bit-clear buffer index)",
+              "Clears the bit at the given bit-index. Returns the buffer.") {
     int bit;
     int32_t index;
     JanetBuffer *buffer;
@@ -332,7 +385,9 @@ static Janet cfun_buffer_bitclear(int32_t argc, Janet *argv) {
     return argv[0];
 }
 
-static Janet cfun_buffer_bitget(int32_t argc, Janet *argv) {
+JANET_CORE_FN(cfun_buffer_bitget,
+              "(buffer/bit buffer index)",
+              "Gets the bit at the given bit-index. Returns true if the bit is set, false if not.") {
     int bit;
     int32_t index;
     JanetBuffer *buffer;
@@ -340,7 +395,9 @@ static Janet cfun_buffer_bitget(int32_t argc, Janet *argv) {
     return janet_wrap_boolean(buffer->data[index] & (1 << bit));
 }
 
-static Janet cfun_buffer_bittoggle(int32_t argc, Janet *argv) {
+JANET_CORE_FN(cfun_buffer_bittoggle,
+              "(buffer/bit-toggle buffer index)",
+              "Toggles the bit at the given bit index in buffer. Returns the buffer.") {
     int bit;
     int32_t index;
     JanetBuffer *buffer;
@@ -349,7 +406,11 @@ static Janet cfun_buffer_bittoggle(int32_t argc, Janet *argv) {
     return argv[0];
 }
 
-static Janet cfun_buffer_blit(int32_t argc, Janet *argv) {
+JANET_CORE_FN(cfun_buffer_blit,
+              "(buffer/blit dest src &opt dest-start src-start src-end)",
+              "Insert the contents of `src` into `dest`. Can optionally take indices that "
+              "indicate which part of `src` to copy into which part of `dest`. Indices can be "
+              "negative in order to index from the end of `src` or `dest`. Returns `dest`.") {
     janet_arity(argc, 2, 5);
     JanetBuffer *dest = janet_getbuffer(argv, 0);
     JanetByteView src = janet_getbytes(argv, 1);
@@ -386,7 +447,10 @@ static Janet cfun_buffer_blit(int32_t argc, Janet *argv) {
     return argv[0];
 }
 
-static Janet cfun_buffer_format(int32_t argc, Janet *argv) {
+JANET_CORE_FN(cfun_buffer_format,
+              "(buffer/format buffer format & args)",
+              "Snprintf like functionality for printing values into a buffer. Returns "
+              "the modified buffer.") {
     janet_arity(argc, 2, -1);
     JanetBuffer *buffer = janet_getbuffer(argv, 0);
     const char *strfrmt = (const char *) janet_getstring(argv, 1);
@@ -394,116 +458,26 @@ static Janet cfun_buffer_format(int32_t argc, Janet *argv) {
     return argv[0];
 }
 
-static const JanetReg buffer_cfuns[] = {
-    {
-        "buffer/new", cfun_buffer_new,
-        JDOC("(buffer/new capacity)\n\n"
-             "Creates a new, empty buffer with enough backing memory for capacity bytes. "
-             "Returns a new buffer of length 0.")
-    },
-    {
-        "buffer/new-filled", cfun_buffer_new_filled,
-        JDOC("(buffer/new-filled count &opt byte)\n\n"
-             "Creates a new buffer of length count filled with byte. By default, byte is 0. "
-             "Returns the new buffer.")
-    },
-    {
-        "buffer/fill", cfun_buffer_fill,
-        JDOC("(buffer/fill buffer &opt byte)\n\n"
-             "Fill up a buffer with bytes, defaulting to 0s. Does not change the buffer's length. "
-             "Returns the modified buffer.")
-    },
-    {
-        "buffer/trim", cfun_buffer_trim,
-        JDOC("(buffer/trim buffer)\n\n"
-             "Set the backing capacity of the buffer to the current length of the buffer. Returns the "
-             "modified buffer.")
-    },
-    {
-        "buffer/push-byte", cfun_buffer_u8,
-        JDOC("(buffer/push-byte buffer & xs)\n\n"
-             "Append bytes to a buffer. Will expand the buffer as necessary. "
-             "Returns the modified buffer. Will throw an error if the buffer overflows.")
-    },
-    {
-        "buffer/push-word", cfun_buffer_word,
-        JDOC("(buffer/push-word buffer & xs)\n\n"
-             "Append machine words to a buffer. The 4 bytes of the integer are appended "
-             "in twos complement, little endian order, unsigned for all x. Returns the modified buffer. Will "
-             "throw an error if the buffer overflows.")
-    },
-    {
-        "buffer/push-string", cfun_buffer_chars,
-        JDOC("(buffer/push-string buffer & xs)\n\n"
-             "Push byte sequences onto the end of a buffer. "
-             "Will accept any of strings, keywords, symbols, and buffers. "
-             "Returns the modified buffer. "
-             "Will throw an error if the buffer overflows.")
-    },
-    {
-        "buffer/push", cfun_buffer_push,
-        JDOC("(buffer/push buffer & xs)\n\n"
-             "Push both individual bytes and byte sequences to a buffer. For each x in xs, "
-             "push the byte if x is an integer, otherwise push the bytesequence to the buffer. "
-             "Thus, this function behaves like both `buffer/push-string` and `buffer/push-byte`. "
-             "Returns the modified buffer. "
-             "Will throw an error if the buffer overflows.")
-    },
-    {
-        "buffer/popn", cfun_buffer_popn,
-        JDOC("(buffer/popn buffer n)\n\n"
-             "Removes the last n bytes from the buffer. Returns the modified buffer.")
-    },
-    {
-        "buffer/clear", cfun_buffer_clear,
-        JDOC("(buffer/clear buffer)\n\n"
-             "Sets the size of a buffer to 0 and empties it. The buffer retains "
-             "its memory so it can be efficiently refilled. Returns the modified buffer.")
-    },
-    {
-        "buffer/slice", cfun_buffer_slice,
-        JDOC("(buffer/slice bytes &opt start end)\n\n"
-             "Takes a slice of a byte sequence from start to end. The range is half open, "
-             "[start, end). Indexes can also be negative, indicating indexing from the end of the "
-             "end of the array. By default, start is 0 and end is the length of the buffer. "
-             "Returns a new buffer.")
-    },
-    {
-        "buffer/bit-set", cfun_buffer_bitset,
-        JDOC("(buffer/bit-set buffer index)\n\n"
-             "Sets the bit at the given bit-index. Returns the buffer.")
-    },
-    {
-        "buffer/bit-clear", cfun_buffer_bitclear,
-        JDOC("(buffer/bit-clear buffer index)\n\n"
-             "Clears the bit at the given bit-index. Returns the buffer.")
-    },
-    {
-        "buffer/bit", cfun_buffer_bitget,
-        JDOC("(buffer/bit buffer index)\n\n"
-             "Gets the bit at the given bit-index. Returns true if the bit is set, false if not.")
-    },
-    {
-        "buffer/bit-toggle", cfun_buffer_bittoggle,
-        JDOC("(buffer/bit-toggle buffer index)\n\n"
-             "Toggles the bit at the given bit index in buffer. Returns the buffer.")
-    },
-    {
-        "buffer/blit", cfun_buffer_blit,
-        JDOC("(buffer/blit dest src &opt dest-start src-start src-end)\n\n"
-             "Insert the contents of src into dest. Can optionally take indices that "
-             "indicate which part of src to copy into which part of dest. Indices can be "
-             "negative to index from the end of src or dest. Returns dest.")
-    },
-    {
-        "buffer/format", cfun_buffer_format,
-        JDOC("(buffer/format buffer format & args)\n\n"
-             "Snprintf like functionality for printing values into a buffer. Returns "
-             " the modified buffer.")
-    },
-    {NULL, NULL, NULL}
-};
-
 void janet_lib_buffer(JanetTable *env) {
-    janet_core_cfuns(env, NULL, buffer_cfuns);
+    JanetRegExt buffer_cfuns[] = {
+        JANET_CORE_REG("buffer/new", cfun_buffer_new),
+        JANET_CORE_REG("buffer/new-filled", cfun_buffer_new_filled),
+        JANET_CORE_REG("buffer/fill", cfun_buffer_fill),
+        JANET_CORE_REG("buffer/trim", cfun_buffer_trim),
+        JANET_CORE_REG("buffer/push-byte", cfun_buffer_u8),
+        JANET_CORE_REG("buffer/push-word", cfun_buffer_word),
+        JANET_CORE_REG("buffer/push-string", cfun_buffer_chars),
+        JANET_CORE_REG("buffer/push", cfun_buffer_push),
+        JANET_CORE_REG("buffer/popn", cfun_buffer_popn),
+        JANET_CORE_REG("buffer/clear", cfun_buffer_clear),
+        JANET_CORE_REG("buffer/slice", cfun_buffer_slice),
+        JANET_CORE_REG("buffer/bit-set", cfun_buffer_bitset),
+        JANET_CORE_REG("buffer/bit-clear", cfun_buffer_bitclear),
+        JANET_CORE_REG("buffer/bit", cfun_buffer_bitget),
+        JANET_CORE_REG("buffer/bit-toggle", cfun_buffer_bittoggle),
+        JANET_CORE_REG("buffer/blit", cfun_buffer_blit),
+        JANET_CORE_REG("buffer/format", cfun_buffer_format),
+        JANET_REG_END
+    };
+    janet_core_cfuns_ext(env, NULL, buffer_cfuns);
 }

src/core/bytecode.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
@@ -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) 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
@@ -51,15 +51,15 @@ JANET_NO_RETURN static void janet_top_level_signal(const char *msg) {
 }
 
 void janet_signalv(JanetSignal sig, Janet message) {
-    if (janet_vm_return_reg != NULL) {
-        *janet_vm_return_reg = message;
-        if (NULL != janet_vm_fiber) {
-            janet_vm_fiber->flags |= JANET_FIBER_DID_LONGJUMP;
+    if (janet_vm.return_reg != NULL) {
+        *janet_vm.return_reg = message;
+        if (NULL != janet_vm.fiber) {
+            janet_vm.fiber->flags |= JANET_FIBER_DID_LONGJUMP;
         }
 #if defined(JANET_BSD) || defined(JANET_APPLE)
-        _longjmp(*janet_vm_jmp_buf, sig);
+        _longjmp(*janet_vm.signal_buf, sig);
 #else
-        longjmp(*janet_vm_jmp_buf, sig);
+        longjmp(*janet_vm.signal_buf, sig);
 #endif
     } else {
         const char *str = (const char *)janet_formatc("janet top level signal - %v\n", message);
@@ -212,7 +212,7 @@ const char *janet_getcstring(const Janet *argv, int32_t n) {
     const uint8_t *jstr = janet_getstring(argv, n);
     const char *cstr = (const char *)jstr;
     if (strlen(cstr) != (size_t) janet_string_length(jstr)) {
-        janet_panicf("string %v contains embedded 0s");
+        janet_panic("string contains embedded 0s");
     }
     return cstr;
 }
@@ -260,11 +260,27 @@ int32_t janet_getinteger(const Janet *argv, int32_t n) {
 }
 
 int64_t janet_getinteger64(const Janet *argv, int32_t n) {
+#ifdef JANET_INT_TYPES
+    return janet_unwrap_s64(argv[n]);
+#else
     Janet x = argv[n];
     if (!janet_checkint64(x)) {
         janet_panicf("bad slot #%d, expected 64 bit signed integer, got %v", n, x);
     }
     return (int64_t) janet_unwrap_number(x);
+#endif
+}
+
+uint64_t janet_getuinteger64(const Janet *argv, int32_t n) {
+#ifdef JANET_INT_TYPES
+    return janet_unwrap_u64(argv[n]);
+#else
+    Janet x = argv[n];
+    if (!janet_checkint64(x)) {
+        janet_panicf("bad slot #%d, expected 64 bit unsigned integer, got %v", n, x);
+    }
+    return (uint64_t) janet_unwrap_number(x);
+#endif
 }
 
 size_t janet_getsize(const Janet *argv, int32_t n) {
@@ -358,26 +374,26 @@ JanetRange janet_getslice(int32_t argc, const Janet *argv) {
 }
 
 Janet janet_dyn(const char *name) {
-    if (!janet_vm_fiber) {
-        if (!janet_vm_top_dyns) return janet_wrap_nil();
-        return janet_table_get(janet_vm_top_dyns, janet_ckeywordv(name));
+    if (!janet_vm.fiber) {
+        if (!janet_vm.top_dyns) return janet_wrap_nil();
+        return janet_table_get(janet_vm.top_dyns, janet_ckeywordv(name));
     }
-    if (janet_vm_fiber->env) {
-        return janet_table_get(janet_vm_fiber->env, janet_ckeywordv(name));
+    if (janet_vm.fiber->env) {
+        return janet_table_get(janet_vm.fiber->env, janet_ckeywordv(name));
     } else {
         return janet_wrap_nil();
     }
 }
 
 void janet_setdyn(const char *name, Janet value) {
-    if (!janet_vm_fiber) {
-        if (!janet_vm_top_dyns) janet_vm_top_dyns = janet_table(10);
-        janet_table_put(janet_vm_top_dyns, janet_ckeywordv(name), value);
+    if (!janet_vm.fiber) {
+        if (!janet_vm.top_dyns) janet_vm.top_dyns = janet_table(10);
+        janet_table_put(janet_vm.top_dyns, janet_ckeywordv(name), value);
     } else {
-        if (!janet_vm_fiber->env) {
-            janet_vm_fiber->env = janet_table(1);
+        if (!janet_vm.fiber->env) {
+            janet_vm.fiber->env = janet_table(1);
         }
-        janet_table_put(janet_vm_fiber->env, janet_ckeywordv(name), value);
+        janet_table_put(janet_vm.fiber->env, janet_ckeywordv(name), value);
     }
 }
 

src/core/cfuns.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

src/core/compile.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
@@ -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);
@@ -197,6 +207,39 @@ void janetc_popscope_keepslot(JanetCompiler *c, JanetSlot retslot) {
     }
 }
 
+static int lookup_missing(
+    JanetCompiler *c,
+    const uint8_t *sym,
+    JanetFunction *handler,
+    JanetBinding *out) {
+    int32_t minar = handler->def->min_arity;
+    int32_t maxar = handler->def->max_arity;
+    if (minar > 1 || maxar < 1) {
+        janetc_error(c, janet_cstring("missing symbol lookup handler must take 1 argument"));
+        return 0;
+    }
+    Janet args[1] = { janet_wrap_symbol(sym) };
+    JanetFiber *fiberp = janet_fiber(handler, 64, 1, args);
+    if (NULL == fiberp) {
+        janetc_error(c, janet_cstring("failed to call missing symbol lookup handler"));
+        return 0;
+    }
+    fiberp->env = c->env;
+    int lock = janet_gclock();
+    Janet tempOut;
+    JanetSignal status = janet_continue(fiberp, janet_wrap_nil(), &tempOut);
+    janet_gcunlock(lock);
+    if (status != JANET_SIGNAL_OK) {
+        janetc_error(c, janet_formatc("(lookup) %V", tempOut));
+        return 0;
+    }
+
+    /* Convert return value as entry. */
+    /* Alternative could use janet_resolve_ext(c->env, sym) to read result from environment. */
+    *out = janet_binding_from_entry(tempOut);
+    return 1;
+}
+
 /* Allow searching for symbols. Return information about the symbol */
 JanetSlot janetc_resolve(
     JanetCompiler *c,
@@ -230,6 +273,21 @@ JanetSlot janetc_resolve(
     /* Symbol not found - check for global */
     {
         JanetBinding binding = janet_resolve_ext(c->env, sym);
+        if (binding.type == JANET_BINDING_NONE) {
+            Janet handler = janet_table_get(c->env, janet_ckeywordv("missing-symbol"));
+            switch (janet_type(handler)) {
+                case JANET_NIL:
+                    break;
+                case JANET_FUNCTION:
+                    if (!lookup_missing(c, sym, janet_unwrap_function(handler), &binding))
+                        return janetc_cslot(janet_wrap_nil());
+                    break;
+                default:
+                    janetc_error(c, janet_formatc("invalid lookup handler %V", handler));
+                    return janetc_cslot(janet_wrap_nil());
+            }
+        }
+
         switch (binding.type) {
             default:
             case JANET_BINDING_NONE:
@@ -239,6 +297,12 @@ JanetSlot janetc_resolve(
             case JANET_BINDING_MACRO: /* Macro should function like defs when not in calling pos */
                 ret = janetc_cslot(binding.value);
                 break;
+            case JANET_BINDING_DYNAMIC_DEF:
+            case JANET_BINDING_DYNAMIC_MACRO:
+                ret = janetc_cslot(binding.value);
+                ret.flags |= JANET_SLOT_REF | JANET_SLOT_NAMED | JANET_SLOTTYPE_ANY;
+                ret.flags &= ~JANET_SLOT_CONSTANT;
+                break;
             case JANET_BINDING_VAR: {
                 ret = janetc_cslot(binding.value);
                 ret.flags |= JANET_SLOT_REF | JANET_SLOT_NAMED | JANET_SLOT_MUTABLE | JANET_SLOTTYPE_ANY;
@@ -280,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;
@@ -301,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;
@@ -310,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;
             }
         }
@@ -651,7 +719,7 @@ static int macroexpand1(
     }
     Janet macroval;
     JanetBindingType btype = janet_resolve(c->env, name, &macroval);
-    if (btype != JANET_BINDING_MACRO ||
+    if (!(btype == JANET_BINDING_MACRO || btype == JANET_BINDING_DYNAMIC_MACRO) ||
             !janet_checktype(macroval, JANET_FUNCTION))
         return 0;
 
@@ -814,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);
@@ -869,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);
 
@@ -942,18 +1057,34 @@ JanetCompileResult janet_compile(Janet source, JanetTable *env, const uint8_t *w
 }
 
 /* C Function for compiling */
-static Janet cfun(int32_t argc, Janet *argv) {
+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 "
+              "eval. Returns a new function and does not modify ast. Returns an error "
+              "struct with keys :line, :column, and :error if compilation fails. "
+              "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;
+        janet_vm.fiber->env = env;
     }
     const uint8_t *source = NULL;
     if (argc >= 3) {
-        source = janet_getstring(argv, 2);
+        Janet x = argv[2];
+        if (janet_checktype(x, JANET_STRING)) {
+            source = janet_unwrap_string(x);
+        } else if (janet_checktype(x, JANET_KEYWORD)) {
+            source = janet_unwrap_keyword(x);
+        } 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));
@@ -973,20 +1104,10 @@ static Janet cfun(int32_t argc, Janet *argv) {
     }
 }
 
-static const JanetReg compile_cfuns[] = {
-    {
-        "compile", cfun,
-        JDOC("(compile ast &opt env source lints)\n\n"
-             "Compiles an Abstract Syntax Tree (ast) into a function. "
-             "Pair the compile function with parsing functionality to implement "
-             "eval. Returns a new function and does not modify ast. Returns an error "
-             "struct with keys :line, :column, and :error if compilation fails. "
-             "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)`.")
-    },
-    {NULL, NULL, NULL}
-};
-
 void janet_lib_compile(JanetTable *env) {
-    janet_core_cfuns(env, NULL, compile_cfuns);
+    JanetRegExt cfuns[] = {
+        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) 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
@@ -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) 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
@@ -35,51 +35,13 @@ extern const unsigned char *janet_core_image;
 extern size_t janet_core_image_size;
 #endif
 
-/* Use LoadLibrary on windows or dlopen on posix to load dynamic libaries
- * with native code. */
-#if defined(JANET_NO_DYNAMIC_MODULES)
-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"
-#elif defined(JANET_WINDOWS)
-#include <windows.h>
-typedef HINSTANCE Clib;
-#define load_clib(name) LoadLibrary((name))
-#define symbol_clib(lib, sym) GetProcAddress((lib), (sym))
-static char error_clib_buf[256];
-static char *error_clib(void) {
-    FormatMessageA(FORMAT_MESSAGE_FROM_SYSTEM | FORMAT_MESSAGE_IGNORE_INSERTS,
-                   NULL, GetLastError(), MAKELANGID(LANG_NEUTRAL, SUBLANG_DEFAULT),
-                   error_clib_buf, sizeof(error_clib_buf), NULL);
-    error_clib_buf[strlen(error_clib_buf) - 1] = '\0';
-    return error_clib_buf;
-}
+/* Docstrings should only exist during bootstrap */
+#ifdef JANET_BOOTSTRAP
+#define JDOC(x) (x)
 #else
-#include <dlfcn.h>
-typedef void *Clib;
-#define load_clib(name) dlopen((name), RTLD_NOW)
-#define symbol_clib(lib, sym) dlsym((lib), (sym))
-#define error_clib() dlerror()
+#define JDOC(x) NULL
 #endif
 
-static char *get_processed_name(const char *name) {
-    if (name[0] == '.') return (char *) name;
-    const char *c;
-    for (c = name; *c; c++) {
-        if (*c == '/') return (char *) name;
-    }
-    size_t l = (size_t)(c - name);
-    char *ret = janet_malloc(l + 3);
-    if (NULL == ret) {
-        JANET_OUT_OF_MEMORY;
-    }
-    ret[0] = '.';
-    ret[1] = '/';
-    memcpy(ret + 2, name, l + 1);
-    return ret;
-}
-
 JanetModule janet_native(const char *name, const uint8_t **error) {
     char *processed_name = get_processed_name(name);
     Clib lib = load_clib(processed_name);
@@ -130,7 +92,7 @@ static const char *janet_dyncstring(const char *name, const char *dflt) {
     const uint8_t *jstr = janet_unwrap_string(x);
     const char *cstr = (const char *)jstr;
     if (strlen(cstr) != (size_t) janet_string_length(jstr)) {
-        janet_panicf("string %v contains embedded 0s");
+        janet_panicf("string %v contains embedded 0s", x);
     }
     return cstr;
 }
@@ -143,7 +105,21 @@ static int is_path_sep(char c) {
 }
 
 /* Used for module system. */
-static Janet janet_core_expand_path(int32_t argc, Janet *argv) {
+JANET_CORE_FN(janet_core_expand_path,
+              "(module/expand-path path template)",
+              "Expands a path template as found in `module/paths` for `module/find`. "
+              "This takes in a path (the argument to require) and a template string, "
+              "to expand the path to a path that can be "
+              "used for importing files. The replacements are as follows:\n\n"
+              "* :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"
+              "* :native: -- the extension used to load natives, .so or .dll\n\n"
+              "* :sys: -- the system path, or (dyn :syspath)") {
     janet_fixarity(argc, 2);
     const char *input = janet_getcstring(argv, 0);
     const char *template = janet_getcstring(argv, 1);
@@ -184,6 +160,21 @@ static Janet janet_core_expand_path(int32_t argc, Janet *argv) {
             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;
@@ -266,11 +257,13 @@ static Janet janet_core_expand_path(int32_t argc, Janet *argv) {
     return janet_wrap_buffer(out);
 }
 
-static Janet janet_core_dyn(int32_t argc, Janet *argv) {
+JANET_CORE_FN(janet_core_dyn,
+              "(dyn key &opt default)",
+              "Get a dynamic binding. Returns the default value (or nil) if no binding found.") {
     janet_arity(argc, 1, 2);
     Janet value;
-    if (janet_vm_fiber->env) {
-        value = janet_table_get(janet_vm_fiber->env, argv[0]);
+    if (janet_vm.fiber->env) {
+        value = janet_table_get(janet_vm.fiber->env, argv[0]);
     } else {
         value = janet_wrap_nil();
     }
@@ -280,16 +273,24 @@ static Janet janet_core_dyn(int32_t argc, Janet *argv) {
     return value;
 }
 
-static Janet janet_core_setdyn(int32_t argc, Janet *argv) {
+JANET_CORE_FN(janet_core_setdyn,
+              "(setdyn key value)",
+              "Set a dynamic binding. Returns value.") {
     janet_fixarity(argc, 2);
-    if (!janet_vm_fiber->env) {
-        janet_vm_fiber->env = janet_table(2);
+    if (!janet_vm.fiber->env) {
+        janet_vm.fiber->env = janet_table(2);
     }
-    janet_table_put(janet_vm_fiber->env, argv[0], argv[1]);
+    janet_table_put(janet_vm.fiber->env, argv[0], argv[1]);
     return argv[1];
 }
 
-static Janet janet_core_native(int32_t argc, Janet *argv) {
+JANET_CORE_FN(janet_core_native,
+              "(native path &opt env)",
+              "Load a native module from the given path. The path "
+              "must be an absolute or relative path on the file system, and is "
+              "usually a .so file on Unix systems, and a .dll file on Windows. "
+              "Returns an environment table that contains functions and other values "
+              "from the native module.") {
     JanetModule init;
     janet_arity(argc, 1, 2);
     const uint8_t *path = janet_getstring(argv, 0);
@@ -309,67 +310,107 @@ static Janet janet_core_native(int32_t argc, Janet *argv) {
     return janet_wrap_table(env);
 }
 
-static Janet janet_core_describe(int32_t argc, Janet *argv) {
+JANET_CORE_FN(janet_core_describe,
+              "(describe x)",
+              "Returns a string that is a human-readable description of `x`. "
+              "For recursive data structures, the string returned contains a "
+              "pointer value from which the identity of `x` "
+              "can be determined.") {
     JanetBuffer *b = janet_buffer(0);
     for (int32_t i = 0; i < argc; ++i)
         janet_description_b(b, argv[i]);
     return janet_stringv(b->data, b->count);
 }
 
-static Janet janet_core_string(int32_t argc, Janet *argv) {
+JANET_CORE_FN(janet_core_string,
+              "(string & xs)",
+              "Creates a string by concatenating the elements of `xs` together. If an "
+              "element is not a byte sequence, it is converted to bytes via `describe`. "
+              "Returns the new string.") {
     JanetBuffer *b = janet_buffer(0);
     for (int32_t i = 0; i < argc; ++i)
         janet_to_string_b(b, argv[i]);
     return janet_stringv(b->data, b->count);
 }
 
-static Janet janet_core_symbol(int32_t argc, Janet *argv) {
+JANET_CORE_FN(janet_core_symbol,
+              "(symbol & xs)",
+              "Creates a symbol by concatenating the elements of `xs` together. If an "
+              "element is not a byte sequence, it is converted to bytes via `describe`. "
+              "Returns the new symbol.") {
     JanetBuffer *b = janet_buffer(0);
     for (int32_t i = 0; i < argc; ++i)
         janet_to_string_b(b, argv[i]);
     return janet_symbolv(b->data, b->count);
 }
 
-static Janet janet_core_keyword(int32_t argc, Janet *argv) {
+JANET_CORE_FN(janet_core_keyword,
+              "(keyword & xs)",
+              "Creates a keyword by concatenating the elements of `xs` together. If an "
+              "element is not a byte sequence, it is converted to bytes via `describe`. "
+              "Returns the new keyword.") {
     JanetBuffer *b = janet_buffer(0);
     for (int32_t i = 0; i < argc; ++i)
         janet_to_string_b(b, argv[i]);
     return janet_keywordv(b->data, b->count);
 }
 
-static Janet janet_core_buffer(int32_t argc, Janet *argv) {
+JANET_CORE_FN(janet_core_buffer,
+              "(buffer & xs)",
+              "Creates a buffer by concatenating the elements of `xs` together. If an "
+              "element is not a byte sequence, it is converted to bytes via `describe`. "
+              "Returns the new buffer.") {
     JanetBuffer *b = janet_buffer(0);
     for (int32_t i = 0; i < argc; ++i)
         janet_to_string_b(b, argv[i]);
     return janet_wrap_buffer(b);
 }
 
-static Janet janet_core_is_abstract(int32_t argc, Janet *argv) {
+JANET_CORE_FN(janet_core_is_abstract,
+              "(abstract? x)",
+              "Check if x is an abstract type.") {
     janet_fixarity(argc, 1);
     return janet_wrap_boolean(janet_checktype(argv[0], JANET_ABSTRACT));
 }
 
-static Janet janet_core_scannumber(int32_t argc, Janet *argv) {
+JANET_CORE_FN(janet_core_scannumber,
+              "(scan-number str &opt base)",
+              "Parse a number from a byte sequence and return that number, either an integer "
+              "or a real. The number "
+              "must be in the same format as numbers in janet source code. Will return nil "
+              "on an invalid number. Optionally provide a base - if a base is provided, no "
+              "radix specifier is expected at the beginning of the number.") {
     double number;
-    janet_fixarity(argc, 1);
+    janet_arity(argc, 1, 2);
     JanetByteView view = janet_getbytes(argv, 0);
-    if (janet_scan_number(view.bytes, view.len, &number))
+    int32_t base = janet_optinteger(argv, argc, 1, 0);
+    int valid = base == 0 || (base >= 2 && base <= 36);
+    if (!valid) {
+        janet_panicf("expected base between 2 and 36, got %d", base);
+    }
+    if (janet_scan_number_base(view.bytes, view.len, base, &number))
         return janet_wrap_nil();
     return janet_wrap_number(number);
 }
 
-static Janet janet_core_tuple(int32_t argc, Janet *argv) {
+JANET_CORE_FN(janet_core_tuple,
+              "(tuple & items)",
+              "Creates a new tuple that contains items. Returns the new tuple.") {
     return janet_wrap_tuple(janet_tuple_n(argv, argc));
 }
 
-static Janet janet_core_array(int32_t argc, Janet *argv) {
+JANET_CORE_FN(janet_core_array,
+              "(array & items)",
+              "Create a new array that contains items. Returns the new array.") {
     JanetArray *array = janet_array(argc);
     array->count = argc;
     safe_memcpy(array->data, argv, argc * sizeof(Janet));
     return janet_wrap_array(array);
 }
 
-static Janet janet_core_slice(int32_t argc, Janet *argv) {
+JANET_CORE_FN(janet_core_slice,
+              "(slice x &opt start end)",
+              "Extract a sub-range of an indexed data structure or byte sequence.") {
     JanetRange range;
     JanetByteView bview;
     JanetView iview;
@@ -384,7 +425,12 @@ static Janet janet_core_slice(int32_t argc, Janet *argv) {
     }
 }
 
-static Janet janet_core_table(int32_t argc, Janet *argv) {
+JANET_CORE_FN(janet_core_table,
+              "(table & kvs)",
+              "Creates a new table from a variadic number of keys and values. "
+              "kvs is a sequence k1, v1, k2, v2, k3, v3, ... If kvs has "
+              "an odd number of elements, an error will be thrown. Returns the "
+              "new table.") {
     int32_t i;
     if (argc & 1)
         janet_panic("expected even number of arguments");
@@ -395,10 +441,35 @@ static Janet janet_core_table(int32_t argc, Janet *argv) {
     return janet_wrap_table(table);
 }
 
-static Janet janet_core_struct(int32_t argc, Janet *argv) {
+JANET_CORE_FN(janet_core_getproto,
+              "(getproto x)",
+              "Get the prototype of a table or struct. Will return nil if `x` has no prototype.") {
+    janet_fixarity(argc, 1);
+    if (janet_checktype(argv[0], JANET_TABLE)) {
+        JanetTable *t = janet_unwrap_table(argv[0]);
+        return t->proto
+               ? janet_wrap_table(t->proto)
+               : janet_wrap_nil();
+    }
+    if (janet_checktype(argv[0], JANET_STRUCT)) {
+        JanetStruct st = janet_unwrap_struct(argv[0]);
+        return janet_struct_proto(st)
+               ? janet_wrap_struct(janet_struct_proto(st))
+               : janet_wrap_nil();
+    }
+    janet_panicf("expected struct|table, got %v", argv[0]);
+}
+
+JANET_CORE_FN(janet_core_struct,
+              "(struct & kvs)",
+              "Create a new struct from a sequence of key value pairs. "
+              "kvs is a sequence k1, v1, k2, v2, k3, v3, ... If kvs has "
+              "an odd number of elements, an error will be thrown. Returns the "
+              "new struct.") {
     int32_t i;
-    if (argc & 1)
+    if (argc & 1) {
         janet_panic("expected even number of arguments");
+    }
     JanetKV *st = janet_struct_begin(argc >> 1);
     for (i = 0; i < argc; i += 2) {
         janet_struct_put(st, argv[i], argv[i + 1]);
@@ -406,20 +477,30 @@ static Janet janet_core_struct(int32_t argc, Janet *argv) {
     return janet_wrap_struct(janet_struct_end(st));
 }
 
-static Janet janet_core_gensym(int32_t argc, Janet *argv) {
+JANET_CORE_FN(janet_core_gensym,
+              "(gensym)",
+              "Returns a new symbol that is unique across the runtime. This means it "
+              "will not collide with any already created symbols during compilation, so "
+              "it can be used in macros to generate automatic bindings.") {
     (void) argv;
     janet_fixarity(argc, 0);
     return janet_wrap_symbol(janet_symbol_gen());
 }
 
-static Janet janet_core_gccollect(int32_t argc, Janet *argv) {
+JANET_CORE_FN(janet_core_gccollect,
+              "(gccollect)",
+              "Run garbage collection. You should probably not call this manually.") {
     (void) argv;
     (void) argc;
     janet_collect();
     return janet_wrap_nil();
 }
 
-static Janet janet_core_gcsetinterval(int32_t argc, Janet *argv) {
+JANET_CORE_FN(janet_core_gcsetinterval,
+              "(gcsetinterval interval)",
+              "Set an integer number of bytes to allocate before running garbage collection. "
+              "Low values for interval will be slower but use less memory. "
+              "High values will be faster but use more memory.") {
     janet_fixarity(argc, 1);
     size_t s = janet_getsize(argv, 0);
     /* limit interval to 48 bits */
@@ -428,17 +509,37 @@ static Janet janet_core_gcsetinterval(int32_t argc, Janet *argv) {
         janet_panic("interval too large");
     }
 #endif
-    janet_vm_gc_interval = s;
+    janet_vm.gc_interval = s;
     return janet_wrap_nil();
 }
 
-static Janet janet_core_gcinterval(int32_t argc, Janet *argv) {
+JANET_CORE_FN(janet_core_gcinterval,
+              "(gcinterval)",
+              "Returns the integer number of bytes to allocate before running an iteration "
+              "of garbage collection.") {
     (void) argv;
     janet_fixarity(argc, 0);
-    return janet_wrap_number((double) janet_vm_gc_interval);
+    return janet_wrap_number((double) janet_vm.gc_interval);
 }
 
-static Janet janet_core_type(int32_t argc, Janet *argv) {
+JANET_CORE_FN(janet_core_type,
+              "(type x)",
+              "Returns the type of `x` as a keyword. `x` is one of:\n\n"
+              "* :nil\n\n"
+              "* :boolean\n\n"
+              "* :number\n\n"
+              "* :array\n\n"
+              "* :tuple\n\n"
+              "* :table\n\n"
+              "* :struct\n\n"
+              "* :string\n\n"
+              "* :buffer\n\n"
+              "* :symbol\n\n"
+              "* :keyword\n\n"
+              "* :function\n\n"
+              "* :cfunction\n\n"
+              "* :fiber\n\n"
+              "or another keyword for an abstract type.") {
     janet_fixarity(argc, 1);
     JanetType t = janet_type(argv[0]);
     if (t == JANET_ABSTRACT) {
@@ -448,12 +549,21 @@ static Janet janet_core_type(int32_t argc, Janet *argv) {
     }
 }
 
-static Janet janet_core_hash(int32_t argc, Janet *argv) {
+JANET_CORE_FN(janet_core_hash,
+              "(hash value)",
+              "Gets a hash for any value. The hash is an integer can be used "
+              "as a cheap hash function for all values. If two values are strictly equal, "
+              "then they will have the same hash value.") {
     janet_fixarity(argc, 1);
     return janet_wrap_number(janet_hash(argv[0]));
 }
 
-static Janet janet_core_getline(int32_t argc, Janet *argv) {
+JANET_CORE_FN(janet_core_getline,
+              "(getline &opt prompt buf env)",
+              "Reads a line of input into a buffer, including the newline character, using a prompt. "
+              "An optional environment table can be provided for auto-complete. "
+              "Returns the modified buffer. "
+              "Use this function to implement a simple interface for a terminal program.") {
     FILE *in = janet_dynfile("in", stdin);
     FILE *out = janet_dynfile("out", stdout);
     janet_arity(argc, 0, 3);
@@ -478,21 +588,27 @@ static Janet janet_core_getline(int32_t argc, Janet *argv) {
     return janet_wrap_buffer(buf);
 }
 
-static Janet janet_core_trace(int32_t argc, Janet *argv) {
+JANET_CORE_FN(janet_core_trace,
+              "(trace func)",
+              "Enable tracing on a function. Returns the function.") {
     janet_fixarity(argc, 1);
     JanetFunction *func = janet_getfunction(argv, 0);
     func->gc.flags |= JANET_FUNCFLAG_TRACE;
     return argv[0];
 }
 
-static Janet janet_core_untrace(int32_t argc, Janet *argv) {
+JANET_CORE_FN(janet_core_untrace,
+              "(untrace func)",
+              "Disables tracing on a function. Returns the function.") {
     janet_fixarity(argc, 1);
     JanetFunction *func = janet_getfunction(argv, 0);
     func->gc.flags &= ~JANET_FUNCFLAG_TRACE;
     return argv[0];
 }
 
-static Janet janet_core_check_int(int32_t argc, Janet *argv) {
+JANET_CORE_FN(janet_core_check_int,
+              "(int? x)",
+              "Check if x can be exactly represented as a 32 bit signed two's complement integer.") {
     janet_fixarity(argc, 1);
     if (!janet_checktype(argv[0], JANET_NUMBER)) goto ret_false;
     double num = janet_unwrap_number(argv[0]);
@@ -501,7 +617,9 @@ ret_false:
     return janet_wrap_false();
 }
 
-static Janet janet_core_check_nat(int32_t argc, Janet *argv) {
+JANET_CORE_FN(janet_core_check_nat,
+              "(nat? x)",
+              "Check if x can be exactly represented as a non-negative 32 bit signed two's complement integer.") {
     janet_fixarity(argc, 1);
     if (!janet_checktype(argv[0], JANET_NUMBER)) goto ret_false;
     double num = janet_unwrap_number(argv[0]);
@@ -510,229 +628,44 @@ ret_false:
     return janet_wrap_false();
 }
 
-static Janet janet_core_signal(int32_t argc, Janet *argv) {
+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]);
 }
 
-static const JanetReg corelib_cfuns[] = {
-    {
-        "native", janet_core_native,
-        JDOC("(native path &opt env)\n\n"
-             "Load a native module from the given path. The path "
-             "must be an absolute or relative path on the file system, and is "
-             "usually a .so file on Unix systems, and a .dll file on Windows. "
-             "Returns an environment table that contains functions and other values "
-             "from the native module.")
-    },
-    {
-        "describe", janet_core_describe,
-        JDOC("(describe x)\n\n"
-             "Returns a string that is a human-readable description of a value x.")
-    },
-    {
-        "string", janet_core_string,
-        JDOC("(string & xs)\n\n"
-             "Creates a string by concatenating the elements of `xs` together. If an "
-             "element is not a byte sequence, it is converted to bytes via `describe`. "
-             "Returns the new string.")
-    },
-    {
-        "symbol", janet_core_symbol,
-        JDOC("(symbol & xs)\n\n"
-             "Creates a symbol by concatenating the elements of `xs` together. If an "
-             "element is not a byte sequence, it is converted to bytes via `describe`. "
-             "Returns the new symbol.")
-    },
-    {
-        "keyword", janet_core_keyword,
-        JDOC("(keyword & xs)\n\n"
-             "Creates a keyword by concatenating the elements of `xs` together. If an "
-             "element is not a byte sequence, it is converted to bytes via `describe`. "
-             "Returns the new keyword.")
-    },
-    {
-        "buffer", janet_core_buffer,
-        JDOC("(buffer & xs)\n\n"
-             "Creates a buffer by concatenating the elements of `xs` together. If an "
-             "element is not a byte sequence, it is converted to bytes via `describe`. "
-             "Returns the new buffer.")
-    },
-    {
-        "abstract?", janet_core_is_abstract,
-        JDOC("(abstract? x)\n\n"
-             "Check if x is an abstract type.")
-    },
-    {
-        "table", janet_core_table,
-        JDOC("(table & kvs)\n\n"
-             "Creates a new table from a variadic number of keys and values. "
-             "kvs is a sequence k1, v1, k2, v2, k3, v3, ... If kvs has "
-             "an odd number of elements, an error will be thrown. Returns the "
-             "new table.")
-    },
-    {
-        "array", janet_core_array,
-        JDOC("(array & items)\n\n"
-             "Create a new array that contains items. Returns the new array.")
-    },
-    {
-        "scan-number", janet_core_scannumber,
-        JDOC("(scan-number str)\n\n"
-             "Parse a number from a byte sequence an return that number, either and integer "
-             "or a real. The number "
-             "must be in the same format as numbers in janet source code. Will return nil "
-             "on an invalid number.")
-    },
-    {
-        "tuple", janet_core_tuple,
-        JDOC("(tuple & items)\n\n"
-             "Creates a new tuple that contains items. Returns the new tuple.")
-    },
-    {
-        "struct", janet_core_struct,
-        JDOC("(struct & kvs)\n\n"
-             "Create a new struct from a sequence of key value pairs. "
-             "kvs is a sequence k1, v1, k2, v2, k3, v3, ... If kvs has "
-             "an odd number of elements, an error will be thrown. Returns the "
-             "new struct.")
-    },
-    {
-        "gensym", janet_core_gensym,
-        JDOC("(gensym)\n\n"
-             "Returns a new symbol that is unique across the runtime. This means it "
-             "will not collide with any already created symbols during compilation, so "
-             "it can be used in macros to generate automatic bindings.")
-    },
-    {
-        "gccollect", janet_core_gccollect,
-        JDOC("(gccollect)\n\n"
-             "Run garbage collection. You should probably not call this manually.")
-    },
-    {
-        "gcsetinterval", janet_core_gcsetinterval,
-        JDOC("(gcsetinterval interval)\n\n"
-             "Set an integer number of bytes to allocate before running garbage collection. "
-             "Low values for interval will be slower but use less memory. "
-             "High values will be faster but use more memory.")
-    },
-    {
-        "gcinterval", janet_core_gcinterval,
-        JDOC("(gcinterval)\n\n"
-             "Returns the integer number of bytes to allocate before running an iteration "
-             "of garbage collection.")
-    },
-    {
-        "type", janet_core_type,
-        JDOC("(type x)\n\n"
-             "Returns the type of `x` as a keyword. `x` is one of:\n\n"
-             "* :nil\n\n"
-             "* :boolean\n\n"
-             "* :number\n\n"
-             "* :array\n\n"
-             "* :tuple\n\n"
-             "* :table\n\n"
-             "* :struct\n\n"
-             "* :string\n\n"
-             "* :buffer\n\n"
-             "* :symbol\n\n"
-             "* :keyword\n\n"
-             "* :function\n\n"
-             "* :cfunction\n\n"
-             "* :fiber\n\n"
-             "or another keyword for an abstract type.")
-    },
-    {
-        "hash", janet_core_hash,
-        JDOC("(hash value)\n\n"
-             "Gets a hash for any value. The hash is an integer can be used "
-             "as a cheap hash function for all values. If two values are strictly equal, "
-             "then they will have the same hash value.")
-    },
-    {
-        "getline", janet_core_getline,
-        JDOC("(getline &opt prompt buf env)\n\n"
-             "Reads a line of input into a buffer, including the newline character, using a prompt. "
-             "An optional environment table can be provided for auto-complete. "
-             "Returns the modified buffer. "
-             "Use this function to implement a simple interface for a terminal program.")
-    },
-    {
-        "dyn", janet_core_dyn,
-        JDOC("(dyn key &opt default)\n\n"
-             "Get a dynamic binding. Returns the default value (or nil) if no binding found.")
-    },
-    {
-        "setdyn", janet_core_setdyn,
-        JDOC("(setdyn key value)\n\n"
-             "Set a dynamic binding. Returns value.")
-    },
-    {
-        "trace", janet_core_trace,
-        JDOC("(trace func)\n\n"
-             "Enable tracing on a function. Returns the function.")
-    },
-    {
-        "untrace", janet_core_untrace,
-        JDOC("(untrace func)\n\n"
-             "Disables tracing on a function. Returns the function.")
-    },
-    {
-        "module/expand-path", janet_core_expand_path,
-        JDOC("(module/expand-path path template)\n\n"
-             "Expands a path template as found in `module/paths` for `module/find`. "
-             "This takes in a path (the argument to require) and a template string, "
-             "to expand the path to a path that can be "
-             "used for importing files. The replacements are as follows:\n\n"
-             "* :all: -- the value of path verbatim\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"
-             "* :native: -- the extension used to load natives, .so or .dll\n\n"
-             "* :sys: -- the system path, or (dyn :syspath)")
-    },
-    {
-        "int?", janet_core_check_int,
-        JDOC("(int? x)\n\n"
-             "Check if x can be exactly represented as a 32 bit signed two's complement integer.")
-    },
-    {
-        "nat?", janet_core_check_nat,
-        JDOC("(nat? x)\n\n"
-             "Check if x can be exactly represented as a non-negative 32 bit signed two's complement integer.")
-    },
-    {
-        "slice", janet_core_slice,
-        JDOC("(slice x &opt start end)\n\n"
-             "Extract a sub-range of an indexed data structure or byte sequence.")
-    },
-    {
-        "signal", janet_core_signal,
-        JDOC("(signal what x)\n\n"
-             "Raise a signal with payload x. ")
-    },
-    {NULL, NULL, NULL}
-};
+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
 
@@ -1006,13 +939,47 @@ static const uint32_t cmp_asm[] = {
  */
 
 static void janet_load_libs(JanetTable *env) {
-    janet_core_cfuns(env, NULL, corelib_cfuns);
+    JanetRegExt corelib_cfuns[] = {
+        JANET_CORE_REG("native", janet_core_native),
+        JANET_CORE_REG("describe", janet_core_describe),
+        JANET_CORE_REG("string", janet_core_string),
+        JANET_CORE_REG("symbol", janet_core_symbol),
+        JANET_CORE_REG("keyword", janet_core_keyword),
+        JANET_CORE_REG("buffer", janet_core_buffer),
+        JANET_CORE_REG("abstract?", janet_core_is_abstract),
+        JANET_CORE_REG("table", janet_core_table),
+        JANET_CORE_REG("array", janet_core_array),
+        JANET_CORE_REG("scan-number", janet_core_scannumber),
+        JANET_CORE_REG("tuple", janet_core_tuple),
+        JANET_CORE_REG("struct", janet_core_struct),
+        JANET_CORE_REG("gensym", janet_core_gensym),
+        JANET_CORE_REG("gccollect", janet_core_gccollect),
+        JANET_CORE_REG("gcsetinterval", janet_core_gcsetinterval),
+        JANET_CORE_REG("gcinterval", janet_core_gcinterval),
+        JANET_CORE_REG("type", janet_core_type),
+        JANET_CORE_REG("hash", janet_core_hash),
+        JANET_CORE_REG("getline", janet_core_getline),
+        JANET_CORE_REG("dyn", janet_core_dyn),
+        JANET_CORE_REG("setdyn", janet_core_setdyn),
+        JANET_CORE_REG("trace", janet_core_trace),
+        JANET_CORE_REG("untrace", janet_core_untrace),
+        JANET_CORE_REG("module/expand-path", janet_core_expand_path),
+        JANET_CORE_REG("int?", janet_core_check_int),
+        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
+    };
+    janet_core_cfuns_ext(env, NULL, corelib_cfuns);
     janet_lib_io(env);
     janet_lib_math(env);
     janet_lib_array(env);
     janet_lib_tuple(env);
     janet_lib_buffer(env);
     janet_lib_table(env);
+    janet_lib_struct(env);
     janet_lib_fiber(env);
     janet_lib_os(env);
     janet_lib_parse(env);
@@ -1029,15 +996,15 @@ static void janet_load_libs(JanetTable *env) {
 #ifdef JANET_INT_TYPES
     janet_lib_inttypes(env);
 #endif
-#ifdef JANET_THREADS
-    janet_lib_thread(env);
-#endif
 #ifdef JANET_EV
     janet_lib_ev(env);
 #endif
 #ifdef JANET_NET
     janet_lib_net(env);
 #endif
+#ifdef JANET_FFI
+    janet_lib_ffi(env);
+#endif
 }
 
 #ifdef JANET_BOOTSTRAP
@@ -1215,8 +1182,8 @@ JanetTable *janet_core_env(JanetTable *replacements) {
 
 JanetTable *janet_core_env(JanetTable *replacements) {
     /* Memoize core env, ignoring replacements the second time around. */
-    if (NULL != janet_vm_core_env) {
-        return janet_vm_core_env;
+    if (NULL != janet_vm.core_env) {
+        return janet_vm.core_env;
     }
 
     JanetTable *dict = janet_core_lookup_table(replacements);
@@ -1232,7 +1199,7 @@ JanetTable *janet_core_env(JanetTable *replacements) {
     /* Memoize */
     janet_gcroot(marsh_out);
     JanetTable *env = janet_unwrap_table(marsh_out);
-    janet_vm_core_env = env;
+    janet_vm.core_env = env;
 
     /* Invert image dict manually here. We can't do this in boot.janet as it
      * breaks deterministic builds */
@@ -1264,9 +1231,7 @@ JanetTable *janet_core_lookup_table(JanetTable *replacements) {
             JanetKV kv = replacements->data[i];
             if (!janet_checktype(kv.key, JANET_NIL)) {
                 janet_table_put(dict, kv.key, kv.value);
-                if (janet_checktype(kv.value, JANET_CFUNCTION)) {
-                    janet_table_put(janet_vm_registry, kv.value, kv.key);
-                }
+                /* Add replacement functions to registry? */
             }
         }
     }

src/core/debug.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
@@ -55,7 +55,7 @@ void janet_debug_find(
     JanetFuncDef **def_out, int32_t *pc_out,
     const uint8_t *source, int32_t sourceLine, int32_t sourceColumn) {
     /* Scan the heap for right func def */
-    JanetGCObject *current = janet_vm_blocks;
+    JanetGCObject *current = janet_vm.blocks;
     /* Keep track of the best source mapping we have seen so far */
     int32_t besti = -1;
     int32_t best_line = -1;
@@ -86,7 +86,7 @@ void janet_debug_find(
                 }
             }
         }
-        current = current->next;
+        current = current->data.next;
     }
     if (best_def) {
         *def_out = best_def;
@@ -96,15 +96,19 @@ void janet_debug_find(
     }
 }
 
+void janet_stacktrace(JanetFiber *fiber, Janet err) {
+    const char *prefix = janet_checktype(err, JANET_NIL) ? NULL : "";
+    janet_stacktrace_ext(fiber, err, prefix);
+}
+
 /* Error reporting. This can be emulated from within Janet, but for
  * consitency with the top level code it is defined once. */
-void janet_stacktrace(JanetFiber *fiber, Janet err) {
+void janet_stacktrace_ext(JanetFiber *fiber, Janet err, const char *prefix) {
+
     int32_t fi;
     const char *errstr = (const char *)janet_to_string(err);
     JanetFiber **fibers = NULL;
-
-    /* Don't print error line if it is nil. */
-    int wrote_error = janet_checktype(err, JANET_NIL);
+    int wrote_error = !prefix;
 
     int print_color = janet_truthy(janet_dyn("err-color"));
     if (print_color) janet_eprintf("\x1b[31m");
@@ -118,6 +122,7 @@ void janet_stacktrace(JanetFiber *fiber, Janet err) {
         fiber = fibers[fi];
         int32_t i = fiber->frame;
         while (i > 0) {
+            JanetCFunRegistry *reg = NULL;
             JanetStackFrame *frame = (JanetStackFrame *)(fiber->data + i - JANET_FRAME_SIZE);
             JanetFuncDef *def = NULL;
             i = frame->prevframe;
@@ -125,11 +130,10 @@ void janet_stacktrace(JanetFiber *fiber, Janet err) {
             /* Print prelude to stack frame */
             if (!wrote_error) {
                 JanetFiberStatus status = janet_fiber_status(fiber);
-                const char *prefix = status == JANET_STATUS_ERROR ? "" : "status ";
                 janet_eprintf("%s%s: %s\n",
-                              prefix,
+                              prefix ? prefix : "",
                               janet_status_names[status],
-                              errstr);
+                              errstr ? errstr : janet_status_names[status]);
                 wrote_error = 1;
             }
 
@@ -144,11 +148,19 @@ void janet_stacktrace(JanetFiber *fiber, Janet err) {
             } else {
                 JanetCFunction cfun = (JanetCFunction)(frame->pc);
                 if (cfun) {
-                    Janet name = janet_table_get(janet_vm_registry, janet_wrap_cfunction(cfun));
-                    if (!janet_checktype(name, JANET_NIL))
-                        janet_eprintf(" %s", (const char *)janet_to_string(name));
-                    else
+                    reg = janet_registry_get(cfun);
+                    if (NULL != reg && NULL != reg->name) {
+                        if (reg->name_prefix) {
+                            janet_eprintf(" %s/%s", reg->name_prefix, reg->name);
+                        } else {
+                            janet_eprintf(" %s", reg->name);
+                        }
+                        if (NULL != reg->source_file) {
+                            janet_eprintf(" [%s]", reg->source_file);
+                        }
+                    } else {
                         janet_eprintf(" <cfunction>");
+                    }
                 }
             }
             if (frame->flags & JANET_STACKFRAME_TAILCALL)
@@ -161,6 +173,11 @@ void janet_stacktrace(JanetFiber *fiber, Janet err) {
                 } else {
                     janet_eprintf(" pc=%d", off);
                 }
+            } else if (NULL != reg) {
+                /* C Function */
+                if (reg->source_line > 0) {
+                    janet_eprintf(" on line %d", (long) reg->source_line);
+                }
             }
             janet_eprintf("\n");
         }
@@ -195,7 +212,13 @@ static void helper_find_fun(int32_t argc, Janet *argv, JanetFuncDef **def, int32
     *bytecode_offset = offset;
 }
 
-static Janet cfun_debug_break(int32_t argc, Janet *argv) {
+JANET_CORE_FN(cfun_debug_break,
+              "(debug/break source line col)",
+              "Sets a breakpoint in `source` at a given line and column. "
+              "Will throw an error if the breakpoint location "
+              "cannot be found. For example\n\n"
+              "\t(debug/break \"core.janet\" 10 4)\n\n"
+              "will set a breakpoint at line 10, 4th column of the file core.janet.") {
     JanetFuncDef *def;
     int32_t offset;
     helper_find(argc, argv, &def, &offset);
@@ -203,7 +226,11 @@ static Janet cfun_debug_break(int32_t argc, Janet *argv) {
     return janet_wrap_nil();
 }
 
-static Janet cfun_debug_unbreak(int32_t argc, Janet *argv) {
+JANET_CORE_FN(cfun_debug_unbreak,
+              "(debug/unbreak source line column)",
+              "Remove a breakpoint with a source key at a given line and column. "
+              "Will throw an error if the breakpoint "
+              "cannot be found.") {
     JanetFuncDef *def;
     int32_t offset = 0;
     helper_find(argc, argv, &def, &offset);
@@ -211,7 +238,11 @@ static Janet cfun_debug_unbreak(int32_t argc, Janet *argv) {
     return janet_wrap_nil();
 }
 
-static Janet cfun_debug_fbreak(int32_t argc, Janet *argv) {
+JANET_CORE_FN(cfun_debug_fbreak,
+              "(debug/fbreak fun &opt pc)",
+              "Set a breakpoint in a given function. pc is an optional offset, which "
+              "is in bytecode instructions. fun is a function value. Will throw an error "
+              "if the offset is too large or negative.") {
     JanetFuncDef *def;
     int32_t offset = 0;
     helper_find_fun(argc, argv, &def, &offset);
@@ -219,7 +250,9 @@ static Janet cfun_debug_fbreak(int32_t argc, Janet *argv) {
     return janet_wrap_nil();
 }
 
-static Janet cfun_debug_unfbreak(int32_t argc, Janet *argv) {
+JANET_CORE_FN(cfun_debug_unfbreak,
+              "(debug/unfbreak fun &opt pc)",
+              "Unset a breakpoint set with debug/fbreak.") {
     JanetFuncDef *def;
     int32_t offset;
     helper_find_fun(argc, argv, &def, &offset);
@@ -227,7 +260,12 @@ static Janet cfun_debug_unfbreak(int32_t argc, Janet *argv) {
     return janet_wrap_nil();
 }
 
-static Janet cfun_debug_lineage(int32_t argc, Janet *argv) {
+JANET_CORE_FN(cfun_debug_lineage,
+              "(debug/lineage fib)",
+              "Returns an array of all child fibers from a root fiber. This function "
+              "is useful when a fiber signals or errors to an ancestor fiber. Using this function, "
+              "the fiber handling the error can see which fiber raised the signal. This function should "
+              "be used mostly for debugging purposes.") {
     janet_fixarity(argc, 1);
     JanetFiber *fiber = janet_getfiber(argv, 0);
     JanetArray *array = janet_array(0);
@@ -252,9 +290,20 @@ static Janet doframe(JanetStackFrame *frame) {
     } else {
         JanetCFunction cfun = (JanetCFunction)(frame->pc);
         if (cfun) {
-            Janet name = janet_table_get(janet_vm_registry, janet_wrap_cfunction(cfun));
-            if (!janet_checktype(name, JANET_NIL)) {
-                janet_table_put(t, janet_ckeywordv("name"), name);
+            JanetCFunRegistry *reg = janet_registry_get(cfun);
+            if (NULL != reg->name) {
+                if (NULL != reg->name_prefix) {
+                    janet_table_put(t, janet_ckeywordv("name"), janet_wrap_string(janet_formatc("%s/%s", reg->name_prefix, reg->name)));
+                } else {
+                    janet_table_put(t, janet_ckeywordv("name"), janet_cstringv(reg->name));
+                }
+                if (NULL != reg->source_file) {
+                    janet_table_put(t, janet_ckeywordv("source"), janet_cstringv(reg->source_file));
+                }
+                if (reg->source_line > 0) {
+                    janet_table_put(t, janet_ckeywordv("source-line"), janet_wrap_integer(reg->source_line));
+                    janet_table_put(t, janet_ckeywordv("source-column"), janet_wrap_integer(1));
+                }
             }
         }
         janet_table_put(t, janet_ckeywordv("c"), janet_wrap_true());
@@ -280,11 +329,46 @@ 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);
 }
 
-static Janet cfun_debug_stack(int32_t argc, Janet *argv) {
+JANET_CORE_FN(cfun_debug_stack,
+              "(debug/stack fib)",
+              "Gets information about the stack as an array of tables. Each table "
+              "in the array contains information about a stack frame. The top-most, current "
+              "stack frame is the first table in the array, and the bottom-most stack frame "
+              "is the last value. Each stack frame contains some of the following attributes:\n\n"
+              "* :c - true if the stack frame is a c function invocation\n\n"
+              "* :source-column - the current source column of the stack frame\n\n"
+              "* :function - the function that the stack frame represents\n\n"
+              "* :source-line - the current source line of the stack frame\n\n"
+              "* :name - the human-friendly name of the function\n\n"
+              "* :pc - integer indicating the location of the program counter\n\n"
+              "* :source - string with the file path or other identifier for the source code\n\n"
+              "* :slots - array of all values in each slot\n\n"
+              "* :tail - boolean indicating a tail call") {
     janet_fixarity(argc, 1);
     JanetFiber *fiber = janet_getfiber(argv, 0);
     JanetArray *array = janet_array(0);
@@ -300,15 +384,24 @@ static Janet cfun_debug_stack(int32_t argc, Janet *argv) {
     return janet_wrap_array(array);
 }
 
-static Janet cfun_debug_stacktrace(int32_t argc, Janet *argv) {
-    janet_arity(argc, 1, 2);
+JANET_CORE_FN(cfun_debug_stacktrace,
+              "(debug/stacktrace fiber &opt err prefix)",
+              "Prints a nice looking stacktrace for a fiber. Can optionally provide "
+              "an error value to print the stack trace with. If `err` is nil or not "
+              "provided, and no prefix is given, will skip the error line. Returns the fiber.") {
+    janet_arity(argc, 1, 3);
     JanetFiber *fiber = janet_getfiber(argv, 0);
     Janet x = argc == 1 ? janet_wrap_nil() : argv[1];
-    janet_stacktrace(fiber, x);
+    const char *prefix = janet_optcstring(argv, argc, 2, NULL);
+    janet_stacktrace_ext(fiber, x, prefix);
     return argv[0];
 }
 
-static Janet cfun_debug_argstack(int32_t argc, Janet *argv) {
+JANET_CORE_FN(cfun_debug_argstack,
+              "(debug/arg-stack fiber)",
+              "Gets all values currently on the fiber's argument stack. Normally, "
+              "this should be empty unless the fiber signals while pushing arguments "
+              "to make a function call. Returns a new array.") {
     janet_fixarity(argc, 1);
     JanetFiber *fiber = janet_getfiber(argv, 0);
     JanetArray *array = janet_array(fiber->stacktop - fiber->stackstart);
@@ -317,7 +410,11 @@ static Janet cfun_debug_argstack(int32_t argc, Janet *argv) {
     return janet_wrap_array(array);
 }
 
-static Janet cfun_debug_step(int32_t argc, Janet *argv) {
+JANET_CORE_FN(cfun_debug_step,
+              "(debug/step fiber &opt x)",
+              "Run a fiber for one virtual instruction of the Janet machine. Can optionally "
+              "pass in a value that will be passed as the resuming value. Returns the signal value, "
+              "which will usually be nil, as breakpoints raise nil signals.") {
     janet_arity(argc, 1, 2);
     JanetFiber *fiber = janet_getfiber(argv, 0);
     Janet out = janet_wrap_nil();
@@ -325,85 +422,19 @@ static Janet cfun_debug_step(int32_t argc, Janet *argv) {
     return out;
 }
 
-static const JanetReg debug_cfuns[] = {
-    {
-        "debug/break", cfun_debug_break,
-        JDOC("(debug/break source line col)\n\n"
-             "Sets a breakpoint in `source` at a given line and column. "
-             "Will throw an error if the breakpoint location "
-             "cannot be found. For example\n\n"
-             "\t(debug/break \"core.janet\" 10 4)\n\n"
-             "wil set a breakpoint at line 10, 4th column of the file core.janet.")
-    },
-    {
-        "debug/unbreak", cfun_debug_unbreak,
-        JDOC("(debug/unbreak source line column)\n\n"
-             "Remove a breakpoint with a source key at a given line and column. "
-             "Will throw an error if the breakpoint "
-             "cannot be found.")
-    },
-    {
-        "debug/fbreak", cfun_debug_fbreak,
-        JDOC("(debug/fbreak fun &opt pc)\n\n"
-             "Set a breakpoint in a given function. pc is an optional offset, which "
-             "is in bytecode instructions. fun is a function value. Will throw an error "
-             "if the offset is too large or negative.")
-    },
-    {
-        "debug/unfbreak", cfun_debug_unfbreak,
-        JDOC("(debug/unfbreak fun &opt pc)\n\n"
-             "Unset a breakpoint set with debug/fbreak.")
-    },
-    {
-        "debug/arg-stack", cfun_debug_argstack,
-        JDOC("(debug/arg-stack fiber)\n\n"
-             "Gets all values currently on the fiber's argument stack. Normally, "
-             "this should be empty unless the fiber signals while pushing arguments "
-             "to make a function call. Returns a new array.")
-    },
-    {
-        "debug/stack", cfun_debug_stack,
-        JDOC("(debug/stack fib)\n\n"
-             "Gets information about the stack as an array of tables. Each table "
-             "in the array contains information about a stack frame. The top-most, current "
-             "stack frame is the first table in the array, and the bottom-most stack frame "
-             "is the last value. Each stack frame contains some of the following attributes:\n\n"
-             "* :c - true if the stack frame is a c function invocation\n\n"
-             "* :column - the current source column of the stack frame\n\n"
-             "* :function - the function that the stack frame represents\n\n"
-             "* :line - the current source line of the stack frame\n\n"
-             "* :name - the human-friendly name of the function\n\n"
-             "* :pc - integer indicating the location of the program counter\n\n"
-             "* :source - string with the file path or other identifier for the source code\n\n"
-             "* :slots - array of all values in each slot\n\n"
-             "* :tail - boolean indicating a tail call")
-    },
-    {
-        "debug/stacktrace", cfun_debug_stacktrace,
-        JDOC("(debug/stacktrace fiber &opt err)\n\n"
-             "Prints a nice looking stacktrace for a fiber. Can optionally provide "
-             "an error value to print the stack trace with. If `err` is nil or not "
-             "provided, will skipp the error line. Returns the fiber.")
-    },
-    {
-        "debug/lineage", cfun_debug_lineage,
-        JDOC("(debug/lineage fib)\n\n"
-             "Returns an array of all child fibers from a root fiber. This function "
-             "is useful when a fiber signals or errors to an ancestor fiber. Using this function, "
-             "the fiber handling the error can see which fiber raised the signal. This function should "
-             "be used mostly for debugging purposes.")
-    },
-    {
-        "debug/step", cfun_debug_step,
-        JDOC("(debug/step fiber &opt x)\n\n"
-             "Run a fiber for one virtual instruction of the Janet machine. Can optionally "
-             "pass in a value that will be passed as the resuming value. Returns the signal value, "
-             "which will usually be nil, as breakpoints raise nil signals.")
-    },
-    {NULL, NULL, NULL}
-};
-
 /* Module entry point */
 void janet_lib_debug(JanetTable *env) {
-    janet_core_cfuns(env, NULL, debug_cfuns);
+    JanetRegExt debug_cfuns[] = {
+        JANET_CORE_REG("debug/break", cfun_debug_break),
+        JANET_CORE_REG("debug/unbreak", cfun_debug_unbreak),
+        JANET_CORE_REG("debug/fbreak", cfun_debug_fbreak),
+        JANET_CORE_REG("debug/unfbreak", cfun_debug_unfbreak),
+        JANET_CORE_REG("debug/arg-stack", cfun_debug_argstack),
+        JANET_CORE_REG("debug/stack", cfun_debug_stack),
+        JANET_CORE_REG("debug/stacktrace", cfun_debug_stacktrace),
+        JANET_CORE_REG("debug/lineage", cfun_debug_lineage),
+        JANET_CORE_REG("debug/step", cfun_debug_step),
+        JANET_REG_END
+    };
+    janet_core_cfuns_ext(env, NULL, debug_cfuns);
 }

src/core/emit.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

src/core/emit.h

@@ -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

src/core/features.h

@@ -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
@@ -36,13 +36,22 @@
 # endif
 #endif
 
+/* Needed for sched.h for cpu count */
+#ifdef __linux__
+#define _GNU_SOURCE
+#endif
+
 #if defined(WIN32) || defined(_WIN32)
 #define WIN32_LEAN_AND_MEAN
 #endif
 
-/* Needed for realpath on linux */
-#if !defined(_XOPEN_SOURCE) && (defined(__linux__) || defined(__EMSCRIPTEN__))
-#define _XOPEN_SOURCE 500
+/* Needed for realpath on linux, as well as pthread rwlocks. */
+#ifndef _XOPEN_SOURCE
+#define _XOPEN_SOURCE 600
+#endif
+#if _XOPEN_SOURCE < 600
+#undef _XOPEN_SOURCE
+#define _XOPEN_SOURCE 600
 #endif
 
 /* Needed for timegm and other extensions when building with -std=c99.

src/core/fiber.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
@@ -57,7 +57,7 @@ static JanetFiber *fiber_alloc(int32_t capacity) {
     if (NULL == data) {
         JANET_OUT_OF_MEMORY;
     }
-    janet_vm_next_collection += sizeof(Janet) * capacity;
+    janet_vm.next_collection += sizeof(Janet) * capacity;
     fiber->data = data;
     return fiber;
 }
@@ -121,7 +121,7 @@ void janet_fiber_setcapacity(JanetFiber *fiber, int32_t n) {
     }
     fiber->data = newData;
     fiber->capacity = n;
-    janet_vm_next_collection += sizeof(Janet) * diff;
+    janet_vm.next_collection += sizeof(Janet) * diff;
 }
 
 /* Grow fiber if needed */
@@ -255,7 +255,7 @@ static void janet_env_detach(JanetFuncEnv *env) {
         int32_t len = env->length;
         size_t s = sizeof(Janet) * (size_t) len;
         Janet *vmem = janet_malloc(s);
-        janet_vm_next_collection += (uint32_t) s;
+        janet_vm.next_collection += (uint32_t) s;
         if (NULL == vmem) {
             JANET_OUT_OF_MEMORY;
         }
@@ -442,16 +442,19 @@ JanetFiberStatus janet_fiber_status(JanetFiber *f) {
 }
 
 JanetFiber *janet_current_fiber(void) {
-    return janet_vm_fiber;
+    return janet_vm.fiber;
 }
 
 JanetFiber *janet_root_fiber(void) {
-    return janet_vm_root_fiber;
+    return janet_vm.root_fiber;
 }
 
 /* CFuns */
 
-static Janet cfun_fiber_getenv(int32_t argc, Janet *argv) {
+JANET_CORE_FN(cfun_fiber_getenv,
+              "(fiber/getenv fiber)",
+              "Gets the environment for a fiber. Returns nil if no such table is "
+              "set yet.") {
     janet_fixarity(argc, 1);
     JanetFiber *fiber = janet_getfiber(argv, 0);
     return fiber->env ?
@@ -459,7 +462,10 @@ static Janet cfun_fiber_getenv(int32_t argc, Janet *argv) {
            janet_wrap_nil();
 }
 
-static Janet cfun_fiber_setenv(int32_t argc, Janet *argv) {
+JANET_CORE_FN(cfun_fiber_setenv,
+              "(fiber/setenv fiber table)",
+              "Sets the environment table for a fiber. Set to nil to remove the current "
+              "environment.") {
     janet_fixarity(argc, 2);
     JanetFiber *fiber = janet_getfiber(argv, 0);
     if (janet_checktype(argv[1], JANET_NIL)) {
@@ -470,7 +476,30 @@ static Janet cfun_fiber_setenv(int32_t argc, Janet *argv) {
     return argv[0];
 }
 
-static Janet cfun_fiber_new(int32_t argc, Janet *argv) {
+JANET_CORE_FN(cfun_fiber_new,
+              "(fiber/new func &opt sigmask)",
+              "Create a new fiber with function body func. Can optionally "
+              "take a set of signals to block from the current parent fiber "
+              "when called. The mask is specified as a keyword where each character "
+              "is used to indicate a signal to block. If the ev module is enabled, and "
+              "this fiber is used as an argument to `ev/go`, these \"blocked\" signals "
+              "will result in messages being sent to the supervisor channel. "
+              "The default sigmask is :y. "
+              "For example,\n\n"
+              "    (fiber/new myfun :e123)\n\n"
+              "blocks error signals and user signals 1, 2 and 3. The signals are "
+              "as follows:\n\n"
+              "* :a - block all signals\n"
+              "* :d - block debug signals\n"
+              "* :e - block error signals\n"
+              "* :t - block termination signals: error + user[0-4]\n"
+              "* :u - block user signals\n"
+              "* :y - block yield signals\n"
+              "* :0-9 - block a specific user signal\n\n"
+              "The sigmask argument also can take environment flags. If any mutually "
+              "exclusive flags are present, the last flag takes precedence.\n\n"
+              "* :i - inherit the environment from the current fiber\n"
+              "* :p - the environment table's prototype is the current environment table") {
     janet_arity(argc, 1, 2);
     JanetFunction *func = janet_getfunction(argv, 0);
     JanetFiber *fiber;
@@ -520,17 +549,17 @@ static Janet cfun_fiber_new(int32_t argc, Janet *argv) {
                         fiber->flags |= JANET_FIBER_MASK_YIELD;
                         break;
                     case 'i':
-                        if (!janet_vm_fiber->env) {
-                            janet_vm_fiber->env = janet_table(0);
+                        if (!janet_vm.fiber->env) {
+                            janet_vm.fiber->env = janet_table(0);
                         }
-                        fiber->env = janet_vm_fiber->env;
+                        fiber->env = janet_vm.fiber->env;
                         break;
                     case 'p':
-                        if (!janet_vm_fiber->env) {
-                            janet_vm_fiber->env = janet_table(0);
+                        if (!janet_vm.fiber->env) {
+                            janet_vm.fiber->env = janet_table(0);
                         }
                         fiber->env = janet_table(0);
-                        fiber->env->proto = janet_vm_fiber->env;
+                        fiber->env->proto = janet_vm.fiber->env;
                         break;
                 }
             }
@@ -539,32 +568,53 @@ static Janet cfun_fiber_new(int32_t argc, Janet *argv) {
     return janet_wrap_fiber(fiber);
 }
 
-static Janet cfun_fiber_status(int32_t argc, Janet *argv) {
+JANET_CORE_FN(cfun_fiber_status,
+              "(fiber/status fib)",
+              "Get the status of a fiber. The status will be one of:\n\n"
+              "* :dead - the fiber has finished\n"
+              "* :error - the fiber has errored out\n"
+              "* :debug - the fiber is suspended in debug mode\n"
+              "* :pending - the fiber has been yielded\n"
+              "* :user(0-9) - the fiber is suspended by a user signal\n"
+              "* :alive - the fiber is currently running and cannot be resumed\n"
+              "* :new - the fiber has just been created and not yet run") {
     janet_fixarity(argc, 1);
     JanetFiber *fiber = janet_getfiber(argv, 0);
     uint32_t s = janet_fiber_status(fiber);
     return janet_ckeywordv(janet_status_names[s]);
 }
 
-static Janet cfun_fiber_current(int32_t argc, Janet *argv) {
+JANET_CORE_FN(cfun_fiber_current,
+              "(fiber/current)",
+              "Returns the currently running fiber.") {
     (void) argv;
     janet_fixarity(argc, 0);
-    return janet_wrap_fiber(janet_vm_fiber);
+    return janet_wrap_fiber(janet_vm.fiber);
 }
 
-static Janet cfun_fiber_root(int32_t argc, Janet *argv) {
+JANET_CORE_FN(cfun_fiber_root,
+              "(fiber/root)",
+              "Returns the current root fiber. The root fiber is the oldest ancestor "
+              "that does not have a parent.") {
     (void) argv;
     janet_fixarity(argc, 0);
-    return janet_wrap_fiber(janet_vm_root_fiber);
+    return janet_wrap_fiber(janet_vm.root_fiber);
 }
 
-static Janet cfun_fiber_maxstack(int32_t argc, Janet *argv) {
+JANET_CORE_FN(cfun_fiber_maxstack,
+              "(fiber/maxstack fib)",
+              "Gets the maximum stack size in janet values allowed for a fiber. While memory for "
+              "the fiber's stack is not allocated up front, the fiber will not allocated more "
+              "than this amount and will throw a stack-overflow error if more memory is needed. ") {
     janet_fixarity(argc, 1);
     JanetFiber *fiber = janet_getfiber(argv, 0);
     return janet_wrap_integer(fiber->maxstack);
 }
 
-static Janet cfun_fiber_setmaxstack(int32_t argc, Janet *argv) {
+JANET_CORE_FN(cfun_fiber_setmaxstack,
+              "(fiber/setmaxstack fib maxstack)",
+              "Sets the maximum stack size in janet values for a fiber. By default, the "
+              "maximum stack size is usually 8192.") {
     janet_fixarity(argc, 2);
     JanetFiber *fiber = janet_getfiber(argv, 0);
     int32_t maxs = janet_getinteger(argv, 1);
@@ -575,7 +625,9 @@ static Janet cfun_fiber_setmaxstack(int32_t argc, Janet *argv) {
     return argv[0];
 }
 
-static Janet cfun_fiber_can_resume(int32_t argc, Janet *argv) {
+JANET_CORE_FN(cfun_fiber_can_resume,
+              "(fiber/can-resume? fiber)",
+              "Check if a fiber is finished and cannot be resumed.") {
     janet_fixarity(argc, 1);
     JanetFiber *fiber = janet_getfiber(argv, 0);
     JanetFiberStatus s = janet_fiber_status(fiber);
@@ -589,101 +641,28 @@ static Janet cfun_fiber_can_resume(int32_t argc, Janet *argv) {
     return janet_wrap_boolean(!isFinished);
 }
 
-static Janet cfun_fiber_last_value(int32_t argc, Janet *argv) {
+JANET_CORE_FN(cfun_fiber_last_value,
+              "(fiber/last-value)",
+              "Get the last value returned or signaled from the fiber.") {
     janet_fixarity(argc, 1);
     JanetFiber *fiber = janet_getfiber(argv, 0);
     return fiber->last_value;
 }
 
-static const JanetReg fiber_cfuns[] = {
-    {
-        "fiber/new", cfun_fiber_new,
-        JDOC("(fiber/new func &opt sigmask)\n\n"
-             "Create a new fiber with function body func. Can optionally "
-             "take a set of signals to block from the current parent fiber "
-             "when called. The mask is specified as a keyword where each character "
-             "is used to indicate a signal to block. If the ev module is enabled, and "
-             "this fiber is used as an argument to `ev/go`, these \"blocked\" signals "
-             "will result in messages being sent to the supervisor channel. "
-             "The default sigmask is :y. "
-             "For example,\n\n"
-             "    (fiber/new myfun :e123)\n\n"
-             "blocks error signals and user signals 1, 2 and 3. The signals are "
-             "as follows:\n\n"
-             "* :a - block all signals\n"
-             "* :d - block debug signals\n"
-             "* :e - block error signals\n"
-             "* :t - block termination signals: error + user[0-4]\n"
-             "* :u - block user signals\n"
-             "* :y - block yield signals\n"
-             "* :0-9 - block a specific user signal\n\n"
-             "The sigmask argument also can take environment flags. If any mutually "
-             "exclusive flags are present, the last flag takes precedence.\n\n"
-             "* :i - inherit the environment from the current fiber\n"
-             "* :p - the environment table's prototype is the current environment table")
-    },
-    {
-        "fiber/status", cfun_fiber_status,
-        JDOC("(fiber/status fib)\n\n"
-             "Get the status of a fiber. The status will be one of:\n\n"
-             "* :dead - the fiber has finished\n"
-             "* :error - the fiber has errored out\n"
-             "* :debug - the fiber is suspended in debug mode\n"
-             "* :pending - the fiber has been yielded\n"
-             "* :user(0-9) - the fiber is suspended by a user signal\n"
-             "* :alive - the fiber is currently running and cannot be resumed\n"
-             "* :new - the fiber has just been created and not yet run")
-    },
-    {
-        "fiber/root", cfun_fiber_root,
-        JDOC("(fiber/root)\n\n"
-             "Returns the current root fiber. The root fiber is the oldest ancestor "
-             "that does not have a parent.")
-    },
-    {
-        "fiber/current", cfun_fiber_current,
-        JDOC("(fiber/current)\n\n"
-             "Returns the currently running fiber.")
-    },
-    {
-        "fiber/maxstack", cfun_fiber_maxstack,
-        JDOC("(fiber/maxstack fib)\n\n"
-             "Gets the maximum stack size in janet values allowed for a fiber. While memory for "
-             "the fiber's stack is not allocated up front, the fiber will not allocated more "
-             "than this amount and will throw a stack-overflow error if more memory is needed. ")
-    },
-    {
-        "fiber/setmaxstack", cfun_fiber_setmaxstack,
-        JDOC("(fiber/setmaxstack fib maxstack)\n\n"
-             "Sets the maximum stack size in janet values for a fiber. By default, the "
-             "maximum stack size is usually 8192.")
-    },
-    {
-        "fiber/getenv", cfun_fiber_getenv,
-        JDOC("(fiber/getenv fiber)\n\n"
-             "Gets the environment for a fiber. Returns nil if no such table is "
-             "set yet.")
-    },
-    {
-        "fiber/setenv", cfun_fiber_setenv,
-        JDOC("(fiber/setenv fiber table)\n\n"
-             "Sets the environment table for a fiber. Set to nil to remove the current "
-             "environment.")
-    },
-    {
-        "fiber/can-resume?", cfun_fiber_can_resume,
-        JDOC("(fiber/can-resume? fiber)\n\n"
-             "Check if a fiber is finished and cannot be resumed.")
-    },
-    {
-        "fiber/last-value", cfun_fiber_last_value,
-        JDOC("(fiber/last-value\n\n"
-             "Get the last value returned or signaled from the fiber.")
-    },
-    {NULL, NULL, NULL}
-};
-
 /* Module entry point */
 void janet_lib_fiber(JanetTable *env) {
-    janet_core_cfuns(env, NULL, fiber_cfuns);
+    JanetRegExt fiber_cfuns[] = {
+        JANET_CORE_REG("fiber/new", cfun_fiber_new),
+        JANET_CORE_REG("fiber/status", cfun_fiber_status),
+        JANET_CORE_REG("fiber/root", cfun_fiber_root),
+        JANET_CORE_REG("fiber/current", cfun_fiber_current),
+        JANET_CORE_REG("fiber/maxstack", cfun_fiber_maxstack),
+        JANET_CORE_REG("fiber/setmaxstack", cfun_fiber_setmaxstack),
+        JANET_CORE_REG("fiber/getenv", cfun_fiber_getenv),
+        JANET_CORE_REG("fiber/setenv", cfun_fiber_setenv),
+        JANET_CORE_REG("fiber/can-resume?", cfun_fiber_can_resume),
+        JANET_CORE_REG("fiber/last-value", cfun_fiber_last_value),
+        JANET_REG_END
+    };
+    janet_core_cfuns_ext(env, NULL, fiber_cfuns);
 }

src/core/fiber.h

@@ -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
@@ -47,7 +47,6 @@
 #define JANET_FIBER_MASK_USER 0x3FF0
 
 #define JANET_FIBER_STATUS_MASK 0x3F0000
-#define JANET_FIBER_FLAG_SCHEDULED 0x800000
 #define JANET_FIBER_RESUME_SIGNAL 0x400000
 #define JANET_FIBER_STATUS_OFFSET 16
 
@@ -57,7 +56,9 @@
 #define JANET_FIBER_DID_LONGJUMP     0x8000000
 #define JANET_FIBER_FLAG_MASK        0xF000000
 
-extern JANET_THREAD_LOCAL JanetFiber *janet_vm_fiber;
+#define JANET_FIBER_EV_FLAG_CANCELED 0x10000
+#define JANET_FIBER_EV_FLAG_SUSPENDED 0x20000
+#define JANET_FIBER_FLAG_ROOT 0x40000
 
 #define janet_fiber_set_status(f, s) do {\
     (f)->flags &= ~JANET_FIBER_STATUS_MASK;\

src/core/gc.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
@@ -31,28 +31,6 @@
 #include "vector.h"
 #endif
 
-struct JanetScratch {
-    JanetScratchFinalizer finalize;
-    long long mem[]; /* for proper alignment */
-};
-
-/* GC State */
-JANET_THREAD_LOCAL void *janet_vm_blocks;
-JANET_THREAD_LOCAL size_t janet_vm_gc_interval;
-JANET_THREAD_LOCAL size_t janet_vm_next_collection;
-JANET_THREAD_LOCAL size_t janet_vm_block_count;
-JANET_THREAD_LOCAL int janet_vm_gc_suspend = 0;
-
-/* Roots */
-JANET_THREAD_LOCAL Janet *janet_vm_roots;
-JANET_THREAD_LOCAL size_t janet_vm_root_count;
-JANET_THREAD_LOCAL size_t janet_vm_root_capacity;
-
-/* Scratch Memory */
-JANET_THREAD_LOCAL JanetScratch **janet_scratch_mem;
-JANET_THREAD_LOCAL size_t janet_scratch_cap;
-JANET_THREAD_LOCAL size_t janet_scratch_len;
-
 /* Helpers for marking the various gc types */
 static void janet_mark_funcenv(JanetFuncEnv *env);
 static void janet_mark_funcdef(JanetFuncDef *def);
@@ -72,7 +50,7 @@ static JANET_THREAD_LOCAL size_t orig_rootcount;
 
 /* Hint to the GC that we may need to collect */
 void janet_gcpressure(size_t s) {
-    janet_vm_next_collection += s;
+    janet_vm.next_collection += s;
 }
 
 /* Mark a value */
@@ -127,6 +105,14 @@ static void janet_mark_buffer(JanetBuffer *buffer) {
 }
 
 static void janet_mark_abstract(void *adata) {
+#ifdef JANET_EV
+    /* Check if abstract type is a threaded abstract type. If it is, marking means
+     * updating the threaded_abstract table. */
+    if ((janet_abstract_head(adata)->gc.flags & JANET_MEM_TYPEBITS) == JANET_MEMORY_THREADED_ABSTRACT) {
+        janet_table_put(&janet_vm.threaded_abstracts, janet_wrap_abstract(adata), janet_wrap_true());
+        return;
+    }
+#endif
     if (janet_gc_reachable(janet_abstract_head(adata)))
         return;
     janet_gc_mark(janet_abstract_head(adata));
@@ -137,6 +123,8 @@ static void janet_mark_abstract(void *adata) {
 
 /* Mark a bunch of items in memory */
 static void janet_mark_many(const Janet *values, int32_t n) {
+    if (values == NULL)
+        return;
     const Janet *end = values + n;
     while (values < end) {
         janet_mark(*values);
@@ -174,10 +162,13 @@ recur: /* Manual tail recursion */
 }
 
 static void janet_mark_struct(const JanetKV *st) {
+recur:
     if (janet_gc_reachable(janet_struct_head(st)))
         return;
     janet_gc_mark(janet_struct_head(st));
     janet_mark_kvs(st, janet_struct_capacity(st));
+    st = janet_struct_proto(st);
+    if (st) goto recur;
 }
 
 static void janet_mark_tuple(const Janet *tuple) {
@@ -218,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) {
@@ -323,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;
     }
@@ -332,25 +330,61 @@ static void janet_deinit_block(JanetGCObject *mem) {
  * marked as reachable. Flip the gc color flag for next sweep. */
 void janet_sweep() {
     JanetGCObject *previous = NULL;
-    JanetGCObject *current = janet_vm_blocks;
+    JanetGCObject *current = janet_vm.blocks;
     JanetGCObject *next;
     while (NULL != current) {
-        next = current->next;
+        next = current->data.next;
         if (current->flags & (JANET_MEM_REACHABLE | JANET_MEM_DISABLED)) {
             previous = current;
             current->flags &= ~JANET_MEM_REACHABLE;
         } else {
-            janet_vm_block_count--;
+            janet_vm.block_count--;
             janet_deinit_block(current);
             if (NULL != previous) {
-                previous->next = next;
+                previous->data.next = next;
             } else {
-                janet_vm_blocks = next;
+                janet_vm.blocks = next;
             }
             janet_free(current);
         }
         current = next;
     }
+#ifdef JANET_EV
+    /* Sweep threaded abstract types for references to decrement */
+    JanetKV *items = janet_vm.threaded_abstracts.data;
+    for (int32_t i = 0; i < janet_vm.threaded_abstracts.capacity; i++) {
+        if (janet_checktype(items[i].key, JANET_ABSTRACT)) {
+
+            /* If item was not visited during the mark phase, then this
+             * abstract type isn't present in the heap and needs its refcount
+             * decremented, and shouuld be removed from table. If the refcount is
+             * then 0, the item will be collected. This ensures that only one interpreter
+             * will clean up the threaded abstract. */
+
+            /* If not visited... */
+            if (!janet_truthy(items[i].value)) {
+                void *abst = janet_unwrap_abstract(items[i].key);
+                if (0 == janet_abstract_decref(abst)) {
+                    /* Run finalizer */
+                    JanetAbstractHead *head = janet_abstract_head(abst);
+                    if (head->type->gc) {
+                        janet_assert(!head->type->gc(head->data, head->size), "finalizer failed");
+                    }
+                    /* Mark as tombstone in place */
+                    items[i].key = janet_wrap_nil();
+                    items[i].value = janet_wrap_false();
+                    janet_vm.threaded_abstracts.deleted++;
+                    janet_vm.threaded_abstracts.count--;
+                    /* Free memory */
+                    janet_free(janet_abstract_head(abst));
+                }
+            }
+
+            /* Reset for next sweep */
+            items[i].value = janet_wrap_false();
+        }
+    }
+#endif
 }
 
 /* Allocate some memory that is tracked for garbage collection */
@@ -358,7 +392,7 @@ void *janet_gcalloc(enum JanetMemoryType type, size_t size) {
     JanetGCObject *mem;
 
     /* Make sure everything is inited */
-    janet_assert(NULL != janet_vm_cache, "please initialize janet before use");
+    janet_assert(NULL != janet_vm.cache, "please initialize janet before use");
     mem = janet_malloc(size);
 
     /* Check for bad malloc */
@@ -370,10 +404,10 @@ void *janet_gcalloc(enum JanetMemoryType type, size_t size) {
     mem->flags = type;
 
     /* Prepend block to heap list */
-    janet_vm_next_collection += size;
-    mem->next = janet_vm_blocks;
-    janet_vm_blocks = mem;
-    janet_vm_block_count++;
+    janet_vm.next_collection += size;
+    mem->data.next = janet_vm.blocks;
+    janet_vm.blocks = mem;
+    janet_vm.block_count++;
 
     return (void *)mem;
 }
@@ -387,10 +421,10 @@ static void free_one_scratch(JanetScratch *s) {
 
 /* Free all allocated scratch memory */
 static void janet_free_all_scratch(void) {
-    for (size_t i = 0; i < janet_scratch_len; i++) {
-        free_one_scratch(janet_scratch_mem[i]);
+    for (size_t i = 0; i < janet_vm.scratch_len; i++) {
+        free_one_scratch(janet_vm.scratch_mem[i]);
     }
-    janet_scratch_len = 0;
+    janet_vm.scratch_len = 0;
 }
 
 static JanetScratch *janet_mem2scratch(void *mem) {
@@ -401,29 +435,29 @@ static JanetScratch *janet_mem2scratch(void *mem) {
 /* Run garbage collection */
 void janet_collect(void) {
     uint32_t i;
-    if (janet_vm_gc_suspend) return;
+    if (janet_vm.gc_suspend) return;
     depth = JANET_RECURSION_GUARD;
     /* Try and prevent many major collections back to back.
-     * A full collection will take O(janet_vm_block_count) time.
+     * A full collection will take O(janet_vm.block_count) time.
      * If we have a large heap, make sure our interval is not too
      * small so we won't make many collections over it. This is just a
      * heuristic for automatically changing the gc interval */
-    if (janet_vm_block_count * 8 > janet_vm_gc_interval) {
-        janet_vm_gc_interval = janet_vm_block_count * sizeof(JanetGCObject);
+    if (janet_vm.block_count * 8 > janet_vm.gc_interval) {
+        janet_vm.gc_interval = janet_vm.block_count * sizeof(JanetGCObject);
     }
-    orig_rootcount = janet_vm_root_count;
+    orig_rootcount = janet_vm.root_count;
 #ifdef JANET_EV
     janet_ev_mark();
 #endif
-    janet_mark_fiber(janet_vm_root_fiber);
+    janet_mark_fiber(janet_vm.root_fiber);
     for (i = 0; i < orig_rootcount; i++)
-        janet_mark(janet_vm_roots[i]);
-    while (orig_rootcount < janet_vm_root_count) {
-        Janet x = janet_vm_roots[--janet_vm_root_count];
+        janet_mark(janet_vm.roots[i]);
+    while (orig_rootcount < janet_vm.root_count) {
+        Janet x = janet_vm.roots[--janet_vm.root_count];
         janet_mark(x);
     }
     janet_sweep();
-    janet_vm_next_collection = 0;
+    janet_vm.next_collection = 0;
     janet_free_all_scratch();
 }
 
@@ -431,17 +465,17 @@ void janet_collect(void) {
  * and all of its children. If gcroot is called on a value n times, unroot
  * must also be called n times to remove it as a gc root. */
 void janet_gcroot(Janet root) {
-    size_t newcount = janet_vm_root_count + 1;
-    if (newcount > janet_vm_root_capacity) {
+    size_t newcount = janet_vm.root_count + 1;
+    if (newcount > janet_vm.root_capacity) {
         size_t newcap = 2 * newcount;
-        janet_vm_roots = janet_realloc(janet_vm_roots, sizeof(Janet) * newcap);
-        if (NULL == janet_vm_roots) {
+        janet_vm.roots = janet_realloc(janet_vm.roots, sizeof(Janet) * newcap);
+        if (NULL == janet_vm.roots) {
             JANET_OUT_OF_MEMORY;
         }
-        janet_vm_root_capacity = newcap;
+        janet_vm.root_capacity = newcap;
     }
-    janet_vm_roots[janet_vm_root_count] = root;
-    janet_vm_root_count = newcount;
+    janet_vm.roots[janet_vm.root_count] = root;
+    janet_vm.root_count = newcount;
 }
 
 /* Identity equality for GC purposes */
@@ -462,11 +496,11 @@ static int janet_gc_idequals(Janet lhs, Janet rhs) {
 /* Remove a root value from the GC. This allows the gc to potentially reclaim
  * a value and all its children. */
 int janet_gcunroot(Janet root) {
-    Janet *vtop = janet_vm_roots + janet_vm_root_count;
+    Janet *vtop = janet_vm.roots + janet_vm.root_count;
     /* Search from top to bottom as access is most likely LIFO */
-    for (Janet *v = janet_vm_roots; v < vtop; v++) {
+    for (Janet *v = janet_vm.roots; v < vtop; v++) {
         if (janet_gc_idequals(root, *v)) {
-            *v = janet_vm_roots[--janet_vm_root_count];
+            *v = janet_vm.roots[--janet_vm.root_count];
             return 1;
         }
     }
@@ -475,12 +509,12 @@ int janet_gcunroot(Janet root) {
 
 /* Remove a root value from the GC. This sets the effective reference count to 0. */
 int janet_gcunrootall(Janet root) {
-    Janet *vtop = janet_vm_roots + janet_vm_root_count;
+    Janet *vtop = janet_vm.roots + janet_vm.root_count;
     int ret = 0;
     /* Search from top to bottom as access is most likely LIFO */
-    for (Janet *v = janet_vm_roots; v < vtop; v++) {
+    for (Janet *v = janet_vm.roots; v < vtop; v++) {
         if (janet_gc_idequals(root, *v)) {
-            *v = janet_vm_roots[--janet_vm_root_count];
+            *v = janet_vm.roots[--janet_vm.root_count];
             vtop--;
             ret = 1;
         }
@@ -490,24 +524,39 @@ int janet_gcunrootall(Janet root) {
 
 /* Free all allocated memory */
 void janet_clear_memory(void) {
-    JanetGCObject *current = janet_vm_blocks;
+#ifdef JANET_EV
+    JanetKV *items = janet_vm.threaded_abstracts.data;
+    for (int32_t i = 0; i < janet_vm.threaded_abstracts.capacity; i++) {
+        if (janet_checktype(items[i].key, JANET_ABSTRACT)) {
+            void *abst = janet_unwrap_abstract(items[i].key);
+            if (0 == janet_abstract_decref(abst)) {
+                JanetAbstractHead *head = janet_abstract_head(abst);
+                if (head->type->gc) {
+                    janet_assert(!head->type->gc(head->data, head->size), "finalizer failed");
+                }
+                janet_free(janet_abstract_head(abst));
+            }
+        }
+    }
+#endif
+    JanetGCObject *current = janet_vm.blocks;
     while (NULL != current) {
         janet_deinit_block(current);
-        JanetGCObject *next = current->next;
+        JanetGCObject *next = current->data.next;
         janet_free(current);
         current = next;
     }
-    janet_vm_blocks = NULL;
+    janet_vm.blocks = NULL;
     janet_free_all_scratch();
-    janet_free(janet_scratch_mem);
+    janet_free(janet_vm.scratch_mem);
 }
 
 /* Primitives for suspending GC. */
 int janet_gclock(void) {
-    return janet_vm_gc_suspend++;
+    return janet_vm.gc_suspend++;
 }
 void janet_gcunlock(int handle) {
-    janet_vm_gc_suspend = handle;
+    janet_vm.gc_suspend = handle;
 }
 
 /* Scratch memory API */
@@ -518,16 +567,16 @@ void *janet_smalloc(size_t size) {
         JANET_OUT_OF_MEMORY;
     }
     s->finalize = NULL;
-    if (janet_scratch_len == janet_scratch_cap) {
-        size_t newcap = 2 * janet_scratch_cap + 2;
-        JanetScratch **newmem = (JanetScratch **) janet_realloc(janet_scratch_mem, newcap * sizeof(JanetScratch));
+    if (janet_vm.scratch_len == janet_vm.scratch_cap) {
+        size_t newcap = 2 * janet_vm.scratch_cap + 2;
+        JanetScratch **newmem = (JanetScratch **) janet_realloc(janet_vm.scratch_mem, newcap * sizeof(JanetScratch));
         if (NULL == newmem) {
             JANET_OUT_OF_MEMORY;
         }
-        janet_scratch_cap = newcap;
-        janet_scratch_mem = newmem;
+        janet_vm.scratch_cap = newcap;
+        janet_vm.scratch_mem = newmem;
     }
-    janet_scratch_mem[janet_scratch_len++] = s;
+    janet_vm.scratch_mem[janet_vm.scratch_len++] = s;
     return (char *)(s->mem);
 }
 
@@ -544,14 +593,14 @@ void *janet_scalloc(size_t nmemb, size_t size) {
 void *janet_srealloc(void *mem, size_t size) {
     if (NULL == mem) return janet_smalloc(size);
     JanetScratch *s = janet_mem2scratch(mem);
-    if (janet_scratch_len) {
-        for (size_t i = janet_scratch_len - 1; ; i--) {
-            if (janet_scratch_mem[i] == s) {
+    if (janet_vm.scratch_len) {
+        for (size_t i = janet_vm.scratch_len - 1; ; i--) {
+            if (janet_vm.scratch_mem[i] == s) {
                 JanetScratch *news = janet_realloc(s, size + sizeof(JanetScratch));
                 if (NULL == news) {
                     JANET_OUT_OF_MEMORY;
                 }
-                janet_scratch_mem[i] = news;
+                janet_vm.scratch_mem[i] = news;
                 return (char *)(news->mem);
             }
             if (i == 0) break;
@@ -568,10 +617,10 @@ void janet_sfinalizer(void *mem, JanetScratchFinalizer finalizer) {
 void janet_sfree(void *mem) {
     if (NULL == mem) return;
     JanetScratch *s = janet_mem2scratch(mem);
-    if (janet_scratch_len) {
-        for (size_t i = janet_scratch_len - 1; ; i--) {
-            if (janet_scratch_mem[i] == s) {
-                janet_scratch_mem[i] = janet_scratch_mem[--janet_scratch_len];
+    if (janet_vm.scratch_len) {
+        for (size_t i = janet_vm.scratch_len - 1; ; i--) {
+            if (janet_vm.scratch_mem[i] == s) {
+                janet_vm.scratch_mem[i] = janet_vm.scratch_mem[--janet_vm.scratch_len];
                 free_one_scratch(s);
                 return;
             }

src/core/gc.h

@@ -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
@@ -55,10 +55,11 @@ enum JanetMemoryType {
     JANET_MEMORY_FUNCTION,
     JANET_MEMORY_ABSTRACT,
     JANET_MEMORY_FUNCENV,
-    JANET_MEMORY_FUNCDEF
+    JANET_MEMORY_FUNCDEF,
+    JANET_MEMORY_THREADED_ABSTRACT,
 };
 
-/* To allocate collectable memory, one must calk janet_alloc, initialize the memory,
+/* To allocate collectable memory, one must call janet_alloc, initialize the memory,
  * and then call when janet_enablegc when it is initailize and reachable by the gc (on the JANET stack) */
 void *janet_gcalloc(enum JanetMemoryType type, size_t size);
 

src/core/inttypes.c

@@ -1,5 +1,5 @@
 /*
-* 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
@@ -193,16 +193,106 @@ Janet janet_wrap_u64(uint64_t x) {
     return janet_wrap_abstract(box);
 }
 
-static Janet cfun_it_s64_new(int32_t argc, Janet *argv) {
+JANET_CORE_FN(cfun_it_s64_new,
+              "(int/s64 value)",
+              "Create a boxed signed 64 bit integer from a string value.") {
     janet_fixarity(argc, 1);
     return janet_wrap_s64(janet_unwrap_s64(argv[0]));
 }
 
-static Janet cfun_it_u64_new(int32_t argc, Janet *argv) {
+JANET_CORE_FN(cfun_it_u64_new,
+              "(int/u64 value)",
+              "Create a boxed unsigned 64 bit integer from a string value.") {
     janet_fixarity(argc, 1);
     return janet_wrap_u64(janet_unwrap_u64(argv[0]));
 }
 
+JANET_CORE_FN(cfun_to_number,
+              "(int/to-number value)",
+              "Convert an int/u64 or int/s64 to a number. Fails if the number is out of range for an int32.") {
+    janet_fixarity(argc, 1);
+    if (janet_type(argv[0]) == JANET_ABSTRACT) {
+        void *abst = janet_unwrap_abstract(argv[0]);
+
+        if (janet_abstract_type(abst) == &janet_s64_type) {
+            int64_t value = *((int64_t *)abst);
+            if (value > JANET_INTMAX_INT64) {
+                janet_panicf("cannot convert %q to a number, must be in the range [%q, %q]", argv[0], janet_wrap_number(JANET_INTMIN_DOUBLE), janet_wrap_number(JANET_INTMAX_DOUBLE));
+            }
+            if (value < -JANET_INTMAX_INT64) {
+                janet_panicf("cannot convert %q to a number, must be in the range [%q, %q]", argv[0], janet_wrap_number(JANET_INTMIN_DOUBLE), janet_wrap_number(JANET_INTMAX_DOUBLE));
+            }
+            return janet_wrap_number((double)value);
+        }
+
+        if (janet_abstract_type(abst) == &janet_u64_type) {
+            uint64_t value = *((uint64_t *)abst);
+            if (value > JANET_INTMAX_INT64) {
+                janet_panicf("cannot convert %q to a number, must be in the range [%q, %q]", argv[0], janet_wrap_number(JANET_INTMIN_DOUBLE), janet_wrap_number(JANET_INTMAX_DOUBLE));
+            }
+
+            return janet_wrap_number((double)value);
+        }
+    }
+
+    janet_panicf("expected int/u64 or int/s64, got %q", argv[0]);
+}
+
+JANET_CORE_FN(cfun_to_bytes,
+              "(int/to-bytes value &opt endianness buffer)",
+              "Write the bytes of an `int/s64` or `int/u64` into a buffer.\n"
+              "The `buffer` parameter specifies an existing buffer to write to, if unset a new buffer will be created.\n"
+              "Returns the modified buffer.\n"
+              "The `endianness` paramater indicates the byte order:\n"
+              "- `nil` (unset): system byte order\n"
+              "- `:le`: little-endian, least significant byte first\n"
+              "- `:be`: big-endian, most significant byte first\n") {
+    janet_arity(argc, 1, 3);
+    if (janet_is_int(argv[0]) == JANET_INT_NONE) {
+        janet_panicf("int/to-bytes: expected an int/s64 or int/u64, got %q", argv[0]);
+    }
+
+    int reverse = 0;
+    if (argc > 1 && !janet_checktype(argv[1], JANET_NIL)) {
+        JanetKeyword endianness_kw = janet_getkeyword(argv, 1);
+        if (!janet_cstrcmp(endianness_kw, "le")) {
+#if JANET_BIG_ENDIAN
+            reverse = 1;
+#endif
+        } else if (!janet_cstrcmp(endianness_kw, "be")) {
+#if JANET_LITTLE_ENDIAN
+            reverse = 1;
+#endif
+        } else {
+            janet_panicf("int/to-bytes: expected endianness :le, :be or nil, got %v", argv[1]);
+        }
+    }
+
+    JanetBuffer *buffer = NULL;
+    if (argc > 2 && !janet_checktype(argv[2], JANET_NIL)) {
+        if (!janet_checktype(argv[2], JANET_BUFFER)) {
+            janet_panicf("int/to-bytes: expected buffer or nil, got %q", argv[2]);
+        }
+
+        buffer = janet_unwrap_buffer(argv[2]);
+        janet_buffer_extra(buffer, 8);
+    } else {
+        buffer = janet_buffer(8);
+    }
+
+    uint8_t *bytes = janet_unwrap_abstract(argv[0]);
+    if (reverse) {
+        for (int i = 0; i < 8; ++i) {
+            buffer->data[buffer->count + 7 - i] = bytes[i];
+        }
+    } else {
+        memcpy(buffer->data + buffer->count, bytes, 8);
+    }
+    buffer->count += 8;
+
+    return janet_wrap_buffer(buffer);
+}
+
 /*
  * Code to support polymorphic comparison.
  * int/u64 and int/s64 support a "compare" method that allows
@@ -317,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); \
 } \
 
@@ -332,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); \
 } \
 
@@ -428,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},
@@ -451,7 +554,6 @@ static JanetMethod it_s64_methods[] = {
     {"<<", cfun_it_s64_lshift},
     {">>", cfun_it_s64_rshift},
     {"compare", cfun_it_s64_compare},
-
     {NULL, NULL}
 };
 
@@ -477,7 +579,6 @@ static JanetMethod it_u64_methods[] = {
     {"<<", cfun_it_u64_lshift},
     {">>", cfun_it_u64_rshift},
     {"compare", cfun_it_u64_compare},
-
     {NULL, NULL}
 };
 
@@ -505,23 +606,16 @@ static int it_u64_get(void *p, Janet key, Janet *out) {
     return janet_getmethod(janet_unwrap_keyword(key), it_u64_methods, out);
 }
 
-static const JanetReg it_cfuns[] = {
-    {
-        "int/s64", cfun_it_s64_new,
-        JDOC("(int/s64 value)\n\n"
-             "Create a boxed signed 64 bit integer from a string value.")
-    },
-    {
-        "int/u64", cfun_it_u64_new,
-        JDOC("(int/u64 value)\n\n"
-             "Create a boxed unsigned 64 bit integer from a string value.")
-    },
-    {NULL, NULL, NULL}
-};
-
 /* Module entry point */
 void janet_lib_inttypes(JanetTable *env) {
-    janet_core_cfuns(env, NULL, it_cfuns);
+    JanetRegExt it_cfuns[] = {
+        JANET_CORE_REG("int/s64", cfun_it_s64_new),
+        JANET_CORE_REG("int/u64", cfun_it_u64_new),
+        JANET_CORE_REG("int/to-number", cfun_to_number),
+        JANET_CORE_REG("int/to-bytes", cfun_to_bytes),
+        JANET_REG_END
+    };
+    janet_core_cfuns_ext(env, NULL, it_cfuns);
     janet_register_abstract_type(&janet_s64_type);
     janet_register_abstract_type(&janet_u64_type);
 }

src/core/io.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
@@ -112,38 +112,10 @@ static void *makef(FILE *f, int32_t flags) {
     return iof;
 }
 
-/* Open a process */
-#ifndef JANET_NO_PROCESSES
-static Janet cfun_io_popen(int32_t argc, Janet *argv) {
-    janet_arity(argc, 1, 2);
-    const uint8_t *fname = janet_getstring(argv, 0);
-    const uint8_t *fmode = NULL;
-    int32_t flags;
-    if (argc == 2) {
-        fmode = janet_getkeyword(argv, 1);
-        flags = JANET_FILE_PIPED | checkflags(fmode);
-        if (flags & (JANET_FILE_UPDATE | JANET_FILE_BINARY | JANET_FILE_APPEND)) {
-            janet_panicf("invalid popen file mode :%S, expected :r or :w", fmode);
-        }
-        fmode = (const uint8_t *)((fmode[0] == 'r') ? "r" : "w");
-    } else {
-        fmode = (const uint8_t *)"r";
-        flags = JANET_FILE_PIPED | JANET_FILE_READ;
-    }
-#ifdef JANET_WINDOWS
-#define popen _popen
-#endif
-    FILE *f = popen((const char *)fname, (const char *)fmode);
-    if (!f) {
-        if (flags & JANET_FILE_NONIL)
-            janet_panicf("failed to popen %s: %s", fname, strerror(errno));
-        return janet_wrap_nil();
-    }
-    return janet_makefile(f, flags);
-}
-#endif
-
-static Janet cfun_io_temp(int32_t argc, Janet *argv) {
+JANET_CORE_FN(cfun_io_temp,
+              "(file/temp)",
+              "Open an anonymous temporary file that is removed on close. "
+              "Raises an error on failure.") {
     (void)argv;
     janet_fixarity(argc, 0);
     // XXX use mkostemp when we can to avoid CLOEXEC race.
@@ -153,7 +125,20 @@ static Janet cfun_io_temp(int32_t argc, Janet *argv) {
     return janet_makefile(tmp, JANET_FILE_WRITE | JANET_FILE_READ | JANET_FILE_BINARY);
 }
 
-static Janet cfun_io_fopen(int32_t argc, Janet *argv) {
+JANET_CORE_FN(cfun_io_fopen,
+              "(file/open path &opt mode)",
+              "Open a file. `path` is an absolute or relative path, and "
+              "`mode` is a set of flags indicating the mode to open the file in. "
+              "`mode` is a keyword where each character represents a flag. If the file "
+              "cannot be opened, returns nil, otherwise returns the new file handle. "
+              "Mode flags:\n\n"
+              "* r - allow reading from the file\n\n"
+              "* w - allow writing to the file\n\n"
+              "* a - append to the file\n\n"
+              "Following one of the initial flags, 0 or more of the following flags can be appended:\n\n"
+              "* b - open the file in binary mode (rather than text mode)\n\n"
+              "* + - append to the file instead of overwriting it\n\n"
+              "* n - error if the file cannot be opened instead of returning nil") {
     janet_arity(argc, 1, 2);
     const uint8_t *fname = janet_getstring(argv, 0);
     const uint8_t *fmode;
@@ -184,7 +169,16 @@ static void read_chunk(JanetFile *iof, JanetBuffer *buffer, int32_t nBytesMax) {
 }
 
 /* Read a certain number of bytes into memory */
-static Janet cfun_io_fread(int32_t argc, Janet *argv) {
+JANET_CORE_FN(cfun_io_fread,
+              "(file/read f what &opt buf)",
+              "Read a number of bytes from a file `f` into a buffer. A buffer `buf` can "
+              "be provided as an optional third argument, otherwise a new buffer "
+              "is created. `what` can either be an integer or a keyword. Returns the "
+              "buffer with file contents. "
+              "Values for `what`:\n\n"
+              "* :all - read the whole file\n\n"
+              "* :line - read up to and including the next newline character\n\n"
+              "* n (integer) - read up to n bytes from the file") {
     janet_arity(argc, 2, 3);
     JanetFile *iof = janet_getabstract(argv, 0, &janet_file_type);
     if (iof->flags & JANET_FILE_CLOSED) janet_panic("file is closed");
@@ -224,7 +218,10 @@ static Janet cfun_io_fread(int32_t argc, Janet *argv) {
 }
 
 /* Write bytes to a file */
-static Janet cfun_io_fwrite(int32_t argc, Janet *argv) {
+JANET_CORE_FN(cfun_io_fwrite,
+              "(file/write f bytes)",
+              "Writes to a file. 'bytes' must be string, buffer, or symbol. Returns the "
+              "file.") {
     janet_arity(argc, 1, -1);
     JanetFile *iof = janet_getabstract(argv, 0, &janet_file_type);
     if (iof->flags & JANET_FILE_CLOSED)
@@ -246,21 +243,27 @@ static Janet cfun_io_fwrite(int32_t argc, Janet *argv) {
     return argv[0];
 }
 
-/* Flush the bytes in the file */
-static Janet cfun_io_fflush(int32_t argc, Janet *argv) {
-    janet_fixarity(argc, 1);
-    JanetFile *iof = janet_getabstract(argv, 0, &janet_file_type);
+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)",
+              "Flush any buffered bytes to the file system. In most files, writes are "
+              "buffered for efficiency reasons. Returns the file handle.") {
+    janet_fixarity(argc, 1);
+    JanetFile *iof = janet_getabstract(argv, 0, &janet_file_type);
+    io_assert_writeable(iof);
     if (fflush(iof->file))
         janet_panic("could not flush file");
     return argv[0];
 }
 
 #ifdef JANET_WINDOWS
-#define pclose _pclose
 #define WEXITSTATUS(x) x
 #endif
 
@@ -268,15 +271,9 @@ static Janet cfun_io_fflush(int32_t argc, Janet *argv) {
 int janet_file_close(JanetFile *file) {
     int ret = 0;
     if (!(file->flags & (JANET_FILE_NOT_CLOSEABLE | JANET_FILE_CLOSED))) {
-#ifndef JANET_NO_PROCESSES
-        if (file->flags & JANET_FILE_PIPED) {
-            ret = pclose(file->file);
-        } else
-#endif
-        {
-            ret = fclose(file->file);
-        }
+        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;
@@ -291,34 +288,35 @@ static int cfun_io_gc(void *p, size_t len) {
 }
 
 /* Close a file */
-static Janet cfun_io_fclose(int32_t argc, Janet *argv) {
+JANET_CORE_FN(cfun_io_fclose,
+              "(file/close f)",
+              "Close a file and release all related resources. When you are "
+              "done reading a file, close it to prevent a resource leak and let "
+              "other processes read the file.") {
     janet_fixarity(argc, 1);
     JanetFile *iof = janet_getabstract(argv, 0, &janet_file_type);
     if (iof->flags & JANET_FILE_CLOSED)
         return janet_wrap_nil();
     if (iof->flags & (JANET_FILE_NOT_CLOSEABLE))
         janet_panic("file not closable");
-    if (iof->flags & JANET_FILE_PIPED) {
-#ifndef JANET_NO_PROCESSES
-        int status = pclose(iof->file);
-        iof->flags |= JANET_FILE_CLOSED;
-        if (status == -1) janet_panic("could not close file");
-        return janet_wrap_integer(WEXITSTATUS(status));
-#else
-        return janet_wrap_nil();
-#endif
-    } else {
-        if (fclose(iof->file)) {
-            iof->flags |= JANET_FILE_NOT_CLOSEABLE;
-            janet_panic("could not close file");
-        }
-        iof->flags |= JANET_FILE_CLOSED;
+    if (fclose(iof->file)) {
+        iof->flags |= JANET_FILE_NOT_CLOSEABLE;
+        janet_panic("could not close file");
     }
+    iof->flags |= JANET_FILE_CLOSED;
     return janet_wrap_nil();
 }
 
 /* Seek a file */
-static Janet cfun_io_fseek(int32_t argc, Janet *argv) {
+JANET_CORE_FN(cfun_io_fseek,
+              "(file/seek f &opt whence n)",
+              "Jump to a relative location in the file `f`. `whence` must be one of:\n\n"
+              "* :cur - jump relative to the current file location\n\n"
+              "* :set - jump relative to the beginning of the file\n\n"
+              "* :end - jump relative to the end of the file\n\n"
+              "By default, `whence` is :cur. Optionally a value `n` may be passed "
+              "for the relative number of bytes to seek in the file. `n` may be a real "
+              "number to handle large files of more than 4GB. Returns the file handle.") {
     janet_arity(argc, 2, 3);
     JanetFile *iof = janet_getabstract(argv, 0, &janet_file_type);
     if (iof->flags & JANET_FILE_CLOSED)
@@ -434,6 +432,19 @@ static Janet cfun_io_print_impl_x(int32_t argc, Janet *argv, int newline,
                 janet_buffer_push_u8(buf, '\n');
             return janet_wrap_nil();
         }
+        case JANET_FUNCTION: {
+            /* Special case function */
+            JanetFunction *fun = janet_unwrap_function(x);
+            JanetBuffer *buf = janet_buffer(0);
+            for (int32_t i = offset; i < argc; ++i) {
+                janet_to_string_b(buf, argv[i]);
+            }
+            if (newline)
+                janet_buffer_push_u8(buf, '\n');
+            Janet args[1] = { janet_wrap_buffer(buf) };
+            janet_call(fun, 1, args);
+            return janet_wrap_nil();
+        }
         case JANET_NIL:
             f = dflt_file;
             if (f == NULL) janet_panic("cannot print to nil");
@@ -443,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;
         }
@@ -480,28 +492,47 @@ static Janet cfun_io_print_impl(int32_t argc, Janet *argv,
     return cfun_io_print_impl_x(argc, argv, newline, dflt_file, 0, x);
 }
 
-static Janet cfun_io_print(int32_t argc, Janet *argv) {
+JANET_CORE_FN(cfun_io_print,
+              "(print & xs)",
+              "Print values to the console (standard out). Value are converted "
+              "to strings if they are not already. After printing all values, a "
+              "newline character is printed. Use the value of `(dyn :out stdout)` to determine "
+              "what to push characters to. Expects `(dyn :out stdout)` to be either a core/file or "
+              "a buffer. Returns nil.") {
     return cfun_io_print_impl(argc, argv, 1, "out", stdout);
 }
 
-static Janet cfun_io_prin(int32_t argc, Janet *argv) {
+JANET_CORE_FN(cfun_io_prin,
+              "(prin & xs)",
+              "Same as `print`, but does not add trailing newline.") {
     return cfun_io_print_impl(argc, argv, 0, "out", stdout);
 }
 
-static Janet cfun_io_eprint(int32_t argc, Janet *argv) {
+JANET_CORE_FN(cfun_io_eprint,
+              "(eprint & xs)",
+              "Same as `print`, but uses `(dyn :err stderr)` instead of `(dyn :out stdout)`.") {
     return cfun_io_print_impl(argc, argv, 1, "err", stderr);
 }
 
-static Janet cfun_io_eprin(int32_t argc, Janet *argv) {
+JANET_CORE_FN(cfun_io_eprin,
+              "(eprin & xs)",
+              "Same as `prin`, but uses `(dyn :err stderr)` instead of `(dyn :out stdout)`.") {
     return cfun_io_print_impl(argc, argv, 0, "err", stderr);
 }
 
-static Janet cfun_io_xprint(int32_t argc, Janet *argv) {
+JANET_CORE_FN(cfun_io_xprint,
+              "(xprint to & xs)",
+              "Print to a file or other value explicitly (no dynamic bindings) with a trailing "
+              "newline character. The value to print "
+              "to is the first argument, and is otherwise the same as `print`. Returns nil.") {
     janet_arity(argc, 1, -1);
     return cfun_io_print_impl_x(argc, argv, 1, NULL, 1, argv[0]);
 }
 
-static Janet cfun_io_xprin(int32_t argc, Janet *argv) {
+JANET_CORE_FN(cfun_io_xprin,
+              "(xprin to & xs)",
+              "Print to a file or other value explicitly (no dynamic bindings). The value to print "
+              "to is the first argument, and is otherwise the same as `prin`. Returns nil.") {
     janet_arity(argc, 1, -1);
     return cfun_io_print_impl_x(argc, argv, 0, NULL, 1, argv[0]);
 }
@@ -520,6 +551,16 @@ static Janet cfun_io_printf_impl_x(int32_t argc, Janet *argv, int newline,
             if (newline) janet_buffer_push_u8(buf, '\n');
             return janet_wrap_nil();
         }
+        case JANET_FUNCTION: {
+            /* Special case function */
+            JanetFunction *fun = janet_unwrap_function(x);
+            JanetBuffer *buf = janet_buffer(0);
+            janet_buffer_format(buf, fmt, offset, argc, argv);
+            if (newline) janet_buffer_push_u8(buf, '\n');
+            Janet args[1] = { janet_wrap_buffer(buf) };
+            janet_call(fun, 1, args);
+            return janet_wrap_nil();
+        }
         case JANET_NIL:
             f = dflt_file;
             if (f == NULL) janet_panic("cannot print to nil");
@@ -529,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;
         }
@@ -557,28 +602,40 @@ static Janet cfun_io_printf_impl(int32_t argc, Janet *argv, int newline,
 
 }
 
-static Janet cfun_io_printf(int32_t argc, Janet *argv) {
+JANET_CORE_FN(cfun_io_printf,
+              "(printf fmt & xs)",
+              "Prints output formatted as if with `(string/format fmt ;xs)` to `(dyn :out stdout)` with a trailing newline.") {
     return cfun_io_printf_impl(argc, argv, 1, "out", stdout);
 }
 
-static Janet cfun_io_prinf(int32_t argc, Janet *argv) {
+JANET_CORE_FN(cfun_io_prinf,
+              "(prinf fmt & xs)",
+              "Like `printf` but with no trailing newline.") {
     return cfun_io_printf_impl(argc, argv, 0, "out", stdout);
 }
 
-static Janet cfun_io_eprintf(int32_t argc, Janet *argv) {
+JANET_CORE_FN(cfun_io_eprintf,
+              "(eprintf fmt & xs)",
+              "Prints output formatted as if with `(string/format fmt ;xs)` to `(dyn :err stderr)` with a trailing newline.") {
     return cfun_io_printf_impl(argc, argv, 1, "err", stderr);
 }
 
-static Janet cfun_io_eprinf(int32_t argc, Janet *argv) {
+JANET_CORE_FN(cfun_io_eprinf,
+              "(eprinf fmt & xs)",
+              "Like `eprintf` but with no trailing newline.") {
     return cfun_io_printf_impl(argc, argv, 0, "err", stderr);
 }
 
-static Janet cfun_io_xprintf(int32_t argc, Janet *argv) {
+JANET_CORE_FN(cfun_io_xprintf,
+              "(xprintf to fmt & xs)",
+              "Like `printf` but prints to an explicit file or value `to`. Returns nil.") {
     janet_arity(argc, 2, -1);
     return cfun_io_printf_impl_x(argc, argv, 1, NULL, 1, argv[0]);
 }
 
-static Janet cfun_io_xprinf(int32_t argc, Janet *argv) {
+JANET_CORE_FN(cfun_io_xprinf,
+              "(xprinf to fmt & xs)",
+              "Like `prinf` but prints to an explicit file or value `to`. Returns nil.") {
     janet_arity(argc, 2, -1);
     return cfun_io_printf_impl_x(argc, argv, 0, NULL, 1, argv[0]);
 }
@@ -601,14 +658,18 @@ static void janet_flusher(const char *name, FILE *dflt_file) {
     }
 }
 
-static Janet cfun_io_flush(int32_t argc, Janet *argv) {
+JANET_CORE_FN(cfun_io_flush,
+              "(flush)",
+              "Flush `(dyn :out stdout)` if it is a file, otherwise do nothing.") {
     janet_fixarity(argc, 0);
     (void) argv;
     janet_flusher("out", stdout);
     return janet_wrap_nil();
 }
 
-static Janet cfun_io_eflush(int32_t argc, Janet *argv) {
+JANET_CORE_FN(cfun_io_eflush,
+              "(eflush)",
+              "Flush `(dyn :err stderr)` if it is a file, otherwise do nothing.") {
     janet_fixarity(argc, 0);
     (void) argv;
     janet_flusher("err", stderr);
@@ -637,12 +698,23 @@ 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);
             janet_buffer_deinit(&buffer);
             break;
         }
+        case JANET_FUNCTION: {
+            JanetFunction *fun = janet_unwrap_function(x);
+            int32_t len = 0;
+            while (format[len]) len++;
+            JanetBuffer *buf = janet_buffer(len);
+            janet_formatbv(buf, format, args);
+            Janet args[1] = { janet_wrap_buffer(buf) };
+            janet_call(fun, 1, args);
+            break;
+        }
         case JANET_BUFFER:
             janet_formatbv(janet_unwrap_buffer(x), format, args);
             break;
@@ -651,179 +723,23 @@ void janet_dynprintf(const char *name, FILE *dflt_file, const char *format, ...)
     return;
 }
 
-static const JanetReg io_cfuns[] = {
-    {
-        "print", cfun_io_print,
-        JDOC("(print & xs)\n\n"
-             "Print values to the console (standard out). Value are converted "
-             "to strings if they are not already. After printing all values, a "
-             "newline character is printed. Use the value of (dyn :out stdout) to determine "
-             "what to push characters to. Expects (dyn :out stdout) to be either a core/file or "
-             "a buffer. Returns nil.")
-    },
-    {
-        "prin", cfun_io_prin,
-        JDOC("(prin & xs)\n\n"
-             "Same as print, but does not add trailing newline.")
-    },
-    {
-        "printf", cfun_io_printf,
-        JDOC("(printf fmt & xs)\n\n"
-             "Prints output formatted as if with (string/format fmt ;xs) to (dyn :out stdout) with a trailing newline.")
-    },
-    {
-        "prinf", cfun_io_prinf,
-        JDOC("(prinf fmt & xs)\n\n"
-             "Like printf but with no trailing newline.")
-    },
-    {
-        "eprin", cfun_io_eprin,
-        JDOC("(eprin & xs)\n\n"
-             "Same as prin, but uses (dyn :err stderr) instead of (dyn :out stdout).")
-    },
-    {
-        "eprint", cfun_io_eprint,
-        JDOC("(eprint & xs)\n\n"
-             "Same as print, but uses (dyn :err stderr) instead of (dyn :out stdout).")
-    },
-    {
-        "eprintf", cfun_io_eprintf,
-        JDOC("(eprintf fmt & xs)\n\n"
-             "Prints output formatted as if with (string/format fmt ;xs) to (dyn :err stderr) with a trailing newline.")
-    },
-    {
-        "eprinf", cfun_io_eprinf,
-        JDOC("(eprinf fmt & xs)\n\n"
-             "Like eprintf but with no trailing newline.")
-    },
-    {
-        "xprint", cfun_io_xprint,
-        JDOC("(xprint to & xs)\n\n"
-             "Print to a file or other value explicitly (no dynamic bindings) with a trailing "
-             "newline character. The value to print "
-             "to is the first argument, and is otherwise the same as print. Returns nil.")
-    },
-    {
-        "xprin", cfun_io_xprin,
-        JDOC("(xprin to & xs)\n\n"
-             "Print to a file or other value explicitly (no dynamic bindings). The value to print "
-             "to is the first argument, and is otherwise the same as prin. Returns nil.")
-    },
-    {
-        "xprintf", cfun_io_xprintf,
-        JDOC("(xprint to fmt & xs)\n\n"
-             "Like printf but prints to an explicit file or value to. Returns nil.")
-    },
-    {
-        "xprinf", cfun_io_xprinf,
-        JDOC("(xprin to fmt & xs)\n\n"
-             "Like prinf but prints to an explicit file or value to. Returns nil.")
-    },
-    {
-        "flush", cfun_io_flush,
-        JDOC("(flush)\n\n"
-             "Flush (dyn :out stdout) if it is a file, otherwise do nothing.")
-    },
-    {
-        "eflush", cfun_io_eflush,
-        JDOC("(eflush)\n\n"
-             "Flush (dyn :err stderr) if it is a file, otherwise do nothing.")
-    },
-    {
-        "file/temp", cfun_io_temp,
-        JDOC("(file/temp)\n\n"
-             "Open an anonymous temporary file that is removed on close. "
-             "Raises an error on failure.")
-    },
-    {
-        "file/open", cfun_io_fopen,
-        JDOC("(file/open path &opt mode)\n\n"
-             "Open a file. `path` is an absolute or relative path, and "
-             "`mode` is a set of flags indicating the mode to open the file in. "
-             "`mode` is a keyword where each character represents a flag. If the file "
-             "cannot be opened, returns nil, otherwise returns the new file handle. "
-             "Mode flags:\n\n"
-             "* r - allow reading from the file\n\n"
-             "* w - allow writing to the file\n\n"
-             "* a - append to the file\n\n"
-             "Following one of the initial flags, 0 or more of the following flags can be appended:\n\n"
-             "* b - open the file in binary mode (rather than text mode)\n\n"
-             "* + - append to the file instead of overwriting it\n\n"
-             "* n - error if the file cannot be opened instead of returning nil")
-    },
-    {
-        "file/close", cfun_io_fclose,
-        JDOC("(file/close f)\n\n"
-             "Close a file and release all related resources. When you are "
-             "done reading a file, close it to prevent a resource leak and let "
-             "other processes read the file. If the file is the result of a file/popen "
-             "call, close waits for and returns the process exit status.")
-    },
-    {
-        "file/read", cfun_io_fread,
-        JDOC("(file/read f what &opt buf)\n\n"
-             "Read a number of bytes from a file `f` into a buffer. A buffer `buf` can "
-             "be provided as an optional third argument, otherwise a new buffer "
-             "is created. `what` can either be an integer or a keyword. Returns the "
-             "buffer with file contents. "
-             "Values for `what`:\n\n"
-             "* :all - read the whole file\n\n"
-             "* :line - read up to and including the next newline character\n\n"
-             "* n (integer) - read up to n bytes from the file")
-    },
-    {
-        "file/write", cfun_io_fwrite,
-        JDOC("(file/write f bytes)\n\n"
-             "Writes to a file. 'bytes' must be string, buffer, or symbol. Returns the "
-             "file.")
-    },
-    {
-        "file/flush", cfun_io_fflush,
-        JDOC("(file/flush f)\n\n"
-             "Flush any buffered bytes to the file system. In most files, writes are "
-             "buffered for efficiency reasons. Returns the file handle.")
-    },
-    {
-        "file/seek", cfun_io_fseek,
-        JDOC("(file/seek f &opt whence n)\n\n"
-             "Jump to a relative location in the file `f`. `whence` must be one of:\n\n"
-             "* :cur - jump relative to the current file location\n\n"
-             "* :set - jump relative to the beginning of the file\n\n"
-             "* :end - jump relative to the end of the file\n\n"
-             "By default, `whence` is :cur. Optionally a value `n` may be passed "
-             "for the relative number of bytes to seek in the file. `n` may be a real "
-             "number to handle large files of more than 4GB. Returns the file handle.")
-    },
-#ifndef JANET_NO_PROCESSES
-    {
-        "file/popen", cfun_io_popen,
-        JDOC("(file/popen command &opt mode) (DEPRECATED for os/spawn)\n\n"
-             "Open a file that is backed by a process. The file must be opened in either "
-             "the :r (read) or the :w (write) mode. In :r mode, the stdout of the "
-             "process can be read from the file. In :w mode, the stdin of the process "
-             "can be written to. Returns the new file.")
-    },
-#endif
-    {NULL, NULL, NULL}
-};
-
 /* C API */
 
 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));
 }
 
@@ -831,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;
@@ -839,20 +755,44 @@ FILE *janet_unwrapfile(Janet j, int *flags) {
 
 /* Module entry point */
 void janet_lib_io(JanetTable *env) {
-    janet_core_cfuns(env, NULL, io_cfuns);
+    JanetRegExt io_cfuns[] = {
+        JANET_CORE_REG("print", cfun_io_print),
+        JANET_CORE_REG("prin", cfun_io_prin),
+        JANET_CORE_REG("printf", cfun_io_printf),
+        JANET_CORE_REG("prinf", cfun_io_prinf),
+        JANET_CORE_REG("eprin", cfun_io_eprin),
+        JANET_CORE_REG("eprint", cfun_io_eprint),
+        JANET_CORE_REG("eprintf", cfun_io_eprintf),
+        JANET_CORE_REG("eprinf", cfun_io_eprinf),
+        JANET_CORE_REG("xprint", cfun_io_xprint),
+        JANET_CORE_REG("xprin", cfun_io_xprin),
+        JANET_CORE_REG("xprintf", cfun_io_xprintf),
+        JANET_CORE_REG("xprinf", cfun_io_xprinf),
+        JANET_CORE_REG("flush", cfun_io_flush),
+        JANET_CORE_REG("eflush", cfun_io_eflush),
+        JANET_CORE_REG("file/temp", cfun_io_temp),
+        JANET_CORE_REG("file/open", cfun_io_fopen),
+        JANET_CORE_REG("file/close", cfun_io_fclose),
+        JANET_CORE_REG("file/read", cfun_io_fread),
+        JANET_CORE_REG("file/write", cfun_io_fwrite),
+        JANET_CORE_REG("file/flush", cfun_io_fflush),
+        JANET_CORE_REG("file/seek", cfun_io_fseek),
+        JANET_REG_END
+    };
+    janet_core_cfuns_ext(env, NULL, io_cfuns);
     janet_register_abstract_type(&janet_file_type);
     int default_flags = JANET_FILE_NOT_CLOSEABLE | JANET_FILE_SERIALIZABLE;
     /* stdout */
-    janet_core_def(env, "stdout",
+    JANET_CORE_DEF(env, "stdout",
                    janet_makefile(stdout, JANET_FILE_APPEND | default_flags),
-                   JDOC("The standard output file."));
+                   "The standard output file.");
     /* stderr */
-    janet_core_def(env, "stderr",
+    JANET_CORE_DEF(env, "stderr",
                    janet_makefile(stderr, JANET_FILE_APPEND | default_flags),
-                   JDOC("The standard error file."));
+                   "The standard error file.");
     /* stdin */
-    janet_core_def(env, "stdin",
+    JANET_CORE_DEF(env, "stdin",
                    janet_makefile(stdin, JANET_FILE_READ | default_flags),
-                   JDOC("The standard input file."));
+                   "The standard input file.");
 
 }

src/core/marsh.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
@@ -37,6 +37,7 @@ typedef struct {
     JanetFuncEnv **seen_envs;
     JanetFuncDef **seen_defs;
     int32_t nextid;
+    int maybe_cycles;
 } MarshalState;
 
 /* Lead bytes in marshaling protocol */
@@ -63,7 +64,11 @@ enum {
     LB_FUNCENV_REF, /* 219 */
     LB_FUNCDEF_REF, /* 220 */
     LB_UNSAFE_CFUNCTION, /* 221 */
-    LB_UNSAFE_POINTER /* 222 */
+    LB_UNSAFE_POINTER, /* 222 */
+    LB_STRUCT_PROTO, /* 223 */
+#ifdef JANET_EV
+    LB_THREADED_ABSTRACT/* 224 */
+#endif
 } LeadBytes;
 
 /* Helper to look inside an entry in an environment */
@@ -247,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)
@@ -256,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);
 
@@ -265,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) {
@@ -325,6 +340,7 @@ static void marshal_one_fiber(MarshalState *st, JanetFiber *fiber, int flags) {
     }
     if (fiber->child)
         marshal_one(st, janet_wrap_fiber(fiber->child), flags + 1);
+    marshal_one(st, fiber->last_value, flags + 1);
 }
 
 void janet_marshal_size(JanetMarshalContext *ctx, size_t value) {
@@ -359,16 +375,33 @@ 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);
+#ifdef JANET_EV
+    /* Threaded abstract types get passed through as pointers in the unsafe mode */
+    if ((flags & JANET_MARSHAL_UNSAFE) &&
+            (JANET_MEMORY_THREADED_ABSTRACT == (janet_abstract_head(abstract)->gc.flags & JANET_MEM_TYPEBITS))) {
+
+        /* Increment refcount before sending message. This prevents a "death in transit" problem
+         * where a message is garbage collected while in transit between two threads - i.e., the sending threads
+         * loses the reference and runs a garbage collection before the receiving thread gets the message. */
+        janet_abstract_incref(abstract);
+        pushbyte(st, LB_THREADED_ABSTRACT);
+        pushbytes(st, (uint8_t *) &abstract, sizeof(abstract));
+        MARK_SEEN();
+        return;
+    }
+#endif
     const JanetAbstractType *at = janet_abstract_type(abstract);
     if (at->marshal) {
         pushbyte(st, LB_ABSTRACT);
@@ -376,7 +409,7 @@ static void marshal_one_abstract(MarshalState *st, Janet x, int flags) {
         JanetMarshalContext context = {st, NULL, flags, NULL, at};
         at->marshal(abstract, &context);
     } else {
-        janet_panicf("try to marshal unregistered abstract type, cannot marshal %p", x);
+        janet_panicf("cannot marshal %p", x);
     }
 }
 
@@ -408,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);
@@ -523,8 +559,10 @@ static void marshal_one(MarshalState *st, Janet x, int flags) {
             int32_t count;
             const JanetKV *struct_ = janet_unwrap_struct(x);
             count = janet_struct_length(struct_);
-            pushbyte(st, LB_STRUCT);
+            pushbyte(st, janet_struct_proto(struct_) ? LB_STRUCT_PROTO : LB_STRUCT);
             pushint(st, count);
+            if (janet_struct_proto(struct_))
+                marshal_one(st, janet_wrap_struct(janet_struct_proto(struct_)), flags + 1);
             for (int32_t i = 0; i < janet_struct_capacity(struct_); i++) {
                 if (janet_checktype(struct_[i].key, JANET_NIL))
                     continue;
@@ -542,9 +580,9 @@ static void marshal_one(MarshalState *st, Janet x, int flags) {
         case JANET_FUNCTION: {
             pushbyte(st, LB_FUNCTION);
             JanetFunction *func = janet_unwrap_function(x);
+            pushint(st, func->def->environments_length);
             /* Mark seen before reading def */
             MARK_SEEN();
-            pushint(st, func->def->environments_length);
             marshal_one_def(st, func->def, flags);
             for (int32_t i = 0; i < func->def->environments_length; i++)
                 marshal_one_env(st, func->envs[i], flags + 1);
@@ -591,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);
@@ -795,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 */
@@ -802,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);
@@ -817,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) {
@@ -845,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) {
@@ -935,6 +999,7 @@ static const uint8_t *unmarshal_one_fiber(
     fiber->data = NULL;
     fiber->child = NULL;
     fiber->env = NULL;
+    fiber->last_value = janet_wrap_nil();
 #ifdef JANET_EV
     fiber->waiting = NULL;
     fiber->sched_id = 0;
@@ -1046,6 +1111,9 @@ static const uint8_t *unmarshal_one_fiber(
         fiber->child = janet_unwrap_fiber(fiberv);
     }
 
+    /* Get the fiber last value */
+    data = unmarshal_one(st, data, &fiber->last_value, flags + 1);
+
     /* We have valid fiber, finally construct remaining fields. */
     fiber->frame = frame;
     fiber->flags = fiber_flags;
@@ -1103,14 +1171,18 @@ Janet janet_unmarshal_janet(JanetMarshalContext *ctx) {
     return ret;
 }
 
-void *janet_unmarshal_abstract(JanetMarshalContext *ctx, size_t size) {
+void janet_unmarshal_abstract_reuse(JanetMarshalContext *ctx, void *p) {
     UnmarshalState *st = (UnmarshalState *)(ctx->u_state);
     if (ctx->at == NULL) {
         janet_panicf("janet_unmarshal_abstract called more than once");
     }
-    void *p = janet_abstract(ctx->at, size);
     janet_v_push(st->lookup, janet_wrap_abstract(p));
     ctx->at = NULL;
+}
+
+void *janet_unmarshal_abstract(JanetMarshalContext *ctx, size_t size) {
+    void *p = janet_abstract(ctx->at, size);
+    janet_unmarshal_abstract_reuse(ctx, p);
     return p;
 }
 
@@ -1118,17 +1190,16 @@ static const uint8_t *unmarshal_one_abstract(UnmarshalState *st, const uint8_t *
     Janet key;
     data = unmarshal_one(st, data, &key, flags + 1);
     const JanetAbstractType *at = janet_get_abstract_type(key);
-    if (at == NULL) goto oops;
+    if (at == NULL) janet_panic("unknown abstract type");
     if (at->unmarshal) {
         JanetMarshalContext context = {NULL, st, flags, data, at};
         *out = janet_wrap_abstract(at->unmarshal(&context));
         if (context.at != NULL) {
-            janet_panicf("janet_unmarshal_abstract not called");
+            janet_panic("janet_unmarshal_abstract not called");
         }
         return context.data;
     }
-oops:
-    janet_panic("invalid abstract type");
+    janet_panic("invalid abstract type - no unmarshal function pointer");
 }
 
 static const uint8_t *unmarshal_one(
@@ -1233,18 +1304,16 @@ static const uint8_t *unmarshal_one(
             data++;
             int32_t len = readnat(st, &data);
             if (len > 255) {
-                janet_panicf("invalid function");
+                janet_panicf("invalid function - too many environments (%d)", len);
             }
             func = janet_gcalloc(JANET_MEMORY_FUNCTION, sizeof(JanetFunction) +
                                  len * sizeof(JanetFuncEnv));
+            func->def = NULL;
             *out = janet_wrap_function(func);
             janet_v_push(st->lookup, *out);
             data = unmarshal_one_def(st, data, &def, flags + 1);
-            if (def->environments_length != len) {
-                janet_panicf("invalid function");
-            }
             func->def = def;
-            for (int32_t i = 0; i < def->environments_length; i++) {
+            for (int32_t i = 0; i < len; i++) {
                 data = unmarshal_one_env(st, data, &(func->envs[i]), flags + 1);
             }
             return data;
@@ -1257,6 +1326,7 @@ static const uint8_t *unmarshal_one(
         case LB_ARRAY:
         case LB_TUPLE:
         case LB_STRUCT:
+        case LB_STRUCT_PROTO:
         case LB_TABLE:
         case LB_TABLE_PROTO:
             /* Things that open with integers */
@@ -1286,9 +1356,15 @@ static const uint8_t *unmarshal_one(
                 }
                 *out = janet_wrap_tuple(janet_tuple_end(tup));
                 janet_v_push(st->lookup, *out);
-            } else if (lead == LB_STRUCT) {
+            } else if (lead == LB_STRUCT || lead == LB_STRUCT_PROTO) {
                 /* Struct */
                 JanetKV *struct_ = janet_struct_begin(len);
+                if (lead == LB_STRUCT_PROTO) {
+                    Janet proto;
+                    data = unmarshal_one(st, data, &proto, flags + 1);
+                    janet_asserttype(proto, JANET_STRUCT);
+                    janet_struct_proto(struct_) = janet_unwrap_struct(proto);
+                }
                 for (int32_t i = 0; i < len; i++) {
                     Janet key, value;
                     data = unmarshal_one(st, data, &key, flags + 1);
@@ -1357,6 +1433,42 @@ static const uint8_t *unmarshal_one(
             janet_v_push(st->lookup, *out);
             return data;
         }
+#ifdef JANET_EV
+        case LB_THREADED_ABSTRACT: {
+            MARSH_EOS(st, data + sizeof(void *));
+            data++;
+            if (!(flags & JANET_MARSHAL_UNSAFE)) {
+                janet_panicf("unsafe flag not given, "
+                             "will not unmarshal threaded abstract pointer at index %d",
+                             (int)(data - st->start));
+            }
+            union {
+                void *ptr;
+                uint8_t bytes[sizeof(void *)];
+            } u;
+            memcpy(u.bytes, data, sizeof(void *));
+            data += sizeof(void *);
+
+            if (flags & JANET_MARSHAL_DECREF) {
+                /* Decrement immediately and don't bother putting into heap */
+                janet_abstract_decref(u.ptr);
+                *out = janet_wrap_nil();
+            } else {
+                *out = janet_wrap_abstract(u.ptr);
+                Janet check = janet_table_get(&janet_vm.threaded_abstracts, *out);
+                if (janet_checktype(check, JANET_NIL)) {
+                    /* Transfers reference from threaded channel buffer to current heap */
+                    janet_table_put(&janet_vm.threaded_abstracts, *out, janet_wrap_false());
+                } else {
+                    /* Heap reference already accounted for, remove threaded channel reference. */
+                    janet_abstract_decref(u.ptr);
+                }
+            }
+
+            janet_v_push(st->lookup, *out);
+            return data;
+        }
+#endif
         default: {
             janet_panicf("unknown byte %x at index %d",
                          *data,
@@ -1364,7 +1476,6 @@ static const uint8_t *unmarshal_one(
             return NULL;
         }
     }
-#undef EXTRA
 }
 
 Janet janet_unmarshal(
@@ -1391,16 +1502,28 @@ Janet janet_unmarshal(
 
 /* C functions */
 
-static Janet cfun_env_lookup(int32_t argc, Janet *argv) {
+JANET_CORE_FN(cfun_env_lookup,
+              "(env-lookup env)",
+              "Creates a forward lookup table for unmarshalling from an environment. "
+              "To create a reverse lookup table, use the invert function to swap keys "
+              "and values in the returned table.") {
     janet_fixarity(argc, 1);
     JanetTable *env = janet_gettable(argv, 0);
     return janet_wrap_table(janet_env_lookup(env));
 }
 
-static Janet cfun_marshal(int32_t argc, Janet *argv) {
-    janet_arity(argc, 1, 3);
+JANET_CORE_FN(cfun_marshal,
+              "(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, 4);
     JanetBuffer *buffer;
     JanetTable *rreg = NULL;
+    uint32_t flags = 0;
     if (argc > 1) {
         rreg = janet_gettable(argv, 1);
     }
@@ -1409,11 +1532,18 @@ static Janet cfun_marshal(int32_t argc, Janet *argv) {
     } 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);
 }
 
-static Janet cfun_unmarshal(int32_t argc, Janet *argv) {
+JANET_CORE_FN(cfun_unmarshal,
+              "(unmarshal buffer &opt lookup)",
+              "Unmarshal a value from a buffer. An optional lookup table "
+              "can be provided to allow for aliases to be resolved. Returns the value "
+              "unmarshalled from the buffer.") {
     janet_arity(argc, 1, 2);
     JanetByteView view = janet_getbytes(argv, 0);
     JanetTable *reg = NULL;
@@ -1423,35 +1553,13 @@ static Janet cfun_unmarshal(int32_t argc, Janet *argv) {
     return janet_unmarshal(view.bytes, (size_t) view.len, 0, reg, NULL);
 }
 
-static const JanetReg marsh_cfuns[] = {
-    {
-        "marshal", cfun_marshal,
-        JDOC("(marshal x &opt reverse-lookup buffer)\n\n"
-             "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.")
-    },
-    {
-        "unmarshal", cfun_unmarshal,
-        JDOC("(unmarshal buffer &opt lookup)\n\n"
-             "Unmarshal a value from a buffer. An optional lookup table "
-             "can be provided to allow for aliases to be resolved. Returns the value "
-             "unmarshalled from the buffer.")
-    },
-    {
-        "env-lookup", cfun_env_lookup,
-        JDOC("(env-lookup env)\n\n"
-             "Creates a forward lookup table for unmarshalling from an environment. "
-             "To create a reverse lookup table, use the invert function to swap keys "
-             "and values in the returned table.")
-    },
-    {NULL, NULL, NULL}
-};
-
 /* Module entry point */
 void janet_lib_marsh(JanetTable *env) {
-    janet_core_cfuns(env, NULL, marsh_cfuns);
+    JanetRegExt marsh_cfuns[] = {
+        JANET_CORE_REG("marshal", cfun_marshal),
+        JANET_CORE_REG("unmarshal", cfun_unmarshal),
+        JANET_CORE_REG("env-lookup", cfun_env_lookup),
+        JANET_REG_END
+    };
+    janet_core_cfuns_ext(env, NULL, marsh_cfuns);
 }

src/core/math.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
@@ -23,13 +23,12 @@
 #ifndef JANET_AMALG
 #include "features.h"
 #include <janet.h>
+#include "state.h"
 #include "util.h"
 #endif
 
 #include <math.h>
 
-static JANET_THREAD_LOCAL JanetRNG janet_vm_rng = {0, 0, 0, 0, 0};
-
 static int janet_rng_get(void *p, Janet key, Janet *out);
 static Janet janet_rng_next(void *p, Janet key);
 
@@ -69,7 +68,7 @@ const JanetAbstractType janet_rng_type = {
 };
 
 JanetRNG *janet_default_rng(void) {
-    return &janet_vm_rng;
+    return &janet_vm.rng;
 }
 
 void janet_rng_seed(JanetRNG *rng, uint32_t seed) {
@@ -118,7 +117,12 @@ double janet_rng_double(JanetRNG *rng) {
     return ldexp((double)(big >> (64 - 52)), -52);
 }
 
-static Janet cfun_rng_make(int32_t argc, Janet *argv) {
+JANET_CORE_FN(cfun_rng_make,
+              "(math/rng &opt seed)",
+              "Creates a Psuedo-Random number generator, with an optional seed. "
+              "The seed should be an unsigned 32 bit integer or a buffer. "
+              "Do not use this for cryptography. Returns a core/rng abstract type."
+             ) {
     janet_arity(argc, 0, 1);
     JanetRNG *rng = janet_abstract(&janet_rng_type, sizeof(JanetRNG));
     if (argc == 1) {
@@ -135,13 +139,20 @@ static Janet cfun_rng_make(int32_t argc, Janet *argv) {
     return janet_wrap_abstract(rng);
 }
 
-static Janet cfun_rng_uniform(int32_t argc, Janet *argv) {
+JANET_CORE_FN(cfun_rng_uniform,
+              "(math/rng-uniform rng)",
+              "Extract a random number in the range [0, 1) from the RNG."
+             ) {
     janet_fixarity(argc, 1);
     JanetRNG *rng = janet_getabstract(argv, 0, &janet_rng_type);
     return janet_wrap_number(janet_rng_double(rng));
 }
 
-static Janet cfun_rng_int(int32_t argc, Janet *argv) {
+JANET_CORE_FN(cfun_rng_int,
+              "(math/rng-int rng &opt max)",
+              "Extract a random random integer in the range [0, max] from the RNG. If "
+              "no max is given, the default is 2^31 - 1."
+             ) {
     janet_arity(argc, 1, 2);
     JanetRNG *rng = janet_getabstract(argv, 0, &janet_rng_type);
     if (argc == 1) {
@@ -169,7 +180,11 @@ static void rng_get_4bytes(JanetRNG *rng, uint8_t *buf) {
     buf[3] = (word >> 24) & 0xFF;
 }
 
-static Janet cfun_rng_buffer(int32_t argc, Janet *argv) {
+JANET_CORE_FN(cfun_rng_buffer,
+              "(math/rng-buffer rng n &opt buf)",
+              "Get n random bytes and put them in a buffer. Creates a new buffer if no buffer is "
+              "provided, otherwise appends to the given buffer. Returns the buffer."
+             ) {
     janet_arity(argc, 2, 3);
     JanetRNG *rng = janet_getabstract(argv, 0, &janet_rng_type);
     int32_t n = janet_getnat(argv, 1);
@@ -214,314 +229,197 @@ static Janet janet_rng_next(void *p, Janet key) {
 }
 
 /* Get a random number */
-static Janet janet_rand(int32_t argc, Janet *argv) {
+JANET_CORE_FN(janet_rand,
+              "(math/random)",
+              "Returns a uniformly distributed random number between 0 and 1.") {
     (void) argv;
     janet_fixarity(argc, 0);
-    return janet_wrap_number(janet_rng_double(&janet_vm_rng));
+    return janet_wrap_number(janet_rng_double(&janet_vm.rng));
 }
 
 /* Seed the random number generator */
-static Janet janet_srand(int32_t argc, Janet *argv) {
+JANET_CORE_FN(janet_srand,
+              "(math/seedrandom seed)",
+              "Set the seed for the random number generator. `seed` should be "
+              "an integer or a buffer."
+             ) {
     janet_fixarity(argc, 1);
     if (janet_checkint(argv[0])) {
         uint32_t seed = (uint32_t)(janet_getinteger(argv, 0));
-        janet_rng_seed(&janet_vm_rng, seed);
+        janet_rng_seed(&janet_vm.rng, seed);
     } else {
         JanetByteView bytes = janet_getbytes(argv, 0);
-        janet_rng_longseed(&janet_vm_rng, bytes.bytes, bytes.len);
+        janet_rng_longseed(&janet_vm.rng, bytes.bytes, bytes.len);
     }
     return janet_wrap_nil();
 }
 
-#define JANET_DEFINE_MATHOP(name, fop)\
-static Janet janet_##name(int32_t argc, Janet *argv) {\
+#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)); \
 }
 
-JANET_DEFINE_MATHOP(acos, acos)
-JANET_DEFINE_MATHOP(asin, asin)
-JANET_DEFINE_MATHOP(atan, atan)
-JANET_DEFINE_MATHOP(cos, cos)
-JANET_DEFINE_MATHOP(cosh, cosh)
-JANET_DEFINE_MATHOP(acosh, acosh)
-JANET_DEFINE_MATHOP(sin, sin)
-JANET_DEFINE_MATHOP(sinh, sinh)
-JANET_DEFINE_MATHOP(asinh, asinh)
-JANET_DEFINE_MATHOP(tan, tan)
-JANET_DEFINE_MATHOP(tanh, tanh)
-JANET_DEFINE_MATHOP(atanh, atanh)
-JANET_DEFINE_MATHOP(exp, exp)
-JANET_DEFINE_MATHOP(exp2, exp2)
-JANET_DEFINE_MATHOP(expm1, expm1)
-JANET_DEFINE_MATHOP(log, log)
-JANET_DEFINE_MATHOP(log10, log10)
-JANET_DEFINE_MATHOP(log2, log2)
-JANET_DEFINE_MATHOP(sqrt, sqrt)
-JANET_DEFINE_MATHOP(cbrt, cbrt)
-JANET_DEFINE_MATHOP(ceil, ceil)
-JANET_DEFINE_MATHOP(fabs, fabs)
-JANET_DEFINE_MATHOP(floor, floor)
-JANET_DEFINE_MATHOP(trunc, trunc)
-JANET_DEFINE_MATHOP(round, round)
-JANET_DEFINE_MATHOP(gamma, lgamma)
-JANET_DEFINE_MATHOP(log1p, log1p)
-JANET_DEFINE_MATHOP(erf, erf)
-JANET_DEFINE_MATHOP(erfc, erfc)
+#define JANET_DEFINE_MATHOP(name, fop, doc) JANET_DEFINE_NAMED_MATHOP(name, name, fop, doc)
 
-#define JANET_DEFINE_MATH2OP(name, fop)\
-static Janet janet_##name(int32_t argc, Janet *argv) {\
+JANET_DEFINE_MATHOP(acos, acos, "Returns the arccosine of x.")
+JANET_DEFINE_MATHOP(asin, asin, "Returns the arcsin of x.")
+JANET_DEFINE_MATHOP(atan, atan, "Returns the arctangent of x.")
+JANET_DEFINE_MATHOP(cos, cos, "Returns the cosine of x.")
+JANET_DEFINE_MATHOP(cosh, cosh, "Returns the hyperbolic cosine of x.")
+JANET_DEFINE_MATHOP(acosh, acosh, "Returns the hyperbolic arccosine of x.")
+JANET_DEFINE_MATHOP(sin, sin, "Returns the sine of x.")
+JANET_DEFINE_MATHOP(sinh, sinh, "Returns the hyperbolic sine of x.")
+JANET_DEFINE_MATHOP(asinh, asinh, "Returns the hyperbolic arcsine of x.")
+JANET_DEFINE_MATHOP(tan, tan, "Returns the tangent of x.")
+JANET_DEFINE_MATHOP(tanh, tanh, "Returns the hyperbolic tangent of x.")
+JANET_DEFINE_MATHOP(atanh, atanh, "Returns the hyperbolic arctangent of x.")
+JANET_DEFINE_MATHOP(exp, exp, "Returns e to the power of x.")
+JANET_DEFINE_MATHOP(exp2, exp2, "Returns 2 to the power of x.")
+JANET_DEFINE_MATHOP(expm1, expm1, "Returns e to the power of x minus 1.")
+JANET_DEFINE_MATHOP(log, log, "Returns the natural logarithm of x.")
+JANET_DEFINE_MATHOP(log10, log10, "Returns the log base 10 of x.")
+JANET_DEFINE_MATHOP(log2, log2, "Returns the log base 2 of x.")
+JANET_DEFINE_MATHOP(sqrt, sqrt, "Returns the square root of x.")
+JANET_DEFINE_MATHOP(cbrt, cbrt, "Returns the cube root of x.")
+JANET_DEFINE_MATHOP(ceil, ceil, "Returns the smallest integer value number that is not less than x.")
+JANET_DEFINE_MATHOP(abs, fabs, "Return the absolute value of x.")
+JANET_DEFINE_MATHOP(floor, floor, "Returns the largest integer value number that is not greater than x.")
+JANET_DEFINE_MATHOP(trunc, trunc, "Returns the integer between x and 0 nearest to x.")
+JANET_DEFINE_MATHOP(round, round, "Returns the integer nearest to x.")
+JANET_DEFINE_MATHOP(gamma, tgamma, "Returns gamma(x).")
+JANET_DEFINE_NAMED_MATHOP(lgamma, "log-gamma", lgamma, "Returns log-gamma(x).")
+JANET_DEFINE_MATHOP(log1p, log1p, "Returns (log base e of x) + 1 more accurately than (+ (math/log x) 1)")
+JANET_DEFINE_MATHOP(erf, erf, "Returns the error function of x.")
+JANET_DEFINE_MATHOP(erfc, erfc, "Returns the complementary error function of x.")
+
+#define JANET_DEFINE_MATH2OP(name, fop, signature, doc)\
+JANET_CORE_FN(janet_##name, signature, doc) {\
     janet_fixarity(argc, 2); \
     double lhs = janet_getnumber(argv, 0); \
     double rhs = janet_getnumber(argv, 1); \
     return janet_wrap_number(fop(lhs, rhs)); \
-}\
+}
 
-JANET_DEFINE_MATH2OP(atan2, atan2)
-JANET_DEFINE_MATH2OP(pow, pow)
-JANET_DEFINE_MATH2OP(hypot, hypot)
-JANET_DEFINE_MATH2OP(nextafter, nextafter)
+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 value after x in the direction of y.")
 
-static Janet janet_not(int32_t argc, Janet *argv) {
+JANET_CORE_FN(janet_not, "(not x)", "Returns the boolean inverse of x.") {
     janet_fixarity(argc, 1);
     return janet_wrap_boolean(!janet_truthy(argv[0]));
 }
 
-static const JanetReg math_cfuns[] = {
-    {
-        "not", janet_not,
-        JDOC("(not x)\n\nReturns the boolean inverse of x.")
-    },
-    {
-        "math/random", janet_rand,
-        JDOC("(math/random)\n\n"
-             "Returns a uniformly distributed random number between 0 and 1.")
-    },
-    {
-        "math/seedrandom", janet_srand,
-        JDOC("(math/seedrandom seed)\n\n"
-             "Set the seed for the random number generator. seed should be "
-             "an integer or a buffer.")
-    },
-    {
-        "math/cos", janet_cos,
-        JDOC("(math/cos x)\n\n"
-             "Returns the cosine of x.")
-    },
-    {
-        "math/sin", janet_sin,
-        JDOC("(math/sin x)\n\n"
-             "Returns the sine of x.")
-    },
-    {
-        "math/tan", janet_tan,
-        JDOC("(math/tan x)\n\n"
-             "Returns the tangent of x.")
-    },
-    {
-        "math/acos", janet_acos,
-        JDOC("(math/acos x)\n\n"
-             "Returns the arccosine of x.")
-    },
-    {
-        "math/asin", janet_asin,
-        JDOC("(math/asin x)\n\n"
-             "Returns the arcsine of x.")
-    },
-    {
-        "math/atan", janet_atan,
-        JDOC("(math/atan x)\n\n"
-             "Returns the arctangent of x.")
-    },
-    {
-        "math/exp", janet_exp,
-        JDOC("(math/exp x)\n\n"
-             "Returns e to the power of x.")
-    },
-    {
-        "math/log", janet_log,
-        JDOC("(math/log x)\n\n"
-             "Returns log base natural number of x.")
-    },
-    {
-        "math/log10", janet_log10,
-        JDOC("(math/log10 x)\n\n"
-             "Returns log base 10 of x.")
-    },
-    {
-        "math/log2", janet_log2,
-        JDOC("(math/log2 x)\n\n"
-             "Returns log base 2 of x.")
-    },
-    {
-        "math/sqrt", janet_sqrt,
-        JDOC("(math/sqrt x)\n\n"
-             "Returns the square root of x.")
-    },
-    {
-        "math/cbrt", janet_cbrt,
-        JDOC("(math/cbrt x)\n\n"
-             "Returns the cube root of x.")
-    },
-    {
-        "math/floor", janet_floor,
-        JDOC("(math/floor x)\n\n"
-             "Returns the largest integer value number that is not greater than x.")
-    },
-    {
-        "math/ceil", janet_ceil,
-        JDOC("(math/ceil x)\n\n"
-             "Returns the smallest integer value number that is not less than x.")
-    },
-    {
-        "math/pow", janet_pow,
-        JDOC("(math/pow a x)\n\n"
-             "Return a to the power of x.")
-    },
-    {
-        "math/abs", janet_fabs,
-        JDOC("(math/abs x)\n\n"
-             "Return the absolute value of x.")
-    },
-    {
-        "math/sinh", janet_sinh,
-        JDOC("(math/sinh x)\n\n"
-             "Return the hyperbolic sine of x.")
-    },
-    {
-        "math/cosh", janet_cosh,
-        JDOC("(math/cosh x)\n\n"
-             "Return the hyperbolic cosine of x.")
-    },
-    {
-        "math/tanh", janet_tanh,
-        JDOC("(math/tanh x)\n\n"
-             "Return the hyperbolic tangent of x.")
-    },
-    {
-        "math/atanh", janet_atanh,
-        JDOC("(math/atanh x)\n\n"
-             "Return the hyperbolic arctangent of x.")
-    },
-    {
-        "math/asinh", janet_asinh,
-        JDOC("(math/asinh x)\n\n"
-             "Return the hyperbolic arcsine of x.")
-    },
-    {
-        "math/acosh", janet_acosh,
-        JDOC("(math/acosh x)\n\n"
-             "Return the hyperbolic arccosine of x.")
-    },
-    {
-        "math/atan2", janet_atan2,
-        JDOC("(math/atan2 y x)\n\n"
-             "Return the arctangent of y/x. Works even when x is 0.")
-    },
-    {
-        "math/rng", cfun_rng_make,
-        JDOC("(math/rng &opt seed)\n\n"
-             "Creates a Psuedo-Random number generator, with an optional seed. "
-             "The seed should be an unsigned 32 bit integer or a buffer. "
-             "Do not use this for cryptography. Returns a core/rng abstract type.")
-    },
-    {
-        "math/rng-uniform", cfun_rng_uniform,
-        JDOC("(math/rng-seed rng seed)\n\n"
-             "Extract a random number in the range [0, 1) from the RNG.")
-    },
-    {
-        "math/rng-int", cfun_rng_int,
-        JDOC("(math/rng-int rng &opt max)\n\n"
-             "Extract a random random integer in the range [0, max] from the RNG. If "
-             "no max is given, the default is 2^31 - 1.")
-    },
-    {
-        "math/rng-buffer", cfun_rng_buffer,
-        JDOC("(math/rng-buffer rng n &opt buf)\n\n"
-             "Get n random bytes and put them in a buffer. Creates a new buffer if no buffer is "
-             "provided, otherwise appends to the given buffer. Returns the buffer.")
-    },
-    {
-        "math/hypot", janet_hypot,
-        JDOC("(math/hypot a b)\n\n"
-             "Returns the c from the equation c^2 = a^2 + b^2")
-    },
-    {
-        "math/exp2", janet_exp2,
-        JDOC("(math/exp2 x)\n\n"
-             "Returns 2 to the power of x.")
-    },
-    {
-        "math/log1p", janet_log1p,
-        JDOC("(math/log1p x)\n\n"
-             "Returns (log base e of x) + 1 more accurately than (+ (math/log x) 1)")
-    },
-    {
-        "math/gamma", janet_gamma,
-        JDOC("(math/gamma x)\n\n"
-             "Returns gamma(x).")
-    },
-    {
-        "math/erfc", janet_erfc,
-        JDOC("(math/erfc x)\n\n"
-             "Returns the complementary error function of x.")
-    },
-    {
-        "math/erf", janet_erf,
-        JDOC("(math/erf x)\n\n"
-             "Returns the error function of x.")
-    },
-    {
-        "math/expm1", janet_expm1,
-        JDOC("(math/expm1 x)\n\n"
-             "Returns e to the power of x minus 1.")
-    },
-    {
-        "math/trunc", janet_trunc,
-        JDOC("(math/trunc x)\n\n"
-             "Returns the integer between x and 0 nearest to x.")
-    },
-    {
-        "math/round", janet_round,
-        JDOC("(math/round x)\n\n"
-             "Returns the integer nearest to x.")
-    },
-    {
-        "math/next", janet_nextafter,
-        JDOC("(math/next x y)\n\n"
-             "Returns the next representable floating point value after x in the direction of y.")
-    },
-    {NULL, NULL, NULL}
-};
+static double janet_gcd(double x, double y) {
+    if (isnan(x) || isnan(y)) {
+#ifdef NAN
+        return NAN;
+#else
+        return 0.0 \ 0.0;
+#endif
+    }
+    if (isinf(x) || isinf(y)) return INFINITY;
+    while (y != 0) {
+        double temp = y;
+        y = fmod(x, y);
+        x = temp;
+    }
+    return x;
+}
+
+static double janet_lcm(double x, double y) {
+    return (x / janet_gcd(x, y)) * y;
+}
+
+JANET_CORE_FN(janet_cfun_gcd, "(math/gcd x y)",
+              "Returns the greatest common divisor between x and y.") {
+    janet_fixarity(argc, 2);
+    double x = janet_getnumber(argv, 0);
+    double y = janet_getnumber(argv, 1);
+    return janet_wrap_number(janet_gcd(x, y));
+}
+
+JANET_CORE_FN(janet_cfun_lcm, "(math/lcm x y)",
+              "Returns the least common multiple of x and y.") {
+    janet_fixarity(argc, 2);
+    double x = janet_getnumber(argv, 0);
+    double y = janet_getnumber(argv, 1);
+    return janet_wrap_number(janet_lcm(x, y));
+}
 
 /* Module entry point */
 void janet_lib_math(JanetTable *env) {
-    janet_core_cfuns(env, NULL, math_cfuns);
+    JanetRegExt math_cfuns[] = {
+        JANET_CORE_REG("not", janet_not),
+        JANET_CORE_REG("math/random", janet_rand),
+        JANET_CORE_REG("math/seedrandom", janet_srand),
+        JANET_CORE_REG("math/cos", janet_cos),
+        JANET_CORE_REG("math/sin", janet_sin),
+        JANET_CORE_REG("math/tan", janet_tan),
+        JANET_CORE_REG("math/acos", janet_acos),
+        JANET_CORE_REG("math/asin", janet_asin),
+        JANET_CORE_REG("math/atan", janet_atan),
+        JANET_CORE_REG("math/exp", janet_exp),
+        JANET_CORE_REG("math/log", janet_log),
+        JANET_CORE_REG("math/log10", janet_log10),
+        JANET_CORE_REG("math/log2", janet_log2),
+        JANET_CORE_REG("math/sqrt", janet_sqrt),
+        JANET_CORE_REG("math/cbrt", janet_cbrt),
+        JANET_CORE_REG("math/floor", janet_floor),
+        JANET_CORE_REG("math/ceil", janet_ceil),
+        JANET_CORE_REG("math/pow", janet_pow),
+        JANET_CORE_REG("math/abs", janet_abs),
+        JANET_CORE_REG("math/sinh", janet_sinh),
+        JANET_CORE_REG("math/cosh", janet_cosh),
+        JANET_CORE_REG("math/tanh", janet_tanh),
+        JANET_CORE_REG("math/atanh", janet_atanh),
+        JANET_CORE_REG("math/asinh", janet_asinh),
+        JANET_CORE_REG("math/acosh", janet_acosh),
+        JANET_CORE_REG("math/atan2", janet_atan2),
+        JANET_CORE_REG("math/rng", cfun_rng_make),
+        JANET_CORE_REG("math/rng-uniform", cfun_rng_uniform),
+        JANET_CORE_REG("math/rng-int", cfun_rng_int),
+        JANET_CORE_REG("math/rng-buffer", cfun_rng_buffer),
+        JANET_CORE_REG("math/hypot", janet_hypot),
+        JANET_CORE_REG("math/exp2", janet_exp2),
+        JANET_CORE_REG("math/log1p", janet_log1p),
+        JANET_CORE_REG("math/gamma", janet_gamma),
+        JANET_CORE_REG("math/log-gamma", janet_lgamma),
+        JANET_CORE_REG("math/erfc", janet_erfc),
+        JANET_CORE_REG("math/erf", janet_erf),
+        JANET_CORE_REG("math/expm1", janet_expm1),
+        JANET_CORE_REG("math/trunc", janet_trunc),
+        JANET_CORE_REG("math/round", janet_round),
+        JANET_CORE_REG("math/next", janet_nextafter),
+        JANET_CORE_REG("math/gcd", janet_cfun_gcd),
+        JANET_CORE_REG("math/lcm", janet_cfun_lcm),
+        JANET_REG_END
+    };
+    janet_core_cfuns_ext(env, NULL, math_cfuns);
     janet_register_abstract_type(&janet_rng_type);
 #ifdef JANET_BOOTSTRAP
-    janet_def(env, "math/pi", janet_wrap_number(3.1415926535897931),
-              JDOC("The value pi."));
-    janet_def(env, "math/e", janet_wrap_number(2.7182818284590451),
-              JDOC("The base of the natural log."));
-    janet_def(env, "math/inf", janet_wrap_number(INFINITY),
-              JDOC("The number representing positive infinity"));
-    janet_def(env, "math/-inf", janet_wrap_number(-INFINITY),
-              JDOC("The number representing negative infinity"));
-    janet_def(env, "math/int32-min", janet_wrap_number(INT32_MIN),
-              JDOC("The minimum contiguous integer representable by a 32 bit signed integer"));
-    janet_def(env, "math/int32-max", janet_wrap_number(INT32_MAX),
-              JDOC("The maximum contiguous integer represtenable by a 32 bit signed integer"));
-    janet_def(env, "math/int-min", janet_wrap_number(JANET_INTMIN_DOUBLE),
-              JDOC("The minimum contiguous integer representable by a double (2^53)"));
-    janet_def(env, "math/int-max", janet_wrap_number(JANET_INTMAX_DOUBLE),
-              JDOC("The maximum contiguous integer represtenable by a double (-(2^53))"));
+    JANET_CORE_DEF(env, "math/pi", janet_wrap_number(3.1415926535897931),
+                   "The value pi.");
+    JANET_CORE_DEF(env, "math/e", janet_wrap_number(2.7182818284590451),
+                   "The base of the natural log.");
+    JANET_CORE_DEF(env, "math/inf", janet_wrap_number(INFINITY),
+                   "The number representing positive infinity");
+    JANET_CORE_DEF(env, "math/-inf", janet_wrap_number(-INFINITY),
+                   "The number representing negative infinity");
+    JANET_CORE_DEF(env, "math/int32-min", janet_wrap_number(INT32_MIN),
+                   "The minimum contiguous integer representable by a 32 bit signed integer");
+    JANET_CORE_DEF(env, "math/int32-max", janet_wrap_number(INT32_MAX),
+                   "The maximum contiguous integer represtenable by a 32 bit signed integer");
+    JANET_CORE_DEF(env, "math/int-min", janet_wrap_number(JANET_INTMIN_DOUBLE),
+                   "The minimum contiguous integer representable by a double (2^53)");
+    JANET_CORE_DEF(env, "math/int-max", janet_wrap_number(JANET_INTMAX_DOUBLE),
+                   "The maximum contiguous integer represtenable by a double (-(2^53))");
 #ifdef NAN
-    janet_def(env, "math/nan", janet_wrap_number(NAN),
+    JANET_CORE_DEF(env, "math/nan", janet_wrap_number(NAN), "Not a number (IEEE-754 NaN)");
 #else
-    janet_def(env, "math/nan", janet_wrap_number(0.0 / 0.0),
+    JANET_CORE_DEF(env, "math/nan", janet_wrap_number(0.0 / 0.0), "Not a number (IEEE-754 NaN)");
 #endif
-              JDOC("Not a number (IEEE-754 NaN)"));
 #endif
 }

src/core/net.c

@@ -1,5 +1,5 @@
 /*
-* 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
@@ -34,10 +34,13 @@
 #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>
 #include <signal.h>
 #include <sys/ioctl.h>
@@ -73,6 +76,15 @@ const JanetAbstractType janet_address_type = {
 #endif
 #endif
 
+/* maximum number of bytes in a socket address host (post name resolution) */
+#ifdef JANET_WINDOWS
+#define SA_ADDRSTRLEN (INET6_ADDRSTRLEN + 1)
+typedef unsigned short in_port_t;
+#else
+#define JANET_SA_MAX(a, b) (((a) > (b))? (a) : (b))
+#define SA_ADDRSTRLEN JANET_SA_MAX(INET6_ADDRSTRLEN + 1, (sizeof ((struct sockaddr_un *)0)->sun_path) + 1)
+#endif
+
 static JanetStream *make_stream(JSock handle, uint32_t flags);
 
 /* We pass this flag to all send calls to prevent sigpipe */
@@ -122,22 +134,20 @@ JanetAsyncStatus net_machine_accept(JanetListenerState *s, JanetAsyncEvent event
         case JANET_ASYNC_EVENT_MARK: {
             if (state->lstream) janet_mark(janet_wrap_abstract(state->lstream));
             if (state->astream) janet_mark(janet_wrap_abstract(state->astream));
-            if (state->function) janet_mark(janet_wrap_abstract(state->function));
+            if (state->function) janet_mark(janet_wrap_function(state->function));
             break;
         }
         case JANET_ASYNC_EVENT_CLOSE:
             janet_schedule(s->fiber, janet_wrap_nil());
             return JANET_ASYNC_STATUS_DONE;
         case JANET_ASYNC_EVENT_COMPLETE: {
-            int seconds;
-            int bytes = sizeof(seconds);
-            if (NO_ERROR != getsockopt((SOCKET) state->astream->handle, SOL_SOCKET, SO_CONNECT_TIME,
-                                       (char *)&seconds, &bytes)) {
+            if (state->astream->flags & JANET_STREAM_CLOSED) {
                 janet_cancel(s->fiber, janet_cstringv("failed to accept connection"));
                 return JANET_ASYNC_STATUS_DONE;
             }
+            SOCKET lsock = (SOCKET) state->lstream->handle;
             if (NO_ERROR != setsockopt((SOCKET) state->astream->handle, SOL_SOCKET, SO_UPDATE_ACCEPT_CONTEXT,
-                                       (char *) & (state->lstream->handle), sizeof(SOCKET))) {
+                                       (char *) &lsock, sizeof(lsock))) {
                 janet_cancel(s->fiber, janet_cstringv("failed to accept connection"));
                 return JANET_ASYNC_STATUS_DONE;
             }
@@ -165,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));
@@ -216,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);
@@ -259,7 +273,8 @@ static int janet_get_sockettype(Janet *argv, int32_t argc, int32_t n) {
 }
 
 /* Needs argc >= offset + 2 */
-/* For unix paths, just rertuns a single sockaddr and sets *is_unix to 1, otherwise 0 */
+/* For unix paths, just rertuns a single sockaddr and sets *is_unix to 1,
+ * otherwise 0. Also, ignores is_bind when is a unix socket. */
 static struct addrinfo *janet_get_addrinfo(Janet *argv, int32_t offset, int socktype, int passive, int *is_unix) {
     /* Unix socket support - not yet supported on windows. */
 #ifndef JANET_WINDOWS
@@ -285,12 +300,12 @@ static struct addrinfo *janet_get_addrinfo(Janet *argv, int32_t offset, int sock
     }
 #endif
     /* Get host and port */
-    const char *host = janet_getcstring(argv, offset);
-    const char *port;
+    char *host = (char *)janet_getcstring(argv, offset);
+    char *port = NULL;
     if (janet_checkint(argv[offset + 1])) {
-        port = (const char *)janet_to_string(argv[offset + 1]);
+        port = (char *)janet_to_string(argv[offset + 1]);
     } else {
-        port = janet_optcstring(argv, offset + 2, offset + 1, NULL);
+        port = (char *)janet_optcstring(argv, offset + 2, offset + 1, NULL);
     }
     /* getaddrinfo */
     struct addrinfo *ai = NULL;
@@ -311,7 +326,14 @@ static struct addrinfo *janet_get_addrinfo(Janet *argv, int32_t offset, int sock
  * C Funs
  */
 
-static Janet cfun_net_sockaddr(int32_t argc, Janet *argv) {
+JANET_CORE_FN(cfun_net_sockaddr,
+              "(net/address host port &opt type multi)",
+              "Look up the connection information for a given hostname, port, and connection type. Returns "
+              "a handle that can be used to send datagrams over network without establishing a connection. "
+              "On Posix platforms, you can use :unix for host to connect to a unix domain socket, where the name is "
+              "given in the port argument. On Linux, abstract "
+              "unix domain sockets are specified with a leading '@' character in port. If `multi` is truthy, will "
+              "return all address that match in an array instead of just the first.") {
     janet_arity(argc, 2, 4);
     int socktype = janet_get_sockettype(argv, argc, 2);
     int is_unix = 0;
@@ -350,13 +372,50 @@ static Janet cfun_net_sockaddr(int32_t argc, Janet *argv) {
     }
 }
 
-static Janet cfun_net_connect(int32_t argc, Janet *argv) {
-    janet_arity(argc, 2, 3);
+JANET_CORE_FN(cfun_net_connect,
+              "(net/connect host port &opt type bindhost bindport)",
+              "Open a connection to communicate with a server. Returns a duplex stream "
+              "that can be used to communicate with the server. Type is an optional keyword "
+              "to specify a connection type, either :stream or :datagram. The default is :stream. "
+              "Bindhost is an optional string to select from what address to make the outgoing "
+              "connection, with the default being the same as using the OS's preferred address. ") {
+    janet_arity(argc, 2, 5);
 
+    /* Check arguments */
     int socktype = janet_get_sockettype(argv, argc, 2);
     int is_unix = 0;
+    char *bindhost = (char *) janet_optcstring(argv, argc, 3, NULL);
+    char *bindport = NULL;
+    if (argc >= 5 && janet_checkint(argv[4])) {
+        bindport = (char *)janet_to_string(argv[4]);
+    } else {
+        bindport = (char *)janet_optcstring(argv, argc, 4, NULL);
+    }
+
+    /* Where we're connecting to */
     struct addrinfo *ai = janet_get_addrinfo(argv, 0, socktype, 0, &is_unix);
 
+    /* Check if we're binding address */
+    struct addrinfo *binding = NULL;
+    if (bindhost != NULL) {
+        if (is_unix) {
+            freeaddrinfo(ai);
+            janet_panic("bindhost not supported for unix domain sockets");
+        }
+        /* getaddrinfo */
+        struct addrinfo hints;
+        memset(&hints, 0, sizeof(hints));
+        hints.ai_family = AF_UNSPEC;
+        hints.ai_socktype = socktype;
+        hints.ai_flags = 0;
+        int status = getaddrinfo(bindhost, bindport, &hints, &binding);
+        if (status) {
+            freeaddrinfo(ai);
+            janet_panicf("could not get address info for bindhost: %s", gai_strerror(status));
+        }
+    }
+
+
     /* Create socket */
     JSock sock = JSOCKDEFAULT;
     void *addr = NULL;
@@ -365,7 +424,9 @@ static Janet cfun_net_connect(int32_t argc, Janet *argv) {
     if (is_unix) {
         sock = socket(AF_UNIX, socktype | JSOCKFLAGS, 0);
         if (!JSOCKVALID(sock)) {
-            janet_panicf("could not create socket: %V", janet_ev_lasterr());
+            Janet v = janet_ev_lasterr();
+            janet_free(ai);
+            janet_panicf("could not create socket: %V", v);
         }
         addr = (void *) ai;
         addrlen = sizeof(struct sockaddr_un);
@@ -375,7 +436,7 @@ static Janet cfun_net_connect(int32_t argc, Janet *argv) {
         struct addrinfo *rp = NULL;
         for (rp = ai; rp != NULL; rp = rp->ai_next) {
 #ifdef JANET_WINDOWS
-            sock = WSASocketW(rp->ai_family, rp->ai_socktype | JSOCKFLAGS, rp->ai_protocol, NULL, 0, WSA_FLAG_OVERLAPPED);
+            sock = WSASocketW(rp->ai_family, rp->ai_socktype, rp->ai_protocol, NULL, 0, WSA_FLAG_OVERLAPPED);
 #else
             sock = socket(rp->ai_family, rp->ai_socktype | JSOCKFLAGS, rp->ai_protocol);
 #endif
@@ -386,17 +447,42 @@ static Janet cfun_net_connect(int32_t argc, Janet *argv) {
             }
         }
         if (NULL == addr) {
+            Janet v = janet_ev_lasterr();
+            if (binding) freeaddrinfo(binding);
             freeaddrinfo(ai);
-            janet_panicf("could not create socket: %V", janet_ev_lasterr());
+            janet_panicf("could not create socket: %V", v);
+        }
+    }
+
+    /* Bind to bindhost and bindport if given */
+    if (binding) {
+        struct addrinfo *rp = NULL;
+        int did_bind = 0;
+        for (rp = ai; rp != NULL; rp = rp->ai_next) {
+            if (bind(sock, rp->ai_addr, (int) rp->ai_addrlen) == 0) {
+                did_bind = 1;
+                break;
+            }
+        }
+        if (!did_bind) {
+            Janet v = janet_ev_lasterr();
+            freeaddrinfo(binding);
+            freeaddrinfo(ai);
+            JSOCKCLOSE(sock);
+            janet_panicf("could not bind outgoing address: %V", v);
+        } else {
+            freeaddrinfo(binding);
         }
     }
 
     /* Connect to socket */
 #ifdef JANET_WINDOWS
     int status = WSAConnect(sock, addr, addrlen, NULL, NULL, NULL, NULL);
+    Janet lasterr = janet_ev_lasterr();
     freeaddrinfo(ai);
 #else
     int status = connect(sock, addr, addrlen);
+    Janet lasterr = janet_ev_lasterr();
     if (is_unix) {
         janet_free(ai);
     } else {
@@ -406,7 +492,7 @@ static Janet cfun_net_connect(int32_t argc, Janet *argv) {
 
     if (status == -1) {
         JSOCKCLOSE(sock);
-        janet_panicf("could not connect to socket: %V", janet_ev_lasterr());
+        janet_panicf("could not connect socket: %V", lasterr);
     }
 
     /* Set up the socket for non-blocking IO after connect - TODO - non-blocking connect? */
@@ -442,7 +528,14 @@ static const char *serverify_socket(JSock sfd) {
 #define JANET_SHUTDOWN_W SHUT_WR
 #endif
 
-static Janet cfun_net_shutdown(int32_t argc, Janet *argv) {
+JANET_CORE_FN(cfun_net_shutdown,
+              "(net/shutdown stream &opt mode)",
+              "Stop communication on this socket in a graceful manner, either in both directions or just "
+              "reading/writing from the stream. The `mode` parameter controls which communication to stop on the socket. "
+              "\n\n* `:wr` is the default and prevents both reading new data from the socket and writing new data to the socket.\n"
+              "* `:r` disables reading new data from the socket.\n"
+              "* `:w` disable writing data to the socket.\n\n"
+              "Returns the original socket.") {
     janet_arity(argc, 1, 2);
     JanetStream *stream = janet_getabstract(argv, 0, &janet_stream_type);
     janet_stream_flags(stream, JANET_STREAM_SOCKET);
@@ -473,7 +566,13 @@ static Janet cfun_net_shutdown(int32_t argc, Janet *argv) {
     return argv[0];
 }
 
-static Janet cfun_net_listen(int32_t argc, Janet *argv) {
+JANET_CORE_FN(cfun_net_listen,
+              "(net/listen host port &opt type)",
+              "Creates a server. Returns a new stream that is neither readable nor "
+              "writeable. Use net/accept or net/accept-loop be to handle connections and start the server. "
+              "The type parameter specifies the type of network connection, either "
+              "a :stream (usually tcp), or :datagram (usually udp). If not specified, the default is "
+              ":stream. The host and port arguments are the same as in net/address.") {
     janet_arity(argc, 2, 3);
 
     /* Get host, port, and handler*/
@@ -547,7 +646,100 @@ static Janet cfun_net_listen(int32_t argc, Janet *argv) {
     }
 }
 
-static Janet cfun_stream_accept_loop(int32_t argc, Janet *argv) {
+/* Types of socket's we need to deal with - relevant type puns below.
+struct sockaddr *sa;           // Common base structure
+struct sockaddr_storage *ss;   // Size of largest socket address type
+struct sockaddr_in *sin;       // IPv4 address + port
+struct sockaddr_in6 *sin6;     // IPv6 address + port
+struct sockaddr_un *sun;       // Unix Domain Socket Address
+*/
+
+/* Turn a socket address into a host, port pair.
+ * For unix domain sockets, returned tuple will have only a single element, the path string. */
+static Janet janet_so_getname(const void *sa_any) {
+    const struct sockaddr *sa = sa_any;
+    char buffer[SA_ADDRSTRLEN];
+    switch (sa->sa_family) {
+        default:
+            janet_panic("unknown address family");
+        case AF_INET: {
+            const struct sockaddr_in *sai = sa_any;
+            if (!inet_ntop(AF_INET, &(sai->sin_addr), buffer, sizeof(buffer))) {
+                janet_panic("unable to decode ipv4 host address");
+            }
+            Janet pair[2] = {janet_cstringv(buffer), janet_wrap_integer(ntohs(sai->sin_port))};
+            return janet_wrap_tuple(janet_tuple_n(pair, 2));
+        }
+        case AF_INET6: {
+            const struct sockaddr_in6 *sai6 = sa_any;
+            if (!inet_ntop(AF_INET6, &(sai6->sin6_addr), buffer, sizeof(buffer))) {
+                janet_panic("unable to decode ipv4 host address");
+            }
+            Janet pair[2] = {janet_cstringv(buffer), janet_wrap_integer(ntohs(sai6->sin6_port))};
+            return janet_wrap_tuple(janet_tuple_n(pair, 2));
+        }
+#ifndef JANET_WINDOWS
+        case AF_UNIX: {
+            const struct sockaddr_un *sun = sa_any;
+            Janet pathname;
+            if (sun->sun_path[0] == '\0') {
+                memcpy(buffer, sun->sun_path, sizeof(sun->sun_path));
+                buffer[0] = '@';
+                pathname = janet_cstringv(buffer);
+            } else {
+                pathname = janet_cstringv(sun->sun_path);
+            }
+            return janet_wrap_tuple(janet_tuple_n(&pathname, 1));
+        }
+#endif
+    }
+}
+
+JANET_CORE_FN(cfun_net_getsockname,
+              "(net/localname stream)",
+              "Gets the local address and port in a tuple in that order.") {
+    janet_fixarity(argc, 1);
+    JanetStream *js = janet_getabstract(argv, 0, &janet_stream_type);
+    if (js->flags & JANET_STREAM_CLOSED) janet_panic("stream closed");
+    struct sockaddr_storage ss;
+    socklen_t slen = sizeof(ss);
+    memset(&ss, 0, slen);
+    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 <= (socklen_t) sizeof(ss), "socket address truncated");
+    return janet_so_getname(&ss);
+}
+
+JANET_CORE_FN(cfun_net_getpeername,
+              "(net/peername stream)",
+              "Gets the remote peer's address and port in a tuple in that order.") {
+    janet_fixarity(argc, 1);
+    JanetStream *js = janet_getabstract(argv, 0, &janet_stream_type);
+    if (js->flags & JANET_STREAM_CLOSED) janet_panic("stream closed");
+    struct sockaddr_storage ss;
+    socklen_t slen = sizeof(ss);
+    memset(&ss, 0, slen);
+    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 <= (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/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);
+    return janet_so_getname(sa);
+}
+
+JANET_CORE_FN(cfun_stream_accept_loop,
+              "(net/accept-loop stream handler)",
+              "Shorthand for running a server stream that will continuously accept new connections. "
+              "Blocks the current fiber until the stream is closed, and will return the stream.") {
     janet_fixarity(argc, 2);
     JanetStream *stream = janet_getabstract(argv, 0, &janet_stream_type);
     janet_stream_flags(stream, JANET_STREAM_ACCEPTABLE | JANET_STREAM_SOCKET);
@@ -555,7 +747,11 @@ static Janet cfun_stream_accept_loop(int32_t argc, Janet *argv) {
     janet_sched_accept(stream, fun);
 }
 
-static Janet cfun_stream_accept(int32_t argc, Janet *argv) {
+JANET_CORE_FN(cfun_stream_accept,
+              "(net/accept stream &opt timeout)",
+              "Get the next connection on a server stream. This would usually be called in a loop in a dedicated fiber. "
+              "Takes an optional timeout in seconds, after which will return nil. "
+              "Returns a new duplex stream which represents a connection to the client.") {
     janet_arity(argc, 1, 2);
     JanetStream *stream = janet_getabstract(argv, 0, &janet_stream_type);
     janet_stream_flags(stream, JANET_STREAM_ACCEPTABLE | JANET_STREAM_SOCKET);
@@ -564,7 +760,13 @@ static Janet cfun_stream_accept(int32_t argc, Janet *argv) {
     janet_sched_accept(stream, NULL);
 }
 
-static Janet cfun_stream_read(int32_t argc, Janet *argv) {
+JANET_CORE_FN(cfun_stream_read,
+              "(net/read stream nbytes &opt buf timeout)",
+              "Read up to n bytes from a stream, suspending the current fiber until the bytes are available. "
+              "`n` can also be the keyword `:all` to read into the buffer until end of stream. "
+              "If less than n bytes are available (and more than 0), will push those bytes and return early. "
+              "Takes an optional timeout in seconds, after which will return nil. "
+              "Returns a buffer with up to n more bytes in it, or raises an error if the read failed.") {
     janet_arity(argc, 2, 4);
     JanetStream *stream = janet_getabstract(argv, 0, &janet_stream_type);
     janet_stream_flags(stream, JANET_STREAM_READABLE | JANET_STREAM_SOCKET);
@@ -581,7 +783,10 @@ static Janet cfun_stream_read(int32_t argc, Janet *argv) {
     janet_await();
 }
 
-static Janet cfun_stream_chunk(int32_t argc, Janet *argv) {
+JANET_CORE_FN(cfun_stream_chunk,
+              "(net/chunk stream nbytes &opt buf timeout)",
+              "Same a net/read, but will wait for all n bytes to arrive rather than return early. "
+              "Takes an optional timeout in seconds, after which will return nil.") {
     janet_arity(argc, 2, 4);
     JanetStream *stream = janet_getabstract(argv, 0, &janet_stream_type);
     janet_stream_flags(stream, JANET_STREAM_READABLE | JANET_STREAM_SOCKET);
@@ -593,7 +798,10 @@ static Janet cfun_stream_chunk(int32_t argc, Janet *argv) {
     janet_await();
 }
 
-static Janet cfun_stream_recv_from(int32_t argc, Janet *argv) {
+JANET_CORE_FN(cfun_stream_recv_from,
+              "(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);
     JanetStream *stream = janet_getabstract(argv, 0, &janet_stream_type);
     janet_stream_flags(stream, JANET_STREAM_UDPSERVER | JANET_STREAM_SOCKET);
@@ -605,7 +813,11 @@ static Janet cfun_stream_recv_from(int32_t argc, Janet *argv) {
     janet_await();
 }
 
-static Janet cfun_stream_write(int32_t argc, Janet *argv) {
+JANET_CORE_FN(cfun_stream_write,
+              "(net/write stream data &opt timeout)",
+              "Write data to a stream, suspending the current fiber until the write "
+              "completes. Takes an optional timeout in seconds, after which will return nil. "
+              "Returns nil, or raises an error if the write failed.") {
     janet_arity(argc, 2, 3);
     JanetStream *stream = janet_getabstract(argv, 0, &janet_stream_type);
     janet_stream_flags(stream, JANET_STREAM_WRITABLE | JANET_STREAM_SOCKET);
@@ -621,7 +833,11 @@ static Janet cfun_stream_write(int32_t argc, Janet *argv) {
     janet_await();
 }
 
-static Janet cfun_stream_send_to(int32_t argc, Janet *argv) {
+JANET_CORE_FN(cfun_stream_send_to,
+              "(net/send-to stream dest data &opt timeout)",
+              "Writes a datagram to a server stream. dest is a the destination address of the packet. "
+              "Takes an optional timeout in seconds, after which will return nil. "
+              "Returns stream.") {
     janet_arity(argc, 3, 4);
     JanetStream *stream = janet_getabstract(argv, 0, &janet_stream_type);
     janet_stream_flags(stream, JANET_STREAM_UDPSERVER | JANET_STREAM_SOCKET);
@@ -638,7 +854,10 @@ static Janet cfun_stream_send_to(int32_t argc, Janet *argv) {
     janet_await();
 }
 
-static Janet cfun_stream_flush(int32_t argc, Janet *argv) {
+JANET_CORE_FN(cfun_stream_flush,
+              "(net/flush stream)",
+              "Make sure that a stream is not buffering any data. This temporarily disables Nagle's algorithm. "
+              "Use this to make sure data is sent without delay. Returns stream.") {
     janet_fixarity(argc, 1);
     JanetStream *stream = janet_getabstract(argv, 0, &janet_stream_type);
     janet_stream_flags(stream, JANET_STREAM_WRITABLE | JANET_STREAM_SOCKET);
@@ -660,7 +879,6 @@ static const JanetMethod net_stream_methods[] = {
     {"accept-loop", cfun_stream_accept_loop},
     {"send-to", cfun_stream_send_to},
     {"recv-from", cfun_stream_recv_from},
-    {"recv-from", cfun_stream_recv_from},
     {"evread", janet_cfun_stream_read},
     {"evchunk", janet_cfun_stream_chunk},
     {"evwrite", janet_cfun_stream_write},
@@ -672,101 +890,26 @@ static JanetStream *make_stream(JSock handle, uint32_t flags) {
     return janet_stream((JanetHandle) handle, flags | JANET_STREAM_SOCKET, net_stream_methods);
 }
 
-static const JanetReg net_cfuns[] = {
-    {
-        "net/address", cfun_net_sockaddr,
-        JDOC("(net/address host port &opt type)\n\n"
-             "Look up the connection information for a given hostname, port, and connection type. Returns "
-             "a handle that can be used to send datagrams over network without establishing a connection. "
-             "On Posix platforms, you can use :unix for host to connect to a unix domain socket, where the name is "
-             "given in the port argument. On Linux, abstract "
-             "unix domain sockets are specified with a leading '@' character in port.")
-    },
-    {
-        "net/listen", cfun_net_listen,
-        JDOC("(net/listen host port &opt type)\n\n"
-             "Creates a server. Returns a new stream that is neither readable nor "
-             "writeable. Use net/accept or net/accept-loop be to handle connections and start the server. "
-             "The type parameter specifies the type of network connection, either "
-             "a :stream (usually tcp), or :datagram (usually udp). If not specified, the default is "
-             ":stream. The host and port arguments are the same as in net/address.")
-    },
-    {
-        "net/accept", cfun_stream_accept,
-        JDOC("(net/accept stream &opt timeout)\n\n"
-             "Get the next connection on a server stream. This would usually be called in a loop in a dedicated fiber. "
-             "Takes an optional timeout in seconds, after which will return nil. "
-             "Returns a new duplex stream which represents a connection to the client.")
-    },
-    {
-        "net/accept-loop", cfun_stream_accept_loop,
-        JDOC("(net/accept-loop stream handler)\n\n"
-             "Shorthand for running a server stream that will continuously accept new connections. "
-             "Blocks the current fiber until the stream is closed, and will return the stream.")
-    },
-    {
-        "net/read", cfun_stream_read,
-        JDOC("(net/read stream nbytes &opt buf timeout)\n\n"
-             "Read up to n bytes from a stream, suspending the current fiber until the bytes are available. "
-             "`n` can also be the keyword `:all` to read into the buffer until end of stream. "
-             "If less than n bytes are available (and more than 0), will push those bytes and return early. "
-             "Takes an optional timeout in seconds, after which will return nil. "
-             "Returns a buffer with up to n more bytes in it, or raises an error if the read failed.")
-    },
-    {
-        "net/chunk", cfun_stream_chunk,
-        JDOC("(net/chunk stream nbytes &opt buf timeout)\n\n"
-             "Same a net/read, but will wait for all n bytes to arrive rather than return early. "
-             "Takes an optional timeout in seconds, after which will return nil.")
-    },
-    {
-        "net/write", cfun_stream_write,
-        JDOC("(net/write stream data &opt timeout)\n\n"
-             "Write data to a stream, suspending the current fiber until the write "
-             "completes. Takes an optional timeout in seconds, after which will return nil. "
-             "Returns nil, or raises an error if the write failed.")
-    },
-    {
-        "net/send-to", cfun_stream_send_to,
-        JDOC("(net/send-to stream dest data &opt timeout)\n\n"
-             "Writes a datagram to a server stream. dest is a the destination address of the packet. "
-             "Takes an optional timeout in seconds, after which will return nil. "
-             "Returns stream.")
-    },
-    {
-        "net/recv-from", cfun_stream_recv_from,
-        JDOC("(net/recv-from stream nbytes buf &opt timoeut)\n\n"
-             "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.")
-    },
-    {
-        "net/flush", cfun_stream_flush,
-        JDOC("(net/flush stream)\n\n"
-             "Make sure that a stream is not buffering any data. This temporarily disables Nagle's algorithm. "
-             "Use this to make sure data is sent without delay. Returns stream.")
-    },
-    {
-        "net/connect", cfun_net_connect,
-        JDOC("(net/connect host port &opt type)\n\n"
-             "Open a connection to communicate with a server. Returns a duplex stream "
-             "that can be used to communicate with the server. Type is an optional keyword "
-             "to specify a connection type, either :stream or :datagram. The default is :stream. ")
-    },
-    {
-        "net/shutdown", cfun_net_shutdown,
-        JDOC("(net/shutdown stream &opt mode)\n\n"
-             "Stop communication on this socket in a graceful manner, either in both directions or just "
-             "reading/writing from the stream. The `mode` parameter controls which communication to stop on the socket. "
-             "\n\n* `:wr` is the default and prevents both reading new data from the socket and writing new data to the socket.\n"
-             "* `:r` disables reading new data from the socket.\n"
-             "* `:w` disable writing data to the socket.\n\n"
-             "Returns the original socket.")
-    },
-    {NULL, NULL, NULL}
-};
-
 void janet_lib_net(JanetTable *env) {
-    janet_core_cfuns(env, NULL, net_cfuns);
+    JanetRegExt net_cfuns[] = {
+        JANET_CORE_REG("net/address", cfun_net_sockaddr),
+        JANET_CORE_REG("net/listen", cfun_net_listen),
+        JANET_CORE_REG("net/accept", cfun_stream_accept),
+        JANET_CORE_REG("net/accept-loop", cfun_stream_accept_loop),
+        JANET_CORE_REG("net/read", cfun_stream_read),
+        JANET_CORE_REG("net/chunk", cfun_stream_chunk),
+        JANET_CORE_REG("net/write", cfun_stream_write),
+        JANET_CORE_REG("net/send-to", cfun_stream_send_to),
+        JANET_CORE_REG("net/recv-from", cfun_stream_recv_from),
+        JANET_CORE_REG("net/flush", cfun_stream_flush),
+        JANET_CORE_REG("net/connect", cfun_net_connect),
+        JANET_CORE_REG("net/shutdown", cfun_net_shutdown),
+        JANET_CORE_REG("net/peername", cfun_net_getpeername),
+        JANET_CORE_REG("net/localname", cfun_net_getsockname),
+        JANET_CORE_REG("net/address-unpack", cfun_net_address_unpack),
+        JANET_REG_END
+    };
+    janet_core_cfuns_ext(env, NULL, net_cfuns);
 }
 
 void janet_net_init(void) {

src/core/parse.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
@@ -51,15 +51,15 @@ static const uint32_t symchars[8] = {
 };
 
 /* Check if a character is a valid symbol character
- * symbol chars are A-Z, a-z, 0-9, or one of !$&*+-./:<=>@\^_~| */
-static int is_symbol_char(uint8_t c) {
+ * symbol chars are A-Z, a-z, 0-9, or one of !$&*+-./:<=>@\^_| */
+int janet_is_symbol_char(uint8_t c) {
     return symchars[c >> 5] & ((uint32_t)1 << (c & 0x1F));
 }
 
 /* Validate some utf8. Useful for identifiers. Only validates
  * the encoding, does not check for valid code points (they
  * are less well defined than the encoding). */
-static int valid_utf8(const uint8_t *str, int32_t len) {
+int janet_valid_utf8(const uint8_t *str, int32_t len) {
     int32_t i = 0;
     int32_t j;
     while (i < len) {
@@ -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:
@@ -411,7 +442,7 @@ static int tokenchar(JanetParser *p, JanetParseState *state, uint8_t c) {
     Janet ret;
     double numval;
     int32_t blen;
-    if (is_symbol_char(c)) {
+    if (janet_is_symbol_char(c)) {
         push_buf(p, (uint8_t) c);
         if (c > 127) state->argn = 1; /* Use to indicate non ascii */
         return 1;
@@ -422,7 +453,7 @@ static int tokenchar(JanetParser *p, JanetParseState *state, uint8_t c) {
     int start_num = start_dig || p->buf[0] == '-' || p->buf[0] == '+' || p->buf[0] == '.';
     if (p->buf[0] == ':') {
         /* Don't do full utf-8 check unless we have seen non ascii characters. */
-        int valid = (!state->argn) || valid_utf8(p->buf + 1, blen - 1);
+        int valid = (!state->argn) || janet_valid_utf8(p->buf + 1, blen - 1);
         if (!valid) {
             p->error = "invalid utf-8 in keyword";
             return 0;
@@ -442,7 +473,7 @@ static int tokenchar(JanetParser *p, JanetParseState *state, uint8_t c) {
             return 0;
         } else {
             /* Don't do full utf-8 check unless we have seen non ascii characters. */
-            int valid = (!state->argn) || valid_utf8(p->buf, blen);
+            int valid = (!state->argn) || janet_valid_utf8(p->buf, blen);
             if (!valid) {
                 p->error = "invalid utf-8 in symbol";
                 return 0;
@@ -582,7 +613,7 @@ static int root(JanetParser *p, JanetParseState *state, uint8_t c) {
     switch (c) {
         default:
             if (is_whitespace(c)) return 1;
-            if (!is_symbol_char(c)) {
+            if (!janet_is_symbol_char(c)) {
                 p->error = "unexpected character";
                 return 1;
             }
@@ -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;
@@ -746,6 +758,7 @@ Janet janet_parser_produce(JanetParser *parser) {
     }
     parser->pending--;
     parser->argcount--;
+    parser->states[0].argn--;
     return ret;
 }
 
@@ -759,6 +772,7 @@ Janet janet_parser_produce_wrapped(JanetParser *parser) {
     }
     parser->pending--;
     parser->argcount--;
+    parser->states[0].argn--;
     return ret;
 }
 
@@ -878,7 +892,10 @@ const JanetAbstractType janet_parser_type = {
 };
 
 /* C Function parser */
-static Janet cfun_parse_parser(int32_t argc, Janet *argv) {
+JANET_CORE_FN(cfun_parse_parser,
+              "(parser/new)",
+              "Creates and returns a new parser object. Parsers are state machines "
+              "that can receive bytes and generate a stream of values.") {
     (void) argv;
     janet_fixarity(argc, 0);
     JanetParser *p = janet_abstract(&janet_parser_type, sizeof(JanetParser));
@@ -886,7 +903,11 @@ static Janet cfun_parse_parser(int32_t argc, Janet *argv) {
     return janet_wrap_abstract(p);
 }
 
-static Janet cfun_parse_consume(int32_t argc, Janet *argv) {
+JANET_CORE_FN(cfun_parse_consume,
+              "(parser/consume parser bytes &opt index)",
+              "Input bytes into the parser and parse them. Will not throw errors "
+              "if there is a parse error. Starts at the byte index given by `index`. Returns "
+              "the number of bytes read.") {
     janet_arity(argc, 2, 3);
     JanetParser *p = janet_getabstract(argv, 0, &janet_parser_type);
     JanetByteView view = janet_getbytes(argv, 1);
@@ -911,14 +932,20 @@ static Janet cfun_parse_consume(int32_t argc, Janet *argv) {
     return janet_wrap_integer(i);
 }
 
-static Janet cfun_parse_eof(int32_t argc, Janet *argv) {
+JANET_CORE_FN(cfun_parse_eof,
+              "(parser/eof parser)",
+              "Indicate to the parser that the end of file was reached. This puts the parser in the :dead state.") {
     janet_fixarity(argc, 1);
     JanetParser *p = janet_getabstract(argv, 0, &janet_parser_type);
     janet_parser_eof(p);
     return argv[0];
 }
 
-static Janet cfun_parse_insert(int32_t argc, Janet *argv) {
+JANET_CORE_FN(cfun_parse_insert,
+              "(parser/insert parser value)",
+              "Insert a value into the parser. This means that the parser state can be manipulated "
+              "in between chunks of bytes. This would allow a user to add extra elements to arrays "
+              "and tuples, for example. Returns the parser.") {
     janet_fixarity(argc, 2);
     JanetParser *p = janet_getabstract(argv, 0, &janet_parser_type);
     JanetParseState *s = p->states + p->statecount - 1;
@@ -957,13 +984,17 @@ static Janet cfun_parse_insert(int32_t argc, Janet *argv) {
     return argv[0];
 }
 
-static Janet cfun_parse_has_more(int32_t argc, Janet *argv) {
+JANET_CORE_FN(cfun_parse_has_more,
+              "(parser/has-more parser)",
+              "Check if the parser has more values in the value queue.") {
     janet_fixarity(argc, 1);
     JanetParser *p = janet_getabstract(argv, 0, &janet_parser_type);
     return janet_wrap_boolean(janet_parser_has_more(p));
 }
 
-static Janet cfun_parse_byte(int32_t argc, Janet *argv) {
+JANET_CORE_FN(cfun_parse_byte,
+              "(parser/byte parser b)",
+              "Input a single byte `b` into the parser byte stream. Returns the parser.") {
     janet_fixarity(argc, 2);
     JanetParser *p = janet_getabstract(argv, 0, &janet_parser_type);
     int32_t i = janet_getinteger(argv, 1);
@@ -971,7 +1002,13 @@ static Janet cfun_parse_byte(int32_t argc, Janet *argv) {
     return argv[0];
 }
 
-static Janet cfun_parse_status(int32_t argc, Janet *argv) {
+JANET_CORE_FN(cfun_parse_status,
+              "(parser/status parser)",
+              "Gets the current status of the parser state machine. The status will "
+              "be one of:\n\n"
+              "* :pending - a value is being parsed.\n\n"
+              "* :error - a parsing error was encountered.\n\n"
+              "* :root - the parser can either read more values or safely terminate.") {
     janet_fixarity(argc, 1);
     JanetParser *p = janet_getabstract(argv, 0, &janet_parser_type);
     const char *stat = NULL;
@@ -992,7 +1029,12 @@ static Janet cfun_parse_status(int32_t argc, Janet *argv) {
     return janet_ckeywordv(stat);
 }
 
-static Janet cfun_parse_error(int32_t argc, Janet *argv) {
+JANET_CORE_FN(cfun_parse_error,
+              "(parser/error parser)",
+              "If the parser is in the error state, returns the message associated with "
+              "that error. Otherwise, returns nil. Also flushes the parser state and parser "
+              "queue, so be sure to handle everything in the queue before calling "
+              "`parser/error`.") {
     janet_fixarity(argc, 1);
     JanetParser *p = janet_getabstract(argv, 0, &janet_parser_type);
     const char *err = janet_parser_error(p);
@@ -1004,7 +1046,13 @@ static Janet cfun_parse_error(int32_t argc, Janet *argv) {
     return janet_wrap_nil();
 }
 
-static Janet cfun_parse_produce(int32_t argc, Janet *argv) {
+JANET_CORE_FN(cfun_parse_produce,
+              "(parser/produce parser &opt wrap)",
+              "Dequeue the next value in the parse queue. Will return nil if "
+              "no parsed values are in the queue, otherwise will dequeue the "
+              "next value. If `wrap` is truthy, will return a 1-element tuple that "
+              "wraps the result. This tuple can be used for source-mapping "
+              "purposes.") {
     janet_arity(argc, 1, 2);
     JanetParser *p = janet_getabstract(argv, 0, &janet_parser_type);
     if (argc == 2 && janet_truthy(argv[1])) {
@@ -1014,14 +1062,22 @@ static Janet cfun_parse_produce(int32_t argc, Janet *argv) {
     }
 }
 
-static Janet cfun_parse_flush(int32_t argc, Janet *argv) {
+JANET_CORE_FN(cfun_parse_flush,
+              "(parser/flush parser)",
+              "Clears the parser state and parse queue. Can be used to reset the parser "
+              "if an error was encountered. Does not reset the line and column counter, so "
+              "to begin parsing in a new context, create a new parser.") {
     janet_fixarity(argc, 1);
     JanetParser *p = janet_getabstract(argv, 0, &janet_parser_type);
     janet_parser_flush(p);
     return argv[0];
 }
 
-static Janet cfun_parse_where(int32_t argc, Janet *argv) {
+JANET_CORE_FN(cfun_parse_where,
+              "(parser/where parser &opt line col)",
+              "Returns the current line number and column of the parser's internal state. If line is "
+              "provided, the current line number of the parser is first set to that value. If column is "
+              "also provided, the current column number of the parser is also first set to that value.") {
     janet_arity(argc, 1, 3);
     JanetParser *p = janet_getabstract(argv, 0, &janet_parser_type);
     if (argc > 1) {
@@ -1051,8 +1107,9 @@ static Janet janet_wrap_parse_state(JanetParseState *s, Janet *args,
 
     if (s->flags & PFLAG_CONTAINER) {
         JanetArray *container_args = janet_array(s->argn);
-        container_args->count = s->argn;
-        safe_memcpy(container_args->data, args, sizeof(args[0])*s->argn);
+        for (int32_t i = 0; i < s->argn; i++) {
+            janet_array_push(container_args, args[i]);
+        }
         janet_table_put(state, janet_ckeywordv("args"),
                         janet_wrap_array(container_args));
     }
@@ -1147,11 +1204,14 @@ static Janet parser_state_frames(const JanetParser *p) {
     JanetArray *states = janet_array(count);
     states->count = count;
     uint8_t *buf = p->buf;
-    Janet *args = p->args;
+    /* Iterate arg stack backwards */
+    Janet *args = p->args + p->argcount;
     for (int32_t i = count - 1; i >= 0; --i) {
         JanetParseState *s = p->states + i;
+        if (s->flags & PFLAG_CONTAINER) {
+            args -= s->argn;
+        }
         states->data[i] = janet_wrap_parse_state(s, args, buf, (uint32_t) p->bufcount);
-        args -= s->argn;
     }
     return janet_wrap_array(states);
 }
@@ -1162,7 +1222,16 @@ static const struct ParserStateGetter parser_state_getters[] = {
     {NULL, NULL}
 };
 
-static Janet cfun_parse_state(int32_t argc, Janet *argv) {
+JANET_CORE_FN(cfun_parse_state,
+              "(parser/state parser &opt key)",
+              "Returns a representation of the internal state of the parser. If a key is passed, "
+              "only that information about the state is returned. Allowed keys are:\n\n"
+              "* :delimiters - Each byte in the string represents a nested data structure. For example, "
+              "if the parser state is '([\"', then the parser is in the middle of parsing a "
+              "string inside of square brackets inside parentheses. Can be used to augment a REPL prompt.\n\n"
+              "* :frames - Each table in the array represents a 'frame' in the parser state. Frames "
+              "contain information about the start of the expression being parsed as well as the "
+              "type of that expression and some type-specific information.") {
     janet_arity(argc, 1, 2);
     const uint8_t *key = NULL;
     JanetParser *p = janet_getabstract(argv, 0, &janet_parser_type);
@@ -1190,7 +1259,11 @@ static Janet cfun_parse_state(int32_t argc, Janet *argv) {
     }
 }
 
-static Janet cfun_parse_clone(int32_t argc, Janet *argv) {
+JANET_CORE_FN(cfun_parse_clone,
+              "(parser/clone p)",
+              "Creates a deep clone of a parser that is identical to the input parser. "
+              "This cloned parser can be used to continue parsing from a good checkpoint "
+              "if parsing later fails. Returns a new parser.") {
     janet_fixarity(argc, 1);
     JanetParser *src = janet_getabstract(argv, 0, &janet_parser_type);
     JanetParser *dest = janet_abstract(&janet_parser_type, sizeof(JanetParser));
@@ -1225,105 +1298,23 @@ static Janet parsernext(void *p, Janet key) {
     return janet_nextmethod(parser_methods, key);
 }
 
-static const JanetReg parse_cfuns[] = {
-    {
-        "parser/new", cfun_parse_parser,
-        JDOC("(parser/new)\n\n"
-             "Creates and returns a new parser object. Parsers are state machines "
-             "that can receive bytes, and generate a stream of values.")
-    },
-    {
-        "parser/clone", cfun_parse_clone,
-        JDOC("(parser/clone p)\n\n"
-             "Creates a deep clone of a parser that is identical to the input parser. "
-             "This cloned parser can be used to continue parsing from a good checkpoint "
-             "if parsing later fails. Returns a new parser.")
-    },
-    {
-        "parser/has-more", cfun_parse_has_more,
-        JDOC("(parser/has-more parser)\n\n"
-             "Check if the parser has more values in the value queue.")
-    },
-    {
-        "parser/produce", cfun_parse_produce,
-        JDOC("(parser/produce parser &opt wrap)\n\n"
-             "Dequeue the next value in the parse queue. Will return nil if "
-             "no parsed values are in the queue, otherwise will dequeue the "
-             "next value. If `wrap` is truthy, will return a 1-element tuple that "
-             "wraps the result. This tuple can be used for source-mapping "
-             "purposes.")
-    },
-    {
-        "parser/consume", cfun_parse_consume,
-        JDOC("(parser/consume parser bytes &opt index)\n\n"
-             "Input bytes into the parser and parse them. Will not throw errors "
-             "if there is a parse error. Starts at the byte index given by index. Returns "
-             "the number of bytes read.")
-    },
-    {
-        "parser/byte", cfun_parse_byte,
-        JDOC("(parser/byte parser b)\n\n"
-             "Input a single byte into the parser byte stream. Returns the parser.")
-    },
-    {
-        "parser/error", cfun_parse_error,
-        JDOC("(parser/error parser)\n\n"
-             "If the parser is in the error state, returns the message associated with "
-             "that error. Otherwise, returns nil. Also flushes the parser state and parser "
-             "queue, so be sure to handle everything in the queue before calling "
-             "parser/error.")
-    },
-    {
-        "parser/status", cfun_parse_status,
-        JDOC("(parser/status parser)\n\n"
-             "Gets the current status of the parser state machine. The status will "
-             "be one of:\n\n"
-             "* :pending - a value is being parsed.\n\n"
-             "* :error - a parsing error was encountered.\n\n"
-             "* :root - the parser can either read more values or safely terminate.")
-    },
-    {
-        "parser/flush", cfun_parse_flush,
-        JDOC("(parser/flush parser)\n\n"
-             "Clears the parser state and parse queue. Can be used to reset the parser "
-             "if an error was encountered. Does not reset the line and column counter, so "
-             "to begin parsing in a new context, create a new parser.")
-    },
-    {
-        "parser/state", cfun_parse_state,
-        JDOC("(parser/state parser &opt key)\n\n"
-             "Returns a representation of the internal state of the parser. If a key is passed, "
-             "only that information about the state is returned. Allowed keys are:\n\n"
-             "* :delimiters - Each byte in the string represents a nested data structure. For example, "
-             "if the parser state is '([\"', then the parser is in the middle of parsing a "
-             "string inside of square brackets inside parentheses. Can be used to augment a REPL prompt.\n\n"
-             "* :frames - Each table in the array represents a 'frame' in the parser state. Frames "
-             "contain information about the start of the expression being parsed as well as the "
-             "type of that expression and some type-specific information.")
-    },
-    {
-        "parser/where", cfun_parse_where,
-        JDOC("(parser/where parser &opt line col)\n\n"
-             "Returns the current line number and column of the parser's internal state. If line is "
-             "provided, the current line number of the parser is first set to that value. If column is "
-             "also provided, the current column number of the parser is also first set to that value.")
-    },
-    {
-        "parser/eof", cfun_parse_eof,
-        JDOC("(parser/eof parser)\n\n"
-             "Indicate that the end of file was reached to the parser. This puts the parser in the :dead state.")
-    },
-    {
-        "parser/insert", cfun_parse_insert,
-        JDOC("(parser/insert parser value)\n\n"
-             "Insert a value into the parser. This means that the parser state can be manipulated "
-             "in between chunks of bytes. This would allow a user to add extra elements to arrays "
-             "and tuples, for example. Returns the parser.")
-    },
-    {NULL, NULL, NULL}
-};
-
 /* Load the library */
 void janet_lib_parse(JanetTable *env) {
-    janet_core_cfuns(env, NULL, parse_cfuns);
+    JanetRegExt parse_cfuns[] = {
+        JANET_CORE_REG("parser/new", cfun_parse_parser),
+        JANET_CORE_REG("parser/clone", cfun_parse_clone),
+        JANET_CORE_REG("parser/has-more", cfun_parse_has_more),
+        JANET_CORE_REG("parser/produce", cfun_parse_produce),
+        JANET_CORE_REG("parser/consume", cfun_parse_consume),
+        JANET_CORE_REG("parser/byte", cfun_parse_byte),
+        JANET_CORE_REG("parser/error", cfun_parse_error),
+        JANET_CORE_REG("parser/status", cfun_parse_status),
+        JANET_CORE_REG("parser/flush", cfun_parse_flush),
+        JANET_CORE_REG("parser/state", cfun_parse_state),
+        JANET_CORE_REG("parser/where", cfun_parse_where),
+        JANET_CORE_REG("parser/eof", cfun_parse_eof),
+        JANET_CORE_REG("parser/insert", cfun_parse_insert),
+        JANET_REG_END
+    };
+    janet_core_cfuns_ext(env, NULL, parse_cfuns);
 }

src/core/peg.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
@@ -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) {
@@ -293,6 +316,7 @@ tail:
                     if (rule[0] == RULE_TO) cap_load(s, cs2);
                     break;
                 }
+                cap_load(s, cs2);
                 text++;
             }
             up1(s);
@@ -387,6 +411,25 @@ tail:
             return result;
         }
 
+        case RULE_CAPTURE_NUM: {
+            down1(s);
+            const uint8_t *result = peg_rule(s, s->bytecode + rule[1], text);
+            up1(s);
+            if (!result) return NULL;
+            /* check number parsing */
+            double x = 0.0;
+            int32_t base = (int32_t) rule[2];
+            if (janet_scan_number_base(text, (int32_t)(result - text), base, &x)) return NULL;
+            /* Specialized pushcap - avoid intermediate string creation */
+            if (!s->has_backref && s->mode == PEG_MODE_ACCUMULATE) {
+                janet_buffer_push_bytes(s->scratch, text, (int32_t)(result - text));
+            } else {
+                uint32_t tag = rule[3];
+                pushcap(s, janet_wrap_number(x), tag);
+            }
+            return result;
+        }
+
         case RULE_ACCUMULATE: {
             uint32_t tag = rule[2];
             int oldmode = s->mode;
@@ -975,6 +1018,25 @@ static void spec_unref(Builder *b, int32_t argc, const Janet *argv) {
     spec_cap1(b, argc, argv, RULE_UNREF);
 }
 
+static void spec_capture_number(Builder *b, int32_t argc, const Janet *argv) {
+    peg_arity(b, argc, 1, 3);
+    Reserve r = reserve(b, 4);
+    uint32_t base = 0;
+    if (argc >= 2) {
+        if (!janet_checktype(argv[1], JANET_NIL)) {
+            if (!janet_checkint(argv[1])) goto error;
+            base = (uint32_t) janet_unwrap_integer(argv[1]);
+            if (base < 2 || base > 36) goto error;
+        }
+    }
+    uint32_t tag = (argc == 3) ? emit_tag(b, argv[2]) : 0;
+    uint32_t rule = peg_compile1(b, argv[0]);
+    emit_3(r, RULE_CAPTURE_NUM, rule, base, tag);
+    return;
+error:
+    peg_panicf(b, "expected integer between 2 and 36, got %v", argv[2]);
+}
+
 static void spec_reference(Builder *b, int32_t argc, const Janet *argv) {
     peg_arity(b, argc, 1, 2);
     Reserve r = reserve(b, 3);
@@ -1118,6 +1180,7 @@ static const SpecialPair peg_specials[] = {
     {"line", spec_line},
     {"look", spec_look},
     {"not", spec_not},
+    {"number", spec_capture_number},
     {"opt", spec_opt},
     {"position", spec_position},
     {"quote", spec_capture},
@@ -1214,6 +1277,18 @@ static uint32_t peg_compile1(Builder *b, Janet peg) {
             emit_bytes(b, RULE_LITERAL, len, str);
             break;
         }
+        case JANET_TABLE: {
+            /* Build grammar table */
+            JanetTable *new_grammar = janet_table_clone(janet_unwrap_table(peg));
+            new_grammar->proto = grammar;
+            b->grammar = grammar = new_grammar;
+            /* Run the main rule */
+            Janet main_rule = janet_table_rawget(grammar, janet_ckeywordv("main"));
+            if (janet_checktype(main_rule, JANET_NIL))
+                peg_panic(b, "grammar requires :main rule");
+            rule = peg_compile1(b, main_rule);
+            break;
+        }
         case JANET_STRUCT: {
             /* Build grammar table */
             const JanetKV *st = janet_unwrap_struct(peg);
@@ -1419,6 +1494,12 @@ static void *peg_unmarshal(JanetMarshalContext *ctx) {
                 if (rule[1] >= clen) goto bad;
                 i += 3;
                 break;
+            case RULE_CAPTURE_NUM:
+                /* [rule, base, tag] */
+                if (rule[1] >= blen) goto bad;
+                op_flags[rule[1]] |= 0x01;
+                i += 4;
+                break;
             case RULE_ACCUMULATE:
             case RULE_GROUP:
             case RULE_CAPTURE:
@@ -1541,7 +1622,11 @@ static JanetPeg *compile_peg(Janet x) {
  * C Functions
  */
 
-static Janet cfun_peg_compile(int32_t argc, Janet *argv) {
+JANET_CORE_FN(cfun_peg_compile,
+              "(peg/compile peg)",
+              "Compiles a peg source data structure into a <core/peg>. This will speed up matching "
+              "if the same peg will be used multiple times. Will also use `(dyn :peg-grammar)` to suppliment "
+              "the grammar of the peg for otherwise undefined peg keywords.") {
     janet_fixarity(argc, 1);
     JanetPeg *peg = compile_peg(argv[0]);
     return janet_wrap_abstract(peg);
@@ -1599,18 +1684,25 @@ 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;
 }
 
-static Janet cfun_peg_match(int32_t argc, Janet *argv) {
+JANET_CORE_FN(cfun_peg_match,
+              "(peg/match peg text &opt start & args)",
+              "Match a Parsing Expression Grammar to a byte string and return an array of captured values. "
+              "Returns nil if text does not match the language defined by peg. The syntax of PEGs is documented on the Janet website.") {
     PegCall c = peg_cfun_init(argc, argv, 0);
     const uint8_t *result = peg_rule(&c.s, c.s.bytecode, c.bytes.bytes + c.start);
     return result ? janet_wrap_array(c.s.captures) : janet_wrap_nil();
 }
 
-static Janet cfun_peg_find(int32_t argc, Janet *argv) {
+JANET_CORE_FN(cfun_peg_find,
+              "(peg/find peg text &opt start & args)",
+              "Find first index where the peg matches in text. Returns an integer, or nil if not found.") {
     PegCall c = peg_cfun_init(argc, argv, 0);
     for (int32_t i = c.start; i < c.bytes.len; i++) {
         peg_call_reset(&c);
@@ -1620,7 +1712,9 @@ static Janet cfun_peg_find(int32_t argc, Janet *argv) {
     return janet_wrap_nil();
 }
 
-static Janet cfun_peg_find_all(int32_t argc, Janet *argv) {
+JANET_CORE_FN(cfun_peg_find_all,
+              "(peg/find-all peg text &opt start & args)",
+              "Find all indexes where the peg matches in text. Returns an array of integers.") {
     PegCall c = peg_cfun_init(argc, argv, 0);
     JanetArray *ret = janet_array(0);
     for (int32_t i = c.start; i < c.bytes.len; i++) {
@@ -1659,11 +1753,16 @@ static Janet cfun_peg_replace_generic(int32_t argc, Janet *argv, int only_one) {
     return janet_wrap_buffer(ret);
 }
 
-static Janet cfun_peg_replace_all(int32_t argc, Janet *argv) {
+JANET_CORE_FN(cfun_peg_replace_all,
+              "(peg/replace-all peg repl text &opt start & args)",
+              "Replace all matches of peg in text with repl, returning a new buffer. The peg does not need to make captures to do replacement.") {
     return cfun_peg_replace_generic(argc, argv, 0);
 }
 
-static Janet cfun_peg_replace(int32_t argc, Janet *argv) {
+JANET_CORE_FN(cfun_peg_replace,
+              "(peg/replace peg repl text &opt start & args)",
+              "Replace first match of peg in text with repl, returning a new buffer. The peg does not need to make captures to do replacement. "
+              "If no matches are found, returns the input string in a new buffer.") {
     return cfun_peg_replace_generic(argc, argv, 1);
 }
 
@@ -1688,47 +1787,18 @@ static Janet peg_next(void *p, Janet key) {
     return janet_nextmethod(peg_methods, key);
 }
 
-static const JanetReg peg_cfuns[] = {
-    {
-        "peg/compile", cfun_peg_compile,
-        JDOC("(peg/compile peg)\n\n"
-             "Compiles a peg source data structure into a <core/peg>. This will speed up matching "
-             "if the same peg will be used multiple times. Will also use `(dyn :peg-grammar)` to suppliment "
-             "the grammar of the peg for otherwise undefined peg keywords.")
-    },
-    {
-        "peg/match", cfun_peg_match,
-        JDOC("(peg/match peg text &opt start & args)\n\n"
-             "Match a Parsing Expression Grammar to a byte string and return an array of captured values. "
-             "Returns nil if text does not match the language defined by peg. The syntax of PEGs is documented on the Janet website.")
-    },
-    {
-        "peg/find", cfun_peg_find,
-        JDOC("(peg/find peg text &opt start & args)\n\n"
-             "Find first index where the peg matches in text. Returns an integer, or nil if not found.")
-    },
-    {
-        "peg/find-all", cfun_peg_find_all,
-        JDOC("(peg/find-all peg text &opt start & args)\n\n"
-             "Find all indexes where the peg matches in text. Returns an array of integers.")
-    },
-    {
-        "peg/replace", cfun_peg_replace,
-        JDOC("(peg/replace peg repl text &opt start & args)\n\n"
-             "Replace first match of peg in text with repl, returning a new buffer. The peg does not need to make captures to do replacement. "
-             "If no matches are found, returns the input string in a new buffer.")
-    },
-    {
-        "peg/replace-all", cfun_peg_replace_all,
-        JDOC("(peg/replace-all peg repl text &opt start & args)\n\n"
-             "Replace all matches of peg in text with repl, returning a new buffer. The peg does not need to make captures to do replacement.")
-    },
-    {NULL, NULL, NULL}
-};
-
 /* Load the peg module */
 void janet_lib_peg(JanetTable *env) {
-    janet_core_cfuns(env, NULL, peg_cfuns);
+    JanetRegExt cfuns[] = {
+        JANET_CORE_REG("peg/compile", cfun_peg_compile),
+        JANET_CORE_REG("peg/match", cfun_peg_match),
+        JANET_CORE_REG("peg/find", cfun_peg_find),
+        JANET_CORE_REG("peg/find-all", cfun_peg_find_all),
+        JANET_CORE_REG("peg/replace", cfun_peg_replace),
+        JANET_CORE_REG("peg/replace-all", cfun_peg_replace_all),
+        JANET_REG_END
+    };
+    janet_core_cfuns_ext(env, NULL, cfuns);
     janet_register_abstract_type(&janet_peg_type);
 }
 

src/core/pp.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
@@ -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';
@@ -227,12 +228,14 @@ void janet_to_string_b(JanetBuffer *buffer, Janet x) {
         }
         return;
         case JANET_CFUNCTION: {
-            Janet check = janet_table_get(janet_vm_registry, x);
-            if (janet_checktype(check, JANET_SYMBOL)) {
+            JanetCFunRegistry *reg = janet_registry_get(janet_unwrap_cfunction(x));
+            if (NULL != reg) {
                 janet_buffer_push_cstring(buffer, "<cfunction ");
-                janet_buffer_push_bytes(buffer,
-                                        janet_unwrap_symbol(check),
-                                        janet_string_length(janet_unwrap_symbol(check)));
+                if (NULL != reg->name_prefix) {
+                    janet_buffer_push_cstring(buffer, reg->name_prefix);
+                    janet_buffer_push_u8(buffer, '/');
+                }
+                janet_buffer_push_cstring(buffer, reg->name);
                 janet_buffer_push_u8(buffer, '>');
                 break;
             }
@@ -259,21 +262,13 @@ void janet_to_string_b(JanetBuffer *buffer, Janet x) {
 
 /* See parse.c for full table */
 
-static const uint32_t pp_symchars[8] = {
-    0x00000000, 0xf7ffec72, 0xc7ffffff, 0x07fffffe,
-    0x00000000, 0x00000000, 0x00000000, 0x00000000
-};
-
-static int pp_is_symbol_char(uint8_t c) {
-    return pp_symchars[c >> 5] & ((uint32_t)1 << (c & 0x1F));
-}
-
 /* Check if a symbol or keyword contains no symbol characters */
 static int contains_bad_chars(const uint8_t *sym, int issym) {
     int32_t len = janet_string_length(sym);
     if (len && issym && sym[0] >= '0' && sym[0] <= '9') return 1;
+    if (!janet_valid_utf8(sym, len)) return 1;
     for (int32_t i = 0; i < len; i++) {
-        if (!pp_is_symbol_char(sym[i])) return 1;
+        if (!janet_is_symbol_char(sym[i])) return 1;
     }
     return 0;
 }
@@ -568,12 +563,12 @@ static void janet_pretty_one(struct pretty *S, Janet x, int is_dict_value) {
         case JANET_STRUCT:
         case JANET_TABLE: {
             int istable = janet_checktype(x, JANET_TABLE);
-            janet_buffer_push_cstring(S->buffer, istable ? "@" : "{");
 
             /* For object-like tables, print class name */
             if (istable) {
                 JanetTable *t = janet_unwrap_table(x);
                 JanetTable *proto = t->proto;
+                janet_buffer_push_cstring(S->buffer, "@");
                 if (NULL != proto) {
                     Janet name = janet_table_get(proto, janet_ckeywordv("_name"));
                     const uint8_t *n;
@@ -588,8 +583,25 @@ static void janet_pretty_one(struct pretty *S, Janet x, int is_dict_value) {
                         }
                     }
                 }
-                janet_buffer_push_cstring(S->buffer, "{");
+            } else {
+                JanetStruct st = janet_unwrap_struct(x);
+                JanetStruct proto = janet_struct_proto(st);
+                if (NULL != proto) {
+                    Janet name = janet_struct_get(proto, janet_ckeywordv("_name"));
+                    const uint8_t *n;
+                    int32_t len;
+                    if (janet_bytes_view(name, &n, &len)) {
+                        if (S->flags & JANET_PRETTY_COLOR) {
+                            janet_buffer_push_cstring(S->buffer, janet_class_color);
+                        }
+                        janet_buffer_push_bytes(S->buffer, n, len);
+                        if (S->flags & JANET_PRETTY_COLOR) {
+                            janet_buffer_push_cstring(S->buffer, "\x1B[0m");
+                        }
+                    }
+                }
             }
+            janet_buffer_push_cstring(S->buffer, "{");
 
             S->depth--;
             S->indent += 2;
@@ -739,20 +751,46 @@ static void pushtypes(JanetBuffer *buffer, int types) {
 
 #define MAX_ITEM  256
 #define FMT_FLAGS "-+ #0"
+#define FMT_REPLACE_INTTYPES "diouxX"
 #define MAX_FORMAT 32
 
+struct FmtMapping {
+    char c;
+    const char *mapping;
+};
+
+/* Janet uses fixed width integer types for most things, so map
+ * format specifiers to these fixed sizes */
+static const struct FmtMapping format_mappings[] = {
+    {'d', PRId64},
+    {'i', PRIi64},
+    {'o', PRIo64},
+    {'u', PRIu64},
+    {'x', PRIx64},
+    {'X', PRIX64},
+};
+
+static const char *get_fmt_mapping(char c) {
+    for (size_t i = 0; i < (sizeof(format_mappings) / sizeof(struct FmtMapping)); i++) {
+        if (format_mappings[i].c == c)
+            return format_mappings[i].mapping;
+    }
+    return NULL;
+}
+
 static const char *scanformat(
     const char *strfrmt,
     char *form,
     char width[3],
     char precision[3]) {
     const char *p = strfrmt;
+
+    /* Parse strfrmt */
     memset(width, '\0', 3);
     memset(precision, '\0', 3);
     while (*p != '\0' && strchr(FMT_FLAGS, *p) != NULL)
         p++; /* skip flags */
-    if ((size_t)(p - strfrmt) >= sizeof(FMT_FLAGS) / sizeof(char))
-        janet_panic("invalid format (repeated flags)");
+    if ((size_t)(p - strfrmt) >= sizeof(FMT_FLAGS)) janet_panic("invalid format (repeated flags)");
     if (isdigit((int)(*p)))
         width[0] = *p++; /* skip width */
     if (isdigit((int)(*p)))
@@ -766,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;
 }
 
@@ -794,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;
                 }
@@ -881,7 +936,7 @@ void janet_formatbv(JanetBuffer *b, const char *format, va_list args) {
                 }
             }
             if (nb >= MAX_ITEM)
-                janet_panicf("format buffer overflow", form);
+                janet_panic("format buffer overflow");
             if (nb > 0)
                 janet_buffer_push_bytes(b, (uint8_t *) item, nb);
         }
@@ -952,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;
                 }
@@ -972,8 +1032,9 @@ void janet_buffer_format(
                     break;
                 }
                 case 's': {
-                    const uint8_t *s = janet_getstring(argv, arg);
-                    int32_t l = janet_string_length(s);
+                    JanetByteView bytes = janet_getbytes(argv, arg);
+                    const uint8_t *s = bytes.bytes;
+                    int32_t l = bytes.len;
                     if (form[2] == '\0')
                         janet_buffer_push_bytes(b, s, l);
                     else {
@@ -1033,7 +1094,7 @@ void janet_buffer_format(
                 }
             }
             if (nb >= MAX_ITEM)
-                janet_panicf("format buffer overflow", form);
+                janet_panic("format buffer overflow");
             if (nb > 0)
                 janet_buffer_push_bytes(b, (uint8_t *) item, nb);
         }

src/core/regalloc.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

src/core/regalloc.h

@@ -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

src/core/run.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
@@ -23,6 +23,7 @@
 #ifndef JANET_AMALG
 #include "features.h"
 #include <janet.h>
+#include "state.h"
 #endif
 
 /* Run a string */
@@ -50,7 +51,7 @@ int janet_dobytes(JanetTable *env, const uint8_t *bytes, int32_t len, const char
                 fiber->env = env;
                 JanetSignal status = janet_continue(fiber, janet_wrap_nil(), &ret);
                 if (status != JANET_SIGNAL_OK && status != JANET_SIGNAL_EVENT) {
-                    janet_stacktrace(fiber, ret);
+                    janet_stacktrace_ext(fiber, ret, "");
                     errflags |= 0x01;
                     done = 1;
                 }
@@ -58,7 +59,7 @@ int janet_dobytes(JanetTable *env, const uint8_t *bytes, int32_t len, const char
                 ret = janet_wrap_string(cres.error);
                 if (cres.macrofiber) {
                     janet_eprintf("compile error in %s: ", sourcePath);
-                    janet_stacktrace(cres.macrofiber, ret);
+                    janet_stacktrace_ext(cres.macrofiber, ret, "");
                 } else {
                     janet_eprintf("compile error in %s: %s\n", sourcePath,
                                   (const char *)cres.error);
@@ -79,7 +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);
-                janet_eprintf("parse error in %s: %s\n", sourcePath, 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;
             }
@@ -98,6 +101,14 @@ int janet_dobytes(JanetTable *env, const uint8_t *bytes, int32_t len, const char
     /* Clean up and return errors */
     janet_parser_deinit(&parser);
     if (where) janet_gcunroot(janet_wrap_string(where));
+#ifdef JANET_EV
+    /* Enter the event loop if we are not already in it */
+    if (janet_vm.stackn == 0) {
+        janet_gcroot(ret);
+        janet_loop();
+        janet_gcunroot(ret);
+    }
+#endif
     if (out) *out = ret;
     return errflags;
 }
@@ -108,3 +119,19 @@ int janet_dostring(JanetTable *env, const char *str, const char *sourcePath, Jan
     return janet_dobytes(env, (const uint8_t *)str, len, sourcePath, out);
 }
 
+/* Run a fiber to completion (use event loop if enabled). Return the status. */
+int janet_loop_fiber(JanetFiber *fiber) {
+    int status;
+#ifdef JANET_EV
+    janet_schedule(fiber, janet_wrap_nil());
+    janet_loop();
+    status = janet_fiber_status(fiber);
+#else
+    Janet out;
+    status = janet_continue(fiber, janet_wrap_nil(), &out);
+    if (status != JANET_SIGNAL_OK && status != JANET_SIGNAL_EVENT) {
+        janet_stacktrace_ext(fiber, out, "");
+    }
+#endif
+    return status;
+}

src/core/specials.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
@@ -31,7 +31,7 @@
 
 static JanetSlot janetc_quote(JanetFopts opts, int32_t argn, const Janet *argv) {
     if (argn != 1) {
-        janetc_cerror(opts.compiler, "expected 1 argument");
+        janetc_cerror(opts.compiler, "expected 1 argument to quote");
         return janetc_cslot(janet_wrap_nil());
     }
     return janetc_cslot(argv[0]);
@@ -40,7 +40,7 @@ static JanetSlot janetc_quote(JanetFopts opts, int32_t argn, const Janet *argv)
 static JanetSlot janetc_splice(JanetFopts opts, int32_t argn, const Janet *argv) {
     JanetSlot ret;
     if (argn != 1) {
-        janetc_cerror(opts.compiler, "expected 1 argument");
+        janetc_cerror(opts.compiler, "expected 1 argument to splice");
         return janetc_cslot(janet_wrap_nil());
     }
     ret = janetc_value(opts, argv[0]);
@@ -62,6 +62,8 @@ static JanetSlot quasiquote(JanetFopts opts, Janet x, int depth, int level) {
         return janetc_cslot(janet_wrap_nil());
     }
     JanetSlot *slots = NULL;
+    JanetFopts subopts = opts;
+    subopts.flags &= ~JANET_FOPTS_HINT;
     switch (janet_type(x)) {
         default:
             return janetc_cslot(x);
@@ -82,7 +84,7 @@ static JanetSlot quasiquote(JanetFopts opts, Janet x, int depth, int level) {
                 }
             }
             for (i = 0; i < len; i++)
-                janet_v_push(slots, quasiquote(opts, tup[i], depth - 1, level));
+                janet_v_push(slots, quasiquote(subopts, tup[i], depth - 1, level));
             return qq_slots(opts, slots, (janet_tuple_flag(tup) & JANET_TUPLE_FLAG_BRACKETCTOR)
                             ? JOP_MAKE_BRACKET_TUPLE
                             : JOP_MAKE_TUPLE);
@@ -91,7 +93,7 @@ static JanetSlot quasiquote(JanetFopts opts, Janet x, int depth, int level) {
             int32_t i;
             JanetArray *array = janet_unwrap_array(x);
             for (i = 0; i < array->count; i++)
-                janet_v_push(slots, quasiquote(opts, array->data[i], depth - 1, level));
+                janet_v_push(slots, quasiquote(subopts, array->data[i], depth - 1, level));
             return qq_slots(opts, slots, JOP_MAKE_ARRAY);
         }
         case JANET_TABLE:
@@ -100,8 +102,8 @@ static JanetSlot quasiquote(JanetFopts opts, Janet x, int depth, int level) {
             int32_t len, cap = 0;
             janet_dictionary_view(x, &kvs, &len, &cap);
             while ((kv = janet_dictionary_next(kvs, cap, kv))) {
-                JanetSlot key = quasiquote(opts, kv->key, depth - 1, level);
-                JanetSlot value =  quasiquote(opts, kv->value, depth - 1, level);
+                JanetSlot key = quasiquote(subopts, kv->key, depth - 1, level);
+                JanetSlot value =  quasiquote(subopts, kv->value, depth - 1, level);
                 key.flags &= ~JANET_SLOT_SPLICED;
                 value.flags &= ~JANET_SLOT_SPLICED;
                 janet_v_push(slots, key);
@@ -115,7 +117,7 @@ static JanetSlot quasiquote(JanetFopts opts, Janet x, int depth, int level) {
 
 static JanetSlot janetc_quasiquote(JanetFopts opts, int32_t argn, const Janet *argv) {
     if (argn != 1) {
-        janetc_cerror(opts.compiler, "expected 1 argument");
+        janetc_cerror(opts.compiler, "expected 1 argument to quasiquote");
         return janetc_cslot(janet_wrap_nil());
     }
     return quasiquote(opts, argv[0], JANET_RECURSION_GUARD, 0);
@@ -141,7 +143,7 @@ static int destructure(JanetCompiler *c,
                        JanetTable *attr) {
     switch (janet_type(left)) {
         default:
-            janetc_cerror(c, "unexpected type in destructuring");
+            janetc_error(c, janet_formatc("unexpected type in destruction, got %v", left));
             return 1;
         case JANET_SYMBOL:
             /* Leaf, assign right to left */
@@ -154,6 +156,67 @@ static int destructure(JanetCompiler *c,
             for (int32_t i = 0; i < len; i++) {
                 JanetSlot nextright = janetc_farslot(c);
                 Janet subval = values[i];
+
+                if (janet_checktype(subval, JANET_SYMBOL) && !janet_cstrcmp(janet_unwrap_symbol(subval), "&")) {
+                    if (i + 1 >= len) {
+                        janetc_cerror(c, "expected symbol following '& in destructuring pattern");
+                        return 1;
+                    }
+
+                    if (i + 2 < len) {
+                        int32_t num_extra = len - i - 1;
+                        Janet *extra = janet_tuple_begin(num_extra);
+                        janet_tuple_flag(extra) |= JANET_TUPLE_FLAG_BRACKETCTOR;
+
+                        for (int32_t j = 0; j < num_extra; ++j) {
+                            extra[j] = values[j + i + 1];
+                        }
+
+                        janetc_error(c, janet_formatc("expected a single symbol follow '& in destructuring pattern, found %q", janet_wrap_tuple(janet_tuple_end(extra))));
+                        return 1;
+                    }
+
+
+                    if (!janet_checktype(values[i + 1], JANET_SYMBOL)) {
+                        janetc_error(c, janet_formatc("expected symbol following '& in destructuring pattern, found %q", values[i + 1]));
+                        return 1;
+                    }
+
+                    JanetSlot argi = janetc_farslot(c);
+                    JanetSlot arg  = janetc_farslot(c);
+                    JanetSlot len  = janetc_farslot(c);
+
+                    janetc_emit_si(c, JOP_LOAD_INTEGER, argi, i, 0);
+                    janetc_emit_ss(c, JOP_LENGTH, len, right, 0);
+
+                    /* loop condition - reuse arg slot for the condition result */
+                    int32_t label_loop_start = janetc_emit_sss(c, JOP_LESS_THAN, arg, argi, len, 0);
+                    int32_t label_loop_cond_jump = janetc_emit_si(c, JOP_JUMP_IF_NOT, arg, 0, 0);
+
+                    /* loop body */
+                    janetc_emit_sss(c, JOP_GET, arg, right, argi, 0);
+                    janetc_emit_s(c, JOP_PUSH, arg, 0);
+                    janetc_emit_ssi(c, JOP_ADD_IMMEDIATE, argi, argi, 1, 0);
+
+                    /* loop - jump back to the start of the loop */
+                    int32_t label_loop_loop = janet_v_count(c->buffer);
+                    janetc_emit(c, JOP_JUMP);
+                    int32_t label_loop_exit = janet_v_count(c->buffer);
+
+                    c->buffer[label_loop_cond_jump] |= (label_loop_exit - label_loop_cond_jump) << 16;
+                    c->buffer[label_loop_loop] |= (label_loop_start - label_loop_loop) << 8;
+
+                    janetc_freeslot(c, argi);
+                    janetc_freeslot(c, arg);
+                    janetc_freeslot(c, len);
+
+                    janetc_emit_s(c, JOP_MAKE_TUPLE, nextright, 1);
+
+                    leaf(c, janet_unwrap_symbol(values[i + 1]), nextright, attr);
+                    janetc_freeslot(c, nextright);
+                    break;
+                }
+
                 if (i < 0x100) {
                     janetc_emit_ssu(c, JOP_GET_INDEX, nextright, right, (uint8_t) i, 1);
                 } else {
@@ -239,11 +302,17 @@ static JanetSlot janetc_varset(JanetFopts opts, int32_t argn, const Janet *argv)
 static JanetTable *handleattr(JanetCompiler *c, int32_t argn, const Janet *argv) {
     int32_t i;
     JanetTable *tab = janet_table(2);
+    const char *binding_name = janet_type(argv[0]) == JANET_SYMBOL
+                               ? ((const char *)janet_unwrap_symbol(argv[0]))
+                               : "<multiple bindings>";
     for (i = 1; i < argn - 1; i++) {
         Janet attr = argv[i];
         switch (janet_type(attr)) {
+            case JANET_TUPLE:
+                janetc_cerror(c, "unexpected form - did you intend to use defn?");
+                break;
             default:
-                janetc_cerror(c, "could not add metadata to binding");
+                janetc_error(c, janet_formatc("cannot add metadata %v to binding %s", attr, binding_name));
                 break;
             case JANET_KEYWORD:
                 janet_table_put(tab, attr, janet_wrap_true());
@@ -298,8 +367,20 @@ static int varleaf(
         /* Global var, generate var */
         JanetSlot refslot;
         JanetTable *entry = janet_table_clone(reftab);
-        JanetArray *ref = janet_array(1);
-        janet_array_push(ref, janet_wrap_nil());
+
+        Janet redef_kw = janet_ckeywordv("redef");
+        int is_redef = janet_truthy(janet_table_get(c->env, redef_kw));
+
+        JanetArray *ref;
+        JanetBinding old_binding;
+        if (is_redef && (old_binding = janet_resolve_ext(c->env, sym),
+                         old_binding.type == JANET_BINDING_VAR)) {
+            ref = janet_unwrap_array(old_binding.value);
+        } else {
+            ref = janet_array(1);
+            janet_array_push(ref, janet_wrap_nil());
+        }
+
         janet_table_put(entry, janet_ckeywordv("ref"), janet_wrap_array(ref));
         janet_table_put(entry, janet_ckeywordv("source-map"),
                         janet_wrap_tuple(janetc_make_sourcemap(c)));
@@ -315,10 +396,11 @@ static int varleaf(
 static JanetSlot janetc_var(JanetFopts opts, int32_t argn, const Janet *argv) {
     JanetCompiler *c = opts.compiler;
     Janet head;
+    JanetTable *attr_table = handleattr(c, argn, argv);
     JanetSlot ret = dohead(c, opts, &head, argn, argv);
     if (c->result.status == JANET_COMPILE_ERROR)
         return janetc_cslot(janet_wrap_nil());
-    destructure(c, argv[0], ret, varleaf, handleattr(c, argn, argv));
+    destructure(c, argv[0], ret, varleaf, attr_table);
     return ret;
 }
 
@@ -331,14 +413,31 @@ static int defleaf(
         JanetTable *entry = janet_table_clone(tab);
         janet_table_put(entry, janet_ckeywordv("source-map"),
                         janet_wrap_tuple(janetc_make_sourcemap(c)));
-        JanetSlot valsym = janetc_cslot(janet_ckeywordv("value"));
-        JanetSlot tabslot = janetc_cslot(janet_wrap_table(entry));
+
+        Janet redef_kw = janet_ckeywordv("redef");
+        int is_redef = janet_truthy(janet_table_get(c->env, redef_kw));
+        if (is_redef) janet_table_put(entry, redef_kw, janet_wrap_true());
+
+        if (is_redef) {
+            JanetBinding binding = janet_resolve_ext(c->env, sym);
+            JanetArray *ref;
+            if (binding.type == JANET_BINDING_DYNAMIC_DEF || binding.type == JANET_BINDING_DYNAMIC_MACRO) {
+                ref = janet_unwrap_array(binding.value);
+            } else {
+                ref = janet_array(1);
+                janet_array_push(ref, janet_wrap_nil());
+            }
+            janet_table_put(entry, janet_ckeywordv("ref"), janet_wrap_array(ref));
+            JanetSlot refslot = janetc_cslot(janet_wrap_array(ref));
+            janetc_emit_ssu(c, JOP_PUT_INDEX, refslot, s, 0, 0);
+        } else {
+            JanetSlot valsym = janetc_cslot(janet_ckeywordv("value"));
+            JanetSlot tabslot = janetc_cslot(janet_wrap_table(entry));
+            janetc_emit_sss(c, JOP_PUT, tabslot, valsym, s, 0);
+        }
 
         /* Add env entry to env */
         janet_table_put(c->env, janet_wrap_symbol(sym), janet_wrap_table(entry));
-
-        /* Put value in table when evaulated */
-        janetc_emit_sss(c, JOP_PUT, tabslot, valsym, s, 0);
     }
     return namelocal(c, sym, 0, s);
 }
@@ -347,10 +446,11 @@ static JanetSlot janetc_def(JanetFopts opts, int32_t argn, const Janet *argv) {
     JanetCompiler *c = opts.compiler;
     Janet head;
     opts.flags &= ~JANET_FOPTS_HINT;
+    JanetTable *attr_table = handleattr(c, argn, argv);
     JanetSlot ret = dohead(c, opts, &head, argn, argv);
     if (c->result.status == JANET_COMPILE_ERROR)
         return janetc_cslot(janet_wrap_nil());
-    destructure(c, argv[0], ret, defleaf, handleattr(c, argn, argv));
+    destructure(c, argv[0], ret, defleaf, attr_table);
     return ret;
 }
 
@@ -713,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;
@@ -725,6 +825,7 @@ static JanetSlot janetc_fn(JanetFopts opts, int32_t argn, const Janet *argv) {
     int selfref = 0;
     int seenamp = 0;
     int seenopt = 0;
+    int namedargs = 0;
 
     /* Begin function */
     c->scope->flags |= JANET_SCOPE_CLOSURE;
@@ -749,6 +850,9 @@ static JanetSlot janetc_fn(JanetFopts opts, int32_t argn, const Janet *argv) {
 
     /* Keep track of destructured parameters */
     JanetSlot *destructed_params = NULL;
+    JanetSlot *named_params = NULL;
+    JanetTable *named_table = NULL;
+    JanetSlot named_slot;
 
     /* Compile function parameters */
     params = janet_unwrap_tuple(argv[parami]);
@@ -756,49 +860,75 @@ static JanetSlot janetc_fn(JanetFopts opts, int32_t argn, const Janet *argv) {
     arity = paramcount;
     for (i = 0; i < paramcount; i++) {
         Janet param = params[i];
-        if (janet_checktype(param, JANET_SYMBOL)) {
+        if (namedargs) {
+            arity--;
+            if (!janet_checktype(param, JANET_SYMBOL)) {
+                errmsg = "only named arguments can follow &named";
+                goto error;
+            }
+            Janet key = janet_wrap_keyword(janet_unwrap_symbol(param));
+            janet_table_put(named_table, key, param);
+            janet_v_push(named_params, janetc_farslot(c));
+        } else if (janet_checktype(param, JANET_SYMBOL)) {
             /* Check for varargs and unfixed arity */
-            if (!janet_cstrcmp(janet_unwrap_symbol(param), "&")) {
-                if (seenamp) {
-                    errmsg = "& in unexpected location";
-                    goto error;
-                } else if (i == paramcount - 1) {
-                    allow_extra = 1;
+            const uint8_t *sym = janet_unwrap_symbol(param);
+            if (sym[0] == '&') {
+                if (!janet_cstrcmp(sym, "&")) {
+                    if (seenamp) {
+                        errmsg = "& in unexpected location";
+                        goto error;
+                    } else if (i == paramcount - 1) {
+                        allow_extra = 1;
+                        arity--;
+                    } else if (i == paramcount - 2) {
+                        vararg = 1;
+                        arity -= 2;
+                    } else {
+                        errmsg = "& in unexpected location";
+                        goto error;
+                    }
+                    seenamp = 1;
+                } else if (!janet_cstrcmp(sym, "&opt")) {
+                    if (seenopt) {
+                        errmsg = "only one &opt allowed";
+                        goto error;
+                    } else if (i == paramcount - 1) {
+                        errmsg = "&opt cannot be last item in parameter list";
+                        goto error;
+                    }
+                    min_arity = i;
                     arity--;
-                } else if (i == paramcount - 2) {
-                    vararg = 1;
-                    arity -= 2;
-                } else {
-                    errmsg = "& in unexpected location";
-                    goto error;
-                }
-                seenamp = 1;
-            } else if (!janet_cstrcmp(janet_unwrap_symbol(param), "&opt")) {
-                if (seenopt) {
-                    errmsg = "only one &opt allowed";
-                    goto error;
-                } else if (i == paramcount - 1) {
-                    errmsg = "&opt cannot be last item in parameter list";
-                    goto error;
-                }
-                min_arity = i;
-                arity--;
-                seenopt = 1;
-            } else if (!janet_cstrcmp(janet_unwrap_symbol(param), "&keys")) {
-                if (seenamp) {
-                    errmsg = "&keys in unexpected location";
-                    goto error;
-                } else if (i == paramcount - 2) {
+                    seenopt = 1;
+                } else if (!janet_cstrcmp(sym, "&keys")) {
+                    if (seenamp) {
+                        errmsg = "&keys in unexpected location";
+                        goto error;
+                    } else if (i == paramcount - 2) {
+                        vararg = 1;
+                        structarg = 1;
+                        arity -= 2;
+                    } else {
+                        errmsg = "&keys in unexpected location";
+                        goto error;
+                    }
+                    seenamp = 1;
+                } else if (!janet_cstrcmp(sym, "&named")) {
+                    if (seenamp) {
+                        errmsg = "&named in unexpected location";
+                        goto error;
+                    }
                     vararg = 1;
                     structarg = 1;
-                    arity -= 2;
+                    arity--;
+                    seenamp = 1;
+                    namedargs = 1;
+                    named_table = janet_table(10);
+                    named_slot = janetc_farslot(c);
                 } else {
-                    errmsg = "&keys in unexpected location";
-                    goto error;
+                    janetc_nameslot(c, sym, janetc_farslot(c));
                 }
-                seenamp = 1;
             } else {
-                janetc_nameslot(c, janet_unwrap_symbol(param), janetc_farslot(c));
+                janetc_nameslot(c, sym, janetc_farslot(c));
             }
         } else {
             janet_v_push(destructed_params, janetc_farslot(c));
@@ -817,6 +947,14 @@ static JanetSlot janetc_fn(JanetFopts opts, int32_t argn, const Janet *argv) {
     }
     janet_v_free(destructed_params);
 
+    /* Compile named arguments */
+    if (namedargs) {
+        Janet param = janet_wrap_table(named_table);
+        destructure(c, param, named_slot, defleaf, NULL);
+        janetc_freeslot(c, named_slot);
+        janet_v_free(named_params);
+    }
+
     max_arity = (vararg || allow_extra) ? INT32_MAX : arity;
     if (!seenopt) min_arity = arity;
 

src/core/state.c

@@ -1,5 +1,5 @@
 /*
-* Copyright (c) 2021 Calvin Rose and contributors
+* 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
@@ -20,21 +20,42 @@
 * IN THE SOFTWARE.
 */
 
-/* A very simple native module */
-
+#ifndef JANET_AMALG
+#include "features.h"
 #include <janet.h>
+#include "state.h"
+#endif
 
-static Janet cfun_get_five(int32_t argc, Janet *argv) {
-    (void) argv;
-    janet_fixarity(argc, 0);
-    return janet_wrap_number(5.0);
+JANET_THREAD_LOCAL JanetVM janet_vm;
+
+JanetVM *janet_local_vm(void) {
+    return &janet_vm;
 }
 
-static const JanetReg array_cfuns[] = {
-    {"get5", cfun_get_five, NULL},
-    {NULL, NULL, NULL}
-};
-
-JANET_MODULE_ENTRY(JanetTable *env) {
-    janet_cfuns(env, NULL, array_cfuns);
+JanetVM *janet_vm_alloc(void) {
+    JanetVM *mem = janet_malloc(sizeof(JanetVM));
+    if (NULL == mem) {
+        JANET_OUT_OF_MEMORY;
+    }
+    return mem;
+}
+
+void janet_vm_free(JanetVM *vm) {
+    janet_free(vm);
+}
+
+void janet_vm_save(JanetVM *into) {
+    *into = janet_vm;
+}
+
+void janet_vm_load(JanetVM *from) {
+    janet_vm = *from;
+}
+
+/* Trigger suspension of the Janet vm by trying to
+ * exit the interpeter loop when convenient. You can optionally
+ * use NULL to interrupt the current VM when convenient */
+void janet_interpreter_interrupt(JanetVM *vm) {
+    vm = vm ? vm : &janet_vm;
+    vm->auto_suspend = 1;
 }

src/core/state.h

@@ -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
@@ -25,81 +25,160 @@
 
 #include <stdint.h>
 
-/* The VM state. Rather than a struct that is passed
- * around, the vm state is global for simplicity. If
- * at some point a global state object, or context,
- * is required to be passed around, this is what would
- * be in it. However, thread local global variables for interpreter
- * state should allow easy multi-threading. */
+#ifdef JANET_EV
+#ifndef JANET_WINDOWS
+#include <pthread.h>
+#endif
+#endif
 
-typedef struct JanetScratch JanetScratch;
+typedef int64_t JanetTimestamp;
 
-/* Top level dynamic bindings */
-extern JANET_THREAD_LOCAL JanetTable *janet_vm_top_dyns;
+typedef struct JanetScratch {
+    JanetScratchFinalizer finalize;
+    long long mem[]; /* for proper alignment */
+} JanetScratch;
 
-/* Cache the core environment */
-extern JANET_THREAD_LOCAL JanetTable *janet_vm_core_env;
-
-/* How many VM stacks have been entered */
-extern JANET_THREAD_LOCAL int janet_vm_stackn;
-
-/* The current running fiber on the current thread.
- * Set and unset by janet_run. */
-extern JANET_THREAD_LOCAL JanetFiber *janet_vm_fiber;
-extern JANET_THREAD_LOCAL JanetFiber *janet_vm_root_fiber;
-
-/* The current pointer to the inner most jmp_buf. The current
- * return point for panics. */
-extern JANET_THREAD_LOCAL jmp_buf *janet_vm_jmp_buf;
-extern JANET_THREAD_LOCAL Janet *janet_vm_return_reg;
-
-/* The global registry for c functions. Used to store meta-data
- * along with otherwise bare c function pointers. */
-extern JANET_THREAD_LOCAL JanetTable *janet_vm_registry;
-
-/* Registry for abstract abstract types that can be marshalled.
- * We need this to look up the constructors when unmarshalling. */
-extern JANET_THREAD_LOCAL JanetTable *janet_vm_abstract_registry;
-
-/* Immutable value cache */
-extern JANET_THREAD_LOCAL const uint8_t **janet_vm_cache;
-extern JANET_THREAD_LOCAL uint32_t janet_vm_cache_capacity;
-extern JANET_THREAD_LOCAL uint32_t janet_vm_cache_count;
-extern JANET_THREAD_LOCAL uint32_t janet_vm_cache_deleted;
-
-/* Garbage collection */
-extern JANET_THREAD_LOCAL void *janet_vm_blocks;
-extern JANET_THREAD_LOCAL size_t janet_vm_gc_interval;
-extern JANET_THREAD_LOCAL size_t janet_vm_next_collection;
-extern JANET_THREAD_LOCAL size_t janet_vm_block_count;
-extern JANET_THREAD_LOCAL int janet_vm_gc_suspend;
-
-/* GC roots */
-extern JANET_THREAD_LOCAL Janet *janet_vm_roots;
-extern JANET_THREAD_LOCAL size_t janet_vm_root_count;
-extern JANET_THREAD_LOCAL size_t janet_vm_root_capacity;
-
-/* Scratch memory */
-extern JANET_THREAD_LOCAL JanetScratch **janet_scratch_mem;
-extern JANET_THREAD_LOCAL size_t janet_scratch_cap;
-extern JANET_THREAD_LOCAL size_t janet_scratch_len;
-
-/* Recursionless traversal of data structures */
 typedef struct {
     JanetGCObject *self;
     JanetGCObject *other;
     int32_t index;
     int32_t index2;
 } JanetTraversalNode;
-extern JANET_THREAD_LOCAL JanetTraversalNode *janet_vm_traversal;
-extern JANET_THREAD_LOCAL JanetTraversalNode *janet_vm_traversal_top;
-extern JANET_THREAD_LOCAL JanetTraversalNode *janet_vm_traversal_base;
 
-/* Setup / teardown */
-#ifdef JANET_THREADS
-void janet_threads_init(void);
-void janet_threads_deinit(void);
+typedef struct {
+    int32_t capacity;
+    int32_t head;
+    int32_t tail;
+    void *data;
+} JanetQueue;
+
+typedef struct {
+    JanetTimestamp when;
+    JanetFiber *fiber;
+    JanetFiber *curr_fiber;
+    uint32_t sched_id;
+    int is_error;
+} JanetTimeout;
+
+/* 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 {
+    JanetCFunction cfun;
+    const char *name;
+    const char *name_prefix;
+    const char *source_file;
+    int32_t source_line;
+    /* int32_t min_arity; */
+    /* int32_t max_arity; */
+} JanetCFunRegistry;
+
+struct JanetVM {
+    /* Place for user data */
+    void *user;
+
+    /* Top level dynamic bindings */
+    JanetTable *top_dyns;
+
+    /* Cache the core environment */
+    JanetTable *core_env;
+
+    /* How many VM stacks have been entered */
+    int stackn;
+
+    /* If this flag is true, suspend on function calls and backwards jumps.
+     * When this occurs, this flag will be reset to 0. */
+    int auto_suspend;
+
+    /* The current running fiber on the current thread.
+     * Set and unset by functions in vm.c */
+    JanetFiber *fiber;
+    JanetFiber *root_fiber;
+
+    /* The current pointer to the inner most jmp_buf. The current
+     * return point for panics. */
+    jmp_buf *signal_buf;
+    Janet *return_reg;
+
+    /* The global registry for c functions. Used to store meta-data
+     * along with otherwise bare c function pointers. */
+    JanetCFunRegistry *registry;
+    size_t registry_cap;
+    size_t registry_count;
+    int registry_dirty;
+
+    /* Registry for abstract types that can be marshalled.
+     * We need this to look up the constructors when unmarshalling. */
+    JanetTable *abstract_registry;
+
+    /* Immutable value cache */
+    const uint8_t **cache;
+    uint32_t cache_capacity;
+    uint32_t cache_count;
+    uint32_t cache_deleted;
+    uint8_t gensym_counter[8];
+
+    /* Garbage collection */
+    void *blocks;
+    size_t gc_interval;
+    size_t next_collection;
+    size_t block_count;
+    int gc_suspend;
+
+    /* GC roots */
+    Janet *roots;
+    size_t root_count;
+    size_t root_capacity;
+
+    /* Scratch memory */
+    JanetScratch **scratch_mem;
+    size_t scratch_cap;
+    size_t scratch_len;
+
+    /* Random number generator */
+    JanetRNG rng;
+
+    /* Traversal pointers */
+    JanetTraversalNode *traversal;
+    JanetTraversalNode *traversal_top;
+    JanetTraversalNode *traversal_base;
+
+    /* Event loop and scheduler globals */
+#ifdef JANET_EV
+    size_t tq_count;
+    size_t tq_capacity;
+    JanetQueue spawn;
+    JanetTimeout *tq;
+    JanetRNG ev_rng;
+    JanetListenerState **listeners;
+    size_t listener_count;
+    size_t listener_cap;
+    size_t extra_listeners;
+    JanetTable threaded_abstracts; /* All abstract types that can be shared between threads (used in this thread) */
+#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
+#endif
+
+};
+
+extern JANET_THREAD_LOCAL JanetVM janet_vm;
 
 #ifdef JANET_NET
 void janet_net_init(void);

src/core/string.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
@@ -170,25 +170,37 @@ static int32_t kmp_next(struct kmp_state *state) {
 
 /* CFuns */
 
-static Janet cfun_string_slice(int32_t argc, Janet *argv) {
+JANET_CORE_FN(cfun_string_slice,
+              "(string/slice bytes &opt start end)",
+              "Returns a substring from a byte sequence. The substring is from "
+              "index `start` inclusive to index `end`, exclusive. All indexing "
+              "is from 0. `start` and `end` can also be negative to indicate indexing "
+              "from the end of the string. Note that index -1 is synonymous with "
+              "index `(length bytes)` to allow a full negative slice range. ") {
     JanetByteView view = janet_getbytes(argv, 0);
     JanetRange range = janet_getslice(argc, argv);
     return janet_stringv(view.bytes + range.start, range.end - range.start);
 }
 
-static Janet cfun_symbol_slice(int32_t argc, Janet *argv) {
+JANET_CORE_FN(cfun_symbol_slice,
+              "(symbol/slice bytes &opt start end)",
+              "Same as string/slice, but returns a symbol.") {
     JanetByteView view = janet_getbytes(argv, 0);
     JanetRange range = janet_getslice(argc, argv);
     return janet_symbolv(view.bytes + range.start, range.end - range.start);
 }
 
-static Janet cfun_keyword_slice(int32_t argc, Janet *argv) {
+JANET_CORE_FN(cfun_keyword_slice,
+              "(keyword/slice bytes &opt start end)",
+              "Same as string/slice, but returns a keyword.") {
     JanetByteView view = janet_getbytes(argv, 0);
     JanetRange range = janet_getslice(argc, argv);
     return janet_keywordv(view.bytes + range.start, range.end - range.start);
 }
 
-static Janet cfun_string_repeat(int32_t argc, Janet *argv) {
+JANET_CORE_FN(cfun_string_repeat,
+              "(string/repeat bytes n)",
+              "Returns a string that is `n` copies of `bytes` concatenated.") {
     janet_fixarity(argc, 2);
     JanetByteView view = janet_getbytes(argv, 0);
     int32_t rep = janet_getinteger(argv, 1);
@@ -204,7 +216,9 @@ static Janet cfun_string_repeat(int32_t argc, Janet *argv) {
     return janet_wrap_string(janet_string_end(newbuf));
 }
 
-static Janet cfun_string_bytes(int32_t argc, Janet *argv) {
+JANET_CORE_FN(cfun_string_bytes,
+              "(string/bytes str)",
+              "Returns a tuple of integers that are the byte values of the string.") {
     janet_fixarity(argc, 1);
     JanetByteView view = janet_getbytes(argv, 0);
     Janet *tup = janet_tuple_begin(view.len);
@@ -215,7 +229,10 @@ static Janet cfun_string_bytes(int32_t argc, Janet *argv) {
     return janet_wrap_tuple(janet_tuple_end(tup));
 }
 
-static Janet cfun_string_frombytes(int32_t argc, Janet *argv) {
+JANET_CORE_FN(cfun_string_frombytes,
+              "(string/from-bytes & byte-vals)",
+              "Creates a string from integer parameters with byte values. All integers "
+              "will be coerced to the range of 1 byte 0-255.") {
     int32_t i;
     uint8_t *buf = janet_string_begin(argc);
     for (i = 0; i < argc; i++) {
@@ -225,7 +242,11 @@ static Janet cfun_string_frombytes(int32_t argc, Janet *argv) {
     return janet_wrap_string(janet_string_end(buf));
 }
 
-static Janet cfun_string_asciilower(int32_t argc, Janet *argv) {
+JANET_CORE_FN(cfun_string_asciilower,
+              "(string/ascii-lower str)",
+              "Returns a new string where all bytes are replaced with the "
+              "lowercase version of themselves in ASCII. Does only a very simple "
+              "case check, meaning no unicode support.") {
     janet_fixarity(argc, 1);
     JanetByteView view = janet_getbytes(argv, 0);
     uint8_t *buf = janet_string_begin(view.len);
@@ -240,7 +261,11 @@ static Janet cfun_string_asciilower(int32_t argc, Janet *argv) {
     return janet_wrap_string(janet_string_end(buf));
 }
 
-static Janet cfun_string_asciiupper(int32_t argc, Janet *argv) {
+JANET_CORE_FN(cfun_string_asciiupper,
+              "(string/ascii-upper str)",
+              "Returns a new string where all bytes are replaced with the "
+              "uppercase version of themselves in ASCII. Does only a very simple "
+              "case check, meaning no unicode support.") {
     janet_fixarity(argc, 1);
     JanetByteView view = janet_getbytes(argv, 0);
     uint8_t *buf = janet_string_begin(view.len);
@@ -255,7 +280,9 @@ static Janet cfun_string_asciiupper(int32_t argc, Janet *argv) {
     return janet_wrap_string(janet_string_end(buf));
 }
 
-static Janet cfun_string_reverse(int32_t argc, Janet *argv) {
+JANET_CORE_FN(cfun_string_reverse,
+              "(string/reverse str)",
+              "Returns a string that is the reversed version of `str`.") {
     janet_fixarity(argc, 1);
     JanetByteView view = janet_getbytes(argv, 0);
     uint8_t *buf = janet_string_begin(view.len);
@@ -279,7 +306,11 @@ static void findsetup(int32_t argc, Janet *argv, struct kmp_state *s, int32_t ex
     s->i = start;
 }
 
-static Janet cfun_string_find(int32_t argc, Janet *argv) {
+JANET_CORE_FN(cfun_string_find,
+              "(string/find patt str &opt start-index)",
+              "Searches for the first instance of pattern `patt` in string "
+              "`str`. Returns the index of the first character in `patt` if found, "
+              "otherwise returns nil.") {
     int32_t result;
     struct kmp_state state;
     findsetup(argc, argv, &state, 0);
@@ -290,7 +321,9 @@ static Janet cfun_string_find(int32_t argc, Janet *argv) {
            : janet_wrap_integer(result);
 }
 
-static Janet cfun_string_hasprefix(int32_t argc, Janet *argv) {
+JANET_CORE_FN(cfun_string_hasprefix,
+              "(string/has-prefix? pfx str)",
+              "Tests whether `str` starts with `pfx`.") {
     janet_fixarity(argc, 2);
     JanetByteView prefix = janet_getbytes(argv, 0);
     JanetByteView str = janet_getbytes(argv, 1);
@@ -299,7 +332,9 @@ static Janet cfun_string_hasprefix(int32_t argc, Janet *argv) {
            : janet_wrap_boolean(memcmp(prefix.bytes, str.bytes, prefix.len) == 0);
 }
 
-static Janet cfun_string_hassuffix(int32_t argc, Janet *argv) {
+JANET_CORE_FN(cfun_string_hassuffix,
+              "(string/has-suffix? sfx str)",
+              "Tests whether `str` ends with `sfx`.") {
     janet_fixarity(argc, 2);
     JanetByteView suffix = janet_getbytes(argv, 0);
     JanetByteView str = janet_getbytes(argv, 1);
@@ -310,7 +345,12 @@ static Janet cfun_string_hassuffix(int32_t argc, Janet *argv) {
                                        suffix.len) == 0);
 }
 
-static Janet cfun_string_findall(int32_t argc, Janet *argv) {
+JANET_CORE_FN(cfun_string_findall,
+              "(string/find-all patt str &opt start-index)",
+              "Searches for all instances of pattern `patt` in string "
+              "`str`. Returns an array of all indices of found patterns. Overlapping "
+              "instances of the pattern are counted individually, meaning a byte in `str` "
+              "may contribute to multiple found patterns.") {
     int32_t result;
     struct kmp_state state;
     findsetup(argc, argv, &state, 0);
@@ -344,7 +384,10 @@ static void replacesetup(int32_t argc, Janet *argv, struct replace_state *s) {
     s->substlen = subst.len;
 }
 
-static Janet cfun_string_replace(int32_t argc, Janet *argv) {
+JANET_CORE_FN(cfun_string_replace,
+              "(string/replace patt subst str)",
+              "Replace the first occurrence of `patt` with `subst` in the string `str`. "
+              "Will return the new string if `patt` is found, otherwise returns `str`.") {
     int32_t result;
     struct replace_state s;
     uint8_t *buf;
@@ -364,7 +407,11 @@ static Janet cfun_string_replace(int32_t argc, Janet *argv) {
     return janet_wrap_string(janet_string_end(buf));
 }
 
-static Janet cfun_string_replaceall(int32_t argc, Janet *argv) {
+JANET_CORE_FN(cfun_string_replaceall,
+              "(string/replace-all patt subst str)",
+              "Replace all instances of `patt` with `subst` in the string `str`. Overlapping "
+              "matches will not be counted, only the first match in such a span will be replaced. "
+              "Will return the new string if `patt` is found, otherwise returns `str`.") {
     int32_t result;
     struct replace_state s;
     JanetBuffer b;
@@ -384,7 +431,13 @@ static Janet cfun_string_replaceall(int32_t argc, Janet *argv) {
     return janet_wrap_string(ret);
 }
 
-static Janet cfun_string_split(int32_t argc, Janet *argv) {
+JANET_CORE_FN(cfun_string_split,
+              "(string/split delim str &opt start limit)",
+              "Splits a string `str` with delimiter `delim` and returns an array of "
+              "substrings. The substrings will not contain the delimiter `delim`. If `delim` "
+              "is not found, the returned array will have one element. Will start searching "
+              "for `delim` at the index `start` (if provided), and return up to a maximum "
+              "of `limit` results (if provided).") {
     int32_t result;
     JanetArray *array;
     struct kmp_state state;
@@ -406,7 +459,11 @@ static Janet cfun_string_split(int32_t argc, Janet *argv) {
     return janet_wrap_array(array);
 }
 
-static Janet cfun_string_checkset(int32_t argc, Janet *argv) {
+JANET_CORE_FN(cfun_string_checkset,
+              "(string/check-set set str)",
+              "Checks that the string `str` only contains bytes that appear in the string `set`. "
+              "Returns true if all bytes in `str` appear in `set`, false if some bytes in `str` do "
+              "not appear in `set`.") {
     uint32_t bitset[8] = {0, 0, 0, 0, 0, 0, 0, 0};
     janet_fixarity(argc, 2);
     JanetByteView set = janet_getbytes(argv, 0);
@@ -428,7 +485,10 @@ static Janet cfun_string_checkset(int32_t argc, Janet *argv) {
     return janet_wrap_true();
 }
 
-static Janet cfun_string_join(int32_t argc, Janet *argv) {
+JANET_CORE_FN(cfun_string_join,
+              "(string/join parts &opt sep)",
+              "Joins an array of strings into one string, optionally separated by "
+              "a separator string `sep`.") {
     janet_arity(argc, 1, 2);
     JanetView parts = janet_getindexed(argv, 0);
     JanetByteView joiner;
@@ -468,7 +528,10 @@ static Janet cfun_string_join(int32_t argc, Janet *argv) {
     return janet_wrap_string(janet_string_end(buf));
 }
 
-static Janet cfun_string_format(int32_t argc, Janet *argv) {
+JANET_CORE_FN(cfun_string_format,
+              "(string/format format & values)",
+              "Similar to C's `snprintf`, but specialized for operating with Janet values. Returns "
+              "a new string.") {
     janet_arity(argc, 1, -1);
     JanetBuffer *buffer = janet_buffer(0);
     const char *strfrmt = (const char *) janet_getstring(argv, 0);
@@ -508,7 +571,10 @@ static void trim_help_args(int32_t argc, Janet *argv, JanetByteView *str, JanetB
     }
 }
 
-static Janet cfun_string_trim(int32_t argc, Janet *argv) {
+JANET_CORE_FN(cfun_string_trim,
+              "(string/trim str &opt set)",
+              "Trim leading and trailing whitespace from a byte sequence. If the argument "
+              "`set` is provided, consider only characters in `set` to be whitespace.") {
     JanetByteView str, set;
     trim_help_args(argc, argv, &str, &set);
     int32_t left_edge = trim_help_leftedge(str, set);
@@ -518,163 +584,52 @@ static Janet cfun_string_trim(int32_t argc, Janet *argv) {
     return janet_stringv(str.bytes + left_edge, right_edge - left_edge);
 }
 
-static Janet cfun_string_triml(int32_t argc, Janet *argv) {
+JANET_CORE_FN(cfun_string_triml,
+              "(string/triml str &opt set)",
+              "Trim leading whitespace from a byte sequence. If the argument "
+              "`set` is provided, consider only characters in `set` to be whitespace.") {
     JanetByteView str, set;
     trim_help_args(argc, argv, &str, &set);
     int32_t left_edge = trim_help_leftedge(str, set);
     return janet_stringv(str.bytes + left_edge, str.len - left_edge);
 }
 
-static Janet cfun_string_trimr(int32_t argc, Janet *argv) {
+JANET_CORE_FN(cfun_string_trimr,
+              "(string/trimr str &opt set)",
+              "Trim trailing whitespace from a byte sequence. If the argument "
+              "`set` is provided, consider only characters in `set` to be whitespace.") {
     JanetByteView str, set;
     trim_help_args(argc, argv, &str, &set);
     int32_t right_edge = trim_help_rightedge(str, set);
     return janet_stringv(str.bytes, right_edge);
 }
 
-static const JanetReg string_cfuns[] = {
-    {
-        "string/slice", cfun_string_slice,
-        JDOC("(string/slice bytes &opt start end)\n\n"
-             "Returns a substring from a byte sequence. The substring is from "
-             "index start inclusive to index end exclusive. All indexing "
-             "is from 0. 'start' and 'end' can also be negative to indicate indexing "
-             "from the end of the string. Note that index -1 is synonymous with "
-             "index (length bytes) to allow a full negative slice range. ")
-    },
-    {
-        "keyword/slice", cfun_keyword_slice,
-        JDOC("(keyword/slice bytes &opt start end)\n\n"
-             "Same a string/slice, but returns a keyword.")
-    },
-    {
-        "symbol/slice", cfun_symbol_slice,
-        JDOC("(symbol/slice bytes &opt start end)\n\n"
-             "Same a string/slice, but returns a symbol.")
-    },
-    {
-        "string/repeat", cfun_string_repeat,
-        JDOC("(string/repeat bytes n)\n\n"
-             "Returns a string that is n copies of bytes concatenated.")
-    },
-    {
-        "string/bytes", cfun_string_bytes,
-        JDOC("(string/bytes str)\n\n"
-             "Returns an array of integers that are the byte values of the string.")
-    },
-    {
-        "string/from-bytes", cfun_string_frombytes,
-        JDOC("(string/from-bytes & byte-vals)\n\n"
-             "Creates a string from integer parameters with byte values. All integers "
-             "will be coerced to the range of 1 byte 0-255.")
-    },
-    {
-        "string/ascii-lower", cfun_string_asciilower,
-        JDOC("(string/ascii-lower str)\n\n"
-             "Returns a new string where all bytes are replaced with the "
-             "lowercase version of themselves in ASCII. Does only a very simple "
-             "case check, meaning no unicode support.")
-    },
-    {
-        "string/ascii-upper", cfun_string_asciiupper,
-        JDOC("(string/ascii-upper str)\n\n"
-             "Returns a new string where all bytes are replaced with the "
-             "uppercase version of themselves in ASCII. Does only a very simple "
-             "case check, meaning no unicode support.")
-    },
-    {
-        "string/reverse", cfun_string_reverse,
-        JDOC("(string/reverse str)\n\n"
-             "Returns a string that is the reversed version of str.")
-    },
-    {
-        "string/find", cfun_string_find,
-        JDOC("(string/find patt str &opt start-index)\n\n"
-             "Searches for the first instance of pattern patt in string "
-             "str. Returns the index of the first character in patt if found, "
-             "otherwise returns nil.")
-    },
-    {
-        "string/find-all", cfun_string_findall,
-        JDOC("(string/find-all patt str &opt start-index)\n\n"
-             "Searches for all instances of pattern patt in string "
-             "str. Returns an array of all indices of found patterns. Overlapping "
-             "instances of the pattern are counted individually, meaning a byte in str "
-             "may contribute to multiple found patterns.")
-    },
-    {
-        "string/has-prefix?", cfun_string_hasprefix,
-        JDOC("(string/has-prefix? pfx str)\n\n"
-             "Tests whether str starts with pfx.")
-    },
-    {
-        "string/has-suffix?", cfun_string_hassuffix,
-        JDOC("(string/has-suffix? sfx str)\n\n"
-             "Tests whether str ends with sfx.")
-    },
-    {
-        "string/replace", cfun_string_replace,
-        JDOC("(string/replace patt subst str)\n\n"
-             "Replace the first occurrence of patt with subst in the string str. "
-             "Will return the new string if patt is found, otherwise returns str.")
-    },
-    {
-        "string/replace-all", cfun_string_replaceall,
-        JDOC("(string/replace-all patt subst str)\n\n"
-             "Replace all instances of patt with subst in the string str. Overlapping "
-             "matches will not be counted, only the first match in such a span will be replaced. "
-             "Will return the new string if patt is found, otherwise returns str.")
-    },
-    {
-        "string/split", cfun_string_split,
-        JDOC("(string/split delim str &opt start limit)\n\n"
-             "Splits a string str with delimiter delim and returns an array of "
-             "substrings. The substrings will not contain the delimiter delim. If delim "
-             "is not found, the returned array will have one element. Will start searching "
-             "for delim at the index start (if provided), and return up to a maximum "
-             "of limit results (if provided).")
-    },
-    {
-        "string/check-set", cfun_string_checkset,
-        JDOC("(string/check-set set str)\n\n"
-             "Checks that the string str only contains bytes that appear in the string set. "
-             "Returns true if all bytes in str appear in set, false if some bytes in str do "
-             "not appear in set.")
-    },
-    {
-        "string/join", cfun_string_join,
-        JDOC("(string/join parts &opt sep)\n\n"
-             "Joins an array of strings into one string, optionally separated by "
-             "a separator string sep.")
-    },
-    {
-        "string/format", cfun_string_format,
-        JDOC("(string/format format & values)\n\n"
-             "Similar to snprintf, but specialized for operating with Janet values. Returns "
-             "a new string.")
-    },
-    {
-        "string/trim", cfun_string_trim,
-        JDOC("(string/trim str &opt set)\n\n"
-             "Trim leading and trailing whitespace from a byte sequence. If the argument "
-             "set is provided, consider only characters in set to be whitespace.")
-    },
-    {
-        "string/triml", cfun_string_triml,
-        JDOC("(string/triml str &opt set)\n\n"
-             "Trim leading whitespace from a byte sequence. If the argument "
-             "set is provided, consider only characters in set to be whitespace.")
-    },
-    {
-        "string/trimr", cfun_string_trimr,
-        JDOC("(string/trimr str &opt set)\n\n"
-             "Trim trailing whitespace from a byte sequence. If the argument "
-             "set is provided, consider only characters in set to be whitespace.")
-    },
-    {NULL, NULL, NULL}
-};
-
 /* Module entry point */
 void janet_lib_string(JanetTable *env) {
-    janet_core_cfuns(env, NULL, string_cfuns);
+    JanetRegExt string_cfuns[] = {
+        JANET_CORE_REG("string/slice", cfun_string_slice),
+        JANET_CORE_REG("keyword/slice", cfun_keyword_slice),
+        JANET_CORE_REG("symbol/slice", cfun_symbol_slice),
+        JANET_CORE_REG("string/repeat", cfun_string_repeat),
+        JANET_CORE_REG("string/bytes", cfun_string_bytes),
+        JANET_CORE_REG("string/from-bytes", cfun_string_frombytes),
+        JANET_CORE_REG("string/ascii-lower", cfun_string_asciilower),
+        JANET_CORE_REG("string/ascii-upper", cfun_string_asciiupper),
+        JANET_CORE_REG("string/reverse", cfun_string_reverse),
+        JANET_CORE_REG("string/find", cfun_string_find),
+        JANET_CORE_REG("string/find-all", cfun_string_findall),
+        JANET_CORE_REG("string/has-prefix?", cfun_string_hasprefix),
+        JANET_CORE_REG("string/has-suffix?", cfun_string_hassuffix),
+        JANET_CORE_REG("string/replace", cfun_string_replace),
+        JANET_CORE_REG("string/replace-all", cfun_string_replaceall),
+        JANET_CORE_REG("string/split", cfun_string_split),
+        JANET_CORE_REG("string/check-set", cfun_string_checkset),
+        JANET_CORE_REG("string/join", cfun_string_join),
+        JANET_CORE_REG("string/format", cfun_string_format),
+        JANET_CORE_REG("string/trim", cfun_string_trim),
+        JANET_CORE_REG("string/triml", cfun_string_triml),
+        JANET_CORE_REG("string/trimr", cfun_string_trimr),
+        JANET_REG_END
+    };
+    janet_core_cfuns_ext(env, NULL, string_cfuns);
 }

src/core/strtod.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
@@ -246,15 +246,15 @@ static double convert(
 }
 
 /* Scan a real (double) from a string. If the string cannot be converted into
- * and integer, set *err to 1 and return 0. */
-int janet_scan_number(
+ * and integer, return 0. */
+int janet_scan_number_base(
     const uint8_t *str,
     int32_t len,
+    int32_t base,
     double *out) {
     const uint8_t *end = str + len;
     int seenadigit = 0;
     int ex = 0;
-    int base = 10;
     int seenpoint = 0;
     int foundexp = 0;
     int neg = 0;
@@ -278,21 +278,28 @@ int janet_scan_number(
     }
 
     /* Check for leading 0x or digit digit r */
-    if (str + 1 < end && str[0] == '0' && str[1] == 'x') {
-        base = 16;
-        str += 2;
-    } else if (str + 1 < end  &&
-               str[0] >= '0' && str[0] <= '9' &&
-               str[1] == 'r') {
-        base = str[0] - '0';
-        str += 2;
-    } else if (str + 2 < end  &&
-               str[0] >= '0' && str[0] <= '9' &&
-               str[1] >= '0' && str[1] <= '9' &&
-               str[2] == 'r') {
-        base = 10 * (str[0] - '0') + (str[1] - '0');
-        if (base < 2 || base > 36) goto error;
-        str += 3;
+    if (base == 0) {
+        if (str + 1 < end && str[0] == '0' && str[1] == 'x') {
+            base = 16;
+            str += 2;
+        } else if (str + 1 < end  &&
+                   str[0] >= '0' && str[0] <= '9' &&
+                   str[1] == 'r') {
+            base = str[0] - '0';
+            str += 2;
+        } else if (str + 2 < end  &&
+                   str[0] >= '0' && str[0] <= '9' &&
+                   str[1] >= '0' && str[1] <= '9' &&
+                   str[2] == 'r') {
+            base = 10 * (str[0] - '0') + (str[1] - '0');
+            if (base < 2 || base > 36) goto error;
+            str += 3;
+        }
+    }
+
+    /* If still base is 0, set to default (10) */
+    if (base == 0) {
+        base = 10;
     }
 
     /* Skip leading zeros */
@@ -376,6 +383,13 @@ error:
     return 1;
 }
 
+int janet_scan_number(
+    const uint8_t *str,
+    int32_t len,
+    double *out) {
+    return janet_scan_number_base(str, len, 0, out);
+}
+
 #ifdef JANET_INT_TYPES
 
 static int scan_uint64(

src/core/struct.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
@@ -39,13 +39,14 @@ JanetKV *janet_struct_begin(int32_t count) {
     head->length = count;
     head->capacity = capacity;
     head->hash = 0;
+    head->proto = NULL;
 
     JanetKV *st = (JanetKV *)(head->data);
     janet_memempty(st, capacity);
     return st;
 }
 
-/* Find an item in a struct. Should be similar to janet_dict_find, but
+/* Find an item in a struct without looking for prototypes. Should be similar to janet_dict_find, but
  * specialized to structs (slightly more compact). */
 const JanetKV *janet_struct_find(const JanetKV *st, Janet key) {
     int32_t cap = janet_struct_capacity(st);
@@ -68,7 +69,7 @@ const JanetKV *janet_struct_find(const JanetKV *st, Janet key) {
  * preforms an in-place insertion sort. This ensures the internal structure of the
  * hash map is independent of insertion order.
  */
-void janet_struct_put(JanetKV *st, Janet key, Janet value) {
+void janet_struct_put_ext(JanetKV *st, Janet key, Janet value, int replace) {
     int32_t cap = janet_struct_capacity(st);
     int32_t hash = janet_hash(key);
     int32_t index = janet_maphash(cap, hash);
@@ -123,13 +124,19 @@ void janet_struct_put(JanetKV *st, Janet key, Janet value) {
                 dist = otherdist;
                 hash = otherhash;
             } else if (status == 0) {
-                /* A key was added to the struct more than once - replace old value */
-                kv->value = value;
+                if (replace) {
+                    /* A key was added to the struct more than once - replace old value */
+                    kv->value = value;
+                }
                 return;
             }
         }
 }
 
+void janet_struct_put(JanetKV *st, Janet key, Janet value) {
+    janet_struct_put_ext(st, key, value, 1);
+}
+
 /* Finish building a struct */
 const JanetKV *janet_struct_end(JanetKV *st) {
     if (janet_struct_hash(st) != janet_struct_length(st)) {
@@ -143,16 +150,43 @@ const JanetKV *janet_struct_end(JanetKV *st) {
                 janet_struct_put(newst, kv->key, kv->value);
             }
         }
+        janet_struct_proto(newst) = janet_struct_proto(st);
         st = newst;
     }
     janet_struct_hash(st) = janet_kv_calchash(st, janet_struct_capacity(st));
+    if (janet_struct_proto(st)) {
+        janet_struct_hash(st) += 2654435761u * janet_struct_hash(janet_struct_proto(st));
+    }
     return (const JanetKV *)st;
 }
 
+/* Get an item from a struct without looking into prototypes. */
+Janet janet_struct_rawget(const JanetKV *st, Janet key) {
+    const JanetKV *kv = janet_struct_find(st, key);
+    return kv ? kv->value : janet_wrap_nil();
+}
+
 /* Get an item from a struct */
 Janet janet_struct_get(const JanetKV *st, Janet key) {
-    const JanetKV *kv = janet_struct_find(st, key);
-    return kv ? kv->value : janet_wrap_nil();
+    for (int i = JANET_MAX_PROTO_DEPTH; st && i; --i, st = janet_struct_proto(st)) {
+        const JanetKV *kv = janet_struct_find(st, key);
+        if (NULL != kv && !janet_checktype(kv->key, JANET_NIL)) {
+            return kv->value;
+        }
+    }
+    return janet_wrap_nil();
+}
+
+/* Get an item from a struct, and record which prototype the item came from. */
+Janet janet_struct_get_ex(const JanetKV *st, Janet key, JanetStruct *which) {
+    for (int i = JANET_MAX_PROTO_DEPTH; st && i; --i, st = janet_struct_proto(st)) {
+        const JanetKV *kv = janet_struct_find(st, key);
+        if (NULL != kv && !janet_checktype(kv->key, JANET_NIL)) {
+            *which = st;
+            return kv->value;
+        }
+    }
+    return janet_wrap_nil();
 }
 
 /* Convert struct to table */
@@ -167,3 +201,107 @@ JanetTable *janet_struct_to_table(const JanetKV *st) {
     }
     return table;
 }
+
+/* C Functions */
+
+JANET_CORE_FN(cfun_struct_with_proto,
+              "(struct/with-proto proto & kvs)",
+              "Create a structure, as with the usual struct constructor but set the "
+              "struct prototype as well.") {
+    janet_arity(argc, 1, -1);
+    JanetStruct proto = janet_optstruct(argv, argc, 0, NULL);
+    if (!(argc & 1))
+        janet_panic("expected odd number of arguments");
+    JanetKV *st = janet_struct_begin(argc / 2);
+    for (int32_t i = 1; i < argc; i += 2) {
+        janet_struct_put(st, argv[i], argv[i + 1]);
+    }
+    janet_struct_proto(st) = proto;
+    return janet_wrap_struct(janet_struct_end(st));
+}
+
+JANET_CORE_FN(cfun_struct_getproto,
+              "(struct/getproto st)",
+              "Return the prototype of a struct, or nil if it doesn't have one.") {
+    janet_fixarity(argc, 1);
+    JanetStruct st = janet_getstruct(argv, 0);
+    return janet_struct_proto(st)
+           ? janet_wrap_struct(janet_struct_proto(st))
+           : janet_wrap_nil();
+}
+
+JANET_CORE_FN(cfun_struct_flatten,
+              "(struct/proto-flatten st)",
+              "Convert a struct with prototypes to a struct with no prototypes by merging "
+              "all key value pairs from recursive prototypes into one new struct.") {
+    janet_fixarity(argc, 1);
+    JanetStruct st = janet_getstruct(argv, 0);
+
+    /* get an upper bounds on the number of items in the final struct */
+    int64_t pair_count = 0;
+    JanetStruct cursor = st;
+    while (cursor) {
+        pair_count += janet_struct_length(cursor);
+        cursor = janet_struct_proto(cursor);
+    }
+
+    if (pair_count > INT32_MAX) {
+        janet_panic("struct too large");
+    }
+
+    JanetKV *accum = janet_struct_begin((int32_t) pair_count);
+    cursor = st;
+    while (cursor) {
+        for (int32_t i = 0; i < janet_struct_capacity(cursor); i++) {
+            const JanetKV *kv = cursor + i;
+            if (!janet_checktype(kv->key, JANET_NIL)) {
+                janet_struct_put_ext(accum, kv->key, kv->value, 0);
+            }
+        }
+        cursor = janet_struct_proto(cursor);
+    }
+    return janet_wrap_struct(janet_struct_end(accum));
+}
+
+JANET_CORE_FN(cfun_struct_to_table,
+              "(struct/to-table st &opt recursive)",
+              "Convert a struct to a table. If recursive is true, also convert the "
+              "table's prototypes into the new struct's prototypes as well.") {
+    janet_arity(argc, 1, 2);
+    JanetStruct st = janet_getstruct(argv, 0);
+    int recursive = argc > 1 && janet_truthy(argv[1]);
+    JanetTable *tab = NULL;
+    JanetStruct cursor = st;
+    JanetTable *tab_cursor = tab;
+    do {
+        if (tab) {
+            tab_cursor->proto = janet_table(janet_struct_length(cursor));
+            tab_cursor = tab_cursor->proto;
+        } else {
+            tab = janet_table(janet_struct_length(cursor));
+            tab_cursor = tab;
+        }
+        /* TODO - implement as memcpy since struct memory should be compatible
+         * with table memory */
+        for (int32_t i = 0; i < janet_struct_capacity(cursor); i++) {
+            const JanetKV *kv = cursor + i;
+            if (!janet_checktype(kv->key, JANET_NIL)) {
+                janet_table_put(tab_cursor, kv->key, kv->value);
+            }
+        }
+        cursor = janet_struct_proto(cursor);
+    } while (recursive && cursor);
+    return janet_wrap_table(tab);
+}
+
+/* Load the struct module */
+void janet_lib_struct(JanetTable *env) {
+    JanetRegExt struct_cfuns[] = {
+        JANET_CORE_REG("struct/with-proto", cfun_struct_with_proto),
+        JANET_CORE_REG("struct/getproto", cfun_struct_getproto),
+        JANET_CORE_REG("struct/proto-flatten", cfun_struct_flatten),
+        JANET_CORE_REG("struct/to-table", cfun_struct_to_table),
+        JANET_REG_END
+    };
+    janet_core_cfuns_ext(env, NULL, struct_cfuns);
+}

src/core/symcache.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
@@ -36,30 +36,26 @@
 
 #include <string.h>
 
-/* Cache state */
-JANET_THREAD_LOCAL const uint8_t **janet_vm_cache = NULL;
-JANET_THREAD_LOCAL uint32_t janet_vm_cache_capacity = 0;
-JANET_THREAD_LOCAL uint32_t janet_vm_cache_count = 0;
-JANET_THREAD_LOCAL uint32_t janet_vm_cache_deleted = 0;
-
 /* Initialize the cache (allocate cache memory) */
 void janet_symcache_init() {
-    janet_vm_cache_capacity = 1024;
-    janet_vm_cache = janet_calloc(1, (size_t) janet_vm_cache_capacity * sizeof(const uint8_t *));
-    if (NULL == janet_vm_cache) {
+    janet_vm.cache_capacity = 1024;
+    janet_vm.cache = janet_calloc(1, (size_t) janet_vm.cache_capacity * sizeof(const uint8_t *));
+    if (NULL == janet_vm.cache) {
         JANET_OUT_OF_MEMORY;
     }
-    janet_vm_cache_count = 0;
-    janet_vm_cache_deleted = 0;
+    memset(&janet_vm.gensym_counter, '0', sizeof(janet_vm.gensym_counter));
+    janet_vm.gensym_counter[0] = '_';
+    janet_vm.cache_count = 0;
+    janet_vm.cache_deleted = 0;
 }
 
 /* Deinitialize the cache (free the cache memory) */
 void janet_symcache_deinit() {
-    janet_free((void *)janet_vm_cache);
-    janet_vm_cache = NULL;
-    janet_vm_cache_capacity = 0;
-    janet_vm_cache_count = 0;
-    janet_vm_cache_deleted = 0;
+    janet_free((void *)janet_vm.cache);
+    janet_vm.cache = NULL;
+    janet_vm.cache_capacity = 0;
+    janet_vm.cache_count = 0;
+    janet_vm.cache_deleted = 0;
 }
 
 /* Mark an entry in the table as deleted. */
@@ -79,24 +75,24 @@ static const uint8_t **janet_symcache_findmem(
 
     /* We will search two ranges - index to the end,
      * and 0 to the index. */
-    index = (uint32_t)hash & (janet_vm_cache_capacity - 1);
+    index = (uint32_t)hash & (janet_vm.cache_capacity - 1);
     bounds[0] = index;
-    bounds[1] = janet_vm_cache_capacity;
+    bounds[1] = janet_vm.cache_capacity;
     bounds[2] = 0;
     bounds[3] = index;
     for (j = 0; j < 4; j += 2)
         for (i = bounds[j]; i < bounds[j + 1]; ++i) {
-            const uint8_t *test = janet_vm_cache[i];
+            const uint8_t *test = janet_vm.cache[i];
             /* Check empty spots */
             if (NULL == test) {
                 if (NULL == firstEmpty)
-                    firstEmpty = janet_vm_cache + i;
+                    firstEmpty = janet_vm.cache + i;
                 goto notfound;
             }
             /* Check for marked deleted */
             if (JANET_SYMCACHE_DELETED == test) {
                 if (firstEmpty == NULL)
-                    firstEmpty = janet_vm_cache + i;
+                    firstEmpty = janet_vm.cache + i;
                 continue;
             }
             if (janet_string_equalconst(test, str, len, hash)) {
@@ -104,10 +100,10 @@ static const uint8_t **janet_symcache_findmem(
                 *success = 1;
                 if (firstEmpty != NULL) {
                     *firstEmpty = test;
-                    janet_vm_cache[i] = JANET_SYMCACHE_DELETED;
+                    janet_vm.cache[i] = JANET_SYMCACHE_DELETED;
                     return firstEmpty;
                 }
-                return janet_vm_cache + i;
+                return janet_vm.cache + i;
             }
         }
 notfound:
@@ -121,15 +117,15 @@ notfound:
 /* Resize the cache. */
 static void janet_cache_resize(uint32_t newCapacity) {
     uint32_t i, oldCapacity;
-    const uint8_t **oldCache = janet_vm_cache;
+    const uint8_t **oldCache = janet_vm.cache;
     const uint8_t **newCache = janet_calloc(1, (size_t) newCapacity * sizeof(const uint8_t *));
     if (newCache == NULL) {
         JANET_OUT_OF_MEMORY;
     }
-    oldCapacity = janet_vm_cache_capacity;
-    janet_vm_cache = newCache;
-    janet_vm_cache_capacity = newCapacity;
-    janet_vm_cache_deleted = 0;
+    oldCapacity = janet_vm.cache_capacity;
+    janet_vm.cache = newCache;
+    janet_vm.cache_capacity = newCapacity;
+    janet_vm.cache_deleted = 0;
     /* Add all of the old cache entries back */
     for (i = 0; i < oldCapacity; ++i) {
         int status;
@@ -150,13 +146,13 @@ static void janet_cache_resize(uint32_t newCapacity) {
 
 /* Add an item to the cache */
 static void janet_symcache_put(const uint8_t *x, const uint8_t **bucket) {
-    if ((janet_vm_cache_count + janet_vm_cache_deleted) * 2 > janet_vm_cache_capacity) {
+    if ((janet_vm.cache_count + janet_vm.cache_deleted) * 2 > janet_vm.cache_capacity) {
         int status;
-        janet_cache_resize(janet_tablen((2 * janet_vm_cache_count + 1)));
+        janet_cache_resize(janet_tablen((2 * janet_vm.cache_count + 1)));
         bucket = janet_symcache_find(x, &status);
     }
     /* Add x to the cache */
-    janet_vm_cache_count++;
+    janet_vm.cache_count++;
     *bucket = x;
 }
 
@@ -165,8 +161,8 @@ void janet_symbol_deinit(const uint8_t *sym) {
     int status = 0;
     const uint8_t **bucket = janet_symcache_find(sym, &status);
     if (status) {
-        janet_vm_cache_count--;
-        janet_vm_cache_deleted++;
+        janet_vm.cache_count--;
+        janet_vm.cache_deleted++;
         *bucket = JANET_SYMCACHE_DELETED;
     }
 }
@@ -194,22 +190,19 @@ const uint8_t *janet_csymbol(const char *cstr) {
     return janet_symbol((const uint8_t *)cstr, (int32_t) strlen(cstr));
 }
 
-/* Store counter for genysm to avoid quadratic behavior */
-JANET_THREAD_LOCAL uint8_t gensym_counter[8] = {'_', '0', '0', '0', '0', '0', '0', 0};
-
 /* Increment the gensym buffer */
 static void inc_gensym(void) {
-    for (int i = sizeof(gensym_counter) - 2; i; i--) {
-        if (gensym_counter[i] == '9') {
-            gensym_counter[i] = 'a';
+    for (int i = sizeof(janet_vm.gensym_counter) - 2; i; i--) {
+        if (janet_vm.gensym_counter[i] == '9') {
+            janet_vm.gensym_counter[i] = 'a';
             break;
-        } else if (gensym_counter[i] == 'z') {
-            gensym_counter[i] = 'A';
+        } else if (janet_vm.gensym_counter[i] == 'z') {
+            janet_vm.gensym_counter[i] = 'A';
             break;
-        } else if (gensym_counter[i] == 'Z') {
-            gensym_counter[i] = '0';
+        } else if (janet_vm.gensym_counter[i] == 'Z') {
+            janet_vm.gensym_counter[i] = '0';
         } else {
-            gensym_counter[i]++;
+            janet_vm.gensym_counter[i]++;
             break;
         }
     }
@@ -227,19 +220,19 @@ const uint8_t *janet_symbol_gen(void) {
      * is enough for resolving collisions. */
     do {
         hash = janet_string_calchash(
-                   gensym_counter,
-                   sizeof(gensym_counter) - 1);
+                   janet_vm.gensym_counter,
+                   sizeof(janet_vm.gensym_counter) - 1);
         bucket = janet_symcache_findmem(
-                     gensym_counter,
-                     sizeof(gensym_counter) - 1,
+                     janet_vm.gensym_counter,
+                     sizeof(janet_vm.gensym_counter) - 1,
                      hash,
                      &status);
     } while (status && (inc_gensym(), 1));
-    JanetStringHead *head = janet_gcalloc(JANET_MEMORY_SYMBOL, sizeof(JanetStringHead) + sizeof(gensym_counter));
-    head->length = sizeof(gensym_counter) - 1;
+    JanetStringHead *head = janet_gcalloc(JANET_MEMORY_SYMBOL, sizeof(JanetStringHead) + sizeof(janet_vm.gensym_counter));
+    head->length = sizeof(janet_vm.gensym_counter) - 1;
     head->hash = hash;
     sym = (uint8_t *)(head->data);
-    memcpy(sym, gensym_counter, sizeof(gensym_counter));
+    memcpy(sym, janet_vm.gensym_counter, sizeof(janet_vm.gensym_counter));
     janet_symcache_put((const uint8_t *)sym, bucket);
     return (const uint8_t *)sym;
 }

src/core/symcache.h

@@ -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

src/core/table.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
@@ -67,14 +67,23 @@ static JanetTable *janet_table_init_impl(JanetTable *table, int32_t capacity, in
     return table;
 }
 
-/* Initialize a table */
+/* Initialize a table (for use withs scratch memory) */
 JanetTable *janet_table_init(JanetTable *table, int32_t capacity) {
     return janet_table_init_impl(table, capacity, 1);
 }
 
+/* Initialize a table without using scratch memory */
+JanetTable *janet_table_init_raw(JanetTable *table, int32_t capacity) {
+    return janet_table_init_impl(table, capacity, 0);
+}
+
 /* Deinitialize a table */
 void janet_table_deinit(JanetTable *table) {
-    janet_sfree(table->data);
+    if (table->gc.flags & JANET_TABLE_FLAG_STACK) {
+        janet_sfree(table->data);
+    } else {
+        janet_free(table->data);
+    }
 }
 
 /* Create a new table */
@@ -123,37 +132,21 @@ static void janet_table_rehash(JanetTable *t, int32_t size) {
 
 /* Get a value out of the table */
 Janet janet_table_get(JanetTable *t, Janet key) {
-    JanetKV *bucket = janet_table_find(t, key);
-    if (NULL != bucket && !janet_checktype(bucket->key, JANET_NIL))
-        return bucket->value;
-    /* Check prototypes */
-    {
-        int i;
-        for (i = JANET_MAX_PROTO_DEPTH, t = t->proto; t && i; t = t->proto, --i) {
-            bucket = janet_table_find(t, key);
-            if (NULL != bucket && !janet_checktype(bucket->key, JANET_NIL))
-                return bucket->value;
-        }
+    for (int i = JANET_MAX_PROTO_DEPTH; t && i; t = t->proto, --i) {
+        JanetKV *bucket = janet_table_find(t, key);
+        if (NULL != bucket && !janet_checktype(bucket->key, JANET_NIL))
+            return bucket->value;
     }
     return janet_wrap_nil();
 }
 
 /* Get a value out of the table, and record which prototype it was from. */
 Janet janet_table_get_ex(JanetTable *t, Janet key, JanetTable **which) {
-    JanetKV *bucket = janet_table_find(t, key);
-    if (NULL != bucket && !janet_checktype(bucket->key, JANET_NIL)) {
-        *which = t;
-        return bucket->value;
-    }
-    /* Check prototypes */
-    {
-        int i;
-        for (i = JANET_MAX_PROTO_DEPTH, t = t->proto; t && i; t = t->proto, --i) {
-            bucket = janet_table_find(t, key);
-            if (NULL != bucket && !janet_checktype(bucket->key, JANET_NIL)) {
-                *which = t;
-                return bucket->value;
-            }
+    for (int i = JANET_MAX_PROTO_DEPTH; t && i; t = t->proto, --i) {
+        JanetKV *bucket = janet_table_find(t, key);
+        if (NULL != bucket && !janet_checktype(bucket->key, JANET_NIL)) {
+            *which = t;
+            return bucket->value;
         }
     }
     return janet_wrap_nil();
@@ -208,6 +201,23 @@ void janet_table_put(JanetTable *t, Janet key, Janet value) {
     }
 }
 
+/* Used internally so don't check arguments
+ * Put into a table, but if the key already exists do nothing. */
+static void janet_table_put_no_overwrite(JanetTable *t, Janet key, Janet value) {
+    JanetKV *bucket = janet_table_find(t, key);
+    if (NULL != bucket && !janet_checktype(bucket->key, JANET_NIL))
+        return;
+    if (NULL == bucket || 2 * (t->count + t->deleted + 1) > t->capacity) {
+        janet_table_rehash(t, janet_tablen(2 * t->count + 2));
+    }
+    bucket = janet_table_find(t, key);
+    if (janet_checktype(bucket->value, JANET_BOOLEAN))
+        --t->deleted;
+    bucket->key = key;
+    bucket->value = value;
+    ++t->count;
+}
+
 /* Clear a table */
 void janet_table_clear(JanetTable *t) {
     int32_t capacity = t->capacity;
@@ -217,19 +227,6 @@ void janet_table_clear(JanetTable *t) {
     t->deleted = 0;
 }
 
-/* Convert table to struct */
-const JanetKV *janet_table_to_struct(JanetTable *t) {
-    JanetKV *st = janet_struct_begin(t->count);
-    JanetKV *kv = t->data;
-    JanetKV *end = t->data + t->capacity;
-    while (kv < end) {
-        if (!janet_checktype(kv->key, JANET_NIL))
-            janet_struct_put(st, kv->key, kv->value);
-        kv++;
-    }
-    return janet_struct_end(st);
-}
-
 /* Clone a table. */
 JanetTable *janet_table_clone(JanetTable *table) {
     JanetTable *newTable = janet_gcalloc(JANET_MEMORY_TABLE, sizeof(JanetTable));
@@ -266,15 +263,51 @@ void janet_table_merge_struct(JanetTable *table, const JanetKV *other) {
     janet_table_mergekv(table, other, janet_struct_capacity(other));
 }
 
+/* Convert table to struct */
+const JanetKV *janet_table_to_struct(JanetTable *t) {
+    JanetKV *st = janet_struct_begin(t->count);
+    JanetKV *kv = t->data;
+    JanetKV *end = t->data + t->capacity;
+    while (kv < end) {
+        if (!janet_checktype(kv->key, JANET_NIL))
+            janet_struct_put(st, kv->key, kv->value);
+        kv++;
+    }
+    return janet_struct_end(st);
+}
+
+JanetTable *janet_table_proto_flatten(JanetTable *t) {
+    JanetTable *newTable = janet_table(0);
+    while (t) {
+        JanetKV *kv = t->data;
+        JanetKV *end = t->data + t->capacity;
+        while (kv < end) {
+            if (!janet_checktype(kv->key, JANET_NIL))
+                janet_table_put_no_overwrite(newTable, kv->key, kv->value);
+            kv++;
+        }
+        t = t->proto;
+    }
+    return newTable;
+}
+
 /* C Functions */
 
-static Janet cfun_table_new(int32_t argc, Janet *argv) {
+JANET_CORE_FN(cfun_table_new,
+              "(table/new capacity)",
+              "Creates a new empty table with pre-allocated memory "
+              "for `capacity` entries. This means that if one knows the number of "
+              "entries going into a table on creation, extra memory allocation "
+              "can be avoided. Returns the new table.") {
     janet_fixarity(argc, 1);
-    int32_t cap = janet_getinteger(argv, 0);
+    int32_t cap = janet_getnat(argv, 0);
     return janet_wrap_table(janet_table(cap));
 }
 
-static Janet cfun_table_getproto(int32_t argc, Janet *argv) {
+JANET_CORE_FN(cfun_table_getproto,
+              "(table/getproto tab)",
+              "Get the prototype table of a table. Returns nil if the table "
+              "has no prototype, otherwise returns the prototype.") {
     janet_fixarity(argc, 1);
     JanetTable *t = janet_gettable(argv, 0);
     return t->proto
@@ -282,7 +315,9 @@ static Janet cfun_table_getproto(int32_t argc, Janet *argv) {
            : janet_wrap_nil();
 }
 
-static Janet cfun_table_setproto(int32_t argc, Janet *argv) {
+JANET_CORE_FN(cfun_table_setproto,
+              "(table/setproto tab proto)",
+              "Set the prototype of a table. Returns the original table `tab`.") {
     janet_fixarity(argc, 2);
     JanetTable *table = janet_gettable(argv, 0);
     JanetTable *proto = NULL;
@@ -293,67 +328,63 @@ static Janet cfun_table_setproto(int32_t argc, Janet *argv) {
     return argv[0];
 }
 
-static Janet cfun_table_tostruct(int32_t argc, Janet *argv) {
+JANET_CORE_FN(cfun_table_tostruct,
+              "(table/to-struct tab)",
+              "Convert a table to a struct. Returns a new struct. This function "
+              "does not take into account prototype tables.") {
     janet_fixarity(argc, 1);
     JanetTable *t = janet_gettable(argv, 0);
     return janet_wrap_struct(janet_table_to_struct(t));
 }
 
-static Janet cfun_table_rawget(int32_t argc, Janet *argv) {
+JANET_CORE_FN(cfun_table_rawget,
+              "(table/rawget tab key)",
+              "Gets a value from a table `tab` without looking at the prototype table. "
+              "If `tab` does not contain the key directly, the function will return "
+              "nil without checking the prototype. Returns the value in the table.") {
     janet_fixarity(argc, 2);
     JanetTable *table = janet_gettable(argv, 0);
     return janet_table_rawget(table, argv[1]);
 }
 
-static Janet cfun_table_clone(int32_t argc, Janet *argv) {
+JANET_CORE_FN(cfun_table_clone,
+              "(table/clone tab)",
+              "Create a copy of a table. Updates to the new table will not change the old table, "
+              "and vice versa.") {
     janet_fixarity(argc, 1);
     JanetTable *table = janet_gettable(argv, 0);
     return janet_wrap_table(janet_table_clone(table));
 }
 
-static const JanetReg table_cfuns[] = {
-    {
-        "table/new", cfun_table_new,
-        JDOC("(table/new capacity)\n\n"
-             "Creates a new empty table with pre-allocated memory "
-             "for capacity entries. This means that if one knows the number of "
-             "entries going to go in a table on creation, extra memory allocation "
-             "can be avoided. Returns the new table.")
-    },
-    {
-        "table/to-struct", cfun_table_tostruct,
-        JDOC("(table/to-struct tab)\n\n"
-             "Convert a table to a struct. Returns a new struct. This function "
-             "does not take into account prototype tables.")
-    },
-    {
-        "table/getproto", cfun_table_getproto,
-        JDOC("(table/getproto tab)\n\n"
-             "Get the prototype table of a table. Returns nil if a table "
-             "has no prototype, otherwise returns the prototype.")
-    },
-    {
-        "table/setproto", cfun_table_setproto,
-        JDOC("(table/setproto tab proto)\n\n"
-             "Set the prototype of a table. Returns the original table tab.")
-    },
-    {
-        "table/rawget", cfun_table_rawget,
-        JDOC("(table/rawget tab key)\n\n"
-             "Gets a value from a table without looking at the prototype table. "
-             "If a table tab does not contain t directly, the function will return "
-             "nil without checking the prototype. Returns the value in the table.")
-    },
-    {
-        "table/clone", cfun_table_clone,
-        JDOC("(table/clone tab)\n\n"
-             "Create a copy of a table. Updates to the new table will not change the old table, "
-             "and vice versa.")
-    },
-    {NULL, NULL, NULL}
-};
+JANET_CORE_FN(cfun_table_clear,
+              "(table/clear tab)",
+              "Remove all key-value pairs in a table and return the modified table `tab`.") {
+    janet_fixarity(argc, 1);
+    JanetTable *table = janet_gettable(argv, 0);
+    janet_table_clear(table);
+    return janet_wrap_table(table);
+}
+
+JANET_CORE_FN(cfun_table_proto_flatten,
+              "(table/proto-flatten tab)",
+              "Create a new table that is the result of merging all prototypes into a new table.") {
+    janet_fixarity(argc, 1);
+    JanetTable *table = janet_gettable(argv, 0);
+    return janet_wrap_table(janet_table_proto_flatten(table));
+}
 
 /* Load the table module */
 void janet_lib_table(JanetTable *env) {
-    janet_core_cfuns(env, NULL, table_cfuns);
+    JanetRegExt table_cfuns[] = {
+        JANET_CORE_REG("table/new", cfun_table_new),
+        JANET_CORE_REG("table/to-struct", cfun_table_tostruct),
+        JANET_CORE_REG("table/getproto", cfun_table_getproto),
+        JANET_CORE_REG("table/setproto", cfun_table_setproto),
+        JANET_CORE_REG("table/rawget", cfun_table_rawget),
+        JANET_CORE_REG("table/clone", cfun_table_clone),
+        JANET_CORE_REG("table/clear", cfun_table_clear),
+        JANET_CORE_REG("table/proto-flatten", cfun_table_proto_flatten),
+        JANET_REG_END
+    };
+    janet_core_cfuns_ext(env, NULL, table_cfuns);
 }

src/core/thread.c

@@ -1,781 +0,0 @@
-/*
-* Copyright (c) 2021 Calvin Rose
-*
-* Permission is hereby granted, free of charge, to any person obtaining a copy
-* of this software and associated documentation files (the "Software"), to
-* deal in the Software without restriction, including without limitation the
-* rights to use, copy, modify, merge, publish, distribute, sublicense, and/or
-* sell copies of the Software, and to permit persons to whom the Software is
-* furnished to do so, subject to the following conditions:
-*
-* The above copyright notice and this permission notice shall be included in
-* all copies or substantial portions of the Software.
-*
-* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
-* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
-* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
-* AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
-* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
-* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS
-* IN THE SOFTWARE.
-*/
-
-#ifndef JANET_AMALG
-#include "features.h"
-#include <janet.h>
-#include "gc.h"
-#include "util.h"
-#include "state.h"
-#endif
-
-#ifdef JANET_THREADS
-
-#include <math.h>
-#ifdef JANET_WINDOWS
-#include <windows.h>
-#else
-#include <setjmp.h>
-#include <time.h>
-#include <pthread.h>
-#endif
-
-/* typedefed in janet.h */
-struct JanetMailbox {
-
-    /* Synchronization */
-#ifdef JANET_WINDOWS
-    CRITICAL_SECTION lock;
-    CONDITION_VARIABLE cond;
-#else
-    pthread_mutex_t lock;
-    pthread_cond_t cond;
-#endif
-
-    /* Memory management - reference counting */
-    int refCount;
-    int closed;
-
-    /* Store messages */
-    uint16_t messageCapacity;
-    uint16_t messageCount;
-    uint16_t messageFirst;
-    uint16_t messageNext;
-
-    /* Buffers to store messages. These buffers are manually allocated, so
-     * are not owned by any thread's GC. */
-    JanetBuffer messages[];
-};
-
-#define JANET_THREAD_HEAVYWEIGHT 0x1
-#define JANET_THREAD_ABSTRACTS 0x2
-#define JANET_THREAD_CFUNCTIONS 0x4
-static const char janet_thread_flags[] = "hac";
-
-typedef struct {
-    JanetMailbox *original;
-    JanetMailbox *newbox;
-    uint64_t flags;
-} JanetMailboxPair;
-
-static JANET_THREAD_LOCAL JanetMailbox *janet_vm_mailbox = NULL;
-static JANET_THREAD_LOCAL JanetThread *janet_vm_thread_current = NULL;
-static JANET_THREAD_LOCAL JanetTable *janet_vm_thread_decode = NULL;
-
-static JanetTable *janet_thread_get_decode(void) {
-    if (janet_vm_thread_decode == NULL) {
-        janet_vm_thread_decode = janet_get_core_table("load-image-dict");
-        if (NULL == janet_vm_thread_decode) {
-            janet_vm_thread_decode = janet_table(0);
-        }
-        janet_gcroot(janet_wrap_table(janet_vm_thread_decode));
-    }
-    return janet_vm_thread_decode;
-}
-
-static JanetMailbox *janet_mailbox_create(int refCount, uint16_t capacity) {
-    JanetMailbox *mailbox = janet_malloc(sizeof(JanetMailbox) + sizeof(JanetBuffer) * (size_t) capacity);
-    if (NULL == mailbox) {
-        JANET_OUT_OF_MEMORY;
-    }
-#ifdef JANET_WINDOWS
-    InitializeCriticalSection(&mailbox->lock);
-    InitializeConditionVariable(&mailbox->cond);
-#else
-    pthread_mutex_init(&mailbox->lock, NULL);
-    pthread_cond_init(&mailbox->cond, NULL);
-#endif
-    mailbox->refCount = refCount;
-    mailbox->closed = 0;
-    mailbox->messageCount = 0;
-    mailbox->messageCapacity = capacity;
-    mailbox->messageFirst = 0;
-    mailbox->messageNext = 0;
-    for (uint16_t i = 0; i < capacity; i++) {
-        janet_buffer_init(mailbox->messages + i, 0);
-    }
-    return mailbox;
-}
-
-static void janet_mailbox_destroy(JanetMailbox *mailbox) {
-#ifdef JANET_WINDOWS
-    DeleteCriticalSection(&mailbox->lock);
-#else
-    pthread_mutex_destroy(&mailbox->lock);
-    pthread_cond_destroy(&mailbox->cond);
-#endif
-    for (uint16_t i = 0; i < mailbox->messageCapacity; i++) {
-        janet_buffer_deinit(mailbox->messages + i);
-    }
-    janet_free(mailbox);
-}
-
-static void janet_mailbox_lock(JanetMailbox *mailbox) {
-#ifdef JANET_WINDOWS
-    EnterCriticalSection(&mailbox->lock);
-#else
-    pthread_mutex_lock(&mailbox->lock);
-#endif
-}
-
-static void janet_mailbox_unlock(JanetMailbox *mailbox) {
-#ifdef JANET_WINDOWS
-    LeaveCriticalSection(&mailbox->lock);
-#else
-    pthread_mutex_unlock(&mailbox->lock);
-#endif
-}
-
-/* Assumes you have the mailbox lock already */
-static void janet_mailbox_ref_with_lock(JanetMailbox *mailbox, int delta) {
-    mailbox->refCount += delta;
-    if (mailbox->refCount <= 0) {
-        janet_mailbox_unlock(mailbox);
-        janet_mailbox_destroy(mailbox);
-    } else {
-        janet_mailbox_unlock(mailbox);
-    }
-}
-
-static void janet_mailbox_ref(JanetMailbox *mailbox, int delta) {
-    janet_mailbox_lock(mailbox);
-    janet_mailbox_ref_with_lock(mailbox, delta);
-}
-
-static void janet_close_thread(JanetThread *thread) {
-    if (thread->mailbox) {
-        janet_mailbox_ref(thread->mailbox, -1);
-        thread->mailbox = NULL;
-    }
-}
-
-static int thread_gc(void *p, size_t size) {
-    (void) size;
-    JanetThread *thread = (JanetThread *)p;
-    janet_close_thread(thread);
-    return 0;
-}
-
-static int thread_mark(void *p, size_t size) {
-    (void) size;
-    JanetThread *thread = (JanetThread *)p;
-    if (thread->encode) {
-        janet_mark(janet_wrap_table(thread->encode));
-    }
-    return 0;
-}
-
-static JanetMailboxPair *make_mailbox_pair(JanetMailbox *original, uint64_t flags) {
-    JanetMailboxPair *pair = janet_malloc(sizeof(JanetMailboxPair));
-    if (NULL == pair) {
-        JANET_OUT_OF_MEMORY;
-    }
-    pair->original = original;
-    janet_mailbox_ref(original, 1);
-    pair->newbox = janet_mailbox_create(1, 16);
-    pair->flags = flags;
-    return pair;
-}
-
-static void destroy_mailbox_pair(JanetMailboxPair *pair) {
-    janet_mailbox_ref(pair->original, -1);
-    janet_mailbox_ref(pair->newbox, -1);
-    janet_free(pair);
-}
-
-/* Abstract waiting for timeout across windows/posix */
-typedef struct {
-    int timedwait;
-    int nowait;
-#ifdef JANET_WINDOWS
-    DWORD interval;
-    DWORD ticksLeft;
-#else
-    struct timespec ts;
-#endif
-} JanetWaiter;
-
-static void janet_waiter_init(JanetWaiter *waiter, double sec) {
-    waiter->timedwait = 0;
-    waiter->nowait = 0;
-
-    if (sec <= 0.0 || isnan(sec)) {
-        waiter->nowait = 1;
-        return;
-    }
-    waiter->timedwait = sec > 0.0 && !isinf(sec);
-
-    /* Set maximum wait time to 30 days */
-    if (sec > (60.0 * 60.0 * 24.0 * 30.0)) {
-        sec = 60.0 * 60.0 * 24.0 * 30.0;
-    }
-
-#ifdef JANET_WINDOWS
-    if (waiter->timedwait) {
-        waiter->ticksLeft = waiter->interval = (DWORD) floor(1000.0 * sec);
-    }
-#else
-    if (waiter->timedwait) {
-        /* N seconds -> timespec of (now + sec) */
-        struct timespec now;
-        janet_gettime(&now);
-        time_t tvsec = (time_t) floor(sec);
-        long tvnsec = (long) floor(1000000000.0 * (sec - ((double) tvsec)));
-        tvsec += now.tv_sec;
-        tvnsec += now.tv_nsec;
-        if (tvnsec >= 1000000000L) {
-            tvnsec -= 1000000000L;
-            tvsec += 1;
-        }
-        waiter->ts.tv_sec = tvsec;
-        waiter->ts.tv_nsec = tvnsec;
-    }
-#endif
-}
-
-static int janet_waiter_wait(JanetWaiter *wait, JanetMailbox *mailbox) {
-    if (wait->nowait) return 1;
-#ifdef JANET_WINDOWS
-    if (wait->timedwait) {
-        if (wait->ticksLeft == 0) return 1;
-        DWORD startTime = GetTickCount();
-        int status = !SleepConditionVariableCS(&mailbox->cond, &mailbox->lock, wait->ticksLeft);
-        DWORD dTick = GetTickCount() - startTime;
-        /* Be careful about underflow */
-        wait->ticksLeft = dTick > wait->ticksLeft ? 0 : dTick;
-        return status;
-    } else {
-        SleepConditionVariableCS(&mailbox->cond, &mailbox->lock, INFINITE);
-        return 0;
-    }
-#else
-    if (wait->timedwait) {
-        return pthread_cond_timedwait(&mailbox->cond, &mailbox->lock, &wait->ts);
-    } else {
-        pthread_cond_wait(&mailbox->cond, &mailbox->lock);
-        return 0;
-    }
-#endif
-}
-
-static void janet_mailbox_wakeup(JanetMailbox *mailbox) {
-#ifdef JANET_WINDOWS
-    WakeConditionVariable(&mailbox->cond);
-#else
-    pthread_cond_signal(&mailbox->cond);
-#endif
-}
-
-static int mailbox_at_capacity(JanetMailbox *mailbox) {
-    return mailbox->messageCount >= mailbox->messageCapacity;
-}
-
-/* Returns 1 if could not send (encode error or timeout), 2 for mailbox closed, and
- * 0 otherwise. Will not panic.  */
-int janet_thread_send(JanetThread *thread, Janet msg, double timeout) {
-
-    /* Ensure mailbox is not closed. */
-    JanetMailbox *mailbox = thread->mailbox;
-    if (NULL == mailbox) return 2;
-    janet_mailbox_lock(mailbox);
-    if (mailbox->closed) {
-        janet_mailbox_ref_with_lock(mailbox, -1);
-        thread->mailbox = NULL;
-        return 2;
-    }
-
-    /* Back pressure */
-    if (mailbox_at_capacity(mailbox)) {
-        JanetWaiter wait;
-        janet_waiter_init(&wait, timeout);
-
-        if (wait.nowait) {
-            janet_mailbox_unlock(mailbox);
-            return 1;
-        }
-
-        /* Retry loop, as there can be multiple writers */
-        while (mailbox_at_capacity(mailbox)) {
-            if (janet_waiter_wait(&wait, mailbox)) {
-                janet_mailbox_unlock(mailbox);
-                janet_mailbox_wakeup(mailbox);
-                return 1;
-            }
-        }
-    }
-
-    /* Hack to capture all panics from marshalling. This works because
-     * we know janet_marshal won't mess with other essential global state. */
-    jmp_buf buf;
-    jmp_buf *old_buf = janet_vm_jmp_buf;
-    janet_vm_jmp_buf = &buf;
-    int32_t oldmcount = mailbox->messageCount;
-
-    int ret = 0;
-    if (setjmp(buf)) {
-        ret = 1;
-        mailbox->messageCount = oldmcount;
-    } else {
-        JanetBuffer *msgbuf = mailbox->messages + mailbox->messageNext;
-        msgbuf->count = 0;
-
-        /* Start panic zone */
-        janet_marshal(msgbuf, msg, thread->encode, JANET_MARSHAL_UNSAFE);
-        /* End panic zone */
-
-        mailbox->messageNext = (mailbox->messageNext + 1) % mailbox->messageCapacity;
-        mailbox->messageCount++;
-    }
-
-    /* Cleanup */
-    janet_vm_jmp_buf = old_buf;
-    janet_mailbox_unlock(mailbox);
-
-    /* Potentially wake up a blocked thread */
-    janet_mailbox_wakeup(mailbox);
-
-    return ret;
-}
-
-/* Returns 0 on successful message. Returns 1 if timedout */
-int janet_thread_receive(Janet *msg_out, double timeout) {
-    JanetMailbox *mailbox = janet_vm_mailbox;
-    janet_mailbox_lock(mailbox);
-
-    /* For timeouts */
-    JanetWaiter wait;
-    janet_waiter_init(&wait, timeout);
-
-    for (;;) {
-
-        /* Check for messages waiting for us */
-        if (mailbox->messageCount > 0) {
-
-            /* Hack to capture all panics from marshalling. This works because
-             * we know janet_marshal won't mess with other essential global state. */
-            jmp_buf buf;
-            jmp_buf *old_buf = janet_vm_jmp_buf;
-            janet_vm_jmp_buf = &buf;
-
-            /* Handle errors */
-            if (setjmp(buf)) {
-                /* Cleanup jmp_buf, return error.
-                 * Do not ignore bad messages as before. */
-                janet_vm_jmp_buf = old_buf;
-                *msg_out = *janet_vm_return_reg;
-                janet_mailbox_unlock(mailbox);
-                return 2;
-            } else {
-                JanetBuffer *msgbuf = mailbox->messages + mailbox->messageFirst;
-                mailbox->messageCount--;
-                mailbox->messageFirst = (mailbox->messageFirst + 1) % mailbox->messageCapacity;
-
-                /* Read from beginning of channel */
-                const uint8_t *nextItem = NULL;
-                Janet item = janet_unmarshal(
-                                 msgbuf->data, msgbuf->count,
-                                 JANET_MARSHAL_UNSAFE, janet_thread_get_decode(), &nextItem);
-                *msg_out = item;
-
-                /* Cleanup */
-                janet_vm_jmp_buf = old_buf;
-                janet_mailbox_unlock(mailbox);
-
-                /* Potentially wake up pending threads */
-                janet_mailbox_wakeup(mailbox);
-
-                return 0;
-            }
-        }
-
-        if (wait.nowait) {
-            janet_mailbox_unlock(mailbox);
-            return 1;
-        }
-
-        /* Wait for next message */
-        if (janet_waiter_wait(&wait, mailbox)) {
-            janet_mailbox_unlock(mailbox);
-            return 1;
-        }
-    }
-}
-
-static int janet_thread_getter(void *p, Janet key, Janet *out);
-static Janet janet_thread_next(void *p, Janet key);
-
-const JanetAbstractType janet_thread_type = {
-    "core/thread",
-    thread_gc,
-    thread_mark,
-    janet_thread_getter,
-    NULL, /* put */
-    NULL, /* marshal */
-    NULL, /* unmarshal */
-    NULL, /* tostring */
-    NULL, /* compare */
-    NULL, /* hash */
-    janet_thread_next,
-    JANET_ATEND_NEXT
-};
-
-static JanetThread *janet_make_thread(JanetMailbox *mailbox, JanetTable *encode) {
-    JanetThread *thread = janet_abstract(&janet_thread_type, sizeof(JanetThread));
-    janet_mailbox_ref(mailbox, 1);
-    thread->mailbox = mailbox;
-    thread->encode = encode;
-    return thread;
-}
-
-JanetThread *janet_getthread(const Janet *argv, int32_t n) {
-    return (JanetThread *) janet_getabstract(argv, n, &janet_thread_type);
-}
-
-/* Runs in new thread */
-static int thread_worker(JanetMailboxPair *pair) {
-    JanetFiber *fiber = NULL;
-    Janet out;
-
-    /* Use the mailbox we were given */
-    janet_vm_mailbox = pair->newbox;
-    janet_mailbox_ref(pair->newbox, 1);
-
-    /* Init VM */
-    janet_init();
-
-    /* Get dictionaries for default encode/decode */
-    JanetTable *encode;
-    if (pair->flags & JANET_THREAD_HEAVYWEIGHT) {
-        encode = janet_get_core_table("make-image-dict");
-    } else {
-        encode = NULL;
-        janet_vm_thread_decode = janet_table(0);
-        janet_gcroot(janet_wrap_table(janet_vm_thread_decode));
-    }
-
-    /* Create parent thread */
-    JanetThread *parent = janet_make_thread(pair->original, encode);
-    Janet parentv = janet_wrap_abstract(parent);
-
-    /* Unmarshal the abstract registry */
-    if (pair->flags & JANET_THREAD_ABSTRACTS) {
-        Janet reg;
-        int status = janet_thread_receive(&reg, INFINITY);
-        if (status) goto error;
-        if (!janet_checktype(reg, JANET_TABLE)) goto error;
-        janet_gcunroot(janet_wrap_table(janet_vm_abstract_registry));
-        janet_vm_abstract_registry = janet_unwrap_table(reg);
-        janet_gcroot(janet_wrap_table(janet_vm_abstract_registry));
-    }
-
-    /* Unmarshal the normal registry */
-    if (pair->flags & JANET_THREAD_CFUNCTIONS) {
-        Janet reg;
-        int status = janet_thread_receive(&reg, INFINITY);
-        if (status) goto error;
-        if (!janet_checktype(reg, JANET_TABLE)) goto error;
-        janet_gcunroot(janet_wrap_table(janet_vm_registry));
-        janet_vm_registry = janet_unwrap_table(reg);
-        janet_gcroot(janet_wrap_table(janet_vm_registry));
-    }
-
-    /* Unmarshal the function */
-    Janet funcv;
-    int status = janet_thread_receive(&funcv, INFINITY);
-    if (status) goto error;
-    if (!janet_checktype(funcv, JANET_FUNCTION)) goto error;
-    JanetFunction *func = janet_unwrap_function(funcv);
-
-    /* Arity check */
-    if (func->def->min_arity > 1 || func->def->max_arity < 1) {
-        goto error;
-    }
-
-    /* Call function */
-    Janet argv[1] = { parentv };
-    fiber = janet_fiber(func, 64, 1, argv);
-    if (pair->flags & JANET_THREAD_HEAVYWEIGHT) {
-        fiber->env = janet_table(0);
-        fiber->env->proto = janet_core_env(NULL);
-    }
-    JanetSignal sig = janet_continue(fiber, janet_wrap_nil(), &out);
-    if (sig != JANET_SIGNAL_OK && sig < JANET_SIGNAL_USER0) {
-        janet_eprintf("in thread %v: ", janet_wrap_abstract(janet_make_thread(pair->newbox, encode)));
-        janet_stacktrace(fiber, out);
-    }
-
-#ifdef JANET_EV
-    janet_loop();
-#endif
-
-    /* Normal exit */
-    destroy_mailbox_pair(pair);
-    janet_deinit();
-    return 0;
-
-    /* Fail to set something up */
-error:
-    destroy_mailbox_pair(pair);
-    janet_eprintf("\nthread failed to start\n");
-    janet_deinit();
-    return 1;
-}
-
-#ifdef JANET_WINDOWS
-
-static DWORD WINAPI janet_create_thread_wrapper(LPVOID param) {
-    thread_worker((JanetMailboxPair *)param);
-    return 0;
-}
-
-static int janet_thread_start_child(JanetMailboxPair *pair) {
-    HANDLE handle = CreateThread(NULL, 0, janet_create_thread_wrapper, pair, 0, NULL);
-    int ret = NULL == handle;
-    /* Does not kill thread, simply detatches */
-    if (!ret) CloseHandle(handle);
-    return ret;
-}
-
-#else
-
-static void *janet_pthread_wrapper(void *param) {
-    thread_worker((JanetMailboxPair *)param);
-    return NULL;
-}
-
-static int janet_thread_start_child(JanetMailboxPair *pair) {
-    pthread_t handle;
-    int error = pthread_create(&handle, NULL, janet_pthread_wrapper, pair);
-    if (error) {
-        return 1;
-    } else {
-        pthread_detach(handle);
-        return 0;
-    }
-}
-
-#endif
-
-/*
- * Setup/Teardown
- */
-
-void janet_threads_init(void) {
-    if (NULL == janet_vm_mailbox) {
-        janet_vm_mailbox = janet_mailbox_create(1, 10);
-    }
-    janet_vm_thread_decode = NULL;
-    janet_vm_thread_current = NULL;
-}
-
-void janet_threads_deinit(void) {
-    janet_mailbox_lock(janet_vm_mailbox);
-    janet_vm_mailbox->closed = 1;
-    janet_mailbox_ref_with_lock(janet_vm_mailbox, -1);
-    janet_vm_mailbox = NULL;
-    janet_vm_thread_current = NULL;
-    janet_vm_thread_decode = NULL;
-}
-
-JanetThread *janet_thread_current(void) {
-    if (NULL == janet_vm_thread_current) {
-        janet_vm_thread_current = janet_make_thread(janet_vm_mailbox, janet_get_core_table("make-image-dict"));
-        janet_gcroot(janet_wrap_abstract(janet_vm_thread_current));
-    }
-    return janet_vm_thread_current;
-}
-
-/*
- * Cfuns
- */
-
-static Janet cfun_thread_current(int32_t argc, Janet *argv) {
-    (void) argv;
-    janet_fixarity(argc, 0);
-    return janet_wrap_abstract(janet_thread_current());
-}
-
-static Janet cfun_thread_new(int32_t argc, Janet *argv) {
-    janet_arity(argc, 1, 3);
-    /* Just type checking */
-    janet_getfunction(argv, 0);
-    int32_t cap = janet_optinteger(argv, argc, 1, 10);
-    if (cap < 1 || cap > UINT16_MAX) {
-        janet_panicf("bad slot #1, expected integer in range [1, 65535], got %d", cap);
-    }
-    uint64_t flags = argc >= 3 ? janet_getflags(argv, 2, janet_thread_flags) : JANET_THREAD_ABSTRACTS;
-    JanetTable *encode;
-    if (flags & JANET_THREAD_HEAVYWEIGHT) {
-        encode = janet_get_core_table("make-image-dict");
-    } else {
-        encode = NULL;
-    }
-
-    JanetMailboxPair *pair = make_mailbox_pair(janet_vm_mailbox, flags);
-    JanetThread *thread = janet_make_thread(pair->newbox, encode);
-    if (janet_thread_start_child(pair)) {
-        destroy_mailbox_pair(pair);
-        janet_panic("could not start thread");
-    }
-
-    if (flags & JANET_THREAD_ABSTRACTS) {
-        if (janet_thread_send(thread, janet_wrap_table(janet_vm_abstract_registry), INFINITY)) {
-            janet_panic("could not send abstract registry to thread");
-        }
-    }
-
-    if (flags & JANET_THREAD_CFUNCTIONS) {
-        if (janet_thread_send(thread, janet_wrap_table(janet_vm_registry), INFINITY)) {
-            janet_panic("could not send registry to thread");
-        }
-    }
-
-    /* If thread started, send the worker function. */
-    if (janet_thread_send(thread, argv[0], INFINITY)) {
-        janet_panicf("could not send worker function %v to thread", argv[0]);
-    }
-
-    return janet_wrap_abstract(thread);
-}
-
-static Janet cfun_thread_send(int32_t argc, Janet *argv) {
-    janet_arity(argc, 2, 3);
-    JanetThread *thread = janet_getthread(argv, 0);
-    int status = janet_thread_send(thread, argv[1], janet_optnumber(argv, argc, 2, 1.0));
-    switch (status) {
-        default:
-            break;
-        case 1:
-            janet_panicf("failed to send message %v", argv[1]);
-        case 2:
-            janet_panic("thread mailbox is closed");
-    }
-    return argv[0];
-}
-
-static Janet cfun_thread_receive(int32_t argc, Janet *argv) {
-    janet_arity(argc, 0, 1);
-    double wait = janet_optnumber(argv, argc, 0, 1.0);
-    Janet out;
-    int status = janet_thread_receive(&out, wait);
-    switch (status) {
-        default:
-            break;
-        case 1:
-            janet_panicf("timeout after %f seconds", wait);
-        case 2:
-            janet_panicf("failed to receive message: %v", out);
-    }
-    return out;
-}
-
-static Janet cfun_thread_close(int32_t argc, Janet *argv) {
-    janet_fixarity(argc, 1);
-    JanetThread *thread = janet_getthread(argv, 0);
-    janet_close_thread(thread);
-    return janet_wrap_nil();
-}
-
-static Janet cfun_thread_exit(int32_t argc, Janet *argv) {
-    (void) argv;
-    janet_arity(argc, 0, 1);
-#if defined(JANET_WINDOWS)
-    int32_t flag = janet_optinteger(argv, argc, 0, 0);
-    ExitThread(flag);
-#else
-    pthread_exit(NULL);
-#endif
-    return janet_wrap_nil();
-}
-
-static const JanetMethod janet_thread_methods[] = {
-    {"send", cfun_thread_send},
-    {"close", cfun_thread_close},
-    {NULL, NULL}
-};
-
-static int janet_thread_getter(void *p, Janet key, Janet *out) {
-    (void) p;
-    if (!janet_checktype(key, JANET_KEYWORD)) return 0;
-    return janet_getmethod(janet_unwrap_keyword(key), janet_thread_methods, out);
-}
-
-static Janet janet_thread_next(void *p, Janet key) {
-    (void) p;
-    return janet_nextmethod(janet_thread_methods, key);
-}
-
-static const JanetReg threadlib_cfuns[] = {
-    {
-        "thread/current", cfun_thread_current,
-        JDOC("(thread/current)\n\n"
-             "Get the current running thread.")
-    },
-    {
-        "thread/new", cfun_thread_new,
-        JDOC("(thread/new func &opt capacity flags)\n\n"
-             "Start a new thread that will start immediately. "
-             "If capacity is provided, that is how many messages can be stored in the thread's mailbox before blocking senders. "
-             "The capacity must be between 1 and 65535 inclusive, and defaults to 10. "
-             "Can optionally provide flags to the new thread - supported flags are:\n\n"
-             "* :h - Start a heavyweight thread. This loads the core environment by default, so may use more memory initially. Messages may compress better, though.\n\n"
-             "* :a - Allow sending over registered abstract types to the new thread\n\n"
-             "* :c - Send over cfunction information to the new thread.\n\n"
-             "Returns a handle to the new thread.")
-    },
-    {
-        "thread/send", cfun_thread_send,
-        JDOC("(thread/send thread msgi &opt timeout)\n\n"
-             "Send a message to the thread. By default, the timeout is 1 second, but an optional timeout "
-             "in seconds can be provided. Use math/inf for no timeout. "
-             "Will throw an error if there is a problem sending the message.")
-    },
-    {
-        "thread/receive", cfun_thread_receive,
-        JDOC("(thread/receive &opt timeout)\n\n"
-             "Get a message sent to this thread. If timeout (in seconds) is provided, an error "
-             "will be thrown after the timeout has elapsed but "
-             "no messages are received. The default timeout is 1 second, and math/inf cam be passed to "
-             "turn off the timeout.")
-    },
-    {
-        "thread/close", cfun_thread_close,
-        JDOC("(thread/close thread)\n\n"
-             "Close a thread, unblocking it and ending communication with it. Note that closing "
-             "a thread is idempotent and does not cancel the thread's operation. Returns nil.")
-    },
-    {
-        "thread/exit", cfun_thread_exit,
-        JDOC("(thread/exit &opt code)\n\n"
-             "Exit from the current thread. If no more threads are running, ends the process, but otherwise does "
-             "not end the current process.")
-    },
-    {NULL, NULL, NULL}
-};
-
-/* Module entry point */
-void janet_lib_thread(JanetTable *env) {
-    janet_core_cfuns(env, NULL, threadlib_cfuns);
-    janet_register_abstract_type(&janet_thread_type);
-}
-
-#endif

src/core/tuple.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
@@ -55,19 +55,35 @@ const Janet *janet_tuple_n(const Janet *values, int32_t n) {
 
 /* C Functions */
 
-static Janet cfun_tuple_brackets(int32_t argc, Janet *argv) {
+JANET_CORE_FN(cfun_tuple_brackets,
+              "(tuple/brackets & xs)",
+              "Creates a new bracketed tuple containing the elements xs.") {
     const Janet *tup = janet_tuple_n(argv, argc);
     janet_tuple_flag(tup) |= JANET_TUPLE_FLAG_BRACKETCTOR;
     return janet_wrap_tuple(tup);
 }
 
-static Janet cfun_tuple_slice(int32_t argc, Janet *argv) {
+JANET_CORE_FN(cfun_tuple_slice,
+              "(tuple/slice arrtup [,start=0 [,end=(length arrtup)]])",
+              "Take a sub-sequence of an array or tuple from index `start` "
+              "inclusive to index `end` exclusive. If `start` or `end` are not provided, "
+              "they default to 0 and the length of `arrtup`, respectively. "
+              "`start` and `end` can also be negative to indicate indexing "
+              "from the end of the input. Note that index -1 is synonymous with "
+              "index `(length arrtup)` to allow a full negative slice range. "
+              "Returns the new tuple.") {
     JanetView view = janet_getindexed(argv, 0);
     JanetRange range = janet_getslice(argc, argv);
     return janet_wrap_tuple(janet_tuple_n(view.items + range.start, range.end - range.start));
 }
 
-static Janet cfun_tuple_type(int32_t argc, Janet *argv) {
+JANET_CORE_FN(cfun_tuple_type,
+              "(tuple/type tup)",
+              "Checks how the tuple was constructed. Will return the keyword "
+              ":brackets if the tuple was parsed with brackets, and :parens "
+              "otherwise. The two types of tuples will behave the same most of "
+              "the time, but will print differently and be treated differently by "
+              "the compiler.") {
     janet_fixarity(argc, 1);
     const Janet *tup = janet_gettuple(argv, 0);
     if (janet_tuple_flag(tup) & JANET_TUPLE_FLAG_BRACKETCTOR) {
@@ -77,7 +93,10 @@ static Janet cfun_tuple_type(int32_t argc, Janet *argv) {
     }
 }
 
-static Janet cfun_tuple_sourcemap(int32_t argc, Janet *argv) {
+JANET_CORE_FN(cfun_tuple_sourcemap,
+              "(tuple/sourcemap tup)",
+              "Returns the sourcemap metadata attached to a tuple, "
+              "which is another tuple (line, column).") {
     janet_fixarity(argc, 1);
     const Janet *tup = janet_gettuple(argv, 0);
     Janet contents[2];
@@ -86,7 +105,10 @@ static Janet cfun_tuple_sourcemap(int32_t argc, Janet *argv) {
     return janet_wrap_tuple(janet_tuple_n(contents, 2));
 }
 
-static Janet cfun_tuple_setmap(int32_t argc, Janet *argv) {
+JANET_CORE_FN(cfun_tuple_setmap,
+              "(tuple/setmap tup line column)",
+              "Set the sourcemap metadata on a tuple. line and column indicate "
+              "should be integers.") {
     janet_fixarity(argc, 3);
     const Janet *tup = janet_gettuple(argv, 0);
     janet_tuple_head(tup)->sm_line = janet_getinteger(argv, 1);
@@ -94,48 +116,15 @@ static Janet cfun_tuple_setmap(int32_t argc, Janet *argv) {
     return argv[0];
 }
 
-static const JanetReg tuple_cfuns[] = {
-    {
-        "tuple/brackets", cfun_tuple_brackets,
-        JDOC("(tuple/brackets & xs)\n\n"
-             "Creates a new bracketed tuple containing the elements xs.")
-    },
-    {
-        "tuple/slice", cfun_tuple_slice,
-        JDOC("(tuple/slice arrtup [,start=0 [,end=(length arrtup)]])\n\n"
-             "Take a sub sequence of an array or tuple from index start "
-             "inclusive to index end exclusive. If start or end are not provided, "
-             "they default to 0 and the length of arrtup respectively. "
-             "'start' and 'end' can also be negative to indicate indexing "
-             "from the end of the input. Note that index -1 is synonymous with "
-             "index '(length arrtup)' to allow a full negative slice range. "
-             "Returns the new tuple.")
-    },
-    {
-        "tuple/type", cfun_tuple_type,
-        JDOC("(tuple/type tup)\n\n"
-             "Checks how the tuple was constructed. Will return the keyword "
-             ":brackets if the tuple was parsed with brackets, and :parens "
-             "otherwise. The two types of tuples will behave the same most of "
-             "the time, but will print differently and be treated differently by "
-             "the compiler.")
-    },
-    {
-        "tuple/sourcemap", cfun_tuple_sourcemap,
-        JDOC("(tuple/sourcemap tup)\n\n"
-             "Returns the sourcemap metadata attached to a tuple, "
-             " which is another tuple (line, column).")
-    },
-    {
-        "tuple/setmap", cfun_tuple_setmap,
-        JDOC("(tuple/setmap tup line column)\n\n"
-             "Set the sourcemap metadata on a tuple. line and column indicate "
-             "should be integers.")
-    },
-    {NULL, NULL, NULL}
-};
-
 /* Load the tuple module */
 void janet_lib_tuple(JanetTable *env) {
-    janet_core_cfuns(env, NULL, tuple_cfuns);
+    JanetRegExt tuple_cfuns[] = {
+        JANET_CORE_REG("tuple/brackets", cfun_tuple_brackets),
+        JANET_CORE_REG("tuple/slice", cfun_tuple_slice),
+        JANET_CORE_REG("tuple/type", cfun_tuple_type),
+        JANET_CORE_REG("tuple/sourcemap", cfun_tuple_sourcemap),
+        JANET_CORE_REG("tuple/setmap", cfun_tuple_setmap),
+        JANET_REG_END
+    };
+    janet_core_cfuns_ext(env, NULL, tuple_cfuns);
 }

src/core/util.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
@@ -36,6 +36,19 @@
 #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
+
 #include <inttypes.h>
 
 /* Base 64 lookup table for digits */
@@ -224,13 +237,17 @@ int32_t janet_string_calchash(const uint8_t *str, int32_t len) {
 
 #endif
 
+uint32_t janet_hash_mix(uint32_t input, uint32_t more) {
+    uint32_t mix1 = (more + 0x9e3779b9 + (input << 6) + (input >> 2));
+    return input ^ (0x9e3779b9 + (mix1 << 6) + (mix1 >> 2));
+}
+
 /* Computes hash of an array of values */
 int32_t janet_array_calchash(const Janet *array, int32_t len) {
     const Janet *end = array + len;
-    uint32_t hash = 0;
+    uint32_t hash = 33;
     while (array < end) {
-        uint32_t elem = janet_hash(*array++);
-        hash ^= elem + 0x9e3779b9 + (hash << 6) + (hash >> 2);
+        hash = janet_hash_mix(hash, janet_hash(*array++));
     }
     return (int32_t) hash;
 }
@@ -238,10 +255,10 @@ int32_t janet_array_calchash(const Janet *array, int32_t len) {
 /* Computes hash of an array of values */
 int32_t janet_kv_calchash(const JanetKV *kvs, int32_t len) {
     const JanetKV *end = kvs + len;
-    uint32_t hash = 0;
+    uint32_t hash = 33;
     while (kvs < end) {
-        hash ^= janet_hash(kvs->key) + 0x9e3779b9 + (hash << 6) + (hash >> 2);
-        hash ^= janet_hash(kvs->value) + 0x9e3779b9 + (hash << 6) + (hash >> 2);
+        hash = janet_hash_mix(hash, janet_hash(kvs->key));
+        hash = janet_hash_mix(hash, janet_hash(kvs->value));
         kvs++;
     }
     return (int32_t) hash;
@@ -250,6 +267,7 @@ int32_t janet_kv_calchash(const JanetKV *kvs, int32_t len) {
 /* Calculate next power of 2. May overflow. If n is 0,
  * will return 0. */
 int32_t janet_tablen(int32_t n) {
+    if (n < 0) return 0;
     n |= n >> 1;
     n |= n >> 2;
     n |= n >> 4;
@@ -362,105 +380,208 @@ const void *janet_strbinsearch(
     return NULL;
 }
 
-/* Register a value in the global registry */
-void janet_register(const char *name, JanetCFunction cfun) {
-    Janet key = janet_wrap_cfunction(cfun);
-    Janet value = janet_csymbolv(name);
-    janet_table_put(janet_vm_registry, key, value);
+/* Add sourcemapping and documentation to a binding table */
+static void janet_add_meta(JanetTable *table, const char *doc, const char *source_file, int32_t source_line) {
+    if (doc) {
+        janet_table_put(table, janet_ckeywordv("doc"), janet_cstringv(doc));
+    }
+    if (source_file && source_line) {
+        Janet triple[3];
+        triple[0] = janet_cstringv(source_file);
+        triple[1] = janet_wrap_integer(source_line);
+        triple[2] = janet_wrap_integer(1);
+        Janet value = janet_wrap_tuple(janet_tuple_n(triple, 3));
+        janet_table_put(table, janet_ckeywordv("source-map"), value);
+    }
 }
 
 /* Add a def to an environment */
-void janet_def(JanetTable *env, const char *name, Janet val, const char *doc) {
+void janet_def_sm(JanetTable *env, const char *name, Janet val, const char *doc, const char *source_file, int32_t source_line) {
     JanetTable *subt = janet_table(2);
     janet_table_put(subt, janet_ckeywordv("value"), val);
-    if (doc)
-        janet_table_put(subt, janet_ckeywordv("doc"), janet_cstringv(doc));
+    janet_add_meta(subt, doc, source_file, source_line);
     janet_table_put(env, janet_csymbolv(name), janet_wrap_table(subt));
 }
+void janet_def(JanetTable *env, const char *name, Janet value, const char *doc) {
+    janet_def_sm(env, name, value, doc, NULL, 0);
+}
 
 /* Add a var to the environment */
-void janet_var(JanetTable *env, const char *name, Janet val, const char *doc) {
+void janet_var_sm(JanetTable *env, const char *name, Janet val, const char *doc, const char *source_file, int32_t source_line) {
     JanetArray *array = janet_array(1);
     JanetTable *subt = janet_table(2);
     janet_array_push(array, val);
     janet_table_put(subt, janet_ckeywordv("ref"), janet_wrap_array(array));
-    if (doc)
-        janet_table_put(subt, janet_ckeywordv("doc"), janet_cstringv(doc));
+    janet_add_meta(subt, doc, source_file, source_line);
     janet_table_put(env, janet_csymbolv(name), janet_wrap_table(subt));
 }
-
-/* Load many cfunctions at once */
-static void _janet_cfuns_prefix(JanetTable *env, const char *regprefix, const JanetReg *cfuns, int defprefix) {
-    uint8_t *longname_buffer = NULL;
-    size_t prefixlen = 0;
-    size_t bufsize = 0;
-    if (NULL != regprefix) {
-        prefixlen = strlen(regprefix);
-        bufsize = prefixlen + 256;
-        longname_buffer = janet_malloc(bufsize);
-        if (NULL == longname_buffer) {
-            JANET_OUT_OF_MEMORY;
-        }
-        safe_memcpy(longname_buffer, regprefix, prefixlen);
-        longname_buffer[prefixlen] = '/';
-        prefixlen++;
-    }
-    while (cfuns->name) {
-        Janet name;
-        if (NULL != regprefix) {
-            int32_t nmlen = 0;
-            while (cfuns->name[nmlen]) nmlen++;
-            int32_t totallen = (int32_t) prefixlen + nmlen;
-            if ((size_t) totallen > bufsize) {
-                bufsize = (size_t)(totallen) + 128;
-                longname_buffer = janet_realloc(longname_buffer, bufsize);
-                if (NULL == longname_buffer) {
-                    JANET_OUT_OF_MEMORY;
-                }
-            }
-            safe_memcpy(longname_buffer + prefixlen, cfuns->name, nmlen);
-            name = janet_wrap_symbol(janet_symbol(longname_buffer, totallen));
-        } else {
-            name = janet_csymbolv(cfuns->name);
-        }
-        Janet fun = janet_wrap_cfunction(cfuns->cfun);
-        if (defprefix) {
-            JanetTable *subt = janet_table(2);
-            janet_table_put(subt, janet_ckeywordv("value"), fun);
-            if (cfuns->documentation)
-                janet_table_put(subt, janet_ckeywordv("doc"), janet_cstringv(cfuns->documentation));
-            janet_table_put(env, name, janet_wrap_table(subt));
-        } else {
-            janet_def(env, cfuns->name, fun, cfuns->documentation);
-        }
-        janet_table_put(janet_vm_registry, fun, name);
-        cfuns++;
-    }
-    (janet_free)(longname_buffer);
+void janet_var(JanetTable *env, const char *name, Janet val, const char *doc) {
+    janet_var_sm(env, name, val, doc, NULL, 0);
 }
 
-void janet_cfuns_prefix(JanetTable *env, const char *regprefix, const JanetReg *cfuns) {
-    _janet_cfuns_prefix(env, regprefix, cfuns, 1);
+/* Registry functions */
+
+/* Put the registry in sorted order. */
+static void janet_registry_sort(void) {
+    for (size_t i = 1; i < janet_vm.registry_count; i++) {
+        JanetCFunRegistry reg = janet_vm.registry[i];
+        size_t j;
+        for (j = i; j > 0; j--) {
+            if ((void *)(janet_vm.registry[j - 1].cfun) < (void *)(reg.cfun)) break;
+            janet_vm.registry[j] = janet_vm.registry[j - 1];
+        }
+        janet_vm.registry[j] = reg;
+    }
+    janet_vm.registry_dirty = 0;
+}
+
+void janet_registry_put(
+    JanetCFunction key,
+    const char *name,
+    const char *name_prefix,
+    const char *source_file,
+    int32_t source_line) {
+    if (janet_vm.registry_count == janet_vm.registry_cap) {
+        size_t newcap = (janet_vm.registry_count + 1) * 2;
+        /* Size it nicely with core by default */
+        if (newcap < 512) {
+            newcap = 512;
+        }
+        void *newmem = janet_realloc(janet_vm.registry, newcap * sizeof(JanetCFunRegistry));
+        if (NULL == newmem) {
+            JANET_OUT_OF_MEMORY;
+        }
+        janet_vm.registry = newmem;
+        janet_vm.registry_cap = newcap;
+    }
+    JanetCFunRegistry value = {
+        key,
+        name,
+        name_prefix,
+        source_file,
+        source_line
+    };
+    janet_vm.registry[janet_vm.registry_count++] = value;
+    janet_vm.registry_dirty = 1;
+}
+
+JanetCFunRegistry *janet_registry_get(JanetCFunction key) {
+    if (janet_vm.registry_dirty) {
+        janet_registry_sort();
+    }
+    for (size_t i = 0; i < janet_vm.registry_count; i++) {
+        if (janet_vm.registry[i].cfun == key) {
+            return janet_vm.registry + i;
+        }
+    }
+    JanetCFunRegistry *lo = janet_vm.registry;
+    JanetCFunRegistry *hi = lo + janet_vm.registry_count;
+    while (lo < hi) {
+        JanetCFunRegistry *mid = lo + (hi - lo) / 2;
+        if (mid->cfun == key) {
+            return mid;
+        }
+        if ((void *)(mid->cfun) > (void *)(key)) {
+            hi = mid;
+        } else {
+            lo = mid + 1;
+        }
+    }
+    return NULL;
+}
+
+typedef struct {
+    char *buf;
+    size_t plen;
+} NameBuf;
+
+static void namebuf_init(NameBuf *namebuf, const char *prefix) {
+    size_t plen = strlen(prefix);
+    namebuf->plen = plen;
+    namebuf->buf = janet_malloc(namebuf->plen + 256);
+    if (NULL == namebuf->buf) {
+        JANET_OUT_OF_MEMORY;
+    }
+    memcpy(namebuf->buf, prefix, plen);
+    namebuf->buf[plen] = '/';
+}
+
+static void namebuf_deinit(NameBuf *namebuf) {
+    janet_free(namebuf->buf);
+}
+
+static char *namebuf_name(NameBuf *namebuf, const char *suffix) {
+    size_t slen = strlen(suffix);
+    namebuf->buf = janet_realloc(namebuf->buf, namebuf->plen + 2 + slen);
+    if (NULL == namebuf->buf) {
+        JANET_OUT_OF_MEMORY;
+    }
+    memcpy(namebuf->buf + namebuf->plen + 1, suffix, slen);
+    namebuf->buf[namebuf->plen + 1 + slen] = '\0';
+    return (char *)(namebuf->buf);
 }
 
 void janet_cfuns(JanetTable *env, const char *regprefix, const JanetReg *cfuns) {
-    _janet_cfuns_prefix(env, regprefix, cfuns, 0);
+    while (cfuns->name) {
+        Janet fun = janet_wrap_cfunction(cfuns->cfun);
+        if (env) janet_def(env, cfuns->name, fun, cfuns->documentation);
+        janet_registry_put(cfuns->cfun, cfuns->name, regprefix, NULL, 0);
+        cfuns++;
+    }
+}
+
+void janet_cfuns_ext(JanetTable *env, const char *regprefix, const JanetRegExt *cfuns) {
+    while (cfuns->name) {
+        Janet fun = janet_wrap_cfunction(cfuns->cfun);
+        if (env) janet_def_sm(env, cfuns->name, fun, cfuns->documentation, cfuns->source_file, cfuns->source_line);
+        janet_registry_put(cfuns->cfun, cfuns->name, regprefix, cfuns->source_file, cfuns->source_line);
+        cfuns++;
+    }
+}
+
+void janet_cfuns_prefix(JanetTable *env, const char *regprefix, const JanetReg *cfuns) {
+    NameBuf nb;
+    if (env) namebuf_init(&nb, regprefix);
+    while (cfuns->name) {
+        Janet fun = janet_wrap_cfunction(cfuns->cfun);
+        if (env) janet_def(env, namebuf_name(&nb, cfuns->name), fun, cfuns->documentation);
+        janet_registry_put(cfuns->cfun, cfuns->name, regprefix, NULL, 0);
+        cfuns++;
+    }
+    if (env) namebuf_deinit(&nb);
+}
+
+void janet_cfuns_ext_prefix(JanetTable *env, const char *regprefix, const JanetRegExt *cfuns) {
+    NameBuf nb;
+    if (env) namebuf_init(&nb, regprefix);
+    while (cfuns->name) {
+        Janet fun = janet_wrap_cfunction(cfuns->cfun);
+        if (env) janet_def_sm(env, namebuf_name(&nb, cfuns->name), fun, cfuns->documentation, cfuns->source_file, cfuns->source_line);
+        janet_registry_put(cfuns->cfun, cfuns->name, regprefix, cfuns->source_file, cfuns->source_line);
+        cfuns++;
+    }
+    if (env) namebuf_deinit(&nb);
+}
+
+/* Register a value in the global registry */
+void janet_register(const char *name, JanetCFunction cfun) {
+    janet_registry_put(cfun, name, NULL, NULL, 0);
 }
 
 /* Abstract type introspection */
 
 void janet_register_abstract_type(const JanetAbstractType *at) {
     Janet sym = janet_csymbolv(at->name);
-    Janet check = janet_table_get(janet_vm_abstract_registry, sym);
+    Janet check = janet_table_get(janet_vm.abstract_registry, sym);
     if (!janet_checktype(check, JANET_NIL) && at != janet_unwrap_pointer(check)) {
         janet_panicf("cannot register abstract type %s, "
                      "a type with the same name exists", at->name);
     }
-    janet_table_put(janet_vm_abstract_registry, sym, janet_wrap_pointer((void *) at));
+    janet_table_put(janet_vm.abstract_registry, sym, janet_wrap_pointer((void *) at));
 }
 
 const JanetAbstractType *janet_get_abstract_type(Janet key) {
-    Janet wrapped = janet_table_get(janet_vm_abstract_registry, key);
+    Janet wrapped = janet_table_get(janet_vm.abstract_registry, key);
     if (janet_checktype(wrapped, JANET_NIL)) {
         return NULL;
     }
@@ -468,29 +589,30 @@ const JanetAbstractType *janet_get_abstract_type(Janet key) {
 }
 
 #ifndef JANET_BOOTSTRAP
-void janet_core_def(JanetTable *env, const char *name, Janet x, const void *p) {
+void janet_core_def_sm(JanetTable *env, const char *name, Janet x, const void *p, const void *sf, int32_t sl) {
+    (void) sf;
+    (void) sl;
     (void) p;
     Janet key = janet_csymbolv(name);
     janet_table_put(env, key, x);
     if (janet_checktype(x, JANET_CFUNCTION)) {
-        janet_table_put(janet_vm_registry, x, key);
+        janet_registry_put(janet_unwrap_cfunction(x), name, NULL, NULL, 0);
     }
 }
 
-void janet_core_cfuns(JanetTable *env, const char *regprefix, const JanetReg *cfuns) {
+void janet_core_cfuns_ext(JanetTable *env, const char *regprefix, const JanetRegExt *cfuns) {
     (void) regprefix;
     while (cfuns->name) {
         Janet fun = janet_wrap_cfunction(cfuns->cfun);
-        janet_core_def(env, cfuns->name, fun, cfuns->documentation);
+        janet_table_put(env, janet_csymbolv(cfuns->name), fun);
+        janet_registry_put(cfuns->cfun, cfuns->name, regprefix, cfuns->source_file, cfuns->source_line);
         cfuns++;
     }
 }
 #endif
 
-JanetBinding janet_resolve_ext(JanetTable *env, const uint8_t *sym) {
-    Janet ref;
+JanetBinding janet_binding_from_entry(Janet entry) {
     JanetTable *entry_table;
-    Janet entry = janet_table_get(env, janet_wrap_symbol(sym));
     JanetBinding binding = {
         JANET_BINDING_NONE,
         janet_wrap_nil(),
@@ -517,29 +639,41 @@ JanetBinding janet_resolve_ext(JanetTable *env, const uint8_t *sym) {
         binding.deprecation = JANET_BINDING_DEP_NORMAL;
     }
 
-    if (!janet_checktype(
-                janet_table_get(entry_table, janet_ckeywordv("macro")),
-                JANET_NIL)) {
-        binding.value = janet_table_get(entry_table, janet_ckeywordv("value"));
-        binding.type = JANET_BINDING_MACRO;
+    int macro = janet_truthy(janet_table_get(entry_table, janet_ckeywordv("macro")));
+    Janet value = janet_table_get(entry_table, janet_ckeywordv("value"));
+    Janet ref = janet_table_get(entry_table, janet_ckeywordv("ref"));
+    int ref_is_valid = janet_checktype(ref, JANET_ARRAY);
+    int redef = ref_is_valid && janet_truthy(janet_table_get(entry_table, janet_ckeywordv("redef")));
+
+    if (macro) {
+        binding.value = redef ? ref : value;
+        binding.type = redef ? JANET_BINDING_DYNAMIC_MACRO : JANET_BINDING_MACRO;
         return binding;
     }
 
-    ref = janet_table_get(entry_table, janet_ckeywordv("ref"));
-    if (janet_checktype(ref, JANET_ARRAY)) {
+    if (ref_is_valid) {
         binding.value = ref;
-        binding.type = JANET_BINDING_VAR;
-        return binding;
+        binding.type = redef ? JANET_BINDING_DYNAMIC_DEF : JANET_BINDING_VAR;
+    } else {
+        binding.value = value;
+        binding.type = JANET_BINDING_DEF;
     }
 
-    binding.value = janet_table_get(entry_table, janet_ckeywordv("value"));
-    binding.type = JANET_BINDING_DEF;
     return binding;
 }
 
+JanetBinding janet_resolve_ext(JanetTable *env, const uint8_t *sym) {
+    Janet entry = janet_table_get(env, janet_wrap_symbol(sym));
+    return janet_binding_from_entry(entry);
+}
+
 JanetBindingType janet_resolve(JanetTable *env, const uint8_t *sym, Janet *out) {
     JanetBinding binding = janet_resolve_ext(env, sym);
-    *out = binding.value;
+    if (binding.type == JANET_BINDING_DYNAMIC_DEF || binding.type == JANET_BINDING_DYNAMIC_MACRO) {
+        *out = janet_array_peek(janet_unwrap_array(binding.value));
+    } else {
+        *out = binding.value;
+    }
     return binding.type;
 }
 
@@ -569,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;
 }
@@ -614,6 +758,13 @@ int janet_checkint64(Janet x) {
     return janet_checkint64range(dval);
 }
 
+int janet_checkuint64(Janet x) {
+    if (!janet_checktype(x, JANET_NUMBER))
+        return 0;
+    double dval = janet_unwrap_number(x);
+    return dval >= 0 && dval <= JANET_INTMAX_DOUBLE && dval == (uint64_t) dval;
+}
+
 int janet_checksize(Janet x) {
     if (!janet_checktype(x, JANET_NUMBER))
         return 0;
@@ -669,11 +820,6 @@ int32_t janet_sorted_keys(const JanetKV *dict, int32_t cap, int32_t *index_buffe
 
 /* Clock shims for various platforms */
 #ifdef JANET_GETTIME
-/* For macos */
-#ifdef __MACH__
-#include <mach/clock.h>
-#include <mach/mach.h>
-#endif
 #ifdef JANET_WINDOWS
 int janet_gettime(struct timespec *spec) {
     FILETIME ftime;
@@ -686,7 +832,10 @@ int janet_gettime(struct timespec *spec) {
     spec->tv_nsec = wintime % 10000000LL * 100;
     return 0;
 }
-#elif defined(__MACH__)
+/* clock_gettime() wasn't available on Mac until 10.12. */
+#elif defined(JANET_APPLE) && !defined(MAC_OS_X_VERSION_10_12)
+#include <mach/clock.h>
+#include <mach/mach.h>
 int janet_gettime(struct timespec *spec) {
     clock_serv_t cclock;
     mach_timespec_t mts;
@@ -716,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.
@@ -754,6 +903,81 @@ int janet_cryptorand(uint8_t *out, size_t n) {
 #endif
 }
 
+/* Dynamic library loading */
+
+char *get_processed_name(const char *name) {
+    if (name[0] == '.') return (char *) name;
+    const char *c;
+    for (c = name; *c; c++) {
+        if (*c == '/') return (char *) name;
+    }
+    size_t l = (size_t)(c - name);
+    char *ret = janet_malloc(l + 3);
+    if (NULL == ret) {
+        JANET_OUT_OF_MEMORY;
+    }
+    ret[0] = '.';
+    ret[1] = '/';
+    memcpy(ret + 2, name, l + 1);
+    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,
+                   NULL, GetLastError(), MAKELANGID(LANG_NEUTRAL, SUBLANG_DEFAULT),
+                   error_clib_buf, sizeof(error_clib_buf), NULL);
+    error_clib_buf[strlen(error_clib_buf) - 1] = '\0';
+    return error_clib_buf;
+}
+
+Clib load_clib(const char *name) {
+    if (name == NULL) {
+        return GetModuleHandle(NULL);
+    } else {
+        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 */
 void *(janet_malloc)(size_t size) {

src/core/util.h

@@ -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
@@ -26,10 +26,19 @@
 #ifndef JANET_AMALG
 #include "features.h"
 #include <janet.h>
+#include "state.h"
 #endif
 
 #include <stdio.h>
 #include <errno.h>
+#include <stddef.h>
+#include <stdbool.h>
+
+#ifdef JANET_EV
+#ifndef JANET_WINDOWS
+#include <pthread.h>
+#endif
+#endif
 
 #if !defined(JANET_REDUCED_OS) || !defined(JANET_SINGLE_THREADED)
 #include <time.h>
@@ -48,20 +57,17 @@
 } while (0)
 #endif
 
+#define JANET_MARSHAL_DECREF 0x40000
+
 #define janet_assert(c, m) do { \
     if (!(c)) JANET_EXIT((m)); \
 } while (0)
 
-/* Omit docstrings in some builds */
-#ifndef JANET_BOOTSTRAP
-#define JDOC(x) NULL
-#define JANET_NO_BOOTSTRAP
-#else
-#define JDOC(x) x
-#endif
-
 /* Utils */
+uint32_t janet_hash_mix(uint32_t input, uint32_t more);
 #define janet_maphash(cap, hash) ((uint32_t)(hash) & (cap - 1))
+int janet_valid_utf8(const uint8_t *str, int32_t len);
+int janet_is_symbol_char(uint8_t c);
 extern const char janet_base64[65];
 int32_t janet_array_calchash(const Janet *array, int32_t len);
 int32_t janet_kv_calchash(const JanetKV *kvs, int32_t len);
@@ -86,15 +92,31 @@ void janet_buffer_format(
     int32_t argc,
     Janet *argv);
 Janet janet_next_impl(Janet ds, Janet key, int is_interpreter);
+JanetBinding janet_binding_from_entry(Janet entry);
+
+/* Registry functions */
+void janet_registry_put(
+    JanetCFunction key,
+    const char *name,
+    const char *name_prefix,
+    const char *source_file,
+    int32_t source_line);
+JanetCFunRegistry *janet_registry_get(JanetCFunction key);
 
 /* Inside the janet core, defining globals is different
  * at bootstrap time and normal runtime */
 #ifdef JANET_BOOTSTRAP
-#define janet_core_def janet_def
-#define janet_core_cfuns janet_cfuns
+#define JANET_CORE_REG JANET_REG
+#define JANET_CORE_FN JANET_FN
+#define JANET_CORE_DEF JANET_DEF
+#define janet_core_def_sm janet_def_sm
+#define janet_core_cfuns_ext janet_cfuns_ext
 #else
-void janet_core_def(JanetTable *env, const char *name, Janet x, const void *p);
-void janet_core_cfuns(JanetTable *env, const char *regprefix, const JanetReg *cfuns);
+#define JANET_CORE_REG JANET_REG_S
+#define JANET_CORE_FN JANET_FN_S
+#define JANET_CORE_DEF(ENV, NAME, X, DOC) janet_core_def_sm(ENV, NAME, X, DOC, NULL, 0)
+void janet_core_def_sm(JanetTable *env, const char *name, Janet x, const void *p, const void *sf, int32_t sl);
+void janet_core_cfuns_ext(JanetTable *env, const char *regprefix, const JanetRegExt *cfuns);
 #endif
 
 /* Clock gettime */
@@ -107,6 +129,31 @@ int janet_gettime(struct timespec *spec);
 #define strdup(x) _strdup(x)
 #endif
 
+/* Use LoadLibrary on windows or dlopen on posix to load dynamic libaries
+ * with native code. */
+#if defined(JANET_NO_DYNAMIC_MODULES)
+typedef int Clib;
+#define load_clib(name) ((void) name, 0)
+#define symbol_clib(lib, sym) ((void) lib, (void) sym, NULL)
+const char *error_clib(void);
+#define free_clib(c) ((void) (c), 0)
+#elif defined(JANET_WINDOWS)
+#include <windows.h>
+typedef HINSTANCE Clib;
+void *symbol_clib(Clib clib, const char *sym);
+void free_clib(Clib clib);
+Clib load_clib(const char *name);
+char *error_clib(void);
+#else
+#include <dlfcn.h>
+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
+#endif
+char *get_processed_name(const char *name);
+
 #define RETRY_EINTR(RC, CALL) do { (RC) = CALL; } while((RC) < 0 && errno == EINTR)
 
 /* Initialize builtin libraries */
@@ -116,6 +163,7 @@ void janet_lib_array(JanetTable *env);
 void janet_lib_tuple(JanetTable *env);
 void janet_lib_buffer(JanetTable *env);
 void janet_lib_table(JanetTable *env);
+void janet_lib_struct(JanetTable *env);
 void janet_lib_fiber(JanetTable *env);
 void janet_lib_os(JanetTable *env);
 void janet_lib_string(JanetTable *env);
@@ -135,9 +183,6 @@ void janet_lib_typed_array(JanetTable *env);
 #ifdef JANET_INT_TYPES
 void janet_lib_inttypes(JanetTable *env);
 #endif
-#ifdef JANET_THREADS
-void janet_lib_thread(JanetTable *env);
-#endif
 #ifdef JANET_NET
 void janet_lib_net(JanetTable *env);
 extern const JanetAbstractType janet_address_type;
@@ -147,5 +192,8 @@ void janet_lib_ev(JanetTable *env);
 void janet_ev_mark(void);
 int janet_make_pipe(JanetHandle handles[2], int mode);
 #endif
+#ifdef JANET_FFI
+void janet_lib_ffi(JanetTable *env);
+#endif
 
 #endif

src/core/value.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
@@ -31,31 +31,28 @@
 
 #include <math.h>
 
-JANET_THREAD_LOCAL JanetTraversalNode *janet_vm_traversal = NULL;
-JANET_THREAD_LOCAL JanetTraversalNode *janet_vm_traversal_top = NULL;
-JANET_THREAD_LOCAL JanetTraversalNode *janet_vm_traversal_base = NULL;
-
 static void push_traversal_node(void *lhs, void *rhs, int32_t index2) {
     JanetTraversalNode node;
     node.self = (JanetGCObject *) lhs;
     node.other = (JanetGCObject *) rhs;
     node.index = 0;
     node.index2 = index2;
-    if (janet_vm_traversal + 1 >= janet_vm_traversal_top) {
-        size_t oldsize = janet_vm_traversal - janet_vm_traversal_base;
+    int is_new = janet_vm.traversal_base == NULL;
+    if (is_new || (janet_vm.traversal + 1 >= janet_vm.traversal_top)) {
+        size_t oldsize = is_new ? 0 : (janet_vm.traversal - janet_vm.traversal_base);
         size_t newsize = 2 * oldsize + 1;
         if (newsize < 128) {
             newsize = 128;
         }
-        JanetTraversalNode *tn = janet_realloc(janet_vm_traversal_base, newsize * sizeof(JanetTraversalNode));
+        JanetTraversalNode *tn = janet_realloc(janet_vm.traversal_base, newsize * sizeof(JanetTraversalNode));
         if (tn == NULL) {
             JANET_OUT_OF_MEMORY;
         }
-        janet_vm_traversal_base = tn;
-        janet_vm_traversal_top = janet_vm_traversal_base + newsize;
-        janet_vm_traversal = janet_vm_traversal_base + oldsize;
+        janet_vm.traversal_base = tn;
+        janet_vm.traversal_top = janet_vm.traversal_base + newsize;
+        janet_vm.traversal = janet_vm.traversal_base + oldsize;
     }
-    *(++janet_vm_traversal) = node;
+    *(++janet_vm.traversal) = node;
 }
 
 /*
@@ -67,8 +64,8 @@ static void push_traversal_node(void *lhs, void *rhs, int32_t index2) {
  * 3 - early stop - lhs > rhs
  */
 static int traversal_next(Janet *x, Janet *y) {
-    JanetTraversalNode *t = janet_vm_traversal;
-    while (t && t > janet_vm_traversal_base) {
+    JanetTraversalNode *t = janet_vm.traversal;
+    while (t && t > janet_vm.traversal_base) {
         JanetGCObject *self = t->self;
         JanetTupleHead *tself = (JanetTupleHead *)self;
         JanetStructHead *sself = (JanetStructHead *)self;
@@ -81,7 +78,7 @@ static int traversal_next(Janet *x, Janet *y) {
                 int32_t index = t->index++;
                 *x = tself->data[index];
                 *y = tother->data[index];
-                janet_vm_traversal = t;
+                janet_vm.traversal = t;
                 return 0;
             }
             if (t->index2 && tself->length != tother->length) {
@@ -94,20 +91,31 @@ static int traversal_next(Janet *x, Janet *y) {
                 int32_t index = t->index++;
                 *x = sself->data[index].value;
                 *y = sother->data[index].value;
-                janet_vm_traversal = t;
+                janet_vm.traversal = t;
                 return 0;
             }
             for (int32_t i = t->index; i < sself->capacity; i++) {
                 t->index2 = 1;
                 *x = sself->data[t->index].key;
                 *y = sother->data[t->index].key;
-                janet_vm_traversal = t;
+                janet_vm.traversal = t;
+                return 0;
+            }
+            /* Traverse prototype */
+            JanetStruct sproto = sself->proto;
+            JanetStruct oproto = sother->proto;
+            if (sproto && !oproto) return 3;
+            if (!sproto && oproto) return 1;
+            if (oproto && sproto) {
+                *x = janet_wrap_struct(sproto);
+                *y = janet_wrap_struct(oproto);
+                janet_vm.traversal = t - 1;
                 return 0;
             }
         }
         t--;
     }
-    janet_vm_traversal = t;
+    janet_vm.traversal = t;
     return 2;
 }
 
@@ -196,17 +204,17 @@ Janet janet_next_impl(Janet ds, Janet key, int is_interpreter) {
                     status == JANET_STATUS_USER4) {
                 return janet_wrap_nil();
             }
-            janet_vm_fiber->child = child;
+            janet_vm.fiber->child = child;
             JanetSignal sig = janet_continue(child, janet_wrap_nil(), &retreg);
             if (sig != JANET_SIGNAL_OK && !(child->flags & (1 << sig))) {
                 if (is_interpreter) {
                     janet_signalv(sig, retreg);
                 } else {
-                    janet_vm_fiber->child = NULL;
+                    janet_vm.fiber->child = NULL;
                     janet_panicv(retreg);
                 }
             }
-            janet_vm_fiber->child = NULL;
+            janet_vm.fiber->child = NULL;
             if (sig == JANET_SIGNAL_OK ||
                     sig == JANET_SIGNAL_ERROR ||
                     sig == JANET_SIGNAL_USER0 ||
@@ -239,7 +247,7 @@ static int janet_compare_abstract(JanetAbstract xx, JanetAbstract yy) {
 }
 
 int janet_equals(Janet x, Janet y) {
-    janet_vm_traversal = janet_vm_traversal_base;
+    janet_vm.traversal = janet_vm.traversal_base;
     do {
         if (janet_type(x) != janet_type(y)) return 0;
         switch (janet_type(x)) {
@@ -276,6 +284,8 @@ int janet_equals(Janet x, Janet y) {
                 if (s1 == s2) break;
                 if (janet_struct_hash(s1) != janet_struct_hash(s2)) return 0;
                 if (janet_struct_length(s1) != janet_struct_length(s2)) return 0;
+                if (janet_struct_proto(s1) && !janet_struct_proto(s2)) return 0;
+                if (!janet_struct_proto(s1) && janet_struct_proto(s2)) return 0;
                 push_traversal_node(janet_struct_head(s1), janet_struct_head(s2), 0);
                 break;
             }
@@ -285,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;
@@ -312,9 +331,11 @@ int32_t janet_hash(Janet x) {
                 uint64_t u;
             } as;
             as.d = janet_unwrap_number(x);
+            as.d += 0.0; /* normalize negative 0 */
             uint32_t lo = (uint32_t)(as.u & 0xFFFFFFFF);
             uint32_t hi = (uint32_t)(as.u >> 32);
-            hash = (int32_t)(hi ^ (lo >> 3));
+            uint32_t hilo = (hi ^ lo) * 2654435769u;
+            hash = (int32_t)((hilo << 16) | (hilo >> 16));
             break;
         }
         case JANET_ABSTRACT: {
@@ -328,15 +349,14 @@ int32_t janet_hash(Janet x) {
         /* fallthrough */
         default:
             if (sizeof(double) == sizeof(void *)) {
-                /* Assuming 8 byte pointer */
-                uint64_t i = janet_u64(x);
-                uint32_t lo = (uint32_t)(i & 0xFFFFFFFF);
-                uint32_t hi = (uint32_t)(i >> 32);
-                hash = (int32_t)(hi ^ (lo >> 3));
+                /* Assuming 8 byte pointer (8 byte aligned) */
+                uint64_t i = murmur64(janet_u64(x));
+                hash = (int32_t)(i >> 32);
             } else {
                 /* Assuming 4 byte pointer (or smaller) */
-                hash = (int32_t)((char *)janet_unwrap_pointer(x) - (char *)0);
-                hash >>= 2;
+                uintptr_t diff = (uintptr_t) janet_unwrap_pointer(x);
+                uint32_t hilo = (uint32_t) diff * 2654435769u;
+                hash = (int32_t)((hilo << 16) | (hilo >> 16));
             }
             break;
     }
@@ -347,7 +367,7 @@ int32_t janet_hash(Janet x) {
  * If y is less, returns 1. All types are comparable
  * and should have strict ordering, excepts NaNs. */
 int janet_compare(Janet x, Janet y) {
-    janet_vm_traversal = janet_vm_traversal_base;
+    janet_vm.traversal = janet_vm.traversal_base;
     int status;
     do {
         JanetType tx = janet_type(x);
@@ -631,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))
@@ -659,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) 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

src/core/vector.h

@@ -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

src/core/vm.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
@@ -32,17 +32,6 @@
 
 #include <math.h>
 
-/* VM state */
-JANET_THREAD_LOCAL JanetTable *janet_vm_top_dyns;
-JANET_THREAD_LOCAL JanetTable *janet_vm_core_env;
-JANET_THREAD_LOCAL JanetTable *janet_vm_registry;
-JANET_THREAD_LOCAL JanetTable *janet_vm_abstract_registry;
-JANET_THREAD_LOCAL int janet_vm_stackn = 0;
-JANET_THREAD_LOCAL JanetFiber *janet_vm_fiber = NULL;
-JANET_THREAD_LOCAL JanetFiber *janet_vm_root_fiber = NULL;
-JANET_THREAD_LOCAL Janet *janet_vm_return_reg = NULL;
-JANET_THREAD_LOCAL jmp_buf *janet_vm_jmp_buf = NULL;
-
 /* Virtual registers
  *
  * One instruction word
@@ -91,18 +80,18 @@ JANET_THREAD_LOCAL jmp_buf *janet_vm_jmp_buf = NULL;
     func = janet_stack_frame(stack)->func; \
 } while (0)
 #define vm_return(sig, val) do { \
-    janet_vm_return_reg[0] = (val); \
+    janet_vm.return_reg[0] = (val); \
     vm_commit(); \
     return (sig); \
 } while (0)
 #define vm_return_no_restore(sig, val) do { \
-    janet_vm_return_reg[0] = (val); \
+    janet_vm.return_reg[0] = (val); \
     return (sig); \
 } while (0)
 
 /* Next instruction variations */
 #define maybe_collect() do {\
-    if (janet_vm_next_collection >= janet_vm_gc_interval) janet_collect(); } while (0)
+    if (janet_vm.next_collection >= janet_vm.gc_interval) janet_collect(); } while (0)
 #define vm_checkgc_next() maybe_collect(); vm_next()
 #define vm_pcnext() pc++; vm_next()
 #define vm_checkgc_pcnext() maybe_collect(); vm_pcnext()
@@ -122,6 +111,17 @@ JANET_THREAD_LOCAL jmp_buf *janet_vm_jmp_buf = NULL;
         janet_panicf("expected %T, got %v", (TS), (X)); \
     } \
 } while (0)
+#ifdef JANET_NO_INTERPRETER_INTERRUPT
+#define vm_maybe_auto_suspend(COND)
+#else
+#define vm_maybe_auto_suspend(COND) do { \
+    if ((COND) && janet_vm.auto_suspend) { \
+        janet_vm.auto_suspend = 0; \
+        fiber->flags |= (JANET_FIBER_RESUME_NO_USEVAL | JANET_FIBER_RESUME_NO_SKIP); \
+        vm_return(JANET_SIGNAL_INTERRUPT, janet_wrap_nil()); \
+    } \
+} while (0)
+#endif
 
 /* Templates for certain patterns in opcodes */
 #define vm_binop_immediate(op)\
@@ -220,14 +220,14 @@ JANET_THREAD_LOCAL jmp_buf *janet_vm_jmp_buf = NULL;
 /* Trace a function call */
 static void vm_do_trace(JanetFunction *func, int32_t argc, const Janet *argv) {
     if (func->def->name) {
-        janet_printf("trace (%S", func->def->name);
+        janet_eprintf("trace (%S", func->def->name);
     } else {
-        janet_printf("trace (%p", janet_wrap_function(func));
+        janet_eprintf("trace (%p", janet_wrap_function(func));
     }
     for (int32_t i = 0; i < argc; i++) {
-        janet_printf(" %p", argv[i]);
+        janet_eprintf(" %p", argv[i]);
     }
-    janet_printf(")\n");
+    janet_eprintf(")\n");
 }
 
 /* Invoke a method once we have looked it up */
@@ -315,7 +315,7 @@ static Janet janet_binop_call(const char *lmethod, const char *rmethod, Janet lh
 }
 
 /* Forward declaration */
-static JanetSignal janet_check_can_resume(JanetFiber *fiber, Janet *out);
+static JanetSignal janet_check_can_resume(JanetFiber *fiber, Janet *out, int is_cancel);
 static JanetSignal janet_continue_no_check(JanetFiber *fiber, Janet in, Janet *out);
 
 /* Interpreter main loop */
@@ -591,7 +591,7 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in) {
         JanetSignal sig = (fiber->gc.flags & JANET_FIBER_STATUS_MASK) >> JANET_FIBER_STATUS_OFFSET;
         fiber->gc.flags &= ~JANET_FIBER_STATUS_MASK;
         fiber->flags &= ~(JANET_FIBER_RESUME_SIGNAL | JANET_FIBER_FLAG_MASK);
-        janet_vm_return_reg[0] = in;
+        janet_vm.return_reg[0] = in;
         return sig;
     }
 
@@ -757,11 +757,13 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in) {
 
     VM_OP(JOP_JUMP)
     pc += DS;
+    vm_maybe_auto_suspend(DS < 0);
     vm_next();
 
     VM_OP(JOP_JUMP_IF)
     if (janet_truthy(stack[A])) {
         pc += ES;
+        vm_maybe_auto_suspend(ES < 0);
     } else {
         pc++;
     }
@@ -772,12 +774,14 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in) {
         pc++;
     } else {
         pc += ES;
+        vm_maybe_auto_suspend(ES < 0);
     }
     vm_next();
 
     VM_OP(JOP_JUMP_IF_NIL)
     if (janet_checktype(stack[A], JANET_NIL)) {
         pc += ES;
+        vm_maybe_auto_suspend(ES < 0);
     } else {
         pc++;
     }
@@ -788,6 +792,7 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in) {
         pc++;
     } else {
         pc += ES;
+        vm_maybe_auto_suspend(ES < 0);
     }
     vm_next();
 
@@ -913,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 */
@@ -961,6 +966,7 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in) {
     vm_checkgc_pcnext();
 
     VM_OP(JOP_CALL) {
+        vm_maybe_auto_suspend(1);
         Janet callee = stack[E];
         if (fiber->stacktop > fiber->maxstack) {
             vm_throw("stack overflow");
@@ -1000,6 +1006,7 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in) {
     }
 
     VM_OP(JOP_TAILCALL) {
+        vm_maybe_auto_suspend(1);
         Janet callee = stack[D];
         if (fiber->stacktop > fiber->maxstack) {
             vm_throw("stack overflow");
@@ -1046,9 +1053,10 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in) {
 
     VM_OP(JOP_RESUME) {
         Janet retreg;
+        vm_maybe_auto_suspend(1);
         vm_assert_type(stack[B], JANET_FIBER);
         JanetFiber *child = janet_unwrap_fiber(stack[B]);
-        if (janet_check_can_resume(child, &retreg)) {
+        if (janet_check_can_resume(child, &retreg, 0)) {
             vm_commit();
             janet_panicv(retreg);
         }
@@ -1088,7 +1096,7 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in) {
         Janet retreg;
         vm_assert_type(stack[B], JANET_FIBER);
         JanetFiber *child = janet_unwrap_fiber(stack[B]);
-        if (janet_check_can_resume(child, &retreg)) {
+        if (janet_check_can_resume(child, &retreg, 1)) {
             vm_commit();
             janet_panicv(retreg);
         }
@@ -1277,21 +1285,35 @@ JanetSignal janet_step(JanetFiber *fiber, Janet in, Janet *out) {
     return signal;
 }
 
+static Janet void_cfunction(int32_t argc, Janet *argv) {
+    (void) argc;
+    (void) argv;
+    janet_panic("placeholder");
+}
+
 Janet janet_call(JanetFunction *fun, int32_t argc, const Janet *argv) {
     /* Check entry conditions */
-    if (!janet_vm_fiber)
+    if (!janet_vm.fiber)
         janet_panic("janet_call failed because there is no current fiber");
-    if (janet_vm_stackn >= JANET_RECURSION_GUARD)
+    if (janet_vm.stackn >= JANET_RECURSION_GUARD)
         janet_panic("C stack recursed too deeply");
 
+    /* Dirty stack */
+    int32_t dirty_stack = janet_vm.fiber->stacktop - janet_vm.fiber->stackstart;
+    if (dirty_stack) {
+        janet_fiber_cframe(janet_vm.fiber, void_cfunction);
+    }
+
     /* Tracing */
     if (fun->gc.flags & JANET_FUNCFLAG_TRACE) {
+        janet_vm.stackn++;
         vm_do_trace(fun, argc, argv);
+        janet_vm.stackn--;
     }
 
     /* Push frame */
-    janet_fiber_pushn(janet_vm_fiber, argv, argc);
-    if (janet_fiber_funcframe(janet_vm_fiber, fun)) {
+    janet_fiber_pushn(janet_vm.fiber, argv, argc);
+    if (janet_fiber_funcframe(janet_vm.fiber, fun)) {
         int32_t min = fun->def->min_arity;
         int32_t max = fun->def->max_arity;
         Janet funv = janet_wrap_function(fun);
@@ -1301,35 +1323,53 @@ Janet janet_call(JanetFunction *fun, int32_t argc, const Janet *argv) {
             janet_panicf("arity mismatch in %v, expected at least %d, got %d", funv, min, argc);
         janet_panicf("arity mismatch in %v, expected at most %d, got %d", funv, max, argc);
     }
-    janet_fiber_frame(janet_vm_fiber)->flags |= JANET_STACKFRAME_ENTRANCE;
+    janet_fiber_frame(janet_vm.fiber)->flags |= JANET_STACKFRAME_ENTRANCE;
 
     /* Set up */
-    int32_t oldn = janet_vm_stackn++;
+    int32_t oldn = janet_vm.stackn++;
     int handle = janet_gclock();
 
     /* Run vm */
-    janet_vm_fiber->flags |= JANET_FIBER_RESUME_NO_USEVAL | JANET_FIBER_RESUME_NO_SKIP;
-    JanetSignal signal = run_vm(janet_vm_fiber, janet_wrap_nil());
+    janet_vm.fiber->flags |= JANET_FIBER_RESUME_NO_USEVAL | JANET_FIBER_RESUME_NO_SKIP;
+    JanetSignal signal = run_vm(janet_vm.fiber, janet_wrap_nil());
 
     /* Teardown */
-    janet_vm_stackn = oldn;
+    janet_vm.stackn = oldn;
     janet_gcunlock(handle);
-
-    if (signal != JANET_SIGNAL_OK) {
-        janet_panicv(*janet_vm_return_reg);
+    if (dirty_stack) {
+        janet_fiber_popframe(janet_vm.fiber);
+        janet_vm.fiber->stacktop += dirty_stack;
     }
 
-    return *janet_vm_return_reg;
+    if (signal != JANET_SIGNAL_OK) {
+        janet_panicv(*janet_vm.return_reg);
+    }
+
+    return *janet_vm.return_reg;
 }
 
-static JanetSignal janet_check_can_resume(JanetFiber *fiber, Janet *out) {
+static JanetSignal janet_check_can_resume(JanetFiber *fiber, Janet *out, int is_cancel) {
     /* Check conditions */
     JanetFiberStatus old_status = janet_fiber_status(fiber);
-    if (janet_vm_stackn >= JANET_RECURSION_GUARD) {
+    if (janet_vm.stackn >= JANET_RECURSION_GUARD) {
         janet_fiber_set_status(fiber, JANET_STATUS_ERROR);
         *out = janet_cstringv("C stack recursed too deeply");
         return JANET_SIGNAL_ERROR;
     }
+    /* If a "task" fiber is trying to be used as a normal fiber, detect that. See bug #920.
+     * Fibers must be marked as root fibers manually, or by the ev scheduler. */
+    if (janet_vm.fiber != NULL && (fiber->gc.flags & JANET_FIBER_FLAG_ROOT)) {
+#ifdef JANET_EV
+        *out = janet_cstringv(is_cancel
+                              ? "cannot cancel root fiber, use ev/cancel"
+                              : "cannot resume root fiber, use ev/go");
+#else
+        *out = janet_cstringv(is_cancel
+                              ? "cannot cancel root fiber"
+                              : "cannot resume root fiber");
+#endif
+        return JANET_SIGNAL_ERROR;
+    }
     if (old_status == JANET_STATUS_ALIVE ||
             old_status == JANET_STATUS_DEAD ||
             (old_status >= JANET_STATUS_USER0 && old_status <= JANET_STATUS_USER4) ||
@@ -1343,21 +1383,21 @@ static JanetSignal janet_check_can_resume(JanetFiber *fiber, Janet *out) {
 }
 
 void janet_try_init(JanetTryState *state) {
-    state->stackn = janet_vm_stackn++;
-    state->gc_handle = janet_vm_gc_suspend;
-    state->vm_fiber = janet_vm_fiber;
-    state->vm_jmp_buf = janet_vm_jmp_buf;
-    state->vm_return_reg = janet_vm_return_reg;
-    janet_vm_return_reg = &(state->payload);
-    janet_vm_jmp_buf = &(state->buf);
+    state->stackn = janet_vm.stackn++;
+    state->gc_handle = janet_vm.gc_suspend;
+    state->vm_fiber = janet_vm.fiber;
+    state->vm_jmp_buf = janet_vm.signal_buf;
+    state->vm_return_reg = janet_vm.return_reg;
+    janet_vm.return_reg = &(state->payload);
+    janet_vm.signal_buf = &(state->buf);
 }
 
 void janet_restore(JanetTryState *state) {
-    janet_vm_stackn = state->stackn;
-    janet_vm_gc_suspend = state->gc_handle;
-    janet_vm_fiber = state->vm_fiber;
-    janet_vm_jmp_buf = state->vm_jmp_buf;
-    janet_vm_return_reg = state->vm_return_reg;
+    janet_vm.stackn = state->stackn;
+    janet_vm.gc_suspend = state->gc_handle;
+    janet_vm.fiber = state->vm_fiber;
+    janet_vm.signal_buf = state->vm_jmp_buf;
+    janet_vm.return_reg = state->vm_return_reg;
 }
 
 static JanetSignal janet_continue_no_check(JanetFiber *fiber, Janet in, Janet *out) {
@@ -1373,13 +1413,13 @@ static JanetSignal janet_continue_no_check(JanetFiber *fiber, Janet in, Janet *o
 
     /* Continue child fiber if it exists */
     if (fiber->child) {
-        if (janet_vm_root_fiber == NULL) janet_vm_root_fiber = fiber;
+        if (janet_vm.root_fiber == NULL) janet_vm.root_fiber = fiber;
         JanetFiber *child = fiber->child;
         uint32_t instr = (janet_stack_frame(fiber->data + fiber->frame)->pc)[0];
-        janet_vm_stackn++;
+        janet_vm.stackn++;
         JanetSignal sig = janet_continue(child, in, &in);
-        janet_vm_stackn--;
-        if (janet_vm_root_fiber == fiber) janet_vm_root_fiber = NULL;
+        janet_vm.stackn--;
+        if (janet_vm.root_fiber == fiber) janet_vm.root_fiber = NULL;
         if (sig != JANET_SIGNAL_OK && !(child->flags & (1 << sig))) {
             *out = in;
             janet_fiber_set_status(fiber, sig);
@@ -1425,14 +1465,14 @@ static JanetSignal janet_continue_no_check(JanetFiber *fiber, Janet in, Janet *o
     JanetSignal sig = janet_try(&tstate);
     if (!sig) {
         /* Normal setup */
-        if (janet_vm_root_fiber == NULL) janet_vm_root_fiber = fiber;
-        janet_vm_fiber = fiber;
+        if (janet_vm.root_fiber == NULL) janet_vm.root_fiber = fiber;
+        janet_vm.fiber = fiber;
         janet_fiber_set_status(fiber, JANET_STATUS_ALIVE);
         sig = run_vm(fiber, in);
     }
 
     /* Restore */
-    if (janet_vm_root_fiber == fiber) janet_vm_root_fiber = NULL;
+    if (janet_vm.root_fiber == fiber) janet_vm.root_fiber = NULL;
     janet_fiber_set_status(fiber, sig);
     janet_restore(&tstate);
     fiber->last_value = tstate.payload;
@@ -1444,14 +1484,14 @@ static JanetSignal janet_continue_no_check(JanetFiber *fiber, Janet in, Janet *o
 /* Enter the main vm loop */
 JanetSignal janet_continue(JanetFiber *fiber, Janet in, Janet *out) {
     /* Check conditions */
-    JanetSignal tmp_signal = janet_check_can_resume(fiber, out);
+    JanetSignal tmp_signal = janet_check_can_resume(fiber, out, 0);
     if (tmp_signal) return tmp_signal;
     return janet_continue_no_check(fiber, in, out);
 }
 
 /* Enter the main vm loop but immediately raise a signal */
 JanetSignal janet_continue_signal(JanetFiber *fiber, Janet in, Janet *out, JanetSignal sig) {
-    JanetSignal tmp_signal = janet_check_can_resume(fiber, out);
+    JanetSignal tmp_signal = janet_check_can_resume(fiber, out, sig != JANET_SIGNAL_OK);
     if (tmp_signal) return tmp_signal;
     if (sig != JANET_SIGNAL_OK) {
         JanetFiber *child = fiber;
@@ -1485,7 +1525,9 @@ JanetSignal janet_pcall(
 
 Janet janet_mcall(const char *name, int32_t argc, Janet *argv) {
     /* At least 1 argument */
-    if (argc < 1) janet_panicf("method :%s expected at least 1 argument");
+    if (argc < 1) {
+        janet_panicf("method :%s expected at least 1 argument", name);
+    }
     /* Find method */
     Janet method = janet_method_lookup(argv[0], name);
     if (janet_checktype(method, JANET_NIL)) {
@@ -1497,42 +1539,58 @@ Janet janet_mcall(const char *name, int32_t argc, Janet *argv) {
 
 /* Setup VM */
 int janet_init(void) {
+
     /* Garbage collection */
-    janet_vm_blocks = NULL;
-    janet_vm_next_collection = 0;
-    janet_vm_gc_interval = 0x400000;
-    janet_vm_block_count = 0;
+    janet_vm.blocks = NULL;
+    janet_vm.next_collection = 0;
+    janet_vm.gc_interval = 0x400000;
+    janet_vm.block_count = 0;
+
     janet_symcache_init();
+
     /* Initialize gc roots */
-    janet_vm_roots = NULL;
-    janet_vm_root_count = 0;
-    janet_vm_root_capacity = 0;
+    janet_vm.roots = NULL;
+    janet_vm.root_count = 0;
+    janet_vm.root_capacity = 0;
+
     /* Scratch memory */
-    janet_scratch_mem = NULL;
-    janet_scratch_len = 0;
-    janet_scratch_cap = 0;
+    janet_vm.user = NULL;
+    janet_vm.scratch_mem = NULL;
+    janet_vm.scratch_len = 0;
+    janet_vm.scratch_cap = 0;
+
     /* Initialize registry */
-    janet_vm_registry = janet_table(0);
-    janet_vm_abstract_registry = janet_table(0);
-    janet_gcroot(janet_wrap_table(janet_vm_registry));
-    janet_gcroot(janet_wrap_table(janet_vm_abstract_registry));
+    janet_vm.registry = NULL;
+    janet_vm.registry_cap = 0;
+    janet_vm.registry_count = 0;
+    janet_vm.registry_dirty = 0;
+
+    /* Intialize abstract registry */
+    janet_vm.abstract_registry = janet_table(0);
+    janet_gcroot(janet_wrap_table(janet_vm.abstract_registry));
+
     /* Traversal */
-    janet_vm_traversal = NULL;
-    janet_vm_traversal_base = NULL;
-    janet_vm_traversal_top = NULL;
+    janet_vm.traversal = NULL;
+    janet_vm.traversal_base = NULL;
+    janet_vm.traversal_top = NULL;
+
     /* Core env */
-    janet_vm_core_env = NULL;
+    janet_vm.core_env = NULL;
+
+    /* Auto suspension */
+    janet_vm.auto_suspend = 0;
+
     /* Dynamic bindings */
-    janet_vm_top_dyns = NULL;
+    janet_vm.top_dyns = NULL;
+
     /* Seed RNG */
     janet_rng_seed(janet_default_rng(), 0);
+
     /* Fibers */
-    janet_vm_fiber = NULL;
-    janet_vm_root_fiber = NULL;
-    janet_vm_stackn = 0;
-#ifdef JANET_THREADS
-    janet_threads_init();
-#endif
+    janet_vm.fiber = NULL;
+    janet_vm.root_fiber = NULL;
+    janet_vm.stackn = 0;
+
 #ifdef JANET_EV
     janet_ev_init();
 #endif
@@ -1546,20 +1604,19 @@ int janet_init(void) {
 void janet_deinit(void) {
     janet_clear_memory();
     janet_symcache_deinit();
-    janet_free(janet_vm_roots);
-    janet_vm_roots = NULL;
-    janet_vm_root_count = 0;
-    janet_vm_root_capacity = 0;
-    janet_vm_registry = NULL;
-    janet_vm_abstract_registry = NULL;
-    janet_vm_core_env = NULL;
-    janet_vm_top_dyns = NULL;
-    janet_free(janet_vm_traversal_base);
-    janet_vm_fiber = NULL;
-    janet_vm_root_fiber = NULL;
-#ifdef JANET_THREADS
-    janet_threads_deinit();
-#endif
+    janet_free(janet_vm.roots);
+    janet_vm.roots = NULL;
+    janet_vm.root_count = 0;
+    janet_vm.root_capacity = 0;
+    janet_vm.abstract_registry = NULL;
+    janet_vm.core_env = NULL;
+    janet_vm.top_dyns = NULL;
+    janet_vm.user = NULL;
+    janet_free(janet_vm.traversal_base);
+    janet_vm.fiber = NULL;
+    janet_vm.root_fiber = NULL;
+    janet_free(janet_vm.registry);
+    janet_vm.registry = NULL;
 #ifdef JANET_EV
     janet_ev_deinit();
 #endif

src/core/wrap.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
@@ -163,7 +163,7 @@ Janet(janet_wrap_number)(double x) {
 void *janet_memalloc_empty(int32_t count) {
     int32_t i;
     void *mem = janet_malloc((size_t) count * sizeof(JanetKV));
-    janet_vm_next_collection += (size_t) count * sizeof(JanetKV);
+    janet_vm.next_collection += (size_t) count * sizeof(JanetKV);
     if (NULL == mem) {
         JANET_OUT_OF_MEMORY;
     }

src/include/janet.h

@@ -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
@@ -57,8 +57,8 @@ extern "C" {
 #define JANET_BSD 1
 #endif
 
-/* Check for Mac */
-#ifdef __APPLE__
+/* Check for macOS or OS X */
+#if defined(__APPLE__) && defined(__MACH__)
 #define JANET_APPLE 1
 #endif
 
@@ -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
@@ -145,16 +161,17 @@ extern "C" {
 #endif
 
 /* Define how global janet state is declared */
+/* Also enable the thread library only if not single-threaded */
 #ifdef JANET_SINGLE_THREADED
 #define JANET_THREAD_LOCAL
+#undef JANET_THREADS
 #elif defined(__GNUC__)
 #define JANET_THREAD_LOCAL __thread
-#define JANET_THREADS
 #elif defined(_MSC_BUILD)
 #define JANET_THREAD_LOCAL __declspec(thread)
-#define JANET_THREADS
 #else
 #define JANET_THREAD_LOCAL
+#undef JANET_THREADS
 #endif
 
 /* Enable or disable dynamic module loading. Enabled by default. */
@@ -162,6 +179,21 @@ extern "C" {
 #define JANET_DYNAMIC_MODULES
 #endif
 
+/* Enable or disable the FFI library. Currently, FFI only enabled on
+ * x86-64 operating systems. */
+#ifndef JANET_NO_FFI
+#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
@@ -187,6 +219,21 @@ extern "C" {
 #define JANET_INT_TYPES
 #endif
 
+/* Enable or disable epoll on Linux */
+#if defined(JANET_LINUX) && !defined(JANET_EV_NO_EPOLL)
+#define JANET_EV_EPOLL
+#endif
+
+/* Enable or disable kqueue on BSD */
+#if defined(JANET_BSD) && !defined(JANET_EV_NO_KQUEUE)
+#define JANET_EV_KQUEUE
+#endif
+
+/* Enable or disable kqueue on Apple */
+#if defined(JANET_APPLE) && !defined(JANET_EV_NO_KQUEUE)
+#define JANET_EV_KQUEUE
+#endif
+
 /* How to export symbols */
 #ifndef JANET_API
 #ifdef JANET_WINDOWS
@@ -212,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.
@@ -283,10 +330,10 @@ typedef struct {
     JANET_CURRENT_CONFIG_BITS })
 #endif
 
-/* What to do when out of memory */
-#ifndef JANET_OUT_OF_MEMORY
-#include <stdio.h>
-#define JANET_OUT_OF_MEMORY do { fprintf(stderr, "janet out of memory\n"); exit(1); } while (0)
+/* Some extra includes if EV is enabled */
+#ifdef JANET_EV
+typedef struct JanetOSMutex JanetOSMutex;
+typedef struct JanetOSRWLock JanetOSRWLock;
 #endif
 
 /***** END SECTION CONFIG *****/
@@ -306,6 +353,12 @@ typedef struct {
 #include <stddef.h>
 #include <stdio.h>
 
+
+/* What to do when out of memory */
+#ifndef JANET_OUT_OF_MEMORY
+#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
 int _setjmp(jmp_buf);
 JANET_NO_RETURN void _longjmp(jmp_buf, int);
@@ -344,6 +397,7 @@ typedef enum {
 } JanetSignal;
 
 #define JANET_SIGNAL_EVENT JANET_SIGNAL_USER9
+#define JANET_SIGNAL_INTERRUPT JANET_SIGNAL_USER8
 
 /* Fiber statuses - mostly corresponds to signals. */
 typedef enum {
@@ -365,6 +419,9 @@ typedef enum {
     JANET_STATUS_ALIVE
 } JanetFiberStatus;
 
+/* For encapsulating all thread-local Janet state (except natives) */
+typedef struct JanetVM JanetVM;
+
 /* Use type punning for GC objects */
 typedef struct JanetGCObject JanetGCObject;
 
@@ -388,8 +445,10 @@ typedef struct JanetKV JanetKV;
 typedef struct JanetStackFrame JanetStackFrame;
 typedef struct JanetAbstractType JanetAbstractType;
 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;
@@ -809,6 +868,7 @@ JANET_API Janet janet_nanbox32_from_tagp(uint32_t tag, void *pointer);
 
 JANET_API int janet_checkint(Janet x);
 JANET_API int janet_checkint64(Janet x);
+JANET_API int janet_checkuint64(Janet x);
 JANET_API int janet_checksize(Janet x);
 JANET_API JanetAbstract janet_checkabstract(Janet x, const JanetAbstractType *at);
 #define janet_checkintrange(x) ((x) >= INT32_MIN && (x) <= INT32_MAX && (x) == (int32_t)(x))
@@ -823,7 +883,10 @@ JANET_API JanetAbstract janet_checkabstract(Janet x, const JanetAbstractType *at
  * list of blocks, which is naive but works. */
 struct JanetGCObject {
     int32_t flags;
-    JanetGCObject *next;
+    union {
+        JanetGCObject *next;
+        int32_t refcount; /* For threaded abstract types */
+    } data;
 };
 
 /* A lightweight green thread in janet. Does not correspond to
@@ -918,6 +981,7 @@ struct JanetStructHead {
     int32_t length;
     int32_t hash;
     int32_t capacity;
+    const JanetKV *proto;
     const JanetKV data[];
 };
 
@@ -940,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
@@ -955,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;
@@ -968,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 */
@@ -978,6 +1052,7 @@ struct JanetFuncDef {
     int32_t bytecode_length;
     int32_t environments_length;
     int32_t defs_length;
+    int32_t symbolmap_length;
 };
 
 /* A function environment */
@@ -1053,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
@@ -1070,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;
@@ -1078,6 +1157,14 @@ struct JanetReg {
     const char *documentation;
 };
 
+struct JanetRegExt {
+    const char *name;
+    JanetCFunction cfun;
+    const char *documentation;
+    const char *source_file;
+    int32_t source_line;
+};
+
 struct JanetMethod {
     const char *name;
     JanetCFunction cfun;
@@ -1128,17 +1215,6 @@ typedef struct {
     Janet payload;
 } JanetTryState;
 
-/* Thread types */
-#ifdef JANET_THREADS
-typedef struct JanetThread JanetThread;
-typedef struct JanetMailbox JanetMailbox;
-struct JanetThread {
-    JanetMailbox *mailbox;
-    JanetTable *encode;
-};
-#endif
-
-
 /***** END SECTION TYPES *****/
 
 /***** START SECTION OPCODES *****/
@@ -1263,10 +1339,36 @@ extern enum JanetInstructionType janet_instructions[JOP_INSTRUCTION_COUNT];
 #ifdef JANET_EV
 
 extern JANET_API const JanetAbstractType janet_stream_type;
+extern JANET_API const JanetAbstractType janet_channel_type;
 
 /* Run the event loop */
 JANET_API void janet_loop(void);
 
+/* Run the event loop, but allow for user scheduled interrupts triggered
+ * by janet_loop1_interrupt being called in library code, a signal handler, or
+ * another thread.
+ *
+ * Example:
+ *
+ * while (!janet_loop_done()) {
+ *   // One turn of the event loop
+ *   JanetFiber *interrupted_fiber = janet_loop1();
+ *   // interrupted_fiber may be NULL
+ *   // do some work here periodically...
+ *   if (NULL != interrupted_fiber) {
+ *     if (cancel_interrupted_fiber) {
+ *       janet_cancel(interrupted_fiber, janet_cstringv("fiber was interrupted for [reason]"));
+ *     } else {
+ *       janet_schedule(interrupted_fiber, janet_wrap_nil());
+ *     }
+ *   }
+ * }
+ *
+ */
+JANET_API int janet_loop_done(void);
+JANET_API JanetFiber *janet_loop1(void);
+JANET_API void janet_loop1_interrupt(JanetVM *vm);
+
 /* Wrapper around streams */
 JANET_API JanetStream *janet_stream(JanetHandle handle, uint32_t flags, const JanetMethod *methods);
 JANET_API void janet_stream_close(JanetStream *stream);
@@ -1294,7 +1396,28 @@ JANET_API void janet_addtimeout(double sec);
 JANET_API void janet_ev_inc_refcount(void);
 JANET_API void janet_ev_dec_refcount(void);
 
-/* Get last error from a an IO operation */
+/* Thread aware abstract types and helpers */
+JANET_API void *janet_abstract_begin_threaded(const JanetAbstractType *atype, size_t size);
+JANET_API void *janet_abstract_end_threaded(void *x);
+JANET_API void *janet_abstract_threaded(const JanetAbstractType *atype, size_t size);
+JANET_API int32_t janet_abstract_incref(void *abst);
+JANET_API int32_t janet_abstract_decref(void *abst);
+
+/* Expose some OS sync primitives */
+JANET_API size_t janet_os_mutex_size(void);
+JANET_API size_t janet_os_rwlock_size(void);
+JANET_API void janet_os_mutex_init(JanetOSMutex *mutex);
+JANET_API void janet_os_mutex_deinit(JanetOSMutex *mutex);
+JANET_API void janet_os_mutex_lock(JanetOSMutex *mutex);
+JANET_API void janet_os_mutex_unlock(JanetOSMutex *mutex);
+JANET_API void janet_os_rwlock_init(JanetOSRWLock *rwlock);
+JANET_API void janet_os_rwlock_deinit(JanetOSRWLock *rwlock);
+JANET_API void janet_os_rwlock_rlock(JanetOSRWLock *rwlock);
+JANET_API void janet_os_rwlock_wlock(JanetOSRWLock *rwlock);
+JANET_API void janet_os_rwlock_runlock(JanetOSRWLock *rwlock);
+JANET_API void janet_os_rwlock_wunlock(JanetOSRWLock *rwlock);
+
+/* Get last error from an IO operation */
 JANET_API Janet janet_ev_lasterr(void);
 
 /* Async service for calling a function or syscall in a background thread. This is not
@@ -1308,6 +1431,7 @@ typedef struct {
     int tag;
     int argi;
     void *argp;
+    Janet argj;
     JanetFiber *fiber;
 } JanetEVGenericMessage;
 
@@ -1330,13 +1454,20 @@ typedef struct {
 /* Function pointer that is run in the thread pool */
 typedef JanetEVGenericMessage(*JanetThreadedSubroutine)(JanetEVGenericMessage arguments);
 
-/* Handler that is run in the main thread with the result of the JanetAsyncSubroutine */
+/* Handler for events posted to the event loop */
+typedef void (*JanetCallback)(JanetEVGenericMessage return_value);
+
+/* Handler that is run in the main thread with the result of the JanetAsyncSubroutine (same as JanetCallback) */
 typedef void (*JanetThreadedCallback)(JanetEVGenericMessage return_value);
 
 /* API calls for quickly offloading some work in C to a new thread or thread pool. */
 JANET_API void janet_ev_threaded_call(JanetThreadedSubroutine fp, JanetEVGenericMessage arguments, JanetThreadedCallback cb);
 JANET_NO_RETURN JANET_API void janet_ev_threaded_await(JanetThreadedSubroutine fp, int tag, int argi, void *argp);
 
+/* Post callback + userdata to an event loop. Takes the vm parameter to allow posting from other
+ * threads or signal handlers. Use NULL to post to the current thread. */
+JANET_API void janet_ev_post_event(JanetVM *vm, JanetCallback cb, JanetEVGenericMessage msg);
+
 /* Callback used by janet_ev_threaded_await */
 JANET_API void janet_ev_default_threaded_callback(JanetEVGenericMessage return_value);
 
@@ -1415,11 +1546,16 @@ JANET_API JanetCompileResult janet_compile_lint(
 JANET_API JanetTable *janet_core_env(JanetTable *replacements);
 JANET_API JanetTable *janet_core_lookup_table(JanetTable *replacements);
 
+/* Execute strings */
 JANET_API int janet_dobytes(JanetTable *env, const uint8_t *bytes, int32_t len, const char *sourcePath, Janet *out);
 JANET_API int janet_dostring(JanetTable *env, const char *str, const char *sourcePath, Janet *out);
 
+/* Run the entrypoint of a wrapped program */
+JANET_API int janet_loop_fiber(JanetFiber *fiber);
+
 /* Number scanning */
 JANET_API int janet_scan_number(const uint8_t *str, int32_t len, double *out);
+JANET_API int janet_scan_number_base(const uint8_t *str, int32_t len, int32_t base, double *out);
 JANET_API int janet_scan_int64(const uint8_t *str, int32_t len, int64_t *out);
 JANET_API int janet_scan_uint64(const uint8_t *str, int32_t len, uint64_t *out);
 
@@ -1436,6 +1572,7 @@ JANET_API JanetRNG *janet_default_rng(void);
 JANET_API void janet_rng_seed(JanetRNG *rng, uint32_t seed);
 JANET_API void janet_rng_longseed(JanetRNG *rng, const uint8_t *bytes, int32_t len);
 JANET_API uint32_t janet_rng_u32(JanetRNG *rng);
+JANET_API double janet_rng_double(JanetRNG *rng);
 
 /* Array functions */
 JANET_API JanetArray *janet_array(int32_t capacity);
@@ -1516,16 +1653,20 @@ JANET_API JanetSymbol janet_symbol_gen(void);
 #define janet_struct_length(t) (janet_struct_head(t)->length)
 #define janet_struct_capacity(t) (janet_struct_head(t)->capacity)
 #define janet_struct_hash(t) (janet_struct_head(t)->hash)
+#define janet_struct_proto(t) (janet_struct_head(t)->proto)
 JANET_API JanetKV *janet_struct_begin(int32_t count);
 JANET_API void janet_struct_put(JanetKV *st, Janet key, Janet value);
 JANET_API JanetStruct janet_struct_end(JanetKV *st);
 JANET_API Janet janet_struct_get(JanetStruct st, Janet key);
+JANET_API Janet janet_struct_rawget(JanetStruct st, Janet key);
+JANET_API Janet janet_struct_get_ex(JanetStruct st, Janet key, JanetStruct *which);
 JANET_API JanetTable *janet_struct_to_table(JanetStruct st);
 JANET_API const JanetKV *janet_struct_find(JanetStruct st, Janet key);
 
 /* Table functions */
 JANET_API JanetTable *janet_table(int32_t capacity);
 JANET_API JanetTable *janet_table_init(JanetTable *table, int32_t capacity);
+JANET_API JanetTable *janet_table_init_raw(JanetTable *table, int32_t capacity);
 JANET_API void janet_table_deinit(JanetTable *table);
 JANET_API Janet janet_table_get(JanetTable *t, Janet key);
 JANET_API Janet janet_table_get_ex(JanetTable *t, Janet key, JanetTable **which);
@@ -1569,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,
@@ -1641,6 +1783,12 @@ JANET_API int32_t janet_sorted_keys(const JanetKV *dict, int32_t cap, int32_t *i
 /* VM functions */
 JANET_API int janet_init(void);
 JANET_API void janet_deinit(void);
+JANET_API JanetVM *janet_vm_alloc(void);
+JANET_API JanetVM *janet_local_vm(void);
+JANET_API void janet_vm_free(JanetVM *vm);
+JANET_API void janet_vm_save(JanetVM *into);
+JANET_API void janet_vm_load(JanetVM *from);
+JANET_API void janet_interpreter_interrupt(JanetVM *vm);
 JANET_API JanetSignal janet_continue(JanetFiber *fiber, Janet in, Janet *out);
 JANET_API JanetSignal janet_continue_signal(JanetFiber *fiber, Janet in, Janet *out, JanetSignal sig);
 JANET_API JanetSignal janet_pcall(JanetFunction *fun, int32_t argn, const Janet *argv, Janet *out, JanetFiber **f);
@@ -1648,6 +1796,7 @@ JANET_API JanetSignal janet_step(JanetFiber *fiber, Janet in, Janet *out);
 JANET_API Janet janet_call(JanetFunction *fun, int32_t argc, const Janet *argv);
 JANET_API Janet janet_mcall(const char *name, int32_t argc, Janet *argv);
 JANET_API void janet_stacktrace(JanetFiber *fiber, Janet err);
+JANET_API void janet_stacktrace_ext(JanetFiber *fiber, Janet err, const char *prefix);
 
 /* Scratch Memory API */
 typedef void (*JanetScratchFinalizer)(void *);
@@ -1663,7 +1812,9 @@ typedef enum {
     JANET_BINDING_NONE,
     JANET_BINDING_DEF,
     JANET_BINDING_VAR,
-    JANET_BINDING_MACRO
+    JANET_BINDING_MACRO,
+    JANET_BINDING_DYNAMIC_DEF,
+    JANET_BINDING_DYNAMIC_MACRO
 } JanetBindingType;
 
 typedef struct {
@@ -1683,7 +1834,6 @@ JANET_API void janet_cfuns(JanetTable *env, const char *regprefix, const JanetRe
 JANET_API void janet_cfuns_prefix(JanetTable *env, const char *regprefix, const JanetReg *cfuns);
 JANET_API JanetBindingType janet_resolve(JanetTable *env, JanetSymbol sym, Janet *out);
 JANET_API JanetBinding janet_resolve_ext(JanetTable *env, JanetSymbol sym);
-JANET_API void janet_register(const char *name, JanetCFunction cfun);
 
 /* Get values from the core environment. */
 JANET_API Janet janet_resolve_core(const char *name);
@@ -1693,6 +1843,70 @@ JANET_API Janet janet_resolve_core(const char *name);
 /* Shorthand for janet C function declarations */
 #define JANET_CFUN(name) Janet name (int32_t argc, Janet *argv)
 
+/* Declare a C function with documentation and source mapping */
+#define JANET_REG_END {NULL, NULL, NULL, NULL, 0}
+
+/* no docstrings or sourcemaps */
+#define JANET_REG_(JNAME, CNAME) {JNAME, CNAME, NULL, NULL, 0}
+#define JANET_FN_(CNAME, USAGE, DOCSTRING) \
+    Janet CNAME (int32_t argc, Janet *argv)
+#define JANET_DEF_(ENV, JNAME, VAL, DOC) \
+    janet_def(ENV, JNAME, VAL, NULL)
+
+/* sourcemaps only */
+#define JANET_REG_S(JNAME, CNAME) {JNAME, CNAME, NULL, __FILE__, CNAME##_sourceline_}
+#define JANET_FN_S(CNAME, USAGE, DOCSTRING) \
+    static int32_t CNAME##_sourceline_ = __LINE__; \
+    Janet CNAME (int32_t argc, Janet *argv)
+#define JANET_DEF_S(ENV, JNAME, VAL, DOC) \
+    janet_def_sm(ENV, JNAME, VAL, NULL, __FILE__, __LINE__)
+
+/* docstring only */
+#define JANET_REG_D(JNAME, CNAME) {JNAME, CNAME, CNAME##_docstring_, NULL, 0}
+#define JANET_FN_D(CNAME, USAGE, DOCSTRING) \
+    static const char CNAME##_docstring_[] = USAGE "\n\n" DOCSTRING; \
+    Janet CNAME (int32_t argc, Janet *argv)
+#define JANET_DEF_D(ENV, JNAME, VAL, DOC) \
+    janet_def(ENV, JNAME, VAL, DOC)
+
+/* sourcemaps and docstrings */
+#define JANET_REG_SD(JNAME, CNAME) {JNAME, CNAME, CNAME##_docstring_, __FILE__, CNAME##_sourceline_}
+#define JANET_FN_SD(CNAME, USAGE, DOCSTRING) \
+    static int32_t CNAME##_sourceline_ = __LINE__; \
+    static const char CNAME##_docstring_[] = USAGE "\n\n" DOCSTRING; \
+    Janet CNAME (int32_t argc, Janet *argv)
+#define JANET_DEF_SD(ENV, JNAME, VAL, DOC) \
+    janet_def_sm(ENV, JNAME, VAL, DOC, __FILE__, __LINE__)
+
+
+/* Choose defaults for source mapping and docstring based on config defs */
+#if defined(JANET_NO_SOURCEMAPS) && defined(JANET_NO_DOCSTRINGS)
+#define JANET_REG JANET_REG_
+#define JANET_FN JANET_FN_
+#define JANET_DEF JANET_DEF_
+#elif defined(JANET_NO_SOURCEMAPS) && !defined(JANET_NO_DOCSTRINGS)
+#define JANET_REG JANET_REG_D
+#define JANET_FN JANET_FN_D
+#define JANET_DEF JANET_DEF_D
+#elif !defined(JANET_NO_SOURCEMAPS) && defined(JANET_NO_DOCSTRINGS)
+#define JANET_REG JANET_REG_S
+#define JANET_FN JANET_FN_S
+#define JANET_DEF JANET_DEF_S
+#elif !defined(JANET_NO_SOURCEMAPS) && !defined(JANET_NO_DOCSTRINGS)
+#define JANET_REG JANET_REG_SD
+#define JANET_FN JANET_FN_SD
+#define JANET_DEF JANET_DEF_SD
+#endif
+
+/* Define things with source mapping information */
+JANET_API void janet_cfuns_ext(JanetTable *env, const char *regprefix, const JanetRegExt *cfuns);
+JANET_API void janet_cfuns_ext_prefix(JanetTable *env, const char *regprefix, const JanetRegExt *cfuns);
+JANET_API void janet_def_sm(JanetTable *env, const char *name, Janet val, const char *documentation, const char *source_file, int32_t source_line);
+JANET_API void janet_var_sm(JanetTable *env, const char *name, Janet val, const char *documentation, const char *source_file, int32_t source_line);
+
+/* Legacy definition of C functions */
+JANET_API void janet_register(const char *name, JanetCFunction cfun);
+
 /* Allow setting entry name for static libraries */
 #ifdef __cplusplus
 #define JANET_MODULE_PREFIX extern "C"
@@ -1744,6 +1958,7 @@ JANET_API void *janet_getpointer(const Janet *argv, int32_t n);
 JANET_API int32_t janet_getnat(const Janet *argv, int32_t n);
 JANET_API int32_t janet_getinteger(const Janet *argv, int32_t n);
 JANET_API int64_t janet_getinteger64(const Janet *argv, int32_t n);
+JANET_API uint64_t janet_getuinteger64(const Janet *argv, int32_t n);
 JANET_API size_t janet_getsize(const Janet *argv, int32_t n);
 JANET_API JanetView janet_getindexed(const Janet *argv, int32_t n);
 JANET_API JanetByteView janet_getbytes(const Janet *argv, int32_t n);
@@ -1791,7 +2006,6 @@ extern JANET_API const JanetAbstractType janet_file_type;
 #define JANET_FILE_CLOSED 32
 #define JANET_FILE_BINARY 64
 #define JANET_FILE_SERIALIZABLE 128
-#define JANET_FILE_PIPED 256
 #define JANET_FILE_NONIL 512
 
 JANET_API Janet janet_makefile(FILE *f, int32_t flags);
@@ -1822,6 +2036,7 @@ JANET_API uint8_t janet_unmarshal_byte(JanetMarshalContext *ctx);
 JANET_API void janet_unmarshal_bytes(JanetMarshalContext *ctx, uint8_t *dest, size_t len);
 JANET_API Janet janet_unmarshal_janet(JanetMarshalContext *ctx);
 JANET_API JanetAbstract janet_unmarshal_abstract(JanetMarshalContext *ctx, size_t size);
+JANET_API void janet_unmarshal_abstract_reuse(JanetMarshalContext *ctx, void *p);
 
 JANET_API void janet_register_abstract_type(const JanetAbstractType *at);
 JANET_API const JanetAbstractType *janet_get_abstract_type(Janet key);
@@ -1862,7 +2077,8 @@ typedef enum {
     RULE_READINT,      /* [(signedness << 4) | (endianess << 5) | bytewidth, tag] */
     RULE_LINE,         /* [tag] */
     RULE_COLUMN,       /* [tag] */
-    RULE_UNREF         /* [rule, tag] */
+    RULE_UNREF,        /* [rule, tag] */
+    RULE_CAPTURE_NUM   /* [rule, tag] */
 } JanetPegOpcod;
 
 typedef struct {
@@ -1896,16 +2112,6 @@ JANET_API int janet_scan_uint64(const uint8_t *str, int32_t len, uint64_t *out);
 
 #endif
 
-#ifdef JANET_THREADS
-
-extern JANET_API const JanetAbstractType janet_thread_type;
-
-JANET_API int janet_thread_receive(Janet *msg_out, double timeout);
-JANET_API int janet_thread_send(JanetThread *thread, Janet msg, double timeout);
-JANET_API JanetThread *janet_thread_current(void);
-
-#endif
-
 /* Custom allocator support */
 JANET_API void *(janet_malloc)(size_t);
 JANET_API void *(janet_realloc)(void *, size_t);

src/mainclient/shell.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
@@ -25,6 +25,7 @@
 #endif
 
 #include <janet.h>
+#include <errno.h>
 
 #ifdef _WIN32
 #include <windows.h>
@@ -32,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();
@@ -75,6 +79,9 @@ static void simpleline(JanetBuffer *buffer) {
     int c;
     for (;;) {
         c = fgetc(in);
+        if (c < 0 && !feof(in) && errno == EINTR) {
+            continue;
+        }
         if (feof(in) || c < 0) {
             break;
         }
@@ -83,8 +90,30 @@ static void simpleline(JanetBuffer *buffer) {
     }
 }
 
-/* Windows */
-#if defined(JANET_WINDOWS) || defined(JANET_SIMPLE_GETLINE)
+/* State */
+
+#ifndef JANET_SIMPLE_GETLINE
+/* static state */
+#define JANET_LINE_MAX 1024
+#define JANET_MATCH_MAX 256
+#define JANET_HISTORY_MAX 100
+static JANET_THREAD_LOCAL int gbl_israwmode = 0;
+static JANET_THREAD_LOCAL const char *gbl_prompt = "> ";
+static JANET_THREAD_LOCAL int gbl_plen = 2;
+static JANET_THREAD_LOCAL char gbl_buf[JANET_LINE_MAX];
+static JANET_THREAD_LOCAL int gbl_len = 0;
+static JANET_THREAD_LOCAL int gbl_pos = 0;
+static JANET_THREAD_LOCAL int gbl_cols = 80;
+static JANET_THREAD_LOCAL char *gbl_history[JANET_HISTORY_MAX];
+static JANET_THREAD_LOCAL int gbl_history_count = 0;
+static JANET_THREAD_LOCAL int gbl_historyi = 0;
+static JANET_THREAD_LOCAL JanetByteView gbl_matches[JANET_MATCH_MAX];
+static JANET_THREAD_LOCAL int gbl_match_count = 0;
+static JANET_THREAD_LOCAL int gbl_lines_below = 0;
+#endif
+
+/* Fallback */
+#if defined(JANET_SIMPLE_GETLINE)
 
 void janet_line_init() {
     ;
@@ -101,6 +130,80 @@ void janet_line_get(const char *p, JanetBuffer *buffer) {
     simpleline(buffer);
 }
 
+/* Rich implementation */
+#else
+
+/* Windows */
+#ifdef _WIN32
+
+#include <stdbool.h>
+#include <stdio.h>
+#include <stdlib.h>
+#include <io.h>
+
+static void setup_console_output(void) {
+    /* Enable color console on windows 10 console and utf8 output and other processing */
+    HANDLE hOut = GetStdHandle(STD_OUTPUT_HANDLE);
+    DWORD dwMode = 0;
+    GetConsoleMode(hOut, &dwMode);
+    dwMode |= ENABLE_VIRTUAL_TERMINAL_PROCESSING;
+    SetConsoleMode(hOut, dwMode);
+    SetConsoleOutputCP(65001);
+}
+
+/* Ansi terminal raw mode */
+static int rawmode(void) {
+    if (gbl_israwmode) return 0;
+    HANDLE hOut = GetStdHandle(STD_INPUT_HANDLE);
+    DWORD dwMode = 0;
+    GetConsoleMode(hOut, &dwMode);
+    dwMode &= ~ENABLE_LINE_INPUT;
+    dwMode &= ~ENABLE_INSERT_MODE;
+    dwMode &= ~ENABLE_ECHO_INPUT;
+    dwMode |= ENABLE_VIRTUAL_TERMINAL_INPUT;
+    dwMode &= ~ENABLE_PROCESSED_INPUT;
+    if (!SetConsoleMode(hOut, dwMode)) return 1;
+    gbl_israwmode = 1;
+    return 0;
+}
+
+/* Disable raw mode */
+static void norawmode(void) {
+    if (!gbl_israwmode) return;
+    HANDLE hOut = GetStdHandle(STD_INPUT_HANDLE);
+    DWORD dwMode = 0;
+    GetConsoleMode(hOut, &dwMode);
+    dwMode |= ENABLE_LINE_INPUT;
+    dwMode |= ENABLE_INSERT_MODE;
+    dwMode |= ENABLE_ECHO_INPUT;
+    dwMode &= ~ENABLE_VIRTUAL_TERMINAL_INPUT;
+    dwMode |= ENABLE_PROCESSED_INPUT;
+    SetConsoleMode(hOut, dwMode);
+    gbl_israwmode = 0;
+}
+
+static long write_console(const char *bytes, size_t n) {
+    DWORD nwritten = 0;
+    BOOL result = WriteConsole(GetStdHandle(STD_OUTPUT_HANDLE), bytes, (DWORD) n, &nwritten, NULL);
+    if (!result) return -1; /* error */
+    return (long)nwritten;
+}
+
+static long read_console(char *into, size_t n) {
+    DWORD numread;
+    BOOL result = ReadConsole(GetStdHandle(STD_INPUT_HANDLE), into, (DWORD) n, &numread, NULL);
+    if (!result) return -1; /* error */
+    return (long)numread;
+}
+
+static int check_simpleline(JanetBuffer *buffer) {
+    if (!_isatty(_fileno(stdin)) || rawmode()) {
+        simpleline(buffer);
+        return 1;
+    }
+    return 0;
+}
+
 /* Posix */
 #else
 
@@ -112,7 +215,6 @@ https://github.com/antirez/linenoise/blob/master/linenoise.c
 #include <unistd.h>
 #include <stdlib.h>
 #include <stdio.h>
-#include <errno.h>
 #include <stdlib.h>
 #include <ctype.h>
 #include <sys/stat.h>
@@ -122,25 +224,7 @@ https://github.com/antirez/linenoise/blob/master/linenoise.c
 #include <string.h>
 #include <signal.h>
 
-/* static state */
-#define JANET_LINE_MAX 1024
-#define JANET_MATCH_MAX 256
-#define JANET_HISTORY_MAX 100
-static JANET_THREAD_LOCAL int gbl_israwmode = 0;
-static JANET_THREAD_LOCAL const char *gbl_prompt = "> ";
-static JANET_THREAD_LOCAL int gbl_plen = 2;
-static JANET_THREAD_LOCAL char gbl_buf[JANET_LINE_MAX];
-static JANET_THREAD_LOCAL int gbl_len = 0;
-static JANET_THREAD_LOCAL int gbl_pos = 0;
-static JANET_THREAD_LOCAL int gbl_cols = 80;
-static JANET_THREAD_LOCAL char *gbl_history[JANET_HISTORY_MAX];
-static JANET_THREAD_LOCAL int gbl_history_count = 0;
-static JANET_THREAD_LOCAL int gbl_historyi = 0;
-static JANET_THREAD_LOCAL int gbl_sigint_flag = 0;
 static JANET_THREAD_LOCAL struct termios gbl_termios_start;
-static JANET_THREAD_LOCAL JanetByteView gbl_matches[JANET_MATCH_MAX];
-static JANET_THREAD_LOCAL int gbl_match_count = 0;
-static JANET_THREAD_LOCAL int gbl_lines_below = 0;
 
 /* Unsupported terminal list from linenoise */
 static const char *badterms[] = {
@@ -150,15 +234,6 @@ static const char *badterms[] = {
     NULL
 };
 
-static char *sdup(const char *s) {
-    size_t len = strlen(s) + 1;
-    char *mem = janet_malloc(len);
-    if (!mem) {
-        return NULL;
-    }
-    return memcpy(mem, s, len);
-}
-
 /* Ansi terminal raw mode */
 static int rawmode(void) {
     struct termios t;
@@ -184,13 +259,54 @@ static void norawmode(void) {
         gbl_israwmode = 0;
 }
 
+static int checktermsupport() {
+    const char *t = getenv("TERM");
+    int i;
+    if (!t) return 1;
+    for (i = 0; badterms[i]; i++)
+        if (!strcmp(t, badterms[i])) return 0;
+    return 1;
+}
+
+static long write_console(char *bytes, size_t n) {
+    return write(STDOUT_FILENO, bytes, n);
+}
+
+static long read_console(char *into, size_t n) {
+    return read(STDIN_FILENO, into, n);
+}
+
+static int check_simpleline(JanetBuffer *buffer) {
+    if (!isatty(STDIN_FILENO) || !checktermsupport()) {
+        simpleline(buffer);
+        return 1;
+    }
+    if (rawmode()) {
+        simpleline(buffer);
+        return 1;
+    }
+    return 0;
+}
+
+#endif
+
+static char *sdup(const char *s) {
+    size_t len = strlen(s) + 1;
+    char *mem = janet_malloc(len);
+    if (!mem) {
+        return NULL;
+    }
+    return memcpy(mem, s, len);
+}
+
+#ifndef _WIN32
 static int curpos(void) {
     char buf[32];
     int cols, rows;
     unsigned int i = 0;
-    if (write(STDOUT_FILENO, "\x1b[6n", 4) != 4) return -1;
+    if (write_console("\x1b[6n", 4) != 4) return -1;
     while (i < sizeof(buf) - 1) {
-        if (read(STDIN_FILENO, buf + i, 1) != 1) break;
+        if (read_console(buf + i, 1) != 1) break;
         if (buf[i] == 'R') break;
         i++;
     }
@@ -199,20 +315,26 @@ static int curpos(void) {
     if (sscanf(buf + 2, "%d;%d", &rows, &cols) != 2) return -1;
     return cols;
 }
+#endif
 
 static int getcols(void) {
+#ifdef _WIN32
+    CONSOLE_SCREEN_BUFFER_INFO csbi;
+    GetConsoleScreenBufferInfo(GetStdHandle(STD_OUTPUT_HANDLE), &csbi);
+    return (int)(csbi.srWindow.Right - csbi.srWindow.Left + 1);
+#else
     struct winsize ws;
     if (ioctl(1, TIOCGWINSZ, &ws) == -1 || ws.ws_col == 0) {
         int start, cols;
         start = curpos();
         if (start == -1) goto failed;
-        if (write(STDOUT_FILENO, "\x1b[999C", 6) != 6) goto failed;
+        if (write_console("\x1b[999C", 6) != 6) goto failed;
         cols = curpos();
         if (cols == -1) goto failed;
         if (cols > start) {
             char seq[32];
             snprintf(seq, 32, "\x1b[%dD", cols - start);
-            if (write(STDOUT_FILENO, seq, strlen(seq)) == -1) {
+            if (write_console(seq, strlen(seq)) == -1) {
                 exit(1);
             }
         }
@@ -222,10 +344,11 @@ static int getcols(void) {
     }
 failed:
     return 80;
+#endif
 }
 
 static void clear(void) {
-    if (write(STDOUT_FILENO, "\x1b[H\x1b[2J", 7) <= 0) {
+    if (write_console("\x1b[H\x1b[2J", 7) <= 0) {
         exit(1);
     }
 }
@@ -257,7 +380,7 @@ static void refresh(void) {
     /* Move cursor to original position. */
     snprintf(seq, 64, "\r\x1b[%dC", (int)(_pos + gbl_plen));
     janet_buffer_push_cstring(&b, seq);
-    if (write(STDOUT_FILENO, b.data, b.count) == -1) {
+    if (write_console((char *) b.data, b.count) == -1) {
         exit(1);
     }
     janet_buffer_deinit(&b);
@@ -283,7 +406,7 @@ static int insert(char c, int draw) {
                 if (gbl_plen + gbl_len < gbl_cols) {
                     /* Avoid a full update of the line in the
                      * trivial case. */
-                    if (write(STDOUT_FILENO, &c, 1) == -1) return -1;
+                    if (write_console(&c, 1) == -1) return -1;
                 } else {
                     refresh();
                 }
@@ -310,7 +433,7 @@ static void historymove(int delta) {
             gbl_historyi = gbl_history_count - 1;
         }
         strncpy(gbl_buf, gbl_history[gbl_historyi], JANET_LINE_MAX - 1);
-        gbl_pos = gbl_len = strlen(gbl_buf);
+        gbl_pos = gbl_len = (int) strlen(gbl_buf);
         gbl_buf[gbl_len] = '\0';
 
         refresh();
@@ -525,6 +648,7 @@ static void check_specials(JanetByteView src) {
     check_cmatch(src, "unquote");
     check_cmatch(src, "var");
     check_cmatch(src, "while");
+    check_cmatch(src, "upscope");
 }
 
 static void resolve_format(JanetTable *entry) {
@@ -738,12 +862,16 @@ static int line() {
 
     addhistory();
 
-    if (write(STDOUT_FILENO, gbl_prompt, gbl_plen) == -1) return -1;
+    if (write_console((char *) gbl_prompt, gbl_plen) == -1) return -1;
     for (;;) {
         char c;
         char seq[3];
 
-        if (read(STDIN_FILENO, &c, 1) <= 0) return -1;
+        int rc;
+        do {
+            rc = read_console(&c, 1);
+        } while (rc < 0 && errno == EINTR);
+        if (rc <= 0) return -1;
 
         switch (c) {
             default:
@@ -759,8 +887,13 @@ static int line() {
                 break;
             case 3:     /* ctrl-c */
                 clearlines();
-                gbl_sigint_flag = 1;
-                return -1;
+                norawmode();
+#ifdef _WIN32
+                ExitProcess(1);
+#else
+                kill(getpid(), SIGINT);
+#endif
+            /* fallthrough */
             case 17:    /* ctrl-q */
                 gbl_cancel_current_repl_form = 1;
                 clearlines();
@@ -820,23 +953,26 @@ static int line() {
             case 23: /* ctrl-w */
                 kbackspacew();
                 break;
+#ifndef _WIN32
             case 26: /* ctrl-z */
+                clearlines();
                 norawmode();
                 kill(getpid(), SIGSTOP);
                 rawmode();
                 refresh();
                 break;
+#endif
             case 27:    /* escape sequence */
                 /* Read the next two bytes representing the escape sequence.
                  * Use two calls to handle slow terminals returning the two
                  * chars at different times. */
-                if (read(STDIN_FILENO, seq, 1) == -1) break;
+                if (read_console(seq, 1) == -1) break;
                 /* Esc[ = Control Sequence Introducer (CSI) */
                 if (seq[0] == '[') {
-                    if (read(STDIN_FILENO, seq + 1, 1) == -1) break;
+                    if (read_console(seq + 1, 1) == -1) break;
                     if (seq[1] >= '0' && seq[1] <= '9') {
                         /* Extended escape, read additional byte. */
-                        if (read(STDIN_FILENO, seq + 2, 1) == -1) break;
+                        if (read_console(seq + 2, 1) == -1) break;
                         if (seq[2] == '~') {
                             switch (seq[1]) {
                                 case '1': /* Home */
@@ -855,7 +991,7 @@ static int line() {
                             }
                         }
                     } else if (seq[0] == 'O') {
-                        if (read(STDIN_FILENO, seq + 1, 1) == -1) break;
+                        if (read_console(seq + 1, 1) == -1) break;
                         switch (seq[1]) {
                             default:
                                 break;
@@ -938,35 +1074,15 @@ void janet_line_deinit() {
     gbl_historyi = 0;
 }
 
-static int checktermsupport() {
-    const char *t = getenv("TERM");
-    int i;
-    if (!t) return 1;
-    for (i = 0; badterms[i]; i++)
-        if (!strcmp(t, badterms[i])) return 0;
-    return 1;
-}
-
 void janet_line_get(const char *p, JanetBuffer *buffer) {
     gbl_prompt = p;
     buffer->count = 0;
     gbl_historyi = 0;
+    if (check_simpleline(buffer)) return;
     FILE *out = janet_dynfile("err", stderr);
-    if (!isatty(STDIN_FILENO) || !checktermsupport()) {
-        simpleline(buffer);
-        return;
-    }
-    if (rawmode()) {
-        simpleline(buffer);
-        return;
-    }
     if (line()) {
         norawmode();
-        if (gbl_sigint_flag) {
-            raise(SIGINT);
-        } else {
-            fputc('\n', out);
-        }
+        fputc('\n', out);
         return;
     }
     fflush(stdin);
@@ -979,6 +1095,13 @@ void janet_line_get(const char *p, JanetBuffer *buffer) {
     replacehistory();
 }
 
+static void clear_at_exit(void) {
+    if (!gbl_israwmode) {
+        clearlines();
+        norawmode();
+    }
+}
+
 #endif
 
 /*
@@ -991,18 +1114,11 @@ int main(int argc, char **argv) {
     JanetTable *env;
 
 #ifdef _WIN32
-    /* Enable color console on windows 10 console and utf8 output. */
-    HANDLE hOut = GetStdHandle(STD_OUTPUT_HANDLE);
-    DWORD dwMode = 0;
-    GetConsoleMode(hOut, &dwMode);
-    dwMode |= ENABLE_VIRTUAL_TERMINAL_PROCESSING;
-    SetConsoleMode(hOut, dwMode);
-    SetConsoleOutputCP(65001);
+    setup_console_output();
 #endif
 
-#if !defined(JANET_WINDOWS) && !defined(JANET_SIMPLE_GETLINE)
-    /* Try and not leave the terminal in a bad state */
-    atexit(norawmode);
+#if !defined(JANET_SIMPLE_GETLINE)
+    atexit(clear_at_exit);
 #endif
 
 #if defined(JANET_PRF)
@@ -1021,7 +1137,6 @@ int main(int argc, char **argv) {
     janet_init_hash_key(hash_key);
 #endif
 
-
     /* Set up VM */
     janet_init();
 
@@ -1048,18 +1163,8 @@ int main(int argc, char **argv) {
     JanetFiber *fiber = janet_fiber(janet_unwrap_function(mainfun), 64, 1, mainargs);
     fiber->env = env;
 
-#ifdef JANET_EV
-    janet_gcroot(janet_wrap_fiber(fiber));
-    janet_schedule(fiber, janet_wrap_nil());
-    janet_loop();
-    status = janet_fiber_status(fiber);
-#else
-    Janet out;
-    status = janet_continue(fiber, janet_wrap_nil(), &out);
-    if (status != JANET_SIGNAL_OK && status != JANET_SIGNAL_EVENT) {
-        janet_stacktrace(fiber, out);
-    }
-#endif
+    /* Run the fiber in an event loop */
+    status = janet_loop_fiber(fiber);
 
     /* Deinitialize vm */
     janet_deinit();

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/helper.janet

@@ -5,6 +5,8 @@
 (var suite-num 0)
 (var start-time 0)
 
+(def is-verbose (os/getenv "VERBOSE"))
+
 (defn assert
   "Override's the default assert with some nice error handling."
   [x &opt e]
@@ -12,11 +14,9 @@
   (++ num-tests-run)
   (when x (++ num-tests-passed))
   (def str (string e))
-  (def truncated
-    (if (> (length e) 40) (string (string/slice e 0 35) "...") (describe e)))
   (if x
-    (eprintf "\e[32m✔\e[0m %s: %v" truncated x)
-    (eprintf "\n\e[31m✘\e[0m %s: %v" truncated x))
+    (when is-verbose (eprintf "\e[32m✔\e[0m %s: %v" (describe e) x))
+    (eprintf "\e[31m✘\e[0m %s: %v" (describe e) x))
   x)
 
 (defmacro assert-error
@@ -32,10 +32,10 @@
 (defn start-suite [x]
   (set suite-num x)
   (set start-time (os/clock))
-  (eprint "\nRunning test suite " x " tests...\n  "))
+  (eprint "Starting suite " x "..."))
 
 (defn end-suite []
   (def delta (- (os/clock) start-time))
-  (eprintf "\n\nTest suite %d finished in %.3f seconds" suite-num delta)
-  (eprint num-tests-passed " of " num-tests-run " tests passed.\n")
+  (eprinf "Finished suite %d in %.3f seconds - " suite-num delta)
+  (eprint num-tests-passed " of " num-tests-run " tests passed.")
   (if (not= num-tests-passed num-tests-run) (os/exit 1)))