Fix meson install test.

Make more use of the built in GC code for abstracts to
be sure things are more correct. Issue before was streams could
be freed before IOCP events arrived.

.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,91 @@
+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
+
+  test-mingw-linux:
+    name: Build and test with Mingw on Linux + Wine
+    runs-on: ubuntu-latest
+    steps:
+      - name: Checkout the repository
+        uses: actions/checkout@master
+      - name: Setup Mingw and wine
+        run: |
+          sudo dpkg --add-architecture i386
+          sudo apt-get update
+          sudo apt-get install libstdc++6:i386 libgcc-s1:i386
+          sudo apt-get install gcc-mingw-w64-x86-64-win32 wine wine32 wine64
+      - name: Compile the project
+        run: make clean && make CC=x86_64-w64-mingw32-gcc LD=x86_64-w64-mingw32-gcc UNAME=MINGW RUN=wine
+      - name: Test the project
+        run: make test UNAME=MINGW RUN=wine
+
+  test-arm-linux:
+    name: Build and test ARM32 cross compilation
+    runs-on: ubuntu-latest
+    steps:
+      - name: Checkout the repository
+        uses: actions/checkout@master
+      - name: Setup qemu and cross compiler
+        run: |
+          sudo apt-get update
+          sudo apt-get install gcc-arm-linux-gnueabi qemu-user
+      - name: Compile the project
+        run: make RUN="qemu-arm -L /usr/arm-linux-gnueabi/" CC=arm-linux-gnueabi-gcc LD=arm-linux-gnueabi-gcc 
+      - name: Test the project
+        run: make RUN="qemu-arm -L /usr/arm-linux-gnueabi/" SUBRUN="qemu-arm -L /usr/arm-linux-gnueabi/" test

.gitignore

@@ -32,8 +32,10 @@ lockfile.janet
 # Local directory for testing
 local
 
-# Common test file I use.
+# Common test files I use.
 temp.janet
+temp*.janet
+scratch.janet
 
 # Emscripten
 *.bc
@@ -66,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
-- 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,274 @@
 # Changelog
 All notable changes to this project will be documented in this file.
 
+## 1.31.0 - 2023-09-17
+- Report line and column when using `janet_dobytes`
+- Add `:unless` loop modifier
+- Allow calling `reverse` on generators.
+- Improve performance of a number of core functions including `partition`, `mean`, `keys`, `values`, `pairs`, `interleave`.
+- Add `lengthable?`
+- Add `os/sigaction`
+- Change `every?` and `any?` to behave like the functional versions of the `and` and `or` macros.
+- Fix bug with garbage collecting threaded abstract types.
+- Add `:signal` to the `sandbox` function to allow intercepting signals.
+
+## 1.30.0 - 2023-08-05
+- Change indexing of `array/remove` to start from -1 at the end instead of -2.
+- Add new string escape sequences `\\a`, `\\b`, `\\?`, and `\\'`.
+- Fix bug with marshalling channels
+- Add `div` for floored division
+- Make `div` and `mod` variadic
+- Support `bnot` for integer types.
+- Define `(mod x 0)` as `x`
+- Add `ffi/pointer-cfunction` to convert pointers to cfunctions
+
+## 1.29.1 - 2023-06-19
+- Add support for passing booleans to PEGs for "always" and "never" matching.
+- Allow dictionary types for `take` and `drop`
+- Fix bug with closing channels while other fibers were waiting on them - `ev/take`, `ev/give`, and `ev/select`  will now return the correct (documented) value when another fiber closes the channel.
+- Add `ffi/calling-conventions` to show all available calling conventions for FFI.
+- Add `net/setsockopt`
+- Add `signal` argument to `os/proc-kill` to send signals besides `SIGKILL` on Posix.
+- Add `source` argument to `os/clock` to get different time sources.
+- Various combinator functions now are variadic like `map`
+- Add `file/lines` to iterate over lines in a file lazily.
+- Reorganize test suite to be sorted by module rather than pseudo-randomly.
+- Add `*task-id*`
+- Add `env` argument to `fiber/new`.
+- Add `JANET_NO_AMALG` flag to Makefile to properly incremental builds
+- Optimize bytecode compiler to generate fewer instructions and improve loops.
+- Fix bug with `ev/gather` and hung fibers.
+- Add `os/isatty`
+- Add `has-key?` and `has-value?`
+- Make imperative arithmetic macros variadic
+- `ev/connect` now yields to the event loop instead of blocking while waiting for an ACK.
+
+## 1.28.0 - 2023-05-13
+- Various bug fixes
+- Make nested short-fn's behave a bit more predictably (it is still not recommended to nest short-fns).
+- Add `os/strftime` for date formatting.
+- Fix `ev/select` on threaded channels sometimes live-locking.
+- Support the `NO_COLOR` environment variable to turn off VT100 color codes in repl (and in scripts).
+  See http://no-color.org/
+- Disallow using `(splice x)` in contexts where it doesn't make sense rather than silently coercing to `x`.
+  Instead, raise a compiler error.
+- Change the names of `:user8` and `:user9` sigals to `:interrupt` and `:await`
+- Change the names of `:user8` and `:user9` fiber statuses to `:interrupted` and `:suspended`.
+- Add `ev/all-tasks` to see all currently suspended fibers.
+- Add `keep-syntax` and `keep-syntax!` functions to make writing macros easier.
+
+## 1.27.0 - 2023-03-05
+- Change semantics around bracket tuples to no longer be equal to regular tuples.
+- Add `index` argument to `ffi/write` for symmetry with `ffi/read`.
+- Add `buffer/push-at`
+- Add `ffi/pointer-buffer` to convert pointers to buffers the cannot be reallocated. This
+  allows easier manipulation of FFI memory, memory mapped files, and buffer memory shared between threads.
+- Calling `ev/cancel` on a fiber waiting on `ev/gather` will correctly
+  cancel the child fibers.
+- Add `(sandbox ...)` function to core for permission based security. Also add `janet_sandbox` to C API.
+  The sandbox allows limiting access to the file system, network, ffi, and OS resources at runtime.
+- Add `(.locals)` function to debugger to see currently bound local symbols.
+- Track symbol -> slot mapping so debugger can get symbolic information. This exposes local bindings
+  in `debug/stack` and `disasm`.
+- Add `os/compiler` to detect what host compiler was used to compile the interpreter
+- Add support for mingw and cygwin builds (mingw support also added in jpm).
+
+## 1.26.0 - 2023-01-07
+- Add `ffi/malloc` and `ffi/free`. Useful as tools of last resort.
+- 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.
+- Fix some issues with linting and re-add missing `make docs`.
+- Allow controlling linting with dynamic bindings `:lint-warn`, `:lint-error`, and `:lint-levels`.
+- Add `-w` and `-x` command line flags to the `janet` binary to set linting thresholds.
+  linting thresholds are as follows:
+    - :none - will never be trigger.
+    - :relaxed - will only trigger on `:relaxed` lints.
+    - :normal - will trigger on `:relaxed` and `:normal` lints.
+    - :strict - will trigger on `:strict`, `:normal`, and `:relaxed` lints. This will catch the most issues
+      but can be distracting.
+
+## 1.16.0 - 2021-05-30
+- Add color documentation to the `doc` macro - enable/disable with `(dyn :doc-color)`.
+- Remove simpler HTML docs from distribution - use website or built-in documentation instead.
+- 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 `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`.
+- Add `from-pairs` to core.
+- Add `JPM_OS_WHICH` environment variable to jpm to allow changing auto-detection behavior.
+- The flychecker will consider any top-level calls of functions that start with `define-` to
+  be safe to execute and execute them. This allows certain patterns (like spork/path) to be
+  better processed by the flychecker.
+
+## 1.15.5 - 2021-04-25
+- Add `declare-headers` to jpm.
+- Fix error using unix pipes on BSDs.
+- Support .cc and .cxx extensions in `jpm` for C++ code.
+- Change networking code to not create as many HUP errors.
+- Add `net/shutdown` to close sockets in one direction without hang ups.
+- Update code for printing the debug repl
+
 ## 1.15.4 - 2021-03-16
 - Increase default nesting depth of pretty printing to `JANET_RECURSION_GUARD`
 - Update meson.build

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) 2020 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,59 +21,90 @@
 ################################
 ##### 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_BOOT=build/janet_boot
+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
+JANET_BOOT_FLAGS:=. JANET_PATH '$(JANET_PATH)'
+JANET_TARGET_OBJECTS=build/janet.o build/shell.o
+JPM_TAG?=master
 DEBUGGER=gdb
 SONAME_SETTER=-Wl,-soname,
 
 # For cross compilation
 HOSTCC?=$(CC)
 HOSTAR?=$(AR)
-CFLAGS?=-O2
+# Symbols are (optionally) removed later, keep -g as default!
+CFLAGS?=-O2 -g
 LDFLAGS?=-rdynamic
+RUN:=$(RUN)
 
 COMMON_CFLAGS:=-std=c99 -Wall -Wextra -Isrc/include -Isrc/conf -fvisibility=hidden -fPIC
-BOOT_CFLAGS:=-DJANET_BOOTSTRAP -DJANET_BUILD=$(JANET_BUILD) -O0 -g $(COMMON_CFLAGS)
+BOOT_CFLAGS:=-DJANET_BOOTSTRAP -DJANET_BUILD=$(JANET_BUILD) -O0 $(COMMON_CFLAGS) -g
 BUILD_CFLAGS:=$(CFLAGS) $(COMMON_CFLAGS)
 
+# Disable amalgamated build
+ifeq ($(JANET_NO_AMALG), 1)
+	JANET_TARGET_OBJECTS+=$(patsubst src/%.c,build/%.bin.o,$(JANET_CORE_SOURCES))
+	JANET_BOOT_FLAGS+=image-only
+endif
+
 # For installation
 LDCONFIG:=ldconfig "$(LIBDIR)"
 
 # Check OS
-UNAME:=$(shell uname -s)
+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
 
-$(shell mkdir -p build/core build/c build/boot)
+# Mingw
+ifeq ($(findstring MINGW,$(UNAME)), MINGW)
+	CLIBS:=-lws2_32 -lpsapi -lwsock32
+	LDFLAGS:=-Wl,--out-implib,$(JANET_IMPORT_LIB)
+	JANET_TARGET:=$(JANET_TARGET).exe
+	JANET_BOOT:=$(JANET_BOOT).exe
+endif
+
+$(shell mkdir -p build/core build/c build/boot build/mainclient)
 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 \
@@ -98,6 +129,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 \
@@ -112,14 +144,13 @@ 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/typedarray.c \
 				   src/core/util.c \
 				   src/core/value.c \
 				   src/core/vector.c \
@@ -145,42 +176,53 @@ $(JANET_BOOT_OBJECTS): $(JANET_BOOT_HEADERS)
 build/%.boot.o: src/%.c $(JANET_HEADERS) $(JANET_LOCAL_HEADERS) Makefile
 	$(CC) $(BOOT_CFLAGS) -o $@ -c $<
 
-build/janet_boot: $(JANET_BOOT_OBJECTS)
+$(JANET_BOOT): $(JANET_BOOT_OBJECTS)
 	$(CC) $(BOOT_CFLAGS) -o $@ $(JANET_BOOT_OBJECTS) $(CLIBS)
 
 # Now the reason we bootstrap in the first place
-build/c/janet.c: build/janet_boot src/boot/boot.janet
-	build/janet_boot . JANET_PATH '$(JANET_PATH)' > $@
+build/c/janet.c: $(JANET_BOOT) src/boot/boot.janet
+	$(RUN) $(JANET_BOOT) $(JANET_BOOT_FLAGS) > $@
 	cksum $@
 
+##################
+##### Quicky #####
+##################
+
+build/%.bin.o: src/%.c $(JANET_HEADERS) $(JANET_LOCAL_HEADERS) Makefile
+	$(HOSTCC) $(BUILD_CFLAGS) -o $@ -c $<
+
 ########################
 ##### Amalgamation #####
 ########################
 
-SONAME=libjanet.so.1.15
+ifeq ($(UNAME), Darwin)
+SONAME=libjanet.1.31.dylib
+else
+SONAME=libjanet.so.1.31
+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)
+	$(RUN) ./$(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
+$(JANET_TARGET): $(JANET_TARGET_OBJECTS)
 	$(HOSTCC) $(LDFLAGS) $(BUILD_CFLAGS) -o $@ $^ $(CLIBS)
 
-$(JANET_LIBRARY): build/janet.o build/shell.o
+$(JANET_LIBRARY): $(JANET_TARGET_OBJECTS)
 	$(HOSTCC) $(LDFLAGS) $(BUILD_CFLAGS) $(SONAME_SETTER)$(SONAME) -shared -o $@ $^ $(CLIBS)
 
-$(JANET_STATIC_LIBRARY): build/janet.o build/shell.o
+$(JANET_STATIC_LIBRARY): $(JANET_TARGET_OBJECTS)
 	$(HOSTAR) rcs $@ $^
 
 ###################
@@ -192,25 +234,23 @@ $(JANET_STATIC_LIBRARY): build/janet.o build/shell.o
 TEST_SCRIPTS=$(wildcard test/suite*.janet)
 
 repl: $(JANET_TARGET)
-	./$(JANET_TARGET)
+	$(RUN) ./$(JANET_TARGET)
 
 debug: $(JANET_TARGET)
 	$(DEBUGGER) ./$(JANET_TARGET)
 
-VALGRIND_COMMAND=valgrind --leak-check=full
+VALGRIND_COMMAND=valgrind --leak-check=full --quiet
 
 valgrind: $(JANET_TARGET)
 	$(VALGRIND_COMMAND) ./$(JANET_TARGET)
 
 test: $(JANET_TARGET) $(TEST_PROGRAMS)
-	for f in test/suite*.janet; do ./$(JANET_TARGET) "$$f" || exit; done
-	for f in examples/*.janet; do ./$(JANET_TARGET) -k "$$f"; done
-	./$(JANET_TARGET) -k jpm
+	for f in test/suite*.janet; do $(RUN) ./$(JANET_TARGET) "$$f" || exit; done
+	for f in examples/*.janet; do $(RUN) ./$(JANET_TARGET) -k "$$f"; done
 
 valtest: $(JANET_TARGET) $(TEST_PROGRAMS)
 	for f in test/suite*.janet; do $(VALGRIND_COMMAND) ./$(JANET_TARGET) "$$f" || exit; done
 	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,12 +263,21 @@ 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) \
-	build/doc.html README.md build/c/janet.c build/c/shell.c jpm
-	$(eval JANET_DIST_DIR = "janet-$(shell basename $*)")
-	mkdir -p build/$(JANET_DIST_DIR)
-	cp -r $^ build/$(JANET_DIST_DIR)/
-	cd build && tar -czvf ../$@ $(JANET_DIST_DIR)
+	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/
+	strip -x -S 'build/$(JANET_DIST_DIR)/bin/janet'
+	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 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)/
+	cd build && tar -czvf ../$@ ./$(JANET_DIST_DIR)
 
 #########################
 ##### Documentation #####
@@ -237,16 +286,12 @@ build/janet-%.tar.gz: $(JANET_TARGET) \
 docs: build/doc.html
 
 build/doc.html: $(JANET_TARGET) tools/gendoc.janet
-	$(JANET_TARGET) tools/gendoc.janet > build/doc.html
+	$(RUN) $(JANET_TARGET) tools/gendoc.janet > build/doc.html
 
 ########################
 ##### Installation #####
 ########################
 
-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)' > $@
@@ -257,38 +302,56 @@ build/janet.pc: $(JANET_TARGET)
 	echo "Name: janet" >> $@
 	echo "Url: https://janet-lang.org" >> $@
 	echo "Description: Library for the Janet programming language." >> $@
-	$(JANET_TARGET) -e '(print "Version: " janet/version)' >> $@
+	$(RUN) $(JANET_TARGET) -e '(print "Version: " janet/version)' >> $@
 	echo 'Cflags: -I$${includedir}' >> $@
 	echo 'Libs: -L$${libdir} -ljanet' >> $@
 	echo 'Libs.private: $(CLIBS)' >> $@
 
-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'
+	strip -x -S '$(DESTDIR)$(BINDIR)/janet'
 	mkdir -p '$(DESTDIR)$(INCLUDEDIR)/janet'
 	cp -r build/janet.h '$(DESTDIR)$(INCLUDEDIR)/janet'
+	ln -sf ./janet/janet.h '$(DESTDIR)$(INCLUDEDIR)/janet.h'
 	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)' \
+		$(RUN) ../../$(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
 
 #################
@@ -296,14 +359,14 @@ uninstall:
 #################
 
 format:
-	tools/format.sh
+	sh tools/format.sh
 
 grammar: build/janet.tmLanguage
 build/janet.tmLanguage: tools/tm_lang_gen.janet $(JANET_TARGET)
-	$(JANET_TARGET) $< > $@
+	$(RUN) $(JANET_TARGET) $< > $@
 
 compile-commands:
-	# Requires pip install copmiledb
+	# Requires pip install compiledb
 	compiledb make
 
 clean:
@@ -311,18 +374,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,58 +1,136 @@
 [![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">
 
-**Janet** is a functional and imperative programming language and bytecode interpreter. It is a
-lisp-like language, but lists are replaced
-by other data structures (arrays, tables (hash table), struct (immutable hash table), tuples).
-The language also supports bridging to native code written in C, meta-programming with macros, and bytecode assembly.
+**Janet** is a programming language for system scripting, expressive automation, and
+extending programs written in C or C++ with user scripting capabilities.
+
+Janet makes a good system scripting language, or a language to embed in other programs.
+It's like Lua and GNU Guile in that regard. It has more built-in functionality and a richer core language than
+Lua, but smaller than GNU Guile or Python. However, it is much easier to embed and port than Python or Guile.
 
 There is a REPL for trying out the language, as well as the ability
 to run script files. This client program is separate from the core runtime, so
 Janet can be embedded in other programs. Try Janet in your browser at
-[https://janet-lang.org](https://janet-lang.org).
+<https://janet-lang.org>.
+
+If you'd like to financially support the ongoing development of Janet, consider
+[sponsoring its primary author](https://github.com/sponsors/bakpakin) through GitHub.
 
 <br>
 
-## Use Cases
+## Examples
 
-Janet makes a good system scripting language, or a language to embed in other programs.
-It's like Lua and Guile in that regard. It has more built-in functionality and a richer core language than
-Lua, but smaller than GNU Guile or Python.
+See the examples directory for all provided example programs.
 
-## Features
+### Game of Life
 
-* Minimal setup - one binary and you are good to go!
+```janet
+# John Conway's Game of Life
+
+(def- window
+  (seq [x :range [-1 2]
+         y :range [-1 2]
+         :when (not (and (zero? x) (zero? y)))]
+       [x y]))
+
+(defn- neighbors
+  [[x y]]
+  (map (fn [[x1 y1]] [(+ x x1) (+ y y1)]) window))
+
+(defn tick
+  "Get the next state in the Game Of Life."
+  [state]
+  (def cell-set (frequencies state))
+  (def neighbor-set (frequencies (mapcat neighbors state)))
+  (seq [coord :keys neighbor-set
+         :let [count (get neighbor-set coord)]
+         :when (or (= count 3) (and (get cell-set coord) (= count 2)))]
+      coord))
+
+(defn draw
+  "Draw cells in the game of life from (x1, y1) to (x2, y2)"
+  [state x1 y1 x2 y2]
+  (def cellset @{})
+  (each cell state (put cellset cell true))
+  (loop [x :range [x1 (+ 1 x2)]
+         :after (print)
+         y :range [y1 (+ 1 y2)]]
+    (file/write stdout (if (get cellset [x y]) "X " ". ")))
+  (print))
+
+# Print the first 20 generations of a glider
+(var *state* '[(0 0) (-1 0) (1 0) (1 1) (0 2)])
+(for i 0 20
+  (print "generation " i)
+  (draw *state* -7 -7 7 7)
+  (set *state* (tick *state*)))
+```
+
+### TCP Echo Server
+
+```janet
+# A simple TCP echo server using the built-in socket networking and event loop.
+
+(defn handler
+  "Simple handler for connections."
+  [stream]
+  (defer (:close stream)
+    (def id (gensym))
+    (def b @"")
+    (print "Connection " id "!")
+    (while (:read stream 1024 b)
+      (printf " %v -> %v" id b)
+      (:write stream b)
+      (buffer/clear b))
+    (printf "Done %v!" id)
+    (ev/sleep 0.5)))
+
+(net/server "127.0.0.1" "8000" handler)
+```
+
+### Windows FFI Hello, World!
+
+```janet
+# Use the FFI to popup a Windows message box - no C required
+
+(ffi/context "user32.dll")
+
+(ffi/defbind MessageBoxA :int
+  [w :ptr text :string cap :string typ :int])
+
+(MessageBoxA nil "Hello, World!" "Test" 0)
+```
+
+## Language Features
+
+* 600+ functions and macros in the core library
+* Built-in socket networking, threading, subprocesses, and file system functions.
+* Parsing Expression Grammars (PEG) engine as a more robust Regex alternative
+* Macros and compile-time computation
+* Per-thread event loop for efficient IO (epoll/IOCP/kqueue)
+* First-class green threads (continuations) as well as OS threads
+* Erlang-style supervision trees that integrate with the event loop
 * First-class closures
 * Garbage collection
-* First-class green threads (continuations)
+* Distributed as janet.c and janet.h for embedding into a larger program.
 * Python-style generators (implemented as a plain macro)
 * Mutable and immutable arrays (array/tuple)
 * Mutable and immutable hashtables (table/struct)
 * Mutable and immutable strings (buffer/string)
-* Macros
-* 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
-* Dynamically load C libraries
-* Functional and imperative standard library
-* Lexical scoping
-* Imperative programming as well as functional
-* REPL
-* Parsing Expression Grammars built into the core library
-* 400+ functions and macros in the core library
-* Embedding Janet in other programs
-* Interactive environment with detailed stack traces
+* Tail recursion
+* Interface with C functions and dynamically load plugins ("natives").
+* Built-in C FFI for when the native bindings are too much work
+* REPL development with debugger and inspectable runtime
 
 ## Documentation
 
 * For a quick tutorial, see [the introduction](https://janet-lang.org/docs/index.html) for more details.
-* For the full API for all functions in the core library, see [the core API doc](https://janet-lang.org/api/index.html)
+* For the full API for all functions in the core library, see [the core API doc](https://janet-lang.org/api/index.html).
 
 Documentation is also available locally in the REPL.
 Use the `(doc symbol-name)` macro to get API
@@ -60,7 +138,7 @@ documentation for symbols in the core library. For example,
 ```
 (doc apply)
 ```
-Shows documentation for the `apply` function.
+shows documentation for the `apply` function.
 
 To get a list of all bindings in the default
 environment, use the `(all-bindings)` function. You
@@ -79,11 +157,13 @@ the SourceHut mirror is actively maintained.
 
 The Makefile is non-portable and requires GNU-flavored make.
 
-```
+```sh
 cd somewhere/my/projects/janet
 make
 make test
 make repl
+make install
+make install-jpm-git
 ```
 
 Find out more about the available make targets by running `make help`.
@@ -93,42 +173,45 @@ Find out more about the available make targets by running `make help`.
 32-bit Haiku build instructions are the same as the UNIX-like build instructions,
 but you need to specify an alternative compiler, such as `gcc-x86`.
 
-```
+```sh
 cd somewhere/my/projects/janet
 make CC=gcc-x86
 make test
 make repl
+make install
+make install-jpm-git
 ```
 
 ### FreeBSD
 
 FreeBSD build instructions are the same as the UNIX-like build instructions,
-but you need `gmake` to compile. Alternatively, install directly from
-packages, using `pkg install lang/janet`.
+but you need `gmake` to compile. Alternatively, install the package directly with `pkg install lang/janet`.
 
-```
+```sh
 cd somewhere/my/projects/janet
 gmake
 gmake test
 gmake repl
+gmake install
+gmake install-jpm-git
 ```
 
 ### NetBSD
 
 NetBSD build instructions are the same as the FreeBSD build instructions.
-Alternatively, install directly from packages, using `pkgin install janet`.
+Alternatively, install the package directly with `pkgin install janet`.
 
 ### Windows
 
-1. Install [Visual Studio](https://visualstudio.microsoft.com/thank-you-downloading-visual-studio/?sku=Community&rel=15#) or [Visual Studio Build Tools](https://visualstudio.microsoft.com/thank-you-downloading-visual-studio/?sku=BuildTools&rel=15#)
-2. Run a Visual Studio Command Prompt (cl.exe and link.exe need to be on the PATH) and cd to the directory with janet.
-3. Run `build_win` to compile janet.
+1. Install [Visual Studio](https://visualstudio.microsoft.com/thank-you-downloading-visual-studio/?sku=Community&rel=15#) or [Visual Studio Build Tools](https://visualstudio.microsoft.com/thank-you-downloading-visual-studio/?sku=BuildTools&rel=15#).
+2. Run a Visual Studio Command Prompt (`cl.exe` and `link.exe` need to be on your PATH) and `cd` to the directory with Janet.
+3. Run `build_win` to compile Janet.
 4. Run `build_win test` to make sure everything is working.
 
 To build an `.msi` installer executable, in addition to the above steps, you will have to:
 
-5. Install, or otherwise add to your PATH the [WiX 3.11 Toolset](https://github.com/wixtoolset/wix3/releases)
-6. run `build_win dist`
+5. Install, or otherwise add to your PATH the [WiX 3.11 Toolset](https://github.com/wixtoolset/wix3/releases).
+6. Run `build_win dist`.
 
 Now you should have an `.msi`. You can run `build_win install` to install the `.msi`, or execute the file itself.
 
@@ -164,19 +247,19 @@ ninja -C build install
 
 Janet can be hacked on with pretty much any environment you like, but for IDE
 lovers, [Gnome Builder](https://wiki.gnome.org/Apps/Builder) is probably the
-best option, as it has excellent meson integration. It also offers code completion
+best option, as it has excellent Meson integration. It also offers code completion
 for Janet's C API right out of the box, which is very useful for exploring. VSCode, Vim,
-Emacs, and Atom will have syntax packages for the Janet language, though.
+Emacs, and Atom each have syntax packages for the Janet language, though.
 
 ## Installation
 
-See [the Introduction](https://janet-lang.org/introduction.html) for more details. If you just want
+See the [Introduction](https://janet-lang.org/docs/index.html) for more details. If you just want
 to try out the language, you don't need to install anything. You can also move the `janet` executable wherever you want on your system and run it.
 
 ## Usage
 
-A REPL is launched when the binary is invoked with no arguments. Pass the -h flag
-to display the usage information. Individual scripts can be run with `./janet myscript.janet`
+A REPL is launched when the binary is invoked with no arguments. Pass the `-h` flag
+to display the usage information. Individual scripts can be run with `./janet myscript.janet`.
 
 If you are looking to explore, you can print a list of all available macros, functions, and constants
 by entering the command `(all-bindings)` into the REPL.
@@ -191,32 +274,38 @@ Hello, World!
 nil
 janet:3:> (os/exit)
 $ janet -h
-usage: build/janet [options] script args...
+usage: janet [options] script args...
 Options are:
   -h : Show this help
   -v : Print the version string
   -s : Use raw stdin instead of getline like functionality
   -e code : Execute a string of janet
+  -E code arguments... : Evaluate an expression as a short-fn with arguments
+  -d : Set the debug flag in the REPL
   -r : Enter the REPL after running all scripts
+  -R : Disables loading profile.janet when JANET_PROFILE is present
   -p : Keep on executing if there is a top-level error (persistent)
-  -q : Hide prompt, logo, and REPL output (quiet)
+  -q : Hide logo (quiet)
   -k : Compile scripts but do not execute (flycheck)
   -m syspath : Set system path for loading global modules
   -c source output : Compile janet source code into an image
+  -i : Load the script argument as an image file instead of source code
   -n : Disable ANSI color output in the REPL
-  -l path : Execute code in a file before running the main script
+  -l lib : Use a module before processing more arguments
+  -w level : Set the lint warning level - default is "normal"
+  -x level : Set the lint error level - default is "none"
   -- : Stop handling options
 ```
 
-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
 
 Janet can be embedded in a host program very easily. The normal build
 will create a file `build/janet.c`, which is a single C file
 that contains all the source to Janet. This file, along with
-`src/include/janet.h` and `src/conf/janetconf.h` can be dragged into any C
-project and compiled into the project. Janet should be compiled with `-std=c99`
+`src/include/janet.h` and `src/conf/janetconf.h`, can be dragged into any C
+project and compiled into it. Janet should be compiled with `-std=c99`
 on most compilers, and will need to be linked to the math library, `-lm`, and
 the dynamic linker, `-ldl`, if one wants to be able to load dynamic modules. If
 there is no need for dynamic modules, add the define
@@ -224,27 +313,89 @@ there is no need for dynamic modules, add the define
 
 See the [Embedding Section](https://janet-lang.org/capi/embedding.html) on the website for more information.
 
-## Examples
-
-See the examples directory for some example janet code.
-
 ## Discussion
 
-Feel free to ask questions and join the discussion on the [Janet Gitter Channel](https://gitter.im/janet-language/community).
-Alternatively, check out [the #janet channel on Freenode](https://webchat.freenode.net/)
+Feel free to ask questions and join the discussion on the [Janet Gitter channel](https://gitter.im/janet-language/community).
+Gitter provides Matrix and IRC bridges as well.
 
 ## FAQ
 
+### How fast is it?
+
+It is about the same speed as most interpreted languages without a JIT compiler. Tight, critical
+loops should probably be written in C or C++ . Programs tend to be a bit faster than
+they would be in a language like Python due to the discouragement of slow Object-Oriented abstraction
+with lots of hash-table lookups, and making late-binding explicit. All values are boxed in an 8-byte
+representation by default and allocated on the heap, with the exception of numbers, nils and booleans. The
+PEG engine is a specialized interpreter that can efficiently process string and buffer data.
+
+The GC is simple and stop-the-world, but GC knobs are exposed in the core library and separate threads
+have isolated heaps and garbage collectors. Data that is shared between threads is reference counted.
+
+YMMV.
+
+### Where is (favorite feature from other language)?
+
+It may exist, it may not. If you want to propose a major language feature, go ahead and open an issue, but
+it will likely be closed as "will not implement". Often, such features make one usecase simpler at the expense
+of 5 others by making the language more complicated.
+
+### Is there a language spec?
+
+There is not currently a spec besides the documentation at <https://janet-lang.org>.
+
+### 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, Scheme, or Common Lisp.
+
+### 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 implemented with keywords.
+
+```clj
+(def Car @{:honk (fn [self msg] (print "car " self " goes " msg)) })
+(def my-car (table/setproto @{} Car))
+(:honk my-car "Beep!")
+```
+
+### 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, a feature can usually be added as a library
+  without feeling "bolted on", especially when compared to ALGOL-like languages. Adding features
+  to the core also makes it a bit more difficult to keep Janet maximally portable.
+
+### Can I bind to Rust/Zig/Go/Java/Nim/C++/D/Pascal/Fortran/Odin/Jai/(Some new "Systems" Programming Language)?
+
+Probably, if that language has a good interface with C. But the programmer may need to do
+some extra work to map Janet's internal memory model may need some to that of the bound language. Janet
+also uses `setjmp`/`longjmp` for non-local returns internally. This
+approach is out of favor with many programmers now and doesn't always play well with other languages
+that have exceptions or stack-unwinding.
+
 ### Why is my terminal spitting out junk when I run the REPL?
 
 Make sure your terminal supports ANSI escape codes. Most modern terminals will
 support these, but some older terminals, Windows consoles, or embedded terminals
 will not. If your terminal does not support ANSI escape codes, run the REPL with
-the `-n` flag, which disables color output. You can also try the `-s` if further issues
+the `-n` flag, which disables color output. You can also try the `-s` flag if further issues
 ensue.
 
-## Why Janet
+## 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).
-
-<img src="https://raw.githubusercontent.com/janet-lang/janet/master/assets/janet-the-good-place.gif" alt="Janet logo" width="115px" align="left">

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
@@ -36,32 +41,32 @@ if not exist build\boot mkdir build\boot
 @rem Build the bootstrap interpreter
 for %%f in (src\core\*.c) do (
     %JANET_COMPILE% /DJANET_BOOTSTRAP /Fobuild\boot\%%~nf.obj %%f
-    @if errorlevel 1 goto :BUILDFAIL
+    @if not errorlevel 0 goto :BUILDFAIL
 )
 for %%f in (src\boot\*.c) do (
     %JANET_COMPILE% /DJANET_BOOTSTRAP /Fobuild\boot\%%~nf.obj %%f
-    @if errorlevel 1 goto :BUILDFAIL
+    @if not errorlevel 0 goto :BUILDFAIL
 )
 %JANET_LINK% /out:build\janet_boot.exe build\boot\*.obj
-@if errorlevel 1 goto :BUILDFAIL
+@if not errorlevel 0 goto :BUILDFAIL
 build\janet_boot . > build\c\janet.c
 
 @rem Build the sources
 %JANET_COMPILE% /Fobuild\janet.obj build\c\janet.c
-@if errorlevel 1 goto :BUILDFAIL
+@if not errorlevel 0 goto :BUILDFAIL
 %JANET_COMPILE% /Fobuild\shell.obj src\mainclient\shell.c
-@if errorlevel 1 goto :BUILDFAIL
+@if not errorlevel 0 goto :BUILDFAIL
 
 @rem Build the resources
 rc /nologo /fobuild\janet_win.res janet_win.rc
 
 @rem Link everything to main client
 %JANET_LINK% /out:janet.exe build\janet.obj build\shell.obj build\janet_win.res
-@if errorlevel 1 goto :BUILDFAIL
+@if not errorlevel 0 goto :BUILDFAIL
 
-@rem Build static library (libjanet.a)
+@rem Build static library (libjanet.lib)
 %JANET_LINK_STATIC% /out:build\libjanet.lib build\janet.obj
-@if errorlevel 1 goto :BUILDFAIL
+@if not errorlevel 0 goto :BUILDFAIL
 
 echo === Successfully built janet.exe for Windows ===
 echo === Run 'build_win test' to run tests. ==
@@ -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
@@ -93,7 +98,7 @@ exit /b 0
 :TEST
 for %%f in (test/suite*.janet) do (
     janet.exe test\%%f
-    @if errorlevel 1 goto TESTFAIL
+    @if not errorlevel 0 goto TESTFAIL
 )
 exit /b 0
 
@@ -112,13 +117,12 @@ copy README.md dist\README.md
 
 copy janet.lib dist\janet.lib
 copy janet.exp dist\janet.exp
+copy janet.def dist\janet.def
 
 janet.exe tools\patch-header.janet src\include\janet.h src\conf\janetconf.h build\janet.h
 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 +151,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,205 @@
+#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

@@ -7,13 +7,13 @@ typedef struct {
 } num_array;
 
 static num_array *num_array_init(num_array *array, size_t size) {
-    array->data = (double *)calloc(size, sizeof(double));
+    array->data = (double *)janet_calloc(size, sizeof(double));
     array->size = size;
     return array;
 }
 
 static void num_array_deinit(num_array *array) {
-    free(array->data);
+    janet_free(array->data);
 }
 
 static int num_array_gc(void *p, size_t s) {
@@ -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/sigaction.janet

@@ -0,0 +1,41 @@
+###
+### Usage: janet examples/sigaction.janet 1|2|3|4 &
+###
+### Then at shell: kill -s SIGTERM $!
+###
+
+(defn action
+  []
+  (print "Handled SIGTERM!")
+  (flush)
+  (os/exit 1))
+
+(defn main1
+  []
+  (os/sigaction :term action true)
+  (forever))
+
+(defn main2
+  []
+  (os/sigaction :term action)
+  (forever))
+
+(defn main3
+  []
+  (os/sigaction :term action true)
+  (forever (ev/sleep math/inf)))
+
+(defn main4
+  []
+  (os/sigaction :term action)
+  (forever (ev/sleep math/inf)))
+
+(defn main
+  [& args]
+  (def which (scan-number (get args 1 "1")))
+  (case which
+    1 (main1) # should work
+    2 (main2) # will not work
+    3 (main3) # should work
+    4 (main4) # should work
+    (error "bad main")))

examples/tarray.janet

@@ -1,73 +0,0 @@
-# naive matrix implementation for testing typed array
-
-(defn matrix [nrow ncol] {:nrow nrow :ncol ncol :array (tarray/new :float64 (* nrow ncol))})
-
-(defn matrix/row [mat i]
-  (def {:nrow nrow :ncol ncol :array array} mat)
-  (tarray/new :float64 ncol 1 (* i ncol)  array))
-
-(defn matrix/column [mat j]
-  (def {:nrow nrow :ncol ncol :array array} mat)
-  (tarray/new :float64 nrow ncol j array))
-
-(defn matrix/set [mat i j value]
-  (def {:nrow nrow :ncol ncol :array array} mat)
-  (set (array (+ (* i ncol) j)) value))
-
-(defn matrix/get [mat i j value]
-  (def {:nrow nrow :ncol ncol :array array} mat)
-  (array (+ (* i ncol) j)))
-
-
-# other variants to test rows and cols views
-
-(defn matrix/set* [mat i j value]
-  (set ((matrix/row mat i) j) value))
-
-(defn matrix/set** [mat i j value]
-  (set ((matrix/column mat j) i) value))
-
-
-(defn matrix/get* [mat i j value]
-  ((matrix/row mat i) j))
-
-(defn matrix/get** [mat i j value]
-  ((matrix/column mat j) i))
-
-
-(defn tarray/print [arr]
-  (def size (tarray/length arr))
-  (prinf "[%2i]" size)
-  (for i 0 size
-    (prinf " %+6.3f " (arr i)))
-  (print))
-
-(defn matrix/print [mat]
-  (def {:nrow nrow :ncol ncol :array tarray} mat)
-  (printf "matrix %iX%i %p" nrow ncol tarray)
-  (for i 0 nrow
-    (tarray/print (matrix/row mat i))))
-
-
-(def nr 5)
-(def nc 4)
-(def A (matrix nr nc))
-
-(loop (i :range (0 nr) j :range (0 nc)) 
-  (matrix/set A i j i))
-(matrix/print A)
-
-(loop (i :range (0 nr) j :range (0 nc)) 
-  (matrix/set* A i j i))
-(matrix/print A)
-
-(loop (i :range (0 nr) j :range (0 nc)) 
-  (matrix/set** A i j i))
-(matrix/print A)
-
-
-(printf "properties:\n%p" (tarray/properties (A :array)))
-(for i 0 nr  
-  (printf "row properties:[%i]\n%p" i (tarray/properties (matrix/row A i))))
-(for i 0 nc  
-  (printf "col properties:[%i]\n%p" i (tarray/properties (matrix/column A i))))

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,11 +3,14 @@
 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]
+[\fB\-w\fR \fILEVEL\fR]
+[\fB\-x\fR \fILEVEL\fR]
 [\fB\-\-\fR]
 .BR script
 .BR args ...
@@ -160,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
@@ -170,6 +183,10 @@ default repl.
 .BR \-n
 Disable ANSI colors in the repl. Has no effect if no repl is run.
 
+.TP
+.BR \-N
+Enable ANSI colors in the repl. Has no effect if no repl is run.
+
 .TP
 .BR \-r
 Open a REPL (Read Eval Print Loop) after executing all sources. By default, if Janet is called with no
@@ -205,12 +222,28 @@ 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
 in this manner, and exports from each file will be made available to the script
 or repl.
-
+.TP
+.BR \-w\ level
+Set the warning linting level for Janet.
+This linting level should be one of :relaxed, :none, :strict, :normal, or a
+Janet number. Any linting message that is of a greater lint level than this setting will be displayed as
+a warning, but not stop compilation or execution.
+.TP
+.BR \-x\ level
+Set the error linting level for Janet.
+This linting level should be one of :relaxed, :none, :strict, :normal, or a
+Janet number. Any linting message that is of a greater lint level will cause a compilation error
+and stop compilation.
 .TP
 .BR \-\-
 Stop parsing command line arguments. All arguments after this one will be considered file names
@@ -239,5 +272,11 @@ This variable does nothing in the default configuration of Janet, as PRF is disa
 cannot be defined for this variable to have an effect.
 .RE
 
+.B NO_COLOR
+.RS
+Turn off color by default in the repl and in the error handler of scripts. This can be changed at runtime
+via dynamic bindings *err-color* and *pretty-format*, or via the command line parameters -n and -N.
+.RE
+
 .SH AUTHOR
 Written by Calvin Rose <calsrose@gmail.com>

jpm.1

@@ -1,273 +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
-
-.SH AUTHOR
-Written by Calvin Rose <calsrose@gmail.com>

meson.build

@@ -1,4 +1,4 @@
-# Copyright (c) 2020 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.15.4')
+  version : '1.31.0')
 
 # 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
@@ -60,9 +61,8 @@ conf.set('JANET_NO_SOURCEMAPS', not get_option('sourcemaps'))
 conf.set('JANET_NO_ASSEMBLER', not get_option('assembler'))
 conf.set('JANET_NO_PEG', not get_option('peg'))
 conf.set('JANET_NO_NET', not get_option('net'))
-conf.set('JANET_NO_EV', not get_option('ev'))
+conf.set('JANET_NO_EV', not get_option('ev') or get_option('single_threaded'))
 conf.set('JANET_REDUCED_OS', get_option('reduced_os'))
-conf.set('JANET_NO_TYPED_ARRAY', not get_option('typed_array'))
 conf.set('JANET_NO_INT_TYPES', not get_option('int_types'))
 conf.set('JANET_PRF', get_option('prf'))
 conf.set('JANET_RECURSION_GUARD', get_option('recursion_guard'))
@@ -73,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
@@ -114,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',
@@ -128,14 +133,13 @@ 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/typedarray.c',
   'src/core/util.c',
   'src/core/value.c',
   'src/core/vector.c',
@@ -160,36 +164,48 @@ 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
 janetc = custom_target('janetc',
-  input : [janet_boot],
+  input : [janet_boot, 'src/boot/boot.janet'],
   output : 'janet.c',
   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, android_spawn_dep]
+if not get_option('single_threaded')
+  janet_dependencies += thread_dep
+endif
+
+if cc.has_argument('-fvisibility=hidden')
+  lib_cflags = ['-fvisibility=hidden']
+else
+  lib_cflags = []
+endif
 libjanet = library('janet', janetc,
   include_directories : incdir,
-  dependencies : [m_dep, dl_dep, thread_dep],
+  dependencies : janet_dependencies,
   version: meson.project_version(),
   soversion: version_parts[0] + '.' + version_parts[1],
+  c_args : lib_cflags,
   install : true)
 
 # Extra c flags - adding -fvisibility=hidden matches the Makefile and
 # shaves off about 10k on linux x64, likely similar on other platforms.
 if cc.has_argument('-fvisibility=hidden')
-  extra_cflags = ['-fvisibility=hidden']
+  extra_cflags = ['-fvisibility=hidden', '-DJANET_DLL_IMPORT']
 else
-  extra_cflags = []
+  extra_cflags = ['-DJANET_DLL_IMPORT']
 endif
-janet_mainclient = executable('janet', janetc, mainclient_src,
+janet_mainclient = executable('janet', mainclient_src,
   include_directories : incdir,
-  dependencies : [m_dep, dl_dep, thread_dep],
+  dependencies : janet_dependencies,
+  link_with: [libjanet],
   c_args : extra_cflags,
   install : true)
 
@@ -202,7 +218,7 @@ if meson.is_cross_build()
   endif
   janet_nativeclient = executable('janet-native', janetc, mainclient_src,
     include_directories : incdir,
-    dependencies : [m_dep, dl_dep, thread_dep],
+    dependencies : janet_dependencies,
     c_args : extra_native_cflags,
     native : true)
 else
@@ -218,17 +234,34 @@ docs = custom_target('docs',
 
 # Tests
 test_files = [
-  'test/suite0000.janet',
-  'test/suite0001.janet',
-  'test/suite0002.janet',
-  'test/suite0003.janet',
-  'test/suite0004.janet',
-  'test/suite0005.janet',
-  'test/suite0006.janet',
-  'test/suite0007.janet',
-  'test/suite0008.janet',
-  'test/suite0009.janet',
-  'test/suite0010.janet'
+  'test/suite-array.janet',
+  'test/suite-asm.janet',
+  'test/suite-boot.janet',
+  'test/suite-buffer.janet',
+  'test/suite-capi.janet',
+  'test/suite-cfuns.janet',
+  'test/suite-compile.janet',
+  'test/suite-corelib.janet',
+  'test/suite-debug.janet',
+  'test/suite-ev.janet',
+  'test/suite-ffi.janet',
+  'test/suite-inttypes.janet',
+  'test/suite-io.janet',
+  'test/suite-marsh.janet',
+  'test/suite-math.janet',
+  'test/suite-os.janet',
+  'test/suite-parse.janet',
+  'test/suite-peg.janet',
+  'test/suite-pp.janet',
+  'test/suite-specials.janet',
+  'test/suite-string.janet',
+  'test/suite-strtod.janet',
+  'test/suite-struct.janet',
+  'test/suite-symcache.janet',
+  'test/suite-table.janet',
+  'test/suite-unknown.janet',
+  'test/suite-value.janet',
+  'test/suite-vm.janet'
 ]
 foreach t : test_files
   test(t, janet_nativeclient, args : files([t]), workdir : meson.current_source_dir())
@@ -255,18 +288,12 @@ patched_janet = custom_target('patched-janeth',
   install : true,
   install_dir : join_paths(get_option('includedir'), 'janet'),
   build_by_default : true,
-  output : ['janet.h'],
+  output : ['janet_' + meson.project_version() + '.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'))
+  install_symlink('janet.h', pointing_to: 'janet_' + meson.project_version() + '.h', install_dir: join_paths(get_option('includedir'), 'janet'))
 endif
+

meson_options.txt

@@ -8,7 +8,6 @@ option('sourcemaps', type : 'boolean', value : true)
 option('reduced_os', type : 'boolean', value : false)
 option('assembler', type : 'boolean', value : true)
 option('peg', type : 'boolean', value : true)
-option('typed_array', type : 'boolean', value : true)
 option('int_types', type : 'boolean', value : true)
 option('prf', type : 'boolean', value : false)
 option('net', type : 'boolean', value : true)
@@ -18,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 : true)
+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) 2020 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) 2020 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,7 +93,7 @@ int main(int argc, const char **argv) {
     fseek(boot_file, 0, SEEK_END);
     size_t boot_size = ftell(boot_file);
     fseek(boot_file, 0, SEEK_SET);
-    unsigned char *boot_buffer = malloc(boot_size);
+    unsigned char *boot_buffer = janet_malloc(boot_size);
     if (NULL == boot_buffer) {
         fprintf(stderr, "Failed to allocate boot buffer\n");
         exit(1);
@@ -105,7 +105,7 @@ int main(int argc, const char **argv) {
     fclose(boot_file);
 
     status = janet_dobytes(env, boot_buffer, (int32_t) boot_size, boot_filename, NULL);
-    free(boot_buffer);
+    janet_free(boot_buffer);
 
     /* Deinitialize vm */
     janet_deinit();

src/boot/buffer_test.c

@@ -1,5 +1,5 @@
 /*
-* Copyright (c) 2020 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) 2020 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) 2020 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
@@ -70,6 +70,5 @@ int system_test() {
 
     assert(janet_equals(tuple1, tuple2));
 
-
     return 0;
 }

src/boot/table_test.c

@@ -1,5 +1,5 @@
 /*
-* Copyright (c) 2020 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 15
-#define JANET_VERSION_PATCH 4
+#define JANET_VERSION_MINOR 31
+#define JANET_VERSION_PATCH 0
 #define JANET_VERSION_EXTRA ""
-#define JANET_VERSION "1.15.4"
+#define JANET_VERSION "1.31.0"
 
 /* #define JANET_BUILD "local" */
 
@@ -27,12 +27,14 @@
 /* #define JANET_NO_ASSEMBLER */
 /* #define JANET_NO_PEG */
 /* #define JANET_NO_NET */
-/* #define JANET_NO_TYPED_ARRAY */
 /* #define JANET_NO_INT_TYPES */
 /* #define JANET_NO_EV */
 /* #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 */
@@ -47,7 +49,16 @@
 /* #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> */
+/* #define janet_malloc(X) mi_malloc((X)) */
+/* #define janet_realloc(X, Y) mi_realloc((X), (Y)) */
+/* #define janet_calloc(X, Y) mi_calloc((X), (Y)) */
+/* #define janet_free(X) mi_free((X)) */
 
 /* Main client settings, does not affect library code */
 /* #define JANET_SIMPLE_GETLINE */

src/core/abstract.c

@@ -1,5 +1,5 @@
 /*
-* Copyright (c) 2020 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) 2020 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,8 +35,8 @@ 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);
-        data = (Janet *) malloc(sizeof(Janet) * (size_t) capacity);
+        janet_vm.next_collection += capacity * sizeof(Janet);
+        data = (Janet *) janet_malloc(sizeof(Janet) * (size_t) capacity);
         if (NULL == data) {
             JANET_OUT_OF_MEMORY;
         }
@@ -52,7 +52,7 @@ JanetArray *janet_array_n(const Janet *elements, int32_t n) {
     JanetArray *array = janet_gcalloc(JANET_MEMORY_ARRAY, sizeof(JanetArray));
     array->capacity = n;
     array->count = n;
-    array->data = malloc(sizeof(Janet) * (size_t) n);
+    array->data = janet_malloc(sizeof(Janet) * (size_t) n);
     if (!array->data) {
         JANET_OUT_OF_MEMORY;
     }
@@ -68,11 +68,11 @@ void janet_array_ensure(JanetArray *array, int32_t capacity, int32_t growth) {
     int64_t new_capacity = ((int64_t) capacity) * growth;
     if (new_capacity > INT32_MAX) new_capacity = INT32_MAX;
     capacity = (int32_t) new_capacity;
-    newData = realloc(old, capacity * sizeof(Janet));
+    newData = janet_realloc(old, capacity * sizeof(Janet));
     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 & xs)",
+              "Push all the elements of xs to 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 if the range is negative, it is taken as (start, end] 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, inserting after the index 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,13 +286,18 @@ 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);
     int32_t n = 1;
     if (at < 0) {
-        at = array->count + at + 1;
+        at = array->count + at;
     }
     if (at < 0 || at > array->count)
         janet_panicf("removal index %d out of range [0,%d]", at, array->count);
@@ -270,12 +316,14 @@ 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) {
         if (array->count < array->capacity) {
-            Janet *newData = realloc(array->data, array->count * sizeof(Janet));
+            Janet *newData = janet_realloc(array->data, array->count * sizeof(Janet));
             if (NULL == newData) {
                 JANET_OUT_OF_MEMORY;
             }
@@ -284,109 +332,39 @@ static Janet cfun_array_trim(int32_t argc, Janet *argv) {
         }
     } else {
         array->capacity = 0;
-        free(array->data);
+        janet_free(array->data);
         array->data = NULL;
     }
     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) 2020 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
@@ -75,6 +75,7 @@ static const JanetInstructionDef janet_ops[] = {
     {"cmp", JOP_COMPARE},
     {"cncl", JOP_CANCEL},
     {"div", JOP_DIVIDE},
+    {"divf", JOP_DIVIDE_FLOOR},
     {"divim", JOP_DIVIDE_IMMEDIATE},
     {"eq", JOP_EQUALS},
     {"eqim", JOP_EQUALS_IMMEDIATE},
@@ -137,6 +138,7 @@ static const JanetInstructionDef janet_ops[] = {
     {"sru", JOP_SHIFT_RIGHT_UNSIGNED},
     {"sruim", JOP_SHIFT_RIGHT_UNSIGNED_IMMEDIATE},
     {"sub", JOP_SUBTRACT},
+    {"subim", JOP_SUBTRACT_IMMEDIATE},
     {"tcall", JOP_TAILCALL},
     {"tchck", JOP_TYPECHECK}
 };
@@ -187,7 +189,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)
@@ -224,7 +230,7 @@ static int32_t janet_asm_addenv(JanetAssembler *a, Janet envname) {
     janet_table_put(&a->envs, envname, janet_wrap_number(envindex));
     if (envindex >= a->environments_capacity) {
         int32_t newcap = 2 * envindex;
-        def->environments = realloc(def->environments, newcap * sizeof(int32_t));
+        def->environments = janet_realloc(def->environments, newcap * sizeof(int32_t));
         if (NULL == def->environments) {
             JANET_OUT_OF_MEMORY;
         }
@@ -516,6 +522,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 +560,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);
@@ -582,7 +593,7 @@ static JanetAssembleResult janet_asm1(JanetAssembler *parent, Janet source, int
     x = janet_get1(s, janet_ckeywordv("constants"));
     if (janet_indexed_view(x, &arr, &count)) {
         def->constants_length = count;
-        def->constants = malloc(sizeof(Janet) * (size_t) count);
+        def->constants = janet_malloc(sizeof(Janet) * (size_t) count);
         if (NULL == def->constants) {
             JANET_OUT_OF_MEMORY;
         }
@@ -597,6 +608,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++) {
@@ -614,7 +628,7 @@ static JanetAssembleResult janet_asm1(JanetAssembler *parent, Janet source, int
             newlen = def->defs_length + 1;
             if (a.defs_capacity < newlen) {
                 int32_t newcap = newlen;
-                def->defs = realloc(def->defs, newcap * sizeof(JanetFuncDef *));
+                def->defs = janet_realloc(def->defs, newcap * sizeof(JanetFuncDef *));
                 if (NULL == def->defs) {
                     JANET_OUT_OF_MEMORY;
                 }
@@ -643,7 +657,7 @@ static JanetAssembleResult janet_asm1(JanetAssembler *parent, Janet source, int
         }
         /* Allocate bytecode array */
         def->bytecode_length = blength;
-        def->bytecode = malloc(sizeof(uint32_t) * (size_t) blength);
+        def->bytecode = janet_malloc(sizeof(uint32_t) * (size_t) blength);
         if (NULL == def->bytecode) {
             JANET_OUT_OF_MEMORY;
         }
@@ -685,7 +699,7 @@ static JanetAssembleResult janet_asm1(JanetAssembler *parent, Janet source, int
     x = janet_get1(s, janet_ckeywordv("sourcemap"));
     if (janet_indexed_view(x, &arr, &count)) {
         janet_asm_assert(&a, count == def->bytecode_length, "sourcemap must have the same length as the bytecode");
-        def->sourcemap = malloc(sizeof(JanetSourceMapping) * (size_t) count);
+        def->sourcemap = janet_malloc(sizeof(JanetSourceMapping) * (size_t) count);
         if (NULL == def->sourcemap) {
             JANET_OUT_OF_MEMORY;
         }
@@ -709,10 +723,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 =
-        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 +928,29 @@ 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 +974,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 +1027,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 +1038,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 +1083,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 +1095,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) 2020 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
@@ -28,12 +28,19 @@
 #include "state.h"
 #endif
 
+/* Allow for managed buffers that cannot realloc/free their backing memory */
+static void janet_buffer_can_realloc(JanetBuffer *buffer) {
+    if (buffer->gc.flags & JANET_BUFFER_FLAG_NO_REALLOC) {
+        janet_panic("buffer cannot reallocate foreign memory");
+    }
+}
+
 /* Initialize a buffer */
-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);
-    data = malloc(sizeof(uint8_t) * (size_t) capacity);
+    data = janet_malloc(sizeof(uint8_t) * (size_t) capacity);
     if (NULL == data) {
         JANET_OUT_OF_MEMORY;
     }
@@ -43,15 +50,37 @@ 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;
+}
+
+/* Initialize an unmanaged buffer */
+JanetBuffer *janet_pointer_buffer_unsafe(void *memory, int32_t capacity, int32_t count) {
+    if (count < 0) janet_panic("count < 0");
+    if (capacity < count) janet_panic("capacity < count");
+    JanetBuffer *buffer = janet_gcalloc(JANET_MEMORY_BUFFER, sizeof(JanetBuffer));
+    buffer->gc.flags |= JANET_BUFFER_FLAG_NO_REALLOC;
+    buffer->capacity = capacity;
+    buffer->count = count;
+    buffer->data = (uint8_t *) memory;
+    return buffer;
+}
+
 /* Deinitialize a buffer (free data memory) */
 void janet_buffer_deinit(JanetBuffer *buffer) {
-    free(buffer->data);
+    if (!(buffer->gc.flags & JANET_BUFFER_FLAG_NO_REALLOC)) {
+        janet_free(buffer->data);
+    }
 }
 
 /* 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 */
