Release patch relase due to bad version bumping.

Mac clock shim not needed after 10.12

.github/workflows/release.yml

@@ -33,3 +33,23 @@ jobs:
             build/janet.h
             build/c/janet.c
             build/c/shell.c
+
+  release-windows:
+    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

.gitignore

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

CHANGELOG.md

@@ -1,6 +1,61 @@
 # Changelog
 All notable changes to this project will be documented in this file.
 
+## 1.21.1 - 2022-03-27
+- 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 +63,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

Makefile

@@ -62,11 +62,18 @@ ifeq ($(UNAME), Darwin)
 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
@@ -120,7 +127,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 +165,7 @@ build/c/janet.c: build/janet_boot src/boot/boot.janet
 ##### Amalgamation #####
 ########################
 
-SONAME=libjanet.so.1.17
+SONAME=libjanet.so.1.20
 
 build/c/shell.c: src/mainclient/shell.c
 	cp $< $@
@@ -232,6 +238,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)/

README.md

@@ -1,6 +1,5 @@
 [![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?)
 [![Actions Status](https://github.com/janet-lang/janet/actions/workflows/test.yml/badge.svg)](https://github.com/janet-lang/janet/actions/workflows/test.yml)
@@ -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
@@ -238,6 +240,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 +294,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/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.21.0')
 
 # Global settings
 janet_path = join_paths(get_option('prefix'), get_option('libdir'), 'janet')
@@ -30,6 +30,7 @@ header_path = join_paths(get_option('prefix'), get_option('includedir'), 'janet'
 cc = meson.get_compiler('c')
 m_dep = cc.find_library('m', required : false)
 dl_dep = cc.find_library('dl', required : false)
+android_spawn_dep = cc.find_library('android-spawn', required : false)
 thread_dep = dependency('threads')
 
 # Link options
@@ -74,7 +75,6 @@ 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'))
 if get_option('os_name') != ''
   conf.set('JANET_OS_NAME', get_option('os_name'))
@@ -136,7 +136,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 +161,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 +174,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

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)

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

@@ -51,7 +51,7 @@
   ``Use a function or macro literal `f` as a macro. This lets
   any function be used as a macro. Inside a quasiquote, the
   idiom `(as-macro ,my-custom-macro arg1 arg2...)` can be used
-  to avoid unwanted variable capture.``
+  to avoid unwanted variable capture of `my-custom-macro`.``
   [f & args]
   (f ;args))
 
@@ -532,16 +532,19 @@
 
 (defmacro loop
   ```
-  A general purpose loop macro. This macro is similar to the Common Lisp
-  loop macro, although intentionally much smaller in scope.
-  The head of the loop should be a tuple that contains a sequence of
-  either bindings or conditionals. A binding is a sequence of three values
-  that define something to loop over. They are formatted like:
+  A general purpose loop macro. This macro is similar to the Common Lisp loop
+  macro, although intentionally much smaller in scope.  The head of the loop
+  should be a tuple that contains a sequence of either bindings or
+  conditionals. A binding is a sequence of three values that define something
+  to loop over. Bindings are written in the format:
 
       binding :verb object/expression
 
-  Where `binding` is a binding as passed to def, `:verb` is one of a set of
-  keywords, and `object` is any expression. The available verbs are:
+  where `binding` is a binding as passed to def, `:verb` is one of a set of
+  keywords, and `object` is any expression. Each subsequent binding creates a
+  nested loop within the loop created by the previous binding.
+
+  The available verbs are:
 
   * `:iterate` - repeatedly evaluate and bind to the expression while it is
     truthy.
@@ -565,14 +568,19 @@
   where `:modifier` is one of a set of keywords, and `argument` is keyword-dependent.
   `:modifier` can be one of:
 
-  * `:while expression` - breaks from the loop if `expression` is falsey.
-  * `:until expression` - breaks from the loop if `expression` is truthy.
-  * `:let bindings` - defines bindings inside the loop as passed to the `let` macro.
-  * `:before form` - evaluates a form for a side effect before the next inner loop.
-  * `:after form` - same as `:before`, but the side effect happens after the next inner loop.
+  * `:while expression` - breaks from the current loop if `expression` is
+    falsey.
+  * `:until expression` - breaks from the current loop if `expression` is
+    truthy.
+  * `:let bindings` - defines bindings inside the current loop as passed to the
+    `let` macro.
+  * `:before form` - evaluates a form for a side effect before the next inner
+    loop.
+  * `:after form` - same as `:before`, but the side effect happens after the
+    next inner loop.
   * `:repeat n` - repeats the next inner loop `n` times.
-    lets try putting a loop item on multiple lines.
-  * `:when condition` - only evaluates the loop body when condition is true.
+  * `:when condition` - only evaluates the current loop body when `condition`
+    is true.
 
   The `loop` macro always evaluates to nil.
   ```
@@ -698,6 +706,14 @@
   "Returns the numeric minimum of the arguments."
   [& args] (extreme < args))
 
+(defn max-of
+  "Returns the numeric maximum of the argument sequence."
+  [args] (extreme > args))
+
+(defn min-of
+  "Returns the numeric minimum of the argument sequence."
+  [args] (extreme < args))
+
 (defn first
   "Get the first element from an indexed data structure."
   [xs]
@@ -900,7 +916,7 @@
         (while true
           (if (= nil (set k1 (next i1 k1))) (break))
           (if (= nil (set k2 (next i2 k2))) (break))
-          (if (= nil (set k3 (next i2 k3))) (break))
+          (if (= nil (set k3 (next i3 k3))) (break))
           (array/push res (f (in i1 k1) (in i2 k2) (in i3 k3)))))
     4 (do
         (var k1 nil)
@@ -910,8 +926,8 @@
         (while true
           (if (= nil (set k1 (next i1 k1))) (break))
           (if (= nil (set k2 (next i2 k2))) (break))
-          (if (= nil (set k3 (next i2 k3))) (break))
-          (if (= nil (set k4 (next i2 k4))) (break))
+          (if (= nil (set k3 (next i3 k3))) (break))
+          (if (= nil (set k4 (next i4 k4))) (break))
           (array/push res (f (in i1 k1) (in i2 k2) (in i3 k3) (in i4 k4)))))
     (do
       (def iterkeys (array/new-filled ninds))
@@ -1139,12 +1155,36 @@
     (array/push parts (tuple apply f $args)))
   (tuple 'fn (tuple '& $args) (tuple/slice parts 0)))
 
