Fix docstring.

stop doc-format detecting other modes within code blocks

.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: |

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

@@ -5,9 +5,14 @@ on:
     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:
@@ -33,3 +38,25 @@ jobs:
             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

@@ -2,6 +2,9 @@ name: Test
 
 on: [push, pull_request]
 
+permissions:
+  contents: read
+
 jobs:
 
   test-posix:

.gitignore

@@ -34,6 +34,7 @@ local
 
 # Common test files I use.
 temp.janet
+temp*.janet
 scratch.janet
 
 # Emscripten

CHANGELOG.md

@@ -1,6 +1,98 @@
 # Changelog
 All notable changes to this project will be documented in this file.
 
+## 1.23.1 - ???
+- Don't process shared object names passed to dlopen.
+- Add better support for windows console in the default shell.c for autocompletion and
+  other shell-like input features.
+- Improve default error message from `assert`.
+- Add the `tabseq` macro for simpler table comprehensions.
+- Allow setting `(dyn :task-id)` in fibers to improve context in supervisor messages. Prior to
+  this change, supverisor messages over threaded channels would be from ambiguous threads/fibers.
+
+## 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.
@@ -8,7 +100,7 @@ All notable changes to this project will be documented in this file.
 - 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/thead` as well as a whole fiber.
+- 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

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

Makefile

@@ -1,4 +1,4 @@
-# Copyright (c) 2021 Calvin Rose
+# Copyright (c) 2022 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
@@ -58,15 +58,23 @@ 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)
 all: $(JANET_TARGET) $(JANET_LIBRARY) $(JANET_STATIC_LIBRARY) build/janet.h
@@ -100,6 +108,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 \
@@ -120,7 +129,6 @@ JANET_CORE_SOURCES=src/core/abstract.c \
 				   src/core/struct.c \
 				   src/core/symcache.c \
 				   src/core/table.c \
-				   src/core/thread.c \
 				   src/core/tuple.c \
 				   src/core/util.c \
 				   src/core/value.c \
@@ -159,7 +167,11 @@ build/c/janet.c: build/janet_boot src/boot/boot.janet
 ##### Amalgamation #####
 ########################
 
-SONAME=libjanet.so.1.17
+ifeq ($(UNAME), Darwin)
+SONAME=libjanet.1.23.dylib
+else
+SONAME=libjanet.so.1.23
+endif
 
 build/c/shell.c: src/mainclient/shell.c
 	cp $< $@
@@ -232,6 +244,7 @@ build/janet-%.tar.gz: $(JANET_TARGET) \
 	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)/
@@ -270,17 +283,24 @@ install: $(JANET_TARGET) $(JANET_LIBRARY) $(JANET_STATIC_LIBRARY) build/janet.pc
 	cp $(JANET_TARGET) '$(DESTDIR)$(BINDIR)/janet'
 	mkdir -p '$(DESTDIR)$(INCLUDEDIR)/janet'
 	cp -r build/janet.h '$(DESTDIR)$(INCLUDEDIR)/janet'
+	ln -sf -T ./janet/janet.h '$(DESTDIR)$(INCLUDEDIR)/janet.h' || true #fixme bsd
 	mkdir -p '$(DESTDIR)$(JANET_PATH)'
 	mkdir -p '$(DESTDIR)$(LIBDIR)'
-	cp $(JANET_LIBRARY) '$(DESTDIR)$(LIBDIR)/libjanet.so.$(shell $(JANET_TARGET) -e '(print janet/version)')'
+	if test $(UNAME) = Darwin ; then \
+		cp $(JANET_LIBRARY) '$(DESTDIR)$(LIBDIR)/libjanet.$(shell $(JANET_TARGET) -e '(print janet/version)').dylib' ; \
+		ln -sf $(SONAME) '$(DESTDIR)$(LIBDIR)/libjanet.dylib' ; \
+		ln -sf libjanet.$(shell $(JANET_TARGET) -e '(print janet/version)').dylib $(DESTDIR)$(LIBDIR)/$(SONAME) ; \
+	else \
+		cp $(JANET_LIBRARY) '$(DESTDIR)$(LIBDIR)/libjanet.so.$(shell $(JANET_TARGET) -e '(print janet/version)')' ; \
+		ln -sf $(SONAME) '$(DESTDIR)$(LIBDIR)/libjanet.so' ; \
+		ln -sf libjanet.so.$(shell $(JANET_TARGET) -e '(print janet/version)') $(DESTDIR)$(LIBDIR)/$(SONAME) ; \
+	fi
 	cp $(JANET_STATIC_LIBRARY) '$(DESTDIR)$(LIBDIR)/libjanet.a'
-	ln -sf $(SONAME) '$(DESTDIR)$(LIBDIR)/libjanet.so'
-	ln -sf libjanet.so.$(shell $(JANET_TARGET) -e '(print janet/version)') $(DESTDIR)$(LIBDIR)/$(SONAME)
 	mkdir -p '$(DESTDIR)$(JANET_MANPATH)'
 	cp janet.1 '$(DESTDIR)$(JANET_MANPATH)'
 	mkdir -p '$(DESTDIR)$(JANET_PKG_CONFIG_PATH)'
 	cp build/janet.pc '$(DESTDIR)$(JANET_PKG_CONFIG_PATH)/janet.pc'
-	[ -z '$(DESTDIR)' ] && $(LDCONFIG) || true
+	[ -z '$(DESTDIR)' ] && $(LDCONFIG) || echo "You can ignore this error for non-Linux systems or local installs"
 
 install-jpm-git: $(JANET_TARGET)
 	mkdir -p build
@@ -297,6 +317,7 @@ install-jpm-git: $(JANET_TARGET)
 uninstall:
 	-rm '$(DESTDIR)$(BINDIR)/janet'
 	-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'

README.md

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

appveyor.yml

@@ -1,51 +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
-    - 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

@@ -18,8 +18,14 @@
 
 @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
@@ -81,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

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/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,87 @@
+#include <stdio.h>
+#include <stdint.h>
+#include <string.h>
+
+int int_fn(int a, int b) {
+    return (a << 2) + b;
+}
+
+double my_fn(int64_t a, int64_t b, const char *x) {
+    return (double)(a + b) + 0.5 + strlen(x);
+}
+
+double double_fn(double x, double y, double z) {
+    return (x + y) * z * 3;
+}
+
+double double_many(double x, double y, double z, double w, double a, double b) {
+    return x + y + z + w + a + b;
+}
+
+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;
+}
+
+double float_fn(float x, float y, float z) {
+    return (x + y) * z;
+}
+
+typedef struct {
+    int a;
+    int b;
+} intint;
+
+typedef struct {
+    int a;
+    int b;
+    int c;
+} intintint;
+
+int intint_fn(double x, intint ii) {
+    printf("double: %g\n", x);
+    return ii.a + ii.b;
+}
+
+int intintint_fn(double x, intintint iii) {
+    printf("double: %g\n", x);
+    return iii.a + iii.b + iii.c;
+}
+
+intint return_struct(int i) {
+    intint ret;
+    ret.a = i;
+    ret.b = i * i;
+    return ret;
+}
+
+typedef struct {
+    int64_t a;
+    int64_t b;
+    int64_t c;
+} big;
+
+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;
+}
+
+void void_fn(void) {
+    printf("void fn ran\n");
+}
+
+void void_ret_fn(int x) {
+    printf("void fn ran: %d\n", x);
+}

examples/ffi/test.janet

@@ -0,0 +1,132 @@
+#
+# Simple FFI test script that tests against a simple shared object
+#
+
+(def ffi/loc "examples/ffi/so.so")
+(def ffi/source-loc "examples/ffi/so.c")
+
+(os/execute ["cc" ffi/source-loc "-shared" "-o" ffi/loc] :px)
+(def module (ffi/native ffi/loc))
+
+(def int-fn-sig (ffi/signature :default :int :int :int))
+(def int-fn-pointer (ffi/lookup module "int_fn"))
+(defn int-fn
+  [x y]
+  (ffi/call int-fn-pointer int-fn-sig x y))
+
+(def double-fn-sig (ffi/signature :default :double :double :double :double))
+(def double-fn-pointer (ffi/lookup module "double_fn"))
+(defn double-fn
+  [x y z]
+  (ffi/call double-fn-pointer double-fn-sig x y z))
+
+(def double-many-sig (ffi/signature :default :double :double :double :double :double :double :double))
+(def double-many-pointer (ffi/lookup module "double_many"))
+(defn double-many
+  [x y z w a b]
+  (ffi/call double-many-pointer double-many-sig x y z w a b))
+
+(def double-lots-sig (ffi/signature :default :double
+                                    :double :double :double :double :double
+                                    :double :double :double :double :double))
+(def double-lots-pointer (ffi/lookup module "double_lots"))
+(defn double-lots
+  [a b c d e f g h i j]
+  (ffi/call double-lots-pointer double-lots-sig a b c d e f g h i j))
+
+(def float-fn-sig (ffi/signature :default :double :float :float :float))
+(def float-fn-pointer (ffi/lookup module "float_fn"))
+(defn float-fn
+  [x y z]
+  (ffi/call float-fn-pointer float-fn-sig x y z))
+
+(def intint-fn-sig (ffi/signature :default :int :double [:int :int]))
+(def intint-fn-pointer (ffi/lookup module "intint_fn"))
+(defn intint-fn
+  [x ii]
+  (ffi/call intint-fn-pointer intint-fn-sig x ii))
+
+(def return-struct-sig (ffi/signature :default [:int :int] :int))
+(def return-struct-pointer (ffi/lookup module "return_struct"))
+(defn return-struct-fn
+  [i]
+  (ffi/call return-struct-pointer return-struct-sig i))
+
+(def intintint (ffi/struct :int :int :int))
+(def intintint-fn-sig (ffi/signature :default :int :double intintint))
+(def intintint-fn-pointer (ffi/lookup module "intintint_fn"))
+(defn intintint-fn
+  [x iii]
+  (ffi/call intintint-fn-pointer intintint-fn-sig x iii))
+
+(def big (ffi/struct :s64 :s64 :s64))
+(def struct-big-fn-sig (ffi/signature :default big :int :double))
+(def struct-big-fn-pointer (ffi/lookup module "struct_big"))
+(defn struct-big-fn
+  [i d]
+  (ffi/call struct-big-fn-pointer struct-big-fn-sig i d))
+
+(def void-fn-pointer (ffi/lookup module "void_fn"))
+(def void-fn-sig (ffi/signature :default :void))
+(defn void-fn
+  []
+  (ffi/call void-fn-pointer void-fn-sig))
+
+#
+# Call functions
+#
+
+(pp (void-fn))
+(pp (int-fn 10 20))
+(pp (double-fn 1.5 2.5 3.5))
+(pp (double-many 1 2 3 4 5 6))
+(pp (double-lots 1 2 3 4 5 6 7 8 9 10))
+(pp (float-fn 8 4 17))
+(pp (intint-fn 123.456 [10 20]))
+(pp (intintint-fn 123.456 [10 20 30]))
+(pp (return-struct-fn 42))
+(pp (struct-big-fn 11 99.5))
+
+(assert (= 60 (int-fn 10 20)))
+(assert (= 42 (double-fn 1.5 2.5 3.5)))
+(assert (= 21 (double-many 1 2 3 4 5 6)))
+(assert (= 19 (double-lots 1 2 3 4 5 6 7 8 9 10)))
+(assert (= 204 (float-fn 8 4 17)))
+
+#
+# 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])
+
+(print "Done.")

examples/numarray/numarray.c

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

examples/numarray/test/numarray_tests.janet

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

examples/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,7 +3,7 @@
 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]
@@ -213,6 +213,11 @@ Precompiles Janet source code into an image, a binary dump that can be efficient
 Source should be a path to the Janet module to compile, and output should be the file path of
 resulting image. Output should usually end with the .jimage extension.
 
+.TP
+.BR \-i
+When this flag is passed, a script passed to the interpreter will be treated as a janet image file
+rather than a janet source file.
+
 .TP
 .BR \-l\ lib
 Import a Janet module before running a script or repl. Multiple files can be loaded

meson.build

@@ -20,7 +20,7 @@
 
 project('janet', 'c',
   default_options : ['c_std=c99', 'build.c_std=c99', 'b_lundef=false', 'default_library=both'],
-  version : '1.17.2')
+  version : '1.23.1')
 
 # Global settings
 janet_path = join_paths(get_option('prefix'), get_option('libdir'), 'janet')
@@ -30,6 +30,7 @@ header_path = join_paths(get_option('prefix'), get_option('includedir'), 'janet'
 cc = meson.get_compiler('c')
 m_dep = cc.find_library('m', required : false)
 dl_dep = cc.find_library('dl', required : false)
+android_spawn_dep = cc.find_library('android-spawn', required : false)
 thread_dep = dependency('threads')
 
 # Link options
@@ -74,8 +75,8 @@ conf.set('JANET_NO_PROCESSES', not get_option('processes'))
 conf.set('JANET_SIMPLE_GETLINE', get_option('simple_getline'))
 conf.set('JANET_EV_NO_EPOLL', not get_option('epoll'))
 conf.set('JANET_EV_NO_KQUEUE', not get_option('kqueue'))
-conf.set('JANET_NO_THREADS', get_option('threads'))
 conf.set('JANET_NO_INTERPRETER_INTERRUPT', not get_option('interpreter_interrupt'))
+conf.set('JANET_NO_FFI', not get_option('ffi'))
 if get_option('os_name') != ''
   conf.set('JANET_OS_NAME', get_option('os_name'))
 endif
@@ -116,6 +117,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',
@@ -136,7 +138,6 @@ core_src = [
   'src/core/struct.c',
   'src/core/symcache.c',
   'src/core/table.c',
-  'src/core/thread.c',
   'src/core/tuple.c',
   'src/core/util.c',
   'src/core/value.c',
@@ -162,7 +163,7 @@ mainclient_src = [
 janet_boot = executable('janet-boot', core_src, boot_src,
   include_directories : incdir,
   c_args : '-DJANET_BOOTSTRAP',
-  dependencies : [m_dep, dl_dep, thread_dep],
+  dependencies : [m_dep, dl_dep, thread_dep, android_spawn_dep],
   native : true)
 
 # Build janet.c
@@ -175,7 +176,7 @@ janetc = custom_target('janetc',
     'JANET_PATH', janet_path
   ])
 
-janet_dependencies = [m_dep, dl_dep]
+janet_dependencies = [m_dep, dl_dep, android_spawn_dep]
 if not get_option('single_threaded')
   janet_dependencies += thread_dep
 endif
@@ -264,3 +265,9 @@ patched_janet = custom_target('patched-janeth',
   build_by_default : true,
   output : ['janet.h'],
   command : [janet_nativeclient, '@INPUT@', '@OUTPUT@'])
+
+# Create a version of the janet.h header that matches what jpm often expects
+if meson.version().version_compare('>=0.61')
+  install_symlink('janet.h', pointing_to: 'janet/janet.h', install_dir: get_option('includedir'))
+endif
+

meson_options.txt

@@ -1,7 +1,6 @@
 option('git_hash', type : 'string', value : 'meson')
 
 option('single_threaded', type : 'boolean', value : false)
-option('threads', type : 'boolean', value : true)
 option('nanbox', type : 'boolean', value : true)
 option('dynamic_modules', type : 'boolean', value : true)
 option('docstrings', type : 'boolean', value : true)
@@ -20,6 +19,7 @@ option('simple_getline', type : 'boolean', value : false)
 option('epoll', type : 'boolean', value : false)
 option('kqueue', type : 'boolean', value : false)
 option('interpreter_interrupt', type : 'boolean', value : false)
+option('ffi', type : 'boolean', value : true)
 
 option('recursion_guard', type : 'integer', min : 10, max : 8000, value : 1024)
 option('max_proto_depth', type : 'integer', min : 10, max : 8000, value : 200)

src/boot/array_test.c

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

src/boot/boot.c

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

src/boot/buffer_test.c

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

src/boot/number_test.c

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

src/boot/system_test.c

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

src/boot/table_test.c

@@ -1,5 +1,5 @@
 /*
-* Copyright (c) 2021 Calvin Rose
+* Copyright (c) 2022 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 17
-#define JANET_VERSION_PATCH 2
-#define JANET_VERSION_EXTRA ""
-#define JANET_VERSION "1.17.2"
+#define JANET_VERSION_MINOR 23
+#define JANET_VERSION_PATCH 1
+#define JANET_VERSION_EXTRA "-dev"
+#define JANET_VERSION "1.23.1-dev"
 
 /* #define JANET_BUILD "local" */
 

src/core/abstract.c

@@ -1,5 +1,5 @@
 /*
-* Copyright (c) 2021 Calvin Rose
+* Copyright (c) 2022 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,14 +23,16 @@
 #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>
 #endif
 #endif
-#endif
 
 /* Create new userdata */
 void *janet_abstract_begin(const JanetAbstractType *atype, size_t size) {
@@ -63,8 +65,8 @@ void *janet_abstract_begin_threaded(const JanetAbstractType *atype, size_t size)
     }
     janet_vm.next_collection += size + sizeof(JanetAbstractHead);
     header->gc.flags = JANET_MEMORY_THREADED_ABSTRACT;
-    header->gc.next = NULL; /* Clear memory for address sanitizers */
-    header->gc.refcount = 1;
+    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);
@@ -85,12 +87,20 @@ void *janet_abstract_threaded(const JanetAbstractType *atype, size_t size) {
 
 #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(&ab->gc.refcount);
+    return InterlockedIncrement(&ab->gc.data.refcount);
 }
 
 static int32_t janet_decref(JanetAbstractHead *ab) {
-    return InterlockedDecrement(&ab->gc.refcount);
+    return InterlockedDecrement(&ab->gc.data.refcount);
 }
 
 void janet_os_mutex_init(JanetOSMutex *mutex) {
@@ -106,33 +116,95 @@ void janet_os_mutex_lock(JanetOSMutex *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.refcount, 1, __ATOMIC_RELAXED);
+    return __atomic_add_fetch(&ab->gc.data.refcount, 1, __ATOMIC_RELAXED);
 }
 
 static int32_t janet_decref(JanetAbstractHead *ab) {
-    return __atomic_add_fetch(&ab->gc.refcount, -1, __ATOMIC_RELAXED);
+    return __atomic_add_fetch(&ab->gc.data.refcount, -1, __ATOMIC_RELAXED);
 }
 
 void janet_os_mutex_init(JanetOSMutex *mutex) {
-    pthread_mutex_init(mutex, NULL);
+    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(mutex);
+    pthread_mutex_destroy((pthread_mutex_t *) mutex);
 }
 
 void janet_os_mutex_lock(JanetOSMutex *mutex) {
-    pthread_mutex_lock(mutex);
+    pthread_mutex_lock((pthread_mutex_t *) mutex);
 }
 
 void janet_os_mutex_unlock(JanetOSMutex *mutex) {
-    pthread_mutex_unlock(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

src/core/array.c

@@ -1,5 +1,5 @@
 /*
-* Copyright (c) 2021 Calvin Rose
+* Copyright (c) 2022 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
@@ -125,7 +125,7 @@ Janet janet_array_peek(JanetArray *array) {
 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.") {
+              "`(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);
@@ -136,7 +136,7 @@ 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++) {
@@ -194,7 +194,7 @@ JANET_CORE_FN(cfun_array_push,
 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. "
+              "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);
@@ -241,6 +241,11 @@ JANET_CORE_FN(cfun_array_concat,
                 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]);
             }

src/core/asm.c