@@ -59,10 +88,11 @@ void janet_buffer_ensure(JanetBuffer *buffer, int32_t capacity, int32_t growth)
     uint8_t *new_data;
     uint8_t *old = buffer->data;
     if (capacity <= buffer->capacity) return;
+    janet_buffer_can_realloc(buffer);
     int64_t big_capacity = ((int64_t) capacity) * growth;
     capacity = big_capacity > INT32_MAX ? INT32_MAX : (int32_t) big_capacity;
     janet_gcpressure(capacity - buffer->capacity);
-    new_data = realloc(old, (size_t) capacity * sizeof(uint8_t));
+    new_data = janet_realloc(old, (size_t) capacity * sizeof(uint8_t));
     if (NULL == new_data) {
         JANET_OUT_OF_MEMORY;
     }
@@ -91,8 +121,9 @@ void janet_buffer_extra(JanetBuffer *buffer, int32_t n) {
     }
     int32_t new_size = buffer->count + n;
     if (new_size > buffer->capacity) {
+        janet_buffer_can_realloc(buffer);
         int32_t new_capacity = (new_size > (INT32_MAX / 2)) ? INT32_MAX : (new_size * 2);
-        uint8_t *new_data = realloc(buffer->data, new_capacity * sizeof(uint8_t));
+        uint8_t *new_data = janet_realloc(buffer->data, new_capacity * sizeof(uint8_t));
         janet_gcpressure(new_capacity - buffer->capacity);
         if (NULL == new_data) {
             JANET_OUT_OF_MEMORY;
@@ -162,28 +193,52 @@ 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_frombytes,
+              "(buffer/from-bytes & byte-vals)",
+              "Creates a buffer from integer parameters with byte values. All integers "
+              "will be coerced to the range of 1 byte 0-255.") {
+    int32_t i;
+    JanetBuffer *buffer = janet_buffer(argc);
+    for (i = 0; i < argc; i++) {
+        int32_t c = janet_getinteger(argv, i);
+        buffer->data[i] = c & 0xFF;
+    }
+    buffer->count = argc;
+    return janet_wrap_buffer(buffer);
+}
+
+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,12 +251,16 @@ 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);
+    janet_buffer_can_realloc(buffer);
     if (buffer->count < buffer->capacity) {
         int32_t newcap = buffer->count > 4 ? buffer->count : 4;
-        uint8_t *newData = realloc(buffer->data, newcap);
+        uint8_t *newData = janet_realloc(buffer->data, newcap);
         if (NULL == newData) {
             JANET_OUT_OF_MEMORY;
         }
@@ -211,7 +270,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 +283,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 +301,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,11 +321,8 @@ static Janet cfun_buffer_chars(int32_t argc, Janet *argv) {
     return argv[0];
 }
 
-static Janet cfun_buffer_push(int32_t argc, Janet *argv) {
-    int32_t i;
-    janet_arity(argc, 1, -1);
-    JanetBuffer *buffer = janet_getbuffer(argv, 0);
-    for (i = 1; i < argc; i++) {
+static void buffer_push_impl(JanetBuffer *buffer, Janet *argv, int32_t argc_offset, int32_t argc) {
+    for (int32_t i = argc_offset; i < argc; i++) {
         if (janet_checktype(argv[i], JANET_NUMBER)) {
             janet_buffer_push_u8(buffer, (uint8_t)(janet_getinteger(argv, i) & 0xFF));
         } else {
@@ -266,18 +334,53 @@ static Janet cfun_buffer_push(int32_t argc, Janet *argv) {
             janet_buffer_push_bytes(buffer, view.bytes, view.len);
         }
     }
+}
+
+JANET_CORE_FN(cfun_buffer_push_at,
+              "(buffer/push-at buffer index & xs)",
+              "Same as buffer/push, but copies the new data into the buffer "
+              " at index `index`.") {
+    janet_arity(argc, 2, -1);
+    JanetBuffer *buffer = janet_getbuffer(argv, 0);
+    int32_t index = janet_getinteger(argv, 1);
+    int32_t old_count = buffer->count;
+    if (index < 0 || index > old_count) {
+        janet_panicf("index out of range [0, %d)", old_count);
+    }
+    buffer->count = index;
+    buffer_push_impl(buffer, argv, 2, argc);
+    if (buffer->count < old_count) {
+        buffer->count = old_count;
+    }
     return argv[0];
 }
 
+JANET_CORE_FN(cfun_buffer_push,
+              "(buffer/push buffer & xs)",
+              "Push both individual bytes and byte sequences to a buffer. For each x in xs, "
+              "push the byte if x is an integer, otherwise push the bytesequence to the buffer. "
+              "Thus, this function behaves like both `buffer/push-string` and `buffer/push-byte`. "
+              "Returns the modified buffer. "
+              "Will throw an error if the buffer overflows.") {
+    janet_arity(argc, 1, -1);
+    JanetBuffer *buffer = janet_getbuffer(argv, 0);
+    buffer_push_impl(buffer, argv, 1, argc);
+    return argv[0];
+}
 
-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 +393,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 +422,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 +433,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 +444,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 +454,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,20 +465,26 @@ 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);
     int same_buf = src.bytes == dest->data;
     int32_t offset_dest = 0;
     int32_t offset_src = 0;
-    if (argc > 2)
+    if (argc > 2 && !janet_checktype(argv[2], JANET_NIL))
         offset_dest = janet_gethalfrange(argv, 2, dest->count, "dest-start");
-    if (argc > 3)
+    if (argc > 3 && !janet_checktype(argv[3], JANET_NIL))
         offset_src = janet_gethalfrange(argv, 3, src.len, "src-start");
     int32_t length_src;
     if (argc > 4) {
-        int32_t src_end = janet_gethalfrange(argv, 4, src.len, "src-end");
+        int32_t src_end = src.len;
+        if (!janet_checktype(argv[4], JANET_NIL))
+            src_end = janet_gethalfrange(argv, 4, src.len, "src-end");
         length_src = src_end - offset_src;
         if (length_src < 0) length_src = 0;
     } else {
@@ -386,7 +508,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 +519,28 @@ 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/from-bytes", cfun_buffer_frombytes),
+        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/push-at", cfun_buffer_push_at),
+        JANET_CORE_REG("buffer/popn", cfun_buffer_popn),
+        JANET_CORE_REG("buffer/clear", cfun_buffer_clear),
+        JANET_CORE_REG("buffer/slice", cfun_buffer_slice),
+        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) 2020 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 @@
 #include <janet.h>
 #include "gc.h"
 #include "util.h"
+#include "regalloc.h"
 #endif
 
 /* Look up table for instructions */
@@ -36,11 +37,13 @@ enum JanetInstructionType janet_instructions[JOP_INSTRUCTION_COUNT] = {
     JINT_0, /* JOP_RETURN_NIL, */
     JINT_SSI, /* JOP_ADD_IMMEDIATE, */
     JINT_SSS, /* JOP_ADD, */
+    JINT_SSI, /* JOP_SUBTRACT_IMMEDIATE, */
     JINT_SSS, /* JOP_SUBTRACT, */
     JINT_SSI, /* JOP_MULTIPLY_IMMEDIATE, */
     JINT_SSS, /* JOP_MULTIPLY, */
     JINT_SSI, /* JOP_DIVIDE_IMMEDIATE, */
     JINT_SSS, /* JOP_DIVIDE, */
+    JINT_SSS, /* JOP_DIVIDE_FLOOR */
     JINT_SSS, /* JOP_MODULO, */
     JINT_SSS, /* JOP_REMAINDER, */
     JINT_SSS, /* JOP_BAND, */
@@ -106,6 +109,291 @@ enum JanetInstructionType janet_instructions[JOP_INSTRUCTION_COUNT] = {
     JINT_SSS /* JOP_CANCEL, */
 };
 
+/* Remove all noops while preserving jumps and debugging information.
+ * Useful as part of a filtering compiler pass. */
+void janet_bytecode_remove_noops(JanetFuncDef *def) {
+
+    /* Get an instruction rewrite map so we can rewrite jumps */
+    uint32_t *pc_map = janet_smalloc(sizeof(uint32_t) * (1 + def->bytecode_length));
+    uint32_t new_bytecode_length = 0;
+    for (int32_t i = 0; i < def->bytecode_length; i++) {
+        uint32_t instr = def->bytecode[i];
+        uint32_t opcode = instr & 0x7F;
+        pc_map[i] = new_bytecode_length;
+        if (opcode != JOP_NOOP) {
+            new_bytecode_length++;
+        }
+    }
+    pc_map[def->bytecode_length] = new_bytecode_length;
+
+    /* Linear scan rewrite bytecode and sourcemap. Also fix jumps. */
+    int32_t j = 0;
+    for (int32_t i = 0; i < def->bytecode_length; i++) {
+        uint32_t instr = def->bytecode[i];
+        uint32_t opcode = instr & 0x7F;
+        int32_t old_jump_target = 0;
+        int32_t new_jump_target = 0;
+        switch (opcode) {
+            case JOP_NOOP:
+                continue;
+            case JOP_JUMP:
+                /* relative pc is in DS field of instruction */
+                old_jump_target = i + (((int32_t)instr) >> 8);
+                new_jump_target = pc_map[old_jump_target];
+                instr += (new_jump_target - old_jump_target + (i - j)) << 8;
+                break;
+            case JOP_JUMP_IF:
+            case JOP_JUMP_IF_NIL:
+            case JOP_JUMP_IF_NOT:
+            case JOP_JUMP_IF_NOT_NIL:
+                /* relative pc is in ES field of instruction */
+                old_jump_target = i + (((int32_t)instr) >> 16);
+                new_jump_target = pc_map[old_jump_target];
+                instr += (new_jump_target - old_jump_target + (i - j)) << 16;
+                break;
+            default:
+                break;
+        }
+        def->bytecode[j] = instr;
+        if (def->sourcemap != NULL) {
+            def->sourcemap[j] = def->sourcemap[i];
+        }
+        j++;
+    }
+
+    /* Rewrite symbolmap */
+    for (int32_t i = 0; i < def->symbolmap_length; i++) {
+        JanetSymbolMap *sm = def->symbolmap + i;
+        /* Don't rewrite upvalue mappings */
+        if (sm->birth_pc < UINT32_MAX) {
+            sm->birth_pc = pc_map[sm->birth_pc];
+            sm->death_pc = pc_map[sm->death_pc];
+        }
+    }
+
+    def->bytecode_length = new_bytecode_length;
+    def->bytecode = janet_realloc(def->bytecode, def->bytecode_length * sizeof(uint32_t));
+    janet_sfree(pc_map);
+}
+
+/* Remove redundant loads, moves and other instructions if possible and convert them to
+ * noops. Input is assumed valid bytecode. */
+void janet_bytecode_movopt(JanetFuncDef *def) {
+    JanetcRegisterAllocator ra;
+    int recur = 1;
+
+    /* Iterate this until no more instructions can be removed. */
+    while (recur) {
+        janetc_regalloc_init(&ra);
+
+        /* Look for slots that have writes but no reads (and aren't in the closure bitset). */
+        if (def->closure_bitset != NULL) {
+            for (int32_t i = 0; i < def->slotcount; i++) {
+                int32_t index = i >> 5;
+                uint32_t mask = 1U << (((uint32_t) i) & 31);
+                if (def->closure_bitset[index] & mask) {
+                    janetc_regalloc_touch(&ra, i);
+                }
+            }
+        }
+
+#define AA ((instr >> 8)  & 0xFF)
+#define BB ((instr >> 16) & 0xFF)
+#define CC (instr >> 24)
+#define DD (instr >> 8)
+#define EE (instr >> 16)
+
+        /* Check reads and writes */
+        for (int32_t i = 0; i < def->bytecode_length; i++) {
+            uint32_t instr = def->bytecode[i];
+            switch (instr & 0x7F) {
+
+                /* Group instructions my how they read from slots */
+
+                /* No reads or writes */
+                default:
+                    janet_assert(0, "unhandled instruction");
+                case JOP_JUMP:
+                case JOP_NOOP:
+                case JOP_RETURN_NIL:
+                /* Write A */
+                case JOP_LOAD_INTEGER:
+                case JOP_LOAD_CONSTANT:
+                case JOP_LOAD_UPVALUE:
+                case JOP_CLOSURE:
+                /* Write D */
+                case JOP_LOAD_NIL:
+                case JOP_LOAD_TRUE:
+                case JOP_LOAD_FALSE:
+                case JOP_LOAD_SELF:
+                case JOP_MAKE_ARRAY:
+                case JOP_MAKE_BUFFER:
+                case JOP_MAKE_STRING:
+                case JOP_MAKE_STRUCT:
+                case JOP_MAKE_TABLE:
+                case JOP_MAKE_TUPLE:
+                case JOP_MAKE_BRACKET_TUPLE:
+                    break;
+
+                /* Read A */
+                case JOP_ERROR:
+                case JOP_TYPECHECK:
+                case JOP_JUMP_IF:
+                case JOP_JUMP_IF_NOT:
+                case JOP_JUMP_IF_NIL:
+                case JOP_JUMP_IF_NOT_NIL:
+                case JOP_SET_UPVALUE:
+                /* Write E, Read A */
+                case JOP_MOVE_FAR:
+                    janetc_regalloc_touch(&ra, AA);
+                    break;
+
+                /* Read B */
+                case JOP_SIGNAL:
+                /* Write A, Read B */
+                case JOP_ADD_IMMEDIATE:
+                case JOP_SUBTRACT_IMMEDIATE:
+                case JOP_MULTIPLY_IMMEDIATE:
+                case JOP_DIVIDE_IMMEDIATE:
+                case JOP_SHIFT_LEFT_IMMEDIATE:
+                case JOP_SHIFT_RIGHT_IMMEDIATE:
+                case JOP_SHIFT_RIGHT_UNSIGNED_IMMEDIATE:
+                case JOP_GREATER_THAN_IMMEDIATE:
+                case JOP_LESS_THAN_IMMEDIATE:
+                case JOP_EQUALS_IMMEDIATE:
+                case JOP_NOT_EQUALS_IMMEDIATE:
+                case JOP_GET_INDEX:
+                    janetc_regalloc_touch(&ra, BB);
+                    break;
+
+                /* Read D */
+                case JOP_RETURN:
+                case JOP_PUSH:
+                case JOP_PUSH_ARRAY:
+                case JOP_TAILCALL:
+                    janetc_regalloc_touch(&ra, DD);
+                    break;
+
+                /* Write A, Read E */
+                case JOP_MOVE_NEAR:
+                case JOP_LENGTH:
+                case JOP_BNOT:
+                case JOP_CALL:
+                    janetc_regalloc_touch(&ra, EE);
+                    break;
+
+                /* Read A, B */
+                case JOP_PUT_INDEX:
+                    janetc_regalloc_touch(&ra, AA);
+                    janetc_regalloc_touch(&ra, BB);
+                    break;
+
+                /* Read A, E */
+                case JOP_PUSH_2:
+                    janetc_regalloc_touch(&ra, AA);
+                    janetc_regalloc_touch(&ra, EE);
+                    break;
+
+                /* Read B, C */
+                case JOP_PROPAGATE:
+                /* Write A, Read B and C */
+                case JOP_BAND:
+                case JOP_BOR:
+                case JOP_BXOR:
+                case JOP_ADD:
+                case JOP_SUBTRACT:
+                case JOP_MULTIPLY:
+                case JOP_DIVIDE:
+                case JOP_DIVIDE_FLOOR:
+                case JOP_MODULO:
+                case JOP_REMAINDER:
+                case JOP_SHIFT_LEFT:
+                case JOP_SHIFT_RIGHT:
+                case JOP_SHIFT_RIGHT_UNSIGNED:
+                case JOP_GREATER_THAN:
+                case JOP_LESS_THAN:
+                case JOP_EQUALS:
+                case JOP_COMPARE:
+                case JOP_IN:
+                case JOP_GET:
+                case JOP_GREATER_THAN_EQUAL:
+                case JOP_LESS_THAN_EQUAL:
+                case JOP_NOT_EQUALS:
+                case JOP_CANCEL:
+                case JOP_RESUME:
+                case JOP_NEXT:
+                    janetc_regalloc_touch(&ra, BB);
+                    janetc_regalloc_touch(&ra, CC);
+                    break;
+
+                /* Read A, B, C */
+                case JOP_PUT:
+                case JOP_PUSH_3:
+                    janetc_regalloc_touch(&ra, AA);
+                    janetc_regalloc_touch(&ra, BB);
+                    janetc_regalloc_touch(&ra, CC);
+                    break;
+            }
+        }
+
+        /* Iterate and set noops on instructions that make writes that no one ever reads.
+         * Only set noops for instructions with no side effects - moves, loads, etc. that can't
+         * raise errors (outside of systemic errors like oom or stack overflow). */
+        recur = 0;
+        for (int32_t i = 0; i < def->bytecode_length; i++) {
+            uint32_t instr = def->bytecode[i];
+            switch (instr & 0x7F) {
+                default:
+                    break;
+                /* Write D */
+                case JOP_LOAD_NIL:
+                case JOP_LOAD_TRUE:
+                case JOP_LOAD_FALSE:
+                case JOP_LOAD_SELF:
+                case JOP_MAKE_ARRAY:
+                case JOP_MAKE_TUPLE:
+                case JOP_MAKE_BRACKET_TUPLE: {
+                    if (!janetc_regalloc_check(&ra, DD)) {
+                        def->bytecode[i] = JOP_NOOP;
+                        recur = 1;
+                    }
+                }
+                break;
+                /* Write E, Read A */
+                case JOP_MOVE_FAR: {
+                    if (!janetc_regalloc_check(&ra, EE)) {
+                        def->bytecode[i] = JOP_NOOP;
+                        recur = 1;
+                    }
+                }
+                break;
+                /* Write A, Read E */
+                case JOP_MOVE_NEAR:
+                /* Write A, Read B */
+                case JOP_GET_INDEX:
+                /* Write A */
+                case JOP_LOAD_INTEGER:
+                case JOP_LOAD_CONSTANT:
+                case JOP_LOAD_UPVALUE:
+                case JOP_CLOSURE: {
+                    if (!janetc_regalloc_check(&ra, AA)) {
+                        def->bytecode[i] = JOP_NOOP;
+                        recur = 1;
+                    }
+                }
+                break;
+            }
+        }
+
+        janetc_regalloc_deinit(&ra);
+#undef AA
+#undef BB
+#undef CC
+#undef DD
+#undef EE
+    }
+}
+
 /* Verify some bytecode */
 int janet_verify(JanetFuncDef *def) {
     int vargs = !!(def->flags & JANET_FUNCDEF_FLAG_VARARG);
@@ -218,6 +506,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 +518,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) 2020 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);
@@ -209,12 +209,46 @@ const char *janet_optcstring(const Janet *argv, int32_t argc, int32_t n, const c
 #undef DEFINE_OPTLEN
 
 const char *janet_getcstring(const Janet *argv, int32_t n) {
-    const uint8_t *jstr = janet_getstring(argv, n);
-    const char *cstr = (const char *)jstr;
-    if (strlen(cstr) != (size_t) janet_string_length(jstr)) {
-        janet_panicf("string %v contains embedded 0s");
+    if (!janet_checktype(argv[n], JANET_STRING)) {
+        janet_panic_type(argv[n], n, JANET_TFLAG_STRING);
     }
+    return janet_getcbytes(argv, n);
+}
+
+const char *janet_getcbytes(const Janet *argv, int32_t n) {
+    /* Ensure buffer 0-padded */
+    if (janet_checktype(argv[n], JANET_BUFFER)) {
+        JanetBuffer *b = janet_unwrap_buffer(argv[n]);
+        if ((b->gc.flags & JANET_BUFFER_FLAG_NO_REALLOC) && b->count == b->capacity) {
+            /* Make a copy with janet_smalloc in the rare case we have a buffer that
+             * cannot be realloced and pushing a 0 byte would panic. */
+            char *new_string = janet_smalloc(b->count + 1);
+            memcpy(new_string, b->data, b->count);
+            new_string[b->count] = 0;
+            if (strlen(new_string) != (size_t) b->count) goto badzeros;
+            return new_string;
+        } else {
+            /* Ensure trailing 0 */
+            janet_buffer_push_u8(b, 0);
+            b->count--;
+            if (strlen((char *)b->data) != (size_t) b->count) goto badzeros;
+            return (const char *) b->data;
+        }
+    }
+    JanetByteView view = janet_getbytes(argv, n);
+    const char *cstr = (const char *)view.bytes;
+    if (strlen(cstr) != (size_t) view.len) goto badzeros;
     return cstr;
+
+badzeros:
+    janet_panic("bytes contain embedded 0s");
+}
+
+const char *janet_optcbytes(const Janet *argv, int32_t argc, int32_t n, const char *dflt) {
+    if (n >= argc || janet_checktype(argv[n], JANET_NIL)) {
+        return dflt;
+    }
+    return janet_getcbytes(argv, n);
 }
 
 int32_t janet_getnat(const Janet *argv, int32_t n) {
@@ -259,12 +293,36 @@ int32_t janet_getinteger(const Janet *argv, int32_t n) {
     return janet_unwrap_integer(x);
 }
 
+uint32_t janet_getuinteger(const Janet *argv, int32_t n) {
+    Janet x = argv[n];
+    if (!janet_checkuint(x)) {
+        janet_panicf("bad slot #%d, expected 32 bit signed integer, got %v", n, x);
+    }
+    return janet_unwrap_integer(x);
+}
+
 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_checkuint64(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) {
@@ -284,6 +342,20 @@ int32_t janet_gethalfrange(const Janet *argv, int32_t n, int32_t length, const c
     return not_raw;
 }
 
+int32_t janet_getstartrange(const Janet *argv, int32_t argc, int32_t n, int32_t length) {
+    if (n >= argc || janet_checktype(argv[n], JANET_NIL)) {
+        return 0;
+    }
+    return janet_gethalfrange(argv, n, length, "start");
+}
+
+int32_t janet_getendrange(const Janet *argv, int32_t argc, int32_t n, int32_t length) {
+    if (n >= argc || janet_checktype(argv[n], JANET_NIL)) {
+        return length;
+    }
+    return janet_gethalfrange(argv, n, length, "end");
+}
+
 int32_t janet_getargindex(const Janet *argv, int32_t n, int32_t length, const char *which) {
     int32_t raw = janet_getinteger(argv, n);
     int32_t not_raw = raw;
@@ -336,48 +408,34 @@ JanetRange janet_getslice(int32_t argc, const Janet *argv) {
     janet_arity(argc, 1, 3);
     JanetRange range;
     int32_t length = janet_length(argv[0]);
-    if (argc == 1) {
-        range.start = 0;
-        range.end = length;
-    } else if (argc == 2) {
-        range.start = janet_checktype(argv[1], JANET_NIL)
-                      ? 0
-                      : janet_gethalfrange(argv, 1, length, "start");
-        range.end = length;
-    } else {
-        range.start = janet_checktype(argv[1], JANET_NIL)
-                      ? 0
-                      : janet_gethalfrange(argv, 1, length, "start");
-        range.end = janet_checktype(argv[2], JANET_NIL)
-                    ? length
-                    : janet_gethalfrange(argv, 2, length, "end");
-        if (range.end < range.start)
-            range.end = range.start;
-    }
+    range.start = janet_getstartrange(argv, argc, 1, length);
+    range.end = janet_getendrange(argv, argc, 2, length);
+    if (range.end < range.start)
+        range.end = range.start;
     return range;
 }
 
 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);
     }
 }
 
@@ -435,7 +493,7 @@ void *janet_optabstract(const Janet *argv, int32_t argc, int32_t n, const JanetA
 
 /* Some definitions for function-like macros */
 
-JANET_API JanetStructHead *(janet_struct_head)(const JanetKV *st) {
+JANET_API JanetStructHead *(janet_struct_head)(JanetStruct st) {
     return janet_struct_head(st);
 }
 
@@ -443,10 +501,10 @@ JANET_API JanetAbstractHead *(janet_abstract_head)(const void *abstract) {
     return janet_abstract_head(abstract);
 }
 
-JANET_API JanetStringHead *(janet_string_head)(const uint8_t *s) {
+JANET_API JanetStringHead *(janet_string_head)(JanetString s) {
     return janet_string_head(s);
 }
 
-JANET_API JanetTupleHead *(janet_tuple_head)(const Janet *tuple) {
+JANET_API JanetTupleHead *(janet_tuple_head)(JanetTuple tuple) {
     return janet_tuple_head(tuple);
 }

src/core/cfuns.c

@@ -1,5 +1,5 @@
 /*
-* Copyright (c) 2020 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
@@ -99,7 +99,7 @@ static JanetSlot opfunction(
 static int can_be_imm(Janet x, int8_t *out) {
     if (!janet_checkint(x)) return 0;
     int32_t integer = janet_unwrap_integer(x);
-    if (integer > 127 || integer < -127) return 0;
+    if (integer > INT8_MAX || integer < INT8_MIN) return 0;
     *out = (int8_t) integer;
     return 1;
 }
@@ -116,12 +116,11 @@ static JanetSlot opreduce(
     JanetSlot *args,
     int op,
     int opim,
-    Janet nullary) {
+    Janet nullary,
+    Janet unary) {
     JanetCompiler *c = opts.compiler;
     int32_t i, len;
     int8_t imm = 0;
-    int neg = opim < 0;
-    if (opim < 0) opim = -opim;
     len = janet_v_count(args);
     JanetSlot t;
     if (len == 0) {
@@ -132,19 +131,19 @@ static JanetSlot opreduce(
         if (op == JOP_SUBTRACT) {
             janetc_emit_ssi(c, JOP_MULTIPLY_IMMEDIATE, t, args[0], -1, 1);
         } else {
-            janetc_emit_sss(c, op, t, janetc_cslot(nullary), args[0], 1);
+            janetc_emit_sss(c, op, t, janetc_cslot(unary), args[0], 1);
         }
         return t;
     }
     t = janetc_gettarget(opts);
     if (opim && can_slot_be_imm(args[1], &imm)) {
-        janetc_emit_ssi(c, opim, t, args[0], neg ? -imm : imm, 1);
+        janetc_emit_ssi(c, opim, t, args[0], imm, 1);
     } else {
         janetc_emit_sss(c, op, t, args[0], args[1], 1);
     }
     for (i = 2; i < len; i++) {
         if (opim && can_slot_be_imm(args[i], &imm)) {
-            janetc_emit_ssi(c, opim, t, t, neg ? -imm : imm, 1);
+            janetc_emit_ssi(c, opim, t, t, imm, 1);
         } else {
             janetc_emit_sss(c, op, t, t, args[i], 1);
         }
@@ -155,7 +154,7 @@ static JanetSlot opreduce(
 /* Function optimizers */
 
 static JanetSlot do_propagate(JanetFopts opts, JanetSlot *args) {
-    return opreduce(opts, args, JOP_PROPAGATE, 0, janet_wrap_nil());
+    return opreduce(opts, args, JOP_PROPAGATE, 0, janet_wrap_nil(), janet_wrap_nil());
 }
 static JanetSlot do_error(JanetFopts opts, JanetSlot *args) {
     janetc_emit_s(opts.compiler, JOP_ERROR, args[0], 0);
@@ -172,7 +171,7 @@ static JanetSlot do_debug(JanetFopts opts, JanetSlot *args) {
     return t;
 }
 static JanetSlot do_in(JanetFopts opts, JanetSlot *args) {
-    return opreduce(opts, args, JOP_IN, 0, janet_wrap_nil());
+    return opreduce(opts, args, JOP_IN, 0, janet_wrap_nil(), janet_wrap_nil());
 }
 static JanetSlot do_get(JanetFopts opts, JanetSlot *args) {
     if (janet_v_count(args) == 3) {
@@ -192,20 +191,14 @@ static JanetSlot do_get(JanetFopts opts, JanetSlot *args) {
         c->buffer[label] |= (current - label) << 16;
         return t;
     } else {
-        return opreduce(opts, args, JOP_GET, 0, janet_wrap_nil());
+        return opreduce(opts, args, JOP_GET, 0, janet_wrap_nil(), janet_wrap_nil());
     }
 }
 static JanetSlot do_next(JanetFopts opts, JanetSlot *args) {
     return opfunction(opts, args, JOP_NEXT, janet_wrap_nil());
 }
-static JanetSlot do_modulo(JanetFopts opts, JanetSlot *args) {
-    return opreduce(opts, args, JOP_MODULO, 0, janet_wrap_nil());
-}
-static JanetSlot do_remainder(JanetFopts opts, JanetSlot *args) {
-    return opreduce(opts, args, JOP_REMAINDER, 0, janet_wrap_nil());
-}
 static JanetSlot do_cmp(JanetFopts opts, JanetSlot *args) {
-    return opreduce(opts, args, JOP_COMPARE, 0, janet_wrap_nil());
+    return opreduce(opts, args, JOP_COMPARE, 0, janet_wrap_nil(), janet_wrap_nil());
 }
 static JanetSlot do_put(JanetFopts opts, JanetSlot *args) {
     if (opts.flags & JANET_FOPTS_DROP) {
@@ -262,34 +255,43 @@ static JanetSlot do_apply(JanetFopts opts, JanetSlot *args) {
 /* Variadic operators specialization */
 
 static JanetSlot do_add(JanetFopts opts, JanetSlot *args) {
-    return opreduce(opts, args, JOP_ADD, JOP_ADD_IMMEDIATE, janet_wrap_integer(0));
+    return opreduce(opts, args, JOP_ADD, JOP_ADD_IMMEDIATE, janet_wrap_integer(0), janet_wrap_integer(0));
 }
 static JanetSlot do_sub(JanetFopts opts, JanetSlot *args) {
-    return opreduce(opts, args, JOP_SUBTRACT, -JOP_ADD_IMMEDIATE, janet_wrap_integer(0));
+    return opreduce(opts, args, JOP_SUBTRACT, JOP_SUBTRACT_IMMEDIATE, janet_wrap_integer(0), janet_wrap_integer(0));
 }
 static JanetSlot do_mul(JanetFopts opts, JanetSlot *args) {
-    return opreduce(opts, args, JOP_MULTIPLY, JOP_MULTIPLY_IMMEDIATE, janet_wrap_integer(1));
+    return opreduce(opts, args, JOP_MULTIPLY, JOP_MULTIPLY_IMMEDIATE, janet_wrap_integer(1), janet_wrap_integer(1));
 }
 static JanetSlot do_div(JanetFopts opts, JanetSlot *args) {
-    return opreduce(opts, args, JOP_DIVIDE, JOP_DIVIDE_IMMEDIATE, janet_wrap_integer(1));
+    return opreduce(opts, args, JOP_DIVIDE, JOP_DIVIDE_IMMEDIATE, janet_wrap_integer(1), janet_wrap_integer(1));
+}
+static JanetSlot do_divf(JanetFopts opts, JanetSlot *args) {
+    return opreduce(opts, args, JOP_DIVIDE_FLOOR, 0, janet_wrap_integer(1), janet_wrap_integer(1));
+}
+static JanetSlot do_modulo(JanetFopts opts, JanetSlot *args) {
+    return opreduce(opts, args, JOP_MODULO, 0, janet_wrap_integer(0), janet_wrap_integer(1));
+}
+static JanetSlot do_remainder(JanetFopts opts, JanetSlot *args) {
+    return opreduce(opts, args, JOP_REMAINDER, 0, janet_wrap_integer(0), janet_wrap_integer(1));
 }
 static JanetSlot do_band(JanetFopts opts, JanetSlot *args) {
-    return opreduce(opts, args, JOP_BAND, 0, janet_wrap_integer(-1));
+    return opreduce(opts, args, JOP_BAND, 0, janet_wrap_integer(-1), janet_wrap_integer(-1));
 }
 static JanetSlot do_bor(JanetFopts opts, JanetSlot *args) {
-    return opreduce(opts, args, JOP_BOR, 0, janet_wrap_integer(0));
+    return opreduce(opts, args, JOP_BOR, 0, janet_wrap_integer(0), janet_wrap_integer(0));
 }
 static JanetSlot do_bxor(JanetFopts opts, JanetSlot *args) {
-    return opreduce(opts, args, JOP_BXOR, 0, janet_wrap_integer(0));
+    return opreduce(opts, args, JOP_BXOR, 0, janet_wrap_integer(0), janet_wrap_integer(0));
 }
 static JanetSlot do_lshift(JanetFopts opts, JanetSlot *args) {
-    return opreduce(opts, args, JOP_SHIFT_LEFT, JOP_SHIFT_LEFT_IMMEDIATE, janet_wrap_integer(1));
+    return opreduce(opts, args, JOP_SHIFT_LEFT, JOP_SHIFT_LEFT_IMMEDIATE, janet_wrap_integer(1), janet_wrap_integer(1));
 }
 static JanetSlot do_rshift(JanetFopts opts, JanetSlot *args) {
-    return opreduce(opts, args, JOP_SHIFT_RIGHT, JOP_SHIFT_RIGHT_IMMEDIATE, janet_wrap_integer(1));
+    return opreduce(opts, args, JOP_SHIFT_RIGHT, JOP_SHIFT_RIGHT_IMMEDIATE, janet_wrap_integer(1), janet_wrap_integer(1));
 }
 static JanetSlot do_rshiftu(JanetFopts opts, JanetSlot *args) {
-    return opreduce(opts, args, JOP_SHIFT_RIGHT_UNSIGNED, JOP_SHIFT_RIGHT_UNSIGNED_IMMEDIATE, janet_wrap_integer(1));
+    return opreduce(opts, args, JOP_SHIFT_RIGHT_UNSIGNED, JOP_SHIFT_RIGHT_UNSIGNED_IMMEDIATE, janet_wrap_integer(1), janet_wrap_integer(1));
 }
 static JanetSlot do_bnot(JanetFopts opts, JanetSlot *args) {
     return genericSS(opts, JOP_BNOT, args[0]);
@@ -383,10 +385,11 @@ static const JanetFunOptimizer optimizers[] = {
     {fixarity2, do_propagate},
     {arity2or3, do_get},
     {arity1or2, do_next},
-    {fixarity2, do_modulo},
-    {fixarity2, do_remainder},
+    {NULL, do_modulo},
+    {NULL, do_remainder},
     {fixarity2, do_cmp},
     {fixarity2, do_cancel},
+    {NULL, do_divf}
 };
 
 const JanetFunOptimizer *janetc_funopt(uint32_t flags) {

src/core/compile.c

@@ -1,5 +1,5 @@
 /*
-* Copyright (c) 2020 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
@@ -53,6 +53,36 @@ void janetc_cerror(JanetCompiler *c, const char *m) {
     janetc_error(c, janet_cstring(m));
 }
 
+static const char *janet_lint_level_names[] = {
+    "relaxed",
+    "normal",
+    "strict"
+};
+
+/* Emit compiler linter messages */
+void janetc_lintf(JanetCompiler *c, JanetCompileLintLevel level, const char *format, ...) {
+    if (NULL != c->lints) {
+        /* format message */
+        va_list args;
+        JanetBuffer buffer;
+        int32_t len = 0;
+        while (format[len]) len++;
+        janet_buffer_init(&buffer, len);
+        va_start(args, format);
+        janet_formatbv(&buffer, format, args);
+        va_end(args);
+        const uint8_t *str = janet_string(buffer.data, buffer.count);
+        janet_buffer_deinit(&buffer);
+        /* construct linting payload */
+        Janet *payload = janet_tuple_begin(4);
+        payload[0] = janet_ckeywordv(janet_lint_level_names[level]);
+        payload[1] = c->current_mapping.line == -1 ? janet_wrap_nil() : janet_wrap_integer(c->current_mapping.line);
+        payload[2] = c->current_mapping.column == -1 ? janet_wrap_nil() : janet_wrap_integer(c->current_mapping.column);
+        payload[3] = janet_wrap_string(str);
+        janet_array_push(c->lints, janet_wrap_tuple(janet_tuple_end(payload)));
+    }
+}
+
 /* Free a slot */
 void janetc_freeslot(JanetCompiler *c, JanetSlot s) {
     if (s.flags & (JANET_SLOT_CONSTANT | JANET_SLOT_REF | JANET_SLOT_NAMED)) return;
@@ -63,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);
 }
 
@@ -129,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);
@@ -167,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,
@@ -199,24 +272,62 @@ JanetSlot janetc_resolve(
 
     /* Symbol not found - check for global */
     {
-        Janet check;
-        JanetBindingType btype = janet_resolve(c->env, sym, &check);
-        switch (btype) {
+        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:
                 janetc_error(c, janet_formatc("unknown symbol %q", janet_wrap_symbol(sym)));
                 return janetc_cslot(janet_wrap_nil());
             case JANET_BINDING_DEF:
             case JANET_BINDING_MACRO: /* Macro should function like defs when not in calling pos */
-                return janetc_cslot(check);
+                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: {
-                JanetSlot ret = janetc_cslot(check);
-                /* TODO save type info */
+                ret = janetc_cslot(binding.value);
                 ret.flags |= JANET_SLOT_REF | JANET_SLOT_NAMED | JANET_SLOT_MUTABLE | JANET_SLOTTYPE_ANY;
                 ret.flags &= ~JANET_SLOT_CONSTANT;
-                return ret;
+                break;
             }
         }
+        JanetCompileLintLevel depLevel = JANET_C_LINT_RELAXED;
+        switch (binding.deprecation) {
+            case JANET_BINDING_DEP_NONE:
+                break;
+            case JANET_BINDING_DEP_RELAXED:
+                depLevel = JANET_C_LINT_RELAXED;
+                break;
+            case JANET_BINDING_DEP_NORMAL:
+                depLevel = JANET_C_LINT_NORMAL;
+                break;
+            case JANET_BINDING_DEP_STRICT:
+                depLevel = JANET_C_LINT_STRICT;
+                break;
+        }
+        if (binding.deprecation != JANET_BINDING_DEP_NONE) {
+            janetc_lintf(c, depLevel, "%q is deprecated", janet_wrap_symbol(sym));
+        }
+        return ret;
     }
 
     /* Symbol was found */
@@ -233,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;
@@ -254,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;
@@ -263,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;
             }
         }
@@ -307,6 +422,7 @@ JanetSlot *janetc_toslots(JanetCompiler *c, const Janet *vals, int32_t len) {
     int32_t i;
     JanetSlot *ret = NULL;
     JanetFopts subopts = janetc_fopts_default(c);
+    subopts.flags |= JANET_FOPTS_ACCEPT_SPLICE;
     for (i = 0; i < len; i++) {
         janet_v_push(ret, janetc_value(subopts, vals[i]));
     }
@@ -317,6 +433,7 @@ JanetSlot *janetc_toslots(JanetCompiler *c, const Janet *vals, int32_t len) {
 JanetSlot *janetc_toslotskv(JanetCompiler *c, Janet ds) {
     JanetSlot *ret = NULL;
     JanetFopts subopts = janetc_fopts_default(c);
+    subopts.flags |= JANET_FOPTS_ACCEPT_SPLICE;
     const JanetKV *kvs = NULL;
     int32_t cap = 0, len = 0;
     janet_dictionary_view(ds, &kvs, &len, &cap);
@@ -399,6 +516,7 @@ void janetc_throwaway(JanetFopts opts, Janet x) {
     int32_t mapbufstart = janet_v_count(c->mapbuffer);
     janetc_scope(&unusedScope, c, JANET_SCOPE_UNUSED, "unusued");
     janetc_value(opts, x);
+    janetc_lintf(c, JANET_C_LINT_STRICT, "dead code, consider removing %.2q", x);
     janetc_popscope(c);
     if (c->buffer) {
         janet_v__cnt(c->buffer) = bufstart;
@@ -504,10 +622,40 @@ static JanetSlot janetc_call(JanetFopts opts, JanetSlot *slots, JanetSlot fun) {
 static JanetSlot janetc_maker(JanetFopts opts, JanetSlot *slots, int op) {
     JanetCompiler *c = opts.compiler;
     JanetSlot retslot;
-    janetc_pushslots(c, slots);
-    janetc_freeslots(c, slots);
-    retslot = janetc_gettarget(opts);
-    janetc_emit_s(c, op, retslot, 1);
+
+    /* Check if this structure is composed entirely of constants */
+    int can_inline = 1;
+    for (int32_t i = 0; i < janet_v_count(slots); i++) {
+        if (!(slots[i].flags & JANET_SLOT_CONSTANT) ||
+                (slots[i].flags & JANET_SLOT_SPLICED)) {
+            can_inline = 0;
+            break;
+        }
+    }
+
+    if (can_inline && (op == JOP_MAKE_STRUCT)) {
+        JanetKV *st = janet_struct_begin(janet_v_count(slots) / 2);
+        for (int32_t i = 0; i < janet_v_count(slots); i += 2) {
+            Janet k = slots[i].constant;
+            Janet v = slots[i + 1].constant;
+            janet_struct_put(st, k, v);
+        }
+        retslot = janetc_cslot(janet_wrap_struct(janet_struct_end(st)));
+        janetc_freeslots(c, slots);
+    } else if (can_inline && (op == JOP_MAKE_TUPLE)) {
+        Janet *tup = janet_tuple_begin(janet_v_count(slots));
+        for (int32_t i = 0; i < janet_v_count(slots); i++) {
+            tup[i] = slots[i].constant;
+        }
+        retslot = janetc_cslot(janet_wrap_tuple(janet_tuple_end(tup)));
+        janetc_freeslots(c, slots);
+    } else {
+        janetc_pushslots(c, slots);
+        janetc_freeslots(c, slots);
+        retslot = janetc_gettarget(opts);
+        janetc_emit_s(c, op, retslot, 1);
+    }
+
     return retslot;
 }
 
@@ -573,7 +721,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;
 
@@ -598,9 +746,14 @@ static int macroexpand1(
     int lock = janet_gclock();
     Janet mf_kw = janet_ckeywordv("macro-form");
     janet_table_put(c->env, mf_kw, x);
+    Janet ml_kw = janet_ckeywordv("macro-lints");
+    if (c->lints) {
+        janet_table_put(c->env, ml_kw, janet_wrap_array(c->lints));
+    }
     Janet tempOut;
     JanetSignal status = janet_continue(fiberp, janet_wrap_nil(), &tempOut);
     janet_table_put(c->env, mf_kw, janet_wrap_nil());
+    janet_table_put(c->env, ml_kw, janet_wrap_nil());
     janet_gcunlock(lock);
     if (status != JANET_SIGNAL_OK) {
         const uint8_t *es = janet_formatc("(macro) %V", tempOut);
@@ -733,7 +886,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);
@@ -745,7 +901,7 @@ JanetFuncDef *janetc_pop_funcdef(JanetCompiler *c) {
     def->bytecode_length = janet_v_count(c->buffer) - scope->bytecode_start;
     if (def->bytecode_length) {
         size_t s = sizeof(int32_t) * (size_t) def->bytecode_length;
-        def->bytecode = malloc(s);
+        def->bytecode = janet_malloc(s);
         if (NULL == def->bytecode) {
             JANET_OUT_OF_MEMORY;
         }
@@ -753,7 +909,7 @@ JanetFuncDef *janetc_pop_funcdef(JanetCompiler *c) {
         janet_v__cnt(c->buffer) = scope->bytecode_start;
         if (NULL != c->mapbuffer && c->source) {
             size_t s = sizeof(JanetSourceMapping) * (size_t) def->bytecode_length;
-            def->sourcemap = malloc(s);
+            def->sourcemap = janet_malloc(s);
             if (NULL == def->sourcemap) {
                 JANET_OUT_OF_MEMORY;
             }
@@ -778,7 +934,7 @@ JanetFuncDef *janetc_pop_funcdef(JanetCompiler *c) {
         int32_t slotchunks = (def->slotcount + 31) >> 5;
         /* numchunks is min of slotchunks and scope->ua.count */
         int32_t numchunks = slotchunks > scope->ua.count ? scope->ua.count : slotchunks;
-        uint32_t *chunks = calloc(sizeof(uint32_t), slotchunks);
+        uint32_t *chunks = janet_calloc(sizeof(uint32_t), slotchunks);
         if (NULL == chunks) {
             JANET_OUT_OF_MEMORY;
         }
@@ -788,14 +944,71 @@ 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) {
+            JanetSymbolMap jsm;
+            if (pair.death_pc == UINT32_MAX) {
+                jsm.death_pc = def->bytecode_length;
+            } else {
+                jsm.death_pc = pair.death_pc - scope->bytecode_start;
+            }
+            /* Handle birth_pc == 0 correctly */
+            if ((uint32_t) scope->bytecode_start > pair.birth_pc) {
+                jsm.birth_pc = 0;
+            } else {
+                jsm.birth_pc = pair.birth_pc - scope->bytecode_start;
+            }
+            janet_assert(jsm.birth_pc <= jsm.death_pc, "birth pc after death pc");
+            janet_assert(jsm.birth_pc < (uint32_t) def->bytecode_length, "bad birth pc");
+            janet_assert(jsm.death_pc <= (uint32_t) def->bytecode_length, "bad 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);
 
+    /* Do basic optimization */
+    janet_bytecode_movopt(def);
+    janet_bytecode_remove_noops(def);
+
     return def;
 }
 
 /* Initialize a compiler */
-static void janetc_init(JanetCompiler *c, JanetTable *env, const uint8_t *where) {
+static void janetc_init(JanetCompiler *c, JanetTable *env, const uint8_t *where, JanetArray *lints) {
     c->scope = NULL;
     c->buffer = NULL;
     c->mapbuffer = NULL;
@@ -804,6 +1017,7 @@ static void janetc_init(JanetCompiler *c, JanetTable *env, const uint8_t *where)
     c->source = where;
     c->current_mapping.line = -1;
     c->current_mapping.column = -1;
+    c->lints = lints;
     /* Init result */
     c->result.error = NULL;
     c->result.status = JANET_COMPILE_OK;
@@ -821,12 +1035,13 @@ static void janetc_deinit(JanetCompiler *c) {
 }
 
 /* Compile a form. */
-JanetCompileResult janet_compile(Janet source, JanetTable *env, const uint8_t *where) {
+JanetCompileResult janet_compile_lint(Janet source,
+                                      JanetTable *env, const uint8_t *where, JanetArray *lints) {
     JanetCompiler c;
     JanetScope rootscope;
     JanetFopts fopts;
 
-    janetc_init(&c, env, where);
+    janetc_init(&c, env, where, lints);
 
     /* Push a function scope */
     janetc_scope(&rootscope, &c, JANET_SCOPE_FUNCTION | JANET_SCOPE_TOP, "root");
@@ -854,19 +1069,40 @@ JanetCompileResult janet_compile(Janet source, JanetTable *env, const uint8_t *w
     return c.result;
 }
 
+JanetCompileResult janet_compile(Janet source, JanetTable *env, const uint8_t *where) {
+    return janet_compile_lint(source, env, where, NULL);
+}
+
 /* C Function for compiling */
-static Janet cfun(int32_t argc, Janet *argv) {
-    janet_arity(argc, 1, 3);
-    JanetTable *env = argc > 1 ? janet_gettable(argv, 1) : janet_vm_fiber->env;
+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_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);
+    if (argc >= 3) {
+        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);
+        }
     }
-    JanetCompileResult res = janet_compile(argv[0], env, source);
+    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));
     } else {
@@ -885,18 +1121,10 @@ static Janet cfun(int32_t argc, Janet *argv) {
     }
 }
 
-static const JanetReg compile_cfuns[] = {
-    {
-        "compile", cfun,
-        JDOC("(compile ast &opt env source)\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.")
-    },
-    {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) 2020 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,6 +29,13 @@
 #include "regalloc.h"
 #endif
 
+/* Levels for compiler warnings */
+typedef enum {
+    JANET_C_LINT_RELAXED,
+    JANET_C_LINT_NORMAL,
+    JANET_C_LINT_STRICT
+} JanetCompileLintLevel;
+
 /* Tags for some functions for the prepared inliner */
 #define JANET_FUN_DEBUG 1
 #define JANET_FUN_ERROR 2
@@ -62,6 +69,7 @@
 #define JANET_FUN_REMAINDER 30
 #define JANET_FUN_CMP 31
 #define JANET_FUN_CANCEL 32
+#define JANET_FUN_DIVIDE_FLOOR 33
 
 /* Compiler typedefs */
 typedef struct JanetCompiler JanetCompiler;
@@ -78,10 +86,10 @@ typedef struct JanetSpecial JanetSpecial;
 #define JANET_SLOT_MUTABLE 0x40000
 #define JANET_SLOT_REF 0x80000
 #define JANET_SLOT_RETURNED 0x100000
-/* Needed for handling single element arrays as global vars. */
-
-/* Used for unquote-splicing */
-#define JANET_SLOT_SPLICED 0x200000
+#define JANET_SLOT_DEP_NOTE 0x200000
+#define JANET_SLOT_DEP_WARN 0x400000
+#define JANET_SLOT_DEP_ERROR 0x800000
+#define JANET_SLOT_SPLICED 0x1000000
 
 #define JANET_SLOTTYPE_ANY 0xFFFF
 
@@ -104,13 +112,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 */
@@ -126,7 +142,7 @@ struct JanetScope {
     /* FuncDefs */
     JanetFuncDef **defs;
 
-    /* Regsiter allocator */
+    /* Register allocator */
     JanetcRegisterAllocator ra;
 
     /* Upvalue allocator */
@@ -135,7 +151,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;
@@ -164,11 +180,15 @@ struct JanetCompiler {
 
     /* Prevent unbounded recursion */
     int recursion_guard;
+
+    /* Collect linting results */
+    JanetArray *lints;
 };
 
 #define JANET_FOPTS_TAIL 0x10000
 #define JANET_FOPTS_HINT 0x20000
 #define JANET_FOPTS_DROP 0x40000
+#define JANET_FOPTS_ACCEPT_SPLICE 0x80000
 
 /* Options for compiling a single form */
 struct JanetFopts {
@@ -217,7 +237,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 */
@@ -230,6 +250,9 @@ JanetSlot janetc_return(JanetCompiler *c, JanetSlot s);
 void janetc_error(JanetCompiler *c, const uint8_t *m);
 void janetc_cerror(JanetCompiler *c, const char *m);
 
+/* Linting */
+void janetc_lintf(JanetCompiler *C, JanetCompileLintLevel level, const char *format, ...);
+
 /* Dispatch to correct form compiler */
 JanetSlot janetc_value(JanetFopts opts, Janet x);
 
@@ -245,4 +268,8 @@ JanetSlot janetc_cslot(Janet x);
 /* Search for a symbol */
 JanetSlot janetc_resolve(JanetCompiler *c, const uint8_t *sym);
 
+/* Bytecode optimization */
+void janet_bytecode_movopt(JanetFuncDef *def);
+void janet_bytecode_remove_noops(JanetFuncDef *def);
+
 #endif

src/core/debug.c

@@ -1,5 +1,5 @@
 /*
-* Copyright (c) 2020 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());
@@ -265,6 +314,7 @@ static Janet doframe(JanetStackFrame *frame) {
     if (frame->func && frame->pc) {
         Janet *stack = (Janet *)frame + JANET_FRAME_SIZE;
         JanetArray *slots;
+        janet_assert(def != NULL, "def != NULL");
         off = (int32_t)(frame->pc - def->bytecode);
         janet_table_put(t, janet_ckeywordv("pc"), janet_wrap_integer(off));
         if (def->sourcemap) {
@@ -280,11 +330,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 +385,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 +411,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 +423,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) 2020 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) 2020 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) 2020 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,9 +26,10 @@
 #define JANET_FEATURES_H_defined
 
 #if defined(__NetBSD__) || defined(__APPLE__) || defined(__OpenBSD__) \
-    || defined(__bsdi__) || defined(__DragonFly__)
+    || defined(__bsdi__) || defined(__DragonFly__) || defined(__FreeBSD__)
 /* Use BSD source on any BSD systems, include OSX */
 # define _BSD_SOURCE
+# define _POSIX_C_SOURCE 200809L
 #else
 /* Use POSIX feature flags */
 # ifndef _POSIX_C_SOURCE
@@ -36,13 +37,31 @@
 # endif
 #endif
 
+#if defined(__APPLE__)
+#define _DARWIN_C_SOURCE
+#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 inet_pton and InitializeSRWLock */
+#ifdef __MINGW32__
+#define _WIN32_WINNT _WIN32_WINNT_VISTA
+#endif
+
+/* 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.
@@ -52,4 +71,9 @@
 #define _NETBSD_SOURCE
 #endif
 
+/* Needed for several things when building with -std=c99. */
+#if !__BSD_VISIBLE && (defined(__DragonFly__) || defined(__FreeBSD__))
+#define __BSD_VISIBLE 1
+#endif
+
 #endif

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
@@ -39,8 +39,8 @@ static void fiber_reset(JanetFiber *fiber) {
     fiber->env = NULL;
     fiber->last_value = janet_wrap_nil();
 #ifdef JANET_EV
-    fiber->waiting = NULL;
     fiber->sched_id = 0;
+    fiber->waiting = NULL;
     fiber->supervisor_channel = NULL;
 #endif
     janet_fiber_set_status(fiber, JANET_STATUS_NEW);
@@ -53,11 +53,11 @@ static JanetFiber *fiber_alloc(int32_t capacity) {
         capacity = 32;
     }
     fiber->capacity = capacity;
-    data = malloc(sizeof(Janet) * (size_t) capacity);
+    data = janet_malloc(sizeof(Janet) * (size_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;
 }
@@ -81,10 +81,10 @@ JanetFiber *janet_fiber_reset(JanetFiber *fiber, JanetFunction *callee, int32_t
         }
         fiber->stacktop = newstacktop;
     }
+    /* Don't panic on failure since we use this to implement janet_pcall */
     if (janet_fiber_funcframe(fiber, callee)) return NULL;
     janet_fiber_frame(fiber)->flags |= JANET_STACKFRAME_ENTRANCE;
 #ifdef JANET_EV
-    fiber->waiting = NULL;
     fiber->supervisor_channel = NULL;
 #endif
     return fiber;
@@ -100,12 +100,12 @@ JanetFiber *janet_fiber(JanetFunction *callee, int32_t capacity, int32_t argc, c
 static void janet_fiber_refresh_memory(JanetFiber *fiber) {
     int32_t n = fiber->capacity;
     if (n) {
-        Janet *newData = malloc(sizeof(Janet) * n);
+        Janet *newData = janet_malloc(sizeof(Janet) * n);
         if (NULL == newData) {
             JANET_OUT_OF_MEMORY;
         }
         memcpy(newData, fiber->data, fiber->capacity * sizeof(Janet));
-        free(fiber->data);
+        janet_free(fiber->data);
         fiber->data = newData;
     }
 }
@@ -115,13 +115,13 @@ static void janet_fiber_refresh_memory(JanetFiber *fiber) {
 void janet_fiber_setcapacity(JanetFiber *fiber, int32_t n) {
     int32_t old_size = fiber->capacity;
     int32_t diff = n - old_size;
-    Janet *newData = realloc(fiber->data, sizeof(Janet) * n);
+    Janet *newData = janet_realloc(fiber->data, sizeof(Janet) * n);
     if (NULL == newData) {
         JANET_OUT_OF_MEMORY;
     }
     fiber->data = newData;
     fiber->capacity = n;
-    janet_vm_next_collection += sizeof(Janet) * diff;
+    janet_vm.next_collection += sizeof(Janet) * diff;
 }
 
 /* Grow fiber if needed */
@@ -254,8 +254,8 @@ static void janet_env_detach(JanetFuncEnv *env) {
         janet_env_valid(env);
         int32_t len = env->length;
         size_t s = sizeof(Janet) * (size_t) len;
-        Janet *vmem = malloc(s);
-        janet_vm_next_collection += (uint32_t) s;
+        Janet *vmem = janet_malloc(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,15 +476,44 @@ static Janet cfun_fiber_setenv(int32_t argc, Janet *argv) {
     return argv[0];
 }
 
-static Janet cfun_fiber_new(int32_t argc, Janet *argv) {
-    janet_arity(argc, 1, 2);
+JANET_CORE_FN(cfun_fiber_new,
+              "(fiber/new func &opt sigmask env)",
+              "Create a new fiber with function body func. Can optionally "
+              "take a set of signals `sigmask` to capture from child fibers, "
+              "and an environment table `env`. 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"
+              "* :w - block await signals (user9)\n"
+              "* :r - block interrupt signals (user8)\n"
+              "* :0-9 - block a specific user signal\n\n"
+              "The sigmask argument also can take environment flags. If any mutually "
+              "exclusive flags are present, the last flag takes precedence.\n\n"
+              "* :i - inherit the environment from the current fiber\n"
+              "* :p - the environment table's prototype is the current environment table") {
+    janet_arity(argc, 1, 3);
     JanetFunction *func = janet_getfunction(argv, 0);
     JanetFiber *fiber;
     if (func->def->min_arity > 1) {
         janet_panicf("fiber function must accept 0 or 1 arguments");
     }
     fiber = janet_fiber(func, 64, func->def->min_arity, NULL);
-    if (argc == 2) {
+    janet_assert(fiber != NULL, "bad fiber arity check");
+    if (argc == 3 && !janet_checktype(argv[2], JANET_NIL)) {
+        fiber->env = janet_gettable(argv, 2);
+    }
+    if (argc >= 2) {
         int32_t i;
         JanetByteView view = janet_getbytes(argv, 1);
         fiber->flags = JANET_FIBER_RESUME_NO_USEVAL | JANET_FIBER_RESUME_NO_SKIP;
@@ -489,7 +524,7 @@ static Janet cfun_fiber_new(int32_t argc, Janet *argv) {
             } else {
                 switch (view.bytes[i]) {
                     default:
-                        janet_panicf("invalid flag %c, expected a, t, d, e, u, y, i, or p", view.bytes[i]);
+                        janet_panicf("invalid flag %c, expected a, t, d, e, u, y, w, r, i, or p", view.bytes[i]);
                         break;
                     case 'a':
                         fiber->flags |=
@@ -519,18 +554,24 @@ static Janet cfun_fiber_new(int32_t argc, Janet *argv) {
                     case 'y':
                         fiber->flags |= JANET_FIBER_MASK_YIELD;
                         break;
+                    case 'w':
+                        fiber->flags |= JANET_FIBER_MASK_USER9;
+                        break;
+                    case 'r':
+                        fiber->flags |= JANET_FIBER_MASK_USER8;
+                        break;
                     case 'i':
-                        if (!janet_vm_fiber->env) {
-                            janet_vm_fiber->env = janet_table(0);
+                        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 +580,55 @@ 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-7) - the fiber is suspended by a user signal\n"
+              "* :interrupted - the fiber was interrupted\n"
+              "* :suspended - the fiber is waiting to be resumed by the scheduler\n"
+              "* :alive - the fiber is currently running and cannot be resumed\n"
+              "* :new - the fiber has just been created and not yet run") {
     janet_fixarity(argc, 1);
     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,9 +639,7 @@ 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_fixarity(argc, 1);
-    JanetFiber *fiber = janet_getfiber(argv, 0);
+int janet_fiber_can_resume(JanetFiber *fiber) {
     JanetFiberStatus s = janet_fiber_status(fiber);
     int isFinished = s == JANET_STATUS_DEAD ||
                      s == JANET_STATUS_ERROR ||
@@ -586,104 +648,39 @@ static Janet cfun_fiber_can_resume(int32_t argc, Janet *argv) {
                      s == JANET_STATUS_USER2 ||
                      s == JANET_STATUS_USER3 ||
                      s == JANET_STATUS_USER4;
-    return janet_wrap_boolean(!isFinished);
+    return !isFinished;
 }
 
-static Janet cfun_fiber_last_value(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);
+    return janet_wrap_boolean(janet_fiber_can_resume(fiber));
+}
+
+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) 2020 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) 2020 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) {
@@ -271,6 +268,9 @@ recur:
     if (fiber->supervisor_channel) {
         janet_mark_abstract(fiber->supervisor_channel);
     }
+    if (fiber->waiting) {
+        janet_mark_abstract(fiber->waiting);
+    }
 #endif
 
     /* Explicit tail recursion */
@@ -290,13 +290,13 @@ static void janet_deinit_block(JanetGCObject *mem) {
             janet_symbol_deinit(((JanetStringHead *) mem)->data);
             break;
         case JANET_MEMORY_ARRAY:
-            free(((JanetArray *) mem)->data);
+            janet_free(((JanetArray *) mem)->data);
             break;
         case JANET_MEMORY_TABLE:
-            free(((JanetTable *) mem)->data);
+            janet_free(((JanetTable *) mem)->data);
             break;
         case JANET_MEMORY_FIBER:
-            free(((JanetFiber *)mem)->data);
+            janet_free(((JanetFiber *)mem)->data);
             break;
         case JANET_MEMORY_BUFFER:
             janet_buffer_deinit((JanetBuffer *) mem);
@@ -311,18 +311,19 @@ static void janet_deinit_block(JanetGCObject *mem) {
         case JANET_MEMORY_FUNCENV: {
             JanetFuncEnv *env = (JanetFuncEnv *)mem;
             if (0 == env->offset)
-                free(env->as.values);
+                janet_free(env->as.values);
         }
         break;
         case JANET_MEMORY_FUNCDEF: {
             JanetFuncDef *def = (JanetFuncDef *)mem;
             /* TODO - get this all with one alloc and one free */
-            free(def->defs);
-            free(def->environments);
-            free(def->constants);
-            free(def->bytecode);
-            free(def->sourcemap);
-            free(def->closure_bitset);
+            janet_free(def->defs);
+            janet_free(def->environments);
+            janet_free(def->constants);
+            janet_free(def->bytecode);
+            janet_free(def->sourcemap);
+            janet_free(def->closure_bitset);
+            janet_free(def->symbolmap);
         }
         break;
     }
@@ -332,25 +333,62 @@ 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;
             }
-            free(current);
+            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");
+                    }
+                    /* Free memory */
+                    janet_free(janet_abstract_head(abst));
+                }
+
+                /* 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--;
+            }
+
+            /* Reset for next sweep */
+            items[i].value = janet_wrap_false();
+        }
+    }
+#endif
 }
 
 /* Allocate some memory that is tracked for garbage collection */
@@ -358,8 +396,8 @@ 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");
-    mem = malloc(size);
+    janet_assert(NULL != janet_vm.cache, "please initialize janet before use");
+    mem = janet_malloc(size);
 
     /* Check for bad malloc */
     if (NULL == mem) {
@@ -370,10 +408,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;
 }
@@ -382,15 +420,15 @@ static void free_one_scratch(JanetScratch *s) {
     if (NULL != s->finalize) {
         s->finalize((char *) s->mem);
     }
-    free(s);
+    janet_free(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 +439,31 @@ 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;
+    janet_vm.gc_mark_phase = 1;
     /* 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_vm.gc_mark_phase = 0;
     janet_sweep();
-    janet_vm_next_collection = 0;
+    janet_vm.next_collection = 0;
     janet_free_all_scratch();
 }
 
@@ -431,17 +471,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 = 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 +502,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 +515,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,44 +530,61 @@ 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;
-        free(current);
+        JanetGCObject *next = current->data.next;
+        janet_free(current);
         current = next;
     }
-    janet_vm_blocks = NULL;
+    janet_vm.blocks = NULL;
     janet_free_all_scratch();
-    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 */
+/* Scratch memory API
+ * Scratch memory allocations do not need to be free (but optionally can be), and will be automatically cleaned
+ * up in the next call to janet_collect. */
 
 void *janet_smalloc(size_t size) {
-    JanetScratch *s = malloc(sizeof(JanetScratch) + size);
+    JanetScratch *s = janet_malloc(sizeof(JanetScratch) + size);
     if (NULL == s) {
         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 **) 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 +601,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) {
-                JanetScratch *news = realloc(s, size + sizeof(JanetScratch));
+    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 +625,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) 2020 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
@@ -118,10 +118,9 @@ int64_t janet_unwrap_s64(Janet x) {
         default:
             break;
         case JANET_NUMBER : {
-            double dbl = janet_unwrap_number(x);
-            if (fabs(dbl) <=  MAX_INT_IN_DBL)
-                return (int64_t)dbl;
-            break;
+            double d = janet_unwrap_number(x);
+            if (!janet_checkint64range(d)) break;
+            return (int64_t) d;
         }
         case JANET_STRING: {
             int64_t value;
@@ -138,7 +137,7 @@ int64_t janet_unwrap_s64(Janet x) {
             break;
         }
     }
-    janet_panicf("bad s64 initializer: %t", x);
+    janet_panicf("can not convert %t %q to 64 bit signed integer", x, x);
     return 0;
 }
 
@@ -147,12 +146,9 @@ uint64_t janet_unwrap_u64(Janet x) {
         default:
             break;
         case JANET_NUMBER : {
-            double dbl = janet_unwrap_number(x);
-            /* Allow negative values to be cast to "wrap around".
-             * This let's addition and subtraction work as expected. */
-            if (fabs(dbl) <=  MAX_INT_IN_DBL)
-                return (uint64_t)dbl;
-            break;
+            double d = janet_unwrap_number(x);
+            if (!janet_checkuint64range(d)) break;
+            return (uint64_t) d;
         }
         case JANET_STRING: {
             uint64_t value;
@@ -169,7 +165,7 @@ uint64_t janet_unwrap_u64(Janet x) {
             break;
         }
     }
-    janet_panicf("bad u64 initializer: %t", x);
+    janet_panicf("can not convert %t %q to a 64 bit unsigned integer", x, x);
     return 0;
 }
 
@@ -193,16 +189,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
@@ -217,8 +303,8 @@ static int compare_double_double(double x, double y) {
 
 static int compare_int64_double(int64_t x, double y) {
     if (isnan(y)) {
-        return 0; // clojure and python do this
-    } else if ((y > (- ((double) MAX_INT_IN_DBL))) && (y < ((double) MAX_INT_IN_DBL))) {
+        return 0;
+    } else if ((y > JANET_INTMIN_DOUBLE) && (y < JANET_INTMAX_DOUBLE)) {
         double dx = (double) x;
         return compare_double_double(dx, y);
     } else if (y > ((double) INT64_MAX)) {
@@ -233,10 +319,10 @@ static int compare_int64_double(int64_t x, double y) {
 
 static int compare_uint64_double(uint64_t x, double y) {
     if (isnan(y)) {
-        return 0; // clojure and python do this
+        return 0;
     } else if (y < 0) {
         return 1;
-    } else if ((y >= 0) && (y < ((double) MAX_INT_IN_DBL))) {
+    } else if ((y >= 0) && (y < JANET_INTMAX_DOUBLE)) {
         double dx = (double) x;
         return compare_double_double(dx, y);
     } else if (y > ((double) UINT64_MAX)) {
@@ -249,8 +335,9 @@ static int compare_uint64_double(uint64_t x, double y) {
 
 static Janet cfun_it_s64_compare(int32_t argc, Janet *argv) {
     janet_fixarity(argc, 2);
-    if (janet_is_int(argv[0]) != JANET_INT_S64)
+    if (janet_is_int(argv[0]) != JANET_INT_S64) {
         janet_panic("compare method requires int/s64 as first argument");
+    }
     int64_t x = janet_unwrap_s64(argv[0]);
     switch (janet_type(argv[1])) {
         default:
@@ -265,7 +352,6 @@ static Janet cfun_it_s64_compare(int32_t argc, Janet *argv) {
                 int64_t y = *(int64_t *)abst;
                 return janet_wrap_number((x < y) ? -1 : (x > y ? 1 : 0));
             } else if (janet_abstract_type(abst) == &janet_u64_type) {
-                // comparing signed to unsigned -- be careful!
                 uint64_t y = *(uint64_t *)abst;
                 if (x < 0) {
                     return janet_wrap_number(-1);
@@ -284,8 +370,9 @@ static Janet cfun_it_s64_compare(int32_t argc, Janet *argv) {
 
 static Janet cfun_it_u64_compare(int32_t argc, Janet *argv) {
     janet_fixarity(argc, 2);
-    if (janet_is_int(argv[0]) != JANET_INT_U64)  // is this needed?
+    if (janet_is_int(argv[0]) != JANET_INT_U64) {
         janet_panic("compare method requires int/u64 as first argument");
+    }
     uint64_t x = janet_unwrap_u64(argv[0]);
     switch (janet_type(argv[1])) {
         default:
@@ -300,7 +387,6 @@ static Janet cfun_it_u64_compare(int32_t argc, Janet *argv) {
                 uint64_t y = *(uint64_t *)abst;
                 return janet_wrap_number((x < y) ? -1 : (x > y ? 1 : 0));
             } else if (janet_abstract_type(abst) == &janet_s64_type) {
-                // comparing unsigned to signed -- be careful!
                 int64_t y = *(int64_t *)abst;
                 if (y < 0) {
                     return janet_wrap_number(1);
@@ -317,25 +403,52 @@ 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); \
 } \
 
 #define OPMETHODINVERT(T, type, name, oper) \
-static Janet cfun_it_##type##_##name(int32_t argc, Janet *argv) { \
+static Janet cfun_it_##type##_##name##i(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); \
 } \
 
+#define UNARYMETHOD(T, type, name, oper) \
+static Janet cfun_it_##type##_##name(int32_t argc, Janet *argv) { \
+    janet_fixarity(argc, 1); \
+    T *box = janet_abstract(&janet_##type##_type, sizeof(T)); \
+    *box = oper(janet_unwrap_##type(argv[0])); \
+    return janet_wrap_abstract(box); \
+} \
+
+#define DIVZERO(name) DIVZERO_##name
+#define DIVZERO_div janet_panic("division by zero")
+#define DIVZERO_rem janet_panic("division by zero")
+#define DIVZERO_mod return janet_wrap_abstract(box)
+
 #define DIVMETHOD(T, type, name, oper) \
 static Janet cfun_it_##type##_##name(int32_t argc, Janet *argv) { \
     janet_arity(argc, 2, -1);                       \
@@ -343,19 +456,19 @@ static Janet cfun_it_##type##_##name(int32_t argc, Janet *argv) { \
     *box = janet_unwrap_##type(argv[0]); \
     for (int32_t i = 1; i < argc; i++) { \
       T value = janet_unwrap_##type(argv[i]); \
-      if (value == 0) janet_panic("division by zero"); \
+      if (value == 0) DIVZERO(name); \
       *box oper##= value; \
     } \
     return janet_wrap_abstract(box); \
 } \
 
 #define DIVMETHODINVERT(T, type, name, oper) \
-static Janet cfun_it_##type##_##name(int32_t argc, Janet *argv) { \
+static Janet cfun_it_##type##_##name##i(int32_t argc, Janet *argv) { \
     janet_fixarity(argc, 2);                       \
     T *box = janet_abstract(&janet_##type##_type, sizeof(T)); \
     *box = janet_unwrap_##type(argv[1]); \
     T value = janet_unwrap_##type(argv[0]); \
-    if (value == 0) janet_panic("division by zero"); \
+    if (value == 0) DIVZERO(name); \
     *box oper##= value; \
     return janet_wrap_abstract(box); \
 } \
@@ -367,7 +480,7 @@ static Janet cfun_it_##type##_##name(int32_t argc, Janet *argv) { \
     *box = janet_unwrap_##type(argv[0]); \
     for (int32_t i = 1; i < argc; i++) { \
       T value = janet_unwrap_##type(argv[i]); \
-      if (value == 0) janet_panic("division by zero"); \
+      if (value == 0) DIVZERO(name); \
       if ((value == -1) && (*box == INT64_MIN)) janet_panic("INT64_MIN divided by -1"); \
       *box oper##= value; \
     } \
@@ -375,51 +488,95 @@ static Janet cfun_it_##type##_##name(int32_t argc, Janet *argv) { \
 } \
 
 #define DIVMETHODINVERT_SIGNED(T, type, name, oper) \
-static Janet cfun_it_##type##_##name(int32_t argc, Janet *argv) { \
+static Janet cfun_it_##type##_##name##i(int32_t argc, Janet *argv) { \
     janet_fixarity(argc, 2);                       \
     T *box = janet_abstract(&janet_##type##_type, sizeof(T)); \
     *box = janet_unwrap_##type(argv[1]); \
     T value = janet_unwrap_##type(argv[0]); \
-    if (value == 0) janet_panic("division by zero"); \
+    if (value == 0) DIVZERO(name); \
     if ((value == -1) && (*box == INT64_MIN)) janet_panic("INT64_MIN divided by -1"); \
     *box oper##= value; \
     return janet_wrap_abstract(box); \
 } \
 
+static Janet cfun_it_s64_divf(int32_t argc, Janet *argv) {
+    janet_fixarity(argc, 2);
+    int64_t *box = janet_abstract(&janet_s64_type, sizeof(int64_t));
+    int64_t op1 = janet_unwrap_s64(argv[0]);
+    int64_t op2 = janet_unwrap_s64(argv[1]);
+    if (op2 == 0) janet_panic("division by zero");
+    int64_t x = op1 / op2;
+    *box = x - (((op1 ^ op2) < 0) && (x * op2 != op1));
+    return janet_wrap_abstract(box);
+}
+
+static Janet cfun_it_s64_divfi(int32_t argc, Janet *argv) {
+    janet_fixarity(argc, 2);
+    int64_t *box = janet_abstract(&janet_s64_type, sizeof(int64_t));
+    int64_t op2 = janet_unwrap_s64(argv[0]);
+    int64_t op1 = janet_unwrap_s64(argv[1]);
+    if (op2 == 0) janet_panic("division by zero");
+    int64_t x = op1 / op2;
+    *box = x - (((op1 ^ op2) < 0) && (x * op2 != op1));
+    return janet_wrap_abstract(box);
+}
+
 static Janet cfun_it_s64_mod(int32_t argc, Janet *argv) {
     janet_fixarity(argc, 2);
     int64_t *box = janet_abstract(&janet_s64_type, sizeof(int64_t));
     int64_t op1 = janet_unwrap_s64(argv[0]);
     int64_t op2 = janet_unwrap_s64(argv[1]);
-    int64_t x = op1 % op2;
-    *box = (op1 > 0)
-           ? ((op2 > 0) ? x : (0 == x ? x : x + op2))
-           : ((op2 > 0) ? (0 == x ? x : x + op2) : x);
+    if (op2 == 0) {
+        *box = op1;
+    } else {
+        int64_t x = op1 % op2;
+        *box = (((op1 ^ op2) < 0) && (x != 0)) ? x + op2 : x;
+    }
+    return janet_wrap_abstract(box);
+}
+
+static Janet cfun_it_s64_modi(int32_t argc, Janet *argv) {
+    janet_fixarity(argc, 2);
+    int64_t *box = janet_abstract(&janet_s64_type, sizeof(int64_t));
+    int64_t op2 = janet_unwrap_s64(argv[0]);
+    int64_t op1 = janet_unwrap_s64(argv[1]);
+    if (op2 == 0) {
+        *box = op1;
+    } else {
+        int64_t x = op1 % op2;
+        *box = (((op1 ^ op2) < 0) && (x != 0)) ? x + op2 : x;
+    }
     return janet_wrap_abstract(box);
 }
 
 OPMETHOD(int64_t, s64, add, +)
 OPMETHOD(int64_t, s64, sub, -)
-OPMETHODINVERT(int64_t, s64, subi, -)
+OPMETHODINVERT(int64_t, s64, sub, -)
 OPMETHOD(int64_t, s64, mul, *)
 DIVMETHOD_SIGNED(int64_t, s64, div, /)
 DIVMETHOD_SIGNED(int64_t, s64, rem, %)
-DIVMETHODINVERT_SIGNED(int64_t, s64, divi, /)
+DIVMETHODINVERT_SIGNED(int64_t, s64, div, /)
+DIVMETHODINVERT_SIGNED(int64_t, s64, rem, %)
 OPMETHOD(int64_t, s64, and, &)
 OPMETHOD(int64_t, s64, or, |)
 OPMETHOD(int64_t, s64, xor, ^)
+UNARYMETHOD(int64_t, s64, not, ~)
 OPMETHOD(int64_t, s64, lshift, <<)
 OPMETHOD(int64_t, s64, rshift, >>)
 OPMETHOD(uint64_t, u64, add, +)
 OPMETHOD(uint64_t, u64, sub, -)
-OPMETHODINVERT(uint64_t, u64, subi, -)
+OPMETHODINVERT(uint64_t, u64, sub, -)
 OPMETHOD(uint64_t, u64, mul, *)
 DIVMETHOD(uint64_t, u64, div, /)
+DIVMETHOD(uint64_t, u64, rem, %)
 DIVMETHOD(uint64_t, u64, mod, %)
-DIVMETHODINVERT(uint64_t, u64, divi, /)
+DIVMETHODINVERT(uint64_t, u64, div, /)
+DIVMETHODINVERT(uint64_t, u64, rem, %)
+DIVMETHODINVERT(uint64_t, u64, mod, %)
 OPMETHOD(uint64_t, u64, and, &)
 OPMETHOD(uint64_t, u64, or, |)
 OPMETHOD(uint64_t, u64, xor, ^)
+UNARYMETHOD(uint64_t, u64, not, ~)
 OPMETHOD(uint64_t, u64, lshift, <<)
 OPMETHOD(uint64_t, u64, rshift, >>)
 
@@ -428,7 +585,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},
@@ -438,20 +594,22 @@ static JanetMethod it_s64_methods[] = {
     {"r*", cfun_it_s64_mul},
     {"/", cfun_it_s64_div},
     {"r/", cfun_it_s64_divi},
+    {"div", cfun_it_s64_divf},
+    {"rdiv", cfun_it_s64_divfi},
     {"mod", cfun_it_s64_mod},
-    {"rmod", cfun_it_s64_mod},
+    {"rmod", cfun_it_s64_modi},
     {"%", cfun_it_s64_rem},
-    {"r%", cfun_it_s64_rem},
+    {"r%", cfun_it_s64_remi},
     {"&", cfun_it_s64_and},
     {"r&", cfun_it_s64_and},
     {"|", cfun_it_s64_or},
     {"r|", cfun_it_s64_or},
     {"^", cfun_it_s64_xor},
     {"r^", cfun_it_s64_xor},
+    {"~", cfun_it_s64_not},
     {"<<", cfun_it_s64_lshift},
     {">>", cfun_it_s64_rshift},
     {"compare", cfun_it_s64_compare},
-
     {NULL, NULL}
 };
 
@@ -464,20 +622,22 @@ static JanetMethod it_u64_methods[] = {
     {"r*", cfun_it_u64_mul},
     {"/", cfun_it_u64_div},
     {"r/", cfun_it_u64_divi},
+    {"div", cfun_it_u64_div},
+    {"rdiv", cfun_it_u64_divi},
     {"mod", cfun_it_u64_mod},
-    {"rmod", cfun_it_u64_mod},
-    {"%", cfun_it_u64_mod},
-    {"r%", cfun_it_u64_mod},
+    {"rmod", cfun_it_u64_modi},
+    {"%", cfun_it_u64_rem},
+    {"r%", cfun_it_u64_remi},
     {"&", cfun_it_u64_and},
     {"r&", cfun_it_u64_and},
     {"|", cfun_it_u64_or},
     {"r|", cfun_it_u64_or},
     {"^", cfun_it_u64_xor},
     {"r^", cfun_it_u64_xor},
+    {"~", cfun_it_u64_not},
     {"<<", cfun_it_u64_lshift},
     {">>", cfun_it_u64_rshift},
     {"compare", cfun_it_u64_compare},
-
     {NULL, NULL}
 };
 
@@ -505,23 +665,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
@@ -69,12 +69,15 @@ static int32_t checkflags(const uint8_t *str) {
             break;
         case 'w':
             flags |= JANET_FILE_WRITE;
+            janet_sandbox_assert(JANET_SANDBOX_FS_WRITE);
             break;
         case 'a':
             flags |= JANET_FILE_APPEND;
+            janet_sandbox_assert(JANET_SANDBOX_FS);
             break;
         case 'r':
             flags |= JANET_FILE_READ;
+            janet_sandbox_assert(JANET_SANDBOX_FS_READ);
             break;
     }
     for (i = 1; i < len; i++) {
@@ -84,6 +87,7 @@ static int32_t checkflags(const uint8_t *str) {
                 break;
             case '+':
                 if (flags & JANET_FILE_UPDATE) return -1;
+                janet_sandbox_assert(JANET_SANDBOX_FS_WRITE);
                 flags |= JANET_FILE_UPDATE;
                 break;
             case 'b':
@@ -112,38 +116,11 @@ 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.") {
+    janet_sandbox_assert(JANET_SANDBOX_FS_TEMP);
     (void)argv;
     janet_fixarity(argc, 0);
     // XXX use mkostemp when we can to avoid CLOEXEC race.
@@ -153,8 +130,22 @@ 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_arity(argc, 1, 2);
+JANET_CORE_FN(cfun_io_fopen,
+              "(file/open path &opt mode buffer-size)",
+              "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\n\n"
+              "See fopen (<stdio.h>, C99) for further details.") {
+    janet_arity(argc, 1, 3);
     const uint8_t *fname = janet_getstring(argv, 0);
     const uint8_t *fmode;
     int32_t flags;
@@ -163,9 +154,19 @@ static Janet cfun_io_fopen(int32_t argc, Janet *argv) {
         flags = checkflags(fmode);
     } else {
         fmode = (const uint8_t *)"r";
+        janet_sandbox_assert(JANET_SANDBOX_FS_READ);
         flags = JANET_FILE_READ;
     }
     FILE *f = fopen((const char *)fname, (const char *)fmode);
+    if (f != NULL) {
+        size_t bufsize = janet_optsize(argv, argc, 2, BUFSIZ);
+        if (bufsize != BUFSIZ) {
+            int result = setvbuf(f, NULL, bufsize ? _IOFBF : _IONBF, bufsize);
+            if (result) {
+                janet_panic("failed to set buffer size for file");
+            }
+        }
+    }
     return f ? janet_makefile(f, flags)
            : (flags & JANET_FILE_NONIL) ? (janet_panicf("failed to open file %s: %s", fname, strerror(errno)), janet_wrap_nil())
            : janet_wrap_nil();
@@ -184,7 +185,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 +234,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 +259,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 +287,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 +304,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)
@@ -344,11 +358,24 @@ static Janet cfun_io_fseek(int32_t argc, Janet *argv) {
     return argv[0];
 }
 
+JANET_CORE_FN(cfun_io_ftell,
+              "(file/tell f)",
+              "Get the current value of the file position for file `f`.") {
+    janet_fixarity(argc, 1);
+    JanetFile *iof = janet_getabstract(argv, 0, &janet_file_type);
+    if (iof->flags & JANET_FILE_CLOSED)
+        janet_panic("file is closed");
+    long pos = ftell(iof->file);
+    if (pos == -1) janet_panic("error getting position in file");
+    return janet_wrap_number((double)pos);
+}
+
 static JanetMethod io_file_methods[] = {
     {"close", cfun_io_fclose},
     {"flush", cfun_io_fflush},
     {"read", cfun_io_fread},
     {"seek", cfun_io_fseek},
+    {"tell", cfun_io_ftell},
     {"write", cfun_io_fwrite},
     {NULL, NULL}
 };
@@ -434,6 +461,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 +483,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;
         }
@@ -473,35 +514,53 @@ static Janet cfun_io_print_impl_x(int32_t argc, Janet *argv, int newline,
     return janet_wrap_nil();
 }
 
-
 static Janet cfun_io_print_impl(int32_t argc, Janet *argv,
                                 int newline, const char *name, FILE *dflt_file) {
     Janet x = janet_dyn(name);
     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 +579,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 +598,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;
         }
@@ -544,7 +617,7 @@ static Janet cfun_io_printf_impl_x(int32_t argc, Janet *argv, int newline,
     /* Clear buffer to make things easier for GC */
     buf->count = 0;
     buf->capacity = 0;
-    free(buf->data);
+    janet_free(buf->data);
     buf->data = NULL;
     return janet_wrap_nil();
 }
@@ -557,28 +630,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 +686,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 +726,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 +751,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 +775,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 +783,45 @@ 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_CORE_REG("file/tell", cfun_io_ftell),
+        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) 2020 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,12 @@ 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 */
+    LB_POINTER_BUFFER, /* 224 */
+#endif
 } LeadBytes;
 
 /* Helper to look inside an entry in an environment */
@@ -148,6 +154,10 @@ static void pushbytes(MarshalState *st, const uint8_t *bytes, int32_t len) {
     janet_buffer_push_bytes(st->buf, bytes, len);
 }
 
+static void pushpointer(MarshalState *st, const void *ptr) {
+    janet_buffer_push_bytes(st->buf, (const uint8_t *) &ptr, sizeof(ptr));
+}
+
 /* Marshal a size_t onto the buffer */
 static void push64(MarshalState *st, uint64_t x) {
     if (x <= 0xF0) {
@@ -236,6 +246,7 @@ static void marshal_one_def(MarshalState *st, JanetFuncDef *def, int flags) {
     }
     /* Add to lookup */
     janet_v_push(st->seen_defs, def);
+
     pushint(st, def->flags);
     pushint(st, def->slotcount);
     pushint(st, def->arity);
@@ -247,6 +258,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)
@@ -254,7 +267,15 @@ static void marshal_one_def(MarshalState *st, JanetFuncDef *def, int flags) {
 
     /* marshal constants */
     for (int32_t i = 0; i < def->constants_length; i++)
-        marshal_one(st, def->constants[i], flags);
+        marshal_one(st, def->constants[i], flags + 1);
+
+    /* 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 + 1);
+    }
 
     /* marshal the bytecode */
     janet_marshal_u32s(st, def->bytecode, def->bytecode_length);
@@ -265,7 +286,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 +346,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) {
@@ -341,6 +363,15 @@ void janet_marshal_int(JanetMarshalContext *ctx, int32_t value) {
     pushint(st, value);
 }
 
+/* Only use in unsafe - don't marshal pointers otherwise */
+void janet_marshal_ptr(JanetMarshalContext *ctx, const void *ptr) {
+    if (!(ctx->flags & JANET_MARSHAL_UNSAFE)) {
+        janet_panic("can only marshal pointers in unsafe mode");
+    }
+    MarshalState *st = (MarshalState *)(ctx->m_state);
+    pushpointer(st, ptr);
+}
+
 void janet_marshal_byte(JanetMarshalContext *ctx, uint8_t value) {
     MarshalState *st = (MarshalState *)(ctx->m_state);
     pushbyte(st, value);
@@ -357,26 +388,52 @@ void janet_marshal_janet(JanetMarshalContext *ctx, Janet x) {
     marshal_one(st, x, ctx->flags + 1);
 }
 
+#ifdef JANET_MARSHAL_DEBUG
+#define MARK_SEEN() \
+    do { if (st->maybe_cycles) { \
+        Janet _check = janet_table_get(&st->seen, x); \
+        if (!janet_checktype(_check, JANET_NIL)) janet_eprintf("double MARK_SEEN on %v\n", x); \
+        janet_eprintf("made reference %d (%t) to %v\n", st->nextid, x, x); \
+        janet_table_put(&st->seen, x, janet_wrap_integer(st->nextid++)); \
+    } } while (0)
+#else
+#define MARK_SEEN() \
+    do { if (st->maybe_cycles) { \
+        janet_table_put(&st->seen, x, janet_wrap_integer(st->nextid++)); \
+    } } while (0)
+#endif
+
 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++));
+    Janet x = janet_wrap_abstract(abstract);
+    MARK_SEEN();
 }
 
-#define MARK_SEEN() \
-    janet_table_put(&st->seen, x, janet_wrap_integer(st->nextid++))
-
 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);
         marshal_one(st, janet_csymbolv(at->name), flags + 1);
-        JanetMarshalContext context = {st, NULL, flags, NULL, at};
+        JanetMarshalContext context = {st, NULL, flags + 1, 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 +465,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);
@@ -475,6 +535,16 @@ static void marshal_one(MarshalState *st, Janet x, int flags) {
             JanetBuffer *buffer = janet_unwrap_buffer(x);
             /* Record reference */
             MARK_SEEN();
+#ifdef JANET_EV
+            if ((flags & JANET_MARSHAL_UNSAFE) &&
+                    (buffer->gc.flags & JANET_BUFFER_FLAG_NO_REALLOC)) {
+                pushbyte(st, LB_POINTER_BUFFER);
+                pushint(st, buffer->count);
+                pushint(st, buffer->capacity);
+                pushpointer(st, buffer->data);
+                return;
+            }
+#endif
             pushbyte(st, LB_BUFFER);
             pushint(st, buffer->count);
             pushbytes(st, buffer->data, buffer->count);
@@ -523,8 +593,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 +614,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);
@@ -568,8 +640,7 @@ static void marshal_one(MarshalState *st, Janet x, int flags) {
             if (!(flags & JANET_MARSHAL_UNSAFE)) goto no_registry;
             MARK_SEEN();
             pushbyte(st, LB_UNSAFE_POINTER);
-            void *ptr = janet_unwrap_pointer(x);
-            pushbytes(st, (uint8_t *) &ptr, sizeof(void *));
+            pushpointer(st, janet_unwrap_pointer(x));
             return;
         }
     no_registry:
@@ -591,6 +662,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);
@@ -675,9 +747,22 @@ static uint64_t read64(UnmarshalState *st, const uint8_t **atdata) {
     return ret;
 }
 
+#ifdef JANET_MARSHAL_DEBUG
+static void dump_reference_table(UnmarshalState *st) {
+    for (int32_t i = 0; i < janet_v_count(st->lookup); i++) {
+        janet_eprintf("  reference %d (%t) = %v\n", i, st->lookup[i], st->lookup[i]);
+    }
+}
+#endif
+
 /* Assert a janet type */
-static void janet_asserttype(Janet x, JanetType t) {
+static void janet_asserttype(Janet x, JanetType t, UnmarshalState *st) {
     if (!janet_checktype(x, t)) {
+#ifdef JANET_MARSHAL_DEBUG
+        dump_reference_table(st);
+#else
+        (void) st;
+#endif
         janet_panicf("expected type %T, got %v", 1 << t, x);
     }
 }
@@ -729,7 +814,7 @@ static const uint8_t *unmarshal_one_env(
             Janet fiberv;
             /* On stack variant */
             data = unmarshal_one(st, data, &fiberv, flags);
-            janet_asserttype(fiberv, JANET_FIBER);
+            janet_asserttype(fiberv, JANET_FIBER, st);
             env->as.fiber = janet_unwrap_fiber(fiberv);
             /* Negative offset indicates untrusted input */
             env->offset = -offset;
@@ -738,7 +823,7 @@ static const uint8_t *unmarshal_one_env(
             if (length == 0) {
                 janet_panic("invalid funcenv length");
             }
-            env->as.values = malloc(sizeof(Janet) * (size_t) length);
+            env->as.values = janet_malloc(sizeof(Janet) * (size_t) length);
             if (!env->as.values) {
                 JANET_OUT_OF_MEMORY;
             }
@@ -795,6 +880,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 +889,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,24 +905,26 @@ 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) {
             Janet x;
             data = unmarshal_one(st, data, &x, flags + 1);
-            janet_asserttype(x, JANET_STRING);
+            janet_asserttype(x, JANET_STRING, st);
             def->name = janet_unwrap_string(x);
         }
         if (def->flags & JANET_FUNCDEF_FLAG_HASSOURCE) {
             Janet x;
             data = unmarshal_one(st, data, &x, flags + 1);
-            janet_asserttype(x, JANET_STRING);
+            janet_asserttype(x, JANET_STRING, st);
             def->source = janet_unwrap_string(x);
         }
 
         /* Unmarshal constants */
         if (constants_length) {
-            def->constants = malloc(sizeof(Janet) * constants_length);
+            def->constants = janet_malloc(sizeof(Janet) * constants_length);
             if (!def->constants) {
                 JANET_OUT_OF_MEMORY;
             }
@@ -845,8 +935,29 @@ 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_panicf("corrupted symbolmap when unmarshalling debug info, got %v", value);
+                }
+                def->symbolmap[i].symbol = janet_unwrap_symbol(value);
+            }
+            def->symbolmap_length = (uint32_t) symbolmap_length;
+        }
+
         /* Unmarshal bytecode */
-        def->bytecode = malloc(sizeof(uint32_t) * bytecode_length);
+        def->bytecode = janet_malloc(sizeof(uint32_t) * bytecode_length);
         if (!def->bytecode) {
             JANET_OUT_OF_MEMORY;
         }
@@ -855,7 +966,7 @@ static const uint8_t *unmarshal_one_def(
 
         /* Unmarshal environments */
         if (def->flags & JANET_FUNCDEF_FLAG_HASENVS) {
-            def->environments = calloc(1, sizeof(int32_t) * (size_t) environments_length);
+            def->environments = janet_calloc(1, sizeof(int32_t) * (size_t) environments_length);
             if (!def->environments) {
                 JANET_OUT_OF_MEMORY;
             }
@@ -869,7 +980,7 @@ static const uint8_t *unmarshal_one_def(
 
         /* Unmarshal sub funcdefs */
         if (def->flags & JANET_FUNCDEF_FLAG_HASDEFS) {
-            def->defs = calloc(1, sizeof(JanetFuncDef *) * (size_t) defs_length);
+            def->defs = janet_calloc(1, sizeof(JanetFuncDef *) * (size_t) defs_length);
             if (!def->defs) {
                 JANET_OUT_OF_MEMORY;
             }
@@ -884,7 +995,7 @@ static const uint8_t *unmarshal_one_def(
         /* Unmarshal source maps if needed */
         if (def->flags & JANET_FUNCDEF_FLAG_HASSOURCEMAP) {
             int32_t current = 0;
-            def->sourcemap = malloc(sizeof(JanetSourceMapping) * (size_t) bytecode_length);
+            def->sourcemap = janet_malloc(sizeof(JanetSourceMapping) * (size_t) bytecode_length);
             if (!def->sourcemap) {
                 JANET_OUT_OF_MEMORY;
             }
@@ -900,7 +1011,7 @@ static const uint8_t *unmarshal_one_def(
         /* Unmarshal closure bitset if needed */
         if (def->flags & JANET_FUNCDEF_FLAG_HASCLOBITSET) {
             int32_t n = (def->slotcount + 31) >> 5;
-            def->closure_bitset = malloc(sizeof(uint32_t) * (size_t) n);
+            def->closure_bitset = janet_malloc(sizeof(uint32_t) * (size_t) n);
             if (NULL == def->closure_bitset) {
                 JANET_OUT_OF_MEMORY;
             }
@@ -935,8 +1046,8 @@ 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;
     fiber->supervisor_channel = NULL;
 #endif
@@ -961,7 +1072,7 @@ static const uint8_t *unmarshal_one_fiber(
 
     /* Allocate stack memory */
     fiber->capacity = fiber_stacktop + 10;
-    fiber->data = malloc(sizeof(Janet) * fiber->capacity);
+    fiber->data = janet_malloc(sizeof(Janet) * fiber->capacity);
     if (!fiber->data) {
         JANET_OUT_OF_MEMORY;
     }
@@ -987,7 +1098,7 @@ static const uint8_t *unmarshal_one_fiber(
         /* Get function */
         Janet funcv;
         data = unmarshal_one(st, data, &funcv, flags + 1);
-        janet_asserttype(funcv, JANET_FUNCTION);
+        janet_asserttype(funcv, JANET_FUNCTION, st);
         func = janet_unwrap_function(funcv);
         def = func->def;
 
@@ -1033,7 +1144,7 @@ static const uint8_t *unmarshal_one_fiber(
         Janet envv;
         fiber_flags &= ~JANET_FIBER_FLAG_HASENV;
         data = unmarshal_one(st, data, &envv, flags + 1);
-        janet_asserttype(envv, JANET_TABLE);
+        janet_asserttype(envv, JANET_TABLE, st);
         fiber_env = janet_unwrap_table(envv);
     }
 
@@ -1042,10 +1153,13 @@ static const uint8_t *unmarshal_one_fiber(
         Janet fiberv;
         fiber_flags &= ~JANET_FIBER_FLAG_HASCHILD;
         data = unmarshal_one(st, data, &fiberv, flags + 1);
-        janet_asserttype(fiberv, JANET_FIBER);
+        janet_asserttype(fiberv, JANET_FIBER, st);
         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;
@@ -1083,6 +1197,18 @@ int64_t janet_unmarshal_int64(JanetMarshalContext *ctx) {
     return read64(st, &(ctx->data));
 }
 
+void *janet_unmarshal_ptr(JanetMarshalContext *ctx) {
+    if (!(ctx->flags & JANET_MARSHAL_UNSAFE)) {
+        janet_panic("can only unmarshal pointers in unsafe mode");
+    }
+    UnmarshalState *st = (UnmarshalState *)(ctx->u_state);
+    void *ptr;
+    MARSH_EOS(st, ctx->data + sizeof(void *) - 1);
+    memcpy((char *) &ptr, ctx->data, sizeof(void *));
+    ctx->data += sizeof(void *);
+    return ptr;
+}
+
 uint8_t janet_unmarshal_byte(JanetMarshalContext *ctx) {
     UnmarshalState *st = (UnmarshalState *)(ctx->u_state);
     MARSH_EOS(st, ctx->data);
@@ -1103,32 +1229,49 @@ 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;
 }
 
+void *janet_unmarshal_abstract_threaded(JanetMarshalContext *ctx, size_t size) {
+#ifdef JANET_THREADS
+    void *p = janet_abstract_threaded(ctx->at, size);
+    janet_unmarshal_abstract_reuse(ctx, p);
+    return p;
+#else
+    (void) ctx;
+    (void) size;
+    janet_panic("threaded abstracts not supported");
+#endif
+}
+
 static const uint8_t *unmarshal_one_abstract(UnmarshalState *st, const uint8_t *data, Janet *out, int flags) {
     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));
+        void *abst = at->unmarshal(&context);
+        janet_assert(abst != NULL, "null pointer abstract");
+        *out = janet_wrap_abstract(abst);
         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(
@@ -1223,7 +1366,7 @@ static const uint8_t *unmarshal_one(
         }
         case LB_FIBER: {
             JanetFiber *fiber;
-            data = unmarshal_one_fiber(st, data + 1, &fiber, flags);
+            data = unmarshal_one_fiber(st, data + 1, &fiber, flags + 1);
             *out = janet_wrap_fiber(fiber);
             return data;
         }
@@ -1233,18 +1376,19 @@ 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;
+            for (int32_t i = 0; i < len; i++) {
+                func->envs[i] = 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 +1401,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 +1431,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, st);
+                    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);
@@ -1309,7 +1460,7 @@ static const uint8_t *unmarshal_one(
                 if (lead == LB_TABLE_PROTO) {
                     Janet proto;
                     data = unmarshal_one(st, data, &proto, flags + 1);
-                    janet_asserttype(proto, JANET_TABLE);
+                    janet_asserttype(proto, JANET_TABLE, st);
                     t->proto = janet_unwrap_table(proto);
                 }
                 for (int32_t i = 0; i < len; i++) {
@@ -1339,6 +1490,29 @@ static const uint8_t *unmarshal_one(
             janet_v_push(st->lookup, *out);
             return data;
         }
+#ifdef JANET_EV
+        case LB_POINTER_BUFFER: {
+            data++;
+            int32_t count = readnat(st, &data);
+            int32_t capacity = readnat(st, &data);
+            MARSH_EOS(st, data + sizeof(void *));
+            union {
+                void *ptr;
+                uint8_t bytes[sizeof(void *)];
+            } u;
+            if (!(flags & JANET_MARSHAL_UNSAFE)) {
+                janet_panicf("unsafe flag not given, "
+                             "will not unmarshal raw pointer at index %d",
+                             (int)(data - st->start));
+            }
+            memcpy(u.bytes, data, sizeof(void *));
+            data += sizeof(void *);
+            JanetBuffer *buffer = janet_pointer_buffer_unsafe(u.ptr, capacity, count);
+            *out = janet_wrap_buffer(buffer);
+            janet_v_push(st->lookup, *out);
+            return data;
+        }
+#endif
         case LB_UNSAFE_CFUNCTION: {
             MARSH_EOS(st, data + sizeof(JanetCFunction));
             data++;
@@ -1357,6 +1531,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 +1574,6 @@ static const uint8_t *unmarshal_one(
             return NULL;
         }
     }
-#undef EXTRA
 }
 
 Janet janet_unmarshal(
@@ -1391,16 +1600,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 +1630,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 +1651,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 integer in the range [0, max) for max > 0 from the RNG.  "
+              "If max is 0, return 0.  If no max is given, the default is 2^31 - 1."
+             ) {
     janet_arity(argc, 1, 2);
     JanetRNG *rng = janet_getabstract(argv, 0, &janet_rng_type);
     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(janet_name, fop, doc)\
+JANET_CORE_FN(janet_##fop, "(math/" janet_name " x)", doc) {\
     janet_fixarity(argc, 1); \
     double x = janet_getnumber(argv, 0); \
     return janet_wrap_number(fop(x)); \
 }
 
-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(fop, doc) JANET_DEFINE_NAMED_MATHOP(#fop, fop, doc)
 
-#define JANET_DEFINE_MATH2OP(name, fop)\
-static Janet janet_##name(int32_t argc, Janet *argv) {\
+JANET_DEFINE_MATHOP(acos, "Returns the arccosine of x.")
+JANET_DEFINE_MATHOP(asin, "Returns the arcsin of x.")
+JANET_DEFINE_MATHOP(atan, "Returns the arctangent of x.")
+JANET_DEFINE_MATHOP(cos, "Returns the cosine of x.")
+JANET_DEFINE_MATHOP(cosh, "Returns the hyperbolic cosine of x.")
+JANET_DEFINE_MATHOP(acosh, "Returns the hyperbolic arccosine of x.")
+JANET_DEFINE_MATHOP(sin, "Returns the sine of x.")
+JANET_DEFINE_MATHOP(sinh, "Returns the hyperbolic sine of x.")
+JANET_DEFINE_MATHOP(asinh, "Returns the hyperbolic arcsine of x.")
+JANET_DEFINE_MATHOP(tan, "Returns the tangent of x.")
+JANET_DEFINE_MATHOP(tanh, "Returns the hyperbolic tangent of x.")
+JANET_DEFINE_MATHOP(atanh, "Returns the hyperbolic arctangent of x.")
+JANET_DEFINE_MATHOP(exp, "Returns e to the power of x.")
+JANET_DEFINE_MATHOP(exp2, "Returns 2 to the power of x.")
+JANET_DEFINE_MATHOP(expm1, "Returns e to the power of x minus 1.")
+JANET_DEFINE_MATHOP(log, "Returns the natural logarithm of x.")
+JANET_DEFINE_MATHOP(log10, "Returns the log base 10 of x.")
+JANET_DEFINE_MATHOP(log2, "Returns the log base 2 of x.")
+JANET_DEFINE_MATHOP(sqrt, "Returns the square root of x.")
+JANET_DEFINE_MATHOP(cbrt, "Returns the cube root of x.")
+JANET_DEFINE_MATHOP(ceil, "Returns the smallest integer value number that is not less than x.")
+JANET_DEFINE_MATHOP(floor, "Returns the largest integer value number that is not greater than x.")
+JANET_DEFINE_MATHOP(trunc, "Returns the integer between x and 0 nearest to x.")
+JANET_DEFINE_MATHOP(round, "Returns the integer nearest to x.")
+JANET_DEFINE_MATHOP(log1p, "Returns (log base e of x) + 1 more accurately than (+ (math/log x) 1)")
+JANET_DEFINE_MATHOP(erf, "Returns the error function of x.")
+JANET_DEFINE_MATHOP(erfc, "Returns the complementary error function of x.")
+JANET_DEFINE_NAMED_MATHOP("log-gamma", lgamma, "Returns log-gamma(x).")
+JANET_DEFINE_NAMED_MATHOP("abs", fabs, "Return the absolute value of x.")
+JANET_DEFINE_NAMED_MATHOP("gamma", tgamma, "Returns gamma(x).")
+
+#define JANET_DEFINE_MATH2OP(name, fop, signature, doc)\
+JANET_CORE_FN(janet_##name, signature, doc) {\
     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_fabs),
+        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_tgamma),
+        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 */
@@ -99,6 +111,62 @@ static void janet_net_socknoblock(JSock s) {
 #endif
 }
 
+/* State machine for async connect */
+
+typedef struct {
+    JanetListenerState head;
+    int did_connect;
+} NetStateConnect;
+
+JanetAsyncStatus net_machine_connect(JanetListenerState *s, JanetAsyncEvent event) {
+    NetStateConnect *state = (NetStateConnect *)s;
+    switch (event) {
+        default:
+            return JANET_ASYNC_STATUS_NOT_DONE;
+        case JANET_ASYNC_EVENT_CLOSE:
+            janet_cancel(s->fiber, janet_cstringv("stream closed"));
+            return JANET_ASYNC_STATUS_DONE;
+        case JANET_ASYNC_EVENT_HUP:
+        case JANET_ASYNC_EVENT_ERR:
+        case JANET_ASYNC_EVENT_COMPLETE:
+        case JANET_ASYNC_EVENT_WRITE:
+        case JANET_ASYNC_EVENT_USER:
+            break;
+    }
+    JanetStream *stream = s->stream;
+#ifdef JANET_WINDOWS
+    int res = 0;
+    int size = sizeof(res);
+    int r = getsockopt((SOCKET)stream->handle, SOL_SOCKET, SO_ERROR, (char *)&res, &size);
+#else
+    int res = 0;
+    socklen_t size = sizeof res;
+    int r = getsockopt(stream->handle, SOL_SOCKET, SO_ERROR, &res, &size);
+#endif
+    if (r == 0) {
+        if (res == 0) {
+            state->did_connect = 1;
+            janet_schedule(s->fiber, janet_wrap_abstract(s->stream));
+        } else {
+            janet_cancel(s->fiber, janet_cstringv(strerror(res)));
+            stream->flags |= JANET_STREAM_TOCLOSE;
+        }
+    } else {
+        janet_cancel(s->fiber, janet_ev_lasterr());
+        stream->flags |= JANET_STREAM_TOCLOSE;
+    }
+    return JANET_ASYNC_STATUS_DONE;
+}
+
+static void net_sched_connect(JanetStream *stream) {
+    JanetListenerState *s = janet_listen(stream, net_machine_connect, JANET_ASYNC_LISTEN_WRITE, sizeof(NetStateConnect), NULL);
+    NetStateConnect *state = (NetStateConnect *)s;
+    state->did_connect = 0;
+#ifdef JANET_WINDOWS
+    net_machine_connect(s, JANET_ASYNC_EVENT_USER);
+#endif
+}
+
 /* State machine for accepting connections. */
 
 #ifdef JANET_WINDOWS
@@ -122,22 +190,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 +231,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 +281,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);
@@ -242,7 +312,6 @@ JANET_NO_RETURN static void janet_sched_accept(JanetStream *stream, JanetFunctio
     janet_await();
 }
 
-
 #endif
 
 /* Adress info */
@@ -259,37 +328,39 @@ 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
     if (janet_keyeq(argv[offset], "unix")) {
         const char *path = janet_getcstring(argv, offset + 1);
-        struct sockaddr_un *saddr = calloc(1, sizeof(struct sockaddr_un));
+        struct sockaddr_un *saddr = janet_calloc(1, sizeof(struct sockaddr_un));
         if (saddr == NULL) {
             JANET_OUT_OF_MEMORY;
         }
         saddr->sun_family = AF_UNIX;
+        size_t path_size = sizeof(saddr->sun_path);
 #ifdef JANET_LINUX
         if (path[0] == '@') {
             saddr->sun_path[0] = '\0';
-            snprintf(saddr->sun_path + 1, 107, "%s", path + 1);
+            snprintf(saddr->sun_path + 1, path_size - 1, "%s", path + 1);
         } else
 #endif
         {
-            snprintf(saddr->sun_path, 108, "%s", path);
+            snprintf(saddr->sun_path, path_size, "%s", path);
         }
         *is_unix = 1;
         return (struct addrinfo *) saddr;
     }
 #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;
@@ -310,7 +381,15 @@ 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_sandbox_assert(JANET_SANDBOX_NET_CONNECT); /* connect OR listen */
     janet_arity(argc, 2, 4);
     int socktype = janet_get_sockettype(argv, argc, 2);
     int is_unix = 0;
@@ -349,13 +428,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_sandbox_assert(JANET_SANDBOX_NET_CONNECT);
+    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;
@@ -364,7 +480,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);
@@ -374,7 +492,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
@@ -385,35 +503,69 @@ 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 = binding; 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);
+        }
+    }
+
+    /* Wrap socket in abstract type JanetStream */
+    JanetStream *stream = make_stream(sock, JANET_STREAM_READABLE | JANET_STREAM_WRITABLE);
+
+    /* Set up the socket for non-blocking IO before connecting */
+    janet_net_socknoblock(sock);
+
     /* Connect to socket */
 #ifdef JANET_WINDOWS
     int status = WSAConnect(sock, addr, addrlen, NULL, NULL, NULL, NULL);
+    int err = WSAGetLastError();
     freeaddrinfo(ai);
 #else
     int status = connect(sock, addr, addrlen);
+    int err = errno;
     if (is_unix) {
-        free(ai);
+        janet_free(ai);
     } else {
         freeaddrinfo(ai);
     }
 #endif
 
-    if (status == -1) {
-        JSOCKCLOSE(sock);
-        janet_panicf("could not connect to socket: %V", janet_ev_lasterr());
+    if (status) {
+#ifdef JANET_WINDOWS
+        if (err != WSAEWOULDBLOCK) {
+#else
+        if (err != EINPROGRESS) {
+#endif
+            JSOCKCLOSE(sock);
+            Janet lasterr = 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? */
-    janet_net_socknoblock(sock);
-
-    /* Wrap socket in abstract type JanetStream */
-    JanetStream *stream = make_stream(sock, JANET_STREAM_READABLE | JANET_STREAM_WRITABLE);
-    return janet_wrap_abstract(stream);
+    net_sched_connect(stream);
+    janet_await();
 }
 
 static const char *serverify_socket(JSock sfd) {
@@ -431,7 +583,62 @@ static const char *serverify_socket(JSock sfd) {
     return NULL;
 }
 
-static Janet cfun_net_listen(int32_t argc, Janet *argv) {
+#ifdef JANET_WINDOWS
+#define JANET_SHUTDOWN_RW SD_BOTH
+#define JANET_SHUTDOWN_R SD_RECEIVE
+#define JANET_SHUTDOWN_W SD_SEND
+#else
+#define JANET_SHUTDOWN_RW SHUT_RDWR
+#define JANET_SHUTDOWN_R SHUT_RD
+#define JANET_SHUTDOWN_W SHUT_WR
+#endif
+
+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);
+    int shutdown_type = JANET_SHUTDOWN_RW;
+    if (argc == 2) {
+        const uint8_t *kw = janet_getkeyword(argv, 1);
+        if (0 == janet_cstrcmp(kw, "rw")) {
+            shutdown_type = JANET_SHUTDOWN_RW;
+        } else if (0 == janet_cstrcmp(kw, "r")) {
+            shutdown_type = JANET_SHUTDOWN_R;
+        } else if (0 == janet_cstrcmp(kw, "w")) {
+            shutdown_type = JANET_SHUTDOWN_W;
+        } else {
+            janet_panicf("unexpected keyword %v", argv[1]);
+        }
+    }
+    int status;
+#ifdef JANET_WINDOWS
+    status = shutdown((SOCKET) stream->handle, shutdown_type);
+#else
+    do {
+        status = shutdown(stream->handle, shutdown_type);
+    } while (status == -1 && errno == EINTR);
+#endif
+    if (status) {
+        janet_panicf("could not shutdown socket: %V", janet_ev_lasterr());
+    }
+    return argv[0];
+}
+
+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_sandbox_assert(JANET_SANDBOX_NET_LISTEN);
     janet_arity(argc, 2, 3);
 
     /* Get host, port, and handler*/
@@ -444,20 +651,20 @@ static Janet cfun_net_listen(int32_t argc, Janet *argv) {
     if (is_unix) {
         sfd = socket(AF_UNIX, socktype | JSOCKFLAGS, 0);
         if (!JSOCKVALID(sfd)) {
-            free(ai);
+            janet_free(ai);
             janet_panicf("could not create socket: %V", janet_ev_lasterr());
         }
         const char *err = serverify_socket(sfd);
         if (NULL != err || bind(sfd, (struct sockaddr *)ai, sizeof(struct sockaddr_un))) {
             JSOCKCLOSE(sfd);
-            free(ai);
+            janet_free(ai);
             if (err) {
                 janet_panic(err);
             } else {
                 janet_panicf("could not bind socket: %V", janet_ev_lasterr());
             }
         }
-        free(ai);
+        janet_free(ai);
     } else
 #endif
     {
@@ -505,7 +712,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);
@@ -513,7 +813,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);
@@ -522,7 +826,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);
@@ -539,7 +849,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);
@@ -551,7 +864,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);
@@ -563,7 +879,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);
@@ -579,7 +899,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);
@@ -596,7 +920,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);
@@ -608,6 +935,98 @@ static Janet cfun_stream_flush(int32_t argc, Janet *argv) {
     return argv[0];
 }
 
+struct sockopt_type {
+    const char *name;
+    int level;
+    int optname;
+    enum JanetType type;
+};
+
+/* List of supported socket options; The type JANET_POINTER is used
+ * for options that require special handling depending on the type. */
+static const struct sockopt_type sockopt_type_list[] = {
+    { "so-broadcast", SOL_SOCKET, SO_BROADCAST, JANET_BOOLEAN },
+    { "so-reuseaddr", SOL_SOCKET, SO_REUSEADDR, JANET_BOOLEAN },
+    { "so-keepalive", SOL_SOCKET, SO_KEEPALIVE, JANET_BOOLEAN },
+    { "ip-multicast-ttl", IPPROTO_IP, IP_MULTICAST_TTL, JANET_NUMBER },
+    { "ip-add-membership", IPPROTO_IP, IP_ADD_MEMBERSHIP, JANET_POINTER },
+    { "ip-drop-membership", IPPROTO_IP, IP_DROP_MEMBERSHIP, JANET_POINTER },
+    { "ipv6-join-group", IPPROTO_IPV6, IPV6_JOIN_GROUP, JANET_POINTER },
+    { "ipv6-leave-group", IPPROTO_IPV6, IPV6_LEAVE_GROUP, JANET_POINTER },
+    { NULL, 0, 0, JANET_POINTER }
+};
+
+JANET_CORE_FN(cfun_net_setsockopt,
+              "(net/setsockopt stream option value)",
+              "set socket options.\n"
+              "\n"
+              "supported options and associated value types:\n"
+              "- :so-broadcast boolean\n"
+              "- :so-reuseaddr boolean\n"
+              "- :so-keepalive boolean\n"
+              "- :ip-multicast-ttl number\n"
+              "- :ip-add-membership string\n"
+              "- :ip-drop-membership string\n"
+              "- :ipv6-join-group string\n"
+              "- :ipv6-leave-group string\n") {
+    janet_arity(argc, 3, 3);
+    JanetStream *stream = janet_getabstract(argv, 0, &janet_stream_type);
+    janet_stream_flags(stream, JANET_STREAM_SOCKET);
+    JanetKeyword optstr = janet_getkeyword(argv, 1);
+
+    const struct sockopt_type *st = sockopt_type_list;
+    while (st->name) {
+        if (janet_cstrcmp(optstr, st->name) == 0) {
+            break;
+        }
+        st++;
+    }
+
+    if (st->name == NULL) {
+        janet_panicf("unknown socket option %q", argv[1]);
+    }
+
+    union {
+        int v_int;
+        struct ip_mreq v_mreq;
+        struct ipv6_mreq v_mreq6;
+    } val;
+
+    void *optval = (void *)&val;
+    socklen_t optlen = 0;
+
+    if (st->type == JANET_BOOLEAN) {
+        val.v_int = janet_getboolean(argv, 2);
+        optlen = sizeof(val.v_int);
+    } else if (st->type == JANET_NUMBER) {
+        val.v_int = janet_getinteger(argv, 2);
+        optlen = sizeof(val.v_int);
+    } else if (st->optname == IP_ADD_MEMBERSHIP || st->optname == IP_DROP_MEMBERSHIP) {
+        const char *addr = janet_getcstring(argv, 2);
+        memset(&val.v_mreq, 0, sizeof val.v_mreq);
+        val.v_mreq.imr_interface.s_addr = htonl(INADDR_ANY);
+        inet_pton(AF_INET, addr, &val.v_mreq.imr_multiaddr.s_addr);
+        optlen = sizeof(val.v_mreq);
+    } else if (st->optname == IPV6_JOIN_GROUP || st->optname == IPV6_LEAVE_GROUP) {
+        const char *addr = janet_getcstring(argv, 2);
+        memset(&val.v_mreq6, 0, sizeof val.v_mreq6);
+        val.v_mreq6.ipv6mr_interface = 0;
+        inet_pton(AF_INET6, addr, &val.v_mreq6.ipv6mr_multiaddr);
+        optlen = sizeof(val.v_mreq6);
+    } else {
+        janet_panicf("invalid socket option type");
+    }
+
+    janet_assert(optlen != 0, "invalid socket option value");
+
+    int r = setsockopt((JSock) stream->handle, st->level, st->optname, optval, optlen);
+    if (r == -1) {
+        janet_panicf("setsockopt(%q): %s", argv[1], strerror(errno));
+    }
+
+    return janet_wrap_nil();
+}
+
 static const JanetMethod net_stream_methods[] = {
     {"chunk", cfun_stream_chunk},
     {"close", janet_cfun_stream_close},
@@ -618,10 +1037,11 @@ 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},
+    {"shutdown", cfun_net_shutdown},
+    {"setsockopt", cfun_net_setsockopt},
     {NULL, NULL}
 };
 
@@ -629,91 +1049,27 @@ 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. ")
-    },
-    {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_CORE_REG("net/setsockopt", cfun_net_setsockopt),
+        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) {
@@ -123,7 +123,7 @@ static void NAME(JanetParser *p, T x) { \
     if (newcount > p->STACKCAP) { \
         T *next; \
         size_t newcap = 2 * newcount; \
-        next = realloc(p->STACK, sizeof(T) * newcap); \
+        next = janet_realloc(p->STACK, sizeof(T) * newcap); \
         if (NULL == next) { \
             JANET_OUT_OF_MEMORY; \
         } \
@@ -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:
@@ -228,6 +259,14 @@ static int checkescape(uint8_t c) {
             return '\f';
         case 'v':
             return '\v';
+        case 'a':
+            return '\a';
+        case 'b':
+            return '\b';
+        case '\'':
+            return '\'';
+        case '?':
+            return '?';
         case 'e':
             return 27;
         case '"':
@@ -411,7 +450,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 +461,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 +481,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 +621,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 +651,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 +672,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 +723,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 +766,7 @@ Janet janet_parser_produce(JanetParser *parser) {
     }
     parser->pending--;
     parser->argcount--;
+    parser->states[0].argn--;
     return ret;
 }
 
@@ -759,6 +780,7 @@ Janet janet_parser_produce_wrapped(JanetParser *parser) {
     }
     parser->pending--;
     parser->argcount--;
+    parser->states[0].argn--;
     return ret;
 }
 
@@ -783,9 +805,9 @@ void janet_parser_init(JanetParser *parser) {
 }
 
 void janet_parser_deinit(JanetParser *parser) {
-    free(parser->args);
-    free(parser->buf);
-    free(parser->states);
+    janet_free(parser->args);
+    janet_free(parser->buf);
+    janet_free(parser->states);
 }
 
 void janet_parser_clone(const JanetParser *src, JanetParser *dest) {
@@ -812,17 +834,17 @@ void janet_parser_clone(const JanetParser *src, JanetParser *dest) {
     dest->states = NULL;
     dest->buf = NULL;
     if (dest->bufcap) {
-        dest->buf = malloc(dest->bufcap);
+        dest->buf = janet_malloc(dest->bufcap);
         if (!dest->buf) goto nomem;
         memcpy(dest->buf, src->buf, dest->bufcap);
     }
     if (dest->argcap) {
-        dest->args = malloc(sizeof(Janet) * dest->argcap);
+        dest->args = janet_malloc(sizeof(Janet) * dest->argcap);
         if (!dest->args) goto nomem;
         memcpy(dest->args, src->args, dest->argcap * sizeof(Janet));
     }
     if (dest->statecap) {
-        dest->states = malloc(sizeof(JanetParseState) * dest->statecap);
+        dest->states = janet_malloc(sizeof(JanetParseState) * dest->statecap);
         if (!dest->states) goto nomem;
         memcpy(dest->states, src->states, dest->statecap * sizeof(JanetParseState));
     }
@@ -878,7 +900,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 +911,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 +940,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;
@@ -943,7 +978,7 @@ static Janet cfun_parse_insert(int32_t argc, Janet *argv) {
         size_t newcount = p->bufcount + slen;
         if (p->bufcap < newcount) {
             size_t newcap = 2 * newcount;
-            p->buf = realloc(p->buf, newcap);
+            p->buf = janet_realloc(p->buf, newcap);
             if (p->buf == NULL) {
                 JANET_OUT_OF_MEMORY;
             }
@@ -957,13 +992,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 +1010,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 +1037,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 +1054,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 +1070,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 +1115,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));
     }
@@ -1137,7 +1202,8 @@ static Janet parser_state_delimiters(const JanetParser *_p) {
             }
         }
     }
-    str = janet_string(p->buf + oldcount, (int32_t)(p->bufcount - oldcount));
+    /* avoid ptr arithmetic on NULL */
+    str = janet_string(oldcount ? p->buf + oldcount : p->buf, (int32_t)(p->bufcount - oldcount));
     p->bufcount = oldcount;
     return janet_wrap_string(str);
 }
@@ -1147,11 +1213,15 @@ 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->argcount ? p->args + p->argcount : p->args; /* avoid ptr arithmetic on NULL */
     for (int32_t i = count - 1; i >= 0; --i) {
         JanetParseState *s = p->states + i;
+        /* avoid ptr arithmetic on args if NULL */
+        if ((s->flags & PFLAG_CONTAINER) && s->argn) {
+            args -= s->argn;
+        }
         states->data[i] = janet_wrap_parse_state(s, args, buf, (uint32_t) p->bufcount);
-        args -= s->argn;
     }
     return janet_wrap_array(states);
 }
@@ -1162,7 +1232,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 +1269,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 +1308,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) 2020 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[1]);
+}
+
 static void spec_reference(Builder *b, int32_t argc, const Janet *argv) {
     peg_arity(b, argc, 1, 2);
     Reserve r = reserve(b, 3);
@@ -1038,7 +1100,7 @@ static void spec_matchtime(Builder *b, int32_t argc, const Janet *argv) {
     Janet fun = argv[1];
     if (!janet_checktype(fun, JANET_FUNCTION) &&
             !janet_checktype(fun, JANET_CFUNCTION)) {
-        peg_panicf(b, "expected function|cfunction, got %v", fun);
+        peg_panicf(b, "expected function or cfunction, got %v", fun);
     }
     uint32_t tag = (argc == 3) ? emit_tag(b, argv[2]) : 0;
     uint32_t cindex = emit_constant(b, fun);
@@ -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},
@@ -1148,7 +1211,9 @@ static uint32_t peg_compile1(Builder *b, Janet peg) {
     for (; i > 0 && janet_checktype(peg, JANET_KEYWORD); --i) {
         Janet nextPeg = janet_table_get_ex(grammar, peg, &grammar);
         if (!grammar || janet_checktype(nextPeg, JANET_NIL)) {
-            nextPeg = janet_table_get(b->default_grammar, peg);
+            nextPeg = (b->default_grammar == NULL)
+                      ? janet_wrap_nil()
+                      : janet_table_get(b->default_grammar, peg);
             if (janet_checktype(nextPeg, JANET_NIL)) {
                 peg_panic(b, "unknown rule");
             }
@@ -1196,6 +1261,13 @@ static uint32_t peg_compile1(Builder *b, Janet peg) {
         default:
             peg_panic(b, "unexpected peg source");
             return 0;
+
+        case JANET_BOOLEAN: {
+            int n = janet_unwrap_boolean(peg);
+            Reserve r = reserve(b, 2);
+            emit_1(r, n ? RULE_NCHAR : RULE_NOTNCHAR, 0);
+            break;
+        }
         case JANET_NUMBER: {
             int32_t n = peg_getinteger(b, peg);
             Reserve r = reserve(b, 2);
@@ -1212,6 +1284,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);
@@ -1335,7 +1419,7 @@ static void *peg_unmarshal(JanetMarshalContext *ctx) {
      * bytecode. */
     uint32_t blen = (int32_t) peg->bytecode_len;
     uint32_t clen = peg->num_constants;
-    uint8_t *op_flags = calloc(1, blen);
+    uint8_t *op_flags = janet_calloc(1, blen);
     if (NULL == op_flags) {
         JANET_OUT_OF_MEMORY;
     }
@@ -1417,6 +1501,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:
@@ -1466,11 +1556,11 @@ static void *peg_unmarshal(JanetMarshalContext *ctx) {
     peg->bytecode = bytecode;
     peg->constants = constants;
     peg->has_backref = has_backref;
-    free(op_flags);
+    janet_free(op_flags);
     return peg;
 
 bad:
-    free(op_flags);
+    janet_free(op_flags);
     janet_panic("invalid peg bytecode");
 }
 
@@ -1539,7 +1629,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);
@@ -1550,7 +1644,7 @@ typedef struct {
     JanetPeg *peg;
     PegState s;
     JanetByteView bytes;
-    JanetByteView repl;
+    Janet subst;
     int32_t start;
 } PegCall;
 
@@ -1566,7 +1660,7 @@ static PegCall peg_cfun_init(int32_t argc, Janet *argv, int get_replace) {
         ret.peg = compile_peg(argv[0]);
     }
     if (get_replace) {
-        ret.repl = janet_getbytes(argv, 1);
+        ret.subst = argv[1];
         ret.bytes = janet_getbytes(argv, 2);
     } else {
         ret.bytes = janet_getbytes(argv, 1);
@@ -1597,18 +1691,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);
@@ -1618,7 +1719,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++) {
@@ -1642,7 +1745,8 @@ static Janet cfun_peg_replace_generic(int32_t argc, Janet *argv, int only_one) {
                 trail = i;
             }
             int32_t nexti = (int32_t)(result - c.bytes.bytes);
-            janet_buffer_push_bytes(ret, c.repl.bytes, c.repl.len);
+            JanetByteView subst = janet_text_substitution(&c.subst, c.bytes.bytes + i, nexti - i, c.s.captures);
+            janet_buffer_push_bytes(ret, subst.bytes, subst.len);
             trail = nexti;
             if (nexti == i) nexti++;
             i = nexti;
@@ -1657,11 +1761,22 @@ 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 subst text &opt start & args)",
+              "Replace all matches of `peg` in `text` with `subst`, returning a new buffer. "
+              "The peg does not need to make captures to do replacement. "
+              "If `subst` is a function, it will be called with the "
+              "matching text followed by any captures.") {
     return cfun_peg_replace_generic(argc, argv, 0);
 }
 
-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 `subst`, returning a new buffer. "
+              "The peg does not need to make captures to do replacement. "
+              "If `subst` is a function, it will be called with the "
+              "matching text followed by any captures. "
+              "If no matches are found, returns the input string in a new buffer.") {
     return cfun_peg_replace_generic(argc, argv, 1);
 }
 
@@ -1686,47 +1801,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) 2020 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';
@@ -151,6 +152,12 @@ static void janet_escape_string_impl(JanetBuffer *buffer, const uint8_t *str, in
             case '\v':
                 janet_buffer_push_bytes(buffer, (const uint8_t *)"\\v", 2);
                 break;
+            case '\a':
+                janet_buffer_push_bytes(buffer, (const uint8_t *)"\\a", 2);
+                break;
+            case '\b':
+                janet_buffer_push_bytes(buffer, (const uint8_t *)"\\b", 2);
+                break;
             case 27:
                 janet_buffer_push_bytes(buffer, (const uint8_t *)"\\e", 2);
                 break;
@@ -227,12 +234,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;
             }
@@ -241,6 +250,10 @@ void janet_to_string_b(JanetBuffer *buffer, Janet x) {
         case JANET_FUNCTION: {
             JanetFunction *fun = janet_unwrap_function(x);
             JanetFuncDef *def = fun->def;
+            if (def == NULL) {
+                janet_buffer_push_cstring(buffer, "<incomplete function>");
+                break;
+            }
             if (def->name) {
                 const uint8_t *n = def->name;
                 janet_buffer_push_cstring(buffer, "<function ");
@@ -259,21 +272,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 +573,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 +593,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;
@@ -617,7 +639,7 @@ static void janet_pretty_one(struct pretty *S, Janet x, int is_dict_value) {
                     if (mincap >= INT32_MAX / 2) {
                         S->keysort_capacity = INT32_MAX;
                     } else {
-                        S->keysort_capacity = mincap * 2;
+                        S->keysort_capacity = (int32_t)(mincap * 2);
                     }
                     S->keysort_buffer = janet_srealloc(S->keysort_buffer, sizeof(int32_t) * S->keysort_capacity);
                     if (NULL == S->keysort_buffer) {
@@ -625,7 +647,7 @@ static void janet_pretty_one(struct pretty *S, Janet x, int is_dict_value) {
                     }
                 }
 
-                janet_sorted_keys(kvs, cap, S->keysort_buffer + ks_start);
+                janet_sorted_keys(kvs, cap, S->keysort_buffer == NULL ? NULL : S->keysort_buffer + ks_start);
                 S->keysort_start += len;
                 if (!(S->flags & JANET_PRETTY_NOTRUNC) && (len > JANET_PRETTY_DICT_LIMIT)) {
                     len = JANET_PRETTY_DICT_LIMIT;
@@ -724,7 +746,7 @@ static void pushtypes(JanetBuffer *buffer, int types) {
             if (first) {
                 first = 0;
             } else {
-                janet_buffer_push_u8(buffer, '|');
+                janet_buffer_push_cstring(buffer, (types == 1) ? " or " : ", ");
             }
             janet_buffer_push_cstring(buffer, janet_type_names[i]);
         }
@@ -739,20 +761,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;
+    }
+    janet_assert(0, "bad format mapping");
+}
+
 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 +814,23 @@ 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) {
+        char *loc = strchr(FMT_REPLACE_INTTYPES, *p2);
+        if (loc != NULL && *loc != '\0') {
+            const char *mapping = get_fmt_mapping(*p2++);
+            size_t len = strlen(mapping);
+            strcpy(form, mapping);
+            form += len;
+        } else {
+            *(form++) = *(p2++);
+        }
+    }
     *form = '\0';
+
     return p;
 }
 
@@ -794,11 +855,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, int);
+                    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 int);
                     nb = snprintf(item, MAX_ITEM, form, n);
                     break;
                 }
@@ -881,7 +947,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 +1018,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 +1043,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 +1105,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) 2020 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
@@ -27,6 +27,8 @@
 #include "util.h"
 #endif
 
+/* The JanetRegisterAllocator is really just a bitset. */
+
 void janetc_regalloc_init(JanetcRegisterAllocator *ra) {
     ra->chunks = NULL;
     ra->count = 0;
@@ -36,7 +38,7 @@ void janetc_regalloc_init(JanetcRegisterAllocator *ra) {
 }
 
 void janetc_regalloc_deinit(JanetcRegisterAllocator *ra) {
-    free(ra->chunks);
+    janet_free(ra->chunks);
 }
 
 /* Fallbacks for when ctz not available */
@@ -70,7 +72,7 @@ void janetc_regalloc_clone(JanetcRegisterAllocator *dest, JanetcRegisterAllocato
     size = sizeof(uint32_t) * (size_t) dest->capacity;
     dest->regtemps = 0;
     if (size) {
-        dest->chunks = malloc(size);
+        dest->chunks = janet_malloc(size);
         if (!dest->chunks) {
             JANET_OUT_OF_MEMORY;
         }
@@ -87,7 +89,7 @@ static void pushchunk(JanetcRegisterAllocator *ra) {
     int32_t newcount = ra->count + 1;
     if (newcount > ra->capacity) {
         int32_t newcapacity = newcount * 2;
-        ra->chunks = realloc(ra->chunks, (size_t) newcapacity * sizeof(uint32_t));
+        ra->chunks = janet_realloc(ra->chunks, (size_t) newcapacity * sizeof(uint32_t));
         if (!ra->chunks) {
             JANET_OUT_OF_MEMORY;
         }
@@ -139,6 +141,14 @@ void janetc_regalloc_free(JanetcRegisterAllocator *ra, int32_t reg) {
     ra->chunks[chunk] &= ~ithbit(bit);
 }
 
+/* Check if a register is set. */
+int janetc_regalloc_check(JanetcRegisterAllocator *ra, int32_t reg) {
+    int32_t chunk = reg >> 5;
+    int32_t bit = reg & 0x1F;
+    while (chunk >= ra->count) pushchunk(ra);
+    return !!(ra->chunks[chunk] & ithbit(bit));
+}
+
 /* Get a register that will fit in 8 bits (< 256). Do not call this
  * twice with the same value of nth without calling janetc_regalloc_free
  * on the returned register before. */

src/core/regalloc.h

@@ -1,5 +1,5 @@
 /*
-* Copyright (c) 2020 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
@@ -56,5 +56,6 @@ int32_t janetc_regalloc_temp(JanetcRegisterAllocator *ra, JanetcRegisterTemp nth
 void janetc_regalloc_freetemp(JanetcRegisterAllocator *ra, int32_t reg, JanetcRegisterTemp nth);
 void janetc_regalloc_clone(JanetcRegisterAllocator *dest, JanetcRegisterAllocator *src);
 void janetc_regalloc_touch(JanetcRegisterAllocator *ra, int32_t reg);
+int janetc_regalloc_check(JanetcRegisterAllocator *ra, int32_t reg);
 
 #endif

src/core/run.c

@@ -1,5 +1,5 @@
 /*
-* Copyright (c) 2020 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,18 +51,26 @@ 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;
                 }
             } else {
                 ret = janet_wrap_string(cres.error);
+                int32_t line = (int32_t) parser.line;
+                int32_t col = (int32_t) parser.column;
+                if ((cres.error_mapping.line > 0) &&
+                        (cres.error_mapping.column > 0)) {
+                    line = cres.error_mapping.line;
+                    col = cres.error_mapping.column;
+                }
                 if (cres.macrofiber) {
-                    janet_eprintf("compile error in %s: ", sourcePath);
-                    janet_stacktrace(cres.macrofiber, ret);
+                    janet_eprintf("%s:%d:%d: compile error", sourcePath,
+                                  line, col);
+                    janet_stacktrace_ext(cres.macrofiber, ret, "");
                 } else {
-                    janet_eprintf("compile error in %s: %s\n", sourcePath,
-                                  (const char *)cres.error);
+                    janet_eprintf("%s:%d:%d: compile error: %s\n", sourcePath,
+                                  line, col, (const char *)cres.error);
                 }
                 errflags |= 0x02;
                 done = 1;
@@ -79,7 +88,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 +109,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 +127,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) 2020 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]);
@@ -39,8 +39,12 @@ static JanetSlot janetc_quote(JanetFopts opts, int32_t argn, const Janet *argv)
 
 static JanetSlot janetc_splice(JanetFopts opts, int32_t argn, const Janet *argv) {
     JanetSlot ret;
+    if (!(opts.flags & JANET_FOPTS_ACCEPT_SPLICE)) {
+        janetc_cerror(opts.compiler, "splice can only be used in function parameters and data constructors, it has no effect here");
+        return janetc_cslot(janet_wrap_nil());
+    }
     if (argn != 1) {
-        janetc_cerror(opts.compiler, "expected 1 argument");
+        janetc_cerror(opts.compiler, "expected 1 argument to splice");
         return janetc_cslot(janet_wrap_nil());
     }
     ret = janetc_value(opts, argv[0]);
@@ -62,6 +66,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);
@@ -73,7 +79,9 @@ static JanetSlot quasiquote(JanetFopts opts, Janet x, int depth, int level) {
                 const uint8_t *head = janet_unwrap_symbol(tup[0]);
                 if (!janet_cstrcmp(head, "unquote")) {
                     if (level == 0) {
-                        return janetc_value(janetc_fopts_default(opts.compiler), tup[1]);
+                        JanetFopts subopts = janetc_fopts_default(opts.compiler);
+                        subopts.flags |= JANET_FOPTS_ACCEPT_SPLICE;
+                        return janetc_value(subopts, tup[1]);
                     } else {
                         level--;
                     }
@@ -82,7 +90,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 +99,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 +108,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 +123,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 +149,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 +162,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);
+
+                    /* avoid shifting negative numbers */
+                    c->buffer[label_loop_cond_jump] |= (uint32_t)(label_loop_exit - label_loop_cond_jump) << 16;
+                    c->buffer[label_loop_loop] |= (uint32_t)(label_loop_start - label_loop_loop) << 8;
+
+                    janetc_freeslot(c, argi);
+                    janetc_freeslot(c, arg);
+                    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 {
@@ -194,7 +263,7 @@ static const Janet *janetc_make_sourcemap(JanetCompiler *c) {
 
 static JanetSlot janetc_varset(JanetFopts opts, int32_t argn, const Janet *argv) {
     if (argn != 2) {
-        janetc_cerror(opts.compiler, "expected 2 arguments");
+        janetc_cerror(opts.compiler, "expected 2 arguments to set");
         return janetc_cslot(janet_wrap_nil());
     }
     JanetFopts subopts = janetc_fopts_default(opts.compiler);
@@ -236,14 +305,24 @@ static JanetSlot janetc_varset(JanetFopts opts, int32_t argn, const Janet *argv)
 }
 
 /* Add attributes to a global def or var table */
-static JanetTable *handleattr(JanetCompiler *c, int32_t argn, const Janet *argv) {
+static JanetTable *handleattr(JanetCompiler *c, const char *kind, 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>";
+    if (argn < 2) {
+        janetc_error(c, janet_formatc("expected at least 2 arguments to %s", kind));
+        return NULL;
+    }
     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());
@@ -251,23 +330,60 @@ static JanetTable *handleattr(JanetCompiler *c, int32_t argn, const Janet *argv)
             case JANET_STRING:
                 janet_table_put(tab, janet_ckeywordv("doc"), attr);
                 break;
+            case JANET_STRUCT:
+                janet_table_merge_struct(tab, janet_unwrap_struct(attr));
+                break;
         }
     }
     return tab;
 }
 
-static JanetSlot dohead(JanetCompiler *c, JanetFopts opts, Janet *head, int32_t argn, const Janet *argv) {
+typedef struct SlotHeadPair {
+    Janet lhs;
+    JanetSlot rhs;
+} SlotHeadPair;
+
+SlotHeadPair *dohead_destructure(JanetCompiler *c, SlotHeadPair *into, JanetFopts opts, Janet lhs, Janet rhs) {
+
+    /* Detect if we can do an optimization to avoid some allocations */
+    int can_destructure_lhs = janet_checktype(lhs, JANET_TUPLE)
+                              || janet_checktype(lhs, JANET_ARRAY);
+    int rhs_is_indexed = janet_checktype(rhs, JANET_ARRAY)
+                         || (janet_checktype(rhs, JANET_TUPLE) && (janet_tuple_flag(janet_unwrap_tuple(rhs)) & JANET_TUPLE_FLAG_BRACKETCTOR));
+    uint32_t has_drop = opts.flags & JANET_FOPTS_DROP;
+
     JanetFopts subopts = janetc_fopts_default(c);
-    JanetSlot ret;
-    if (argn < 2) {
-        janetc_cerror(c, "expected at least 2 arguments");
-        return janetc_cslot(janet_wrap_nil());
-    }
-    *head = argv[0];
     subopts.flags = opts.flags & ~(JANET_FOPTS_TAIL | JANET_FOPTS_DROP);
+
+    if (has_drop && can_destructure_lhs && rhs_is_indexed) {
+        /* Code is of the form (def [a b] [1 2]), avoid the allocation of two tuples */
+        JanetView view_lhs = {0};
+        JanetView view_rhs = {0};
+        janet_indexed_view(lhs, &view_lhs.items, &view_lhs.len);
+        janet_indexed_view(rhs, &view_rhs.items, &view_rhs.len);
+        int found_amp = 0;
+        for (int32_t i = 0; i < view_lhs.len; i++) {
+            if (janet_symeq(view_lhs.items[i], "&")) {
+                found_amp = 1;
+                /* Good error will be generated later. */
+                break;
+            }
+        }
+        if (!found_amp) {
+            for (int32_t i = 0; i < view_lhs.len; i++) {
+                Janet sub_rhs = view_rhs.len <= i ? janet_wrap_nil() : view_rhs.items[i];
+                into = dohead_destructure(c, into, subopts, view_lhs.items[i], sub_rhs);
+            }
+            return into;
+        }
+    }
+
+    /* No optimization, do the simple way */
     subopts.hint = opts.hint;
-    ret = janetc_value(subopts, argv[argn - 1]);
-    return ret;
+    JanetSlot ret = janetc_value(subopts, rhs);
+    SlotHeadPair shp = {lhs, ret};
+    janet_v_push(into, shp);
+    return into;
 }
 
 /* Def or var a symbol in a local scope */
@@ -275,7 +391,17 @@ static int namelocal(JanetCompiler *c, const uint8_t *head, int32_t flags, Janet
     int isUnnamedRegister = !(ret.flags & JANET_SLOT_NAMED) &&
                             ret.index > 0 &&
                             ret.envindex >= 0;
-    if (!isUnnamedRegister) {
+    /* optimization for `(def x my-def)` - don't emit a movn/movf instruction, we can just alias my-def */
+    /* TODO - implement optimization for `(def x my-var)` correctly as well w/ de-aliasing */
+    int canAlias = !(flags & JANET_SLOT_MUTABLE) &&
+                   !(ret.flags & JANET_SLOT_MUTABLE) &&
+                   (ret.flags & JANET_SLOT_NAMED) &&
+                   (ret.index >= 0) &&
+                   (ret.envindex == -1);
+    if (canAlias) {
+        ret.flags &= ~JANET_SLOT_MUTABLE;
+        isUnnamedRegister = 1; /* don't free slot after use - is an alias for another slot */
+    } else if (!isUnnamedRegister) {
         /* Slot is not able to be named */
         JanetSlot localslot = janetc_farslot(c);
         janetc_copy(c, localslot, ret);
@@ -295,8 +421,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)));
@@ -311,11 +449,23 @@ static int varleaf(
 
 static JanetSlot janetc_var(JanetFopts opts, int32_t argn, const Janet *argv) {
     JanetCompiler *c = opts.compiler;
-    Janet head;
-    JanetSlot ret = dohead(c, opts, &head, argn, argv);
-    if (c->result.status == JANET_COMPILE_ERROR)
+    JanetTable *attr_table = handleattr(c, "var", 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));
+    }
+    SlotHeadPair *into = NULL;
+    into = dohead_destructure(c, into, opts, argv[0], argv[argn - 1]);
+    if (c->result.status == JANET_COMPILE_ERROR) {
+        janet_v_free(into);
+        return janetc_cslot(janet_wrap_nil());
+    }
+    JanetSlot ret;
+    janet_assert(janet_v_count(into) > 0, "bad destructure");
+    for (int32_t i = 0; i < janet_v_count(into); i++) {
+        destructure(c, into[i].lhs, into[i].rhs, varleaf, attr_table);
+        ret = into[i].rhs;
+    }
+    janet_v_free(into);
     return ret;
 }
 
@@ -328,29 +478,84 @@ 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);
 }
 
 static JanetSlot janetc_def(JanetFopts opts, int32_t argn, const Janet *argv) {
     JanetCompiler *c = opts.compiler;
-    Janet head;
-    opts.flags &= ~JANET_FOPTS_HINT;
-    JanetSlot ret = dohead(c, opts, &head, argn, argv);
-    if (c->result.status == JANET_COMPILE_ERROR)
+    JanetTable *attr_table = handleattr(c, "def", 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));
+    }
+    opts.flags &= ~JANET_FOPTS_HINT;
+    SlotHeadPair *into = NULL;
+    into = dohead_destructure(c, into, opts, argv[0], argv[argn - 1]);
+    if (c->result.status == JANET_COMPILE_ERROR) {
+        janet_v_free(into);
+        return janetc_cslot(janet_wrap_nil());
+    }
+    JanetSlot ret;
+    janet_assert(janet_v_count(into) > 0, "bad destructure");
+    for (int32_t i = 0; i < janet_v_count(into); i++) {
+        destructure(c, into[i].lhs, into[i].rhs, defleaf, attr_table);
+        ret = into[i].rhs;
+    }
+    janet_v_free(into);
     return ret;
 }
 
+/* Check if a form matches the pattern (= nil _) or (not= nil _) */
+static int janetc_check_nil_form(JanetFopts opts, Janet x, Janet *capture, uint32_t fun_tag) {
+    if (!janet_checktype(x, JANET_TUPLE)) return 0;
+    JanetTuple tup = janet_unwrap_tuple(x);
+    if (3 != janet_tuple_length(tup)) return 0;
+    Janet op1 = tup[0];
+    if (janet_checktype(op1, JANET_SYMBOL)) {
+        Janet entry = janet_table_get(opts.compiler->env, op1);
+        if (janet_checktype(entry, JANET_TABLE)) {
+            op1 = janet_table_get(janet_unwrap_table(entry), janet_ckeywordv("value"));
+        }
+    }
+    if (!janet_checktype(op1, JANET_FUNCTION)) return 0;
+    JanetFunction *fun = janet_unwrap_function(op1);
+    uint32_t tag = fun->def->flags & JANET_FUNCDEF_FLAG_TAG;
+    if (tag != fun_tag) return 0;
+    if (janet_checktype(tup[1], JANET_NIL)) {
+        *capture = tup[2];
+        return 1;
+    } else if (janet_checktype(tup[2], JANET_NIL)) {
+        *capture = tup[1];
+        return 1;
+    }
+    return 0;
+}
+
 /*
  * :condition
  * ...
@@ -371,6 +576,7 @@ static JanetSlot janetc_if(JanetFopts opts, int32_t argn, const Janet *argv) {
     JanetScope condscope, tempscope;
     const int tail = opts.flags & JANET_FOPTS_TAIL;
     const int drop = opts.flags & JANET_FOPTS_DROP;
+    uint8_t ifnjmp = JOP_JUMP_IF_NOT;
 
     if (argn < 2 || argn > 3) {
         janetc_cerror(c, "expected 2 or 3 arguments to if");
@@ -384,6 +590,7 @@ static JanetSlot janetc_if(JanetFopts opts, int32_t argn, const Janet *argv) {
     /* Get options */
     condopts = janetc_fopts_default(c);
     bodyopts = opts;
+    bodyopts.flags &= ~JANET_FOPTS_ACCEPT_SPLICE;
 
     /* Set target for compilation */
     target = (drop || tail)
@@ -392,7 +599,16 @@ static JanetSlot janetc_if(JanetFopts opts, int32_t argn, const Janet *argv) {
 
     /* Compile condition */
     janetc_scope(&condscope, c, 0, "if");
-    cond = janetc_value(condopts, argv[0]);
+
+    Janet condform = argv[0];
+    if (janetc_check_nil_form(opts, condform, &condform, JANET_FUN_EQ)) {
+        ifnjmp = JOP_JUMP_IF_NOT_NIL;
+    }
+    if (janetc_check_nil_form(opts, condform, &condform, JANET_FUN_NEQ)) {
+        ifnjmp = JOP_JUMP_IF_NIL;
+    }
+
+    cond = janetc_value(condopts, condform);
 
     /* Check constant condition. */
     /* TODO: Use type info for more short circuits */
@@ -407,13 +623,15 @@ static JanetSlot janetc_if(JanetFopts opts, int32_t argn, const Janet *argv) {
         right = janetc_value(bodyopts, truebody);
         if (!drop && !tail) janetc_copy(c, target, right);
         janetc_popscope(c);
-        janetc_throwaway(bodyopts, falsebody);
+        if (!janet_checktype(falsebody, JANET_NIL)) {
+            janetc_throwaway(bodyopts, falsebody);
+        }
         janetc_popscope(c);
         return target;
     }
 
     /* Compile jump to right */
-    labeljr = janetc_emit_si(c, JOP_JUMP_IF_NOT, cond, 0, 0);
+    labeljr = janetc_emit_si(c, ifnjmp, cond, 0, 0);
 
     /* Condition left body */
     janetc_scope(&tempscope, c, 0, "if-true");
@@ -423,7 +641,7 @@ static JanetSlot janetc_if(JanetFopts opts, int32_t argn, const Janet *argv) {
 
     /* Compile jump to done */
     labeljd = janet_v_count(c->buffer);
-    if (!tail) janetc_emit(c, JOP_JUMP);
+    if (!tail && !(drop && janet_checktype(falsebody, JANET_NIL))) janetc_emit(c, JOP_JUMP);
 
     /* Compile right body */
     labelr = janet_v_count(c->buffer);
@@ -458,6 +676,7 @@ static JanetSlot janetc_do(JanetFopts opts, int32_t argn, const Janet *argv) {
             subopts.flags = JANET_FOPTS_DROP;
         } else {
             subopts = opts;
+            subopts.flags &= ~JANET_FOPTS_ACCEPT_SPLICE;
         }
         ret = janetc_value(subopts, argv[i]);
         if (i != argn - 1) {
@@ -468,7 +687,6 @@ static JanetSlot janetc_do(JanetFopts opts, int32_t argn, const Janet *argv) {
     return ret;
 }
 
-
 /* Compile an upscope form. Upscope forms execute their body sequentially and
  * evaluate to the last expression in the body, but without lexical scope. */
 static JanetSlot janetc_upscope(JanetFopts opts, int32_t argn, const Janet *argv) {
@@ -481,6 +699,7 @@ static JanetSlot janetc_upscope(JanetFopts opts, int32_t argn, const Janet *argv
             subopts.flags = JANET_FOPTS_DROP;
         } else {
             subopts = opts;
+            subopts.flags &= ~JANET_FOPTS_ACCEPT_SPLICE;
         }
         ret = janetc_value(subopts, argv[i]);
         if (i != argn - 1) {
@@ -558,20 +777,6 @@ static JanetSlot janetc_break(JanetFopts opts, int32_t argn, const Janet *argv)
     }
 }
 
-/* Check if a form matches the pattern (not= nil _) */
-static int janetc_check_notnil_form(Janet x, Janet *capture) {
-    if (!janet_checktype(x, JANET_TUPLE)) return 0;
-    JanetTuple tup = janet_unwrap_tuple(x);
-    if (!janet_checktype(tup[0], JANET_FUNCTION)) return 0;
-    if (3 != janet_tuple_length(tup)) return 0;
-    JanetFunction *fun = janet_unwrap_function(tup[0]);
-    uint32_t tag = fun->def->flags & JANET_FUNCDEF_FLAG_TAG;
-    if (tag != JANET_FUN_NEQ) return 0;
-    if (!janet_checktype(tup[1], JANET_NIL)) return 0;
-    *capture = tup[2];
-    return 1;
-}
-
 /*
  * :whiletop
  * ...
@@ -588,12 +793,13 @@ static JanetSlot janetc_while(JanetFopts opts, int32_t argn, const Janet *argv)
     JanetScope tempscope;
     int32_t labelwt, labeld, labeljt, labelc, i;
     int infinite = 0;
+    int is_nil_form = 0;
     int is_notnil_form = 0;
     uint8_t ifjmp = JOP_JUMP_IF;
     uint8_t ifnjmp = JOP_JUMP_IF_NOT;
 
-    if (argn < 2) {
-        janetc_cerror(c, "expected at least 2 arguments");
+    if (argn < 1) {
+        janetc_cerror(c, "expected at least 1 argument to while");
         return janetc_cslot(janet_wrap_nil());
     }
 
@@ -601,11 +807,16 @@ static JanetSlot janetc_while(JanetFopts opts, int32_t argn, const Janet *argv)
 
     janetc_scope(&tempscope, c, JANET_SCOPE_WHILE, "while");
 
-    /* Check for `(not= nil _)` in condition, and if so, use the
+    /* Check for `(= nil _)` or `(not= nil _)` in condition, and if so, use the
      * jmpnl or jmpnn instructions. This let's us implement `(each ...)`
      * more efficiently. */
     Janet condform = argv[0];
-    if (janetc_check_notnil_form(condform, &condform)) {
+    if (janetc_check_nil_form(opts, condform, &condform, JANET_FUN_EQ)) {
+        is_nil_form = 1;
+        ifjmp = JOP_JUMP_IF_NIL;
+        ifnjmp = JOP_JUMP_IF_NOT_NIL;
+    }
+    if (janetc_check_nil_form(opts, condform, &condform, JANET_FUN_NEQ)) {
         is_notnil_form = 1;
         ifjmp = JOP_JUMP_IF_NOT_NIL;
         ifnjmp = JOP_JUMP_IF_NIL;
@@ -617,7 +828,9 @@ static JanetSlot janetc_while(JanetFopts opts, int32_t argn, const Janet *argv)
     /* Check for constant condition */
     if (cond.flags & JANET_SLOT_CONSTANT) {
         /* Loop never executes */
-        int never_executes = is_notnil_form
+        int never_executes = is_nil_form
+                             ? !janet_checktype(cond.constant, JANET_NIL)
+                             : is_notnil_form
                              ? janet_checktype(cond.constant, JANET_NIL)
                              : !janet_truthy(cond.constant);
         if (never_executes) {
@@ -708,7 +921,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;
@@ -720,6 +933,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;
@@ -744,6 +958,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]);
@@ -751,49 +968,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));
@@ -805,6 +1048,7 @@ static JanetSlot janetc_fn(JanetFopts opts, int32_t argn, const Janet *argv) {
     for (i = 0; i < paramcount; i++) {
         Janet param = params[i];
         if (!janet_checktype(param, JANET_SYMBOL)) {
+            janet_assert(janet_v_count(destructed_params) > j, "out of bounds");
             JanetSlot reg = destructed_params[j++];
             destructure(c, param, reg, defleaf, NULL);
             janetc_freeslot(c, reg);
@@ -812,15 +1056,37 @@ 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;
 
-    /* Check for self ref */
+    /* Check for self ref (also avoid if arguments shadow own name) */
     if (selfref) {
-        JanetSlot slot = janetc_farslot(c);
-        slot.flags = JANET_SLOT_NAMED | JANET_FUNCTION;
-        janetc_emit_s(c, JOP_LOAD_SELF, slot, 1);
-        janetc_nameslot(c, janet_unwrap_symbol(head), slot);
+        /* Check if the parameters shadow the function name. If so, don't
+         * emit JOP_LOAD_SELF and add a binding since that most users
+         * seem to expect that function parameters take precedence over the
+         * function name */
+        const uint8_t *sym = janet_unwrap_symbol(head);
+        int32_t len = janet_v_count(c->scope->syms);
+        int found = 0;
+        for (int32_t i = 0; i < len; i++) {
+            if (c->scope->syms[i].sym == sym) {
+                found = 1;
+            }
+        }
+        if (!found) {
+            JanetSlot slot = janetc_farslot(c);
+            slot.flags = JANET_SLOT_NAMED | JANET_FUNCTION;
+            janetc_emit_s(c, JOP_LOAD_SELF, slot, 1);
+            janetc_nameslot(c, sym, slot);
+        }
     }
 
     /* Compile function body */
@@ -887,4 +1153,3 @@ const JanetSpecial *janetc_special(const uint8_t *name) {
                sizeof(JanetSpecial),
                name);
 }
-

src/core/state.c

@@ -0,0 +1,79 @@
+/*
+* 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
+* 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 "state.h"
+#include "util.h"
+#endif
+
+#ifdef JANET_WINDOWS
+#include <windows.h>
+#endif
+
+JANET_THREAD_LOCAL JanetVM janet_vm;
+
+JanetVM *janet_local_vm(void) {
+    return &janet_vm;
+}
+
+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;
+#ifdef JANET_WINDOWS
+    InterlockedIncrement(&vm->auto_suspend);
+#else
+    __atomic_add_fetch(&vm->auto_suspend, 1, __ATOMIC_RELAXED);
+#endif
+}
+
+void janet_interpreter_interrupt_handled(JanetVM *vm) {
+    vm = vm ? vm : &janet_vm;
+#ifdef JANET_WINDOWS
+    InterlockedDecrement(&vm->auto_suspend);
+#else
+    __atomic_add_fetch(&vm->auto_suspend, -1, __ATOMIC_RELAXED);
+#endif
+}

src/core/state.h

@@ -1,5 +1,5 @@
 /*
-* Copyright (c) 2020 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,83 +23,167 @@
 #ifndef JANET_STATE_H_defined
 #define JANET_STATE_H_defined
 
+#include <janet.h>
 #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. */
+    volatile int32_t 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;
+    int gc_mark_phase;
+
+    /* 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;
+
+    /* Sandbox flags */
+    uint32_t sandbox_flags;
+
+    /* 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;
+    volatile size_t extra_listeners; /* used in signal handler, must be volatile */
+    JanetTable threaded_abstracts; /* All abstract types that can be shared between threads (used in this thread) */
+    JanetTable active_tasks; /* All possibly live task fibers - used just for tracking */
+    JanetArray *listeners; /* For GC */
+    JanetTable signal_handlers;
+#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) 2020 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
@@ -108,7 +108,7 @@ static void kmp_init(
     if (patlen == 0) {
         janet_panic("expected non-empty pattern");
     }
-    int32_t *lookup = calloc(patlen, sizeof(int32_t));
+    int32_t *lookup = janet_calloc(patlen, sizeof(int32_t));
     if (!lookup) {
         JANET_OUT_OF_MEMORY;
     }
@@ -131,7 +131,7 @@ static void kmp_init(
 }
 
 static void kmp_deinit(struct kmp_state *state) {
-    free(state->lookup);
+    janet_free(state->lookup);
 }
 
 static void kmp_seti(struct kmp_state *state, int32_t i) {
@@ -170,25 +170,38 @@ 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 if `start` is negative it is "
+              "exclusive, and if `end` is negative it is inclusive, 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 +217,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 +230,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 +243,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 +262,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 +281,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 +307,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 +322,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 +333,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 +346,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);
@@ -324,14 +365,13 @@ static Janet cfun_string_findall(int32_t argc, Janet *argv) {
 
 struct replace_state {
     struct kmp_state kmp;
-    const uint8_t *subst;
-    int32_t substlen;
+    Janet subst;
 };
 
 static void replacesetup(int32_t argc, Janet *argv, struct replace_state *s) {
     janet_arity(argc, 3, 4);
     JanetByteView pat = janet_getbytes(argv, 0);
-    JanetByteView subst = janet_getbytes(argv, 1);
+    Janet subst = argv[1];
     JanetByteView text = janet_getbytes(argv, 2);
     int32_t start = 0;
     if (argc == 4) {
@@ -340,11 +380,15 @@ static void replacesetup(int32_t argc, Janet *argv, struct replace_state *s) {
     }
     kmp_init(&s->kmp, text.bytes, text.len, pat.bytes, pat.len);
     s->kmp.i = start;
-    s->subst = subst.bytes;
-    s->substlen = subst.len;
+    s->subst = subst;
 }
 
-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`. "
+              "If `subst` is a function, it will be called with `patt` only if a match is found, "
+              "and should return the actual replacement text to use. "
+              "Will return the new string if `patt` is found, otherwise returns `str`.") {
     int32_t result;
     struct replace_state s;
     uint8_t *buf;
@@ -354,17 +398,24 @@ static Janet cfun_string_replace(int32_t argc, Janet *argv) {
         kmp_deinit(&s.kmp);
         return janet_stringv(s.kmp.text, s.kmp.textlen);
     }
-    buf = janet_string_begin(s.kmp.textlen - s.kmp.patlen + s.substlen);
+    JanetByteView subst = janet_text_substitution(&s.subst, s.kmp.text + result, s.kmp.patlen, NULL);
+    buf = janet_string_begin(s.kmp.textlen - s.kmp.patlen + subst.len);
     safe_memcpy(buf, s.kmp.text, result);
-    safe_memcpy(buf + result, s.subst, s.substlen);
-    safe_memcpy(buf + result + s.substlen,
+    safe_memcpy(buf + result, subst.bytes, subst.len);
+    safe_memcpy(buf + result + subst.len,
                 s.kmp.text + result + s.kmp.patlen,
                 s.kmp.textlen - result - s.kmp.patlen);
     kmp_deinit(&s.kmp);
     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. "
+              "If `subst` is a function, it will be called with `patt` once for each match, "
+              "and should return the actual replacement text to use. "
+              "Will return the new string if `patt` is found, otherwise returns `str`.") {
     int32_t result;
     struct replace_state s;
     JanetBuffer b;
@@ -372,8 +423,9 @@ static Janet cfun_string_replaceall(int32_t argc, Janet *argv) {
     replacesetup(argc, argv, &s);
     janet_buffer_init(&b, s.kmp.textlen);
     while ((result = kmp_next(&s.kmp)) >= 0) {
+        JanetByteView subst = janet_text_substitution(&s.subst, s.kmp.text + result, s.kmp.patlen, NULL);
         janet_buffer_push_bytes(&b, s.kmp.text + lastindex, result - lastindex);
-        janet_buffer_push_bytes(&b, s.subst, s.substlen);
+        janet_buffer_push_bytes(&b, subst.bytes, subst.len);
         lastindex = result + s.kmp.patlen;
         kmp_seti(&s.kmp, lastindex);
     }
@@ -384,7 +436,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 +464,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 +490,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 +533,33 @@ 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.\n\n"
+              "The following conversion specifiers are supported, where the upper case specifiers generate "
+              "upper case output:\n"
+              "- `c`: ASCII character.\n"
+              "- `d`, `i`: integer, formatted as a decimal number.\n"
+              "- `x`, `X`: integer, formatted as a hexadecimal number.\n"
+              "- `o`: integer, formatted as an octal number.\n"
+              "- `f`, `F`: floating point number, formatted as a decimal number.\n"
+              "- `e`, `E`: floating point number, formatted in scientific notation.\n"
+              "- `g`, `G`: floating point number, formatted in its shortest form.\n"
+              "- `a`, `A`: floating point number, formatted as a hexadecimal number.\n"
+              "- `s`: formatted as a string, precision indicates padding and maximum length.\n"
+              "- `t`: emit the type of the given value.\n"
+              "- `v`: format with (describe x)"
+              "- `V`: format with (string x)"
+              "- `j`: format to jdn (Janet data notation).\n"
+              "\n"
+              "The following conversion specifiers are used for \"pretty-printing\", where the upper-case "
+              "variants generate colored output. These speficiers can take a precision "
+              "argument to specify the maximum nesting depth to print.\n"
+              "- `p`, `P`: pretty format, truncating if necessary\n"
+              "- `m`, `M`: pretty format without truncating.\n"
+              "- `q`, `Q`: pretty format on one line, truncating if necessary.\n"
+              "- `n`, `N`: pretty format on one line without truncation.\n") {
     janet_arity(argc, 1, -1);
     JanetBuffer *buffer = janet_buffer(0);
     const char *strfrmt = (const char *) janet_getstring(argv, 0);
@@ -508,7 +599,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 +612,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)\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)\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) 2020 Calvin Rose
+* Copyright (c) 2023 Calvin Rose
 *
 * Permission is hereby granted, free of charge, to any person obtaining a copy
 * of this software and associated documentation files (the "Software"), to
@@ -87,7 +87,7 @@ static uint32_t *bignat_extra(struct BigNat *mant, int32_t n) {
     int32_t newn = oldn + n;
     if (mant->cap < newn) {
         int32_t newcap = 2 * newn;
-        uint32_t *mem = realloc(mant->digits, (size_t) newcap * sizeof(uint32_t));
+        uint32_t *mem = janet_realloc(mant->digits, (size_t) newcap * sizeof(uint32_t));
         if (NULL == mem) {
             JANET_OUT_OF_MEMORY;
         }
@@ -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 */
@@ -368,14 +375,21 @@ int janet_scan_number(
         goto error;
 
     *out = convert(neg, &mant, base, ex);
-    free(mant.digits);
+    janet_free(mant.digits);
     return 0;
 
 error:
-    free(mant.digits);
+    janet_free(mant.digits);
     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) 2020 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) 2020 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 = 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() {
-    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,14 +100,15 @@ 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:
     *success = 0;
+    janet_assert(firstEmpty != NULL, "symcache failed to get memory");
     return firstEmpty;
 }
 
@@ -121,15 +118,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 **newCache = calloc(1, (size_t) newCapacity * sizeof(const uint8_t *));
+    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;
@@ -145,18 +142,18 @@ static void janet_cache_resize(uint32_t newCapacity) {
         }
     }
     /* Free the old cache */
-    free((void *)oldCache);
+    janet_free((void *)oldCache);
 }
 
 /* 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 +162,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 +191,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 +221,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) 2020 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) 2020 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 */
@@ -102,12 +111,11 @@ static void janet_table_rehash(JanetTable *t, int32_t size) {
             JANET_OUT_OF_MEMORY;
         }
     }
-    int32_t i, oldcapacity;
-    oldcapacity = t->capacity;
+    int32_t oldcapacity = t->capacity;
     t->data = newdata;
     t->capacity = size;
     t->deleted = 0;
-    for (i = 0; i < oldcapacity; i++) {
+    for (int32_t i = 0; i < oldcapacity; i++) {
         JanetKV *kv = olddata + i;
         if (!janet_checktype(kv->key, JANET_NIL)) {
             JanetKV *newkv = janet_table_find(t, kv->key);
@@ -117,43 +125,27 @@ static void janet_table_rehash(JanetTable *t, int32_t size) {
     if (islocal) {
         janet_sfree(olddata);
     } else {
-        free(olddata);
+        janet_free(olddata);
     }
 }
 
 /* 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 +200,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 +226,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));
@@ -237,7 +233,7 @@ JanetTable *janet_table_clone(JanetTable *table) {
     newTable->capacity = table->capacity;
     newTable->deleted = table->deleted;
     newTable->proto = table->proto;
-    newTable->data = malloc(newTable->capacity * sizeof(JanetKV));
+    newTable->data = janet_malloc(newTable->capacity * sizeof(JanetKV));
     if (NULL == newTable->data) {
         JANET_OUT_OF_MEMORY;
     }
@@ -266,15 +262,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 +314,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 +327,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) 2020 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 = 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);
-    }
-    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 = 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);
-    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) 2020 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 if `start` is negative it is "
+              "exclusive, and if `end` is negative it is inclusive, 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/typedarray.c

@@ -1,614 +0,0 @@
-/*
-* Copyright (c) 2020 Calvin Rose & contributors
-*
-* Permission is hereby granted, free of charge, to any person obtaining a copy
-* of this software and associated documentation files (the "Software"), to
-* deal in the Software without restriction, including without limitation the
-* rights to use, copy, modify, merge, publish, distribute, sublicense, and/or
-* sell copies of the Software, and to permit persons to whom the Software is
-* furnished to do so, subject to the following conditions:
-*
-* The above copyright notice and this permission notice shall be included in
-* all copies or substantial portions of the Software.
-*
-* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
-* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
-* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
-* AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
-* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
-* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS
-* IN THE SOFTWARE.
-*/
-
-#ifndef JANET_AMALG
-#include "features.h"
-#include <janet.h>
-#include "util.h"
-#endif
-
-#ifdef JANET_TYPED_ARRAY
-
-static char *ta_type_names[] = {
-    "uint8",
-    "int8",
-    "uint16",
-    "int16",
-    "uint32",
-    "int32",
-    "uint64",
-    "int64",
-    "float32",
-    "float64",
-    "?"
-};
-
-static size_t ta_type_sizes[] = {
-    sizeof(uint8_t),
-    sizeof(int8_t),
-    sizeof(uint16_t),
-    sizeof(int16_t),
-    sizeof(uint32_t),
-    sizeof(int32_t),
-    sizeof(uint64_t),
-    sizeof(int64_t),
-    sizeof(float),
-    sizeof(double),
-    0
-};
-
-#define TA_COUNT_TYPES (JANET_TARRAY_TYPE_F64 + 1)
-#define TA_ATOM_MAXSIZE 8
-#define TA_FLAG_BIG_ENDIAN 1
-
-static JanetTArrayType get_ta_type_by_name(const uint8_t *name) {
-    for (int i = 0; i < TA_COUNT_TYPES; i++) {
-        if (!janet_cstrcmp(name, ta_type_names[i]))
-            return i;
-    }
-    janet_panicf("invalid typed array type %S", name);
-    return 0;
-}
-
-static JanetTArrayBuffer *ta_buffer_init(JanetTArrayBuffer *buf, size_t size) {
-    buf->data = NULL;
-    if (size > 0) {
-        buf->data = (uint8_t *)calloc(size, sizeof(uint8_t));
-        if (buf->data == NULL) {
-            JANET_OUT_OF_MEMORY;
-        }
-    }
-    buf->size = size;
-#ifdef JANET_BIG_ENDIAN
-    buf->flags = TA_FLAG_BIG_ENDIAN;
-#else
-    buf->flags = 0;
-#endif
-    return buf;
-}
-
-static int ta_buffer_gc(void *p, size_t s) {
-    (void) s;
-    JanetTArrayBuffer *buf = (JanetTArrayBuffer *)p;
-    free(buf->data);
-    return 0;
-}
-
-static void ta_buffer_marshal(void *p, JanetMarshalContext *ctx) {
-    JanetTArrayBuffer *buf = (JanetTArrayBuffer *)p;
-    janet_marshal_abstract(ctx, p);
-    janet_marshal_size(ctx, buf->size);
-    janet_marshal_int(ctx, buf->flags);
-    janet_marshal_bytes(ctx, buf->data, buf->size);
-}
-
-static void *ta_buffer_unmarshal(JanetMarshalContext *ctx) {
-    JanetTArrayBuffer *buf = janet_unmarshal_abstract(ctx, sizeof(JanetTArrayBuffer));
-    size_t size = janet_unmarshal_size(ctx);
-    int32_t flags = janet_unmarshal_int(ctx);
-    ta_buffer_init(buf, size);
-    buf->flags = flags;
-    janet_unmarshal_bytes(ctx, buf->data, size);
-    return buf;
-}
-
-const JanetAbstractType janet_ta_buffer_type = {
-    "ta/buffer",
-    ta_buffer_gc,
-    NULL,
-    NULL,
-    NULL,
-    ta_buffer_marshal,
-    ta_buffer_unmarshal,
-    JANET_ATEND_UNMARSHAL
-};
-
-static int ta_mark(void *p, size_t s) {
-    (void) s;
-    JanetTArrayView *view = (JanetTArrayView *)p;
-    janet_mark(janet_wrap_abstract(view->buffer));
-    return 0;
-}
-
-static void ta_view_marshal(void *p, JanetMarshalContext *ctx) {
-    JanetTArrayView *view = (JanetTArrayView *)p;
-    size_t offset = (view->buffer->data - view->as.u8);
-    janet_marshal_abstract(ctx, p);
-    janet_marshal_size(ctx, view->size);
-    janet_marshal_size(ctx, view->stride);
-    janet_marshal_int(ctx, view->type);
-    janet_marshal_size(ctx, offset);
-    janet_marshal_janet(ctx, janet_wrap_abstract(view->buffer));
-}
-
-static void *ta_view_unmarshal(JanetMarshalContext *ctx) {
-    size_t offset;
-    int32_t atype;
-    Janet buffer;
-    JanetTArrayView *view = janet_unmarshal_abstract(ctx, sizeof(JanetTArrayView));
-    view->size = janet_unmarshal_size(ctx);
-    view->stride = janet_unmarshal_size(ctx);
-    atype = janet_unmarshal_int(ctx);
-    if (atype < 0 || atype >= TA_COUNT_TYPES)
-        janet_panic("bad typed array type");
-    view->type = atype;
-    offset = janet_unmarshal_size(ctx);
-    buffer = janet_unmarshal_janet(ctx);
-    if (!janet_checktype(buffer, JANET_ABSTRACT) ||
-            (janet_abstract_type(janet_unwrap_abstract(buffer)) != &janet_ta_buffer_type)) {
-        janet_panicf("expected typed array buffer");
-    }
-    view->buffer = (JanetTArrayBuffer *)janet_unwrap_abstract(buffer);
-    size_t buf_need_size = offset + (ta_type_sizes[view->type]) * ((view->size - 1) * view->stride + 1);
-    if (view->buffer->size < buf_need_size)
-        janet_panic("bad typed array offset in marshalled data");
-    view->as.u8 = view->buffer->data + offset;
-    return view;
-}
-
-static JanetMethod tarray_view_methods[6];
-
-static int ta_getter(void *p, Janet key, Janet *out) {
-    size_t index, i;
-    JanetTArrayView *array = p;
-    if (janet_checktype(key, JANET_KEYWORD)) {
-        return janet_getmethod(janet_unwrap_keyword(key), tarray_view_methods, out);
-    }
-    if (!janet_checksize(key)) janet_panic("expected size as key");
-    index = (size_t) janet_unwrap_number(key);
-    i = index * array->stride;
-    if (index >= array->size) {
-        return 0;
-    } else {
-        switch (array->type) {
-            case JANET_TARRAY_TYPE_U8:
-                *out = janet_wrap_number(array->as.u8[i]);
-                break;
-            case JANET_TARRAY_TYPE_S8:
-                *out = janet_wrap_number(array->as.s8[i]);
-                break;
-            case JANET_TARRAY_TYPE_U16:
-                *out = janet_wrap_number(array->as.u16[i]);
-                break;
-            case JANET_TARRAY_TYPE_S16:
-                *out = janet_wrap_number(array->as.s16[i]);
-                break;
-            case JANET_TARRAY_TYPE_U32:
-                *out = janet_wrap_number(array->as.u32[i]);
-                break;
-            case JANET_TARRAY_TYPE_S32:
-                *out = janet_wrap_number(array->as.s32[i]);
-                break;
-#ifdef JANET_INT_TYPES
-            case JANET_TARRAY_TYPE_U64:
-                *out = janet_wrap_u64(array->as.u64[i]);
-                break;
-            case JANET_TARRAY_TYPE_S64:
-                *out = janet_wrap_s64(array->as.s64[i]);
-                break;
-#endif
-            case JANET_TARRAY_TYPE_F32:
-                *out = janet_wrap_number_safe(array->as.f32[i]);
-                break;
-            case JANET_TARRAY_TYPE_F64:
-                *out = janet_wrap_number_safe(array->as.f64[i]);
-                break;
-            default:
-                janet_panicf("cannot get from typed array of type %s",
-                             ta_type_names[array->type]);
-                break;
-        }
-    }
-    return 1;
-}
-
-static void ta_setter(void *p, Janet key, Janet value) {
-    size_t index, i;
-    if (!janet_checksize(key)) janet_panic("expected size as key");
-    index = (size_t) janet_unwrap_number(key);
-    JanetTArrayView *array = p;
-    i = index * array->stride;
-    if (index >= array->size) {
-        janet_panic("index out of bounds");
-    }
-    if (!janet_checktype(value, JANET_NUMBER) &&
-            array->type != JANET_TARRAY_TYPE_U64 &&
-            array->type != JANET_TARRAY_TYPE_S64) {
-        janet_panic("expected number value");
-    }
-    switch (array->type) {
-        case JANET_TARRAY_TYPE_U8:
-            array->as.u8[i] = (uint8_t) janet_unwrap_number(value);
-            break;
-        case JANET_TARRAY_TYPE_S8:
-            array->as.s8[i] = (int8_t) janet_unwrap_number(value);
-            break;
-        case JANET_TARRAY_TYPE_U16:
-            array->as.u16[i] = (uint16_t) janet_unwrap_number(value);
-            break;
-        case JANET_TARRAY_TYPE_S16:
-            array->as.s16[i] = (int16_t) janet_unwrap_number(value);
-            break;
-        case JANET_TARRAY_TYPE_U32:
-            array->as.u32[i] = (uint32_t) janet_unwrap_number(value);
-            break;
-        case JANET_TARRAY_TYPE_S32:
-            array->as.s32[i] = (int32_t) janet_unwrap_number(value);
-            break;
-#ifdef JANET_INT_TYPES
-        case JANET_TARRAY_TYPE_U64:
-            array->as.u64[i] = janet_unwrap_u64(value);
-            break;
-        case JANET_TARRAY_TYPE_S64:
-            array->as.s64[i] = janet_unwrap_s64(value);
-            break;
-#endif
-        case JANET_TARRAY_TYPE_F32:
-            array->as.f32[i] = (float) janet_unwrap_number(value);
-            break;
-        case JANET_TARRAY_TYPE_F64:
-            array->as.f64[i] = janet_unwrap_number(value);
-            break;
-        default:
-            janet_panicf("cannot set typed array of type %s",
-                         ta_type_names[array->type]);
-            break;
-    }
-}
-
-static Janet ta_view_next(void *p, Janet key) {
-    JanetTArrayView *view = p;
-    if (janet_checktype(key, JANET_NIL)) {
-        if (view->size > 0) {
-            return janet_wrap_number(0);
-        } else {
-            return janet_wrap_nil();
-        }
-    }
-    if (!janet_checksize(key)) janet_panic("expected size as key");
-    size_t index = (size_t) janet_unwrap_number(key);
-    index++;
-    if (index < view->size) {
-        return janet_wrap_number((double) index);
-    }
-    return janet_wrap_nil();
-}
-
-const JanetAbstractType janet_ta_view_type = {
-    "ta/view",
-    NULL,
-    ta_mark,
-    ta_getter,
-    ta_setter,
-    ta_view_marshal,
-    ta_view_unmarshal,
-    NULL,
-    NULL,
-    NULL,
-    ta_view_next,
-    JANET_ATEND_NEXT
-};
-
-JanetTArrayBuffer *janet_tarray_buffer(size_t size) {
-    JanetTArrayBuffer *buf = janet_abstract(&janet_ta_buffer_type, sizeof(JanetTArrayBuffer));
-    ta_buffer_init(buf, size);
-    return buf;
-}
-
-JanetTArrayView *janet_tarray_view(
-    JanetTArrayType type,
-    size_t size,
-    size_t stride,
-    size_t offset,
-    JanetTArrayBuffer *buffer) {
-
-    JanetTArrayView *view = janet_abstract(&janet_ta_view_type, sizeof(JanetTArrayView));
-
-    if ((stride < 1) || (size < 1)) janet_panic("stride and size should be > 0");
-    size_t buf_size = offset + ta_type_sizes[type] * ((size - 1) * stride + 1);
-
-    if (NULL == buffer) {
-        buffer = janet_abstract(&janet_ta_buffer_type, sizeof(JanetTArrayBuffer));
-        ta_buffer_init(buffer, buf_size);
-    }
-
-    if (buffer->size < buf_size) {
-        janet_panicf("bad buffer size, %i bytes allocated < %i required",
-                     buffer->size,
-                     buf_size);
-    }
-
-    view->buffer = buffer;
-    view->stride = stride;
-    view->size = size;
-    view->as.u8 = buffer->data + offset;
-    view->type = type;
-
-    return view;
-}
-
-JanetTArrayBuffer *janet_gettarray_buffer(const Janet *argv, int32_t n) {
-    return janet_getabstract(argv, n, &janet_ta_buffer_type);
-}
-
-JanetTArrayView *janet_gettarray_any(const Janet *argv, int32_t n) {
-    return janet_getabstract(argv, n, &janet_ta_view_type);
-}
-
-JanetTArrayView *janet_gettarray_view(const Janet *argv, int32_t n, JanetTArrayType type) {
-    JanetTArrayView *view = janet_getabstract(argv, n, &janet_ta_view_type);
-    if (view->type != type) {
-        janet_panicf("bad slot #%d, expected typed array of type %s, got %v",
-                     n, ta_type_names[type], argv[n]);
-    }
-    return view;
-}
-
-static Janet cfun_typed_array_new(int32_t argc, Janet *argv) {
-    janet_arity(argc, 2, 5);
-    size_t offset = 0;
-    size_t stride = 1;
-    JanetTArrayBuffer *buffer = NULL;
-    const uint8_t *keyw = janet_getkeyword(argv, 0);
-    JanetTArrayType type = get_ta_type_by_name(keyw);
-    size_t size = janet_getsize(argv, 1);
-    if (argc > 2)
-        stride = janet_getsize(argv, 2);
-    if (argc > 3)
-        offset = janet_getsize(argv, 3);
-    if (argc > 4) {
-        int32_t blen;
-        const uint8_t *bytes;
-        if (janet_bytes_view(argv[4], &bytes, &blen)) {
-            buffer = janet_abstract(&janet_ta_buffer_type, sizeof(JanetTArrayBuffer));
-            ta_buffer_init(buffer, (size_t) blen);
-            memcpy(buffer->data, bytes, blen);
-        } else {
-            if (!janet_checktype(argv[4], JANET_ABSTRACT)) {
-                janet_panicf("bad slot #%d, expected ta/view|ta/buffer, got %v",
-                             4, argv[4]);
-            }
-            void *p = janet_unwrap_abstract(argv[4]);
-            if (janet_abstract_type(p) == &janet_ta_view_type) {
-                JanetTArrayView *view = (JanetTArrayView *)p;
-                offset = (view->buffer->data - view->as.u8) + offset * ta_type_sizes[view->type];
-                stride *= view->stride;
-                buffer = view->buffer;
-            } else if (janet_abstract_type(p) == &janet_ta_buffer_type) {
-                buffer = p;
-            } else {
-                janet_panicf("bad slot #%d, expected ta/view|ta/buffer, got %v",
-                             4, argv[4]);
-            }
-        }
-    }
-    JanetTArrayView *view = janet_tarray_view(type, size, stride, offset, buffer);
-    return janet_wrap_abstract(view);
-}
-
-static JanetTArrayView *ta_is_view(Janet x) {
-    if (!janet_checktype(x, JANET_ABSTRACT)) return NULL;
-    void *abst = janet_unwrap_abstract(x);
-    if (janet_abstract_type(abst) != &janet_ta_view_type) return NULL;
-    return (JanetTArrayView *)abst;
-}
-
-static Janet cfun_typed_array_buffer(int32_t argc, Janet *argv) {
-    janet_fixarity(argc, 1);
-    JanetTArrayView *view;
-    if ((view = ta_is_view(argv[0]))) {
-        return janet_wrap_abstract(view->buffer);
-    }
-    size_t size = janet_getsize(argv, 0);
-    JanetTArrayBuffer *buf = janet_tarray_buffer(size);
-    return janet_wrap_abstract(buf);
-}
-
-static Janet cfun_typed_array_size(int32_t argc, Janet *argv) {
-    janet_fixarity(argc, 1);
-    JanetTArrayView *view;
-    if ((view = ta_is_view(argv[0]))) {
-        return janet_wrap_number((double) view->size);
-    }
-    JanetTArrayBuffer *buf = (JanetTArrayBuffer *)janet_getabstract(argv, 0, &janet_ta_buffer_type);
-    return janet_wrap_number((double) buf->size);
-}
-
-static Janet cfun_typed_array_properties(int32_t argc, Janet *argv) {
-    janet_fixarity(argc, 1);
-    JanetTArrayView *view;
-    if ((view = ta_is_view(argv[0]))) {
-        JanetTArrayView *view = janet_unwrap_abstract(argv[0]);
-        JanetKV *props = janet_struct_begin(6);
-        ptrdiff_t boffset = view->as.u8 - view->buffer->data;
-        janet_struct_put(props, janet_ckeywordv("size"),
-                         janet_wrap_number((double) view->size));
-        janet_struct_put(props, janet_ckeywordv("byte-offset"),
-                         janet_wrap_number((double) boffset));
-        janet_struct_put(props, janet_ckeywordv("stride"),
-                         janet_wrap_number((double) view->stride));
-        janet_struct_put(props, janet_ckeywordv("type"),
-                         janet_ckeywordv(ta_type_names[view->type]));
-        janet_struct_put(props, janet_ckeywordv("type-size"),
-                         janet_wrap_number((double) ta_type_sizes[view->type]));
-        janet_struct_put(props, janet_ckeywordv("buffer"),
-                         janet_wrap_abstract(view->buffer));
-        return janet_wrap_struct(janet_struct_end(props));
-    } else {
-        JanetTArrayBuffer *buffer = janet_gettarray_buffer(argv, 0);
-        JanetKV *props = janet_struct_begin(2);
-        janet_struct_put(props, janet_ckeywordv("size"),
-                         janet_wrap_number((double) buffer->size));
-        janet_struct_put(props, janet_ckeywordv("big-endian"),
-                         janet_wrap_boolean(buffer->flags & TA_FLAG_BIG_ENDIAN));
-        return janet_wrap_struct(janet_struct_end(props));
-    }
-}
-
-static Janet cfun_typed_array_slice(int32_t argc, Janet *argv) {
-    janet_arity(argc, 1, 3);
-    JanetTArrayView *src = janet_getabstract(argv, 0, &janet_ta_view_type);
-    JanetRange range;
-    int32_t length = (int32_t)src->size;
-    if (argc == 1) {
-        range.start = 0;
-        range.end = length;
-    } else if (argc == 2) {
-        range.start = janet_gethalfrange(argv, 1, length, "start");
-        range.end = length;
-    } else {
-        range.start = janet_gethalfrange(argv, 1, length, "start");
-        range.end = janet_gethalfrange(argv, 2, length, "end");
-        if (range.end < range.start)
-            range.end = range.start;
-    }
-    JanetArray *array = janet_array(range.end - range.start);
-    if (array->data) {
-        for (int32_t i = range.start; i < range.end; i++) {
-            if (!ta_getter(src, janet_wrap_number(i), &array->data[i - range.start]))
-                array->data[i - range.start] = janet_wrap_nil();
-        }
-    }
-    array->count = range.end - range.start;
-    return janet_wrap_array(array);
-}
-
-static Janet cfun_typed_array_copy_bytes(int32_t argc, Janet *argv) {
-    janet_arity(argc, 4, 5);
-    JanetTArrayView *src = janet_getabstract(argv, 0, &janet_ta_view_type);
-    size_t index_src = janet_getsize(argv, 1);
-    JanetTArrayView *dst = janet_getabstract(argv, 2, &janet_ta_view_type);
-    size_t index_dst = janet_getsize(argv, 3);
-    size_t count = (argc == 5) ? janet_getsize(argv, 4) : 1;
-    size_t src_atom_size = ta_type_sizes[src->type];
-    size_t dst_atom_size = ta_type_sizes[dst->type];
-    size_t step_src = src->stride * src_atom_size;
-    size_t step_dst = dst->stride * dst_atom_size;
-    size_t pos_src = (src->as.u8 - src->buffer->data) + (index_src * step_src);
-    size_t pos_dst = (dst->as.u8 - dst->buffer->data) + (index_dst * step_dst);
-    uint8_t *ps = src->buffer->data + pos_src, * pd = dst->buffer->data + pos_dst;
-    if ((pos_dst + (count - 1)*step_dst + src_atom_size <= dst->buffer->size) &&
-            (pos_src + (count - 1)*step_src + src_atom_size <= src->buffer->size)) {
-        for (size_t i = 0; i < count; i++) {
-            memmove(pd, ps, src_atom_size);
-            pd += step_dst;
-            ps += step_src;
-        }
-    } else {
-        janet_panic("typed array copy out of bounds");
-    }
-    return janet_wrap_nil();
-}
-
-static Janet cfun_typed_array_swap_bytes(int32_t argc, Janet *argv) {
-    janet_arity(argc, 4, 5);
-    JanetTArrayView *src = janet_getabstract(argv, 0, &janet_ta_view_type);
-    size_t index_src = janet_getsize(argv, 1);
-    JanetTArrayView *dst = janet_getabstract(argv, 2, &janet_ta_view_type);
-    size_t index_dst = janet_getsize(argv, 3);
-    size_t count = (argc == 5) ? janet_getsize(argv, 4) : 1;
-    size_t src_atom_size = ta_type_sizes[src->type];
-    size_t dst_atom_size = ta_type_sizes[dst->type];
-    size_t step_src = src->stride * src_atom_size;
-    size_t step_dst = dst->stride * dst_atom_size;
-    size_t pos_src = (src->as.u8 - src->buffer->data) + (index_src * step_src);
-    size_t pos_dst = (dst->as.u8 - dst->buffer->data) + (index_dst * step_dst);
-    uint8_t *ps = src->buffer->data + pos_src, * pd = dst->buffer->data + pos_dst;
-    uint8_t temp[TA_ATOM_MAXSIZE];
-    if ((pos_dst + (count - 1)*step_dst + src_atom_size <= dst->buffer->size) &&
-            (pos_src + (count - 1)*step_src + src_atom_size <= src->buffer->size)) {
-        for (size_t i = 0; i < count; i++) {
-            memcpy(temp, ps, src_atom_size);
-            memcpy(ps, pd, src_atom_size);
-            memcpy(pd, temp, src_atom_size);
-            pd += step_dst;
-            ps += step_src;
-        }
-    } else {
-        janet_panic("typed array swap out of bounds");
-    }
-    return janet_wrap_nil();
-}
-
-static const JanetReg ta_cfuns[] = {
-    {
-        "tarray/new", cfun_typed_array_new,
-        JDOC("(tarray/new type size &opt stride offset tarray|buffer)\n\n"
-             "Create new typed array.")
-    },
-    {
-        "tarray/buffer", cfun_typed_array_buffer,
-        JDOC("(tarray/buffer array|size)\n\n"
-             "Return typed array buffer or create a new buffer.")
-    },
-    {
-        "tarray/length", cfun_typed_array_size,
-        JDOC("(tarray/length array|buffer)\n\n"
-             "Return typed array or buffer size.")
-    },
-    {
-        "tarray/properties", cfun_typed_array_properties,
-        JDOC("(tarray/properties array)\n\n"
-             "Return typed array properties as a struct.")
-    },
-    {
-        "tarray/copy-bytes", cfun_typed_array_copy_bytes,
-        JDOC("(tarray/copy-bytes src sindex dst dindex &opt count)\n\n"
-             "Copy count elements (default 1) of src array from index sindex "
-             "to dst array at position dindex "
-             "memory can overlap.")
-    },
-    {
-        "tarray/swap-bytes", cfun_typed_array_swap_bytes,
-        JDOC("(tarray/swap-bytes src sindex dst dindex &opt count)\n\n"
-             "Swap count elements (default 1) between src array from index sindex "
-             "and dst array at position dindex "
-             "memory can overlap.")
-    },
-    {
-        "tarray/slice", cfun_typed_array_slice,
-        JDOC("(tarray/slice tarr &opt start end)\n\n"
-             "Takes a slice of a typed array 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 typed array. By default, start is 0 and end is "
-             "the size of the typed array. Returns a new janet array.")
-    },
-    {NULL, NULL, NULL}
-};
-
-static JanetMethod tarray_view_methods[] = {
-    {"length", cfun_typed_array_size},
-    {"properties", cfun_typed_array_properties},
-    {"copy-bytes", cfun_typed_array_copy_bytes},
-    {"swap-bytes", cfun_typed_array_swap_bytes},
-    {"slice", cfun_typed_array_slice},
-    {NULL, NULL}
-};
-
-/* Module entry point */
-void janet_lib_typed_array(JanetTable *env) {
-    janet_core_cfuns(env, NULL, ta_cfuns);
-    janet_register_abstract_type(&janet_ta_buffer_type);
-    janet_register_abstract_type(&janet_ta_view_type);
-}
-
-#endif

src/core/util.c

@@ -1,5 +1,5 @@
 /*
-* Copyright (c) 2020 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 */
@@ -79,8 +92,8 @@ const char *const janet_signal_names[14] = {
     "user5",
     "user6",
     "user7",
-    "user8",
-    "user9"
+    "interrupt",
+    "await"
 };
 
 const char *const janet_status_names[16] = {
@@ -96,8 +109,8 @@ const char *const janet_status_names[16] = {
     "user5",
     "user6",
     "user7",
-    "user8",
-    "user9",
+    "interrupted",
+    "suspended",
     "new",
     "alive"
 };
@@ -105,6 +118,7 @@ const char *const janet_status_names[16] = {
 #ifndef JANET_PRF
 
 int32_t janet_string_calchash(const uint8_t *str, int32_t len) {
+    if (NULL == str) return 5381;
     const uint8_t *end = str + len;
     uint32_t hash = 5381;
     while (str < end)
@@ -224,13 +238,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 +256,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 +268,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 +381,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 = 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 = 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++;
-    }
-    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_smalloc(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_sfree(namebuf->buf);
+}
+
+static char *namebuf_name(NameBuf *namebuf, const char *suffix) {
+    size_t slen = strlen(suffix);
+    namebuf->buf = janet_srealloc(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,46 +590,145 @@ 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
 
-/* Resolve a symbol in the environment */
-JanetBindingType janet_resolve(JanetTable *env, const uint8_t *sym, Janet *out) {
-    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(),
+        JANET_BINDING_DEP_NONE
+    };
+
+    /* Check environment for entry */
     if (!janet_checktype(entry, JANET_TABLE))
-        return JANET_BINDING_NONE;
+        return binding;
     entry_table = janet_unwrap_table(entry);
-    if (!janet_checktype(
-                janet_table_get(entry_table, janet_ckeywordv("macro")),
-                JANET_NIL)) {
-        *out = janet_table_get(entry_table, janet_ckeywordv("value"));
-        return JANET_BINDING_MACRO;
+
+    /* deprecation check */
+    Janet deprecate = janet_table_get(entry_table, janet_ckeywordv("deprecated"));
+    if (janet_checktype(deprecate, JANET_KEYWORD)) {
+        JanetKeyword depkw = janet_unwrap_keyword(deprecate);
+        if (!janet_cstrcmp(depkw, "relaxed")) {
+            binding.deprecation = JANET_BINDING_DEP_RELAXED;
+        } else if (!janet_cstrcmp(depkw, "normal")) {
+            binding.deprecation = JANET_BINDING_DEP_NORMAL;
+        } else if (!janet_cstrcmp(depkw, "strict")) {
+            binding.deprecation = JANET_BINDING_DEP_STRICT;
+        }
+    } else if (!janet_checktype(deprecate, JANET_NIL)) {
+        binding.deprecation = JANET_BINDING_DEP_NORMAL;
     }
-    ref = janet_table_get(entry_table, janet_ckeywordv("ref"));
-    if (janet_checktype(ref, JANET_ARRAY)) {
-        *out = ref;
-        return JANET_BINDING_VAR;
+
+    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;
     }
-    *out = janet_table_get(entry_table, janet_ckeywordv("value"));
-    return JANET_BINDING_DEF;
+
+    if (ref_is_valid) {
+        binding.value = ref;
+        binding.type = redef ? JANET_BINDING_DYNAMIC_DEF : JANET_BINDING_VAR;
+    } else {
+        binding.value = value;
+        binding.type = JANET_BINDING_DEF;
+    }
+
+    return binding;
+}
+
+/* If the value at the given address can be coerced to a byte view,
+   return that byte view. If it can't, replace the value at the address
+   with the result of janet_to_string, and return a byte view over that
+   string. */
+static JanetByteView memoize_byte_view(Janet *value) {
+    JanetByteView result;
+    if (!janet_bytes_view(*value, &result.bytes, &result.len)) {
+        JanetString str = janet_to_string(*value);
+        *value = janet_wrap_string(str);
+        result.bytes = str;
+        result.len = janet_string_length(str);
+    }
+    return result;
+}
+
+static JanetByteView to_byte_view(Janet value) {
+    JanetByteView result;
+    if (!janet_bytes_view(value, &result.bytes, &result.len)) {
+        JanetString str = janet_to_string(value);
+        result.bytes = str;
+        result.len = janet_string_length(str);
+    }
+    return result;
+}
+
+JanetByteView janet_text_substitution(
+    Janet *subst,
+    const uint8_t *bytes,
+    uint32_t len,
+    JanetArray *extra_argv) {
+    int32_t extra_argc = extra_argv == NULL ? 0 : extra_argv->count;
+    JanetType type = janet_type(*subst);
+    switch (type) {
+        case JANET_FUNCTION:
+        case JANET_CFUNCTION: {
+            int32_t argc = 1 + extra_argc;
+            Janet *argv = janet_tuple_begin(argc);
+            argv[0] = janet_stringv(bytes, len);
+            for (int32_t i = 0; i < extra_argc; i++) {
+                argv[i + 1] = extra_argv->data[i];
+            }
+            janet_tuple_end(argv);
+            if (type == JANET_FUNCTION) {
+                return to_byte_view(janet_call(janet_unwrap_function(*subst), argc, argv));
+            } else {
+                return to_byte_view(janet_unwrap_cfunction(*subst)(argc, argv));
+            }
+        }
+        default:
+            return memoize_byte_view(subst);
+    }
+}
+
+JanetBinding janet_resolve_ext(JanetTable *env, const uint8_t *sym) {
+    Janet entry = janet_table_get(env, janet_wrap_symbol(sym));
+    return janet_binding_from_entry(entry);
+}
+
+JanetBindingType janet_resolve(JanetTable *env, const uint8_t *sym, Janet *out) {
+    JanetBinding binding = janet_resolve_ext(env, sym);
+    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;
 }
 
 /* Resolve a symbol in the core environment. */
@@ -536,15 +757,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;
 }
@@ -574,6 +805,13 @@ int janet_checkint(Janet x) {
     return janet_checkintrange(dval);
 }
 
+int janet_checkuint(Janet x) {
+    if (!janet_checktype(x, JANET_NUMBER))
+        return 0;
+    double dval = janet_unwrap_number(x);
+    return janet_checkuintrange(dval);
+}
+
 int janet_checkint64(Janet x) {
     if (!janet_checktype(x, JANET_NUMBER))
         return 0;
@@ -581,6 +819,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 janet_checkuint64range(dval);
+}
+
 int janet_checksize(Janet x) {
     if (!janet_checktype(x, JANET_NUMBER))
         return 0;
@@ -636,37 +881,74 @@ 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;
-    GetSystemTimeAsFileTime(&ftime);
-    int64_t wintime = (int64_t)(ftime.dwLowDateTime) | ((int64_t)(ftime.dwHighDateTime) << 32);
-    /* Windows epoch is January 1, 1601 apparently */
-    wintime -= 116444736000000000LL;
-    spec->tv_sec  = wintime / 10000000LL;
-    /* Resolution is 100 nanoseconds. */
-    spec->tv_nsec = wintime % 10000000LL * 100;
+#include <profileapi.h>
+int janet_gettime(struct timespec *spec, enum JanetTimeSource source) {
+    if (source == JANET_TIME_REALTIME) {
+        FILETIME ftime;
+        GetSystemTimeAsFileTime(&ftime);
+        int64_t wintime = (int64_t)(ftime.dwLowDateTime) | ((int64_t)(ftime.dwHighDateTime) << 32);
+        /* Windows epoch is January 1, 1601 apparently */
+        wintime -= 116444736000000000LL;
+        spec->tv_sec  = wintime / 10000000LL;
+        /* Resolution is 100 nanoseconds. */
+        spec->tv_nsec = wintime % 10000000LL * 100;
+    } else if (source == JANET_TIME_MONOTONIC) {
+        LARGE_INTEGER count;
+        LARGE_INTEGER perf_freq;
+        QueryPerformanceCounter(&count);
+        QueryPerformanceFrequency(&perf_freq);
+        spec->tv_sec = count.QuadPart / perf_freq.QuadPart;
+        spec->tv_nsec = (long)((count.QuadPart % perf_freq.QuadPart) * 1000000000 / perf_freq.QuadPart);
+    } else if (source == JANET_TIME_CPUTIME) {
+        FILETIME creationTime, exitTime, kernelTime, userTime;
+        GetProcessTimes(GetCurrentProcess(), &creationTime, &exitTime, &kernelTime, &userTime);
+        int64_t tmp = ((int64_t)userTime.dwHighDateTime << 32) + userTime.dwLowDateTime;
+        spec->tv_sec = tmp / 10000000LL;
+        spec->tv_nsec = tmp % 10000000LL * 100;
+    }
     return 0;
 }
-#elif defined(__MACH__)
-int janet_gettime(struct timespec *spec) {
-    clock_serv_t cclock;
-    mach_timespec_t mts;
-    host_get_clock_service(mach_host_self(), CALENDAR_CLOCK, &cclock);
-    clock_get_time(cclock, &mts);
-    mach_port_deallocate(mach_task_self(), cclock);
-    spec->tv_sec = mts.tv_sec;
-    spec->tv_nsec = mts.tv_nsec;
+/* 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, enum JanetTimeSource source) {
+    if (source == JANET_TIME_REALTIME) {
+        clock_serv_t cclock;
+        mach_timespec_t mts;
+        host_get_clock_service(mach_host_self(), CALENDAR_CLOCK, &cclock);
+        clock_get_time(cclock, &mts);
+        mach_port_deallocate(mach_task_self(), cclock);
+        spec->tv_sec = mts.tv_sec;
+        spec->tv_nsec = mts.tv_nsec;
+    } else if (source == JANET_TIME_MONOTONIC) {
+        clock_serv_t cclock;
+        int nsecs;
+        mach_msg_type_number_t count;
+        host_get_clock_service(mach_host_self(), clock, &cclock);
+        clock_get_attributes(cclock, CLOCK_GET_TIME_RES, (clock_attr_t)&nsecs, &count);
+        mach_port_deallocate(mach_task_self(), cclock);
+        clock_getres(CLOCK_MONOTONIC, spec);
+    }
+    if (source == JANET_TIME_CPUTIME) {
+        clock_t tmp = clock();
+        spec->tv_sec = tmp;
+        spec->tv_nsec = (tmp - spec->tv_sec) * 1.0e9;
+    }
     return 0;
 }
 #else
-int janet_gettime(struct timespec *spec) {
-    return clock_gettime(CLOCK_REALTIME, spec);
+int janet_gettime(struct timespec *spec, enum JanetTimeSource source) {
+    clockid_t cid = CLOCK_REALTIME;
+    if (source == JANET_TIME_REALTIME) {
+        cid = CLOCK_REALTIME;
+    } else if (source == JANET_TIME_MONOTONIC) {
+        cid = CLOCK_MONOTONIC;
+    } else if (source == JANET_TIME_CPUTIME) {
+        cid = CLOCK_PROCESS_CPUTIME_ID;
+    }
+    return clock_gettime(cid, spec);
 }
 #endif
 #endif
@@ -683,13 +965,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.
@@ -720,3 +1002,96 @@ int janet_cryptorand(uint8_t *out, size_t n) {
     return -1;
 #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) {
+    return janet_malloc(size);
+}
+
+void (janet_free)(void *ptr) {
+    janet_free(ptr);
+}
+
+void *(janet_calloc)(size_t nmemb, size_t size) {
+    return janet_calloc(nmemb, size);
+}
+
+void *(janet_realloc)(void *ptr, size_t size) {
+    return janet_realloc(ptr, size);
+}

src/core/util.h

@@ -1,5 +1,5 @@
 /*
-* Copyright (c) 2020 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>
@@ -40,7 +49,7 @@
 #ifndef JANET_EXIT
 #include <stdio.h>
 #define JANET_EXIT(m) do { \
-    fprintf(stderr, "C runtime error at line %d in file %s: %s\n",\
+    fprintf(stderr, "janet interpreter runtime error at line %d in file %s: %s\n",\
         __LINE__,\
         __FILE__,\
         (m));\
@@ -48,26 +57,17 @@
 } while (0)
 #endif
 
+#define JANET_MARSHAL_DECREF 0x40000
+
 #define janet_assert(c, m) do { \
     if (!(c)) JANET_EXIT((m)); \
 } while (0)
 
-/* 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)
-#endif
-
-/* 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);
@@ -92,20 +92,46 @@ 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);
+JanetByteView janet_text_substitution(
+    Janet *subst,
+    const uint8_t *bytes,
+    uint32_t len,
+    JanetArray *extra_args);
+
+/* 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 */
 #ifdef JANET_GETTIME
-int janet_gettime(struct timespec *spec);
+enum JanetTimeSource {
+    JANET_TIME_REALTIME,
+    JANET_TIME_MONOTONIC,
+    JANET_TIME_CPUTIME
+};
+int janet_gettime(struct timespec *spec, enum JanetTimeSource source);
 #endif
 
 /* strdup */
@@ -113,6 +139,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 */
@@ -122,6 +173,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);
@@ -141,9 +193,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;
@@ -153,5 +202,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 = 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)) {
@@ -264,6 +272,7 @@ int janet_equals(Janet x, Janet y) {
                 const Janet *t1 = janet_unwrap_tuple(x);
                 const Janet *t2 = janet_unwrap_tuple(y);
                 if (t1 == t2) break;
+                if (JANET_TUPLE_FLAG_BRACKETCTOR & (janet_tuple_flag(t1) ^ janet_tuple_flag(t2))) return 0;
                 if (janet_tuple_hash(t1) != janet_tuple_hash(t2)) return 0;
                 if (janet_tuple_length(t1) != janet_tuple_length(t2)) return 0;
                 push_traversal_node(janet_tuple_head(t1), janet_tuple_head(t2), 0);
@@ -276,6 +285,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 +296,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;
@@ -302,6 +322,7 @@ int32_t janet_hash(Janet x) {
             break;
         case JANET_TUPLE:
             hash = janet_tuple_hash(janet_unwrap_tuple(x));
+            hash += (janet_tuple_flag(janet_unwrap_tuple(x)) & JANET_TUPLE_FLAG_BRACKETCTOR) ? 1 : 0;
             break;
         case JANET_STRUCT:
             hash = janet_struct_hash(janet_unwrap_struct(x));
@@ -312,9 +333,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 +351,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 +369,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);
@@ -392,6 +414,9 @@ int janet_compare(Janet x, Janet y) {
             case JANET_TUPLE: {
                 const Janet *lhs = janet_unwrap_tuple(x);
                 const Janet *rhs = janet_unwrap_tuple(y);
+                if (JANET_TUPLE_FLAG_BRACKETCTOR & (janet_tuple_flag(lhs) ^ janet_tuple_flag(rhs))) {
+                    return (janet_tuple_flag(lhs) & JANET_TUPLE_FLAG_BRACKETCTOR) ? 1 : -1;
+                }
                 push_traversal_node(janet_tuple_head(lhs), janet_tuple_head(rhs), 1);
                 break;
             }
@@ -414,20 +439,21 @@ int janet_compare(Janet x, Janet y) {
     return status - 2;
 }
 
-static int32_t getter_checkint(Janet key, int32_t max) {
+static int32_t getter_checkint(JanetType type, Janet key, int32_t max) {
     if (!janet_checkint(key)) goto bad;
     int32_t ret = janet_unwrap_integer(key);
     if (ret < 0) goto bad;
     if (ret >= max) goto bad;
     return ret;
 bad:
-    janet_panicf("expected integer key in range [0, %d), got %v", max, key);
+    janet_panicf("expected integer key for %s in range [0, %d), got %v", janet_type_names[type], max, key);
 }
 
 /* Gets a value and returns. Can panic. */
 Janet janet_in(Janet ds, Janet key) {
     Janet value;
-    switch (janet_type(ds)) {
+    JanetType type = janet_type(ds);
+    switch (type) {
         default:
             janet_panicf("expected %T, got %v", JANET_TFLAG_LENGTHABLE, ds);
             break;
@@ -439,19 +465,19 @@ Janet janet_in(Janet ds, Janet key) {
             break;
         case JANET_ARRAY: {
             JanetArray *array = janet_unwrap_array(ds);
-            int32_t index = getter_checkint(key, array->count);
+            int32_t index = getter_checkint(type, key, array->count);
             value = array->data[index];
             break;
         }
         case JANET_TUPLE: {
             const Janet *tuple = janet_unwrap_tuple(ds);
             int32_t len = janet_tuple_length(tuple);
-            value = tuple[getter_checkint(key, len)];
+            value = tuple[getter_checkint(type, key, len)];
             break;
         }
         case JANET_BUFFER: {
             JanetBuffer *buffer = janet_unwrap_buffer(ds);
-            int32_t index = getter_checkint(key, buffer->count);
+            int32_t index = getter_checkint(type, key, buffer->count);
             value = janet_wrap_integer(buffer->data[index]);
             break;
         }
@@ -459,7 +485,7 @@ Janet janet_in(Janet ds, Janet key) {
         case JANET_SYMBOL:
         case JANET_KEYWORD: {
             const uint8_t *str = janet_unwrap_string(ds);
-            int32_t index = getter_checkint(key, janet_string_length(str));
+            int32_t index = getter_checkint(type, key, janet_string_length(str));
             value = janet_wrap_integer(str[index]);
             break;
         }
@@ -631,6 +657,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 +694,21 @@ 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 len is always less then double, we can never overflow */
+#ifdef JANET_32
+                return janet_wrap_number(len);
+#else
+                if (len < (size_t) JANET_INTMAX_INT64) {
+                    return janet_wrap_number((double) len);
+                } else {
+                    janet_panicf("integer length %u too large", len);
+                }
+#endif
+            }
             Janet argv[1] = { x };
             return janet_mcall("length", 1, argv);
         }
@@ -708,13 +758,14 @@ void janet_putindex(Janet ds, int32_t index, Janet value) {
 }
 
 void janet_put(Janet ds, Janet key, Janet value) {
-    switch (janet_type(ds)) {
+    JanetType type = janet_type(ds);
+    switch (type) {
         default:
             janet_panicf("expected %T, got %v",
                          JANET_TFLAG_ARRAY | JANET_TFLAG_BUFFER | JANET_TFLAG_TABLE, ds);
         case JANET_ARRAY: {
             JanetArray *array = janet_unwrap_array(ds);
-            int32_t index = getter_checkint(key, INT32_MAX - 1);
+            int32_t index = getter_checkint(type, key, INT32_MAX - 1);
             if (index >= array->count) {
                 janet_array_setcount(array, index + 1);
             }
@@ -723,7 +774,7 @@ void janet_put(Janet ds, Janet key, Janet value) {
         }
         case JANET_BUFFER: {
             JanetBuffer *buffer = janet_unwrap_buffer(ds);
-            int32_t index = getter_checkint(key, INT32_MAX - 1);
+            int32_t index = getter_checkint(type, key, INT32_MAX - 1);
             if (!janet_checkint(value))
                 janet_panicf("can only put integers in buffers, got %v", value);
             if (index >= buffer->count) {

src/core/vector.c

@@ -1,5 +1,5 @@
 /*
-* Copyright (c) 2020 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
@@ -40,10 +40,10 @@ void *janet_v_grow(void *v, int32_t increment, int32_t itemsize) {
 
 /* Convert a buffer to normal allocated memory (forget capacity) */
 void *janet_v_flattenmem(void *v, int32_t itemsize) {
-    int32_t *p;
+    char *p;
     if (NULL == v) return NULL;
     size_t size = (size_t) itemsize * janet_v__cnt(v);
-    p = malloc(size);
+    p = janet_malloc(size);
     if (NULL != p) {
         safe_memcpy(p, v, size);
         return p;

src/core/vector.h

@@ -1,5 +1,5 @@
 /*
-* Copyright (c) 2020 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,16 @@ 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) { \
+        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)\
@@ -138,7 +137,7 @@ JANET_THREAD_LOCAL jmp_buf *janet_vm_jmp_buf = NULL;
             vm_pcnext();\
         }\
     }
-#define _vm_bitop_immediate(op, type1)\
+#define _vm_bitop_immediate(op, type1, rangecheck, msg)\
     {\
         Janet op1 = stack[B];\
         if (!janet_checktype(op1, JANET_NUMBER)) {\
@@ -147,13 +146,15 @@ JANET_THREAD_LOCAL jmp_buf *janet_vm_jmp_buf = NULL;
             stack[A] = janet_mcall(#op, 2, _argv);\
             vm_checkgc_pcnext();\
         } else {\
-            type1 x1 = (type1) janet_unwrap_integer(op1);\
-            stack[A] = janet_wrap_integer(x1 op CS);\
+            double y1 = janet_unwrap_number(op1);\
+            if (!rangecheck(y1)) { vm_commit(); janet_panicf("value %v out of range for " msg, op1); }\
+            type1 x1 = (type1) y1;\
+            stack[A] = janet_wrap_number((type1) (x1 op CS));\
             vm_pcnext();\
         }\
     }
-#define vm_bitop_immediate(op) _vm_bitop_immediate(op, int32_t);
-#define vm_bitopu_immediate(op) _vm_bitop_immediate(op, uint32_t);
+#define vm_bitop_immediate(op) _vm_bitop_immediate(op, int32_t, janet_checkintrange, "32-bit signed integers");
+#define vm_bitopu_immediate(op) _vm_bitop_immediate(op, uint32_t, janet_checkuintrange, "32-bit unsigned integers");
 #define _vm_binop(op, wrap)\
     {\
         Janet op1 = stack[B];\
@@ -170,14 +171,18 @@ JANET_THREAD_LOCAL jmp_buf *janet_vm_jmp_buf = NULL;
         }\
     }
 #define vm_binop(op) _vm_binop(op, janet_wrap_number)
-#define _vm_bitop(op, type1)\
+#define _vm_bitop(op, type1, rangecheck, msg)\
     {\
         Janet op1 = stack[B];\
         Janet op2 = stack[C];\
         if (janet_checktype(op1, JANET_NUMBER) && janet_checktype(op2, JANET_NUMBER)) {\
-            type1 x1 = (type1) janet_unwrap_integer(op1);\
-            int32_t x2 = janet_unwrap_integer(op2);\
-            stack[A] = janet_wrap_integer(x1 op x2);\
+            double y1 = janet_unwrap_number(op1);\
+            double y2 = janet_unwrap_number(op2);\
+            if (!rangecheck(y1)) { vm_commit(); janet_panicf("value %v out of range for " msg, op1); }\
+            if (!janet_checkintrange(y2)) { vm_commit(); janet_panicf("rhs must be valid 32-bit signed integer, got %f", op2); }\
+            type1 x1 = (type1) y1;\
+            int32_t x2 = (int32_t) y2;\
+            stack[A] = janet_wrap_number((type1) (x1 op x2));\
             vm_pcnext();\
         } else {\
             vm_commit();\
@@ -185,8 +190,8 @@ JANET_THREAD_LOCAL jmp_buf *janet_vm_jmp_buf = NULL;
             vm_checkgc_pcnext();\
         }\
     }
-#define vm_bitop(op) _vm_bitop(op, int32_t)
-#define vm_bitopu(op) _vm_bitop(op, uint32_t)
+#define vm_bitop(op) _vm_bitop(op, int32_t, janet_checkintrange, "32-bit signed integers")
+#define vm_bitopu(op) _vm_bitop(op, uint32_t, janet_checkuintrange, "32-bit unsigned integers")
 #define vm_compop(op) \
     {\
         Janet op1 = stack[B];\
@@ -220,14 +225,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 */
@@ -275,11 +280,16 @@ static Janet call_nonfn(JanetFiber *fiber, Janet callee) {
     return janet_method_invoke(callee, argc, fiber->data + fiber->stacktop);
 }
 
+/* Method lookup could potentially handle tables specially... */
+static Janet method_to_fun(Janet method, Janet obj) {
+    return janet_get(obj, method);
+}
+
 /* Get a callable from a keyword method name and ensure that it is valid. */
 static Janet resolve_method(Janet name, JanetFiber *fiber) {
     int32_t argc = fiber->stacktop - fiber->stackstart;
     if (argc < 1) janet_panicf("method call (%v) takes at least 1 argument, got 0", name);
-    Janet callee = janet_get(fiber->data[fiber->stackstart], name);
+    Janet callee = method_to_fun(name, fiber->data[fiber->stackstart]);
     if (janet_checktype(callee, JANET_NIL))
         janet_panicf("unknown method %v invoked on %v", name, fiber->data[fiber->stackstart]);
     return callee;
@@ -287,8 +297,17 @@ static Janet resolve_method(Janet name, JanetFiber *fiber) {
 
 /* Lookup method on value x */
 static Janet janet_method_lookup(Janet x, const char *name) {
-    Janet kname = janet_ckeywordv(name);
-    return janet_get(x, kname);
+    return method_to_fun(janet_ckeywordv(name), x);
+}
+
+static Janet janet_unary_call(const char *method, Janet arg) {
+    Janet m = janet_method_lookup(arg, method);
+    if (janet_checktype(m, JANET_NIL)) {
+        janet_panicf("could not find method :%s for %v", method, arg);
+    } else {
+        Janet argv[1] = { arg };
+        return janet_method_invoke(m, 1, argv);
+    }
 }
 
 /* Call a method first on the righthand side, and then on the left hand side with a prefix */
@@ -311,7 +330,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 */
@@ -327,11 +346,13 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in) {
         &&label_JOP_RETURN_NIL,
         &&label_JOP_ADD_IMMEDIATE,
         &&label_JOP_ADD,
+        &&label_JOP_SUBTRACT_IMMEDIATE,
         &&label_JOP_SUBTRACT,
         &&label_JOP_MULTIPLY_IMMEDIATE,
         &&label_JOP_MULTIPLY,
         &&label_JOP_DIVIDE_IMMEDIATE,
         &&label_JOP_DIVIDE,
+        &&label_JOP_DIVIDE_FLOOR,
         &&label_JOP_MODULO,
         &&label_JOP_REMAINDER,
         &&label_JOP_BAND,
@@ -572,8 +593,6 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in) {
         &&label_unknown_op,
         &&label_unknown_op,
         &&label_unknown_op,
-        &&label_unknown_op,
-        &&label_unknown_op,
         &&label_unknown_op
     };
 #endif
@@ -587,7 +606,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;
     }
 
@@ -663,6 +682,9 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in) {
     VM_OP(JOP_ADD)
     vm_binop(+);
 
+    VM_OP(JOP_SUBTRACT_IMMEDIATE)
+    vm_binop_immediate(-);
+
     VM_OP(JOP_SUBTRACT)
     vm_binop(-);
 
@@ -678,14 +700,33 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in) {
     VM_OP(JOP_DIVIDE)
     vm_binop( /);
 
+    VM_OP(JOP_DIVIDE_FLOOR) {
+        Janet op1 = stack[B];
+        Janet op2 = stack[C];
+        if (janet_checktype(op1, JANET_NUMBER) && janet_checktype(op2, JANET_NUMBER)) {
+            double x1 = janet_unwrap_number(op1);
+            double x2 = janet_unwrap_number(op2);
+            stack[A] = janet_wrap_number(floor(x1 / x2));
+            vm_pcnext();
+        } else {
+            vm_commit();
+            stack[A] = janet_binop_call("div", "rdiv", op1, op2);
+            vm_checkgc_pcnext();
+        }
+    }
+
     VM_OP(JOP_MODULO) {
         Janet op1 = stack[B];
         Janet op2 = stack[C];
         if (janet_checktype(op1, JANET_NUMBER) && janet_checktype(op2, JANET_NUMBER)) {
             double x1 = janet_unwrap_number(op1);
             double x2 = janet_unwrap_number(op2);
-            double intres = x2 * floor(x1 / x2);
-            stack[A] = janet_wrap_number(x1 - intres);
+            if (x2 == 0) {
+                stack[A] = janet_wrap_number(x1);
+            } else {
+                double intres = x2 * floor(x1 / x2);
+                stack[A] = janet_wrap_number(x1 - intres);
+            }
             vm_pcnext();
         } else {
             vm_commit();
@@ -720,9 +761,14 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in) {
 
     VM_OP(JOP_BNOT) {
         Janet op = stack[E];
-        vm_assert_type(op, JANET_NUMBER);
-        stack[A] = janet_wrap_integer(~janet_unwrap_integer(op));
-        vm_pcnext();
+        if (janet_checktype(op, JANET_NUMBER)) {
+            stack[A] = janet_wrap_integer(~janet_unwrap_integer(op));
+            vm_pcnext();
+        } else {
+            vm_commit();
+            stack[A] = janet_unary_call("~", op);
+            vm_checkgc_pcnext();
+        }
     }
 
     VM_OP(JOP_SHIFT_RIGHT_UNSIGNED)
@@ -753,11 +799,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++;
     }
@@ -768,12 +816,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++;
     }
@@ -784,6 +834,7 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in) {
         pc++;
     } else {
         pc += ES;
+        vm_maybe_auto_suspend(ES <= 0);
     }
     vm_next();
 
@@ -810,7 +861,7 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in) {
     vm_pcnext();
 
     VM_OP(JOP_EQUALS_IMMEDIATE)
-    stack[A] = janet_wrap_boolean(janet_unwrap_number(stack[B]) == (double) CS);
+    stack[A] = janet_wrap_boolean(janet_checktype(stack[B], JANET_NUMBER) && (janet_unwrap_number(stack[B]) == (double) CS));
     vm_pcnext();
 
     VM_OP(JOP_NOT_EQUALS)
@@ -818,7 +869,7 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in) {
     vm_pcnext();
 
     VM_OP(JOP_NOT_EQUALS_IMMEDIATE)
-    stack[A] = janet_wrap_boolean(janet_unwrap_number(stack[B]) != (double) CS);
+    stack[A] = janet_wrap_boolean(!janet_checktype(stack[B], JANET_NUMBER) || (janet_unwrap_number(stack[B]) != (double) CS));
     vm_pcnext();
 
     VM_OP(JOP_COMPARE)
@@ -909,7 +960,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 */
@@ -957,6 +1008,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");
@@ -970,7 +1022,7 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in) {
             if (func->gc.flags & JANET_FUNCFLAG_TRACE) {
                 vm_do_trace(func, fiber->stacktop - fiber->stackstart, fiber->data + fiber->stackstart);
             }
-            janet_stack_frame(stack)->pc = pc;
+            vm_commit();
             if (janet_fiber_funcframe(fiber, func)) {
                 int32_t n = fiber->stacktop - fiber->stackstart;
                 janet_panicf("%v called with %d argument%s, expected %d",
@@ -996,6 +1048,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");
@@ -1042,9 +1095,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);
         }
@@ -1084,7 +1138,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);
         }
@@ -1273,21 +1327,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);
@@ -1297,35 +1365,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) ||
@@ -1339,21 +1425,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) {
@@ -1369,16 +1455,17 @@ 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);
+            fiber->last_value = child->last_value;
             return sig;
         }
         /* Check if we need any special handling for certain opcodes */
@@ -1421,14 +1508,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;
@@ -1440,14 +1527,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;
@@ -1472,7 +1559,7 @@ JanetSignal janet_pcall(
         fiber = janet_fiber(fun, 64, argc, argv);
     }
     if (f) *f = fiber;
-    if (!fiber) {
+    if (NULL == fiber) {
         *out = janet_cstringv("arity mismatch");
         return JANET_SIGNAL_ERROR;
     }
@@ -1481,7 +1568,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)) {
@@ -1493,42 +1582,62 @@ 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_vm.gc_mark_phase = 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;
+
+    /* Sandbox flags */
+    janet_vm.sandbox_flags = 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
@@ -1538,24 +1647,35 @@ int janet_init(void) {
     return 0;
 }
 
+/* Disable some features at runtime with no way to re-enable them */
+void janet_sandbox(uint32_t flags) {
+    janet_sandbox_assert(JANET_SANDBOX_SANDBOX);
+    janet_vm.sandbox_flags |= flags;
+}
+
+void janet_sandbox_assert(uint32_t forbidden_flags) {
+    if (forbidden_flags & janet_vm.sandbox_flags) {
+        janet_panic("operation forbidden by sandbox");
+    }
+}
+
 /* Clear all memory associated with the VM */
 void janet_deinit(void) {
     janet_clear_memory();
     janet_symcache_deinit();
-    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;
-    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) 2020 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
@@ -43,10 +43,10 @@ int (janet_truthy)(Janet x) {
     return janet_truthy(x);
 }
 
-const JanetKV *(janet_unwrap_struct)(Janet x) {
+JanetStruct(janet_unwrap_struct)(Janet x) {
     return janet_unwrap_struct(x);
 }
-const Janet *(janet_unwrap_tuple)(Janet x) {
+JanetTuple(janet_unwrap_tuple)(Janet x) {
     return janet_unwrap_tuple(x);
 }
 JanetFiber *(janet_unwrap_fiber)(Janet x) {
@@ -61,16 +61,16 @@ JanetTable *(janet_unwrap_table)(Janet x) {
 JanetBuffer *(janet_unwrap_buffer)(Janet x) {
     return janet_unwrap_buffer(x);
 }
-const uint8_t *(janet_unwrap_string)(Janet x) {
+JanetString(janet_unwrap_string)(Janet x) {
     return janet_unwrap_string(x);
 }
-const uint8_t *(janet_unwrap_symbol)(Janet x) {
+JanetSymbol(janet_unwrap_symbol)(Janet x) {
     return janet_unwrap_symbol(x);
 }
-const uint8_t *(janet_unwrap_keyword)(Janet x) {
+JanetKeyword(janet_unwrap_keyword)(Janet x) {
     return janet_unwrap_keyword(x);
 }
-void *(janet_unwrap_abstract)(Janet x) {
+JanetAbstract(janet_unwrap_abstract)(Janet x) {
     return janet_unwrap_abstract(x);
 }
 void *(janet_unwrap_pointer)(Janet x) {
@@ -102,22 +102,22 @@ Janet(janet_wrap_false)(void) {
 Janet(janet_wrap_boolean)(int x) {
     return janet_wrap_boolean(x);
 }
-Janet(janet_wrap_string)(const uint8_t *x) {
+Janet(janet_wrap_string)(JanetString x) {
     return janet_wrap_string(x);
 }
-Janet(janet_wrap_symbol)(const uint8_t *x) {
+Janet(janet_wrap_symbol)(JanetSymbol x) {
     return janet_wrap_symbol(x);
 }
-Janet(janet_wrap_keyword)(const uint8_t *x) {
+Janet(janet_wrap_keyword)(JanetKeyword x) {
     return janet_wrap_keyword(x);
 }
 Janet(janet_wrap_array)(JanetArray *x) {
     return janet_wrap_array(x);
 }
-Janet(janet_wrap_tuple)(const Janet *x) {
+Janet(janet_wrap_tuple)(JanetTuple x) {
     return janet_wrap_tuple(x);
 }
-Janet(janet_wrap_struct)(const JanetKV *x) {
+Janet(janet_wrap_struct)(JanetStruct x) {
     return janet_wrap_struct(x);
 }
 Janet(janet_wrap_fiber)(JanetFiber *x) {
@@ -135,7 +135,7 @@ Janet(janet_wrap_cfunction)(JanetCFunction x) {
 Janet(janet_wrap_table)(JanetTable *x) {
     return janet_wrap_table(x);
 }
-Janet(janet_wrap_abstract)(void *x) {
+Janet(janet_wrap_abstract)(JanetAbstract x) {
     return janet_wrap_abstract(x);
 }
 Janet(janet_wrap_pointer)(void *x) {
@@ -162,8 +162,8 @@ Janet(janet_wrap_number)(double x) {
 
 void *janet_memalloc_empty(int32_t count) {
     int32_t i;
-    void *mem = malloc((size_t) count * sizeof(JanetKV));
-    janet_vm_next_collection += (size_t) count * sizeof(JanetKV);
+    void *mem = janet_malloc((size_t) count * sizeof(JanetKV));
+    janet_vm.next_collection += (size_t) count * sizeof(JanetKV);
     if (NULL == mem) {
         JANET_OUT_OF_MEMORY;
     }
@@ -317,4 +317,3 @@ JANET_WRAP_DEFINE(pointer, void *, JANET_POINTER, pointer)
 #undef JANET_WRAP_DEFINE
 
 #endif
-