+(defmacro defdyn
+  ``Define an alias for a keyword that is used as a dynamic binding. The
+  alias is a normal, lexically scoped binding that can be used instead of
+  a keyword to prevent typos. Defdyn does not set dynamic bindings or otherwise
+  replace `dyn` and `setdyn`. The alias _must_ start and end with the `*` character, usually
+  called "earmuffs".``
+  [alias & more]
+  (assert (symbol? alias) "alias must be a symbol")
+  (assert (and (> (length alias) 2) (= 42 (first alias) (last alias))) "name must have leading and trailing '*' characters")
+  (def prefix (dyn :defdyn-prefix))
+  (def kw (keyword prefix (slice alias 1 -2)))
+  ~(def ,alias :dyn ,;more ,kw))
+
+(defdyn *defdyn-prefix* "Optional namespace prefix to add to keywords declared with `defdyn`.
+  Use this to prevent keyword collisions between dynamic bindings.")
+(defdyn *out* "Where normal print functions print output to.")
+(defdyn *err* "Where error printing prints output to.")
+
+(defdyn *macro-form*
+  "Inside a macro, is bound to the source form that invoked the macro")
+
+(defdyn *current-file*
+  "Bound to the name of the currently compiling file.")
+
 (defmacro tracev
   `Print a value and a description of the form that produced that value to
   stderr. Evaluates to x.`
   [x]
-  (def [l c] (tuple/sourcemap (dyn :macro-form ())))
-  (def cf (dyn :current-file))
+  (def [l c] (tuple/sourcemap (dyn *macro-form* ())))
+  (def cf (dyn *current-file*))
   (def fmt-1 (if cf (string/format "trace [%s]" cf) "trace"))
   (def fmt-2 (if (or (neg? l) (neg? c)) ":" (string/format " on line %d, column %d:" l c)))
   (def fmt (string fmt-1 fmt-2 " %j is "))
@@ -1639,10 +1679,13 @@
   (file/close f)
   nil)
 
+(defdyn *pretty-format*
+  "Format specifier for the `pp` function")
+
 (defn pp
-  `Pretty print to stdout or (dyn :out). The format string used is (dyn :pretty-format "%q").`
+  `Pretty print to stdout or (dyn *out*). The format string used is (dyn *pretty-format* "%q").`
   [x]
-  (printf (dyn :pretty-format "%q") x)
+  (printf (dyn *pretty-format* "%q") x)
   (flush))
 
 ###
@@ -1660,8 +1703,9 @@
   * symbol -- a pattern that is a symbol will match anything, binding `x`'s
     value to that symbol.
 
-  * array -- an array will match only if all of its elements match the
-    corresponding elements in `x`.
+  * array or bracket tuple -- an array or bracket tuple will match only if
+    all of its elements match the corresponding elements in `x`.
+    Use `& rest` at the end of an array or bracketed tuple to bind all remaining values to `rest`.
 
   * table or struct -- a table or struct will match if all values match with
     the corresponding values in `x`.
@@ -1677,6 +1721,8 @@
   already bound to `<sym>`, rather than matching and rebinding it.
 
   Any other value pattern will only match if it is equal to `x`.
+  Quoting a pattern with `'` will also treat the value as a literal value to match against.
+
   ```
   [x & cases]
 
@@ -1728,11 +1774,31 @@
         (array/push x s)
         (put b2g pattern @[s]))
 
+      # match quoted literal
+      (and (= t :tuple) (= 2 (length pattern)) (= 'quote (pattern 0)))
+      (break)
+
       # match data structure template
-      (or isarr (= t :struct) (= t :table))
+      (or (= t :struct) (= t :table))
+      (eachp [i sub-pattern] pattern
+        (visit-pattern-1 b2g s i sub-pattern))
+
+      isarr
       (do
-        (when isarr (get-length-sym s))
+        (get-length-sym s)
         (eachp [i sub-pattern] pattern
+          (when (= sub-pattern '&)
+            (when (<= (length pattern) (inc i))
+              (errorf "expected symbol following & in pattern"))
+
+            (when (< (+ i 2) (length pattern))
+              (errorf "expected a single symbol follow '& in pattern, found %q" (slice pattern (inc i))))
+
+            (when (not= (type (pattern (inc i))) :symbol)
+              (errorf "expected symbol following & in pattern, found %q" (pattern (inc i))))
+
+            (put b2g (pattern (inc i)) @[[slice s i]])
+            (break))
           (visit-pattern-1 b2g s i sub-pattern)))
 
       # match global unification
@@ -1752,19 +1818,33 @@
     (def isarr (or (= t :array) (and (= t :tuple) (= (tuple/type pattern) :brackets))))
     (when isarr
       (array/push anda (get-length-sym s))
-      (array/push anda [<= (length pattern) (get-length-sym s)]))
+      (def pattern-len
+        (if-let [ rest-idx (find-index (fn [x] (= x '&)) pattern) ]
+          rest-idx
+          (length pattern)))
+      (array/push anda [<= pattern-len (get-length-sym s)]))
     (cond
 
       # match data structure template
-      (or isarr (= t :struct) (= t :table))
+      (or (= t :struct) (= t :table))
       (eachp [i sub-pattern] pattern
-        (when (not isarr)
-          (array/push anda [not= nil (get-sym s i)]))
+        (array/push anda [not= nil (get-sym s i)])
+        (visit-pattern-2 anda gun preds s i sub-pattern))
+      
+      isarr
+      (eachp [i sub-pattern] pattern
+        # stop recursing to sub-patterns if the rest sigil is found
+        (when (= sub-pattern '&)
+          (break))
         (visit-pattern-2 anda gun preds s i sub-pattern))
 
       # match local binding
       (= t :symbol) (break)
 
+      # match quoted literal
+      (and (= t :tuple) (= 2 (length pattern)) (= 'quote (pattern 0)))
+      (array/push anda ['= s pattern])
+
       # match global unification
       (and (= t :tuple) (= 2 (length pattern)) (= '@ (pattern 0)))
       (if-let [x (in gun (pattern 1))]
@@ -1829,13 +1909,17 @@
 ###
 ###
 
+(defdyn *macro-lints*
+  "Bound to an array of lint messgae that will be reported by the compiler inside a macro.
+  To indicate an error or warning, a macro author should use `maclintf`.")
+
 (defn maclintf
   ``When inside a macro, call this function to add a linter warning. Takes
   a `fmt` argument like `string/format` which is used to format the message.``
   [level fmt & args]
-  (def lints (dyn :macro-lints))
+  (def lints (dyn *macro-lints*))
   (when lints
-    (def form (dyn :macro-form))
+    (def form (dyn *macro-form*))
     (def [l c] (if (tuple? form) (tuple/sourcemap form) [nil nil]))
     (def l (if-not (= -1 l) l))
     (def c (if-not (= -1 c) c))
@@ -1926,11 +2010,11 @@
     (def h (in t 0))
     (def s (in specs h))
     (def entry (or (dyn h) {}))
-    (def m (entry :value))
-    (def m? (entry :macro))
+    (def m (do (def r (get entry :ref)) (if r (in r 0) (get entry :value))))
+    (def m? (in entry :macro))
     (cond
       s (s t)
-      m? (do (setdyn :macro-form t) (m ;(tuple/slice t 1)))
+      m? (do (setdyn *macro-form* t) (m ;(tuple/slice t 1)))
       (tuple/slice (map recur t))))
 
   (def ret
@@ -2047,7 +2131,7 @@
   ```
   Shorthand for fn. Arguments are given as $n, where n is the 0-indexed
   argument of the function. $ is also an alias for the first (index 0) argument.
-  The $& symbol will make the anonymous function variadic if it apears in the
+  The $& symbol will make the anonymous function variadic if it appears in the
   body of the function - it can be combined with positional arguments.
 
   Example usage:
@@ -2138,10 +2222,13 @@
   (def newenv (table/setproto @{} parent))
   newenv)
 