@@ -1,5 +1,5 @@
 /*
-* Copyright (c) 2021 Calvin Rose
+* Copyright (c) 2022 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
@@ -553,6 +553,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);
@@ -884,6 +888,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,6 +941,7 @@ 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("constants"), janet_disasm_constants(def));
@@ -986,6 +995,7 @@ JANET_CORE_FN(cfun_disasm,
         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);

src/core/buffer.c

@@ -1,5 +1,5 @@
 /*
-* Copyright (c) 2021 Calvin Rose
+* Copyright (c) 2022 Calvin Rose
 *
 * Permission is hereby granted, free of charge, to any person obtaining a copy
 * of this software and associated documentation files (the "Software"), to
@@ -164,7 +164,7 @@ void janet_buffer_push_u64(JanetBuffer *buffer, uint64_t x) {
 
 JANET_CORE_FN(cfun_buffer_new,
               "(buffer/new capacity)",
-              "Creates a new, empty buffer with enough backing memory for capacity bytes. "
+              "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);
@@ -174,16 +174,17 @@ JANET_CORE_FN(cfun_buffer_new,
 
 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. "
+              "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);
@@ -312,7 +313,7 @@ JANET_CORE_FN(cfun_buffer_clear,
 
 JANET_CORE_FN(cfun_buffer_popn,
               "(buffer/popn buffer n)",
-              "Removes the last n bytes from the buffer. Returns the modified buffer.") {
+              "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);
@@ -327,9 +328,9 @@ JANET_CORE_FN(cfun_buffer_popn,
 
 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, "
+              "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. "
+              "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);
@@ -399,9 +400,9 @@ JANET_CORE_FN(cfun_buffer_bittoggle,
 
 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 to index from the end of src or dest. Returns dest.") {
+              "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);

src/core/bytecode.c

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

src/core/capi.c

@@ -1,5 +1,5 @@
 /*
-* Copyright (c) 2021 Calvin Rose
+* Copyright (c) 2022 Calvin Rose
 *
 * Permission is hereby granted, free of charge, to any person obtaining a copy
 * of this software and associated documentation files (the "Software"), to
@@ -260,11 +260,27 @@ int32_t janet_getinteger(const Janet *argv, int32_t n) {
 }
 
 int64_t janet_getinteger64(const Janet *argv, int32_t n) {
+#ifdef JANET_INTTYPES
+    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_INTTYPES
+    return janet_unwrap_u64(argv[n]);
+#else
+    Janet x = argv[n];
+    if (!janet_checkint64(x)) {
+        janet_panicf("bad slot #%d, expected 64 bit unsigned integer, got %v", n, x);
+    }
+    return (uint64_t) janet_unwrap_number(x);
+#endif
 }
 
 size_t janet_getsize(const Janet *argv, int32_t n) {

src/core/cfuns.c

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

src/core/compile.c

@@ -1,5 +1,5 @@
 /*
-* Copyright (c) 2021 Calvin Rose
+* Copyright (c) 2022 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
@@ -197,6 +197,39 @@ void janetc_popscope_keepslot(JanetCompiler *c, JanetSlot retslot) {
     }
 }
 
+static int lookup_missing(
+    JanetCompiler *c,
+    const uint8_t *sym,
+    JanetFunction *handler,
+    JanetBinding *out) {
+    int32_t minar = handler->def->min_arity;
+    int32_t maxar = handler->def->max_arity;
+    if (minar > 1 || maxar < 1) {
+        janetc_error(c, janet_cstring("missing symbol lookup handler must take 1 argument"));
+        return 0;
+    }
+    Janet args[1] = { janet_wrap_symbol(sym) };
+    JanetFiber *fiberp = janet_fiber(handler, 64, 1, args);
+    if (NULL == fiberp) {
+        janetc_error(c, janet_cstring("failed to call missing symbol lookup handler"));
+        return 0;
+    }
+    fiberp->env = c->env;
+    int lock = janet_gclock();
+    Janet tempOut;
+    JanetSignal status = janet_continue(fiberp, janet_wrap_nil(), &tempOut);
+    janet_gcunlock(lock);
+    if (status != JANET_SIGNAL_OK) {
+        janetc_error(c, janet_formatc("(lookup) %V", tempOut));
+        return 0;
+    }
+
+    /* Convert return value as entry. */
+    /* Alternative could use janet_resolve_ext(c->env, sym) to read result from environment. */
+    *out = janet_binding_from_entry(tempOut);
+    return 1;
+}
+
 /* Allow searching for symbols. Return information about the symbol */
 JanetSlot janetc_resolve(
     JanetCompiler *c,
@@ -230,6 +263,21 @@ JanetSlot janetc_resolve(
     /* Symbol not found - check for global */
     {
         JanetBinding binding = janet_resolve_ext(c->env, sym);
+        if (binding.type == JANET_BINDING_NONE) {
+            Janet handler = janet_table_get(c->env, janet_ckeywordv("missing-symbol"));
+            switch (janet_type(handler)) {
+                case JANET_NIL:
+                    break;
+                case JANET_FUNCTION:
+                    if (!lookup_missing(c, sym, janet_unwrap_function(handler), &binding))
+                        return janetc_cslot(janet_wrap_nil());
+                    break;
+                default:
+                    janetc_error(c, janet_formatc("invalid lookup handler %V", handler));
+                    return janetc_cslot(janet_wrap_nil());
+            }
+        }
+
         switch (binding.type) {
             default:
             case JANET_BINDING_NONE:
@@ -239,6 +287,12 @@ JanetSlot janetc_resolve(
             case JANET_BINDING_MACRO: /* Macro should function like defs when not in calling pos */
                 ret = janetc_cslot(binding.value);
                 break;
+            case JANET_BINDING_DYNAMIC_DEF:
+            case JANET_BINDING_DYNAMIC_MACRO:
+                ret = janetc_cslot(binding.value);
+                ret.flags |= JANET_SLOT_REF | JANET_SLOT_NAMED | JANET_SLOTTYPE_ANY;
+                ret.flags &= ~JANET_SLOT_CONSTANT;
+                break;
             case JANET_BINDING_VAR: {
                 ret = janetc_cslot(binding.value);
                 ret.flags |= JANET_SLOT_REF | JANET_SLOT_NAMED | JANET_SLOT_MUTABLE | JANET_SLOTTYPE_ANY;
@@ -651,7 +705,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;
 
@@ -958,7 +1012,14 @@ JANET_CORE_FN(cfun,
     }
     const uint8_t *source = NULL;
     if (argc >= 3) {
-        source = janet_getstring(argv, 2);
+        Janet x = argv[2];
+        if (janet_checktype(x, JANET_STRING)) {
+            source = janet_unwrap_string(x);
+        } else if (janet_checktype(x, JANET_KEYWORD)) {
+            source = janet_unwrap_keyword(x);
+        } else {
+            janet_panic_type(x, 2, JANET_TFLAG_STRING | JANET_TFLAG_KEYWORD);
+        }
     }
     JanetArray *lints = (argc >= 4) ? janet_getarray(argv, 3) : NULL;
     JanetCompileResult res = janet_compile_lint(argv[0], env, source, lints);

src/core/compile.h

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

src/core/corelib.c

@@ -1,5 +1,5 @@
 /*
-* Copyright (c) 2021 Calvin Rose
+* Copyright (c) 2022 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
@@ -42,51 +42,6 @@ extern size_t janet_core_image_size;
 #define JDOC(x) NULL
 #endif
 
-/* Use LoadLibrary on windows or dlopen on posix to load dynamic libaries
- * with native code. */
-#if defined(JANET_NO_DYNAMIC_MODULES)
-typedef int Clib;
-#define load_clib(name) ((void) name, 0)
-#define symbol_clib(lib, sym) ((void) lib, (void) sym, NULL)
-#define error_clib() "dynamic libraries not supported"
-#elif defined(JANET_WINDOWS)
-#include <windows.h>
-typedef HINSTANCE Clib;
-#define load_clib(name) LoadLibrary((name))
-#define symbol_clib(lib, sym) GetProcAddress((lib), (sym))
-static char error_clib_buf[256];
-static char *error_clib(void) {
-    FormatMessageA(FORMAT_MESSAGE_FROM_SYSTEM | FORMAT_MESSAGE_IGNORE_INSERTS,
-                   NULL, GetLastError(), MAKELANGID(LANG_NEUTRAL, SUBLANG_DEFAULT),
-                   error_clib_buf, sizeof(error_clib_buf), NULL);
-    error_clib_buf[strlen(error_clib_buf) - 1] = '\0';
-    return error_clib_buf;
-}
-#else
-#include <dlfcn.h>
-typedef void *Clib;
-#define load_clib(name) dlopen((name), RTLD_NOW)
-#define symbol_clib(lib, sym) dlsym((lib), (sym))
-#define error_clib() dlerror()
-#endif
-
-static char *get_processed_name(const char *name) {
-    if (name[0] == '.') return (char *) name;
-    const char *c;
-    for (c = name; *c; c++) {
-        if (*c == '/') return (char *) name;
-    }
-    size_t l = (size_t)(c - name);
-    char *ret = janet_malloc(l + 3);
-    if (NULL == ret) {
-        JANET_OUT_OF_MEMORY;
-    }
-    ret[0] = '.';
-    ret[1] = '/';
-    memcpy(ret + 2, name, l + 1);
-    return ret;
-}
-
 JanetModule janet_native(const char *name, const uint8_t **error) {
     char *processed_name = get_processed_name(name);
     Clib lib = load_clib(processed_name);
@@ -137,7 +92,7 @@ static const char *janet_dyncstring(const char *name, const char *dflt) {
     const uint8_t *jstr = janet_unwrap_string(x);
     const char *cstr = (const char *)jstr;
     if (strlen(cstr) != (size_t) janet_string_length(jstr)) {
-        janet_panicf("string %v contains embedded 0s");
+        janet_panicf("string %v contains embedded 0s", x);
     }
     return cstr;
 }
@@ -339,7 +294,10 @@ JANET_CORE_FN(janet_core_native,
 
 JANET_CORE_FN(janet_core_describe,
               "(describe x)",
-              "Returns a string that is a human-readable description of a value x.") {
+              "Returns a string that is a human-readable description of `x`. "
+              "For recursive data structures, the string returned contains a "
+              "pointer value from which the identity of `x` "
+              "can be determined.") {
     JanetBuffer *b = janet_buffer(0);
     for (int32_t i = 0; i < argc; ++i)
         janet_description_b(b, argv[i]);
@@ -398,15 +356,21 @@ JANET_CORE_FN(janet_core_is_abstract,
 }
 
 JANET_CORE_FN(janet_core_scannumber,
-              "(scan-number str)",
-              "Parse a number from a byte sequence an return that number, either and integer "
+              "(scan-number str &opt base)",
+              "Parse a number from a byte sequence and return that number, either an integer "
               "or a real. The number "
               "must be in the same format as numbers in janet source code. Will return nil "
-              "on an invalid number.") {
+              "on an invalid number. Optionally provide a base - if a base is provided, no "
+              "radix specifier is expected at the beginning of the number.") {
     double number;
-    janet_fixarity(argc, 1);
+    janet_arity(argc, 1, 2);
     JanetByteView view = janet_getbytes(argv, 0);
-    if (janet_scan_number(view.bytes, view.len, &number))
+    int32_t base = janet_optinteger(argv, argc, 1, 0);
+    int valid = base == 0 || (base >= 2 && base <= 36);
+    if (!valid) {
+        janet_panicf("expected base between 2 and 36, got %d", base);
+    }
+    if (janet_scan_number_base(view.bytes, view.len, base, &number))
         return janet_wrap_nil();
     return janet_wrap_number(number);
 }
@@ -459,6 +423,25 @@ JANET_CORE_FN(janet_core_table,
     return janet_wrap_table(table);
 }
 
+JANET_CORE_FN(janet_core_getproto,
+              "(getproto x)",
+              "Get the prototype of a table or struct. Will return nil if `x` has no prototype.") {
+    janet_fixarity(argc, 1);
+    if (janet_checktype(argv[0], JANET_TABLE)) {
+        JanetTable *t = janet_unwrap_table(argv[0]);
+        return t->proto
+               ? janet_wrap_table(t->proto)
+               : janet_wrap_nil();
+    }
+    if (janet_checktype(argv[0], JANET_STRUCT)) {
+        JanetStruct st = janet_unwrap_struct(argv[0]);
+        return janet_struct_proto(st)
+               ? janet_wrap_struct(janet_struct_proto(st))
+               : janet_wrap_nil();
+    }
+    janet_panicf("expected struct|table, got %v", argv[0]);
+}
+
 JANET_CORE_FN(janet_core_struct,
               "(struct & kvs)",
               "Create a new struct from a sequence of key value pairs. "
@@ -466,8 +449,9 @@ JANET_CORE_FN(janet_core_struct,
               "an odd number of elements, an error will be thrown. Returns the "
               "new struct.") {
     int32_t i;
-    if (argc & 1)
+    if (argc & 1) {
         janet_panic("expected even number of arguments");
+    }
     JanetKV *st = janet_struct_begin(argc >> 1);
     for (i = 0; i < argc; i += 2) {
         janet_struct_put(st, argv[i], argv[i + 1]);
@@ -954,6 +938,7 @@ static void janet_load_libs(JanetTable *env) {
         JANET_CORE_REG("nat?", janet_core_check_nat),
         JANET_CORE_REG("slice", janet_core_slice),
         JANET_CORE_REG("signal", janet_core_signal),
+        JANET_CORE_REG("getproto", janet_core_getproto),
         JANET_REG_END
     };
     janet_core_cfuns_ext(env, NULL, corelib_cfuns);
@@ -963,6 +948,7 @@ static void janet_load_libs(JanetTable *env) {
     janet_lib_tuple(env);
     janet_lib_buffer(env);
     janet_lib_table(env);
+    janet_lib_struct(env);
     janet_lib_fiber(env);
     janet_lib_os(env);
     janet_lib_parse(env);
@@ -979,15 +965,15 @@ static void janet_load_libs(JanetTable *env) {
 #ifdef JANET_INT_TYPES
     janet_lib_inttypes(env);
 #endif
-#ifdef JANET_THREADS
-    janet_lib_thread(env);
-#endif
 #ifdef JANET_EV
     janet_lib_ev(env);
 #endif
 #ifdef JANET_NET
     janet_lib_net(env);
 #endif
+#ifdef JANET_FFI
+    janet_lib_ffi(env);
+#endif
 }
 
 #ifdef JANET_BOOTSTRAP

src/core/debug.c

@@ -1,5 +1,5 @@
 /*
-* Copyright (c) 2021 Calvin Rose
+* Copyright (c) 2022 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
@@ -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");
@@ -126,7 +130,6 @@ 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,
                               janet_status_names[status],
@@ -337,9 +340,9 @@ JANET_CORE_FN(cfun_debug_stack,
               "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"
+              "* :source-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"
+              "* :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"
@@ -361,14 +364,15 @@ JANET_CORE_FN(cfun_debug_stack,
 }
 
 JANET_CORE_FN(cfun_debug_stacktrace,
-              "(debug/stacktrace fiber &opt err)",
+              "(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, will skip the error line. Returns the fiber.") {
-    janet_arity(argc, 1, 2);
+              "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];
 }
 

src/core/emit.c

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

src/core/emit.h

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

src/core/ev.c

@@ -1,4 +1,14 @@
-/* The above copyright notice and this permission notice shall be included in
+/*
+* Copyright (c) 2022 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
@@ -10,6 +20,7 @@
 * IN THE SOFTWARE.
 */
 
+
 #ifndef JANET_AMALG
 #include "features.h"
 #include <janet.h>
@@ -68,13 +79,18 @@ typedef struct {
     int32_t limit;
     int closed;
     int is_threaded;
-    JanetOSMutex lock;
+#ifdef JANET_WINDOWS
+    CRITICAL_SECTION lock;
+#else
+    pthread_mutex_t lock;
+#endif
 } JanetChannel;
 
 typedef struct {
     JanetFiber *fiber;
     Janet value;
     JanetSignal sig;
+    uint32_t expected_sched_id; /* If the fiber has been rescheduled this loop, don't run first scheduling. */
 } JanetTask;
 
 /* Wrap return value by pairing it with the callback used to handle it
@@ -222,6 +238,9 @@ static void add_timeout(JanetTimeout to) {
 
 /* Create a new event listener */
 static JanetListenerState *janet_listen_impl(JanetStream *stream, JanetListener behavior, int mask, size_t size, void *user) {
+    if (stream->flags & JANET_STREAM_CLOSED) {
+        janet_panic("cannot listen on closed stream");
+    }
     if (stream->_mask & mask) {
         janet_panic("cannot listen for duplicate event on stream");
     }
@@ -332,8 +351,10 @@ static void janet_stream_close_impl(JanetStream *stream, int is_gc) {
     {
         CloseHandle(stream->handle);
     }
+    stream->handle = INVALID_HANDLE_VALUE;
 #else
     close(stream->handle);
+    stream->handle = -1;
 #endif
 }
 
@@ -447,10 +468,10 @@ const JanetAbstractType janet_stream_type = {
 
 /* Register a fiber to resume with value */
 void janet_schedule_signal(JanetFiber *fiber, Janet value, JanetSignal sig) {
-    if (fiber->flags & JANET_FIBER_FLAG_SCHEDULED) return;
-    fiber->flags |= JANET_FIBER_FLAG_SCHEDULED;
-    fiber->sched_id++;
-    JanetTask t = { fiber, value, sig };
+    if (fiber->gc.flags & JANET_FIBER_EV_FLAG_CANCELED) return;
+    fiber->gc.flags |= JANET_FIBER_FLAG_ROOT;
+    JanetTask t = { fiber, value, sig, ++fiber->sched_id };
+    if (sig == JANET_SIGNAL_ERROR) fiber->gc.flags |= JANET_FIBER_EV_FLAG_CANCELED;
     janet_q_push(&janet_vm.spawn, &t, sizeof(t));
 }
 
@@ -514,10 +535,15 @@ static int janet_channel_push(JanetChannel *channel, Janet x, int mode);
 static int janet_channel_pop(JanetChannel *channel, Janet *item, int is_choice);
 
 static Janet make_supervisor_event(const char *name, JanetFiber *fiber, int threaded) {
-    Janet tup[2];
+    Janet tup[3];
     tup[0] = janet_ckeywordv(name);
     tup[1] = threaded ? fiber->last_value : janet_wrap_fiber(fiber) ;
-    return janet_wrap_tuple(janet_tuple_n(tup, 2));
+    if (fiber->env != NULL) {
+        tup[2] = janet_table_get(fiber->env, janet_ckeywordv("task-id"));
+    } else {
+        tup[2] = janet_wrap_nil();
+    }
+    return janet_wrap_tuple(janet_tuple_n(tup, 3));
 }
 
 /* Common init code */
@@ -604,7 +630,7 @@ static int janet_chan_unpack(JanetChannel *chan, Janet *x, int is_cleanup) {
             return 1;
         case JANET_BUFFER: {
             JanetBuffer *buf = janet_unwrap_buffer(*x);
-            int flags = is_cleanup ? JANET_MARSHAL_UNSAFE : (JANET_MARSHAL_UNSAFE | JANET_MARSHAL_DECREF);
+            int flags = is_cleanup ? (JANET_MARSHAL_UNSAFE | JANET_MARSHAL_DECREF) : JANET_MARSHAL_UNSAFE;
             *x = janet_unmarshal(buf->data, buf->count, flags, NULL, NULL);
             janet_buffer_deinit(buf);
             janet_free(buf);
@@ -626,7 +652,7 @@ static void janet_chan_init(JanetChannel *chan, int32_t limit, int threaded) {
     janet_q_init(&chan->items);
     janet_q_init(&chan->read_pending);
     janet_q_init(&chan->write_pending);
-    janet_os_mutex_init(&chan->lock);
+    janet_os_mutex_init((JanetOSMutex *) &chan->lock);
 }
 
 static void janet_chan_deinit(JanetChannel *chan) {
@@ -639,17 +665,17 @@ static void janet_chan_deinit(JanetChannel *chan) {
         }
     }
     janet_q_deinit(&chan->items);
-    janet_os_mutex_deinit(&chan->lock);
+    janet_os_mutex_deinit((JanetOSMutex *) &chan->lock);
 }
 
 static void janet_chan_lock(JanetChannel *chan) {
     if (!janet_chan_is_threaded(chan)) return;
-    janet_os_mutex_lock(&chan->lock);
+    janet_os_mutex_lock((JanetOSMutex *) &chan->lock);
 }
 
 static void janet_chan_unlock(JanetChannel *chan) {
     if (!janet_chan_is_threaded(chan)) return;
-    janet_os_mutex_unlock(&chan->lock);
+    janet_os_mutex_unlock((JanetOSMutex *) &chan->lock);
 }
 
 /*
@@ -728,7 +754,6 @@ static void janet_thread_chan_cb(JanetEVGenericMessage msg) {
     int mode = msg.tag;
     JanetChannel *channel = (JanetChannel *) msg.argp;
     Janet x = msg.argj;
-    janet_ev_dec_refcount();
     if (fiber->sched_id == sched_id) {
         if (mode == JANET_CP_MODE_CHOICE_READ) {
             janet_assert(!janet_chan_unpack(channel, &x, 0), "packing error");
@@ -822,7 +847,6 @@ static int janet_channel_push(JanetChannel *channel, Janet x, int mode) {
             janet_q_push(&channel->write_pending, &pending, sizeof(pending));
             janet_chan_unlock(channel);
             if (is_threaded) {
-                janet_ev_inc_refcount();
                 janet_gcroot(janet_wrap_fiber(pending.fiber));
             }
             return 1;
@@ -872,7 +896,6 @@ static int janet_channel_pop(JanetChannel *channel, Janet *item, int is_choice)
         janet_q_push(&channel->read_pending, &pending, sizeof(pending));
         janet_chan_unlock(channel);
         if (is_threaded) {
-            janet_ev_inc_refcount();
             janet_gcroot(janet_wrap_fiber(pending.fiber));
         }
         return 0;
@@ -961,23 +984,30 @@ JANET_CORE_FN(cfun_channel_choice,
             JanetChannel *chan = janet_getchannel(data, 0);
             janet_chan_lock(chan);
             if (chan->closed) {
+                janet_chan_unlock(chan);
                 return make_close_result(chan);
             }
             if (janet_q_count(&chan->items) < chan->limit) {
+                janet_chan_unlock(chan);
                 janet_channel_push(chan, data[1], 1);
                 return make_write_result(chan);
             }
+            janet_chan_unlock(chan);
         } else {
             /* Read */
             JanetChannel *chan = janet_getchannel(argv, i);
+            janet_chan_lock(chan);
             if (chan->closed) {
+                janet_chan_unlock(chan);
                 return make_close_result(chan);
             }
             if (chan->items.head != chan->items.tail) {
                 Janet item;
+                janet_chan_unlock(chan);
                 janet_channel_pop(chan, &item, 1);
                 return make_read_result(chan, item);
             }
+            janet_chan_unlock(chan);
         }
     }
 
@@ -986,13 +1016,11 @@ JANET_CORE_FN(cfun_channel_choice,
         if (janet_indexed_view(argv[i], &data, &len) && len == 2) {
             /* Write */
             JanetChannel *chan = janet_getchannel(data, 0);
-            if (chan->closed) continue;
             janet_channel_push(chan, data[1], 1);
         } else {
             /* Read */
             Janet item;
             JanetChannel *chan = janet_getchannel(argv, i);
-            if (chan->closed) continue;
             janet_channel_pop(chan, &item, 1);
         }
     }
@@ -1182,13 +1210,13 @@ JanetFiber *janet_loop1(void) {
         if (to.curr_fiber != NULL) {
             /* This is a deadline (for a fiber, not a function call) */
             JanetFiberStatus s = janet_fiber_status(to.curr_fiber);
-            int isFinished = s == (JANET_STATUS_DEAD ||
-                                   s == JANET_STATUS_ERROR ||
-                                   s == JANET_STATUS_USER0 ||
-                                   s == JANET_STATUS_USER1 ||
-                                   s == JANET_STATUS_USER2 ||
-                                   s == JANET_STATUS_USER3 ||
-                                   s == JANET_STATUS_USER4);
+            int isFinished = (s == JANET_STATUS_DEAD ||
+                              s == JANET_STATUS_ERROR ||
+                              s == JANET_STATUS_USER0 ||
+                              s == JANET_STATUS_USER1 ||
+                              s == JANET_STATUS_USER2 ||
+                              s == JANET_STATUS_USER3 ||
+                              s == JANET_STATUS_USER4);
             if (!isFinished) {
                 janet_cancel(to.fiber, janet_cstringv("deadline expired"));
             }
@@ -1206,23 +1234,29 @@ JanetFiber *janet_loop1(void) {
 
     /* Run scheduled fibers */
     while (janet_vm.spawn.head != janet_vm.spawn.tail) {
-        JanetTask task = {NULL, janet_wrap_nil(), JANET_SIGNAL_OK};
+        JanetTask task = {NULL, janet_wrap_nil(), JANET_SIGNAL_OK, 0};
         janet_q_pop(&janet_vm.spawn, &task, sizeof(task));
-        task.fiber->flags &= ~JANET_FIBER_FLAG_SCHEDULED;
+        if (task.fiber->gc.flags & JANET_FIBER_EV_FLAG_SUSPENDED) janet_ev_dec_refcount();
+        task.fiber->gc.flags &= ~(JANET_FIBER_EV_FLAG_CANCELED | JANET_FIBER_EV_FLAG_SUSPENDED);
+        if (task.expected_sched_id != task.fiber->sched_id) continue;
         Janet res;
         JanetSignal sig = janet_continue_signal(task.fiber, task.value, &res, task.sig);
         void *sv = task.fiber->supervisor_channel;
         int is_suspended = sig == JANET_SIGNAL_EVENT || sig == JANET_SIGNAL_YIELD || sig == JANET_SIGNAL_INTERRUPT;
+        if (is_suspended) {
+            task.fiber->gc.flags |= JANET_FIBER_EV_FLAG_SUSPENDED;
+            janet_ev_inc_refcount();
+        }
         if (NULL == sv) {
             if (!is_suspended) {
-                janet_stacktrace(task.fiber, res);
+                janet_stacktrace_ext(task.fiber, res, "");
             }
         } else if (sig == JANET_SIGNAL_OK || (task.fiber->flags & (1 << sig))) {
             JanetChannel *chan = janet_channel_unwrap(sv);
             janet_channel_push(chan, make_supervisor_event(janet_signal_names[sig],
                                task.fiber, chan->is_threaded), 2);
         } else if (!is_suspended) {
-            janet_stacktrace(task.fiber, res);
+            janet_stacktrace_ext(task.fiber, res, "");
         }
         if (sig == JANET_SIGNAL_INTERRUPT) {
             /* On interrupts, return the interrupted fiber immediately */
@@ -1236,8 +1270,25 @@ JanetFiber *janet_loop1(void) {
         memset(&to, 0, sizeof(to));
         int has_timeout;
         /* Drop timeouts that are no longer needed */
-        while ((has_timeout = peek_timeout(&to)) && (to.curr_fiber == NULL) && to.fiber->sched_id != to.sched_id) {
-            pop_timeout(0);
+        while ((has_timeout = peek_timeout(&to))) {
+            if (to.curr_fiber != NULL) {
+                JanetFiberStatus s = janet_fiber_status(to.curr_fiber);
+                int is_finished = (s == JANET_STATUS_DEAD ||
+                                   s == JANET_STATUS_ERROR ||
+                                   s == JANET_STATUS_USER0 ||
+                                   s == JANET_STATUS_USER1 ||
+                                   s == JANET_STATUS_USER2 ||
+                                   s == JANET_STATUS_USER3 ||
+                                   s == JANET_STATUS_USER4);
+                if (is_finished) {
+                    pop_timeout(0);
+                    continue;
+                }
+            } else if (to.fiber->sched_id != to.sched_id) {
+                pop_timeout(0);
+                continue;
+            }
+            break;
         }
         /* Run polling implementation only if pending timeouts or pending events */
         if (janet_vm.tq_count || janet_vm.listener_count || janet_vm.extra_listeners) {
@@ -1410,7 +1461,7 @@ static void janet_epoll_sync_callback(JanetEVGenericMessage msg) {
     JanetAsyncStatus status2 = JANET_ASYNC_STATUS_NOT_DONE;
     if (state->stream->_mask & JANET_ASYNC_LISTEN_WRITE)
         status1 = state->machine(state, JANET_ASYNC_EVENT_WRITE);
-    if (state->stream->_mask & JANET_ASYNC_LISTEN_WRITE)
+    if (state->stream->_mask & JANET_ASYNC_LISTEN_READ)
         status2 = state->machine(state, JANET_ASYNC_EVENT_READ);
     if (status1 == JANET_ASYNC_STATUS_DONE ||
             status2 == JANET_ASYNC_STATUS_DONE) {
@@ -1513,8 +1564,8 @@ void janet_loop1_impl(int has_timeout, JanetTimestamp timeout) {
             JanetStream *stream = p;
             int mask = events[i].events;
             JanetListenerState *state = stream->state;
-            state->event = events + i;
             while (NULL != state) {
+                state->event = events + i;
                 JanetListenerState *next_state = state->_next;
                 JanetAsyncStatus status1 = JANET_ASYNC_STATUS_NOT_DONE;
                 JanetAsyncStatus status2 = JANET_ASYNC_STATUS_NOT_DONE;
@@ -1576,36 +1627,20 @@ void janet_ev_deinit(void) {
  * NetBSD uses intptr_t while others use void * for .udata */
 #define EV_SETx(ev, a, b, c, d, e, f) EV_SET((ev), (a), (b), (c), (d), (e), ((__typeof__((ev)->udata))(f)))
 #define JANET_KQUEUE_TF (EV_ADD | EV_ENABLE | EV_CLEAR | EV_ONESHOT)
-
-/* NOTE:
- * NetBSD doesn't like intervals less than 1 millisecond so lets make that the
- * default anywhere JANET_KQUEUE_TS will be used. */
-#ifdef __NetBSD__
-#define JANET_KQUEUE_MIN_INTERVAL 1
-#else
 #define JANET_KQUEUE_MIN_INTERVAL 0
-#endif
 
-#ifdef __FreeBSD__
-#define JANET_KQUEUE_TS(timestamp) (timestamp)
-#else
 /* NOTE:
- * NetBSD and OpenBSD expect things are always intervals, so fake that we have
- * abstime capability by changing how a timestamp is used in all kqueue calls
- * and defining absent macros. Additionally NetBSD expects intervals be
- * greater than 1 millisecond, so correct all intervals to be at least 1
- * millisecond under NetBSD. */
-JanetTimestamp fix_interval(const JanetTimestamp ts) {
+ * NetBSD and OpenBSD expect things are always intervals, and FreeBSD doesn't
+ * like an ABSTIME in the past so just use intervals always. Introduces a
+ * calculation to determine the minimum timeout per timeout requested of
+ * kqueue. Also note that NetBSD doesn't accept timeout intervals less than 1
+ * millisecond, so correct all intervals on that platform to be at least 1
+ * millisecond.*/
+JanetTimestamp to_interval(const JanetTimestamp ts) {
     return ts >= JANET_KQUEUE_MIN_INTERVAL ? ts : JANET_KQUEUE_MIN_INTERVAL;
 }
-#define JANET_KQUEUE_TS(timestamp) (fix_interval((timestamp - ts_now())))
-#define NOTE_MSECONDS 0
-#define NOTE_ABSTIME 0
-#endif
+#define JANET_KQUEUE_INTERVAL(timestamp) (to_interval((timestamp - ts_now())))
 
-
-/* TODO: make this available be we using kqueue or epoll, instead of
- * redefinining it for kqueue and epoll separately? */
 static JanetTimestamp ts_now(void) {
     struct timespec now;
     janet_assert(-1 != clock_gettime(CLOCK_MONOTONIC, &now), "failed to get time");
@@ -1614,6 +1649,12 @@ static JanetTimestamp ts_now(void) {
     return res;
 }
 
+/* NOTE: Assumes Janet's timestamp precision is in milliseconds. */
+static void timestamp2timespec(struct timespec *t, JanetTimestamp ts) {
+    t->tv_sec = ts == 0 ? 0 : ts / 1000;
+    t->tv_nsec = ts == 0 ? 0 : (ts % 1000) * 1000000;
+}
+
 void add_kqueue_events(const struct kevent *events, int length) {
     /* NOTE: Status should be equal to the amount of events added, which isn't
      * always known since deletions or modifications occur. Can't use the
@@ -1680,45 +1721,46 @@ static void janet_unlisten(JanetListenerState *state, int is_gc) {
     janet_unlisten_impl(state, is_gc);
 }
 
-#define JANET_KQUEUE_TIMER_IDENT 1
 #define JANET_KQUEUE_MAX_EVENTS 64
 
 void janet_loop1_impl(int has_timeout, JanetTimestamp timeout) {
-    /* Construct our timer which is a definite time on the clock, not an
-     * interval, in milliseconds as that is `JanetTimestamp`'s precision. */
-    struct kevent timer;
-    if (janet_vm.timer_enabled || has_timeout) {
-        EV_SETx(&timer,
-                JANET_KQUEUE_TIMER_IDENT,
-                EVFILT_TIMER,
-                JANET_KQUEUE_TF,
-                NOTE_MSECONDS | NOTE_ABSTIME,
-                JANET_KQUEUE_TS(timeout), &janet_vm.timer);
-        add_kqueue_events(&timer, 1);
-    }
-    janet_vm.timer_enabled = has_timeout;
-
     /* Poll for events */
+    /* NOTE:
+     * We calculate the timeout interval per iteration. When the interval
+     * drops to 0 or negative, we effect a timeout of 0. Effecting a timeout
+     * of infinity will not work and could make other fibers with timeouts
+     * miss their timeouts if we did so.
+     * JANET_KQUEUE_INTERVAL insures we have a timeout of no less than 0. */
     int status;
+    struct timespec ts;
     struct kevent events[JANET_KQUEUE_MAX_EVENTS];
     do {
-        status = kevent(janet_vm.kq, NULL, 0, events, JANET_KQUEUE_MAX_EVENTS, NULL);
+        if (janet_vm.timer_enabled || has_timeout) {
+            timestamp2timespec(&ts, JANET_KQUEUE_INTERVAL(timeout));
+            status = kevent(janet_vm.kq, NULL, 0, events,
+                            JANET_KQUEUE_MAX_EVENTS, &ts);
+        } else {
+            status = kevent(janet_vm.kq, NULL, 0, events,
+                            JANET_KQUEUE_MAX_EVENTS, NULL);
+        }
     } while (status == -1 && errno == EINTR);
     if (status == -1)
         JANET_EXIT("failed to poll events");
 
+    /* Make sure timer is set accordingly. */
+    janet_vm.timer_enabled = has_timeout;
+
     /* Step state machines */
     for (int i = 0; i < status; i++) {
         void *p = (void *) events[i].udata;
-        if (&janet_vm.timer == p) {
-            /* Timer expired, ignore */;
-        } else if (janet_vm.selfpipe == p) {
+        if (janet_vm.selfpipe == p) {
             /* Self-pipe handling */
             janet_ev_handle_selfpipe();
         } else {
             JanetStream *stream = p;
             JanetListenerState *state = stream->state;
-            if (NULL != state) {
+            while (NULL != state) {
+                JanetListenerState *next_state = state->_next;
                 state->event = events + i;
                 JanetAsyncStatus statuses[4];
                 for (int i = 0; i < 4; i++)
@@ -1739,6 +1781,8 @@ void janet_loop1_impl(int has_timeout, JanetTimestamp timeout) {
                         statuses[2] == JANET_ASYNC_STATUS_DONE ||
                         statuses[3] == JANET_ASYNC_STATUS_DONE)
                     janet_unlisten(state, 0);
+
+                state = next_state;
             }
         }
     }
@@ -1750,16 +1794,9 @@ void janet_ev_init(void) {
     janet_vm.kq = kqueue();
     janet_vm.timer_enabled = 0;
     if (janet_vm.kq == -1) goto error;
-    struct kevent events[2];
-    /* Don't use JANET_KQUEUE_TS here, as even under FreeBSD we use intervals
-     * here. */
-    EV_SETx(&events[0],
-            JANET_KQUEUE_TIMER_IDENT,
-            EVFILT_TIMER,
-            JANET_KQUEUE_TF,
-            NOTE_MSECONDS, JANET_KQUEUE_MIN_INTERVAL, &janet_vm.timer);
-    EV_SETx(&events[1], janet_vm.selfpipe[0], EVFILT_READ, EV_ADD | EV_ENABLE, 0, 0, janet_vm.selfpipe);
-    add_kqueue_events(events, 2);
+    struct kevent event;
+    EV_SETx(&event, janet_vm.selfpipe[0], EVFILT_READ, EV_ADD | EV_ENABLE, 0, 0, janet_vm.selfpipe);
+    add_kqueue_events(&event, 1);
     return;
 error:
     JANET_EXIT("failed to initialize event loop");
@@ -2206,6 +2243,10 @@ JanetAsyncStatus ev_machine_read(JanetListenerState *s, JanetAsyncEvent event) {
             } else
 #endif
             {
+                /* Some handles (not all) read from the offset in lopOverlapped
+                 * if its not set before calling `ReadFile` these streams will always read from offset 0 */
+                state->overlapped.Offset = (DWORD) state->bytes_read;
+
                 status = ReadFile(s->stream->handle, state->chunk_buf, chunk_size, NULL, &state->overlapped);
                 if (!status && (ERROR_IO_PENDING != WSAGetLastError())) {
                     if (WSAGetLastError() == ERROR_BROKEN_PIPE) {
@@ -2235,7 +2276,7 @@ JanetAsyncStatus ev_machine_read(JanetListenerState *s, JanetAsyncEvent event) {
         case JANET_ASYNC_EVENT_READ: {
             JanetBuffer *buffer = state->buf;
             int32_t bytes_left = state->bytes_left;
-            int32_t read_limit = bytes_left > 4096 ? 4096 : bytes_left;
+            int32_t read_limit = state->is_chunk ? (bytes_left > 4096 ? 4096 : bytes_left) : bytes_left;
             janet_buffer_extra(buffer, read_limit);
             ssize_t nread;
 #ifdef JANET_NET
@@ -2571,15 +2612,16 @@ void janet_ev_sendto_string(JanetStream *stream, JanetString str, void *dest, in
 static volatile long PipeSerialNumber;
 #endif
 
+/*
+ * mode = 0: both sides non-blocking.
+ * mode = 1: only read side non-blocking: write side sent to subprocess
+ * mode = 2: only write side non-blocking: read side sent to subprocess
+ */
 int janet_make_pipe(JanetHandle handles[2], int mode) {
 #ifdef JANET_WINDOWS
     /*
      * On windows, the built in CreatePipe function doesn't support overlapped IO
      * so we lift from the windows source code and modify for our own version.
-     *
-     * mode = 0: both sides non-blocking.
-     * mode = 1: only read side non-blocking: write side sent to subprocess
-     * mode = 2: only write side non-blocking: read side sent to subprocess
      */
     JanetHandle shandle, chandle;
     UCHAR PipeNameBuffer[MAX_PATH];
@@ -2629,10 +2671,11 @@ int janet_make_pipe(JanetHandle handles[2], int mode) {
     }
     return 0;
 #else
-    (void) mode;
     if (pipe(handles)) return -1;
-    if (fcntl(handles[0], F_SETFL, O_NONBLOCK)) goto error;
-    if (fcntl(handles[1], F_SETFL, O_NONBLOCK)) goto error;
+    if (mode != 2 && fcntl(handles[0], F_SETFD, FD_CLOEXEC)) goto error;
+    if (mode != 1 && fcntl(handles[1], F_SETFD, FD_CLOEXEC)) goto error;
+    if (mode != 2 && fcntl(handles[0], F_SETFL, O_NONBLOCK)) goto error;
+    if (mode != 1 && fcntl(handles[1], F_SETFL, O_NONBLOCK)) goto error;
     return 0;
 error:
     close(handles[0]);
@@ -2681,6 +2724,8 @@ JANET_CORE_FN(cfun_ev_go,
     return janet_wrap_fiber(fiber);
 }
 
+#define JANET_THREAD_SUPERVISOR_FLAG 0x100
+
 /* For ev/thread - Run an interpreter in the new thread. */
 static JanetEVGenericMessage janet_go_thread_subr(JanetEVGenericMessage args) {
     JanetBuffer *buffer = (JanetBuffer *) args.argp;
@@ -2703,7 +2748,7 @@ static JanetEVGenericMessage janet_go_thread_subr(JanetEVGenericMessage args) {
         }
 
         /* Get supervsior */
-        if (flags & 0x8) {
+        if (flags & JANET_THREAD_SUPERVISOR_FLAG) {
             Janet sup =
                 janet_unmarshal(nextbytes, endbytes - nextbytes,
                                 JANET_MARSHAL_UNSAFE, NULL, &nextbytes);
@@ -2755,6 +2800,10 @@ static JanetEVGenericMessage janet_go_thread_subr(JanetEVGenericMessage args) {
         } else {
             fiber = janet_unwrap_fiber(fiberv);
         }
+        if (flags & 0x8) {
+            if (NULL == fiber->env) fiber->env = janet_table(0);
+            janet_table_put(fiber->env, janet_ckeywordv("task-id"), value);
+        }
         fiber->supervisor_channel = janet_vm.user;
         janet_schedule(fiber, value);
         janet_loop();
@@ -2799,6 +2848,7 @@ JANET_CORE_FN(cfun_ev_thread,
               "If you want to run the thread without waiting for a result, pass the `:n` flag to return nil immediately. "
               "Otherwise, returns nil. Available flags:\n\n"
               "* `:n` - return immediately\n"
+              "* `:t` - set the task-id of the new thread to value. The task-id is passed in messages to the supervisor channel.\n"
               "* `:a` - don't copy abstract registry to new thread (performance optimization)\n"
               "* `:c` - don't copy cfunction registry to new thread (performance optimization)") {
     janet_arity(argc, 1, 4);
@@ -2806,10 +2856,10 @@ JANET_CORE_FN(cfun_ev_thread,
     if (!janet_checktype(argv[0], JANET_FUNCTION)) janet_getfiber(argv, 0);
     uint64_t flags = 0;
     if (argc >= 3) {
-        flags = janet_getflags(argv, 2, "nac");
+        flags = janet_getflags(argv, 2, "nact");
     }
     void *supervisor = janet_optabstract(argv, argc, 3, &janet_channel_type, janet_vm.root_fiber->supervisor_channel);
-    if (NULL != supervisor) flags |= 0x8;
+    if (NULL != supervisor) flags |= JANET_THREAD_SUPERVISOR_FLAG;
 
     /* Marshal arguments for the new thread. */
     JanetBuffer *buffer = janet_malloc(sizeof(JanetBuffer));
@@ -2820,7 +2870,7 @@ JANET_CORE_FN(cfun_ev_thread,
     if (!(flags & 0x2)) {
         janet_marshal(buffer, janet_wrap_table(janet_vm.abstract_registry), NULL, JANET_MARSHAL_UNSAFE);
     }
-    if (flags & 0x8) {
+    if (flags & JANET_THREAD_SUPERVISOR_FLAG) {
         janet_marshal(buffer, janet_wrap_abstract(supervisor), NULL, JANET_MARSHAL_UNSAFE);
     }
     if (!(flags & 0x4)) {
@@ -2903,7 +2953,7 @@ JANET_CORE_FN(cfun_ev_deadline,
 
 JANET_CORE_FN(cfun_ev_cancel,
               "(ev/cancel fiber err)",
-              "Cancel a suspended fiber in the event loop. Differs from cancel in that it returns the canceled fiber immediately") {
+              "Cancel a suspended fiber in the event loop. Differs from cancel in that it returns the canceled fiber immediately.") {
     janet_fixarity(argc, 2);
     JanetFiber *fiber = janet_getfiber(argv, 0);
     Janet err = argv[1];
@@ -2979,6 +3029,106 @@ JANET_CORE_FN(janet_cfun_stream_write,
     janet_await();
 }
 
+static int mutexgc(void *p, size_t size) {
+    (void) size;
+    janet_os_mutex_deinit(p);
+    return 0;
+}
+
+const JanetAbstractType janet_mutex_type = {
+    "core/lock",
+    mutexgc,
+    JANET_ATEND_GC
+};
+
+JANET_CORE_FN(janet_cfun_mutex,
+              "(ev/lock)",
+              "Create a new lock to coordinate threads.") {
+    janet_fixarity(argc, 0);
+    (void) argv;
+    void *mutex = janet_abstract_threaded(&janet_mutex_type, janet_os_mutex_size());
+    janet_os_mutex_init(mutex);
+    return janet_wrap_abstract(mutex);
+}
+
+JANET_CORE_FN(janet_cfun_mutex_acquire,
+              "(ev/acquire-lock lock)",
+              "Acquire a lock such that this operating system thread is the only thread with access to this resource."
+              " This will block this entire thread until the lock becomes available, and will not yield to other fibers "
+              "on this system thread.") {
+    janet_fixarity(argc, 1);
+    void *mutex = janet_getabstract(argv, 0, &janet_mutex_type);
+    janet_os_mutex_lock(mutex);
+    return argv[0];
+}
+
+JANET_CORE_FN(janet_cfun_mutex_release,
+              "(ev/release-lock lock)",
+              "Release a lock such that other threads may acquire it.") {
+    janet_fixarity(argc, 1);
+    void *mutex = janet_getabstract(argv, 0, &janet_mutex_type);
+    janet_os_mutex_unlock(mutex);
+    return argv[0];
+}
+
+static int rwlockgc(void *p, size_t size) {
+    (void) size;
+    janet_os_rwlock_deinit(p);
+    return 0;
+}
+
+const JanetAbstractType janet_rwlock_type = {
+    "core/rwlock",
+    rwlockgc,
+    JANET_ATEND_GC
+};
+
+JANET_CORE_FN(janet_cfun_rwlock,
+              "(ev/rwlock)",
+              "Create a new read-write lock to coordinate threads.") {
+    janet_fixarity(argc, 0);
+    (void) argv;
+    void *rwlock = janet_abstract_threaded(&janet_rwlock_type, janet_os_rwlock_size());
+    janet_os_rwlock_init(rwlock);
+    return janet_wrap_abstract(rwlock);
+}
+
+JANET_CORE_FN(janet_cfun_rwlock_read_lock,
+              "(ev/acquire-rlock rwlock)",
+              "Acquire a read lock an a read-write lock.") {
+    janet_fixarity(argc, 1);
+    void *rwlock = janet_getabstract(argv, 0, &janet_rwlock_type);
+    janet_os_rwlock_rlock(rwlock);
+    return argv[0];
+}
+
+JANET_CORE_FN(janet_cfun_rwlock_write_lock,
+              "(ev/acquire-wlock rwlock)",
+              "Acquire a write lock on a read-write lock.") {
+    janet_fixarity(argc, 1);
+    void *rwlock = janet_getabstract(argv, 0, &janet_rwlock_type);
+    janet_os_rwlock_wlock(rwlock);
+    return argv[0];
+}
+
+JANET_CORE_FN(janet_cfun_rwlock_read_release,
+              "(ev/release-rlock rwlock)",
+              "Release a read lock on a read-write lock") {
+    janet_fixarity(argc, 1);
+    void *rwlock = janet_getabstract(argv, 0, &janet_rwlock_type);
+    janet_os_rwlock_runlock(rwlock);
+    return argv[0];
+}
+
+JANET_CORE_FN(janet_cfun_rwlock_write_release,
+              "(ev/release-wlock rwlock)",
+              "Release a write lock on a read-write lock") {
+    janet_fixarity(argc, 1);
+    void *rwlock = janet_getabstract(argv, 0, &janet_rwlock_type);
+    janet_os_rwlock_wunlock(rwlock);
+    return argv[0];
+}
+
 void janet_lib_ev(JanetTable *env) {
     JanetRegExt ev_cfuns_ext[] = {
         JANET_CORE_REG("ev/give", cfun_channel_push),
@@ -3001,12 +3151,22 @@ void janet_lib_ev(JanetTable *env) {
         JANET_CORE_REG("ev/read", janet_cfun_stream_read),
         JANET_CORE_REG("ev/chunk", janet_cfun_stream_chunk),
         JANET_CORE_REG("ev/write", janet_cfun_stream_write),
+        JANET_CORE_REG("ev/lock", janet_cfun_mutex),
+        JANET_CORE_REG("ev/acquire-lock", janet_cfun_mutex_acquire),
+        JANET_CORE_REG("ev/release-lock", janet_cfun_mutex_release),
+        JANET_CORE_REG("ev/rwlock", janet_cfun_rwlock),
+        JANET_CORE_REG("ev/acquire-rlock", janet_cfun_rwlock_read_lock),
+        JANET_CORE_REG("ev/acquire-wlock", janet_cfun_rwlock_write_lock),
+        JANET_CORE_REG("ev/release-rlock", janet_cfun_rwlock_read_release),
+        JANET_CORE_REG("ev/release-wlock", janet_cfun_rwlock_write_release),
         JANET_REG_END
     };
 
     janet_core_cfuns_ext(env, NULL, ev_cfuns_ext);
     janet_register_abstract_type(&janet_stream_type);
     janet_register_abstract_type(&janet_channel_type);
+    janet_register_abstract_type(&janet_mutex_type);
+    janet_register_abstract_type(&janet_rwlock_type);
 }
 
 #endif

src/core/features.h

@@ -1,5 +1,5 @@
 /*
-* Copyright (c) 2021 Calvin Rose
+* Copyright (c) 2022 Calvin Rose
 *
 * Permission is hereby granted, free of charge, to any person obtaining a copy
 * of this software and associated documentation files (the "Software"), to
@@ -36,13 +36,22 @@
 # endif
 #endif
 
+/* Needed for sched.h for cpu count */
+#ifdef __linux__
+#define _GNU_SOURCE
+#endif
+
 #if defined(WIN32) || defined(_WIN32)
 #define WIN32_LEAN_AND_MEAN
 #endif
 
-/* Needed for realpath on linux */
-#if !defined(_XOPEN_SOURCE) && (defined(__linux__) || defined(__EMSCRIPTEN__))
-#define _XOPEN_SOURCE 500
+/* Needed for realpath on linux, as well as pthread rwlocks. */
+#ifndef _XOPEN_SOURCE
+#define _XOPEN_SOURCE 600
+#endif
+#if _XOPEN_SOURCE < 600
+#undef _XOPEN_SOURCE
+#define _XOPEN_SOURCE 600
 #endif
 
 /* Needed for timegm and other extensions when building with -std=c99.

src/core/fiber.c

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

src/core/fiber.h

@@ -1,5 +1,5 @@
 /*
-* Copyright (c) 2021 Calvin Rose
+* Copyright (c) 2022 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,6 +56,10 @@
 #define JANET_FIBER_DID_LONGJUMP     0x8000000
 #define JANET_FIBER_FLAG_MASK        0xF000000
 
+#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;\
     (f)->flags |= (s) << JANET_FIBER_STATUS_OFFSET;\

src/core/gc.c

@@ -1,5 +1,5 @@
 /*
-* Copyright (c) 2021 Calvin Rose
+* Copyright (c) 2022 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
@@ -162,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) {
@@ -323,7 +326,7 @@ void janet_sweep() {
     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;
@@ -331,7 +334,7 @@ void janet_sweep() {
             janet_vm.block_count--;
             janet_deinit_block(current);
             if (NULL != previous) {
-                previous->next = next;
+                previous->data.next = next;
             } else {
                 janet_vm.blocks = next;
             }
@@ -395,7 +398,7 @@ void *janet_gcalloc(enum JanetMemoryType type, size_t size) {
 
     /* Prepend block to heap list */
     janet_vm.next_collection += size;
-    mem->next = janet_vm.blocks;
+    mem->data.next = janet_vm.blocks;
     janet_vm.blocks = mem;
     janet_vm.block_count++;
 
@@ -532,7 +535,7 @@ void janet_clear_memory(void) {
     JanetGCObject *current = janet_vm.blocks;
     while (NULL != current) {
         janet_deinit_block(current);
-        JanetGCObject *next = current->next;
+        JanetGCObject *next = current->data.next;
         janet_free(current);
         current = next;
     }

src/core/gc.h

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

src/core/inttypes.c

@@ -1,5 +1,5 @@
 /*
-* Copyright (c) 2021 Calvin Rose & contributors
+* Copyright (c) 2022 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
@@ -207,6 +207,92 @@ JANET_CORE_FN(cfun_it_u64_new,
     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
@@ -514,6 +600,8 @@ void janet_lib_inttypes(JanetTable *env) {
     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);

src/core/io.c

@@ -1,5 +1,5 @@
 /*
-* Copyright (c) 2021 Calvin Rose
+* Copyright (c) 2022 Calvin Rose
 *
 * Permission is hereby granted, free of charge, to any person obtaining a copy
 * of this software and associated documentation files (the "Software"), to
@@ -112,42 +112,6 @@ static void *makef(FILE *f, int32_t flags) {
     return iof;
 }
 
-/* Open a process */
-#ifndef JANET_NO_PROCESSES
-JANET_CORE_FN(cfun_io_popen,
-              "(file/popen command &opt mode) (DEPRECATED for os/spawn)",
-              "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.") {
-    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
-
 JANET_CORE_FN(cfun_io_temp,
               "(file/temp)",
               "Open an anonymous temporary file that is removed on close. "
@@ -296,7 +260,6 @@ JANET_CORE_FN(cfun_io_fflush,
 }
 
 #ifdef JANET_WINDOWS
-#define pclose _pclose
 #define WEXITSTATUS(x) x
 #endif
 
@@ -304,14 +267,7 @@ JANET_CORE_FN(cfun_io_fflush,
 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;
         return ret;
     }
@@ -331,30 +287,18 @@ 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. If the file is the result of a file/popen "
-              "call, close waits for and returns the process exit status.") {
+              "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();
 }
 
@@ -483,6 +427,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");
@@ -533,27 +490,27 @@ 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 "
+              "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);
 }
 
 JANET_CORE_FN(cfun_io_prin,
               "(prin & xs)",
-              "Same as print, but does not add trailing newline.") {
+              "Same as `print`, but does not add trailing newline.") {
     return cfun_io_print_impl(argc, argv, 0, "out", stdout);
 }
 
 JANET_CORE_FN(cfun_io_eprint,
               "(eprint & xs)",
-              "Same as print, but uses (dyn :err stderr) instead of (dyn :out stdout).") {
+              "Same as `print`, but uses `(dyn :err stderr)` instead of `(dyn :out stdout)`.") {
     return cfun_io_print_impl(argc, argv, 1, "err", stderr);
 }
 
 JANET_CORE_FN(cfun_io_eprin,
               "(eprin & xs)",
-              "Same as prin, but uses (dyn :err stderr) instead of (dyn :out stdout).") {
+              "Same as `prin`, but uses `(dyn :err stderr)` instead of `(dyn :out stdout)`.") {
     return cfun_io_print_impl(argc, argv, 0, "err", stderr);
 }
 
@@ -561,7 +518,7 @@ 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.") {
+              "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]);
 }
@@ -569,7 +526,7 @@ JANET_CORE_FN(cfun_io_xprint,
 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.") {
+              "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]);
 }
@@ -588,6 +545,16 @@ static Janet cfun_io_printf_impl_x(int32_t argc, Janet *argv, int newline,
             if (newline) janet_buffer_push_u8(buf, '\n');
             return janet_wrap_nil();
         }
+        case JANET_FUNCTION: {
+            /* Special case function */
+            JanetFunction *fun = janet_unwrap_function(x);
+            JanetBuffer *buf = janet_buffer(0);
+            janet_buffer_format(buf, fmt, offset, argc, argv);
+            if (newline) janet_buffer_push_u8(buf, '\n');
+            Janet args[1] = { janet_wrap_buffer(buf) };
+            janet_call(fun, 1, args);
+            return janet_wrap_nil();
+        }
         case JANET_NIL:
             f = dflt_file;
             if (f == NULL) janet_panic("cannot print to nil");
@@ -627,38 +594,38 @@ static Janet cfun_io_printf_impl(int32_t argc, Janet *argv, int newline,
 
 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.") {
+              "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);
 }
 
 JANET_CORE_FN(cfun_io_prinf,
               "(prinf fmt & xs)",
-              "Like printf but with no trailing newline.") {
+              "Like `printf` but with no trailing newline.") {
     return cfun_io_printf_impl(argc, argv, 0, "out", stdout);
 }
 
 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.") {
+              "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);
 }
 
 JANET_CORE_FN(cfun_io_eprinf,
               "(eprinf fmt & xs)",
-              "Like eprintf but with no trailing newline.") {
+              "Like `eprintf` but with no trailing newline.") {
     return cfun_io_printf_impl(argc, argv, 0, "err", stderr);
 }
 
 JANET_CORE_FN(cfun_io_xprintf,
               "(xprintf to fmt & xs)",
-              "Like printf but prints to an explicit file or value to. Returns nil.") {
+              "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]);
 }
 
 JANET_CORE_FN(cfun_io_xprinf,
               "(xprinf to fmt & xs)",
-              "Like prinf but prints to an explicit file or value to. Returns nil.") {
+              "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]);
 }
@@ -683,7 +650,7 @@ static void janet_flusher(const char *name, FILE *dflt_file) {
 
 JANET_CORE_FN(cfun_io_flush,
               "(flush)",
-              "Flush (dyn :out stdout) if it is a file, otherwise do nothing.") {
+              "Flush `(dyn :out stdout)` if it is a file, otherwise do nothing.") {
     janet_fixarity(argc, 0);
     (void) argv;
     janet_flusher("out", stdout);
@@ -692,7 +659,7 @@ JANET_CORE_FN(cfun_io_flush,
 
 JANET_CORE_FN(cfun_io_eflush,
               "(eflush)",
-              "Flush (dyn :err stderr) if it is a file, otherwise do nothing.") {
+              "Flush `(dyn :err stderr)` if it is a file, otherwise do nothing.") {
     janet_fixarity(argc, 0);
     (void) argv;
     janet_flusher("err", stderr);
@@ -727,6 +694,16 @@ void janet_dynprintf(const char *name, FILE *dflt_file, const char *format, ...)
             janet_buffer_deinit(&buffer);
             break;
         }
+        case JANET_FUNCTION: {
+            JanetFunction *fun = janet_unwrap_function(x);
+            int32_t len = 0;
+            while (format[len]) len++;
+            JanetBuffer *buf = janet_buffer(len);
+            janet_formatbv(buf, format, args);
+            Janet args[1] = { janet_wrap_buffer(buf) };
+            janet_call(fun, 1, args);
+            break;
+        }
         case JANET_BUFFER:
             janet_formatbv(janet_unwrap_buffer(x), format, args);
             break;
@@ -789,9 +766,6 @@ void janet_lib_io(JanetTable *env) {
         JANET_CORE_REG("file/write", cfun_io_fwrite),
         JANET_CORE_REG("file/flush", cfun_io_fflush),
         JANET_CORE_REG("file/seek", cfun_io_fseek),
-#ifndef JANET_NO_PROCESSES
-        JANET_CORE_REG("file/popen", cfun_io_popen),
-#endif
         JANET_REG_END
     };
     janet_core_cfuns_ext(env, NULL, io_cfuns);

src/core/marsh.c

@@ -1,5 +1,5 @@
 /*
-* Copyright (c) 2021 Calvin Rose
+* Copyright (c) 2022 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
@@ -64,8 +64,9 @@ enum {
     LB_FUNCDEF_REF, /* 220 */
     LB_UNSAFE_CFUNCTION, /* 221 */
     LB_UNSAFE_POINTER, /* 222 */
+    LB_STRUCT_PROTO, /* 223 */
 #ifdef JANET_EV
-    LB_THREADED_ABSTRACT/* 223 */
+    LB_THREADED_ABSTRACT/* 224 */
 #endif
 } LeadBytes;
 
@@ -542,8 +543,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;
@@ -1281,6 +1284,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 */
@@ -1310,9 +1314,15 @@ static const uint8_t *unmarshal_one(
                 }
                 *out = janet_wrap_tuple(janet_tuple_end(tup));
                 janet_v_push(st->lookup, *out);
-            } else if (lead == LB_STRUCT) {
+            } else if (lead == LB_STRUCT || lead == LB_STRUCT_PROTO) {
                 /* Struct */
                 JanetKV *struct_ = janet_struct_begin(len);
+                if (lead == LB_STRUCT_PROTO) {
+                    Janet proto;
+                    data = unmarshal_one(st, data, &proto, flags + 1);
+                    janet_asserttype(proto, JANET_STRUCT);
+                    janet_struct_proto(struct_) = janet_unwrap_struct(proto);
+                }
                 for (int32_t i = 0; i < len; i++) {
                     Janet key, value;
                     data = unmarshal_one(st, data, &key, flags + 1);

src/core/math.c

@@ -1,5 +1,5 @@
 /*
-* Copyright (c) 2021 Calvin Rose
+* Copyright (c) 2022 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
@@ -231,7 +231,7 @@ static Janet janet_rng_next(void *p, Janet key) {
 /* Get a random number */
 JANET_CORE_FN(janet_rand,
               "(math/random)",
-              "Returns a uniformly distributed random number between 0 and 1") {
+              "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));
@@ -240,7 +240,7 @@ JANET_CORE_FN(janet_rand,
 /* Seed the random number generator */
 JANET_CORE_FN(janet_srand,
               "(math/seedrandom seed)",
-              "Set the seed for the random number generator. seed should be "
+              "Set the seed for the random number generator. `seed` should be "
               "an integer or a buffer."
              ) {
     janet_fixarity(argc, 1);
@@ -261,7 +261,7 @@ JANET_CORE_FN(janet_##name, "(math/" #name " x)", doc) {\
     return janet_wrap_number(fop(x)); \
 }
 
-JANET_DEFINE_MATHOP(acos, acos, "Returns the arccosize of x.")
+JANET_DEFINE_MATHOP(acos, acos, "Returns the arccosine of x.")
 JANET_DEFINE_MATHOP(asin, asin, "Returns the arcsin of x.")
 JANET_DEFINE_MATHOP(atan, atan, "Returns the arctangent of x.")
 JANET_DEFINE_MATHOP(cos, cos, "Returns the cosine of x.")
@@ -286,7 +286,8 @@ JANET_DEFINE_MATHOP(fabs, fabs, "Return the absolute value of x.")
 JANET_DEFINE_MATHOP(floor, floor, "Returns the largest integer value number that is not greater than x.")
 JANET_DEFINE_MATHOP(trunc, trunc, "Returns the integer between x and 0 nearest to x.")
 JANET_DEFINE_MATHOP(round, round, "Returns the integer nearest to x.")
-JANET_DEFINE_MATHOP(gamma, lgamma, "Returns gamma(x).")
+JANET_DEFINE_MATHOP(gamma, tgamma, "Returns gamma(x).")
+JANET_DEFINE_MATHOP(lgamma, lgamma, "Returns log-gamma(x).")
 JANET_DEFINE_MATHOP(log1p, log1p, "Returns (log base e of x) + 1 more accurately than (+ (math/log x) 1)")
 JANET_DEFINE_MATHOP(erf, erf, "Returns the error function of x.")
 JANET_DEFINE_MATHOP(erfc, erfc, "Returns the complementary error function of x.")
@@ -309,6 +310,42 @@ JANET_CORE_FN(janet_not, "(not x)", "Returns the boolean inverse of x.") {
     return janet_wrap_boolean(!janet_truthy(argv[0]));
 }
 
+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) {
@@ -347,12 +384,15 @@ void janet_lib_math(JanetTable *env) {
         JANET_CORE_REG("math/exp2", janet_exp2),
         JANET_CORE_REG("math/log1p", janet_log1p),
         JANET_CORE_REG("math/gamma", janet_gamma),
+        JANET_CORE_REG("math/log-gamma", janet_lgamma),
         JANET_CORE_REG("math/erfc", janet_erfc),
         JANET_CORE_REG("math/erf", janet_erf),
         JANET_CORE_REG("math/expm1", janet_expm1),
         JANET_CORE_REG("math/trunc", janet_trunc),
         JANET_CORE_REG("math/round", janet_round),
         JANET_CORE_REG("math/next", janet_nextafter),
+        JANET_CORE_REG("math/gcd", janet_cfun_gcd),
+        JANET_CORE_REG("math/lcm", janet_cfun_lcm),
         JANET_REG_END
     };
     janet_core_cfuns_ext(env, NULL, math_cfuns);

src/core/net.c

@@ -1,5 +1,5 @@
 /*
-* Copyright (c) 2021 Calvin Rose and contributors.
+* Copyright (c) 2022 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
@@ -74,6 +74,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 */
@@ -123,22 +132,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;
             }
@@ -314,12 +321,13 @@ static struct addrinfo *janet_get_addrinfo(Janet *argv, int32_t offset, int sock
  */
 
 JANET_CORE_FN(cfun_net_sockaddr,
-              "(net/address host port &opt type)",
+              "(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.") {
+              "unix domain sockets are specified with a leading '@' character in port. If `multi` is truthy, will "
+              "return all address that match in an array instead of just the first.") {
     janet_arity(argc, 2, 4);
     int socktype = janet_get_sockettype(argv, argc, 2);
     int is_unix = 0;
@@ -372,7 +380,7 @@ JANET_CORE_FN(cfun_net_connect,
     int is_unix = 0;
     char *bindhost = (char *) janet_optcstring(argv, argc, 3, NULL);
     char *bindport = NULL;
-    if (janet_checkint(argv[4])) {
+    if (argc >= 5 && janet_checkint(argv[4])) {
         bindport = (char *)janet_to_string(argv[4]);
     } else {
         bindport = (char *)janet_optcstring(argv, argc, 4, NULL);
@@ -401,6 +409,7 @@ JANET_CORE_FN(cfun_net_connect,
         }
     }
 
+
     /* Create socket */
     JSock sock = JSOCKDEFAULT;
     void *addr = NULL;
@@ -421,7 +430,7 @@ JANET_CORE_FN(cfun_net_connect,
         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
@@ -631,268 +640,94 @@ JANET_CORE_FN(cfun_net_listen,
     }
 }
 
-/* Definitions from:
- *   https://github.com/wahern/cqueues/blog/master/src/lib/socket.h
- *     SO_MAX, SA_PORT_NONE, SO_MIN, SA_ADDRSTRLEN, sa_ntoa, sa_family,
- *     sa_port */
-#define SO_MAX(a, b) (((a) > (b))? (a) : (b))
-#define SA_PORT_NONE (&(in_port_t){ 0 })
-#define SO_MIN(a, b) (((a) < (b))? (a) : (b))
-#ifndef JANET_WINDOWS
-#define SA_ADDRSTRLEN SO_MAX(INET6_ADDRSTRLEN, (sizeof ((struct sockaddr_un *)0)->sun_path) + 1)
-#else
-#define SA_ADDRSTRLEN (INET6_ADDRSTRLEN + 1)
-#endif
-#define sa_ntoa(sa)  sa_ntoa_((char [SA_ADDRSTRLEN]){ 0 }, SA_ADDRSTRLEN, (sa))
-#define sa_family(...) sa_family(__VA_ARGS__)
-#define sa_port(...) sa_port(__VA_ARGS__)
-#ifdef JANET_WINDOWS
-typedef short sa_family_t; /* added to silence warnings */
-typedef unsigned short in_port_t; /* added to silence warnings */
-#endif
+/* 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
+*/
 
-/* Definition from:
- *   https://github.com/wahern/cqueues/blog/master/src/lib/socket.h */
-union sockaddr_arg {
-    struct sockaddr *sa;
-    const struct sockaddr *c_sa;
-    struct sockaddr_storage *ss;
-    struct sockaddr_storage *c_ss;
-    struct sockaddr_in *sin;
-    struct sockaddr_in *c_sin;
-    struct sockaddr_in6 *sin6;
-    struct sockaddr_in6 *c_sin6;
-#ifndef JANET_WINDOWS
-    struct sockaddr_un *sun;
-#endif
-    struct sockaddr_un *c_sun;
-    union sockaddr_any *any;
-    union sockaddr_any *c_any;
-
-    void *ptr;
-    void *c_ptr;
-};
-
-/* Definition from:
- *   https://github.com/wahern/cqueues/blog/master/src/lib/socket.h */
-union sockaddr_any {
-    struct sockaddr sa;
-    struct sockaddr_storage ss;
-    struct sockaddr_in sin;
-    struct sockaddr_in6 sin6;
-#ifndef JANET_WINDOWS
-    struct sockaddr_un sun;
-#endif
-};
-
-/* Definition from:
- *   https://github.com/wahern/cqueues/blog/master/src/lib/socket.h */
-static inline union sockaddr_arg sockaddr_ref(void *arg) {
-    return (union sockaddr_arg) {
-        arg
-    };
-}
-
-/* Definition from:
- *   https://github.com/wahern/cqueues/blog/master/src/lib/socket.h */
-static inline sa_family_t *(sa_family)(void *arg) {
-    return &sockaddr_ref(arg).sa->sa_family;
-}
-
-/* Definition from:
- *   https://github.com/wahern/cqueues/blog/master/src/lib/socket.h */
-static inline in_port_t *(sa_port)(void *arg, const in_port_t *def, int *error) {
-    switch (*sa_family(arg)) {
-        case AF_INET:
-            return &sockaddr_ref(arg).sin->sin_port;
-        case AF_INET6:
-            return &sockaddr_ref(arg).sin6->sin6_port;
+/* 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:
-            if (error)
-                *error = EAFNOSUPPORT;
-
-            return (in_port_t *)def;
-    }
-}
-
-/* Definition from:
- *   https://github.com/wahern/cqueues/blog/master/src/lib/socket.c
- * Original was dns_strlcpy */
-size_t janet_socket_strlcpy(char *dst, const char *src, size_t lim) {
-    char *d     = dst;
-    char *e     = &dst[lim];
-    const char *s   = src;
-
-    if (d < e) {
-        do {
-            if ('\0' == (*d++ = *s++))
-                return s - src - 1;
-        } while (d < e);
-
-        d[-1]   = '\0';
-    }
-
-    while (*s++ != '\0')
-        ;;
-
-    return s - src - 1;
-}
-
-/* Definition from:
- *   https://github.com/wahern/cqueues/blog/master/src/lib/socket.c */
-char *sa_ntop(char *dst, size_t lim, const void *src, const char *def, int *_error) {
-    union sockaddr_any *any = (void *)src;
-    const char *unspec = "0.0.0.0";
-    char text[SA_ADDRSTRLEN];
-    int error;
-
-    switch (*sa_family(&any->sa)) {
-        case AF_INET:
-            unspec = "0.0.0.0";
-
-            if (!inet_ntop(AF_INET, &any->sin.sin_addr, text, sizeof text))
-                goto syerr;
-
-            break;
-        case AF_INET6:
-            unspec = "::";
-
-            if (!inet_ntop(AF_INET6, &any->sin6.sin6_addr, text, sizeof text))
-                goto syerr;
-
-            break;
-#ifndef JANET_WINDOWS
-        case AF_UNIX:
-            unspec = "/nonexistent";
-
-            memset(text, 0, sizeof text);
-            memcpy(text, any->sun.sun_path, SO_MIN(sizeof text - 1, sizeof any->sun.sun_path));
-
-            break;
-#endif
-        default:
-            error = EAFNOSUPPORT;
-
-            goto error;
-    }
-
-    if (janet_socket_strlcpy(dst, text, lim) >= lim) {
-        error = ENOSPC;
-
-        goto error;
-    }
-
-    return dst;
-syerr:
-    error = errno;
-error:
-    if (_error)
-        *_error = error;
-
-    /*
-     * NOTE: Always write something in case caller ignores errors, such
-     * as when caller is using the sa_ntoa() macro.
-     */
-    safe_memcpy(dst, (def) ? def : unspec, lim);
-
-    return (char *)def;
-}
-
-/* Definition from:
- *   https://github.com/wahern/cqueues/blog/master/src/lib/socket.h */
-static inline char *sa_ntoa_(char *dst, size_t lim, const void *src) {
-    return sa_ntop(dst, lim, src, NULL, &(int) {
-        0
-    }), dst;
-}
-
-/* Definition from:
- *   https://github.com/wahern/cqueues/blog/master/src/lib/socket.c
- * Originaly was lso_pushname */
-static Janet janet_so_getname(const struct sockaddr_storage *ss, socklen_t slen) {
-    uint8_t *hn = NULL;
-    uint16_t hp = 0;
-    size_t plen = SA_ADDRSTRLEN;
-
-    switch (ss->ss_family) {
-        case AF_INET:
-        /* fall through */
-        case AF_INET6:
-            /* hn = hostname, hp = hostport */
-            hn = (uint8_t *)sa_ntoa(ss);
-            hp = ntohs(*sa_port((void *)ss, SA_PORT_NONE, NULL));
-            break;
-#ifndef JANET_WINDOWS
-        case AF_UNIX:
-            /* support nameless sockets, linux-ism */
-            if (slen > offsetof(struct sockaddr_un, sun_path)) {
-                struct sockaddr_un *sun = (struct sockaddr_un *)ss;
-                char *pe = (char *)sun + SO_MIN(sizeof * sun, slen);
-
-                while (pe > sun->sun_path && pe[-1] == '\0')
-                    --pe;
-
-                if ((plen = pe - sun->sun_path) > 0) {
-                    hn = (uint8_t *)sun->sun_path;
-                } else {
-                    hn = (uint8_t *)"@";
-                    plen = 1;
-                }
-            } else {
-                hn = (uint8_t *)"@";
-                plen = 1;
+            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");
             }
-            break;
+            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
-        default:
-            hn = (uint8_t *)"";
-            plen = 0;
-            break;
     }
-
-    Janet name[2];
-    int32_t len = 1;
-    name[0] = janet_wrap_string(janet_cstring((const char *)hn));
-    if (hp > 0) {
-        len++;
-        name[1] = janet_wrap_integer(hp);
-    }
-
-    return janet_wrap_tuple(janet_tuple_n(name, len));
 }
 
 JANET_CORE_FN(cfun_net_getsockname,
               "(net/localname stream)",
               "Gets the local address and port in a tuple in that order.") {
-    janet_arity(argc, 1, 1);
+    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;
+    socklen_t slen = sizeof(ss);
     memset(&ss, 0, slen);
-
-    int error;
-    if (0 != (error = getsockname((JSock)js->handle, (struct sockaddr *) &ss, &slen)))
-        janet_panicf("Failed to get peername on fd %d, error: %s", js->handle, janet_ev_lasterr());
-
-    return janet_so_getname(&ss, 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 <= 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_arity(argc, 1, 1);
+    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;
+    socklen_t slen = sizeof(ss);
     memset(&ss, 0, slen);
-
-    int error;
-    if (0 != (error = getpeername((JSock)js->handle, (struct sockaddr *)&ss, &slen))) {
-        janet_panicf("Failed to get peername on fd %d, error: %s", js->handle, janet_ev_lasterr());
+    if (getpeername((JSock)js->handle, (struct sockaddr *)&ss, &slen)) {
+        janet_panicf("Failed to get peername on %v: %V", argv[0], janet_ev_lasterr());
     }
+    janet_assert(slen <= sizeof(ss), "socket address truncated");
+    return janet_so_getname(&ss);
+}
 
-    return janet_so_getname(&ss, slen);
+JANET_CORE_FN(cfun_net_address_unpack,
+              "(net/address-unpack address)",
+              "Given an address returned by net/adress, return a host, port pair. Unix domain sockets "
+              "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,
@@ -1049,7 +884,6 @@ static JanetStream *make_stream(JSock handle, uint32_t flags) {
     return janet_stream((JanetHandle) handle, flags | JANET_STREAM_SOCKET, net_stream_methods);
 }
 
-
 void janet_lib_net(JanetTable *env) {
     JanetRegExt net_cfuns[] = {
         JANET_CORE_REG("net/address", cfun_net_sockaddr),
@@ -1066,6 +900,7 @@ void janet_lib_net(JanetTable *env) {
         JANET_CORE_REG("net/shutdown", cfun_net_shutdown),
         JANET_CORE_REG("net/peername", cfun_net_getpeername),
         JANET_CORE_REG("net/localname", cfun_net_getsockname),
+        JANET_CORE_REG("net/address-unpack", cfun_net_address_unpack),
         JANET_REG_END
     };
     janet_core_cfuns_ext(env, NULL, net_cfuns);

src/core/os.c

@@ -1,5 +1,5 @@
 /*
-* Copyright (c) 2021 Calvin Rose and contributors.
+* Copyright (c) 2022 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
@@ -39,8 +39,12 @@
 #include <sys/stat.h>
 #include <signal.h>
 
-#ifdef JANET_APPLE
-#include <AvailabilityMacros.h>
+#ifdef JANET_BSD
+#include <sys/sysctl.h>
+#endif
+
+#ifdef JANET_LINUX
+#include <sched.h>
 #endif
 
 #ifdef JANET_WINDOWS
@@ -67,12 +71,6 @@ extern char **environ;
 #endif
 #endif
 
-/* For macos */
-#ifdef __MACH__
-#include <mach/clock.h>
-#include <mach/mach.h>
-#endif
-
 /* Not POSIX, but all Unixes but Solaris have this function. */
 #if defined(JANET_POSIX) && !defined(__sun)
 time_t timegm(struct tm *tm);
@@ -183,6 +181,8 @@ JANET_CORE_FN(os_arch,
     return janet_ckeywordv("sparc");
 #elif (defined(__ppc__))
     return janet_ckeywordv("ppc");
+#elif (defined(__ppc64__) || defined(_ARCH_PPC64) || defined(_M_PPC))
+    return janet_ckeywordv("ppc64");
 #else
     return janet_ckeywordv("unknown");
 #endif
@@ -209,6 +209,47 @@ JANET_CORE_FN(os_exit,
     return janet_wrap_nil();
 }
 
+JANET_CORE_FN(os_cpu_count,
+              "(os/cpu-count &opt dflt)",
+              "Get an approximate number of CPUs available on for this process to use. If "
+              "unable to get an approximation, will return a default value dflt.") {
+    janet_arity(argc, 0, 1);
+    Janet dflt = argc > 0 ? argv[0] : janet_wrap_nil();
+#ifdef JANET_WINDOWS
+    (void) dflt;
+    SYSTEM_INFO info;
+    GetSystemInfo(&info);
+    return janet_wrap_integer(info.dwNumberOfProcessors);
+#elif defined(JANET_LINUX)
+    (void) dflt;
+    cpu_set_t cs;
+    CPU_ZERO(&cs);
+    sched_getaffinity(0, sizeof(cs), &cs);
+    int count = CPU_COUNT(&cs);
+    return janet_wrap_integer(count);
+#elif defined(JANET_BSD) && defined(HW_NCPUONLINE)
+    (void) dflt;
+    const int name[2] = {CTL_HW, HW_NCPUONLINE};
+    int result = 0;
+    size_t len = sizeof(int);
+    if (-1 == sysctl(name, 2, &result, &len, NULL, 0)) {
+        return dflt;
+    }
+    return janet_wrap_integer(result);
+#elif defined(JANET_BSD) && defined(HW_NCPU)
+    (void) dflt;
+    const int name[2] = {CTL_HW, HW_NCPU};
+    int result = 0;
+    size_t len = sizeof(int);
+    if (-1 == sysctl(name, 2, &result, &len, NULL, 0)) {
+        return dflt;
+    }
+    return janet_wrap_integer(result);
+#else
+    return dflt;
+#endif
+}
+
 #ifndef JANET_REDUCED_OS
 
 #ifndef JANET_NO_PROCESSES
@@ -403,21 +444,19 @@ typedef struct {
 static JanetEVGenericMessage janet_proc_wait_subr(JanetEVGenericMessage args) {
     JanetProc *proc = (JanetProc *) args.argp;
     WaitForSingleObject(proc->pHandle, INFINITE);
-    GetExitCodeProcess(proc->pHandle, &args.argi);
+    GetExitCodeProcess(proc->pHandle, &args.tag);
     return args;
 }
 
 #else /* windows check */
 
-/* Function that is called in separate thread to wait on a pid */
-static JanetEVGenericMessage janet_proc_wait_subr(JanetEVGenericMessage args) {
-    JanetProc *proc = (JanetProc *) args.argp;
-    pid_t result;
+static int proc_get_status(JanetProc *proc) {
+    /* Use POSIX shell semantics for interpreting signals */
     int status = 0;
+    pid_t result;
     do {
         result = waitpid(proc->pid, &status, 0);
     } while (result == -1 && errno == EINTR);
-    /* Use POSIX shell semantics for interpreting signals */
     if (WIFEXITED(status)) {
         status = WEXITSTATUS(status);
     } else if (WIFSTOPPED(status)) {
@@ -425,7 +464,21 @@ static JanetEVGenericMessage janet_proc_wait_subr(JanetEVGenericMessage args) {
     } else {
         status = WTERMSIG(status) + 128;
     }
-    args.argi = status;
+    return status;
+}
+
+/* Function that is called in separate thread to wait on a pid */
+static JanetEVGenericMessage janet_proc_wait_subr(JanetEVGenericMessage args) {
+    JanetProc *proc = (JanetProc *) args.argp;
+#ifdef WNOWAIT
+    pid_t result;
+    int status = 0;
+    do {
+        result = waitpid(proc->pid, &status, WNOWAIT);
+    } while (result == -1 && errno == EINTR);
+#else
+    args.tag = proc_get_status(proc);
+#endif
     return args;
 }
 
@@ -434,9 +487,13 @@ static JanetEVGenericMessage janet_proc_wait_subr(JanetEVGenericMessage args) {
 /* Callback that is called in main thread when subroutine completes. */
 static void janet_proc_wait_cb(JanetEVGenericMessage args) {
     janet_ev_dec_refcount();
-    int status = args.argi;
     JanetProc *proc = (JanetProc *) args.argp;
     if (NULL != proc) {
+#ifdef WNOWAIT
+        int status = proc_get_status(proc);
+#else
+        int status = args.tag;
+#endif
         proc->return_code = (int32_t) status;
         proc->flags |= JANET_PROC_WAITED;
         proc->flags &= ~JANET_PROC_WAITING;
@@ -469,7 +526,9 @@ static int janet_proc_gc(void *p, size_t s) {
         /* Kill and wait to prevent zombies */
         kill(proc->pid, SIGKILL);
         int status;
-        waitpid(proc->pid, &status, 0);
+        if (!(proc->flags & JANET_PROC_WAITING)) {
+            waitpid(proc->pid, &status, 0);
+        }
     }
 #endif
     return 0;
@@ -540,8 +599,8 @@ JANET_CORE_FN(os_proc_wait,
 JANET_CORE_FN(os_proc_kill,
               "(os/proc-kill proc &opt wait)",
               "Kill a subprocess by sending SIGKILL to it on posix systems, or by closing the process "
-              "handle on windows. If wait is truthy, will wait for the process to finsih and "
-              "returns the exit code. Otherwise, returns proc.") {
+              "handle on windows. If `wait` is truthy, will wait for the process to finish and "
+              "returns the exit code. Otherwise, returns `proc`.") {
     janet_arity(argc, 1, 2);
     JanetProc *proc = janet_getabstract(argv, 0, &ProcAT);
     if (proc->flags & JANET_PROC_WAITED) {
@@ -685,6 +744,12 @@ static int janet_proc_get(void *p, Janet key, Janet *out) {
         *out = (NULL == proc->err) ? janet_wrap_nil() : janet_wrap_abstract(proc->err);
         return 1;
     }
+#ifndef JANET_WINDOWS
+    if (janet_keyeq(key, "pid")) {
+        *out = janet_wrap_number(proc->pid);
+        return 1;
+    }
+#endif
     if ((-1 != proc->return_code) && janet_keyeq(key, "return-code")) {
         *out = janet_wrap_integer(proc->return_code);
         return 1;
@@ -820,19 +885,19 @@ static Janet os_execute_impl(int32_t argc, Janet *argv, int is_spawn) {
         Janet maybe_stdin = janet_dictionary_get(tab.kvs, tab.cap, janet_ckeywordv("in"));
         Janet maybe_stdout = janet_dictionary_get(tab.kvs, tab.cap, janet_ckeywordv("out"));
         Janet maybe_stderr = janet_dictionary_get(tab.kvs, tab.cap, janet_ckeywordv("err"));
-        if (janet_keyeq(maybe_stdin, "pipe")) {
+        if (is_spawn && janet_keyeq(maybe_stdin, "pipe")) {
             new_in = make_pipes(&pipe_in, 1, &pipe_errflag);
             pipe_owner_flags |= JANET_PROC_OWNS_STDIN;
         } else if (!janet_checktype(maybe_stdin, JANET_NIL)) {
             new_in = janet_getjstream(&maybe_stdin, 0, &orig_in);
         }
-        if (janet_keyeq(maybe_stdout, "pipe")) {
+        if (is_spawn && janet_keyeq(maybe_stdout, "pipe")) {
             new_out = make_pipes(&pipe_out, 0, &pipe_errflag);
             pipe_owner_flags |= JANET_PROC_OWNS_STDOUT;
         } else if (!janet_checktype(maybe_stdout, JANET_NIL)) {
             new_out = janet_getjstream(&maybe_stdout, 0, &orig_out);
         }
-        if (janet_keyeq(maybe_stderr, "pipe")) {
+        if (is_spawn && janet_keyeq(maybe_stderr, "pipe")) {
             new_err = make_pipes(&pipe_err, 0, &pipe_errflag);
             pipe_owner_flags |= JANET_PROC_OWNS_STDERR;
         } else if (!janet_checktype(maybe_stderr, JANET_NIL)) {
@@ -948,18 +1013,24 @@ static Janet os_execute_impl(int32_t argc, Janet *argv, int is_spawn) {
     posix_spawn_file_actions_init(&actions);
     if (pipe_in != JANET_HANDLE_NONE) {
         posix_spawn_file_actions_adddup2(&actions, pipe_in, 0);
+        posix_spawn_file_actions_addclose(&actions, pipe_in);
     } else if (new_in != JANET_HANDLE_NONE) {
         posix_spawn_file_actions_adddup2(&actions, new_in, 0);
+        posix_spawn_file_actions_addclose(&actions, new_in);
     }
     if (pipe_out != JANET_HANDLE_NONE) {
         posix_spawn_file_actions_adddup2(&actions, pipe_out, 1);
+        posix_spawn_file_actions_addclose(&actions, pipe_out);
     } else if (new_out != JANET_HANDLE_NONE) {
         posix_spawn_file_actions_adddup2(&actions, new_out, 1);
+        posix_spawn_file_actions_addclose(&actions, new_out);
     }
     if (pipe_err != JANET_HANDLE_NONE) {
         posix_spawn_file_actions_adddup2(&actions, pipe_err, 2);
+        posix_spawn_file_actions_addclose(&actions, pipe_err);
     } else if (new_err != JANET_HANDLE_NONE) {
         posix_spawn_file_actions_adddup2(&actions, new_err, 2);
+        posix_spawn_file_actions_addclose(&actions, new_err);
     }
 
     pid_t pid;
@@ -1041,19 +1112,20 @@ JANET_CORE_FN(os_execute,
               "`env` is a table or struct mapping environment variables to values. It can also "
               "contain the keys :in, :out, and :err, which allow redirecting stdio in the subprocess. "
               "These arguments should be core/file values. "
-              "One can also pass in the :pipe keyword "
-              "for these arguments to create files that will read (for :err and :out) or write (for :in) "
-              "to the file descriptor of the subprocess. This is only useful in `os/spawn`, which takes "
-              "the same parameters as `os/execute`, but will return an object that contains references to these "
-              "files via (return-value :in), (return-value :out), and (return-value :err). "
               "Returns the exit status of the program.") {
     return os_execute_impl(argc, argv, 0);
 }
 
 JANET_CORE_FN(os_spawn,
               "(os/spawn args &opt flags env)",
-              "Execute a program on the system and return a handle to the process. Otherwise, the "
-              "same arguments as os/execute. Does not wait for the process.") {
+              "Execute a program on the system and return a handle to the process. Otherwise, takes the "
+              "same arguments as `os/execute`. Does not wait for the process. "
+              "For each of the :in, :out, and :err keys to the `env` argument, one "
+              "can also pass in the keyword `:pipe` "
+              "to get streams for standard IO of the subprocess that can be read from and written to. "
+              "The returned value `proc` has the fields :in, :out, :err, :return-code, and "
+              "the additional field :pid on unix-like platforms. Use `(os/proc-wait proc)` to rejoin the "
+              "subprocess or `(os/proc-kill proc)`.") {
     return os_execute_impl(argc, argv, 1);
 }
 
@@ -1093,7 +1165,7 @@ JANET_CORE_FN(os_shell,
 
 JANET_CORE_FN(os_environ,
               "(os/environ)",
-              "Get a copy of the os environment table.") {
+              "Get a copy of the OS environment table.") {
     (void) argv;
     janet_fixarity(argc, 0);
     int32_t nenv = 0;
@@ -1174,7 +1246,7 @@ JANET_CORE_FN(os_time,
 JANET_CORE_FN(os_clock,
               "(os/clock)",
               "Return the number of whole + fractional seconds since some fixed point in time. The clock "
-              "is guaranteed to be non decreasing in real time.") {
+              "is guaranteed to be non-decreasing in real time.") {
     janet_fixarity(argc, 0);
     (void) argv;
     struct timespec tv;
@@ -1185,7 +1257,7 @@ JANET_CORE_FN(os_clock,
 
 JANET_CORE_FN(os_sleep,
               "(os/sleep n)",
-              "Suspend the program for n seconds. 'nsec' can be a real number. Returns "
+              "Suspend the program for `n` seconds. `n` can be a real number. Returns "
               "nil.") {
     janet_fixarity(argc, 1);
     double delay = janet_getnumber(argv, 0);
@@ -1222,7 +1294,7 @@ JANET_CORE_FN(os_cwd,
 
 JANET_CORE_FN(os_cryptorand,
               "(os/cryptorand n &opt buf)",
-              "Get or append n bytes of good quality random data provided by the OS. Returns a new buffer or buf.") {
+              "Get or append `n` bytes of good quality random data provided by the OS. Returns a new buffer or `buf`.") {
     JanetBuffer *buffer;
     janet_arity(argc, 1, 2);
     int32_t offset;
@@ -1273,6 +1345,7 @@ JANET_CORE_FN(os_date,
     if (argc >= 2 && janet_truthy(argv[1])) {
         /* local time */
 #ifdef JANET_WINDOWS
+        _tzset();
         localtime_s(&t_infos, &t);
         t_info = &t_infos;
 #else
@@ -1359,9 +1432,9 @@ static timeint_t entry_getint(Janet env_entry, char *field) {
 JANET_CORE_FN(os_mktime,
               "(os/mktime date-struct &opt local)",
               "Get the broken down date-struct time expressed as the number "
-              " of seconds since January 1, 1970, the Unix epoch. "
+              "of seconds since January 1, 1970, the Unix epoch. "
               "Returns a real number. "
-              "Date is given in UTC unless local is truthy, in which case the "
+              "Date is given in UTC unless `local` is truthy, in which case the "
               "date is computed for the local timezone.\n\n"
               "Inverse function to os/date.") {
     janet_arity(argc, 1, 2);
@@ -1432,7 +1505,7 @@ JANET_CORE_FN(os_link,
 
 JANET_CORE_FN(os_symlink,
               "(os/symlink oldpath newpath)",
-              "Create a symlink from oldpath to newpath, returning nil. Same as (os/link oldpath newpath true).") {
+              "Create a symlink from oldpath to newpath, returning nil. Same as `(os/link oldpath newpath true)`.") {
     janet_fixarity(argc, 2);
 #ifdef JANET_WINDOWS
     (void) argc;
@@ -1807,10 +1880,10 @@ JANET_CORE_FN(os_stat,
               "* :uid - File uid\n\n"
               "* :gid - File gid\n\n"
               "* :nlink - number of links to file\n\n"
-              "* :rdev - Real device of file. 0 on windows.\n\n"
+              "* :rdev - Real device of file. 0 on Windows\n\n"
               "* :size - size of file in bytes\n\n"
-              "* :blocks - number of blocks in file. 0 on windows\n\n"
-              "* :blocksize - size of blocks in file. 0 on windows\n\n"
+              "* :blocks - number of blocks in file. 0 on Windows\n\n"
+              "* :blocksize - size of blocks in file. 0 on Windows\n\n"
               "* :accessed - timestamp when file last accessed\n\n"
               "* :changed - timestamp when file last changed (permissions changed)\n\n"
               "* :modified - timestamp when file last modified (content changed)\n") {
@@ -1825,9 +1898,9 @@ JANET_CORE_FN(os_lstat,
 
 JANET_CORE_FN(os_chmod,
               "(os/chmod path mode)",
-              "Change file permissions, where mode is a permission string as returned by "
-              "os/perm-string, or an integer as returned by os/perm-int. "
-              "When mode is an integer, it is interpreted as a Unix permission value, best specified in octal, like "
+              "Change file permissions, where `mode` is a permission string as returned by "
+              "`os/perm-string`, or an integer as returned by `os/perm-int`. "
+              "When `mode` is an integer, it is interpreted as a Unix permission value, best specified in octal, like "
               "8r666 or 8r400. Windows will not differentiate between user, group, and other permissions, and thus will combine all of these permissions. Returns nil.") {
     janet_fixarity(argc, 2);
     const char *path = janet_getcstring(argv, 0);
@@ -1929,9 +2002,9 @@ JANET_CORE_FN(os_realpath,
 
 JANET_CORE_FN(os_permission_string,
               "(os/perm-string int)",
-              "Convert a Unix octal permission value from a permission integer as returned by os/stat "
+              "Convert a Unix octal permission value from a permission integer as returned by `os/stat` "
               "to a human readable string, that follows the formatting "
-              "of unix tools like ls. Returns the string as a 9 character string of r, w, x and - characters. Does not "
+              "of Unix tools like `ls`. Returns the string as a 9-character string of r, w, x and - characters. Does not "
               "include the file/directory/symlink character as rendered by `ls`.") {
     janet_fixarity(argc, 1);
     return os_make_permstring(os_get_unix_mode(argv, 0));
@@ -1939,7 +2012,7 @@ JANET_CORE_FN(os_permission_string,
 
 JANET_CORE_FN(os_permission_int,
               "(os/perm-int bytes)",
-              "Parse a 9 character permission string and return an integer that can be used by chmod.") {
+              "Parse a 9-character permission string and return an integer that can be used by chmod.") {
     janet_fixarity(argc, 1);
     return janet_wrap_integer(os_get_unix_mode(argv, 0));
 }
@@ -1958,28 +2031,28 @@ static jmode_t os_optmode(int32_t argc, const Janet *argv, int32_t n, int32_t df
 JANET_CORE_FN(os_open,
               "(os/open path &opt flags mode)",
               "Create a stream from a file, like the POSIX open system call. Returns a new stream. "
-              "mode should be a file mode as passed to os/chmod, but only if the create flag is given. "
+              "`mode` should be a file mode as passed to `os/chmod`, but only if the create flag is given. "
               "The default mode is 8r666. "
               "Allowed flags are as follows:\n\n"
               "  * :r - open this file for reading\n"
               "  * :w - open this file for writing\n"
-              "  * :c - create a new file (O_CREATE)\n"
-              "  * :e - fail if the file exists (O_EXCL)\n"
-              "  * :t - shorten an existing file to length 0 (O_TRUNC)\n\n"
-              "Posix only flags:\n\n"
-              "  * :a - append to a file (O_APPEND)\n"
-              "  * :x - O_SYNC\n"
-              "  * :C - O_NOCTTY\n\n"
-              "Windows only flags:\n\n"
-              "  * :R - share reads (FILE_SHARE_READ)\n"
-              "  * :W - share writes (FILE_SHARE_WRITE)\n"
-              "  * :D - share deletes (FILE_SHARE_DELETE)\n"
-              "  * :H - FILE_ATTRIBUTE_HIDDEN\n"
-              "  * :O - FILE_ATTRIBUTE_READONLY\n"
-              "  * :F - FILE_ATTRIBUTE_OFFLINE\n"
-              "  * :T - FILE_ATTRIBUTE_TEMPORARY\n"
-              "  * :d - FILE_FLAG_DELETE_ON_CLOSE\n"
-              "  * :b - FILE_FLAG_NO_BUFFERING\n") {
+              "  * :c - create a new file (O\\_CREATE)\n"
+              "  * :e - fail if the file exists (O\\_EXCL)\n"
+              "  * :t - shorten an existing file to length 0 (O\\_TRUNC)\n\n"
+              "Posix-only flags:\n\n"
+              "  * :a - append to a file (O\\_APPEND)\n"
+              "  * :x - O\\_SYNC\n"
+              "  * :C - O\\_NOCTTY\n\n"
+              "Windows-only flags:\n\n"
+              "  * :R - share reads (FILE\\_SHARE\\_READ)\n"
+              "  * :W - share writes (FILE\\_SHARE\\_WRITE)\n"
+              "  * :D - share deletes (FILE\\_SHARE\\_DELETE)\n"
+              "  * :H - FILE\\_ATTRIBUTE\\_HIDDEN\n"
+              "  * :O - FILE\\_ATTRIBUTE\\_READONLY\n"
+              "  * :F - FILE\\_ATTRIBUTE\\_OFFLINE\n"
+              "  * :T - FILE\\_ATTRIBUTE\\_TEMPORARY\n"
+              "  * :d - FILE\\_FLAG\\_DELETE\\_ON\\_CLOSE\n"
+              "  * :b - FILE\\_FLAG\\_NO\\_BUFFERING\n") {
     janet_arity(argc, 1, 3);
     const char *path = janet_getcstring(argv, 0);
     const uint8_t *opt_flags = janet_optkeyword(argv, argc, 1, (const uint8_t *) "r");
@@ -2123,7 +2196,7 @@ JANET_CORE_FN(os_open,
 
 JANET_CORE_FN(os_pipe,
               "(os/pipe)",
-              "Create a readable stream and a writable stream that are connected. Returns a two element "
+              "Create a readable stream and a writable stream that are connected. Returns a two-element "
               "tuple where the first element is a readable stream and the second element is the writable "
               "stream.") {
     (void) argv;
@@ -2172,6 +2245,7 @@ void janet_lib_os(JanetTable *env) {
         JANET_CORE_REG("os/chmod", os_chmod),
         JANET_CORE_REG("os/touch", os_touch),
         JANET_CORE_REG("os/cd", os_cd),
+        JANET_CORE_REG("os/cpu-count", os_cpu_count),
 #ifndef JANET_NO_UMASK
         JANET_CORE_REG("os/umask", os_umask),
 #endif

src/core/parse.c

@@ -1,5 +1,5 @@
 /*
-* Copyright (c) 2021 Calvin Rose
+* Copyright (c) 2022 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) {
@@ -411,7 +411,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 +422,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 +442,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 +582,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;
             }
@@ -746,6 +746,7 @@ Janet janet_parser_produce(JanetParser *parser) {
     }
     parser->pending--;
     parser->argcount--;
+    parser->states[0].argn--;
     return ret;
 }
 
@@ -759,6 +760,7 @@ Janet janet_parser_produce_wrapped(JanetParser *parser) {
     }
     parser->pending--;
     parser->argcount--;
+    parser->states[0].argn--;
     return ret;
 }
 
@@ -881,7 +883,7 @@ const JanetAbstractType janet_parser_type = {
 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.") {
+              "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));
@@ -892,7 +894,7 @@ JANET_CORE_FN(cfun_parse_parser,
 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 "
+              "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);
@@ -920,7 +922,7 @@ JANET_CORE_FN(cfun_parse_consume,
 
 JANET_CORE_FN(cfun_parse_eof,
               "(parser/eof parser)",
-              "Indicate that the end of file was reached to the parser. This puts the parser in the :dead state.") {
+              "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);
@@ -980,7 +982,7 @@ JANET_CORE_FN(cfun_parse_has_more,
 
 JANET_CORE_FN(cfun_parse_byte,
               "(parser/byte parser b)",
-              "Input a single byte into the parser byte stream. Returns the parser.") {
+              "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);
@@ -1020,7 +1022,7 @@ JANET_CORE_FN(cfun_parse_error,
               "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/error`.") {
     janet_fixarity(argc, 1);
     JanetParser *p = janet_getabstract(argv, 0, &janet_parser_type);
     const char *err = janet_parser_error(p);
@@ -1093,8 +1095,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));
     }
@@ -1189,11 +1192,14 @@ static Janet parser_state_frames(const JanetParser *p) {
     JanetArray *states = janet_array(count);
     states->count = count;
     uint8_t *buf = p->buf;
-    Janet *args = p->args;
+    /* Iterate arg stack backwards */
+    Janet *args = p->args + p->argcount;
     for (int32_t i = count - 1; i >= 0; --i) {
         JanetParseState *s = p->states + i;
+        if (s->flags & PFLAG_CONTAINER) {
+            args -= s->argn;
+        }
         states->data[i] = janet_wrap_parse_state(s, args, buf, (uint32_t) p->bufcount);
-        args -= s->argn;
     }
     return janet_wrap_array(states);
 }

src/core/peg.c

@@ -1,5 +1,5 @@
 /*
-* Copyright (c) 2021 Calvin Rose
+* Copyright (c) 2022 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
@@ -293,6 +293,7 @@ tail:
                     if (rule[0] == RULE_TO) cap_load(s, cs2);
                     break;
                 }
+                cap_load(s, cs2);
                 text++;
             }
             up1(s);
@@ -387,6 +388,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 +995,25 @@ static void spec_unref(Builder *b, int32_t argc, const Janet *argv) {
     spec_cap1(b, argc, argv, RULE_UNREF);
 }
 
+static void spec_capture_number(Builder *b, int32_t argc, const Janet *argv) {
+    peg_arity(b, argc, 1, 3);
+    Reserve r = reserve(b, 4);
+    uint32_t base = 0;
+    if (argc >= 2) {
+        if (!janet_checktype(argv[1], JANET_NIL)) {
+            if (!janet_checkint(argv[1])) goto error;
+            base = (uint32_t) janet_unwrap_integer(argv[1]);
+            if (base < 2 || base > 36) goto error;
+        }
+    }
+    uint32_t tag = (argc == 3) ? emit_tag(b, argv[2]) : 0;
+    uint32_t rule = peg_compile1(b, argv[0]);
+    emit_3(r, RULE_CAPTURE_NUM, rule, base, tag);
+    return;
+error:
+    peg_panicf(b, "expected integer between 2 and 36, got %v", argv[2]);
+}
+
 static void spec_reference(Builder *b, int32_t argc, const Janet *argv) {
     peg_arity(b, argc, 1, 2);
     Reserve r = reserve(b, 3);
@@ -1118,6 +1157,7 @@ static const SpecialPair peg_specials[] = {
     {"line", spec_line},
     {"look", spec_look},
     {"not", spec_not},
+    {"number", spec_capture_number},
     {"opt", spec_opt},
     {"position", spec_position},
     {"quote", spec_capture},
@@ -1214,6 +1254,18 @@ static uint32_t peg_compile1(Builder *b, Janet peg) {
             emit_bytes(b, RULE_LITERAL, len, str);
             break;
         }
+        case JANET_TABLE: {
+            /* Build grammar table */
+            JanetTable *new_grammar = janet_table_clone(janet_unwrap_table(peg));
+            new_grammar->proto = grammar;
+            b->grammar = grammar = new_grammar;
+            /* Run the main rule */
+            Janet main_rule = janet_table_rawget(grammar, janet_ckeywordv("main"));
+            if (janet_checktype(main_rule, JANET_NIL))
+                peg_panic(b, "grammar requires :main rule");
+            rule = peg_compile1(b, main_rule);
+            break;
+        }
         case JANET_STRUCT: {
             /* Build grammar table */
             const JanetKV *st = janet_unwrap_struct(peg);
@@ -1419,6 +1471,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:

src/core/pp.c

@@ -1,5 +1,5 @@
 /*
-* Copyright (c) 2021 Calvin Rose
+* Copyright (c) 2022 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
@@ -261,21 +261,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;
 }
@@ -570,12 +562,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;
@@ -590,8 +582,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;
@@ -753,8 +762,7 @@ static const char *scanformat(
     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)))
@@ -974,8 +982,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 {

src/core/regalloc.c

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

src/core/regalloc.h

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

src/core/run.c

@@ -1,5 +1,5 @@
 /*
-* Copyright (c) 2021 Calvin Rose
+* Copyright (c) 2022 Calvin Rose
 *
 * Permission is hereby granted, free of charge, to any person obtaining a copy
 * of this software and associated documentation files (the "Software"), to
@@ -23,6 +23,7 @@
 #ifndef JANET_AMALG
 #include "features.h"
 #include <janet.h>
+#include "state.h"
 #endif
 
 /* Run a string */
@@ -50,7 +51,7 @@ int janet_dobytes(JanetTable *env, const uint8_t *bytes, int32_t len, const char
                 fiber->env = env;
                 JanetSignal status = janet_continue(fiber, janet_wrap_nil(), &ret);
                 if (status != JANET_SIGNAL_OK && status != JANET_SIGNAL_EVENT) {
-                    janet_stacktrace(fiber, ret);
+                    janet_stacktrace_ext(fiber, ret, "");
                     errflags |= 0x01;
                     done = 1;
                 }
@@ -58,7 +59,7 @@ int janet_dobytes(JanetTable *env, const uint8_t *bytes, int32_t len, const char
                 ret = janet_wrap_string(cres.error);
                 if (cres.macrofiber) {
                     janet_eprintf("compile error in %s: ", sourcePath);
-                    janet_stacktrace(cres.macrofiber, ret);
+                    janet_stacktrace_ext(cres.macrofiber, ret, "");
                 } else {
                     janet_eprintf("compile error in %s: %s\n", sourcePath,
                                   (const char *)cres.error);
@@ -79,7 +80,9 @@ int janet_dobytes(JanetTable *env, const uint8_t *bytes, int32_t len, const char
                 const char *e = janet_parser_error(&parser);
                 errflags |= 0x04;
                 ret = janet_cstringv(e);
-                janet_eprintf("parse error in %s: %s\n", sourcePath, e);
+                size_t line = parser.line;
+                size_t col = parser.column;
+                janet_eprintf("%s:%lu:%lu: parse error: %s\n", sourcePath, line, col, e);
                 done = 1;
                 break;
             }
@@ -98,6 +101,14 @@ int janet_dobytes(JanetTable *env, const uint8_t *bytes, int32_t len, const char
     /* Clean up and return errors */
     janet_parser_deinit(&parser);
     if (where) janet_gcunroot(janet_wrap_string(where));
+#ifdef JANET_EV
+    /* Enter the event loop if we are not already in it */
+    if (janet_vm.stackn == 0) {
+        janet_gcroot(ret);
+        janet_loop();
+        janet_gcunroot(ret);
+    }
+#endif
     if (out) *out = ret;
     return errflags;
 }
@@ -119,7 +130,7 @@ int janet_loop_fiber(JanetFiber *fiber) {
     Janet out;
     status = janet_continue(fiber, janet_wrap_nil(), &out);
     if (status != JANET_SIGNAL_OK && status != JANET_SIGNAL_EVENT) {
-        janet_stacktrace(fiber, out);
+        janet_stacktrace_ext(fiber, out, "");
     }
 #endif
     return status;

src/core/specials.c

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

src/core/state.c

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

src/core/state.h

@@ -1,5 +1,5 @@
 /*
-* Copyright (c) 2021 Calvin Rose
+* Copyright (c) 2022 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
@@ -54,14 +54,6 @@ typedef struct {
     int is_error;
 } JanetTimeout;
 
-#ifdef JANET_THREADS
-typedef struct {
-    JanetMailbox *original;
-    JanetMailbox *newbox;
-    uint64_t flags;
-} JanetMailboxPair;
-#endif
-
 /* Registry table for C functions - containts metadata that can
  * be looked up by cfunction pointer. All strings here are pointing to
  * static memory not managed by Janet. */
@@ -145,13 +137,6 @@ struct JanetVM {
     JanetTraversalNode *traversal_top;
     JanetTraversalNode *traversal_base;
 
-    /* Threading */
-#ifdef JANET_THREADS
-    JanetMailbox *mailbox;
-    JanetThread *thread_current;
-    JanetTable *thread_decode;
-#endif
-
     /* Event loop and scheduler globals */
 #ifdef JANET_EV
     size_t tq_count;
@@ -186,12 +171,6 @@ struct JanetVM {
 
 extern JANET_THREAD_LOCAL JanetVM janet_vm;
 
-/* Setup / teardown */
-#ifdef JANET_THREADS
-void janet_threads_init(void);
-void janet_threads_deinit(void);
-#endif
-
 #ifdef JANET_NET
 void janet_net_init(void);
 void janet_net_deinit(void);

src/core/string.c

@@ -1,5 +1,5 @@
 /*
-* Copyright (c) 2021 Calvin Rose
+* Copyright (c) 2022 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
@@ -173,10 +173,10 @@ static int32_t kmp_next(struct kmp_state *state) {
 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 "
+              "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. ") {
+              "index `(length bytes)` to allow a full negative slice range. ") {
     JanetByteView view = janet_getbytes(argv, 0);
     JanetRange range = janet_getslice(argc, argv);
     return janet_stringv(view.bytes + range.start, range.end - range.start);
@@ -184,7 +184,7 @@ JANET_CORE_FN(cfun_string_slice,
 
 JANET_CORE_FN(cfun_symbol_slice,
               "(symbol/slice bytes &opt start end)",
-              "Same a string/slice, but returns a symbol.") {
+              "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);
@@ -192,7 +192,7 @@ JANET_CORE_FN(cfun_symbol_slice,
 
 JANET_CORE_FN(cfun_keyword_slice,
               "(keyword/slice bytes &opt start end)",
-              "Same a string/slice, but returns a keyword.") {
+              "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);
@@ -200,7 +200,7 @@ JANET_CORE_FN(cfun_keyword_slice,
 
 JANET_CORE_FN(cfun_string_repeat,
               "(string/repeat bytes n)",
-              "Returns a string that is n copies of bytes concatenated.") {
+              "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);
@@ -218,7 +218,7 @@ JANET_CORE_FN(cfun_string_repeat,
 
 JANET_CORE_FN(cfun_string_bytes,
               "(string/bytes str)",
-              "Returns an array of integers that are the byte values of the string.") {
+              "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);
@@ -282,7 +282,7 @@ JANET_CORE_FN(cfun_string_asciiupper,
 
 JANET_CORE_FN(cfun_string_reverse,
               "(string/reverse str)",
-              "Returns a string that is the reversed version of 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);
@@ -308,8 +308,8 @@ static void findsetup(int32_t argc, Janet *argv, struct kmp_state *s, int32_t ex
 
 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, "
+              "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;
@@ -323,7 +323,7 @@ JANET_CORE_FN(cfun_string_find,
 
 JANET_CORE_FN(cfun_string_hasprefix,
               "(string/has-prefix? pfx str)",
-              "Tests whether str starts with pfx.") {
+              "Tests whether `str` starts with `pfx`.") {
     janet_fixarity(argc, 2);
     JanetByteView prefix = janet_getbytes(argv, 0);
     JanetByteView str = janet_getbytes(argv, 1);
@@ -334,7 +334,7 @@ JANET_CORE_FN(cfun_string_hasprefix,
 
 JANET_CORE_FN(cfun_string_hassuffix,
               "(string/has-suffix? sfx str)",
-              "Tests whether str ends with sfx.") {
+              "Tests whether `str` ends with `sfx`.") {
     janet_fixarity(argc, 2);
     JanetByteView suffix = janet_getbytes(argv, 0);
     JanetByteView str = janet_getbytes(argv, 1);
@@ -347,9 +347,9 @@ JANET_CORE_FN(cfun_string_hassuffix,
 
 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 "
+              "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;
@@ -386,8 +386,8 @@ static void replacesetup(int32_t argc, Janet *argv, struct replace_state *s) {
 
 JANET_CORE_FN(cfun_string_replace,
               "(string/replace patt subst str)",
-              "Replace the first occurrence of patt with subst in the string str. "
-              "Will return the new string if patt is found, otherwise returns str.") {
+              "Replace the first occurrence of `patt` with `subst` in the string `str`. "
+              "Will return the new string if `patt` is found, otherwise returns `str`.") {
     int32_t result;
     struct replace_state s;
     uint8_t *buf;
@@ -409,9 +409,9 @@ JANET_CORE_FN(cfun_string_replace,
 
 JANET_CORE_FN(cfun_string_replaceall,
               "(string/replace-all patt subst str)",
-              "Replace all instances of patt with subst in the string str. Overlapping "
+              "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.") {
+              "Will return the new string if `patt` is found, otherwise returns `str`.") {
     int32_t result;
     struct replace_state s;
     JanetBuffer b;
@@ -433,11 +433,11 @@ JANET_CORE_FN(cfun_string_replaceall,
 
 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 "
+              "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).") {
+              "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;
@@ -461,9 +461,9 @@ JANET_CORE_FN(cfun_string_split,
 
 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.") {
+              "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);
@@ -488,7 +488,7 @@ JANET_CORE_FN(cfun_string_checkset,
 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.") {
+              "a separator string `sep`.") {
     janet_arity(argc, 1, 2);
     JanetView parts = janet_getindexed(argv, 0);
     JanetByteView joiner;
@@ -530,7 +530,7 @@ JANET_CORE_FN(cfun_string_join,
 
 JANET_CORE_FN(cfun_string_format,
               "(string/format format & values)",
-              "Similar to snprintf, but specialized for operating with Janet values. Returns "
+              "Similar to C's `snprintf`, but specialized for operating with Janet values. Returns "
               "a new string.") {
     janet_arity(argc, 1, -1);
     JanetBuffer *buffer = janet_buffer(0);
@@ -574,7 +574,7 @@ static void trim_help_args(int32_t argc, Janet *argv, JanetByteView *str, JanetB
 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.") {
+              "`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);
@@ -587,7 +587,7 @@ JANET_CORE_FN(cfun_string_trim,
 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.") {
+              "`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);
@@ -597,7 +597,7 @@ JANET_CORE_FN(cfun_string_triml,
 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.") {
+              "`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);

src/core/strtod.c

@@ -1,5 +1,5 @@
 /*
-* Copyright (c) 2021 Calvin Rose
+* Copyright (c) 2022 Calvin Rose
 *
 * Permission is hereby granted, free of charge, to any person obtaining a copy
 * of this software and associated documentation files (the "Software"), to
@@ -246,15 +246,15 @@ static double convert(
 }
 
 /* Scan a real (double) from a string. If the string cannot be converted into
- * and integer, set *err to 1 and return 0. */
-int janet_scan_number(
+ * and integer, return 0. */
+int janet_scan_number_base(
     const uint8_t *str,
     int32_t len,
+    int32_t base,
     double *out) {
     const uint8_t *end = str + len;
     int seenadigit = 0;
     int ex = 0;
-    int base = 10;
     int seenpoint = 0;
     int foundexp = 0;
     int neg = 0;
@@ -278,21 +278,28 @@ int janet_scan_number(
     }
 
     /* Check for leading 0x or digit digit r */
-    if (str + 1 < end && str[0] == '0' && str[1] == 'x') {
-        base = 16;
-        str += 2;
-    } else if (str + 1 < end  &&
-               str[0] >= '0' && str[0] <= '9' &&
-               str[1] == 'r') {
-        base = str[0] - '0';
-        str += 2;
-    } else if (str + 2 < end  &&
-               str[0] >= '0' && str[0] <= '9' &&
-               str[1] >= '0' && str[1] <= '9' &&
-               str[2] == 'r') {
-        base = 10 * (str[0] - '0') + (str[1] - '0');
-        if (base < 2 || base > 36) goto error;
-        str += 3;
+    if (base == 0) {
+        if (str + 1 < end && str[0] == '0' && str[1] == 'x') {
+            base = 16;
+            str += 2;
+        } else if (str + 1 < end  &&
+                   str[0] >= '0' && str[0] <= '9' &&
+                   str[1] == 'r') {
+            base = str[0] - '0';
+            str += 2;
+        } else if (str + 2 < end  &&
+                   str[0] >= '0' && str[0] <= '9' &&
+                   str[1] >= '0' && str[1] <= '9' &&
+                   str[2] == 'r') {
+            base = 10 * (str[0] - '0') + (str[1] - '0');
+            if (base < 2 || base > 36) goto error;
+            str += 3;
+        }
+    }
+
+    /* If still base is 0, set to default (10) */
+    if (base == 0) {
+        base = 10;
     }
 
     /* Skip leading zeros */
@@ -376,6 +383,13 @@ error:
     return 1;
 }
 
+int janet_scan_number(
+    const uint8_t *str,
+    int32_t len,
+    double *out) {
+    return janet_scan_number_base(str, len, 0, out);
+}
+
 #ifdef JANET_INT_TYPES
 
 static int scan_uint64(

src/core/struct.c

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

src/core/symcache.c

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

src/core/symcache.h

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

src/core/table.c

@@ -1,5 +1,5 @@
 /*
-* Copyright (c) 2021 Calvin Rose
+* Copyright (c) 2022 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
@@ -132,37 +132,21 @@ static void janet_table_rehash(JanetTable *t, int32_t size) {
 
 /* Get a value out of the table */
 Janet janet_table_get(JanetTable *t, Janet key) {
-    JanetKV *bucket = janet_table_find(t, key);
-    if (NULL != bucket && !janet_checktype(bucket->key, JANET_NIL))
-        return bucket->value;
-    /* Check prototypes */
-    {
-        int i;
-        for (i = JANET_MAX_PROTO_DEPTH, t = t->proto; t && i; t = t->proto, --i) {
-            bucket = janet_table_find(t, key);
-            if (NULL != bucket && !janet_checktype(bucket->key, JANET_NIL))
-                return bucket->value;
-        }
+    for (int i = JANET_MAX_PROTO_DEPTH; t && i; t = t->proto, --i) {
+        JanetKV *bucket = janet_table_find(t, key);
+        if (NULL != bucket && !janet_checktype(bucket->key, JANET_NIL))
+            return bucket->value;
     }
     return janet_wrap_nil();
 }
 
 /* Get a value out of the table, and record which prototype it was from. */
 Janet janet_table_get_ex(JanetTable *t, Janet key, JanetTable **which) {
-    JanetKV *bucket = janet_table_find(t, key);
-    if (NULL != bucket && !janet_checktype(bucket->key, JANET_NIL)) {
-        *which = t;
-        return bucket->value;
-    }
-    /* Check prototypes */
-    {
-        int i;
-        for (i = JANET_MAX_PROTO_DEPTH, t = t->proto; t && i; t = t->proto, --i) {
-            bucket = janet_table_find(t, key);
-            if (NULL != bucket && !janet_checktype(bucket->key, JANET_NIL)) {
-                *which = t;
-                return bucket->value;
-            }
+    for (int i = JANET_MAX_PROTO_DEPTH; t && i; t = t->proto, --i) {
+        JanetKV *bucket = janet_table_find(t, key);
+        if (NULL != bucket && !janet_checktype(bucket->key, JANET_NIL)) {
+            *which = t;
+            return bucket->value;
         }
     }
     return janet_wrap_nil();
@@ -217,6 +201,23 @@ void janet_table_put(JanetTable *t, Janet key, Janet value) {
     }
 }
 
+/* Used internally so don't check arguments
+ * Put into a table, but if the key already exists do nothing. */
+static void janet_table_put_no_overwrite(JanetTable *t, Janet key, Janet value) {
+    JanetKV *bucket = janet_table_find(t, key);
+    if (NULL != bucket && !janet_checktype(bucket->key, JANET_NIL))
+        return;
+    if (NULL == bucket || 2 * (t->count + t->deleted + 1) > t->capacity) {
+        janet_table_rehash(t, janet_tablen(2 * t->count + 2));
+    }
+    bucket = janet_table_find(t, key);
+    if (janet_checktype(bucket->value, JANET_BOOLEAN))
+        --t->deleted;
+    bucket->key = key;
+    bucket->value = value;
+    ++t->count;
+}
+
 /* Clear a table */
 void janet_table_clear(JanetTable *t) {
     int32_t capacity = t->capacity;
@@ -226,19 +227,6 @@ void janet_table_clear(JanetTable *t) {
     t->deleted = 0;
 }
 
-/* Convert table to struct */
-const JanetKV *janet_table_to_struct(JanetTable *t) {
-    JanetKV *st = janet_struct_begin(t->count);
-    JanetKV *kv = t->data;
-    JanetKV *end = t->data + t->capacity;
-    while (kv < end) {
-        if (!janet_checktype(kv->key, JANET_NIL))
-            janet_struct_put(st, kv->key, kv->value);
-        kv++;
-    }
-    return janet_struct_end(st);
-}
-
 /* Clone a table. */
 JanetTable *janet_table_clone(JanetTable *table) {
     JanetTable *newTable = janet_gcalloc(JANET_MEMORY_TABLE, sizeof(JanetTable));
@@ -275,22 +263,50 @@ 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 */
 
 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 to go in a table on creation, extra memory allocation "
+              "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));
 }
 
 JANET_CORE_FN(cfun_table_getproto,
               "(table/getproto tab)",
-              "Get the prototype table of a table. Returns nil if a table "
+              "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);
@@ -301,7 +317,7 @@ JANET_CORE_FN(cfun_table_getproto,
 
 JANET_CORE_FN(cfun_table_setproto,
               "(table/setproto tab proto)",
-              "Set the prototype of a table. Returns the original table tab.") {
+              "Set the prototype of a table. Returns the original table `tab`.") {
     janet_fixarity(argc, 2);
     JanetTable *table = janet_gettable(argv, 0);
     JanetTable *proto = NULL;
@@ -323,8 +339,8 @@ JANET_CORE_FN(cfun_table_tostruct,
 
 JANET_CORE_FN(cfun_table_rawget,
               "(table/rawget tab key)",
-              "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 "
+              "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);
@@ -349,6 +365,14 @@ JANET_CORE_FN(cfun_table_clear,
     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) {
     JanetRegExt table_cfuns[] = {
@@ -359,6 +383,7 @@ void janet_lib_table(JanetTable *env) {
         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,739 +0,0 @@
-/*
-* Copyright (c) 2021 Calvin Rose
-*
-* Permission is hereby granted, free of charge, to any person obtaining a copy
-* of this software and associated documentation files (the "Software"), to
-* deal in the Software without restriction, including without limitation the
-* rights to use, copy, modify, merge, publish, distribute, sublicense, and/or
-* sell copies of the Software, and to permit persons to whom the Software is
-* furnished to do so, subject to the following conditions:
-*
-* The above copyright notice and this permission notice shall be included in
-* all copies or substantial portions of the Software.
-*
-* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
-* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
-* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
-* AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
-* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
-* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS
-* IN THE SOFTWARE.
-*/
-
-#ifndef JANET_AMALG
-#include "features.h"
-#include <janet.h>
-#include "gc.h"
-#include "util.h"
-#include "state.h"
-#endif
-
-#ifdef JANET_THREADS
-
-#include <math.h>
-#ifdef JANET_WINDOWS
-#include <windows.h>
-#else
-#include <setjmp.h>
-#include <time.h>
-#include <pthread.h>
-#endif
-
-/* typedefed in janet.h */
-struct JanetMailbox {
-
-    /* Synchronization */
-#ifdef JANET_WINDOWS
-    CRITICAL_SECTION lock;
-    CONDITION_VARIABLE cond;
-#else
-    pthread_mutex_t lock;
-    pthread_cond_t cond;
-#endif
-
-    /* Memory management - reference counting */
-    int refCount;
-    int closed;
-
-    /* Store messages */
-    uint16_t messageCapacity;
-    uint16_t messageCount;
-    uint16_t messageFirst;
-    uint16_t messageNext;
-
-    /* Buffers to store messages. These buffers are manually allocated, so
-     * are not owned by any thread's GC. */
-    JanetBuffer messages[];
-};
-
-#define JANET_THREAD_HEAVYWEIGHT 0x1
-#define JANET_THREAD_ABSTRACTS 0x2
-#define JANET_THREAD_CFUNCTIONS 0x4
-static const char janet_thread_flags[] = "hac";
-
-static JanetTable *janet_thread_get_decode(void) {
-    if (janet_vm.thread_decode == NULL) {
-        janet_vm.thread_decode = janet_get_core_table("load-image-dict");
-        if (NULL == janet_vm.thread_decode) {
-            janet_vm.thread_decode = janet_table(0);
-        }
-        janet_gcroot(janet_wrap_table(janet_vm.thread_decode));
-    }
-    return janet_vm.thread_decode;
-}
-
-static JanetMailbox *janet_mailbox_create(int refCount, uint16_t capacity) {
-    JanetMailbox *mailbox = janet_malloc(sizeof(JanetMailbox) + sizeof(JanetBuffer) * (size_t) capacity);
-    if (NULL == mailbox) {
-        JANET_OUT_OF_MEMORY;
-    }
-#ifdef JANET_WINDOWS
-    InitializeCriticalSection(&mailbox->lock);
-    InitializeConditionVariable(&mailbox->cond);
-#else
-    pthread_mutex_init(&mailbox->lock, NULL);
-    pthread_cond_init(&mailbox->cond, NULL);
-#endif
-    mailbox->refCount = refCount;
-    mailbox->closed = 0;
-    mailbox->messageCount = 0;
-    mailbox->messageCapacity = capacity;
-    mailbox->messageFirst = 0;
-    mailbox->messageNext = 0;
-    for (uint16_t i = 0; i < capacity; i++) {
-        janet_buffer_init(mailbox->messages + i, 0);
-    }
-    return mailbox;
-}
-
-static void janet_mailbox_destroy(JanetMailbox *mailbox) {
-#ifdef JANET_WINDOWS
-    DeleteCriticalSection(&mailbox->lock);
-#else
-    pthread_mutex_destroy(&mailbox->lock);
-    pthread_cond_destroy(&mailbox->cond);
-#endif
-    for (uint16_t i = 0; i < mailbox->messageCapacity; i++) {
-        janet_buffer_deinit(mailbox->messages + i);
-    }
-    janet_free(mailbox);
-}
-
-static void janet_mailbox_lock(JanetMailbox *mailbox) {
-#ifdef JANET_WINDOWS
-    EnterCriticalSection(&mailbox->lock);
-#else
-    pthread_mutex_lock(&mailbox->lock);
-#endif
-}
-
-static void janet_mailbox_unlock(JanetMailbox *mailbox) {
-#ifdef JANET_WINDOWS
-    LeaveCriticalSection(&mailbox->lock);
-#else
-    pthread_mutex_unlock(&mailbox->lock);
-#endif
-}
-
-/* Assumes you have the mailbox lock already */
-static void janet_mailbox_ref_with_lock(JanetMailbox *mailbox, int delta) {
-    mailbox->refCount += delta;
-    if (mailbox->refCount <= 0) {
-        janet_mailbox_unlock(mailbox);
-        janet_mailbox_destroy(mailbox);
-    } else {
-        janet_mailbox_unlock(mailbox);
-    }
-}
-
-static void janet_mailbox_ref(JanetMailbox *mailbox, int delta) {
-    janet_mailbox_lock(mailbox);
-    janet_mailbox_ref_with_lock(mailbox, delta);
-}
-
-static void janet_close_thread(JanetThread *thread) {
-    if (thread->mailbox) {
-        janet_mailbox_ref(thread->mailbox, -1);
-        thread->mailbox = NULL;
-    }
-}
-
-static int thread_gc(void *p, size_t size) {
-    (void) size;
-    JanetThread *thread = (JanetThread *)p;
-    janet_close_thread(thread);
-    return 0;
-}
-
-static int thread_mark(void *p, size_t size) {
-    (void) size;
-    JanetThread *thread = (JanetThread *)p;
-    if (thread->encode) {
-        janet_mark(janet_wrap_table(thread->encode));
-    }
-    return 0;
-}
-
-static JanetMailboxPair *make_mailbox_pair(JanetMailbox *original, uint64_t flags) {
-    JanetMailboxPair *pair = janet_malloc(sizeof(JanetMailboxPair));
-    if (NULL == pair) {
-        JANET_OUT_OF_MEMORY;
-    }
-    pair->original = original;
-    janet_mailbox_ref(original, 1);
-    pair->newbox = janet_mailbox_create(1, 16);
-    pair->flags = flags;
-    return pair;
-}
-
-static void destroy_mailbox_pair(JanetMailboxPair *pair) {
-    janet_mailbox_ref(pair->original, -1);
-    janet_mailbox_ref(pair->newbox, -1);
-    janet_free(pair);
-}
-
-/* Abstract waiting for timeout across windows/posix */
-typedef struct {
-    int timedwait;
-    int nowait;
-#ifdef JANET_WINDOWS
-    DWORD interval;
-    DWORD ticksLeft;
-#else
-    struct timespec ts;
-#endif
-} JanetWaiter;
-
-static void janet_waiter_init(JanetWaiter *waiter, double sec) {
-    waiter->timedwait = 0;
-    waiter->nowait = 0;
-
-    if (sec <= 0.0 || isnan(sec)) {
-        waiter->nowait = 1;
-        return;
-    }
-    waiter->timedwait = sec > 0.0 && !isinf(sec);
-
-    /* Set maximum wait time to 30 days */
-    if (sec > (60.0 * 60.0 * 24.0 * 30.0)) {
-        sec = 60.0 * 60.0 * 24.0 * 30.0;
-    }
-
-#ifdef JANET_WINDOWS
-    if (waiter->timedwait) {
-        waiter->ticksLeft = waiter->interval = (DWORD) floor(1000.0 * sec);
-    }
-#else
-    if (waiter->timedwait) {
-        /* N seconds -> timespec of (now + sec) */
-        struct timespec now;
-        janet_gettime(&now);
-        time_t tvsec = (time_t) floor(sec);
-        long tvnsec = (long) floor(1000000000.0 * (sec - ((double) tvsec)));
-        tvsec += now.tv_sec;
-        tvnsec += now.tv_nsec;
-        if (tvnsec >= 1000000000L) {
-            tvnsec -= 1000000000L;
-            tvsec += 1;
-        }
-        waiter->ts.tv_sec = tvsec;
-        waiter->ts.tv_nsec = tvnsec;
-    }
-#endif
-}
-
-static int janet_waiter_wait(JanetWaiter *wait, JanetMailbox *mailbox) {
-    if (wait->nowait) return 1;
-#ifdef JANET_WINDOWS
-    if (wait->timedwait) {
-        if (wait->ticksLeft == 0) return 1;
-        DWORD startTime = GetTickCount();
-        int status = !SleepConditionVariableCS(&mailbox->cond, &mailbox->lock, wait->ticksLeft);
-        DWORD dTick = GetTickCount() - startTime;
-        /* Be careful about underflow */
-        wait->ticksLeft = dTick > wait->ticksLeft ? 0 : dTick;
-        return status;
-    } else {
-        SleepConditionVariableCS(&mailbox->cond, &mailbox->lock, INFINITE);
-        return 0;
-    }
-#else
-    if (wait->timedwait) {
-        return pthread_cond_timedwait(&mailbox->cond, &mailbox->lock, &wait->ts);
-    } else {
-        pthread_cond_wait(&mailbox->cond, &mailbox->lock);
-        return 0;
-    }
-#endif
-}
-
-static void janet_mailbox_wakeup(JanetMailbox *mailbox) {
-#ifdef JANET_WINDOWS
-    WakeConditionVariable(&mailbox->cond);
-#else
-    pthread_cond_signal(&mailbox->cond);
-#endif
-}
-
-static int mailbox_at_capacity(JanetMailbox *mailbox) {
-    return mailbox->messageCount >= mailbox->messageCapacity;
-}
-
-/* Returns 1 if could not send (encode error or timeout), 2 for mailbox closed, and
- * 0 otherwise. Will not panic.  */
-int janet_thread_send(JanetThread *thread, Janet msg, double timeout) {
-
-    /* Ensure mailbox is not closed. */
-    JanetMailbox *mailbox = thread->mailbox;
-    if (NULL == mailbox) return 2;
-    janet_mailbox_lock(mailbox);
-    if (mailbox->closed) {
-        janet_mailbox_ref_with_lock(mailbox, -1);
-        thread->mailbox = NULL;
-        return 2;
-    }
-
-    /* Back pressure */
-    if (mailbox_at_capacity(mailbox)) {
-        JanetWaiter wait;
-        janet_waiter_init(&wait, timeout);
-
-        if (wait.nowait) {
-            janet_mailbox_unlock(mailbox);
-            return 1;
-        }
-
-        /* Retry loop, as there can be multiple writers */
-        while (mailbox_at_capacity(mailbox)) {
-            if (janet_waiter_wait(&wait, mailbox)) {
-                janet_mailbox_unlock(mailbox);
-                janet_mailbox_wakeup(mailbox);
-                return 1;
-            }
-        }
-    }
-
-    /* Hack to capture all panics from marshalling. This works because
-     * we know janet_marshal won't mess with other essential global state. */
-    jmp_buf buf;
-    jmp_buf *old_buf = janet_vm.signal_buf;
-    janet_vm.signal_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.signal_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.signal_buf;
-            janet_vm.signal_buf = &buf;
-
-            /* Handle errors */
-            if (setjmp(buf)) {
-                /* Cleanup jmp_buf, return error.
-                 * Do not ignore bad messages as before. */
-                janet_vm.signal_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.signal_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;
-
-    /* Init VM */
-    janet_init();
-
-    /* Use the mailbox we were given */
-    janet_vm.mailbox = pair->newbox;
-    janet_mailbox_ref(pair->newbox, 1);
-
-    /* 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 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) {
-    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
- */
-
-JANET_CORE_FN(cfun_thread_current,
-              "(thread/current)",
-              "Get the current running thread.") {
-    (void) argv;
-    janet_fixarity(argc, 0);
-    return janet_wrap_abstract(janet_thread_current());
-}
-
-JANET_CORE_FN(cfun_thread_new,
-              "(thread/new func &opt capacity flags)",
-              "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"
-              "* `:a` - Allow sending over registered abstract types to the new thread\n"
-              "* `:c` - Send over cfunction information to the new thread (no longer supported).\n"
-              "Returns a handle to the new thread.") {
-    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 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);
-}
-
-JANET_CORE_FN(cfun_thread_send,
-              "(thread/send thread msgi &opt timeout)",
-              "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.") {
-    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];
-}
-
-JANET_CORE_FN(cfun_thread_receive,
-              "(thread/receive &opt timeout)",
-              "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.") {
-    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;
-}
-
-JANET_CORE_FN(cfun_thread_close,
-              "(thread/close thread)",
-              "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.") {
-    janet_fixarity(argc, 1);
-    JanetThread *thread = janet_getthread(argv, 0);
-    janet_close_thread(thread);
-    return janet_wrap_nil();
-}
-
-JANET_CORE_FN(cfun_thread_exit,
-              "(thread/exit &opt code)",
-              "Exit from the current thread. If no more threads are running, ends the process, but otherwise does "
-              "not end the current process.") {
-    (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);
-}
-
-/* Module entry point */
-void janet_lib_thread(JanetTable *env) {
-    JanetRegExt threadlib_cfuns[] = {
-        JANET_CORE_REG("thread/current", cfun_thread_current),
-        JANET_CORE_REG("thread/new", cfun_thread_new),
-        JANET_CORE_REG("thread/send", cfun_thread_send),
-        JANET_CORE_REG("thread/receive", cfun_thread_receive),
-        JANET_CORE_REG("thread/close", cfun_thread_close),
-        JANET_CORE_REG("thread/exit", cfun_thread_exit),
-        JANET_REG_END
-    };
-    janet_core_cfuns_ext(env, NULL, threadlib_cfuns);
-    janet_register_abstract_type(&janet_thread_type);
-}
-
-#endif

src/core/tuple.c

@@ -1,5 +1,5 @@
 /*
-* Copyright (c) 2021 Calvin Rose
+* Copyright (c) 2022 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
@@ -65,12 +65,12 @@ JANET_CORE_FN(cfun_tuple_brackets,
 
 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 "
+              "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. "
+              "index `(length arrtup)` to allow a full negative slice range. "
               "Returns the new tuple.") {
     JanetView view = janet_getindexed(argv, 0);
     JanetRange range = janet_getslice(argc, argv);
@@ -96,7 +96,7 @@ JANET_CORE_FN(cfun_tuple_type,
 JANET_CORE_FN(cfun_tuple_sourcemap,
               "(tuple/sourcemap tup)",
               "Returns the sourcemap metadata attached to a tuple, "
-              " which is another tuple (line, column).") {
+              "which is another tuple (line, column).") {
     janet_fixarity(argc, 1);
     const Janet *tup = janet_gettuple(argv, 0);
     Janet contents[2];

src/core/util.c

@@ -1,5 +1,5 @@
 /*
-* Copyright (c) 2021 Calvin Rose
+* Copyright (c) 2022 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,10 @@
 #endif
 #endif
 
+#ifdef JANET_APPLE
+#include <AvailabilityMacros.h>
+#endif
+
 #include <inttypes.h>
 
 /* Base 64 lookup table for digits */
@@ -224,13 +228,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 +246,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 +258,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;
@@ -593,10 +602,8 @@ void janet_core_cfuns_ext(JanetTable *env, const char *regprefix, const JanetReg
 }
 #endif
 
-JanetBinding janet_resolve_ext(JanetTable *env, const uint8_t *sym) {
-    Janet ref;
+JanetBinding janet_binding_from_entry(Janet entry) {
     JanetTable *entry_table;
-    Janet entry = janet_table_get(env, janet_wrap_symbol(sym));
     JanetBinding binding = {
         JANET_BINDING_NONE,
         janet_wrap_nil(),
@@ -623,29 +630,41 @@ JanetBinding janet_resolve_ext(JanetTable *env, const uint8_t *sym) {
         binding.deprecation = JANET_BINDING_DEP_NORMAL;
     }
 
-    if (!janet_checktype(
-                janet_table_get(entry_table, janet_ckeywordv("macro")),
-                JANET_NIL)) {
-        binding.value = janet_table_get(entry_table, janet_ckeywordv("value"));
-        binding.type = JANET_BINDING_MACRO;
+    int macro = janet_truthy(janet_table_get(entry_table, janet_ckeywordv("macro")));
+    Janet value = janet_table_get(entry_table, janet_ckeywordv("value"));
+    Janet ref = janet_table_get(entry_table, janet_ckeywordv("ref"));
+    int ref_is_valid = janet_checktype(ref, JANET_ARRAY);
+    int redef = ref_is_valid && janet_truthy(janet_table_get(entry_table, janet_ckeywordv("redef")));
+
+    if (macro) {
+        binding.value = redef ? ref : value;
+        binding.type = redef ? JANET_BINDING_DYNAMIC_MACRO : JANET_BINDING_MACRO;
         return binding;
     }
 
-    ref = janet_table_get(entry_table, janet_ckeywordv("ref"));
-    if (janet_checktype(ref, JANET_ARRAY)) {
+    if (ref_is_valid) {
         binding.value = ref;
-        binding.type = JANET_BINDING_VAR;
-        return binding;
+        binding.type = redef ? JANET_BINDING_DYNAMIC_DEF : JANET_BINDING_VAR;
+    } else {
+        binding.value = value;
+        binding.type = JANET_BINDING_DEF;
     }
 
-    binding.value = janet_table_get(entry_table, janet_ckeywordv("value"));
-    binding.type = JANET_BINDING_DEF;
     return binding;
 }
 
+JanetBinding janet_resolve_ext(JanetTable *env, const uint8_t *sym) {
+    Janet entry = janet_table_get(env, janet_wrap_symbol(sym));
+    return janet_binding_from_entry(entry);
+}
+
 JanetBindingType janet_resolve(JanetTable *env, const uint8_t *sym, Janet *out) {
     JanetBinding binding = janet_resolve_ext(env, sym);
-    *out = binding.value;
+    if (binding.type == JANET_BINDING_DYNAMIC_DEF || binding.type == JANET_BINDING_DYNAMIC_MACRO) {
+        *out = janet_array_peek(janet_unwrap_array(binding.value));
+    } else {
+        *out = binding.value;
+    }
     return binding.type;
 }
 
@@ -720,6 +739,13 @@ int janet_checkint64(Janet x) {
     return janet_checkint64range(dval);
 }
 
+int janet_checkuint64(Janet x) {
+    if (!janet_checktype(x, JANET_NUMBER))
+        return 0;
+    double dval = janet_unwrap_number(x);
+    return dval >= 0 && dval <= JANET_INTMAX_DOUBLE && dval == (uint64_t) dval;
+}
+
 int janet_checksize(Janet x) {
     if (!janet_checktype(x, JANET_NUMBER))
         return 0;
@@ -775,11 +801,6 @@ int32_t janet_sorted_keys(const JanetKV *dict, int32_t cap, int32_t *index_buffe
 
 /* Clock shims for various platforms */
 #ifdef JANET_GETTIME
-/* For macos */
-#ifdef __MACH__
-#include <mach/clock.h>
-#include <mach/mach.h>
-#endif
 #ifdef JANET_WINDOWS
 int janet_gettime(struct timespec *spec) {
     FILETIME ftime;
@@ -792,7 +813,10 @@ int janet_gettime(struct timespec *spec) {
     spec->tv_nsec = wintime % 10000000LL * 100;
     return 0;
 }
-#elif defined(__MACH__)
+/* clock_gettime() wasn't available on Mac until 10.12. */
+#elif defined(JANET_APPLE) && !defined(MAC_OS_X_VERSION_10_12)
+#include <mach/clock.h>
+#include <mach/mach.h>
 int janet_gettime(struct timespec *spec) {
     clock_serv_t cclock;
     mach_timespec_t mts;
@@ -860,6 +884,43 @@ int janet_cryptorand(uint8_t *out, size_t n) {
 #endif
 }
 
+/* Dynamic library loading */
+
+char *get_processed_name(const char *name) {
+    if (name[0] == '.') return (char *) name;
+    const char *c;
+    for (c = name; *c; c++) {
+        if (*c == '/') return (char *) name;
+    }
+    size_t l = (size_t)(c - name);
+    char *ret = janet_malloc(l + 3);
+    if (NULL == ret) {
+        JANET_OUT_OF_MEMORY;
+    }
+    ret[0] = '.';
+    ret[1] = '/';
+    memcpy(ret + 2, name, l + 1);
+    return ret;
+}
+
+#if defined(JANET_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);
+    }
+}
+#endif
 
 /* Alloc function macro fills */
 void *(janet_malloc)(size_t size) {

src/core/util.h

@@ -1,5 +1,5 @@
 /*
-* Copyright (c) 2021 Calvin Rose
+* Copyright (c) 2022 Calvin Rose
 *
 * Permission is hereby granted, free of charge, to any person obtaining a copy
 * of this software and associated documentation files (the "Software"), to
@@ -31,6 +31,14 @@
 
 #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>
@@ -56,7 +64,10 @@
 } while (0)
 
 /* 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);
@@ -81,6 +92,7 @@ void janet_buffer_format(
     int32_t argc,
     Janet *argv);
 Janet janet_next_impl(Janet ds, Janet key, int is_interpreter);
+JanetBinding janet_binding_from_entry(Janet entry);
 
 /* Registry functions */
 void janet_registry_put(
@@ -117,6 +129,31 @@ int janet_gettime(struct timespec *spec);
 #define strdup(x) _strdup(x)
 #endif
 
+/* Use LoadLibrary on windows or dlopen on posix to load dynamic libaries
+ * with native code. */
+#if defined(JANET_NO_DYNAMIC_MODULES)
+typedef int Clib;
+#define load_clib(name) ((void) name, 0)
+#define symbol_clib(lib, sym) ((void) lib, (void) sym, NULL)
+#define error_clib() "dynamic libraries not supported"
+#define free_clib(c) ((void) (c), 0)
+#elif defined(JANET_WINDOWS)
+#include <windows.h>
+typedef HINSTANCE Clib;
+#define free_clib(c) FreeLibrary((c))
+#define symbol_clib(lib, sym) GetProcAddress((lib), (sym))
+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 */
@@ -126,6 +163,7 @@ void janet_lib_array(JanetTable *env);
 void janet_lib_tuple(JanetTable *env);
 void janet_lib_buffer(JanetTable *env);
 void janet_lib_table(JanetTable *env);
+void janet_lib_struct(JanetTable *env);
 void janet_lib_fiber(JanetTable *env);
 void janet_lib_os(JanetTable *env);
 void janet_lib_string(JanetTable *env);
@@ -145,9 +183,6 @@ void janet_lib_typed_array(JanetTable *env);
 #ifdef JANET_INT_TYPES
 void janet_lib_inttypes(JanetTable *env);
 #endif
-#ifdef JANET_THREADS
-void janet_lib_thread(JanetTable *env);
-#endif
 #ifdef JANET_NET
 void janet_lib_net(JanetTable *env);
 extern const JanetAbstractType janet_address_type;
@@ -157,5 +192,8 @@ void janet_lib_ev(JanetTable *env);
 void janet_ev_mark(void);
 int janet_make_pipe(JanetHandle handles[2], int mode);
 #endif
+#ifdef JANET_FFI
+void janet_lib_ffi(JanetTable *env);
+#endif
 
 #endif

src/core/value.c

@@ -1,5 +1,5 @@
 /*
-* Copyright (c) 2021 Calvin Rose
+* Copyright (c) 2022 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
@@ -101,6 +101,17 @@ static int traversal_next(Janet *x, Janet *y) {
                 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--;
     }
@@ -273,6 +284,8 @@ int janet_equals(Janet x, Janet y) {
                 if (s1 == s2) break;
                 if (janet_struct_hash(s1) != janet_struct_hash(s2)) return 0;
                 if (janet_struct_length(s1) != janet_struct_length(s2)) return 0;
+                if (janet_struct_proto(s1) && !janet_struct_proto(s2)) return 0;
+                if (!janet_struct_proto(s1) && janet_struct_proto(s2)) return 0;
                 push_traversal_node(janet_struct_head(s1), janet_struct_head(s2), 0);
                 break;
             }
@@ -309,9 +322,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: {
@@ -325,15 +340,17 @@ int32_t janet_hash(Janet x) {
         /* fallthrough */
         default:
             if (sizeof(double) == sizeof(void *)) {
-                /* Assuming 8 byte pointer */
+                /* Assuming 8 byte pointer (8 byte aligned) */
                 uint64_t i = janet_u64(x);
                 uint32_t lo = (uint32_t)(i & 0xFFFFFFFF);
                 uint32_t hi = (uint32_t)(i >> 32);
-                hash = (int32_t)(hi ^ (lo >> 3));
+                uint32_t hilo = (hi ^ lo) * 2654435769u;
+                hash = (int32_t)((hilo << 16) | (hilo >> 16));
             } 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;
     }

src/core/vector.c

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

src/core/vector.h

@@ -1,5 +1,5 @@
 /*
-* Copyright (c) 2021 Calvin Rose
+* Copyright (c) 2022 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) 2022 Calvin Rose
 *
 * Permission is hereby granted, free of charge, to any person obtaining a copy
 * of this software and associated documentation files (the "Software"), to
@@ -220,14 +220,14 @@
 /* Trace a function call */
 static void vm_do_trace(JanetFunction *func, int32_t argc, const Janet *argv) {
     if (func->def->name) {
-        janet_printf("trace (%S", func->def->name);
+        janet_eprintf("trace (%S", func->def->name);
     } else {
-        janet_printf("trace (%p", janet_wrap_function(func));
+        janet_eprintf("trace (%p", janet_wrap_function(func));
     }
     for (int32_t i = 0; i < argc; i++) {
-        janet_printf(" %p", argv[i]);
+        janet_eprintf(" %p", argv[i]);
     }
-    janet_printf(")\n");
+    janet_eprintf(")\n");
 }
 
 /* Invoke a method once we have looked it up */
@@ -315,7 +315,7 @@ static Janet janet_binop_call(const char *lmethod, const char *rmethod, Janet lh
 }
 
 /* Forward declaration */
-static JanetSignal janet_check_can_resume(JanetFiber *fiber, Janet *out);
+static JanetSignal janet_check_can_resume(JanetFiber *fiber, Janet *out, int is_cancel);
 static JanetSignal janet_continue_no_check(JanetFiber *fiber, Janet in, Janet *out);
 
 /* Interpreter main loop */
@@ -1056,7 +1056,7 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in) {
         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);
         }
@@ -1096,7 +1096,7 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in) {
         Janet retreg;
         vm_assert_type(stack[B], JANET_FIBER);
         JanetFiber *child = janet_unwrap_fiber(stack[B]);
-        if (janet_check_can_resume(child, &retreg)) {
+        if (janet_check_can_resume(child, &retreg, 1)) {
             vm_commit();
             janet_panicv(retreg);
         }
@@ -1285,6 +1285,12 @@ JanetSignal janet_step(JanetFiber *fiber, Janet in, Janet *out) {
     return signal;
 }
 
+static Janet void_cfunction(int32_t argc, Janet *argv) {
+    (void) argc;
+    (void) argv;
+    janet_panic("placeholder");
+}
+
 Janet janet_call(JanetFunction *fun, int32_t argc, const Janet *argv) {
     /* Check entry conditions */
     if (!janet_vm.fiber)
@@ -1292,9 +1298,17 @@ Janet janet_call(JanetFunction *fun, int32_t argc, const Janet *argv) {
     if (janet_vm.stackn >= JANET_RECURSION_GUARD)
         janet_panic("C stack recursed too deeply");
 
+    /* Dirty stack */
+    int32_t dirty_stack = janet_vm.fiber->stacktop - janet_vm.fiber->stackstart;
+    if (dirty_stack) {
+        janet_fiber_cframe(janet_vm.fiber, void_cfunction);
+    }
+
     /* Tracing */
     if (fun->gc.flags & JANET_FUNCFLAG_TRACE) {
+        janet_vm.stackn++;
         vm_do_trace(fun, argc, argv);
+        janet_vm.stackn--;
     }
 
     /* Push frame */
@@ -1322,6 +1336,10 @@ Janet janet_call(JanetFunction *fun, int32_t argc, const Janet *argv) {
     /* Teardown */
     janet_vm.stackn = oldn;
     janet_gcunlock(handle);
+    if (dirty_stack) {
+        janet_fiber_popframe(janet_vm.fiber);
+        janet_vm.fiber->stacktop += dirty_stack;
+    }
 
     if (signal != JANET_SIGNAL_OK) {
         janet_panicv(*janet_vm.return_reg);
@@ -1330,7 +1348,7 @@ Janet janet_call(JanetFunction *fun, int32_t argc, const Janet *argv) {
     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) {
@@ -1338,6 +1356,20 @@ static JanetSignal janet_check_can_resume(JanetFiber *fiber, Janet *out) {
         *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) ||
@@ -1452,14 +1484,14 @@ static JanetSignal janet_continue_no_check(JanetFiber *fiber, Janet in, Janet *o
 /* Enter the main vm loop */
 JanetSignal janet_continue(JanetFiber *fiber, Janet in, Janet *out) {
     /* Check conditions */
-    JanetSignal tmp_signal = janet_check_can_resume(fiber, out);
+    JanetSignal tmp_signal = janet_check_can_resume(fiber, out, 0);
     if (tmp_signal) return tmp_signal;
     return janet_continue_no_check(fiber, in, out);
 }
 
 /* Enter the main vm loop but immediately raise a signal */
 JanetSignal janet_continue_signal(JanetFiber *fiber, Janet in, Janet *out, JanetSignal sig) {
-    JanetSignal tmp_signal = janet_check_can_resume(fiber, out);
+    JanetSignal tmp_signal = janet_check_can_resume(fiber, out, sig != JANET_SIGNAL_OK);
     if (tmp_signal) return tmp_signal;
     if (sig != JANET_SIGNAL_OK) {
         JanetFiber *child = fiber;
@@ -1493,7 +1525,9 @@ JanetSignal janet_pcall(
 
 Janet janet_mcall(const char *name, int32_t argc, Janet *argv) {
     /* At least 1 argument */
-    if (argc < 1) janet_panicf("method :%s expected at least 1 argument");
+    if (argc < 1) {
+        janet_panicf("method :%s expected at least 1 argument", name);
+    }
     /* Find method */
     Janet method = janet_method_lookup(argv[0], name);
     if (janet_checktype(method, JANET_NIL)) {
@@ -1557,9 +1591,6 @@ int janet_init(void) {
     janet_vm.root_fiber = NULL;
     janet_vm.stackn = 0;
 
-#ifdef JANET_THREADS
-    janet_threads_init();
-#endif
 #ifdef JANET_EV
     janet_ev_init();
 #endif
@@ -1586,9 +1617,6 @@ void janet_deinit(void) {
     janet_vm.root_fiber = NULL;
     janet_free(janet_vm.registry);
     janet_vm.registry = NULL;
-#ifdef JANET_THREADS
-    janet_threads_deinit();
-#endif
 #ifdef JANET_EV
     janet_ev_deinit();
 #endif

src/core/wrap.c

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

src/include/janet.h

@@ -1,5 +1,5 @@
 /*
-* Copyright (c) 2021 Calvin Rose
+* Copyright (c) 2022 Calvin Rose
 *
 * Permission is hereby granted, free of charge, to any person obtaining a copy
 * of this software and associated documentation files (the "Software"), to
@@ -57,8 +57,8 @@ extern "C" {
 #define JANET_BSD 1
 #endif
 
-/* Check for Mac */
-#ifdef __APPLE__
+/* Check for macOS or OS X */
+#if defined(__APPLE__) && defined(__MACH__)
 #define JANET_APPLE 1
 #endif
 
@@ -144,11 +144,6 @@ extern "C" {
 #define JANET_NO_UTC_MKTIME
 #endif
 
-/* Check thread library */
-#ifndef JANET_NO_THREADS
-#define JANET_THREADS
-#endif
-
 /* Define how global janet state is declared */
 /* Also enable the thread library only if not single-threaded */
 #ifdef JANET_SINGLE_THREADED
@@ -168,6 +163,14 @@ extern "C" {
 #define JANET_DYNAMIC_MODULES
 #endif
 
+/* Enable or disable the FFI library. Currently, FFI only enabled on
+ * x86-64, non-windows operating systems. */
+#ifndef JANET_NO_FFI
+#if !defined(JANET_WINDOWS) && !defined(__EMSCRIPTEN__) && (defined(__x86_64__) || defined(_M_X64))
+#define JANET_FFI
+#endif
+#endif
+
 /* Enable or disable the assembler. Enabled by default. */
 #ifndef JANET_NO_ASSEMBLER
 #define JANET_ASSEMBLER
@@ -304,10 +307,10 @@ typedef struct {
     JANET_CURRENT_CONFIG_BITS })
 #endif
 
-/* What to do when out of memory */
-#ifndef JANET_OUT_OF_MEMORY
-#include <stdio.h>
-#define JANET_OUT_OF_MEMORY do { fprintf(stderr, "janet out of memory\n"); exit(1); } while (0)
+/* Some extra includes if EV is enabled */
+#ifdef JANET_EV
+typedef struct JanetOSMutex JanetOSMutex;
+typedef struct JanetOSRWLock JanetOSRWLock;
 #endif
 
 /***** END SECTION CONFIG *****/
@@ -327,23 +330,10 @@ typedef struct {
 #include <stddef.h>
 #include <stdio.h>
 
-/* Some extra includes if EV is enabled */
-#ifdef JANET_EV
-#ifdef JANET_WINDOWS
-typedef struct JanetDudCriticalSection {
-    /* Avoid including windows.h here - instead, create a structure of the same size */
-    /* Needs to be same size as crtical section see WinNT.h for CRITCIAL_SECTION definition */
-    void *debug_info;
-    long lock_count;
-    long recursion_count;
-    void *owning_thread;
-    void *lock_semaphore;
-    unsigned long spin_count;
-} JanetOSMutex;
-#else
-#include <pthread.h>
-typedef pthread_mutex_t JanetOSMutex;
-#endif
+
+/* What to do when out of memory */
+#ifndef JANET_OUT_OF_MEMORY
+#define JANET_OUT_OF_MEMORY do { fprintf(stderr, "janet out of memory\n"); exit(1); } while (0)
 #endif
 
 #ifdef JANET_BSD
@@ -854,6 +844,7 @@ JANET_API Janet janet_nanbox32_from_tagp(uint32_t tag, void *pointer);
 
 JANET_API int janet_checkint(Janet x);
 JANET_API int janet_checkint64(Janet x);
+JANET_API int janet_checkuint64(Janet x);
 JANET_API int janet_checksize(Janet x);
 JANET_API JanetAbstract janet_checkabstract(Janet x, const JanetAbstractType *at);
 #define janet_checkintrange(x) ((x) >= INT32_MIN && (x) <= INT32_MAX && (x) == (int32_t)(x))
@@ -871,7 +862,7 @@ struct JanetGCObject {
     union {
         JanetGCObject *next;
         int32_t refcount; /* For threaded abstract types */
-    };
+    } data;
 };
 
 /* A lightweight green thread in janet. Does not correspond to
@@ -966,6 +957,7 @@ struct JanetStructHead {
     int32_t length;
     int32_t hash;
     int32_t capacity;
+    const JanetKV *proto;
     const JanetKV data[];
 };
 
@@ -1184,17 +1176,6 @@ typedef struct {
     Janet payload;
 } JanetTryState;
 
-/* Thread types */
-#ifdef JANET_THREADS
-typedef struct JanetThread JanetThread;
-typedef struct JanetMailbox JanetMailbox;
-struct JanetThread {
-    JanetMailbox *mailbox;
-    JanetTable *encode;
-};
-#endif
-
-
 /***** END SECTION TYPES *****/
 
 /***** START SECTION OPCODES *****/
@@ -1383,11 +1364,19 @@ JANET_API void *janet_abstract_threaded(const JanetAbstractType *atype, size_t s
 JANET_API int32_t janet_abstract_incref(void *abst);
 JANET_API int32_t janet_abstract_decref(void *abst);
 
-/* Expose some OS sync primitives to make portable abstract types easier to implement */
+/* Expose some OS sync primitives */
+JANET_API size_t janet_os_mutex_size(void);
+JANET_API size_t janet_os_rwlock_size(void);
 JANET_API void janet_os_mutex_init(JanetOSMutex *mutex);
 JANET_API void janet_os_mutex_deinit(JanetOSMutex *mutex);
 JANET_API void janet_os_mutex_lock(JanetOSMutex *mutex);
 JANET_API void janet_os_mutex_unlock(JanetOSMutex *mutex);
+JANET_API void janet_os_rwlock_init(JanetOSRWLock *rwlock);
+JANET_API void janet_os_rwlock_deinit(JanetOSRWLock *rwlock);
+JANET_API void janet_os_rwlock_rlock(JanetOSRWLock *rwlock);
+JANET_API void janet_os_rwlock_wlock(JanetOSRWLock *rwlock);
+JANET_API void janet_os_rwlock_runlock(JanetOSRWLock *rwlock);
+JANET_API void janet_os_rwlock_wunlock(JanetOSRWLock *rwlock);
 
 /* Get last error from an IO operation */
 JANET_API Janet janet_ev_lasterr(void);
@@ -1527,6 +1516,7 @@ JANET_API int janet_loop_fiber(JanetFiber *fiber);
 
 /* Number scanning */
 JANET_API int janet_scan_number(const uint8_t *str, int32_t len, double *out);
+JANET_API int janet_scan_number_base(const uint8_t *str, int32_t len, int32_t base, double *out);
 JANET_API int janet_scan_int64(const uint8_t *str, int32_t len, int64_t *out);
 JANET_API int janet_scan_uint64(const uint8_t *str, int32_t len, uint64_t *out);
 
@@ -1543,6 +1533,7 @@ JANET_API JanetRNG *janet_default_rng(void);
 JANET_API void janet_rng_seed(JanetRNG *rng, uint32_t seed);
 JANET_API void janet_rng_longseed(JanetRNG *rng, const uint8_t *bytes, int32_t len);
 JANET_API uint32_t janet_rng_u32(JanetRNG *rng);
+JANET_API double janet_rng_double(JanetRNG *rng);
 
 /* Array functions */
 JANET_API JanetArray *janet_array(int32_t capacity);
@@ -1623,10 +1614,13 @@ JANET_API JanetSymbol janet_symbol_gen(void);
 #define janet_struct_length(t) (janet_struct_head(t)->length)
 #define janet_struct_capacity(t) (janet_struct_head(t)->capacity)
 #define janet_struct_hash(t) (janet_struct_head(t)->hash)
+#define janet_struct_proto(t) (janet_struct_head(t)->proto)
 JANET_API JanetKV *janet_struct_begin(int32_t count);
 JANET_API void janet_struct_put(JanetKV *st, Janet key, Janet value);
 JANET_API JanetStruct janet_struct_end(JanetKV *st);
 JANET_API Janet janet_struct_get(JanetStruct st, Janet key);
+JANET_API Janet janet_struct_rawget(JanetStruct st, Janet key);
+JANET_API Janet janet_struct_get_ex(JanetStruct st, Janet key, JanetStruct *which);
 JANET_API JanetTable *janet_struct_to_table(JanetStruct st);
 JANET_API const JanetKV *janet_struct_find(JanetStruct st, Janet key);
 
@@ -1762,6 +1756,7 @@ JANET_API JanetSignal janet_step(JanetFiber *fiber, Janet in, Janet *out);
 JANET_API Janet janet_call(JanetFunction *fun, int32_t argc, const Janet *argv);
 JANET_API Janet janet_mcall(const char *name, int32_t argc, Janet *argv);
 JANET_API void janet_stacktrace(JanetFiber *fiber, Janet err);
+JANET_API void janet_stacktrace_ext(JanetFiber *fiber, Janet err, const char *prefix);
 
 /* Scratch Memory API */
 typedef void (*JanetScratchFinalizer)(void *);
@@ -1777,7 +1772,9 @@ typedef enum {
     JANET_BINDING_NONE,
     JANET_BINDING_DEF,
     JANET_BINDING_VAR,
-    JANET_BINDING_MACRO
+    JANET_BINDING_MACRO,
+    JANET_BINDING_DYNAMIC_DEF,
+    JANET_BINDING_DYNAMIC_MACRO
 } JanetBindingType;
 
 typedef struct {
@@ -1921,6 +1918,7 @@ JANET_API void *janet_getpointer(const Janet *argv, int32_t n);
 JANET_API int32_t janet_getnat(const Janet *argv, int32_t n);
 JANET_API int32_t janet_getinteger(const Janet *argv, int32_t n);
 JANET_API int64_t janet_getinteger64(const Janet *argv, int32_t n);
+JANET_API uint64_t janet_getuinteger64(const Janet *argv, int32_t n);
 JANET_API size_t janet_getsize(const Janet *argv, int32_t n);
 JANET_API JanetView janet_getindexed(const Janet *argv, int32_t n);
 JANET_API JanetByteView janet_getbytes(const Janet *argv, int32_t n);
@@ -1968,7 +1966,6 @@ extern JANET_API const JanetAbstractType janet_file_type;
 #define JANET_FILE_CLOSED 32
 #define JANET_FILE_BINARY 64
 #define JANET_FILE_SERIALIZABLE 128
-#define JANET_FILE_PIPED 256
 #define JANET_FILE_NONIL 512
 
 JANET_API Janet janet_makefile(FILE *f, int32_t flags);
@@ -2040,7 +2037,8 @@ typedef enum {
     RULE_READINT,      /* [(signedness << 4) | (endianess << 5) | bytewidth, tag] */
     RULE_LINE,         /* [tag] */
     RULE_COLUMN,       /* [tag] */
-    RULE_UNREF         /* [rule, tag] */
+    RULE_UNREF,        /* [rule, tag] */
+    RULE_CAPTURE_NUM   /* [rule, tag] */
 } JanetPegOpcod;
 
 typedef struct {
@@ -2074,16 +2072,6 @@ JANET_API int janet_scan_uint64(const uint8_t *str, int32_t len, uint64_t *out);
 
 #endif
 
-#ifdef JANET_THREADS
-
-extern JANET_API const JanetAbstractType janet_thread_type;
-
-JANET_API int janet_thread_receive(Janet *msg_out, double timeout);
-JANET_API int janet_thread_send(JanetThread *thread, Janet msg, double timeout);
-JANET_API JanetThread *janet_thread_current(void);
-
-#endif
-
 /* Custom allocator support */
 JANET_API void *(janet_malloc)(size_t);
 JANET_API void *(janet_realloc)(void *, size_t);

src/mainclient/shell.c

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

test/helper.janet

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

test/suite0000.janet

@@ -202,6 +202,7 @@
 
 #🐙🐙🐙🐙
 
+(defn foo [Θa Θb Θc] 0)
 (def 🦊 :fox)
 (def 🐮 :cow)
 (assert (= (string "🐼" 🦊 🐮) "🐼foxcow") "emojis 🙉 :)")
@@ -294,6 +295,21 @@
     (++ i))
   (assert (= i 6) "when macro"))
 
+# Dynamic defs
+
+(def staticdef1 0)
+(defn staticdef1-inc [] (+ 1 staticdef1))
+(assert (= 1 (staticdef1-inc)) "before redefinition without :redef")
+(def staticdef1 1)
+(assert (= 1 (staticdef1-inc)) "after redefinition without :redef")
+(setdyn :redef true)
+(def dynamicdef2 0)
+(defn dynamicdef2-inc [] (+ 1 dynamicdef2))
+(assert (= 1 (dynamicdef2-inc)) "before redefinition with dyn :redef")
+(def dynamicdef2 1)
+(assert (= 2 (dynamicdef2-inc)) "after redefinition with dyn :redef")
+(setdyn :redef nil)
+
 # Denormal tables and structs
 
 (assert (= (length {1 2 nil 3}) 1) "nil key struct literal")
@@ -395,7 +411,7 @@
       compare-poly-tests
       [[(int/s64 3) (int/u64 3) 0]
        [(int/s64 -3) (int/u64 3) -1]
-       [(int/s64 3) (int/u64 2) 1] 
+       [(int/s64 3) (int/u64 2) 1]
        [(int/s64 3) 3 0] [(int/s64 3) 4 -1] [(int/s64 3) -9 1]
        [(int/u64 3) 3 0] [(int/u64 3) 4 -1] [(int/u64 3) -9 1]
        [3 (int/s64 3) 0] [3 (int/s64 4) -1] [3 (int/s64 -5) 1]
@@ -405,7 +421,7 @@
        [(int/u64 MAX_INT_IN_DBL_STRING) (scan-number MAX_INT_IN_DBL_STRING) 0]
        [(+ 1 (int/u64 MAX_INT_IN_DBL_STRING)) (scan-number MAX_INT_IN_DBL_STRING) 1]
        [(int/s64 0) INF -1] [(int/u64 0) INF -1]
-       [MINUS_INF (int/u64 0) -1] [MINUS_INF (int/s64 0) -1] 
+       [MINUS_INF (int/u64 0) -1] [MINUS_INF (int/s64 0) -1]
        [(int/s64 1) NAN 0] [NAN (int/u64 1) 0]]]
   (each [x y c] compare-poly-tests
     (assert (= c (compare x y)) (string/format "compare polymorphic %q %q %d" x y c))))

test/suite0001.janet

@@ -137,6 +137,39 @@
   (assert (= a 1) "dictionary destructuring 3")
   (assert (= b 2) "dictionary destructuring 4")
   (assert (= c 4) "dictionary destructuring 5 - expression as key"))
+(let [test-tuple [:a :b 1 2]]
+  (def [a b one two] test-tuple)
+  (assert (= a :a) "tuple destructuring 1")
+  (assert (= b :b) "tuple destructuring 2")
+  (assert (= two 2) "tuple destructuring 3"))
+(let [test-tuple [:a :b 1 2]]
+  (def [a & rest] test-tuple)
+  (assert (= a :a) "tuple destructuring 4 - rest")
+  (assert (= rest [:b 1 2]) "tuple destructuring 5 - rest"))
+(do
+  (def [a b & rest] [:a :b nil :d])
+  (assert (= a :a) "tuple destructuring 6 - rest")
+  (assert (= b :b) "tuple destructuring 7 - rest")
+  (assert (= rest [nil :d]) "tuple destructuring 8 - rest"))
+(do
+  (def [[a b] x & rest] [[1 2] :a :c :b :a])
+  (assert (= a 1) "tuple destructuring 9 - rest")
+  (assert (= b 2) "tuple destructuring 10 - rest")
+  (assert (= x :a) "tuple destructuring 11 - rest")
+  (assert (= rest [:c :b :a]) "tuple destructuring 12 - rest"))
+(do
+  (def [a b & rest] [:a :b])
+  (assert (= a :a) "tuple destructuring 13 - rest")
+  (assert (= b :b) "tuple destructuring 14 - rest")
+  (assert (= rest []) "tuple destructuring 15 - rest"))
+
+(do
+  (def [[a b & r1] c & r2] [[:a :b 1 2] :c 3 4])
+  (assert (= a :a) "tuple destructuring 16 - rest")
+  (assert (= b :b) "tuple destructuring 17 - rest")
+  (assert (= c :c) "tuple destructuring 18 - rest")
+  (assert (= r1 [1 2]) "tuple destructuring 19 - rest")
+  (assert (= r2 [3 4]) "tuple destructuring 20 - rest"))
 
 # Marshal
 
@@ -288,6 +321,11 @@
 (assert (deep= (map + [1 2 3] [10 20 30] [100 200 300] [1000 2000 3000]) @[1111 2222 3333]))
 (assert (deep= (map + [1 2 3] [10 20 30] [100 200 300] [1000 2000 3000] [10000 20000 30000]) @[11111 22222 33333]))
 
+# Mapping uses the shortest sequence
+(assert (deep= (map + [1 2 3 4] [10 20 30]) @[11 22 33]))
+(assert (deep= (map + [1 2 3 4] [10 20 30] [100 200]) @[111 222]))
+(assert (deep= (map + [1 2 3 4] [10 20 30] [100 200] [1000]) @[1111]))
+
 # Sort function
 (assert (deep=
           (range 99)

test/suite0006.janet

@@ -39,6 +39,25 @@
    (def c (u64 "32rvv_vv_vv_vv"))
    (def d (u64 "123456789"))))
 
+# Conversion back to an int32
+(assert (= (int/to-number (u64 0xFaFa)) 0xFaFa))
+(assert (= (int/to-number (i64 0xFaFa)) 0xFaFa))
+(assert (= (int/to-number (u64 9007199254740991)) 9007199254740991))
+(assert (= (int/to-number (i64 9007199254740991)) 9007199254740991))
+(assert (= (int/to-number (i64 -9007199254740991)) -9007199254740991))
+
+(assert-error
+  "u64 out of bounds for safe integer"
+  (int/to-number (u64 "9007199254740993"))
+
+(assert-error
+  "s64 out of bounds for safe integer"
+  (int/to-number (i64 "-9007199254740993"))))
+
+(assert-error
+  "int/to-number fails on non-abstract types"
+  (int/to-number 1))
+
 (assert-no-error
  "create some int64 bigints"
  (do
@@ -72,6 +91,39 @@
  "trap INT64_MIN / -1"
  (:/ (int/s64 "-0x8000_0000_0000_0000") -1))
 
+# int/s64 and int/u64 serialization
+(assert (deep= (int/to-bytes (u64 0)) @"\x00\x00\x00\x00\x00\x00\x00\x00"))
+
+(assert (deep= (int/to-bytes (i64 1) :le) @"\x01\x00\x00\x00\x00\x00\x00\x00"))
+(assert (deep= (int/to-bytes (i64 1) :be) @"\x00\x00\x00\x00\x00\x00\x00\x01"))
+(assert (deep= (int/to-bytes (i64 -1)) @"\xFF\xFF\xFF\xFF\xFF\xFF\xFF\xFF"))
+(assert (deep= (int/to-bytes (i64 -5) :be) @"\xFF\xFF\xFF\xFF\xFF\xFF\xFF\xFB"))
+
+(assert (deep= (int/to-bytes (u64 1) :le) @"\x01\x00\x00\x00\x00\x00\x00\x00"))
+(assert (deep= (int/to-bytes (u64 1) :be) @"\x00\x00\x00\x00\x00\x00\x00\x01"))
+(assert (deep= (int/to-bytes (u64 300) :be) @"\x00\x00\x00\x00\x00\x00\x01\x2C"))
+
+# int/s64 int/u64 to existing buffer
+(let [buf1 @""
+      buf2 @"abcd"]
+  (assert (deep= (int/to-bytes (i64 1) :le buf1) @"\x01\x00\x00\x00\x00\x00\x00\x00"))
+  (assert (deep= buf1 @"\x01\x00\x00\x00\x00\x00\x00\x00"))
+  (assert (deep= (int/to-bytes (u64 300) :be buf2) @"abcd\x00\x00\x00\x00\x00\x00\x01\x2C")))
+
+# int/s64 and int/u64 paramater type checking
+(assert-error
+ "bad value passed to int/to-bytes"
+ (int/to-bytes 1))
+
+(assert-error
+  "invalid endianness passed to int/to-bytes"
+   (int/to-bytes (u64 0) :little))
+
+(assert-error
+  "invalid buffer passed to int/to-bytes"
+   (int/to-bytes (u64 0) :little :buffer))
+
+
 # Dynamic bindings
 (setdyn :a 10)
 (assert (= 40 (with-dyns [:a 25 :b 15] (+ (dyn :a) (dyn :b)))) "dyn usage 1")

test/suite0007.janet

@@ -168,6 +168,16 @@
 (assert (= (string out-buf) "Hello\nhi") "print and prin to buffer 1")
 (assert (= (string err-buf) "Sup\nnot much.") "eprint and eprin to buffer 1")
 
+# Printing to functions
+(def out-buf @"")
+(defn prepend [x]
+  (with-dyns [:out out-buf]
+    (prin "> " x)))
+(with-dyns [:out prepend]
+  (print "Hello world"))
+
+(assert (= (string out-buf) "> Hello world\n") "print to buffer via function")
+
 (assert (= (string '()) (string [])) "empty bracket tuple literal")
 
 # with-vars
@@ -308,8 +318,9 @@
 (assert (deep= (range 4) a) "eachk 1")
 
 
-(tracev (def my-unique-var-name true))
-(assert my-unique-var-name "tracev upscopes")
+(with-dyns [:err @""]
+  (tracev (def my-unique-var-name true))
+  (assert my-unique-var-name "tracev upscopes"))
 
 (assert (pos? (length (gensym))) "gensym not empty, regression #753")
 

test/suite0008.janet

@@ -106,6 +106,10 @@
 (assert (= nil (match {:a :hi} {:a a :b b} a)) "match 3")
 (assert (= nil (match [1 2] [a b c] a)) "match 4")
 (assert (= 2 (match [1 2] [a b] b)) "match 5")
+(assert (= [2 :a :b] (match [1 2 :a :b] [o & rest] rest)) "match 6")
+(assert (= [] (match @[:a] @[x & r] r :fallback)) "match 7")
+(assert (= :fallback (match @[1] @[x y & r] r :fallback)) "match 8")
+(assert (= [1 2 3 4] (match @[1 2 3 4] @[x y z & r] [x y z ;r] :fallback)) "match 9")
 
 # And/or checks
 
@@ -344,4 +348,12 @@ neldb\0\0\0\xD8\x05printG\x01\0\xDE\xDE\xDE'\x03\0marshal_tes/\x02
 (assert (deep= @[] (peg/match '(* "test" (any 1)) @"test")) "peg empty pattern 5")
 (assert (deep= @[] (peg/match '(* "test" (any 1)) (buffer "test"))) "peg empty pattern 6")
 
+# number pattern
+(assert (deep= @[111] (peg/match '(number :d+) "111")) "simple number capture 1")
+(assert (deep= @[255] (peg/match '(number :w+) "0xff")) "simple number capture 2")
+
+# quoted match test
+(assert (= :yes (match 'john 'john :yes _ :nope)) "quoted literal match 1")
+(assert (= :nope (match 'john ''john :yes _ :nope)) "quoted literal match 2")
+
 (end-suite)

test/suite0009.janet

@@ -115,8 +115,21 @@
    # Cast to string to enable comparison
    (assert (= "123\n456\n" (string (slurp "unique.txt"))) "File writing 4.2")
    (os/rm "unique.txt"))
-     
-# ev/gather
+
+# Test that the stream created by os/open can be read from
+(comment
+  (assert-no-error "File reading 1.1"
+    (def outstream (os/open "unique.txt" :wct))
+    (defer (:close outstream)
+      (:write outstream "123\n")
+      (:write outstream "456\n"))
+
+    (def outstream (os/open "unique.txt" :r))
+    (defer (:close outstream)
+      (assert (= "123\n456\n" (string (:read outstream :all))) "File reading 1.2"))
+    (os/rm "unique.txt")))
+
+  # ev/gather
 
 (assert (deep= @[1 2 3] (ev/gather 1 2 3)) "ev/gather 1")
 (assert (deep= @[] (ev/gather)) "ev/gather 2")
@@ -151,42 +164,27 @@
 
   (:close s))
 
+# Test on both server and client
+(defn names-handler
+  [stream]
+  (defer (:close stream)
+    # prevent immediate close
+    (ev/read stream 1)
+    (def [host port] (net/localname stream))
+    (assert (= host "127.0.0.1") "localname host server")
+    (assert (= port 8000) "localname port server")))
+
 # Test localname and peername
 (repeat 10
-  (defn check-matching-names [stream &opt direction]
-    "Checks that the remote agrees with the local about ip/port"
-    (let [[my-ip my-port]         (net/localname stream)
-          [remote-ip remote-port] (net/peername stream)
-          to-write                (string/join
-                                    @[my-ip (string my-port)
-                                      remote-ip (string remote-port)]
-                                    " ")
-          buffer                  @""]
-      (if (= direction :write)
-        (do (net/write stream to-write) (net/read stream 1024 buffer))
-        (do (net/read stream 1024 buffer) (net/write stream to-write)))
-      (def comparison (string/split " " buffer))
-      (assert (and (= my-ip (get comparison 2))
-                   (= (string my-port) (get comparison 3))
-                   (= remote-ip (get comparison 0))
-                   (= (string remote-port) (get comparison 1)))
-              "localname does not match peername")))
-  (defn names-handler
-    "Simple handler for connections."
-    [stream]
-    (defer (:close stream)
-      (check-matching-names stream)))
-
-  (def s (net/server "127.0.0.1" "8000" names-handler))
-  (assert s "made server 1")
-
-  (defn test-names []
-    (with [conn (net/connect "127.0.0.1" "8000")]
-          (check-matching-names conn :write)))
-
-  (test-names)
-  (test-names)
-  (:close s))
+  (with [s (net/server "127.0.0.1" "8000" names-handler)]
+    (repeat 10
+      (with [conn (net/connect "127.0.0.1" "8000")]
+        (def [host port] (net/peername conn))
+        (assert (= host "127.0.0.1") "peername host client ")
+        (assert (= port 8000) "peername port client")
+        # let server close
+        (ev/write conn " "))))
+  (gccollect))
 
 # Create pipe
 
@@ -258,4 +256,13 @@
 (ev/rselect c2)
 (assert (= (slice arr) (slice (range 100))) "ev/chan-close 3")
 
+# threaded channels
+
+(def ch (ev/thread-chan 2))
+(def att (ev/thread-chan 109))
+(assert att "`att` was nil after creation")
+(ev/give ch att)
+(ev/do-thread
+  (assert (ev/take ch) "channel packing bug for threaded abstracts on threaded channels."))
+
 (end-suite)

test/suite0010.janet

@@ -161,10 +161,59 @@
            ([err] :caught))))
     "regression #638"))
 
+
+# Struct prototypes
+(def x (struct/with-proto {1 2 3 4} 5 6))
+(def y (-> x marshal unmarshal))
+(def z {1 2 3 4})
+(assert (= 2 (get x 1)) "struct get proto value 1")
+(assert (= 4 (get x 3)) "struct get proto value 2")
+(assert (= 6 (get x 5)) "struct get proto value 3")
+(assert (= x y) "struct proto marshal equality 1")
+(assert (= (getproto x) (getproto y)) "struct proto marshal equality 2")
+(assert (= 0 (cmp x y)) "struct proto comparison 1")
+(assert (= 0 (cmp (getproto x) (getproto y))) "struct proto comparison 2")
+(assert (not= (cmp x z) 0) "struct proto comparison 3")
+(assert (not= (cmp y z) 0) "struct proto comparison 4")
+(assert (not= x z) "struct proto comparison 5")
+(assert (not= y z) "struct proto comparison 6")
+(assert (= (x 5) 6) "struct proto get 1")
+(assert (= (y 5) 6) "struct proto get 1")
+(assert (deep= x y) "struct proto deep= 1")
+(assert (deep-not= x z) "struct proto deep= 2")
+(assert (deep-not= y z) "struct proto deep= 3")
+
 # Issue #751
 (def t {:side false})
 (assert (nil? (get-in t [:side :note])) "get-in with false value")
 (assert (= (get-in t [:side :note] "dflt") "dflt")
         "get-in with false value and default")
 
+(assert (= (math/gcd 462 1071) 21) "math/gcd 1")
+(assert (= (math/lcm 462 1071) 23562) "math/lcm 1")
+
+# Evaluate stream with `dofile`
+(def [r w] (os/pipe))
+(:write w "(setdyn :x 10)")
+(:close w)
+(def stream-env (dofile r))
+(assert (= (stream-env :x) 10) "dofile stream 1")
+
+# Issue #861 - should be valgrind clean
+(def step1 "(a b c d)\n")
+(def step2 "(a b)\n")
+(def p1 (parser/new))
+(parser/state p1)
+(parser/consume p1 step1)
+(loop [v :iterate (parser/produce p1)])
+(parser/state p1)
+(def p2 (parser/clone p1))
+(parser/state p2)
+(parser/consume p2 step2)
+(loop [v :iterate (parser/produce p2)])
+(parser/state p2)
+
+# Check missing struct proto bug.
+(assert (struct/getproto (struct/with-proto {:a 1} :b 2 :c nil)) "missing struct proto")
+
 (end-suite)

test/suite0011.janet

@@ -0,0 +1,106 @@
+# Copyright (c) 2022 Calvin Rose & contributors
+#
+# Permission is hereby granted, free of charge, to any person obtaining a copy
+# of this software and associated documentation files (the "Software"), to
+# deal in the Software without restriction, including without limitation the
+# rights to use, copy, modify, merge, publish, distribute, sublicense, and/or
+# sell copies of the Software, and to permit persons to whom the Software is
+# furnished to do so, subject to the following conditions:
+#
+# The above copyright notice and this permission notice shall be included in
+# all copies or substantial portions of the Software.
+#
+# THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+# IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+# FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
+# AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
+# LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
+# FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS
+# IN THE SOFTWARE.
+
+(import ./helper :prefix "" :exit true)
+(start-suite 11)
+
+# math gamma
+
+(assert (< 11899423.08 (math/gamma 11.5) 11899423.085) "math/gamma")
+(assert (< 2605.1158 (math/log-gamma 500) 2605.1159) "math/log-gamma")
+
+# missing symbols
+
+(defn lookup-symbol [sym] (defglobal sym 10) (dyn sym))
+
+(setdyn :missing-symbol lookup-symbol)
+
+(assert (= (eval-string "(+ a 5)") 15) "lookup missing symbol")
+
+(setdyn :missing-symbol nil)
+(setdyn 'a nil)
+
+(assert-error "compile error" (eval-string "(+ a 5)"))
+
+# 919
+(defn test
+  []
+  (var x 1)
+  (set x ~(,x ()))
+  x)
+
+(assert (= (test) '(1 ())) "issue #919")
+
+(assert (= (hash 0) (hash (* -1 0))) "hash -0 same as hash 0")
+
+# os/execute regressions
+(for i 0 10
+  (assert (= i (os/execute [(dyn :executable) "-e" (string/format "(os/exit %d)" i)] :p)) (string "os/execute " i)))
+
+# to/thru bug
+(def pattern
+  (peg/compile
+    '{:dd (sequence :d :d)
+      :sep (set "/-")
+      :date (sequence :dd :sep :dd)
+      :wsep (some (set " \t"))
+      :entry (group (sequence (capture :date) :wsep (capture :date)))
+      :main (some (thru :entry))}))
+
+(def alt-pattern
+  (peg/compile
+    '{:dd (sequence :d :d)
+      :sep (set "/-")
+      :date (sequence :dd :sep :dd)
+      :wsep (some (set " \t"))
+      :entry (group (sequence (capture :date) :wsep (capture :date)))
+      :main (some (choice :entry 1))}))
+
+(def text "1800-10-818-9-818 16/12\n17/12 19/12\n20/12 11/01")
+(assert (deep= (peg/match pattern text) (peg/match alt-pattern text)) "to/thru bug #971")
+
+(assert-error
+  "table rawget regression"
+  (table/new -1))
+
+# Named arguments
+(defn named-arguments
+  [&named bob sally joe]
+  (+ bob sally joe))
+
+(assert (= 15 (named-arguments :bob 3 :sally 5 :joe 7)) "named arguments 1")
+
+(defn named-opt-arguments
+  [&opt x &named a b c]
+  (+ x a b c))
+
+(assert (= 10 (named-opt-arguments 1 :a 2 :b 3 :c 4)) "named arguments 2")
+
+(let [b @""]
+  (defn dummy [a b c]
+    (+ a b c))
+  (trace dummy)
+  (defn errout [arg]
+    (buffer/push b arg))
+  (assert (= 6 (with-dyns [*err* errout] (dummy 1 2 3))) "trace to custom err function")
+  (assert (deep= @"trace (dummy 1 2 3)\n" b) "trace buffer correct"))
+
+(end-suite)
+

test/suite0012.janet

@@ -0,0 +1,54 @@
+# Copyright (c) 2022 Calvin Rose & contributors
+#
+# Permission is hereby granted, free of charge, to any person obtaining a copy
+# of this software and associated documentation files (the "Software"), to
+# deal in the Software without restriction, including without limitation the
+# rights to use, copy, modify, merge, publish, distribute, sublicense, and/or
+# sell copies of the Software, and to permit persons to whom the Software is
+# furnished to do so, subject to the following conditions:
+#
+# The above copyright notice and this permission notice shall be included in
+# all copies or substantial portions of the Software.
+#
+# THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+# IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+# FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
+# AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
+# LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
+# FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS
+# IN THE SOFTWARE.
+
+(import ./helper :prefix "" :exit true)
+(start-suite 12)
+
+(var counter 0)
+(def thunk (delay (++ counter)))
+(assert (= (thunk) 1) "delay 1")
+(assert (= counter 1) "delay 2")
+(assert (= (thunk) 1) "delay 3")
+(assert (= counter 1) "delay 4")
+
+(def has-ffi (dyn 'ffi/native))
+
+# FFI check
+(compwhen has-ffi
+  (ffi/context))
+(compwhen has-ffi
+  (ffi/defbind memcpy :ptr [dest :ptr src :ptr n :size]))
+(compwhen has-ffi
+  (def buffer1 @"aaaa")
+  (def buffer2 @"bbbb")
+  (memcpy buffer1 buffer2 4)
+  (assert (= (string buffer1) "bbbb") "ffi 1 - memcpy"))
+
+(compwhen has-ffi
+  (assert (= 8 (ffi/size [:int :char])) "size unpacked struct 1")
+  (assert (= 5 (ffi/size [:pack :int :char])) "size packed struct 1")
+  (assert (= 5 (ffi/size [:int :pack-all :char])) "size packed struct 2")
+  (assert (= 4 (ffi/align [:int :char])) "align 1")
+  (assert (= 1 (ffi/align [:pack :int :char])) "align 2")
+  (assert (= 1 (ffi/align [:int :char :pack-all])) "align 3")
+  (assert (= 26 (ffi/size [:char :pack :int @[:char 21]])) "array struct size"))
+
+(end-suite)
+

test/suite0013.janet

@@ -0,0 +1,30 @@
+# Copyright (c) 2022 Calvin Rose & contributors
+#
+# Permission is hereby granted, free of charge, to any person obtaining a copy
+# of this software and associated documentation files (the "Software"), to
+# deal in the Software without restriction, including without limitation the
+# rights to use, copy, modify, merge, publish, distribute, sublicense, and/or
+# sell copies of the Software, and to permit persons to whom the Software is
+# furnished to do so, subject to the following conditions:
+#
+# The above copyright notice and this permission notice shall be included in
+# all copies or substantial portions of the Software.
+#
+# THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+# IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+# FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
+# AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
+# LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
+# FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS
+# IN THE SOFTWARE.
+
+(import ./helper :prefix "" :exit true)
+(start-suite 13)
+
+(assert (deep= (tabseq [i :in (range 3)] i (* 3 i))
+               @{0 0 1 3 2 6}))
+
+(assert (deep= (tabseq [i :in (range 3)] i)
+               @{}))
+
+(end-suite)

tools/format.sh

@@ -3,8 +3,11 @@
 # Format all code with astyle
 
 STYLEOPTS="--style=attach --indent-switches --convert-tabs \
-		  --align-pointer=name --pad-header --pad-oper --unpad-paren --indent-labels"
+		  --align-pointer=name --pad-header --pad-oper --unpad-paren --indent-labels --formatted"
 
 astyle $STYLEOPTS */*.c
 astyle $STYLEOPTS */*/*.c
 astyle $STYLEOPTS */*/*.h
+rm -f */*.c.orig
+rm -f */*/*.c.orig
+rm -f */*/*.h.orig

tools/hashbench/ints1.janet

@@ -0,0 +1,24 @@
+(def f @{})
+(var collisions 0)
+(loop [x :range [0 300] y :range [0 300]]  
+  (def key (hash (+ (* x 1000) y))) 
+  (if (in f key) 
+    (++ collisions)) 
+  (put f key true))
+(print "ints 1 collisions: " collisions)
+
+(def f @{})
+(var collisions 0)
+(loop [x :range [100000 101000] y :range [100000 101000]]
+  (def key (hash [x y]))
+  (if (in f key) (++ collisions))
+  (put f key true))
+(print "int pair 1 collisions: " collisions)
+
+(def f @{})
+(var collisions 0)
+(loop [x :range [10000 11000] y :range [10000 11000]]
+  (def key (hash [x y]))
+  (if (in f key) (++ collisions))
+  (put f key true))
+(print "int pair 2 collisions: " collisions)

tools/tm_lang_gen.janet

@@ -17,6 +17,7 @@
       "quote"
       "quasiquote"
       "unquote"
+      "upscope"
       "splice"]
     (all-bindings)))
 (def allsyms (dyn :allsyms))