+(defdyn *err-color*
+  "Whether or not to turn on error coloring in stacktraces and other error messages.")
+
 (defn bad-parse
   "Default handler for a parse error."
   [p where]
-  (def ec (dyn :err-color))
+  (def ec (dyn *err-color*))
   (def [line col] (:where p))
   (eprint
     (if ec "\e[31m" "")
@@ -2160,24 +2247,25 @@
   the file, prints nothing."
   [where line col]
   (if-not line (break))
+  (unless (string? where) (break))
   (when-with [f (file/open where :r)]
     (def source-code (file/read f :all))
     (var index 0)
     (repeat (dec line)
        (if-not index (break))
-       (set index (inc (string/find "\n" source-code index))))
+       (set index (string/find "\n" source-code index))
+       (if index (++ index)))
     (when index
       (def line-end (string/find "\n" source-code index))
       (eprint "  " (string/slice source-code index line-end))
       (when col
         (+= index col)
-        (eprint (string/repeat " " (inc col)) "^"))
-      (eflush))))
+        (eprint (string/repeat " " (inc col)) "^")))))
 
 (defn warn-compile
   "Default handler for a compile warning"
   [msg level where &opt line col]
-  (def ec (dyn :err-color))
+  (def ec (dyn *err-color*))
   (eprin
     (if ec "\e[33m" "")
     where
@@ -2195,7 +2283,7 @@
 (defn bad-compile
   "Default handler for a compile error."
   [msg macrof where &opt line col]
-  (def ec (dyn :err-color))
+  (def ec (dyn *err-color*))
   (eprin
     (if ec "\e[31m" "")
     where
@@ -2205,7 +2293,7 @@
     col
     ": compile error: ")
   (if macrof
-    (debug/stacktrace macrof msg)
+    (debug/stacktrace macrof msg "")
     (eprint msg))
   (when ec
     (print-line-col where line col)
@@ -2237,7 +2325,7 @@
     * `:chunks` - callback to read into a buffer - default is getline
     * `:on-parse-error` - callback when parsing fails - default is bad-parse
     * `:env` - the environment to compile against - default is the current env
-    * `:source` - string path of source for better errors - default is "<anonymous>"
+    * `:source` - source path for better errors (use keywords for non-paths) - default is :<anonymous>
     * `:on-compile-error` - callback when compilation fails - default is bad-compile
     * `:on-compile-warning` - callback for any linting error - default is warn-compile
     * `:evaluator` - callback that executes thunks. Signature is (evaluator thunk source env where)
@@ -2269,11 +2357,14 @@
   (default on-compile-warning warn-compile)
   (default on-parse-error bad-parse)
   (default evaluator (fn evaluate [x &] (x)))
-  (default default-where "<anonymous>")
+  (default default-where :<anonymous>)
   (default guard :ydt)
 
   (var where default-where)
 
+  (if (string? where)
+    (put env *current-file* where))
+
   # Evaluate 1 source form in a protected manner
   (def lints @[])
   (defn eval1 [source &opt l c]
@@ -2351,9 +2442,10 @@
         (buffer/clear buf))
 
       [:source new-where]
-      (if (string? new-where)
+      (do
         (set where new-where)
-        (set where default-where))
+        (if (string? new-where)
+          (put env *current-file* new-where)))
 
       (do
         (var pindex 0)
@@ -2414,14 +2506,14 @@
                              (if-not (= (fiber/status f) :dead)
                                (error val))
                              (set returnval val))
-                :source "eval-string"})
+                :source :eval-string})
   returnval)
 
 (defn eval
   ``Evaluates a form in the current environment. If more control over the
   environment is needed, use `run-context`.``
   [form]
-  (def res (compile form (fiber/getenv (fiber/current)) "eval"))
+  (def res (compile form (fiber/getenv (fiber/current)) :eval))
   (if (= (type res) :function)
     (res)
     (error (get res :error))))
@@ -2582,8 +2674,8 @@
   @{})
 
 (defn dofile
-  `Evaluate a file and return the resulting environment. :env, :expander,
-  :evaluator, :read, and :parser are passed through to the underlying
+  `Evaluate a file, file path, or stream and return the resulting environment. :env, :expander,
+  :source, :evaluator, :read, and :parser are passed through to the underlying
   run-context call. If exit is true, any top level errors will trigger a
   call to (os/exit 1) after printing the error.`
   [path &keys
@@ -2594,24 +2686,24 @@
     :evaluator evaluator
     :read read
     :parser parser}]
-  (def f (if (= (type path) :core/file)
-           path
+  (def f (case (type path)
+           :core/file path
+           :core/stream path
            (file/open path :rb)))
   (def path-is-file (= f path))
   (default env (make-env))
   (def spath (string path))
-  (put env :current-file (or src (if-not path-is-file spath)))
   (put env :source (or src (if-not path-is-file spath path)))
   (var exit-error nil)
   (var exit-fiber nil)
-  (defn chunks [buf _] (file/read f 4096 buf))
+  (defn chunks [buf _] (:read f 4096 buf))
   (defn bp [&opt x y]
     (when exit
       (bad-parse x y)
       (os/exit 1))
     (put env :exit true)
     (def buf @"")
-    (with-dyns [:err buf :err-color false]
+    (with-dyns [*err* buf *err-color* false]
       (bad-parse x y))
     (set exit-error (string/slice buf 0 -2)))
   (defn bc [&opt x y z a b]
@@ -2620,7 +2712,7 @@
       (os/exit 1))
     (put env :exit true)
     (def buf @"")
-    (with-dyns [:err buf :err-color false]
+    (with-dyns [*err* buf *err-color* false]
       (bad-compile x nil z a b))
     (set exit-error (string/slice buf 0 -2))
     (set exit-fiber y))
@@ -2634,8 +2726,7 @@
                   :on-status (fn [f x]
                                (when (not= (fiber/status f) :dead)
                                  (when exit
-                                   (eprint x)
-                                   (debug/stacktrace f)
+                                   (debug/stacktrace f x "")
                                    (eflush)
                                    (os/exit 1))
                                  (put env :exit true)
@@ -2645,8 +2736,8 @@
                   :expander expander
                   :read read
                   :parser parser
-                  :source (or src (if path-is-file "<anonymous>" spath))}))
-  (if-not path-is-file (file/close f))
+                  :source (or src (if path-is-file :<anonymous> spath))}))
+  (if-not path-is-file (:close f))
   (when exit-error
     (if exit-fiber
       (propagate exit-error exit-fiber)
@@ -2770,6 +2861,12 @@
   [&opt env local]
   (env-walk keyword? env local))
 
+(defdyn *doc-width*
+  "Width in columns to print documentation printed with `doc-format`")
+
+(defdyn *doc-color*
+  "Whether or not to colorize documentation printed with `doc-format`.")
+
 (defn doc-format
   `Reformat a docstring to wrap a certain width. Docstrings can either be plaintext
   or a subset of markdown. This allows a long single line of prose or formatted text to be
@@ -2777,10 +2874,10 @@
   [str &opt width indent colorize]
 
   (default indent 4)
-  (def max-width (- (or width (dyn :doc-width 80)) 8))
+  (def max-width (- (or width (dyn *doc-width* 80)) 8))
   (def has-color (if (not= nil colorize)
                    colorize
-                   (dyn :doc-color)))
+                   (dyn *doc-color*)))
 
   # Terminal codes for emission/tokenization
   (def delimiters
@@ -3048,6 +3145,7 @@
   (def bind-type
     (string "    "
             (cond
+              (x :redef) (type (in (x :ref) 0))
               (x :ref) (string :var " (" (type (in (x :ref) 0)) ")")
               (x :macro) :macro
               (x :module) (string :module " (" (x :kind) ")")
@@ -3056,7 +3154,7 @@
   (def sm (x :source-map))
   (def d (x :doc))
   (print "\n\n"
-         (when d bind-type)
+         bind-type
          (when-let [[path line col] sm]
            (string "    " path (when (and line col) (string " on line " line ", column " col))))
          (when sm "\n")
@@ -3142,7 +3240,7 @@
   "Print the current fiber stack"
   []
   (print)
-  (with-dyns [:err-color false] (debug/stacktrace (.fiber) (.signal)))
+  (with-dyns [*err-color* false] (debug/stacktrace (.fiber) (.signal) ""))
   (print))
 
 (defn .frame
@@ -3339,9 +3437,7 @@
           (printf (get e :pretty-format "%q") x)
           (flush))
         (do
-          (def ec (dyn :err-color))
-          (eprint (if ec "\e[31m" "") fs ": " x)
-          (debug/stacktrace f)
+          (debug/stacktrace f x "")
           (eflush)
           (if (e :debug) (enter-debugger f x))))))
 
@@ -3350,7 +3446,7 @@
                 :on-status (or onsignal (make-onsignal env 1))
                 :parser parser
                 :read read
-                :source "repl"}))
+                :source :repl}))
 
 ###
 ###
@@ -3492,13 +3588,17 @@
   arbitrary execution is possible. Other arguments are the same as dofile. `path` can also be
   a file value such as stdin. Returns nil.``
   [path &keys kwargs]
+  (def old-modcache (table/clone module/cache))
+  (table/clear module/cache)
   (try
     (dofile path :evaluator flycheck-evaluator ;(kvs kwargs))
     ([e f]
-     (eprint e)
-     (debug/stacktrace f)))
+     (debug/stacktrace f e "")))
+  (table/clear module/cache)
+  (merge-into module/cache old-modcache)
   nil)
 
+
 ###
 ###
 ### CLI Tool Main
@@ -3508,27 +3608,45 @@
 # conditional compilation for reduced os
 (def- getenv-alias (if-let [entry (in root-env 'os/getenv)] (entry :value) (fn [&])))
 
+(defn- run-main
+  [env subargs arg]
+  (if-let [entry (in env 'main)
+           main (or (get entry :value) (in (get entry :ref) 0))]
+    (let [thunk (compile [main ;subargs] env arg)]
+      (if (function? thunk) (thunk) (error (thunk :error))))))
+
+(defdyn *args*
+  "Dynamic bindings that will contain command line arguments at program start")
+
+(defdyn *executable*
+  "Name of the interpreter executable used to execute this program. Corresponds to argv[0] in the call to
+   int main(int argc, char **argv);")
+
+(defdyn *profilepath*
+  "Path to profile file loaded when starting up the repl.")
+
 (defn cli-main
   `Entrance for the Janet CLI tool. Call this function with the command line
   arguments as an array or tuple of strings to invoke the CLI interface.`
   [args]
 
-  (setdyn :args args)
+  (setdyn *args* args)
 
-  (var *should-repl* false)
-  (var *no-file* true)
-  (var *quiet* false)
-  (var *raw-stdin* false)
-  (var *handleopts* true)
-  (var *exit-on-error* true)
-  (var *colorize* true)
-  (var *debug* false)
-  (var *compile-only* false)
-  (var *warn-level* nil)
-  (var *error-level* nil)
+  (var should-repl false)
+  (var no-file true)
+  (var quiet false)
+  (var raw-stdin false)
+  (var handleopts true)
+  (var exit-on-error true)
+  (var colorize true)
+  (var debug-flag false)
+  (var compile-only false)
+  (var warn-level nil)
+  (var error-level nil)
+  (var expect-image false)
 
   (if-let [jp (getenv-alias "JANET_PATH")] (setdyn :syspath jp))
-  (if-let [jprofile (getenv-alias "JANET_PROFILE")] (setdyn :profilepath jprofile))
+  (if-let [jprofile (getenv-alias "JANET_PROFILE")] (setdyn *profilepath* jprofile))
 
   (defn- get-lint-level
     [i]
@@ -3538,7 +3656,7 @@
   # Flag handlers
   (def handlers
     {"h" (fn [&]
-           (print "usage: " (dyn :executable "janet") " [options] script args...")
+           (print "usage: " (dyn *executable* "janet") " [options] script args...")
            (print
              ```
              Options are:
@@ -3555,8 +3673,9 @@
                -k : Compile scripts but do not execute (flycheck)
                -m syspath : Set system path for loading global modules
                -c source output : Compile janet source code into an image
+               -i : Load the script argument as an image file instead of source code
                -n : Disable ANSI color output in the REPL
-               -l lib : Import a module before processing more arguments
+               -l lib : Use a module before processing more arguments
                -w level : Set the lint warning level - default is "normal"
                -x level : Set the lint error level - default is "none"
                -- : Stop handling options
@@ -3564,29 +3683,31 @@
            (os/exit 0)
            1)
      "v" (fn [&] (print janet/version "-" janet/build) (os/exit 0) 1)
-     "s" (fn [&] (set *raw-stdin* true) (set *should-repl* true) 1)
-     "r" (fn [&] (set *should-repl* true) 1)
-     "p" (fn [&] (set *exit-on-error* false) 1)
-     "q" (fn [&] (set *quiet* true) 1)
-     "k" (fn [&] (set *compile-only* true) (set *exit-on-error* false) 1)
-     "n" (fn [&] (set *colorize* false) 1)
+     "s" (fn [&] (set raw-stdin true) (set should-repl true) 1)
+     "r" (fn [&] (set should-repl true) 1)
+     "p" (fn [&] (set exit-on-error false) 1)
+     "q" (fn [&] (set quiet true) 1)
+     "i" (fn [&] (set expect-image true) 1)
+     "k" (fn [&] (set compile-only true) (set exit-on-error false) 1)
+     "n" (fn [&] (set colorize false) 1)
      "m" (fn [i &] (setdyn :syspath (in args (+ i 1))) 2)
      "c" (fn c-switch [i &]
-           (def e (dofile (in args (+ i 1))))
+           (def path (in args (+ i 1)))
+           (def e (dofile path))
            (spit (in args (+ i 2)) (make-image e))
-           (set *no-file* false)
+           (set no-file false)
            3)
-     "-" (fn [&] (set *handleopts* false) 1)
+     "-" (fn [&] (set handleopts false) 1)
      "l" (fn l-switch [i &]
            (import* (in args (+ i 1))
-                    :prefix "" :exit *exit-on-error*)
+                    :prefix "" :exit exit-on-error)
            2)
      "e" (fn e-switch [i &]
-           (set *no-file* false)
+           (set no-file false)
            (eval-string (in args (+ i 1)))
            2)
      "E" (fn E-switch [i &]
-           (set *no-file* false)
+           (set no-file false)
            (def subargs (array/slice args (+ i 2)))
            (def src ~|,(parse (in args (+ i 1))))
            (def thunk (compile src))
@@ -3594,10 +3715,10 @@
              ((thunk) ;subargs)
              (error (get thunk :error)))
            math/inf)
-     "d" (fn [&] (set *debug* true) 1)
-     "w" (fn [i &] (set *warn-level* (get-lint-level i)) 2)
-     "x" (fn [i &] (set *error-level* (get-lint-level i)) 2)
-     "R" (fn [&] (setdyn :profilepath nil) 1)})
+     "d" (fn [&] (set debug-flag true) 1)
+     "w" (fn [i &] (set warn-level (get-lint-level i)) 2)
+     "x" (fn [i &] (set error-level (get-lint-level i)) 2)
+     "R" (fn [&] (setdyn *profilepath* nil) 1)})
 
   (defn- dohandler [n i &]
     (def h (in handlers n))
@@ -3608,29 +3729,41 @@
   (def lenargs (length args))
   (while (< i lenargs)
     (def arg (in args i))
-    (if (and *handleopts* (= "-" (string/slice arg 0 1)))
+    (if (and handleopts (= "-" (string/slice arg 0 1)))
       (+= i (dohandler (string/slice arg 1) i))
       (do
-        (set *no-file* false)
-        (def env (make-env))
         (def subargs (array/slice args i))
-        (put env :args subargs)
-        (put env :lint-error *error-level*)
-        (put env :lint-warn *warn-level*)
-        (if *compile-only*
-          (flycheck arg :exit *exit-on-error* :env env)
+        (set no-file false)
+        (if expect-image
           (do
-            (dofile arg :exit *exit-on-error* :env env)
-            (if-let [main (get (in env 'main) :value)]
-              (let [thunk (compile [main ;(tuple/slice args i)] env arg)]
-                (if (function? thunk) (thunk) (error (thunk :error)))))))
+            (def env (load-image (slurp arg)))
+            (put env :args subargs)
+            (put env :lint-error error-level)
+            (put env :lint-warn warn-level)
+            (when debug-flag
+              (put env :debug true)
+              (put env :redef true))
+            (run-main env subargs arg))
+          (do
+            (def env (make-env))
+            (put env :args subargs)
+            (put env :lint-error error-level)
+            (put env :lint-warn warn-level)
+            (when debug-flag
+              (put env :debug true)
+              (put env :redef true))
+            (if compile-only
+              (flycheck arg :exit exit-on-error :env env)
+              (do
+                (dofile arg :exit exit-on-error :env env)
+                (run-main env subargs arg)))))
         (set i lenargs))))
 
-  (if (or *should-repl* *no-file*)
+  (if (or should-repl no-file)
     (if
-      *compile-only* (flycheck stdin :source "stdin" :exit *exit-on-error*)
+      compile-only (flycheck stdin :source :stdin :exit exit-on-error)
       (do
-        (if-not *quiet*
+        (if-not quiet
           (print "Janet " janet/version "-" janet/build " " (os/which) "/" (os/arch) " - '(doc)' for help"))
         (flush)
         (defn getprompt [p]
@@ -3641,18 +3774,20 @@
           (file/flush stdout)
           (file/read stdin :line buf))
         (def env (make-env))
-        (when-let [profile.janet (dyn :profilepath)]
+        (when-let [profile.janet (dyn *profilepath*)]
             (def new-env (dofile profile.janet :exit true))
             (merge-module env new-env "" false))
-        (if *debug* (put env :debug true))
-        (def getter (if *raw-stdin* getstdin getline))
+        (when debug-flag
+          (put env :debug true)
+          (put env :redef true))
+        (def getter (if raw-stdin getstdin getline))
         (defn getchunk [buf p]
           (getter (getprompt p) buf env))
-        (setdyn :pretty-format (if *colorize* "%.20Q" "%.20q"))
-        (setdyn :err-color (if *colorize* true))
-        (setdyn :doc-color (if *colorize* true))
-        (setdyn :lint-error *error-level*)
-        (setdyn :lint-warn *error-level*)
+        (setdyn :pretty-format (if colorize "%.20Q" "%.20q"))
+        (setdyn :err-color (if colorize true))
+        (setdyn :doc-color (if colorize true))
+        (setdyn :lint-error error-level)
+        (setdyn :lint-warn error-level)
         (repl getchunk nil env)))))
 
 ###
@@ -3663,26 +3798,15 @@
 
 (do
 
-  (defn proto-flatten
-    "Flatten a table and its prototypes into a single table."
-    [into x]
-    (when x
-      (proto-flatten into (table/getproto x))
-      (loop [k :keys x]
-        (put into k (x k))))
-    into)
-
-  # Deprecate thread library
-  (loop [[k v] :in (pairs root-env)
-         :when (symbol? k)
-         :when (string/has-prefix? "thread/" k)]
+  # Deprecate file/popen
+  (when-let [v (get root-env 'file/popen)]
     (put v :deprecated true))
 
   # Modify root-env to remove private symbols and
   # flatten nested tables.
   (loop [[k v] :in (pairs root-env)
          :when (symbol? k)]
-    (def flat (proto-flatten @{} v))
+    (def flat (table/proto-flatten v))
     (when (boot/config :no-docstrings)
       (put flat :doc nil))
     (when (boot/config :no-sourcemaps)
@@ -3762,7 +3886,6 @@
      "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"

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_MINOR 21
+#define JANET_VERSION_PATCH 1
 #define JANET_VERSION_EXTRA ""
-#define JANET_VERSION "1.17.2"
+#define JANET_VERSION "1.21.1"
 
 /* #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
@@ -63,8 +63,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);
@@ -86,11 +86,11 @@ void *janet_abstract_threaded(const JanetAbstractType *atype, size_t size) {
 #ifdef JANET_WINDOWS
 
 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) {
@@ -112,11 +112,11 @@ void janet_os_mutex_unlock(JanetOSMutex *mutex) {
 #else
 
 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) {

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

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

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

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
@@ -137,7 +137,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 +339,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 +401,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 +468,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 +494,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 +983,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 +993,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,9 +1010,6 @@ 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

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>
@@ -75,6 +86,7 @@ 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 +234,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 +347,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 +464,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));
 }
 
@@ -604,7 +621,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);
@@ -728,7 +745,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 +838,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 +887,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 +975,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 +1007,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 +1201,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 +1225,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 +1261,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 +1452,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 +1555,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 +1618,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 +1640,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 +1712,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 +1772,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 +1785,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 +2234,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 +2267,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 +2603,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 +2662,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]);
@@ -2903,7 +2937,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];

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

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
@@ -483,6 +483,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");

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
@@ -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,
@@ -1066,6 +901,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,10 +39,6 @@
 #include <sys/stat.h>
 #include <signal.h>
 
-#ifdef JANET_APPLE
-#include <AvailabilityMacros.h>
-#endif
-
 #ifdef JANET_WINDOWS
 #include <windows.h>
 #include <direct.h>
@@ -67,12 +63,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 +173,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
@@ -409,15 +401,13 @@ static JanetEVGenericMessage janet_proc_wait_subr(JanetEVGenericMessage 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 +415,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 +438,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 +477,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,7 +550,7 @@ 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 "
+              "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);
@@ -685,6 +695,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;
@@ -948,18 +964,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;
@@ -1053,7 +1075,9 @@ JANET_CORE_FN(os_execute,
 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.") {
+              "same arguments as os/execute. Does not wait for the process. "
+              "The returned value has the fields :in, :out, :err, :return-code and "
+              "the additional field :pid on unix like platforms.") {
     return os_execute_impl(argc, argv, 1);
 }
 

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;
 }
 
@@ -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
@@ -387,6 +387,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 +994,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 +1156,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 +1253,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 +1470,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;

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
@@ -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);
@@ -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 {
@@ -298,8 +361,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)));
@@ -331,14 +406,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);
 }

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

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,6 +263,34 @@ 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,
@@ -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

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;
@@ -593,10 +601,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 +629,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;
 }
 
@@ -775,11 +793,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 +805,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;

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
@@ -56,7 +56,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 +84,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(
@@ -126,6 +130,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 +150,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;

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;
+                ptrdiff_t diff = ((char *)janet_unwrap_pointer(x) - (char *)0);
+                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
@@ -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);
         }
@@ -1330,7 +1330,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 +1338,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 +1466,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 +1507,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 +1573,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 +1599,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
@@ -871,7 +866,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 +961,7 @@ struct JanetStructHead {
     int32_t length;
     int32_t hash;
     int32_t capacity;
+    const JanetKV *proto;
     const JanetKV data[];
 };
 
@@ -1527,6 +1523,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 +1540,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 +1621,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 +1763,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 +1779,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 {
@@ -2040,7 +2044,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 {

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;
         }
@@ -112,7 +116,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>
@@ -136,7 +139,6 @@ 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;
@@ -743,7 +745,11 @@ static int line() {
         char c;
         char seq[3];
 
-        if (read(STDIN_FILENO, &c, 1) <= 0) return -1;
+        int rc;
+        do {
+            rc = read(STDIN_FILENO, &c, 1);
+        } while (rc < 0 && errno == EINTR);
+        if (rc <= 0) return -1;
 
         switch (c) {
             default:
@@ -758,9 +764,9 @@ static int line() {
                 kleft();
                 break;
             case 3:     /* ctrl-c */
-                clearlines();
-                gbl_sigint_flag = 1;
-                return -1;
+                norawmode();
+                kill(getpid(), SIGINT);
+            /* fallthrough */
             case 17:    /* ctrl-q */
                 gbl_cancel_current_repl_form = 1;
                 clearlines();
@@ -962,11 +968,7 @@ void janet_line_get(const char *p, JanetBuffer *buffer) {
     }
     if (line()) {
         norawmode();
-        if (gbl_sigint_flag) {
-            raise(SIGINT);
-        } else {
-            fputc('\n', out);
-        }
+        fputc('\n', out);
         return;
     }
     fflush(stdin);

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,37 @@
 
   (:close s))
 
+(defn check-matching-names [stream]
+  (def ln (net/localname stream))
+  (def pn (net/peername stream))
+  (def [my-ip my-port] ln)
+  (def [remote-ip remote-port] pn)
+  (def msg (string my-ip " " my-port " " remote-ip " " remote-port))
+  (def buf @"")
+  (ev/gather
+    (net/write stream msg)
+    (net/read stream 1024 buf))
+  (def comparison (string/split " " buf))
+  (assert (and (= my-ip (get comparison 2))
+               (= (string my-port) (get comparison 3))
+               (= remote-ip (get comparison 0))
+               (= (string remote-port) (get comparison 1)))
+          (string/format "localname should match peername: msg=%j, buf=%j" msg buf)))
+
+# Test on both server and client
+(defn names-handler
+  [stream]
+  (defer (:close stream)
+    (check-matching-names stream)))
+
 # 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))
+(repeat 20
+  (with [s (net/server "127.0.0.1" "8000" names-handler)]
+    (defn test-names []
+      (with [conn (net/connect "127.0.0.1" "8000")]
+        (check-matching-names conn)))
+    (repeat 20 (test-names)))
+  (gccollect))
 
 # Create pipe
 
@@ -258,4 +266,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,54 @@
+# Copyright (c) 2021 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")
+
+(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)