Add support for cuddled symbol shorthand.

Fix typo flie

.builds/.freebsd.yaml

@@ -1,11 +0,0 @@
-image: freebsd/latest
-packages:
-  - gmake
-tasks:
-  - build: |
-      cd janet
-      gmake
-      gmake test
-      sudo gmake install
-      gmake test-install
-      gmake test-amalg

.builds/.openbsd.yaml

@@ -1,11 +0,0 @@
-image: openbsd/6.5
-packages:
-  - gmake
-tasks:
-  - build: |
-      cd janet
-      gmake
-      gmake test
-      doas gmake install
-      gmake test-install
-      gmake test-amalg

.builds/freebsd.yml

@@ -0,0 +1,12 @@
+image: freebsd/12.x
+sources:
+- https://git.sr.ht/~bakpakin/janet
+packages:
+- gmake
+tasks:
+- build: |
+    cd janet
+    gmake
+    gmake test
+    sudo gmake install
+    gmake test-install

.builds/openbsd.yml

@@ -0,0 +1,12 @@
+image: openbsd/latest
+sources:
+- https://git.sr.ht/~bakpakin/janet
+packages:
+- gmake
+tasks:
+- build: |
+    cd janet
+    gmake
+    gmake test
+    doas gmake install
+    gmake test-install

.gitignore

@@ -13,6 +13,9 @@ janet
 janet-*.tar.gz
 dist
 
+# jpm lockfile
+lockfile.janet
+
 # Kakoune (fzf via fd)
 .fdignore
 

.travis.yml

@@ -4,7 +4,6 @@ script:
 - make test
 - sudo make install
 - make test-install
-- make test-amalg
 - make build/janet-${TRAVIS_TAG}-${TRAVIS_OS_NAME}.tar.gz
 compiler:
 - clang

CHANGELOG.md

@@ -1,7 +1,66 @@
 # Changelog
 All notable changes to this project will be documented in this file.
 
-### 1.6.0 - 2019-12-22
+## 1.8.1 - 2020-03-31
+- Fix bugs for big endian systems
+- Fix 1.8.0 regression on BSDs
+
+## 1.8.0 - 2020-03-29
+- Add `reduce2`, `accumulate`, and `accumulate2`.
+- Add lockfiles to `jpm` via `jpm make-lockfile` and `jpm load-lockfile`.
+- Add `os/realpath` (Not supported on windows).
+- Add `os/chmod`.
+- Add `chr` macro.
+- Allow `_` in the `match` macro to match anything without creating a binding
+  or doing unification. Also change behavior of matching nil.
+- Add `:range-to` and `:down-to` verbs in the `loop` macro.
+- Fix `and` and `or` macros returning nil instead of false in some cases.
+- Allow matching successfully against nil values in the `match` macro.
+- Improve `janet_formatc` and `janet_panicf` formatters to be more like `string/format`.
+  This makes it easier to make nice error messages from C.
+- Add `signal`
+- Add `fiber/can-resume?`
+- Allow fiber functions to accept arguments that are passed in via `resume`.
+- Make flychecking slightly less strict but more useful
+- Correct arity for `next`
+- Correct arity for `marshal`
+- Add `flush` and `eflush`
+- Add `prompt` and `return` on top of signal for user friendly delimited continuations.
+- Fix bug in buffer/blit when using the offset-src argument.
+- Fix segfault with malformed pegs.
+
+## 1.7.0 - 2020-02-01
+- Remove `file/fileno` and `file/fdopen`.
+- Remove `==`, `not==`, `order<`, `order>`, `order<=`, and `order>=`. Instead, use the normal
+  comparison and equality functions.
+- Let abstract types define a hash function and comparison/equality semantics. This lets
+  abstract types much better represent value types. This adds more fields to abstract types, which
+  will generate warnings when compiled against other versions.
+- Remove Emscripten build. Instead, use the amalgamated source code with a custom toolchain.
+- Update documentation.
+- Add `var-`
+- Add `module/add-paths`
+- Add `file/temp`
+- Add `mod` function to core.
+- Small bug fixes
+- Allow signaling from C functions (yielding) via janet\_signalv. This
+  makes it easy to write C functions that work with event loops, such as
+  in libuv or embedded in a game.
+- Add '%j' formatting option to the format family of functions.
+- Add `defer`
+- Add `assert`
+- Add `when-with`
+- Add `if-with`
+- Add completion to the default repl based on currently defined bindings. Also generally improve
+  the repl keybindings.
+- Add `eachk`
+- Add `eachp`
+- Improve functionality of the `next` function. `next` now works on many different
+  types, not just tables and structs. This allows for more generic data processing.
+- Fix thread module issue where sometimes decoding a message failed.
+- Fix segfault regression when macros are called with bad arity.
+
+## 1.6.0 - 2019-12-22
 - Add `thread/` module to the core.
 - Allow seeding RNGs with any sequence of bytes. This provides
   a wider key space for the RNG. Exposed in C as `janet_rng_longseed`.

LICENSE

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

Makefile

@@ -1,4 +1,4 @@
-# Copyright (c) 2019 Calvin Rose
+# Copyright (c) 2020 Calvin Rose
 #
 # Permission is hereby granted, free of charge, to any person obtaining a copy
 # of this software and associated documentation files (the "Software"), to
@@ -27,7 +27,7 @@ PREFIX?=/usr/local
 INCLUDEDIR?=$(PREFIX)/include
 BINDIR?=$(PREFIX)/bin
 LIBDIR?=$(PREFIX)/lib
-JANET_BUILD?="\"$(shell git log --pretty=format:'%h' -n 1 || 'local')\""
+JANET_BUILD?="\"$(shell git log --pretty=format:'%h' -n 1 || echo local)\""
 CLIBS=-lm -lpthread
 JANET_TARGET=build/janet
 JANET_LIBRARY=build/libjanet.so
@@ -37,9 +37,8 @@ MANPATH?=$(PREFIX)/share/man/man1/
 PKG_CONFIG_PATH?=$(LIBDIR)/pkgconfig
 DEBUGGER=gdb
 
-CFLAGS=-std=c99 -Wall -Wextra -Isrc/include -Isrc/conf -fPIC -O2 -fvisibility=hidden \
+CFLAGS:=$(CFLAGS) -std=c99 -Wall -Wextra -Isrc/include -Isrc/conf -fPIC -O2 -fvisibility=hidden
-	   -DJANET_BUILD=$(JANET_BUILD)
+LDFLAGS:=$(LDFLAGS) -rdynamic
-LDFLAGS=-rdynamic
 
 # For installation
 LDCONFIG:=ldconfig "$(LIBDIR)"
@@ -48,13 +47,13 @@ LDCONFIG:=ldconfig "$(LIBDIR)"
 UNAME:=$(shell uname -s)
 ifeq ($(UNAME), Darwin)
 	CLIBS:=$(CLIBS) -ldl
-	LDCONFIG:=
+	LDCONFIG:=true
 else ifeq ($(UNAME), Linux)
 	CLIBS:=$(CLIBS) -lrt -ldl
 endif
 # For other unix likes, add flags here!
 ifeq ($(UNAME), Haiku)
-	LDCONFIG:=
+	LDCONFIG:=true
 	LDFLAGS=-Wl,--export-dynamic
 endif
 
@@ -67,7 +66,8 @@ all: $(JANET_TARGET) $(JANET_LIBRARY) $(JANET_STATIC_LIBRARY)
 
 JANET_HEADERS=src/include/janet.h src/conf/janetconf.h
 
-JANET_LOCAL_HEADERS=src/core/util.h \
+JANET_LOCAL_HEADERS=src/core/features.h \
+					src/core/util.h \
 					src/core/state.h \
 					src/core/gc.h \
 					src/core/vector.h \
@@ -121,108 +121,33 @@ JANET_BOOT_SOURCES=src/boot/array_test.c \
 				   src/boot/number_test.c \
 				   src/boot/system_test.c \
 				   src/boot/table_test.c
+JANET_BOOT_HEADERS=src/boot/tests.h
 
-JANET_MAINCLIENT_SOURCES=src/mainclient/line.c src/mainclient/main.c
+##########################################################
+##### The bootstrap interpreter that creates janet.c #####
+##########################################################
 
-JANET_WEBCLIENT_SOURCES=src/webclient/main.c
+JANET_BOOT_OBJECTS=$(patsubst src/%.c,build/%.boot.o,$(JANET_CORE_SOURCES) $(JANET_BOOT_SOURCES))
+BOOT_CFLAGS:=-DJANET_BOOTSTRAP -DJANET_BUILD=$(JANET_BUILD) $(CFLAGS)
 
-##################################################################
+$(JANET_BOOT_OBJECTS): $(JANET_BOOT_HEADERS)
-##### The bootstrap interpreter that compiles the core image #####
-##################################################################
-
-JANET_BOOT_OBJECTS=$(patsubst src/%.c,build/%.boot.o,$(JANET_CORE_SOURCES) $(JANET_BOOT_SOURCES)) \
-	build/boot.gen.o
 
 build/%.boot.o: src/%.c $(JANET_HEADERS) $(JANET_LOCAL_HEADERS)
-	$(CC) $(CFLAGS) -DJANET_BOOTSTRAP -o $@ -c $<
+	$(CC) $(BOOT_CFLAGS) -o $@ -c $<
 
 build/janet_boot: $(JANET_BOOT_OBJECTS)
-	$(CC) $(CFLAGS) -DJANET_BOOTSTRAP -o $@ $^ $(CLIBS)
+	$(CC) $(BOOT_CFLAGS) -o $@ $(JANET_BOOT_OBJECTS) $(CLIBS)
 
 # Now the reason we bootstrap in the first place
-build/core_image.c: build/janet_boot
+build/janet.c: build/janet_boot src/boot/boot.janet
-	build/janet_boot $@ JANET_PATH '$(JANET_PATH)' JANET_HEADERPATH '$(INCLUDEDIR)/janet'
+	build/janet_boot . JANET_PATH '$(JANET_PATH)' JANET_HEADERPATH '$(INCLUDEDIR)/janet' > $@
-
-##########################################################
-##### The main interpreter program and shared object #####
-##########################################################
-
-JANET_CORE_OBJECTS=$(patsubst src/%.c,build/%.o,$(JANET_CORE_SOURCES)) build/core_image.o
-JANET_MAINCLIENT_OBJECTS=$(patsubst src/%.c,build/%.o,$(JANET_MAINCLIENT_SOURCES))
-
-# Compile the core image generated by the bootstrap build
-build/core_image.o: build/core_image.c $(JANET_HEADERS) $(JANET_LOCAL_HEADERS)
-	$(CC) $(CFLAGS) -o $@ -c $<
-
-build/%.o: src/%.c $(JANET_HEADERS) $(JANET_LOCAL_HEADERS)
-	$(CC) $(CFLAGS) -o $@ -c $<
-
-$(JANET_TARGET): $(JANET_CORE_OBJECTS) $(JANET_MAINCLIENT_OBJECTS)
-	$(CC) $(LDFLAGS) $(CFLAGS) -o $@ $^ $(CLIBS)
-
-$(JANET_LIBRARY): $(JANET_CORE_OBJECTS)
-	$(CC) $(LDFLAGS) $(CFLAGS) -shared -o $@ $^ $(CLIBS)
-
-$(JANET_STATIC_LIBRARY): $(JANET_CORE_OBJECTS)
-	$(AR) rcs $@ $^
-
-######################
-##### Emscripten #####
-######################
-
-EMCC=emcc
-EMCFLAGS=-std=c99 -Wall -Wextra -Isrc/include -Isrc/conf -O2 \
-		  -s EXTRA_EXPORTED_RUNTIME_METHODS='["cwrap"]' \
-		  -s ALLOW_MEMORY_GROWTH=1 \
-		  -s AGGRESSIVE_VARIABLE_ELIMINATION=1 \
-		  -DJANET_BUILD=$(JANET_BUILD)
-JANET_EMTARGET=build/janet.js
-JANET_WEB_SOURCES=$(JANET_CORE_SOURCES) $(JANET_WEBCLIENT_SOURCES)
-JANET_EMOBJECTS=$(patsubst src/%.c,build/%.bc,$(JANET_WEB_SOURCES)) \
-				build/webinit.gen.bc build/core_image.bc
-
-%.gen.bc: %.gen.c
-	$(EMCC) $(EMCFLAGS) -o $@ -c $<
-
-build/core_image.bc: build/core_image.c $(JANET_HEADERS) $(JANET_LOCAL_HEADERS)
-	$(EMCC) $(EMCFLAGS) -o $@ -c $<
-
-build/%.bc: src/%.c $(JANET_HEADERS) $(JANET_LOCAL_HEADERS)
-	$(EMCC) $(EMCFLAGS) -o $@ -c $<
-
-$(JANET_EMTARGET): $(JANET_EMOBJECTS)
-	$(EMCC) $(EMCFLAGS) -shared -o $@ $^
-
-emscripten: $(JANET_EMTARGET)
-
-#############################
-##### Generated C files #####
-#############################
-
-%.gen.o: %.gen.c
-	$(CC) $(CFLAGS) -o $@ -c $<
-
-build/xxd: tools/xxd.c
-	$(CC) $< -o $@
-
-build/webinit.gen.c: src/webclient/webinit.janet build/xxd
-	build/xxd $< $@ janet_gen_webinit
-build/boot.gen.c: src/boot/boot.janet build/xxd
-	build/xxd $< $@ janet_gen_boot
 
 ########################
 ##### Amalgamation #####
 ########################
 
-amalg: build/shell.c build/janet.c build/janet.h build/core_image.c build/janetconf.h
+build/shell.c: src/mainclient/shell.c
-
+	cp $< $@
-AMALG_SOURCE=$(JANET_LOCAL_HEADERS) $(JANET_CORE_SOURCES) build/core_image.c
-build/janet.c: $(AMALG_SOURCE) tools/amalg.janet $(JANET_TARGET)
-	$(JANET_TARGET) tools/amalg.janet $(AMALG_SOURCE) > $@
-
-AMALG_SHELL_SOURCE=src/mainclient/line.h src/mainclient/line.c src/mainclient/main.c
-build/shell.c: $(JANET_TARGET) tools/amalg.janet $(AMALG_SHELL_SOURCE)
-	$(JANET_TARGET) tools/amalg.janet $(AMALG_SHELL_SOURCE) > $@
 
 build/janet.h: src/include/janet.h
 	cp $< $@
@@ -230,6 +155,21 @@ build/janet.h: src/include/janet.h
 build/janetconf.h: src/conf/janetconf.h
 	cp $< $@
 
+build/janet.o: build/janet.c build/janet.h build/janetconf.h
+	$(CC) $(CFLAGS) -c $< -o $@ -I build
+
+build/shell.o: build/shell.c build/janet.h build/janetconf.h
+	$(CC) $(CFLAGS) -c $< -o $@ -I build
+
+$(JANET_TARGET): build/janet.o build/shell.o
+	$(CC) $(LDFLAGS) $(CFLAGS) -o $@ $^ $(CLIBS)
+
+$(JANET_LIBRARY): build/janet.o build/shell.o
+	$(CC) $(LDFLAGS) $(CFLAGS) -shared -o $@ $^ $(CLIBS)
+
+$(JANET_STATIC_LIBRARY): build/janet.o build/shell.o
+	$(AR) rcs $@ $^
+
 ###################
 ##### Testing #####
 ###################
@@ -290,7 +230,7 @@ build/doc.html: $(JANET_TARGET) tools/gendoc.janet
 
 SONAME=libjanet.so.1
 
-.PHONY: build/janet.pc
+.INTERMEDIATE: build/janet.pc
 build/janet.pc: $(JANET_TARGET)
 	echo 'prefix=$(PREFIX)' > $@
 	echo 'exec_prefix=$${prefix}' >> $@
@@ -306,33 +246,33 @@ build/janet.pc: $(JANET_TARGET)
 	echo 'Libs.private: $(CLIBS)' >> $@
 
 install: $(JANET_TARGET) build/janet.pc
-	mkdir -p '$(BINDIR)'
+	mkdir -p '$(DESTDIR)$(BINDIR)'
-	cp $(JANET_TARGET) '$(BINDIR)/janet'
+	cp $(JANET_TARGET) '$(DESTDIR)$(BINDIR)/janet'
-	mkdir -p '$(INCLUDEDIR)/janet'
+	mkdir -p '$(DESTDIR)$(INCLUDEDIR)/janet'
-	cp -rf $(JANET_HEADERS) '$(INCLUDEDIR)/janet'
+	cp -rf $(JANET_HEADERS) '$(DESTDIR)$(INCLUDEDIR)/janet'
-	mkdir -p '$(JANET_PATH)'
+	mkdir -p '$(DESTDIR)$(JANET_PATH)'
-	mkdir -p '$(LIBDIR)'
+	mkdir -p '$(DESTDIR)$(LIBDIR)'
-	cp $(JANET_LIBRARY) '$(LIBDIR)/libjanet.so.$(shell $(JANET_TARGET) -e '(print janet/version)')'
+	cp $(JANET_LIBRARY) '$(DESTDIR)$(LIBDIR)/libjanet.so.$(shell $(JANET_TARGET) -e '(print janet/version)')'
-	cp $(JANET_STATIC_LIBRARY) '$(LIBDIR)/libjanet.a'
+	cp $(JANET_STATIC_LIBRARY) '$(DESTDIR)$(LIBDIR)/libjanet.a'
-	ln -sf $(SONAME) '$(LIBDIR)/libjanet.so'
+	ln -sf $(SONAME) '$(DESTDIR)$(LIBDIR)/libjanet.so'
-	ln -sf libjanet.so.$(shell $(JANET_TARGET) -e '(print janet/version)') $(LIBDIR)/$(SONAME)
+	ln -sf libjanet.so.$(shell $(JANET_TARGET) -e '(print janet/version)') $(DESTDIR)$(LIBDIR)/$(SONAME)
-	cp -rf auxbin/* '$(BINDIR)'
+	cp -rf auxbin/* '$(DESTDIR)$(BINDIR)'
-	mkdir -p '$(MANPATH)'
+	mkdir -p '$(DESTDIR)$(MANPATH)'
-	cp janet.1 '$(MANPATH)'
+	cp janet.1 '$(DESTDIR)$(MANPATH)'
-	cp jpm.1 '$(MANPATH)'
+	cp jpm.1 '$(DESTDIR)$(MANPATH)'
-	mkdir -p '$(PKG_CONFIG_PATH)'
+	mkdir -p '$(DESTDIR)$(PKG_CONFIG_PATH)'
-	cp build/janet.pc '$(PKG_CONFIG_PATH)/janet.pc'
+	cp build/janet.pc '$(DESTDIR)$(PKG_CONFIG_PATH)/janet.pc'
-	-$(LDCONFIG)
+	[ -z '$(DESTDIR)' ] && $(LDCONFIG) || true
 
 uninstall:
-	-rm '$(BINDIR)/janet'
+	-rm '$(DESTDIR)$(BINDIR)/janet'
-	-rm '$(BINDIR)/jpm'
+	-rm '$(DESTDIR)$(BINDIR)/jpm'
-	-rm -rf '$(INCLUDEDIR)/janet'
+	-rm -rf '$(DESTDIR)$(INCLUDEDIR)/janet'
-	-rm -rf '$(LIBDIR)'/libjanet.*
+	-rm -rf '$(DESTDIR)$(LIBDIR)'/libjanet.*
-	-rm '$(PKG_CONFIG_PATH)/janet.pc'
+	-rm '$(DESTDIR)$(PKG_CONFIG_PATH)/janet.pc'
-	-rm '$(MANPATH)/janet.1'
+	-rm '$(DESTDIR)$(MANPATH)/janet.1'
-	-rm '$(MANPATH)/jpm.1'
+	-rm '$(DESTDIR)$(MANPATH)/jpm.1'
-	# -rm -rf '$(JANET_PATH)'/* - err on the side of correctness here
+	# -rm -rf '$(DESTDIR)$(JANET_PATH)'/* - err on the side of correctness here
 
 #################
 ##### Other #####
@@ -361,15 +301,5 @@ test-install:
 	cd test/install && jpm --verbose --test --modpath=. install https://github.com/janet-lang/path.git
 	cd test/install && jpm --verbose --test --modpath=. install https://github.com/janet-lang/argparse.git
 
-build/embed_janet.o: build/janet.c $(JANET_HEADERS)
+.PHONY: clean install repl debug valgrind test \
-	$(CC) $(CFLAGS) -c $< -o $@
-build/embed_main.o: test/amalg/main.c $(JANET_HEADERS)
-	$(CC) $(CFLAGS) -c $< -o $@
-build/embed_test: build/embed_janet.o build/embed_main.o
-	$(CC) $(LDFLAGS) $(CFLAGS) -o $@ $^ $(CLIBS)
-
-test-amalg: build/embed_test
-	./build/embed_test
-
-.PHONY: clean install repl debug valgrind test amalg \
 	valtest emscripten dist uninstall docs grammar format

README.md

@@ -2,26 +2,28 @@
  
 [![Appveyor Status](https://ci.appveyor.com/api/projects/status/bjraxrxexmt3sxyv/branch/master?svg=true)](https://ci.appveyor.com/project/bakpakin/janet/branch/master)
 [![Build Status](https://travis-ci.org/janet-lang/janet.svg?branch=master)](https://travis-ci.org/janet-lang/janet)
-[![builds.sr.ht status](https://builds.sr.ht/~bakpakin/janet/.freebsd.yaml.svg)](https://builds.sr.ht/~bakpakin/janet/.freebsd.yaml?)
+[![builds.sr.ht status](https://builds.sr.ht/~bakpakin/janet/freebsd.yml.svg)](https://builds.sr.ht/~bakpakin/janet/freebsd.yml?)
-[![builds.sr.ht status](https://builds.sr.ht/~bakpakin/janet/.openbsd.yaml.svg)](https://builds.sr.ht/~bakpakin/janet/.openbsd.yaml?)
+[![builds.sr.ht status](https://builds.sr.ht/~bakpakin/janet/openbsd.yml.svg)](https://builds.sr.ht/~bakpakin/janet/openbsd.yml?)
 
 <img src="https://raw.githubusercontent.com/janet-lang/janet/master/assets/janet-w200.png" alt="Janet logo" width=200 align="left">
 
 **Janet** is a functional and imperative programming language and bytecode interpreter. It is a
 modern lisp, but lists are replaced
-by other data structures with better utility and performance (arrays, tables, structs, tuples).
+by other data structures (arrays, tables (hash table), struct (immutable hash table), tuples).
 The language also supports bridging to native code written in C, meta-programming with macros, and bytecode assembly.
 
 There is a repl for trying out the language, as well as the ability
 to run script files. This client program is separate from the core runtime, so
-janet could be embedded into other programs. Try janet in your browser at
+Janet can be embedded into other programs. Try Janet in your browser at
 [https://janet-lang.org](https://janet-lang.org).
 
 <br>
 
 ## Use Cases
 
-Janet makes a good system scripting language, or a language to embed in other programs. Think Lua or Guile.
+Janet makes a good system scripting language, or a language to embed in other programs.
+It's like Lua and Guile in that regard. It has more built-in functionality and a richer core language than
+Lua, but smaller than GNU Guile or Python.
 
 ## Features
 
@@ -43,7 +45,7 @@ Janet makes a good system scripting language, or a language to embed in other pr
 * Imperative programming as well as functional
 * REPL
 * Parsing Expression Grammars built in to the core library
-* 300+ functions and macros in the core library
+* 400+ functions and macros in the core library
 * Embedding Janet in other programs
 * Interactive environment with detailed stack traces
 
@@ -61,7 +63,9 @@ documentation for symbols in the core library. For example,
 Shows documentation for the doc macro.
 
 To get a list of all bindings in the default
-environment, use the `(all-bindings)` function.
+environment, use the `(all-bindings)` function. You
+can also use the `(doc)` macro with no arguments if you are in the repl
+to show bound symbols.
 
 ## Source
 
@@ -114,15 +118,6 @@ gmake repl
 3. Run `build_win` to compile janet.
 4. Run `build_win test` to make sure everything is working.
 
-### Emscripten
-
-To build janet for the web via [Emscripten](https://kripken.github.io/emscripten-site/), make sure you
-have `emcc` installed and on your path. On a linux or macOS system, use `make emscripten` to build
-`janet.js` and `janet.wasm` - both are needed to run janet in a browser or in node.
-The JavaScript build is what runs the repl on the main website,
-but really serves mainly as a proof of concept. Janet will run slower in a browser.
-Building with emscripten on windows is currently unsupported.
-
 ### Meson
 
 Janet also has a build file for [Meson](https://mesonbuild.com/), a cross platform build
@@ -131,7 +126,7 @@ is maybe more convenient and flexible for integrating into existing pipelines.
 Meson also provides much better IDE integration than Make or batch files, as well as support
 for cross compilation.
 
-For the impatient, building with Meson is as simple as follows. The options provided to
+For the impatient, building with Meson is as follows. The options provided to
 `meson setup` below emulate Janet's Makefile.
 
 ```sh
@@ -161,7 +156,7 @@ Emacs, and Atom will have syntax packages for the Janet language, though.
 ## Installation
 
 See [the Introduction](https://janet-lang.org/introduction.html) for more details. If you just want
-to try out the language, you don't need to install anything. You can also simply move the `janet` executable wherever you want on your system and run it.
+to try out the language, you don't need to install anything. You can also move the `janet` executable wherever you want on your system and run it.
 
 ## Usage
 
@@ -172,35 +167,38 @@ If you are looking to explore, you can print a list of all available macros, fun
 by entering the command `(all-bindings)` into the repl.
 
 ```
-$ ./janet
+$ janet
-Janet 0.0.0 alpha  Copyright (C) 2017-2018 Calvin Rose
+Janet 1.7.1-dev-951e10f  Copyright (C) 2017-2020 Calvin Rose
 janet:1:> (+ 1 2 3)
 6
 janet:2:> (print "Hello, World!")
 Hello, World!
 nil
 janet:3:> (os/exit)
-$ ./janet -h
+$ janet -h
-usage: ./janet [options] scripts...
+usage: build/janet [options] script args...
 Options are:
-  -h Show this help
+  -h : Show this help
-  -v Print the version string
+  -v : Print the version string
-  -s Use raw stdin instead of getline like functionality
+  -s : Use raw stdin instead of getline like functionality
-  -e Execute a string of janet
+  -e code : Execute a string of janet
-  -r Enter the repl after running all scripts
+  -r : Enter the repl after running all scripts
-  -p Keep on executing if there is a top level error (persistent)
+  -p : Keep on executing if there is a top level error (persistent)
-  -- Stop handling option
+  -q : Hide prompt, logo, and repl output (quiet)
-$
+  -k : Compile scripts but do not execute (flycheck)
+  -m syspath : Set system path for loading global modules
+  -c source output : Compile janet source code into an image
+  -n : Disable ANSI color output in the repl
+  -l path : Execute code in a file before running the main script
+  -- : Stop handling options
 ```
 
-If installed, you can also run `man janet` to get usage information.
+If installed, you can also run `man janet` and `man jpm` to get usage information.
 
 ## Embedding
 
-The C API for Janet is not yet documented but coming soon.
+Janet can be embedded in a host program very easily. The normal build
-
+will create a file `build/janet.c`, which is a single C file
-Janet can be embedded in a host program very easily. There is a make target
-`make amalg` which creates the file `build/janet.c`, which is a single C file
 that contains all the source to Janet. This file, along with
 `src/include/janet.h` and `src/include/janetconf.h` can dragged into any C
 project and compiled into the project. Janet should be compiled with `-std=c99`
@@ -209,6 +207,8 @@ the dynamic linker, `-ldl`, if one wants to be able to load dynamic modules. If
 there is no need for dynamic modules, add the define
 `-DJANET_NO_DYNAMIC_MODULES` to the compiler options.
 
+See the [Embedding Section](https://janet-lang.org/capi/embedding.html) on the website for more information.
+
 ## Examples
 
 See the examples directory for some example janet code.

appveyor.yml

@@ -20,17 +20,17 @@ init:
 
 install:
     - set JANET_BUILD=%appveyor_repo_commit:~0,7%
-    - choco install nsis -y -pre
+    - choco install nsis -y -pre --version 3.05
     # Replace makensis.exe and files with special long string build. This should
     # prevent issues when setting PATH during installation.
-    - 7z e "tools\nsis-3.04-strlen_8192.zip" -o"C:\Program Files (x86)\NSIS\" -y
+    - 7z e "tools\nsis-3.05-strlen_8192.zip" -o"C:\Program Files (x86)\NSIS\" -y
     - build_win all
     - refreshenv
     # We need to reload vcvars after refreshing
     - call "C:\Program Files (x86)\Microsoft Visual Studio\2019\Community\VC\Auxiliary\Build\vcvarsall.bat" %platform%
     - build_win test-install
     - set janet_outname=%appveyor_repo_tag_name%
-    - if "%janet_outname%"=="" set janet_outname=v1.6.0
+    - if "%janet_outname%"=="" set janet_outname=v1.8.1
 build: off
 
 artifacts:

auxbin/jpm

@@ -29,7 +29,7 @@
 
 (defn- rule-impl
   [target deps thunk &opt phony]
-  (put (getrules) target @[(array/slice deps) thunk phony]))
+  (put (getrules) target @[(array/slice deps) @[thunk] phony]))
 
 (defmacro rule
   "Add a rule to the rule graph."
@@ -53,8 +53,9 @@
 (defn- add-thunk
   [target more]
   (def item (gettarget target))
-  (def [_ thunk] item)
+  (def [_ thunks] item)
-  (put item 1 (fn [] (more) (thunk))))
+  (array/push thunks more)
+  item)
 
 (defmacro add-body
   "Add recipe code to an existing rule. This makes existing rules do more but
@@ -83,10 +84,10 @@
     (if (os/stat target :mode)
       (break target)
       (error (string "No rule for file " target " found."))))
-  (def [deps thunk phony] item)
+  (def [deps thunks phony] item)
   (def realdeps (seq [dep :in deps :let [x (do-rule dep)] :when x] x))
   (when (or phony (needs-build-some target realdeps))
-    (thunk))
+    (each thunk thunks (thunk)))
   (unless phony target))
 
 #
@@ -130,7 +131,6 @@
     ["/nologo" "/MD"]
     ["-std=c99" "-Wall" "-Wextra"]))
 
-
 # Link to pthreads
 (def- thread-flags (if is-win [] (if threads? ["-lpthread"] [])))
 
@@ -194,7 +194,8 @@
   (loop [k :keys currenv :when (keyword? k)]
     (put env k (currenv k)))
   (dofile path :env env :exit true)
-  (when-let [rules (env :rules)] (merge-into (getrules) rules)))
+  (when-let [rules (env :rules)] (merge-into (getrules) rules))
+  env)
 
 #
 # OS and shell helpers
@@ -251,11 +252,7 @@
   If we can't create it, give a friendly error. Return true if created, false if
   existing. Throw an error if we can't create it."
   [dir]
-  (if (os/mkdir dir)
+  (os/mkdir dir))
-    true
-    (if (os/stat dir :mode)
-      false
-      (error (string "Could not create " dir " - this could be a permission issue.")))))
 
 #
 # C Compilation
@@ -554,6 +551,15 @@ int main(int argc, const char **argv) {
 # Public utilities
 #
 
+(defn parse
+  "Read a string of Janet source and parse out the first expression."
+  [src]
+  (let [p (parser/new)]
+    (:consume p src)
+    (if (= :error (:status p))
+      (error (string "Could not parse: " (parser/error p))))
+    (:produce p)))
+
 (defn find-manifest-dir
   "Get the path to the directory containing manifests for installed
   packages."
@@ -563,7 +569,7 @@ int main(int argc, const char **argv) {
 (defn find-manifest
   "Get the full path of a manifest file given a package name."
   [name]
-  (string (find-manifest-dir) sep name ".txt"))
+  (string (find-manifest-dir) sep name ".jdn"))
 
 (defn find-cache
   "Return the path to the global cache."
@@ -575,35 +581,36 @@ int main(int argc, const char **argv) {
   "Uninstall bundle named name"
   [name]
   (def manifest (find-manifest name))
-  (def f (file/open manifest :r))
+  (when-with [f (file/open manifest)]
-  (unless f (print manifest " does not exist") (break))
+    (def man (parse (:read f :all)))
-  (loop [line :iterate (:read f :line)]
+    (each path (get man :paths [])
-    (def path ((string/split "\n" line) 0))
+      (print "removing " path)
-    (def path ((string/split "\r" path) 0))
+      (rm path))
-    (print "removing " path)
+    (print "removing " manifest)
+    (rm manifest)
+    (print "Uninstalled.")))
+
+(defn- rimraf
+  "Hard delete directory tree"
+  [path]
+  (if is-win
+    # windows get rid of read-only files
+    (os/shell `rmdir /S /Q "` path `"`))
     (rm path))
-  (:close f)
-  (print "removing " manifest)
-  (rm manifest)
-  (print "Uninstalled."))
 
 (defn clear-cache
   "Clear the global git cache."
   []
   (def cache (find-cache))
   (print "clearing " cache "...")
-  (if is-win
+  (rimraf cache))
-    # Git for windows decided that .git should be hidden and everything in it read-only.
-    # This means we can't delete things easily.
-    (os/shell (string `rmdir /S /Q "` cache `"`))
-    (rm cache)))
 
 (def- default-pkglist (or (os/getenv "JANET_PKGLIST") "https://github.com/janet-lang/pkgs.git"))
 
 (defn install-git
   "Install a bundle from git. If the bundle is already installed, the bundle
    is reinistalled (but not rebuilt if artifacts are cached)."
-  [repotab &opt recurse]
+  [repotab &opt recurse no-deps]
   (def repo (if (string? repotab) repotab (repotab :repo)))
   (def tag (unless (string? repotab) (repotab :tag)))
   # prevent infinite recursion (very unlikely, but consider
@@ -631,7 +638,9 @@ int main(int argc, const char **argv) {
   (when (mkdir module-dir)
       (set fresh true)
       (print "cloning repository " repo " to " module-dir)
-      (os/execute ["git" "clone" repo module-dir] :p))
+      (unless (zero? (os/execute ["git" "clone" repo module-dir] :p))
+        (rimraf module-dir)
+        (error (string "could not clone git dependency " repo))))
   (def olddir (os/cwd))
   (try
     (with-dyns [:rules @{}
@@ -646,7 +655,7 @@ int main(int argc, const char **argv) {
         (os/execute ["git" "reset" "--hard" tag] :p))
       (os/execute ["git" "submodule" "update" "--init" "--recursive"] :p)
       (import-rules "./project.janet")
-      (do-rule "install-deps")
+      (unless no-deps (do-rule "install-deps"))
       (do-rule "build")
       (do-rule "install"))
     ([err] (print "Error building git repository dependency: " err)))
@@ -663,6 +672,49 @@ int main(int argc, const char **argv) {
             (mkdir destdir)
             (copy src destdir)))
 
+(defn- pslurp
+  "Like slurp, but with file/popen instead file/open. Also trims output"
+  [cmd]
+  (string/trim (with [f (file/popen cmd)] (:read f :all))))
+
+(defn- make-lockfile
+  [&opt filename]
+  (default filename "lockfile.janet")
+  (def cwd (os/cwd))
+  (def packages @[])
+  # Read installed modules from manifests
+  (def mdir (find-manifest-dir))
+  (each man (os/dir mdir)
+    (def package (parse (slurp (string mdir sep man))))
+    (if (and (dictionary? package) (package :repo) (package :sha))
+      (array/push packages package)
+      (print "Cannot add local or malformed package " mdir sep man " to lockfile, skipping...")))
+  # Put in correct order, such that a package is preceded by all of its dependencies
+  (def ordered-packages @[])
+  (def resolved @{})
+  (while (< (length ordered-packages) (length packages))
+    (var made-progress false)
+    (each p packages
+      (def {:repo r :sha s :dependencies d} p)
+      (def dep-urls (map |(if (string? $) $ ($ :repo)) d))
+      (unless (resolved r)
+        (when (all resolved dep-urls)
+          (array/push ordered-packages p)
+          (set made-progress true)
+          (put resolved r true))))
+    (unless made-progress
+      (error (string/format "could not resolve package order for: %j"
+                            (filter (complement resolved) (map |($ :repo) packages))))))
+  # Write to file
+  (with [f (file/open filename :w)] (with-dyns [:out f] (printf "%j" ordered-packages))))
+
+(defn- load-lockfile
+  [&opt filename]
+  (default filename "lockfile.janet")
+  (def lockarray (parse (slurp filename)))
+  (each {:repo url :sha sha} lockarray
+    (install-git {:repo url :tag sha} nil true)))
+
 #
 # Declaring Artifacts - used in project.janet, targets specifically
 # tailored for janet.
@@ -746,10 +798,11 @@ int main(int argc, const char **argv) {
   file is evaluated and a main function is looked for in the entry file. This function
   is marshalled into bytecode which is then embedded in a final executable for distribution.\n\n
   This executable can be installed as well to the --binpath given."
-  [&keys {:install install :name name :entry entry :headers headers}]
+  [&keys {:install install :name name :entry entry :headers headers
+          :cflags cflags :lflags lflags}]
   (def name (if is-win (string name ".exe") name))
   (def dest (string "build" sep name))
-  (create-executable @{} entry dest)
+  (create-executable @{:cflags cflags :lflags lflags} entry dest)
   (add-dep "build" dest)
   (when headers
     (each h headers (add-dep dest h)))
@@ -807,7 +860,15 @@ int main(int argc, const char **argv) {
   (phony "manifest" []
          (print "generating " manifest "...")
          (mkdir manifests)
-         (spit manifest (string (string/join installed-files "\n") "\n")))
+         (def sha (pslurp "git rev-parse HEAD"))
+         (def url (pslurp "git remote get-url origin"))
+         (def man
+           {:sha (if-not (empty? sha) sha)
+            :repo (if-not (empty? url) url)
+            :dependencies (array/slice (get meta :dependencies []))
+            :paths installed-files})
+         (spit manifest (string/format "%j\n" man)))
+
   (phony "install" ["uninstall" "build" "manifest"]
          (when (dyn :test)
            (do-rule "test"))
@@ -881,6 +942,12 @@ Subcommands are:
   rules : list rules available with run.
   update-pkgs : Update the current package listing from the remote git repository selected.
   quickbin entry executable : Create an executable from a janet script with a main function.
+  make-lockfile (lockfile) : Create a lockfile based on repositories in the cache. The
+            lockfile will record the exact versions of dependencies used to ensure a reproducible
+            build. Lockfiles are best used with applications, not libraries. The default lockfile
+            name is lockfile.janet.
+  load-lockfile (lockfile) : Install modules from a lockfile in a reproducible way. The
+                             default lockfile name is lockfile.janet.
 
 Keys are:
   --modpath : The directory to install modules to. Defaults to $JANET_MODPATH, $JANET_PATH, or (dyn :syspath)
@@ -967,6 +1034,8 @@ Flags are:
    "rules" list-rules
    "update-pkgs" update-pkgs
    "uninstall" uninstall-cmd
+   "make-lockfile" make-lockfile
+   "load-lockfile" load-lockfile
    "quickbin" quickbin})
 
 (def- args (tuple/slice (dyn :args) 1))

build_win.bat

@@ -33,20 +33,6 @@ mkdir build\core
 mkdir build\mainclient
 mkdir build\boot
 
-@rem Build the xxd tool for generating sources
-cl /nologo /c tools/xxd.c /Fobuild\xxd.obj
-@if errorlevel 1 goto :BUILDFAIL
-link /nologo /out:build\xxd.exe build\xxd.obj
-@if errorlevel 1 goto :BUILDFAIL
-
-@rem Generate the embedded sources
-build\xxd.exe src\boot\boot.janet build\boot.gen.c janet_gen_boot
-@if errorlevel 1 goto :BUILDFAIL
-
-@rem Build the generated sources
-%JANET_COMPILE% /Fobuild\boot\boot.gen.obj build\boot.gen.c
-@if errorlevel 1 goto :BUILDFAIL
-
 @rem Build the bootstrap interpreter
 for %%f in (src\core\*.c) do (
     %JANET_COMPILE% /DJANET_BOOTSTRAP /Fobuild\boot\%%~nf.obj %%f
@@ -58,48 +44,25 @@ for %%f in (src\boot\*.c) do (
 )
 %JANET_LINK% /out:build\janet_boot.exe build\boot\*.obj
 @if errorlevel 1 goto :BUILDFAIL
-build\janet_boot build\core_image.c
+build\janet_boot . > build\janet.c
-
-@rem Build the core image
-%JANET_COMPILE% /Fobuild\core_image.obj build\core_image.c
-@if errorlevel 1 goto :BUILDFAIL
 
 @rem Build the sources
-for %%f in (src\core\*.c) do (
+%JANET_COMPILE% /Fobuild\janet.obj build\janet.c
-    %JANET_COMPILE% /Fobuild\core\%%~nf.obj %%f
+@if errorlevel 1 goto :BUILDFAIL
-    @if errorlevel 1 goto :BUILDFAIL
+%JANET_COMPILE% /Fobuild\shell.obj src\mainclient\shell.c
-)
+@if errorlevel 1 goto :BUILDFAIL
 
 @rem Build the resources
 rc /nologo /fobuild\janet_win.res janet_win.rc
 
-@rem Build the main client
-for %%f in (src\mainclient\*.c) do (
-    %JANET_COMPILE% /Fobuild\mainclient\%%~nf.obj %%f
-    @if errorlevel 1 goto :BUILDFAIL
-)
-
 @rem Link everything to main client
-%JANET_LINK% /out:janet.exe build\core\*.obj build\mainclient\*.obj build\core_image.obj build\janet_win.res
+%JANET_LINK% /out:janet.exe build\janet.obj build\shell.obj build\janet_win.res
 @if errorlevel 1 goto :BUILDFAIL
 
 @rem Build static library (libjanet.a)
-%JANET_LINK_STATIC% /out:build\libjanet.lib build\core\*.obj build\core_image.obj
+%JANET_LINK_STATIC% /out:build\libjanet.lib build\janet.obj
 @if errorlevel 1 goto :BUILDFAIL
 
-@rem Gen amlag
-setlocal enabledelayedexpansion
-set "amalg_files="
-for %%f in (src\core\*.c) do (
-    set "amalg_files=!amalg_files! %%f"
-)
-janet.exe tools\amalg.janet src\core\util.h src\core\state.h src\core\gc.h src\core\vector.h src\core\fiber.h src\core\regalloc.h src\core\compile.h src\core\emit.h src\core\symcache.h %amalg_files% build\core_image.c > build\janet.c
-janet.exe tools\removecr.janet build\janet.c
-
-@rem Gen shell.c
-janet.exe tools\amalg.janet src\mainclient\line.h src\mainclient\line.c src\mainclient\main.c > build\shell.c
-janet.exe tools\removecr.janet build\shell.c
-
 echo === Successfully built janet.exe for Windows ===
 echo === Run 'build_win test' to run tests. ==
 echo === Run 'build_win clean' to delete build artifacts. ===
@@ -141,7 +104,7 @@ janet.exe tools\gendoc.janet > dist\doc.html
 janet.exe tools\removecr.janet dist\doc.html
 
 copy build\janet.c dist\janet.c
-copy build\shell.c dist\shell.c
+copy src\mainclient\shell.c dist\shell.c
 copy janet.exe dist\janet.exe
 copy LICENSE dist\LICENSE
 copy README.md dist\README.md

janet-installer.nsi

@@ -1,3 +1,8 @@
+Unicode True
+
+!echo "Program Files: ${PROGRAMFILES}"
+!addplugindir "tools\"
+
 # Version
 !define PRODUCT_VERSION "${VERSION}.0"
 VIProductVersion "${PRODUCT_VERSION}"
@@ -20,7 +25,6 @@ VIFileVersion "${PRODUCT_VERSION}"
 # Includes
 !include "MultiUser.nsh"
 !include "MUI2.nsh"
-!include ".\tools\EnvVarUpdate.nsh"
 !include "LogicLib.nsh"
 
 # Basics
@@ -124,6 +128,15 @@ section "Janet" BfWSection
     # Start Menu
     createShortCut "$SMPROGRAMS\Janet.lnk" "$INSTDIR\bin\janet.exe" "" "$INSTDIR\logo.ico"
 
+    # Update path
+    ${If} $MultiUser.InstallMode == "AllUsers"
+        EnVar::SetHKLM
+    ${Else}
+        EnVar::SetHKCU
+    ${EndIf}
+    EnVar::AddValue "PATH" "$INSTDIR\bin"
+    Pop $0
+
     # Set up Environment variables
     !insertmacro WriteEnv JANET_PATH "$INSTDIR\Library"
     !insertmacro WriteEnv JANET_HEADERPATH "$INSTDIR\C"
@@ -132,13 +145,6 @@ section "Janet" BfWSection
 
     SendMessage ${HWND_BROADCAST} ${WM_WININICHANGE} 0 "STR:Environment" /TIMEOUT=5000
 
-    # Update path
-    ${If} $MultiUser.InstallMode == "AllUsers"
-        ${EnvVarUpdate} $0 "PATH" "A" "HKLM" "$INSTDIR\bin" ; Append
-    ${Else}
-        ${EnvVarUpdate} $0 "PATH" "A" "HKCU" "$INSTDIR\bin" ; Append
-    ${EndIf}
-
     # Registry information for add/remove programs
     WriteRegStr SHCTX "${UNINST_KEY}" "DisplayName" "Janet"
     WriteRegStr SHCTX "${UNINST_KEY}" "InstallLocation" "$INSTDIR"
@@ -185,10 +191,12 @@ section "uninstall"
 
     # Unset PATH
     ${If} $MultiUser.InstallMode == "AllUsers"
-        ${un.EnvVarUpdate} $0 "PATH" "R" "HKLM" "$INSTDIR\bin" ; Remove
+        EnVar::SetHKLM
     ${Else}
-        ${un.EnvVarUpdate} $0 "PATH" "R" "HKCU" "$INSTDIR\bin" ; Remove
+        EnVar::SetHKCU
     ${EndIf}
+    EnVar::DeleteValue "PATH" "$INSTDIR\bin"
+    Pop $0
 
     # make sure windows knows about the change
     SendMessage ${HWND_BROADCAST} ${WM_WININICHANGE} 0 "STR:Environment" /TIMEOUT=5000

janet.1

@@ -9,8 +9,8 @@ janet \- run the Janet language abstract machine
 [\fB\-m\fR \fIPATH\fR]
 [\fB\-c\fR \fIMODULE JIMAGE\fR]
 [\fB\-\-\fR]
-.IR script
+.BR script
-.IR args ...
+.BR args ...
 .SH DESCRIPTION
 Janet is a functional and imperative programming language and bytecode interpreter.
 It is a modern lisp, but lists are replaced by other data structures with better utility
@@ -25,6 +25,106 @@ Implemented in mostly standard C99, Janet runs on Windows, Linux and macOS.
 The few features that are not standard C99 (dynamic library loading, compiler
 specific optimizations), are fairly straight forward. Janet can be easily ported to
 most new platforms.
+
+.SH REPL KEY-BINDINGS
+
+.TP 16
+.BR Home
+Move cursor to the beginning of input line.
+
+.TP 16
+.BR End
+Move cursor to the end of input line.
+
+.TP 16
+.BR Left/Right
+Move cursor in input line.
+
+.TP 16
+.BR Up/Down
+Go backwards and forwards through history.
+
+.TP 16
+.BR Tab
+Complete current symbol, or show available completions.
+
+.TP 16
+.BR Delete
+Delete one character after the cursor.
+
+.TP 16
+.BR Backspace
+Delete one character before the cursor.
+
+.TP 16
+.BR Ctrl\-A
+Move cursor to the beginning of input line.
+
+.TP 16
+.BR Ctrl\-B
+Move cursor one character to the left.
+
+.TP 16
+.BR Ctrl\-E
+Move cursor to the end of input line.
+
+.TP 16
+.BR Ctrl\-F
+Move cursor one character to the right.
+
+.TP 16
+.BR Ctrl\-H
+Delete one character before the cursor.
+
+.TP 16
+.BR Ctrl\-K
+Delete everything after the cursor on the input line.
+
+.TP 16
+.BR Ctrl\-L
+Clear the screen.
+
+.TP 16
+.BR Ctrl\-N/Ctrl\-P
+Go forwards and backwards through history.
+
+.TP 16
+.BR Ctrl\-U
+Delete everything before the cursor on the input line.
+
+.TP 16
+.BR Ctrl\-W
+Delete one word before the cursor.
+
+.TP 16
+.BR Alt\-B/Alt\-F
+Move cursor backwards and forwards one word.
+
+.TP 16
+.BR Alt\-D
+Delete one word after the cursor.
+
+.TP 16
+.BR Alt\-,
+Go to earliest item in history.
+
+.TP 16
+.BR Alt\-.
+Go to last item in history.
+
+.LP
+
+The repl keybindings are loosely based on a subset of GNU readline, although
+Janet does not use GNU readline internally for the repl. It is a limited
+substitute for GNU readline, and does not handle
+utf-8 input or other mutlibyte input well.
+
+To disable the built-in repl input handling, pass the \fB\-s\fR option to Janet, and
+use a program like rlwrap with Janet to provide input.
+
+For key bindings that operate on words, a word is considered to be a sequence
+of characters that does not contain whitespace.
+
 .SH DOCUMENTATION
 
 For more complete API documentation, run a REPL (Read Eval Print Loop), and use the doc macro to

meson.build

@@ -1,4 +1,4 @@
-# Copyright (c) 2019 Calvin Rose and contributors
+# Copyright (c) 2020 Calvin Rose and contributors
 #
 # Permission is hereby granted, free of charge, to any person obtaining a copy
 # of this software and associated documentation files (the "Software"), to
@@ -20,7 +20,7 @@
 
 project('janet', 'c',
   default_options : ['c_std=c99', 'b_lundef=false', 'default_library=both'],
-  version : '1.6.0')
+  version : '1.8.1')
 
 # Global settings
 janet_path = join_paths(get_option('prefix'), get_option('libdir'), 'janet')
@@ -62,6 +62,7 @@ conf.set('JANET_NO_PEG', not get_option('peg'))
 conf.set('JANET_REDUCED_OS', get_option('reduced_os'))
 conf.set('JANET_NO_TYPED_ARRAY', not get_option('typed_array'))
 conf.set('JANET_NO_INT_TYPES', not get_option('int_types'))
+conf.set('JANET_NO_PRF', not get_option('prf'))
 conf.set('JANET_RECURSION_GUARD', get_option('recursion_guard'))
 conf.set('JANET_MAX_PROTO_DEPTH', get_option('max_proto_depth'))
 conf.set('JANET_MAX_MACRO_EXPAND', get_option('max_macro_expand'))
@@ -78,16 +79,10 @@ jconf = configure_file(output : 'janetconf.h',
 # Include directories
 incdir = include_directories(['src/include', '.'])
 
-# Building generated sources
-xxd = executable('xxd', 'tools/xxd.c', native : true)
-gen = generator(xxd,
-  output : '@BASENAME@.gen.c',
-  arguments : ['@INPUT@', '@OUTPUT@', '@EXTRA_ARGS@'])
-boot_gen = gen.process('src/boot/boot.janet', extra_args: 'janet_gen_boot')
-
 # Order is important here, as some headers
 # depend on other headers for the amalg target
 core_headers = [
+  'src/core/features.h',
   'src/core/util.h',
   'src/core/state.h',
   'src/core/gc.h',
@@ -149,24 +144,27 @@ boot_src = [
 ]
 
 mainclient_src = [
-  'src/mainclient/line.c',
+  'src/mainclient/shell.c'
-  'src/mainclient/main.c'
 ]
 
 # Build boot binary
-janet_boot = executable('janet-boot', core_src, boot_src, boot_gen,
+janet_boot = executable('janet-boot', core_src, boot_src,
   include_directories : incdir,
   c_args : '-DJANET_BOOTSTRAP',
   dependencies : [m_dep, dl_dep, thread_dep],
   native : true)
 
-# Build core image
+# Build janet.c
-core_image = custom_target('core_image',
+janetc = custom_target('janetc',
   input : [janet_boot],
-  output : 'core_image.gen.c',
+  output : 'janet.c',
-  command : [janet_boot, '@OUTPUT@', 'JANET_PATH', janet_path, 'JANET_HEADERPATH', header_path])
+  capture : true,
+  command : [
+    janet_boot, meson.current_source_dir(),
+    'JANET_PATH', janet_path, 'JANET_HEADERPATH', header_path
+  ])
 
-libjanet = library('janet', core_src, core_image,
+libjanet = library('janet', janetc,
   include_directories : incdir,
   dependencies : [m_dep, dl_dep, thread_dep],
   install : true)
@@ -186,14 +184,14 @@ else
   extra_cross_cflags = []
 endif
 
-janet_mainclient = executable('janet', core_src, core_image, mainclient_src,
+janet_mainclient = executable('janet', janetc, mainclient_src,
   include_directories : incdir,
   dependencies : [m_dep, dl_dep, thread_dep],
   c_args : extra_native_cflags,
   install : true)
 
 if meson.is_cross_build()
-  janet_nativeclient = executable('janet-native', core_src, core_image, mainclient_src,
+  janet_nativeclient = executable('janet-native', janetc, mainclient_src,
     include_directories : incdir,
     dependencies : [m_dep, dl_dep, thread_dep],
     c_args : extra_cross_cflags,
@@ -209,25 +207,6 @@ docs = custom_target('docs',
   capture : true,
   command : [janet_nativeclient, '@INPUT@'])
 
-# Amalgamated source
-amalg = custom_target('amalg',
-  input : ['tools/amalg.janet', core_headers, core_src, core_image],
-  output : ['janet.c'],
-  capture : true,
-  command : [janet_nativeclient, '@INPUT@'])
-amalg_shell = custom_target('amalg-shell',
-  input : ['tools/amalg.janet', 'src/mainclient/line.h',
-    'src/mainclient/line.c', 'src/mainclient/main.c'],
-  output : ['shell.c'],
-  capture : true,
-  command : [janet_nativeclient, '@INPUT@'])
-
-# Amalgamated client
-janet_amalgclient = executable('janet-amalg', amalg, amalg_shell,
-  include_directories : incdir,
-  dependencies : [m_dep, dl_dep, thread_dep],
-  build_by_default : false)
-
 # Tests
 test_files = [
   'test/suite0.janet',
@@ -237,7 +216,8 @@ test_files = [
   'test/suite4.janet',
   'test/suite5.janet',
   'test/suite6.janet',
-  'test/suite7.janet'
+  'test/suite7.janet',
+  'test/suite8.janet'
 ]
 foreach t : test_files
   test(t, janet_nativeclient, args : files([t]), workdir : meson.current_source_dir())
@@ -250,6 +230,11 @@ run_target('repl', command : [janet_nativeclient])
 janet_dep = declare_dependency(include_directories : incdir,
   link_with : libjanet)
 
+# pkgconfig
+pkg = import('pkgconfig')
+pkg.generate(libjanet,
+  description: 'Library for the Janet programming language.')
+
 # Installation
 install_man('janet.1')
 install_man('jpm.1')
@@ -257,5 +242,5 @@ install_headers(['src/include/janet.h', jconf], subdir: 'janet')
 janet_binscripts = [
   'auxbin/jpm'
 ]
-install_data(sources : janet_binscripts, install_dir : 'bin')
+install_data(sources : janet_binscripts, install_dir : get_option('bindir'))
-install_data(sources : ['tools/.keep'], install_dir : 'lib/janet')
+install_data(sources : ['tools/.keep'], install_dir : join_paths(get_option('libdir'), 'janet'))

meson_options.txt

@@ -10,6 +10,7 @@ option('assembler', type : 'boolean', value : true)
 option('peg', type : 'boolean', value : true)
 option('typed_array', type : 'boolean', value : true)
 option('int_types', type : 'boolean', value : true)
+option('prf', type : 'boolean', value : true)
 
 option('recursion_guard', type : 'integer', min : 10, max : 8000, value : 1024)
 option('max_proto_depth', type : 'integer', min : 10, max : 8000, value : 200)

src/boot/array_test.c

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

src/boot/boot.c

@@ -1,5 +1,5 @@
 /*
-* Copyright (c) 2019 Calvin Rose
+* Copyright (c) 2020 Calvin Rose
 *
 * Permission is hereby granted, free of charge, to any person obtaining a copy
 * of this software and associated documentation files (the "Software"), to
@@ -23,6 +23,13 @@
 #include <janet.h>
 #include "tests.h"
 
+#ifdef JANET_WINDOWS
+#include <direct.h>
+#define chdir(x) _chdir(x)
+#else
+#include <unistd.h>
+#endif
+
 extern const unsigned char *janet_gen_boot;
 extern int32_t janet_gen_boot_size;
 
@@ -63,13 +70,42 @@ int main(int argc, const char **argv) {
     janet_def(env, "boot/config", janet_wrap_table(opts), "Boot options");
 
     /* Run bootstrap script to generate core image */
-    const char *boot_file;
+    const char *boot_filename;
 #ifdef JANET_NO_SOURCEMAPS
-    boot_file = NULL;
+    boot_filename = NULL;
 #else
-    boot_file = "boot.janet";
+    boot_filename = "boot.janet";
 #endif
-    status = janet_dobytes(env, janet_gen_boot, janet_gen_boot_size, boot_file, NULL);
+
+    int chdir_status = chdir(argv[1]);
+    if (chdir_status) {
+        fprintf(stderr, "Could not change to directory %s\n", argv[1]);
+        exit(1);
+    }
+
+    FILE *boot_file = fopen("src/boot/boot.janet", "rb");
+    if (NULL == boot_file) {
+        fprintf(stderr, "Could not open src/boot/boot.janet\n");
+        exit(1);
+    }
+
+    /* Slurp file into buffer */
+    fseek(boot_file, 0, SEEK_END);
+    size_t boot_size = ftell(boot_file);
+    fseek(boot_file, 0, SEEK_SET);
+    unsigned char *boot_buffer = malloc(boot_size);
+    if (NULL == boot_buffer) {
+        fprintf(stderr, "Failed to allocate boot buffer\n");
+        exit(1);
+    }
+    if (!fread(boot_buffer, 1, boot_size, boot_file)) {
+        fprintf(stderr, "Failed to read into boot buffer\n");
+        exit(1);
+    }
+    fclose(boot_file);
+
+    status = janet_dobytes(env, boot_buffer, (int32_t) boot_size, boot_filename, NULL);
+    free(boot_buffer);
 
     /* Deinitialize vm */
     janet_deinit();

src/boot/boot.janet

@@ -1,5 +1,5 @@
 # The core janet library
-# Copyright 2019 © Calvin Rose
+# Copyright 2020 © Calvin Rose
 
 ###
 ###
@@ -58,6 +58,11 @@
   [name & more]
   ~(def ,name :private ,;more))
 
+(defmacro var-
+  "Define a private var that will not be exported."
+  [name & more]
+  ~(var ,name :private ,;more))
+
 (defn defglobal
   "Dynamically create a global def."
   [name value]
@@ -74,12 +79,12 @@
 
 # Basic predicates
 (defn nan? "Check if x is NaN" [x] (not= x x))
-(defn even? "Check if x is even." [x] (== 0 (% x 2)))
+(defn even? "Check if x is even." [x] (= 0 (mod x 2)))
-(defn odd? "Check if x is odd." [x] (not= 0 (% x 2)))
+(defn odd? "Check if x is odd." [x] (= 1 (mod x 2)))
-(defn zero? "Check if x is zero." [x] (== x 0))
+(defn zero? "Check if x is zero." [x] (= x 0))
 (defn pos? "Check if x is greater than 0." [x] (> x 0))
 (defn neg? "Check if x is less than 0." [x] (< x 0))
-(defn one? "Check if x is equal to 1." [x] (== x 1))
+(defn one? "Check if x is equal to 1." [x] (= x 1))
 (defn number? "Check if x is a number." [x] (= (type x) :number))
 (defn fiber? "Check if x is a fiber." [x] (= (type x) :fiber))
 (defn string? "Check if x is a string." [x] (= (type x) :string))
@@ -131,6 +136,11 @@
 (defmacro /= "Shorthand for (set x (/ x n))." [x n] ~(set ,x (,/ ,x ,n)))
 (defmacro %= "Shorthand for (set x (% x n))." [x n] ~(set ,x (,% ,x ,n)))
 
+(defn assert
+  "Throw an error if x is not truthy."
+  [x &opt err]
+  (if x x (error (if err err "assert failure"))))
+
 (defmacro default
   "Define a default value for an optional argument.
   Expands to (def sym (if (= nil sym) val sym))"
@@ -219,7 +229,7 @@
         r (gensym)]
     ~(let [,f (,fiber/new (fn [] ,body) :ie)
            ,r (,resume ,f)]
-       (if (= (,fiber/status ,f) :error)
+       (if (,= (,fiber/status ,f) :error)
          (do (def ,err ,r) ,(if fib ~(def ,fib ,f)) ,;(tuple/slice catch 1))
          ,r))))
 
@@ -234,26 +244,30 @@
       [(,not= :error (,fiber/status ,f)) ,r])))
 
 (defmacro and
-  "Evaluates to the last argument if all preceding elements are true, otherwise
+  "Evaluates to the last argument if all preceding elements are truthy, otherwise
-  evaluates to false."
+  evaluates to the first falsey argument."
   [& forms]
   (var ret true)
   (def len (length forms))
   (var i len)
   (while (> i 0)
     (-- i)
+    (def v (in forms i))
     (set ret (if (= ret true)
-               (in forms i)
+               v
-               (tuple 'if (in forms i) ret))))
+               (if (idempotent? v)
+                 ['if v ret v]
+                 (do (def s (gensym))
+                   ['if ['def s v] ret s])))))
   ret)
 
 (defmacro or
-  "Evaluates to the last argument if all preceding elements are false, otherwise
+  "Evaluates to the last argument if all preceding elements are falsey, otherwise
-  evaluates to true."
+  evaluates to the first truthy element."
   [& forms]
-  (var ret nil)
   (def len (length forms))
-  (var i len)
+  (var i (- len 1))
+  (var ret (in forms i))
   (while (> i 0)
     (-- i)
     (def fi (in forms i))
@@ -276,20 +290,77 @@
     (++ i))
   ~(let (,;accum) ,;body))
 
+(defmacro defer
+  "Run form unconditionally after body, even if the body throws an error.
+  Will also run form if a user signal 0-4 is received."
+  [form & body]
+  (with-syms [f r]
+    ~(do
+       (def ,f (,fiber/new (fn [] ,;body) :ti))
+       (def ,r (,resume ,f))
+       ,form
+       (if (= (,fiber/status ,f) :dead)
+         ,r
+         (propagate ,r ,f)))))
+
+(defmacro prompt
+  "Set up a checkpoint that can be returned to. Tag should be a value
+  that is used in a return statement, like a keyword."
+  [tag & body]
+  (with-syms [res target payload fib]
+    ~(do
+       (def ,fib (,fiber/new (fn [] [,tag (do ,;body)]) :i0))
+       (def ,res (,resume ,fib))
+       (def [,target ,payload] ,res)
+       (if (,= ,tag ,target)
+         ,payload
+         (propagate ,res ,fib)))))
+
+(defmacro chr
+  "Convert a string of length 1 to its byte (ascii) value at compile time."
+  [c]
+  (unless (and (string? c) (= (length c) 1))
+    (error (string/format "expected string of length 1, got %v" c)))
+  (c 0))
+
+(defmacro label
+  "Set a label point that is lexically scoped. Name should be a symbol
+  that will be bound to the label."
+  [name & body]
+  ~(do
+     (def ,name @"")
+     ,(apply prompt name body)))
+
+(defn return
+  "Return to a prompt point."
+  [to &opt value]
+  (signal 0 [to value]))
+
 (defmacro with
   "Evaluate body with some resource, which will be automatically cleaned up
   if there is an error in body. binding is bound to the expression ctor, and
   dtor is a function or callable that is passed the binding. If no destructor
   (dtor) is given, will call :close on the resource."
   [[binding ctor dtor] & body]
-  (with-syms [res f]
+  ~(do
-    ~(let [,binding ,ctor
+     (def ,binding ,ctor)
-           ,f (,fiber/new (fn [] ,;body) :ie)
+     ,(apply defer [(or dtor :close) binding] body)))
-           ,res (,resume ,f)]
+
-       (,(or dtor :close) ,binding)
+(defmacro when-with
-       (if (,= (,fiber/status ,f) :error)
+  "Similar to with, but if binding is false or nil, returns
-         (,propagate ,res ,f)
+  nil without evaluating the body. Otherwise, the same as with."
-         ,res))))
+  [[binding ctor dtor] & body]
+  ~(if-let [,binding ,ctor]
+     ,(apply defer [(or dtor :close) binding] body)))
+
+(defmacro if-with
+  "Similar to with, but if binding is false or nil, evaluates
+  the falsey path. Otherwise, evaluates the truthy path. In both cases,
+  ctor is bound to binding."
+  [[binding ctor dtor] truthy &opt falsey ]
+  ~(if-let [,binding ,ctor]
+     ,(apply defer [(or dtor :close) binding] [truthy])
+     ,falsey))
 
 (defn- for-template
   [binding start stop step comparison delta body]
@@ -302,18 +373,27 @@
          ,;body
          (set ,i (,delta ,i ,step))))))
 
+(defn- check-indexed [x]
+  (if (indexed? x)
+    x
+    (error (string "expected tuple for range, got " x))))
+
+(defn- range-template
+  [binding object rest op comparison]
+  (let [[start stop step] (check-indexed object)]
+    (for-template binding start stop (or step 1) comparison op [rest])))
+
 (defn- each-template
-  [binding in body]
+  [binding inx body]
-  (with-syms [i len]
+  (with-syms [k]
-    (def ds (if (idempotent? in) in (gensym)))
+    (def ds (if (idempotent? inx) inx (gensym)))
     ~(do
-       (var ,i 0)
+       ,(unless (= ds inx) ~(def ,ds ,inx))
-       ,(unless (= ds in) ~(def ,ds ,in))
+       (var ,k (,next ,ds nil))
-       (def ,len (,length ,ds))
+       (while (,not= nil ,k)
-       (while (,< ,i ,len)
+         (def ,binding (,in ,ds ,k))
-         (def ,binding (in ,ds ,i))
          ,;body
-         (++ ,i)))))
+         (set ,k (,next ,ds ,k))))))
 
 (defn- keys-template
   [binding in pair? body]
@@ -322,7 +402,7 @@
     ~(do
        ,(unless (= ds in) ~(def ,ds ,in))
        (var ,k (,next ,ds nil))
-       (while ,k
+       (while (,not= nil ,k)
          (def ,binding ,(if pair? ~(tuple ,k (in ,ds ,k)) k))
          ,;body
          (set ,k (,next ,ds ,k))))))
@@ -336,11 +416,6 @@
          (def ,binding ,i)
          ,body))))
 
-(defn- check-indexed [x]
-  (if (indexed? x)
-    x
-    (error (string "expected tuple for range, got " x))))
-
 (defn- loop1
   [body head i]
 
@@ -370,12 +445,12 @@
   (def {(+ i 2) object} head)
   (let [rest (loop1 body head (+ i 3))]
     (case verb
-      :range (let [[start stop step] (check-indexed object)]
+      :range (range-template binding object rest + <)
-               (for-template binding start stop (or step 1) < + [rest]))
+      :range-to (range-template binding object rest + <=)
+      :down (range-template binding object rest - >)
+      :down-to (range-template binding object rest - >=)
       :keys (keys-template binding object false [rest])
       :pairs (keys-template binding object true [rest])
-      :down (let [[start stop step] (check-indexed object)]
-              (for-template binding start stop (or step 1) > - [rest]))
       :in (each-template binding object [rest])
       :iterate (iterate-template binding object rest)
       :generate (with-syms [f s]
@@ -391,10 +466,20 @@
   [i start stop & body]
   (for-template i start stop 1 < + body))
 
+(defmacro eachk
+  "loop over each key in ds. returns nil."
+  [x ds & body]
+  (keys-template x ds false body))
+
+(defmacro eachp
+  "Loop over each (key, value) pair in ds. Returns nil."
+  [x ds & body]
+  (keys-template x ds true body))
+
 (defmacro each
-  "Loop over each value in ind. Returns nil."
+  "Loop over each value in ds. Returns nil."
-  [x ind & body]
+  [x ds & body]
-  (each-template x ind body))
+  (each-template x ds body))
 
 (defmacro loop
   "A general purpose loop macro. This macro is similar to the Common Lisp
@@ -408,11 +493,14 @@
   \t:iterate - repeatedly evaluate and bind to the expression while it is truthy.\n
   \t:range - loop over a range. The object should be two element tuple with a start
   and end value, and an optional positive step. The range is half open, [start, end).\n
-  \t:down - Same as range, but loops in reverse.\n
+  \t:range-to - same as :range, but the range is inclusive [start, end].\n
-  \t:keys - Iterate over the keys in a data structure.\n
+  \t:down - loop over a range, stepping downwards. The object should be two element tuple
-  \t:pairs - Iterate over the keys value pairs in a data structure.\n
+  with a start and (exclusive) end value, and an optional (positive!) step size.\n
-  \t:in - Iterate over the values in an indexed data structure or byte sequence.\n
+  \t:down-to - same :as down, but the range is inclusive [start, end].\n
-  \t:generate - Iterate over values yielded from a fiber. Can be paired with the generator
+  \t:keys - iterate over the keys in a data structure.\n
+  \t:pairs - iterate over the keys value pairs as tuples in a data structure.\n
+  \t:in - iterate over the values in a data structure.\n
+  \t:generate - iterate over values yielded from a fiber. Can be paired with the generator
   function for the producer/consumer pattern.\n\n
   loop also accepts conditionals to refine the looping further. Conditionals are of
   the form:\n\n
@@ -436,6 +524,7 @@
 (put _env 'iterate-template nil)
 (put _env 'each-template nil)
 (put _env 'keys-template nil)
+(put _env 'range-template nil)
 
 (defmacro seq
   "Similar to loop, but accumulates the loop body into an array and returns that.
@@ -551,20 +640,10 @@
   "Returns the numeric minimum of the arguments."
   [& args] (extreme < args))
 
-(defn max-order
-  "Returns the maximum of the arguments according to a total
-  order over all values."
-  [& args] (extreme order> args))
-
-(defn min-order
-  "Returns the minimum of the arguments according to a total
-  order over all values."
-  [& args] (extreme order< args))
-
 (defn first
   "Get the first element from an indexed data structure."
   [xs]
-  (in xs 0))
+  (get xs 0))
 
 (defn last
   "Get the last element from an indexed data structure."
@@ -605,11 +684,11 @@
       a)
 
     (fn sort [a &opt by]
-      (sort-help a 0 (- (length a) 1) (or by order<)))))
+      (sort-help a 0 (- (length a) 1) (or by <)))))
 
 (defn sorted
   "Returns a new sorted array without modifying the old one."
-  [ind by]
+  [ind &opt by]
   (sort (array/slice ind) by))
 
 (defn reduce
@@ -620,6 +699,45 @@
   (each x ind (set res (f res x)))
   res)
 
+(defn reduce2
+  "The 2 argument version of reduce that does not take an initialization value.
+  Instead the first element of the array is used for initialization."
+  [f ind]
+  (var k (next ind))
+  (if (= nil k) (break nil))
+  (var res (in ind k))
+  (set k (next ind k))
+  (while (not= nil k)
+    (set res (f res (in ind k)))
+    (set k (next ind k)))
+  res)
+
+(defn accumulate
+  "Similar to reduce, but accumulates intermediate values into an array.
+  The last element in the array is what would be the return value from reduce.
+  The init value is not added to the array.
+  Returns a new array."
+  [f init ind]
+  (var res init)
+  (def ret (array/new (length ind)))
+  (each x ind (array/push ret (set res (f res x))))
+  ret)
+
+(defn accumulate2
+  "The 2 argument version of accumulate that does not take an initialization value."
+  [f ind]
+  (var k (next ind))
+  (def ret (array/new (length ind)))
+  (if (= nil k) (break ret))
+  (var res (in ind k))
+  (array/push ret res)
+  (set k (next ind k))
+  (while (not= nil k)
+    (set res (f res (in ind k)))
+    (array/push ret res)
+    (set k (next ind k)))
+  ret)
+
 (defn map
   "Map a function over every element in an indexed data structure and
   return an array of the results."
@@ -729,8 +847,10 @@
   [n ind]
   (def use-str (bytes? ind))
   (def f (if use-str string/slice tuple/slice))
+  (def len (length ind))
   # make sure end is in [0, len]
-  (def end (max 0 (min n (length ind))))
+  (def m (if (> n 0) n 0))
+  (def end (if (> m len) len m))
   (f ind 0 end))
 
 (defn take-until
@@ -754,8 +874,10 @@
   [n ind]
   (def use-str (bytes? ind))
   (def f (if use-str string/slice tuple/slice))
+  (def len (length ind))
   # make sure start is in [0, len]
-  (def start (max 0 (min n (length ind))))
+  (def m (if (> n 0) n 0))
+  (def start (if (> m len) len m))
   (f ind start -1))
 
 (defn drop-until
@@ -939,11 +1061,10 @@
   (with-syms [ret f s]
   ~(do
      ,;saveold
-     (def ,f (,fiber/new (fn [] ,;setnew ,;body) :ei))
+     (def ,f (,fiber/new (fn [] ,;setnew ,;body) :ti))
      (def ,ret (,resume ,f))
      ,;restoreold
-     (if (= (,fiber/status ,f) :error) (,propagate ,ret ,f))
+     (if (= (,fiber/status ,f) :dead) ,ret (,propagate ,ret ,f)))))
-     ,ret)))
 
 (defn partial
   "Partial function application."
@@ -1214,9 +1335,10 @@
   nil)
 
 (defn pp
-  "Pretty print to stdout or (dyn :out)."
+  `Pretty print to stdout or (dyn :out). The format string used is (dyn :pretty-format "%q").`
   [x]
-  (print (buffer/format @"" (dyn :pretty-format "%q") x)))
+  (printf (dyn :pretty-format "%q") x)
+  (flush))
 
 ###
 ###
@@ -1249,12 +1371,15 @@
   [pattern expr onmatch seen]
   (cond
 
+    (= '_ pattern)
+    (onmatch)
+
     (symbol? pattern)
     (if (in seen pattern)
       ~(if (= ,pattern ,expr) ,(onmatch) ,sentinel)
       (do
         (put seen pattern true)
-        ~(if (= nil (def ,pattern ,expr)) ,sentinel ,(onmatch))))
+        ~(do (def ,pattern ,expr) ,(onmatch))))
 
     (and (tuple? pattern) (= :parens (tuple/type pattern)))
     (if (and (= (pattern 0) '@) (symbol? (pattern 1)))
@@ -1271,12 +1396,14 @@
       (var i -1)
       (with-idemp
         $arr expr
-        ~(if (indexed? ,$arr)
+        ~(if (,indexed? ,$arr)
-           ,((fn aux []
+           (if (< (,length ,$arr) ,len)
-               (++ i)
+             ,sentinel
-               (if (= i len)
+             ,((fn aux []
-                 (onmatch)
+                 (++ i)
-                 (match-1 (in pattern i) (tuple in $arr i) aux seen))))
+                 (if (= i len)
+                   (onmatch)
+                   (match-1 (in pattern i) (tuple in $arr i) aux seen)))))
            ,sentinel)))
 
     (dictionary? pattern)
@@ -1284,26 +1411,29 @@
       (var key nil)
       (with-idemp
         $dict expr
-        ~(if (dictionary? ,$dict)
+        ~(if (,dictionary? ,$dict)
            ,((fn aux []
                (set key (next pattern key))
+               (def $val (gensym))
                (if (= key nil)
                  (onmatch)
-                 (match-1 (in pattern key) (tuple in $dict key) aux seen))))
+                 ~(do (def ,$val (,get ,$dict ,key))
+                   ,(match-1 [(in pattern key) [not= nil $val]] $val aux seen)))))
            ,sentinel)))
 
     :else ~(if (= ,pattern ,expr) ,(onmatch) ,sentinel)))
 
 (defmacro match
   "Pattern matching. Match an expression x against
-  any number of cases. Easy case is a pattern to match against, followed
+  any number of cases. Each case is a pattern to match against, followed
   by an expression to evaluate to if that case is matched. A pattern that is
   a symbol will match anything, binding x's value to that symbol. An array
   will match only if all of it's elements match the corresponding elements in
   x. A table or struct will match if all values match with the corresponding
   values in x. A tuple pattern will match if it's first element matches, and the following
-  elements are treated as predicates and are true. Any other value pattern will only
+  elements are treated as predicates and are true. The last special case is
-  match if it is equal to x."
+  the '_ symbol, which is a wildcard that will match any value without creating a binding.
+  Any other value pattern will only match if it is equal to x."
   [x & cases]
   (with-idemp $x x
     (def len (length cases))
@@ -1427,7 +1557,7 @@
                  (if-let [[path line col] sm]
                    (string "    " path " on line " line ", column " col "\n") "")
                  (if (or d sm) "\n" "")
-                 (if d (doc-format d) "no documentation found.")
+                 (if d (doc-format d) "    no documentation found.")
                  "\n\n"))))
 
     # else
@@ -1520,7 +1650,8 @@
      'quote identity
      'quasiquote expandqq
      'var expanddef
-     'while expandall})
+     'while expandall
+     'break expandall})
 
   (defn dotup [t]
     (def h (in t 0))
@@ -1545,14 +1676,16 @@
   ret)
 
 (defn all
-  "Returns true if all xs are truthy, otherwise the first false or nil value."
+  "Returns true if all xs are truthy, otherwise the resulty of first
+  falsey predicate value, (pred x)."
   [pred xs]
   (var ret true)
   (loop [x :in xs :while ret] (set ret (pred x)))
   ret)
 
 (defn some
-  "Returns false if all xs are false or nil, otherwise returns the first true value."
+  "Returns nil if all xs are false or nil, otherwise returns the result of the
+  first truthy predicate, (pred x)."
   [pred xs]
   (var ret nil)
   (loop [x :in xs :while (not ret)] (if-let [y (pred x)] (set ret y)))
@@ -1738,20 +1871,23 @@
     (string col)
     ": "
     (parser/error p)
-    (if ec "\e[0m" "")))
+    (if ec "\e[0m" ""))
+  (eflush))
 
 (defn bad-compile
   "Default handler for a compile error."
   [msg macrof where]
   (def ec (dyn :err-color))
-  (eprint
+  (if macrof
-    (if ec "\e[31m" "")
+    (debug/stacktrace macrof (string msg " while compiling " where))
-    "compile error: "
+    (eprint
-    msg
+      (if ec "\e[31m" "")
-    " while compiling "
+      "compile error: "
-    where
+      msg
-    (if ec "\e[0m" ""))
+      " while compiling "
-  (when macrof (debug/stacktrace macrof)))
+      where
+      (if ec "\e[0m" "")))
+  (eflush))
 
 (defn run-context
   "Run a context. This evaluates expressions of janet in an environment,
@@ -1778,7 +1914,7 @@
         :source where
         :expander expand} opts)
   (default env (fiber/getenv (fiber/current)))
-  (default chunks (fn [buf p] (getline "" buf)))
+  (default chunks (fn [buf p] (getline "" buf env)))
   (default onstatus debug/stacktrace)
   (default on-compile-error bad-compile)
   (default on-parse-error bad-parse)
@@ -1812,8 +1948,7 @@
               (on-compile-error msg errf where))))
         (or guard :a)))
     (fiber/setenv f env)
-    (while (let [fs (fiber/status f)]
+    (while (fiber/can-resume? f)
-             (and (not= :dead fs) (not= :error fs)))
       (def res (resume f resumeval))
       (when good (when going (set resumeval (onstatus f res))))))
 
@@ -1924,27 +2059,33 @@
   from searching that path template if the filter doesn't match the input
   path. The filter can be a string or a predicate function, and
   is often a file extension, including the period."
-  @[# Relative to (dyn :current-file "./."). Path must start with .
+  @[])
-    [":cur:/:all:.jimage" :image check-.]
-    [":cur:/:all:.janet" :source check-.]
-    [":cur:/:all:/init.janet" :source check-.]
-    [":cur:/:all::native:" :native check-.]
-
-    # As a path from (os/cwd)
-    [":all:.jimage" :image not-check-.]
-    [":all:.janet" :source not-check-.]
-    [":all:/init.janet" :source not-check-.]
-    [":all::native:" :native not-check-.]
-
-    # System paths
-    [":sys:/:all:.jimage" :image not-check-.]
-    [":sys:/:all:.janet" :source not-check-.]
-    [":sys:/:all:/init.janet" :source not-check-.]
-    [":sys:/:all::native:" :native not-check-.]])
 
 (setdyn :syspath (boot/opts "JANET_PATH"))
 (setdyn :headerpath (boot/opts "JANET_HEADERPATH"))
 
+(defn module/add-paths
+  "Add paths to module/paths for a given loader such that
+  the generated paths behave like other module types, including
+  relative imports and syspath imports. ext is the file extension
+  to associate with this module type, including the dot. loader is the
+  keyword name of a loader that is module/loaders. Returns the modified module/paths."
+  [ext loader]
+  (defn- find-prefix
+    [pre]
+    (or (find-index |(string/has-prefix? pre ($ 0)) module/paths) 0))
+  (array/insert module/paths 0 [(string ":cur:/:all:" ext) loader check-.])
+  (def all-index (find-prefix ":all:"))
+  (array/insert module/paths all-index [(string ":all:" ext) loader not-check-.])
+  (def sys-index (find-prefix ":sys:"))
+  (array/insert module/paths sys-index [(string ":sys:/:all:" ext) loader not-check-.])
+  module/paths)
+
+(module/add-paths ":native:" :native)
+(module/add-paths "/init.janet" :source)
+(module/add-paths ".janet" :source)
+(module/add-paths ".jimage" :image)
+
 # Version of fexists that works even with a reduced OS
 (if-let [has-stat (_env 'os/stat)]
   (let [stat (has-stat :value)]
@@ -2042,7 +2183,7 @@
                   :on-status (fn [f x]
                                (when (not= (fiber/status f) :dead)
                                  (debug/stacktrace f x)
-                                 (if exit-on-error (os/exit 1))))
+                                 (if exit-on-error (os/exit 1) (eflush))))
                   :evaluator evaluator
                   :expander expander
                   :source (if path-is-file "<anonymous>" spath)}))
@@ -2071,7 +2212,7 @@
   (if-let [check (in module/cache fullpath)]
     check
     (do
-      (def loader (module/loaders mod-kind))
+      (def loader (if (keyword? mod-kind) (module/loaders mod-kind) mod-kind))
       (unless loader (error (string "module type " mod-kind " unknown")))
       (def env (loader fullpath args))
       (put module/cache fullpath env)
@@ -2086,7 +2227,10 @@
         :prefix prefix
         :export ep} (table ;args))
   (def newenv (require path ;args))
-  (def prefix (or (and as (string as "/")) prefix (string path "/")))
+  (def prefix (or
+                (and as (string as "/"))
+                prefix
+                (string (last (string/split "/" path)) "/")))
   (loop [[k v] :pairs newenv :when (symbol? k) :when (not (v :private))]
     (def newv (table/setproto @{:private (not ep)} v))
     (put env (symbol prefix k) newv)))
@@ -2098,7 +2242,7 @@
   use the name of the module as a prefix. One can also use :export true
   to re-export the imported symbols. If :exit true is given as an argument,
   any errors encountered at the top level in the module will cause (os/exit 1)
-  to be called."
+  to be called. Dynamic bindings will NOT be imported."
   [path & args]
   (def argm (map (fn [x]
                    (if (keyword? x)
@@ -2131,7 +2275,7 @@
                                                ((parser/where p) 0)
                                                ":"
                                                (parser/state p :delimiters) "> ")
-                                       buf)))
+                                       buf env)))
   (defn make-onsignal
     [e level]
 
@@ -2142,14 +2286,17 @@
       (put nextenv :debug-level level)
       (put nextenv :signal x)
       (debug/stacktrace f x)
+      (eflush)
       (defn debugger-chunks [buf p]
         (def status (parser/state p :delimiters))
         (def c ((parser/where p) 0))
         (def prompt (string "debug[" level "]:" c ":" status "> "))
-        (getline prompt buf))
+        (getline prompt buf nextenv))
       (print "entering debug[" level "] - (quit) to exit")
+      (flush)
       (repl debugger-chunks (make-onsignal nextenv (+ 1 level)) nextenv)
       (print "exiting debug[" level "]")
+      (flush)
       (nextenv :resume-value))
 
     (fn [f x]
@@ -2157,7 +2304,7 @@
         (do (pp x) (put e '_ @{:value x}))
         (if (e :debug)
           (enter-debugger f x)
-          (do (debug/stacktrace f x) nil)))))
+          (do (debug/stacktrace f x) (eflush))))))
 
   (run-context {:env env
                 :chunks chunks
@@ -2170,6 +2317,29 @@
 ###
 ###
 
+(defn- no-side-effects
+  "Check if form may have side effects. If returns true, then the src
+  must not have side effects, such as calling a C function."
+  [src]
+  (cond
+    (tuple? src)
+    (if (= (tuple/type src) :brackets)
+      (all no-side-effects src))
+    (array? src)
+    (all no-side-effects src)
+    (dictionary? src)
+    (and (all no-side-effects (keys src))
+         (all no-side-effects (values src)))
+    true))
+
+(defn- is-safe-def [x] (no-side-effects (last x)))
+
+(def- safe-forms {'defn true 'defn- true 'defmacro true 'defmacro- true
+                  'def is-safe-def 'var is-safe-def 'def- is-safe-def 'var- is-safe-def
+                  'defglobal is-safe-def 'varglobal is-safe-def})
+
+(def- importers {'import true 'import* true 'use true 'dofile true 'require true})
+
 (defn cli-main
   "Entrance for the Janet CLI tool. Call this functions with the command line
   arguments as an array or tuple of strings to invoke the CLI interface."
@@ -2237,15 +2407,21 @@
     (def h (in handlers n))
     (if h (h i) (do (print "unknown flag -" n) ((in handlers "h")))))
 
-  (def- safe-forms {'defn true 'defn- true 'defmacro true 'defmacro- true})
-  (def- importers {'import true 'import* true 'use true 'dofile true 'require true})
   (defn- evaluator
     [thunk source env where]
     (if *compile-only*
       (when (tuple? source)
+        (def head (source 0))
+        (def safe-check (safe-forms head))
         (cond
-          (safe-forms (source 0)) (thunk)
+          # Sometimes safe form
-          (importers (source 0))
+          (function? safe-check)
+          (if (safe-check source) (thunk))
+          # Always safe form
+          safe-check
+          (thunk)
+          # Import-like form
+          (importers head)
           (do
             (let [[l c] (tuple/sourcemap source)
                   newtup (tuple/setmap (tuple ;source :evaluator evaluator) l c)]
@@ -2272,23 +2448,30 @@
 
   (when (and (not *compile-only*) (or *should-repl* *no-file*))
     (if-not *quiet*
-      (print "Janet " janet/version "-" janet/build "  Copyright (C) 2017-2019 Calvin Rose"))
+      (print "Janet " janet/version "-" janet/build "  Copyright (C) 2017-2020 Calvin Rose"))
+    (flush)
     (defn noprompt [_] "")
     (defn getprompt [p]
       (def [line] (parser/where p))
       (string "janet:" line ":" (parser/state p :delimiters) "> "))
     (def prompter (if *quiet* noprompt getprompt))
-    (defn getstdin [prompt buf]
+    (defn getstdin [prompt buf _]
       (file/write stdout prompt)
       (file/flush stdout)
       (file/read stdin :line buf))
+    (def env (make-env))
     (def getter (if *raw-stdin* getstdin getline))
     (defn getchunk [buf p]
-      (getter (prompter p) buf))
+      (getter (prompter p) buf env))
     (def onsig (if *quiet* (fn [x &] x) nil))
     (setdyn :pretty-format (if *colorize* "%.20Q" "%.20q"))
     (setdyn :err-color (if *colorize* true))
-    (repl getchunk onsig)))
+    (repl getchunk onsig env)))
+
+(put _env 'no-side-effects nil)
+(put _env 'is-safe-def nil)
+(put _env 'safe-forms nil)
+(put _env 'importers nil)
 
 
 ###
@@ -2343,21 +2526,92 @@
                    reverse-lookup (invert lookup)]
                (marshal env reverse-lookup)))
 
+  # Create amalgamation
+
+  (def feature-header "src/core/features.h")
+
+  (def local-headers
+    ["src/core/util.h"
+     "src/core/state.h"
+     "src/core/gc.h"
+     "src/core/vector.h"
+     "src/core/fiber.h"
+     "src/core/regalloc.h"
+     "src/core/compile.h"
+     "src/core/emit.h"
+     "src/core/symcache.h"])
+
+  (def core-sources
+    ["src/core/abstract.c"
+     "src/core/array.c"
+     "src/core/asm.c"
+     "src/core/buffer.c"
+     "src/core/bytecode.c"
+     "src/core/capi.c"
+     "src/core/cfuns.c"
+     "src/core/compile.c"
+     "src/core/corelib.c"
+     "src/core/debug.c"
+     "src/core/emit.c"
+     "src/core/fiber.c"
+     "src/core/gc.c"
+     "src/core/inttypes.c"
+     "src/core/io.c"
+     "src/core/marsh.c"
+     "src/core/math.c"
+     "src/core/os.c"
+     "src/core/parse.c"
+     "src/core/peg.c"
+     "src/core/pp.c"
+     "src/core/regalloc.c"
+     "src/core/run.c"
+     "src/core/specials.c"
+     "src/core/string.c"
+     "src/core/strtod.c"
+     "src/core/struct.c"
+     "src/core/symcache.c"
+     "src/core/table.c"
+     "src/core/thread.c"
+     "src/core/tuple.c"
+     "src/core/typedarray.c"
+     "src/core/util.c"
+     "src/core/value.c"
+     "src/core/vector.c"
+     "src/core/vm.c"
+     "src/core/wrap.c"])
+
+  # Print janet.c to stdout
+  (print "/* Amalgamated build - DO NOT EDIT */")
+  (print "/* Generated from janet version " janet/version "-" janet/build " */")
+  (print "#define JANET_BUILD \"" janet/build "\"")
+  (print ```#define JANET_AMALG```)
+
+  (defn do-one-file
+    [fname]
+    (print "\n/* " fname " */")
+    (print "#line 0 \"" fname "\"\n")
+    (def source (slurp fname))
+    (print (string/replace-all "\r" "" source)))
+
+  (do-one-file feature-header)
+
+  (print ```#include "janet.h"```)
+
+  (each h local-headers
+    (do-one-file h))
+
+  (each s core-sources
+    (do-one-file s))
+
   # Create C source file that contains images a uint8_t buffer. This
   # can be compiled and linked statically into the main janet library
   # and example client.
-  (def chunks (string/bytes image))
+  (print "static const unsigned char janet_core_image_bytes[] = {")
-  (def image-file (file/open (boot/args 1) :wb))
+  (loop [line :in (partition 16 image)]
-  (file/write image-file
+    (prin "  ")
-              "#ifndef JANET_AMALG\n"
+    (each b line
-              "#include <janet.h>\n"
+      (prinf "0x%.2X, " b))
-              "#endif\n"
+    (print))
-              "static const unsigned char janet_core_image_bytes[] = {\n")
+  (print "  0\n};\n")
-  (loop [line :in (partition 10 chunks)]
+  (print "const unsigned char *janet_core_image = janet_core_image_bytes;")
-    (def str (string ;(interpose ", " (map (partial string/format "0x%.2X") line))))
+  (print "size_t janet_core_image_size = sizeof(janet_core_image_bytes);"))
-    (file/write image-file "    " str ",\n"))
-  (file/write image-file
-              "    0\n};\n\n"
-              "const unsigned char *janet_core_image = janet_core_image_bytes;\n"
-              "size_t janet_core_image_size = sizeof(janet_core_image_bytes);\n")
-  (file/close image-file))

src/boot/buffer_test.c

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

src/boot/number_test.c

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

src/boot/system_test.c

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

src/boot/table_test.c

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

src/conf/janetconf.h

@@ -1,5 +1,5 @@
 /*
-* Copyright (c) 2019 Calvin Rose
+* Copyright (c) 2020 Calvin Rose
 *
 * Permission is hereby granted, free of charge, to any person obtaining a copy
 * of this software and associated documentation files (the "Software"), to
@@ -27,10 +27,10 @@
 #define JANETCONF_H
 
 #define JANET_VERSION_MAJOR 1
-#define JANET_VERSION_MINOR 6
+#define JANET_VERSION_MINOR 8
-#define JANET_VERSION_PATCH 0
+#define JANET_VERSION_PATCH 1
 #define JANET_VERSION_EXTRA ""
-#define JANET_VERSION "1.6.0"
+#define JANET_VERSION "1.8.1"
 
 /* #define JANET_BUILD "local" */
 
@@ -51,6 +51,7 @@
 /* #define JANET_NO_PEG */
 /* #define JANET_NO_TYPED_ARRAY */
 /* #define JANET_NO_INT_TYPES */
+/* #define JANET_NO_PRF */
 /* #define JANET_OUT_OF_MEMORY do { printf("janet out of memory\n"); exit(1); } while (0) */
 /* #define JANET_RECURSION_GUARD 1024 */
 /* #define JANET_MAX_PROTO_DEPTH 200 */

src/core/abstract.c

@@ -1,5 +1,5 @@
 /*
-* Copyright (c) 2019 Calvin Rose
+* Copyright (c) 2020 Calvin Rose
 *
 * Permission is hereby granted, free of charge, to any person obtaining a copy
 * of this software and associated documentation files (the "Software"), to
@@ -21,6 +21,7 @@
 */
 
 #ifndef JANET_AMALG
+#include "features.h"
 #include <janet.h>
 #include "gc.h"
 #endif

src/core/array.c

@@ -1,5 +1,5 @@
 /*
-* Copyright (c) 2019 Calvin Rose
+* Copyright (c) 2020 Calvin Rose
 *
 * Permission is hereby granted, free of charge, to any person obtaining a copy
 * of this software and associated documentation files (the "Software"), to
@@ -21,6 +21,7 @@
 */
 
 #ifndef JANET_AMALG
+#include "features.h"
 #include <janet.h>
 #include "gc.h"
 #include "util.h"
@@ -35,7 +36,7 @@ JanetArray *janet_array(int32_t capacity) {
     Janet *data = NULL;
     if (capacity > 0) {
         janet_vm_next_collection += capacity * sizeof(Janet);
-        data = (Janet *) malloc(sizeof(Janet) * capacity);
+        data = (Janet *) malloc(sizeof(Janet) * (size_t) capacity);
         if (NULL == data) {
             JANET_OUT_OF_MEMORY;
         }
@@ -51,11 +52,11 @@ JanetArray *janet_array_n(const Janet *elements, int32_t n) {
     JanetArray *array = janet_gcalloc(JANET_MEMORY_ARRAY, sizeof(JanetArray));
     array->capacity = n;
     array->count = n;
-    array->data = malloc(sizeof(Janet) * n);
+    array->data = malloc(sizeof(Janet) * (size_t) n);
     if (!array->data) {
         JANET_OUT_OF_MEMORY;
     }
-    memcpy(array->data, elements, sizeof(Janet) * n);
+    safe_memcpy(array->data, elements, sizeof(Janet) * n);
     return array;
 }
 
@@ -92,6 +93,9 @@ void janet_array_setcount(JanetArray *array, int32_t count) {
 
 /* Push a value to the top of the array */
 void janet_array_push(JanetArray *array, Janet x) {
+    if (array->count == INT32_MAX) {
+        janet_panic("array overflow");
+    }
     int32_t newcount = array->count + 1;
     janet_array_ensure(array, newcount, 2);
     array->data[array->count] = x;
@@ -162,9 +166,12 @@ static Janet cfun_array_peek(int32_t argc, Janet *argv) {
 static Janet cfun_array_push(int32_t argc, Janet *argv) {
     janet_arity(argc, 1, -1);
     JanetArray *array = janet_getarray(argv, 0);
+    if (INT32_MAX - argc + 1 <= array->count) {
+        janet_panic("array overflow");
+    }
     int32_t newcount = array->count - 1 + argc;
     janet_array_ensure(array, newcount, 2);
-    if (argc > 1) memcpy(array->data + array->count, argv + 1, (argc - 1) * sizeof(Janet));
+    if (argc > 1) memcpy(array->data + array->count, argv + 1, (size_t)(argc - 1) * sizeof(Janet));
     array->count = newcount;
     return argv[0];
 }
@@ -224,11 +231,16 @@ static Janet cfun_array_insert(int32_t argc, Janet *argv) {
         janet_panicf("insertion index %d out of range [0,%d]", at, array->count);
     chunksize = (argc - 2) * sizeof(Janet);
     restsize = (array->count - at) * sizeof(Janet);
+    if (INT32_MAX - (argc - 2) < array->count) {
+        janet_panic("array overflow");
+    }
     janet_array_ensure(array, array->count + argc - 2, 2);
-    memmove(array->data + at + argc - 2,
+    if (restsize) {
-            array->data + at,
+        memmove(array->data + at + argc - 2,
-            restsize);
+                array->data + at,
-    memcpy(array->data + at, argv + 2, chunksize);
+                restsize);
+    }
+    safe_memcpy(array->data + at, argv + 2, chunksize);
     array->count += (argc - 2);
     return argv[0];
 }

src/core/asm.c

@@ -1,5 +1,5 @@
 /*
-* Copyright (c) 2019 Calvin Rose
+* Copyright (c) 2020 Calvin Rose
 *
 * Permission is hereby granted, free of charge, to any person obtaining a copy
 * of this software and associated documentation files (the "Software"), to
@@ -21,6 +21,7 @@
 */
 
 #ifndef JANET_AMALG
+#include "features.h"
 #include <janet.h>
 #include "util.h"
 #endif
@@ -77,17 +78,17 @@ static const JanetInstructionDef janet_ops[] = {
     {"divim", JOP_DIVIDE_IMMEDIATE},
     {"eq", JOP_EQUALS},
     {"eqim", JOP_EQUALS_IMMEDIATE},
-    {"eqn", JOP_NUMERIC_EQUAL},
     {"err", JOP_ERROR},
     {"get", JOP_GET},
     {"geti", JOP_GET_INDEX},
     {"gt", JOP_GREATER_THAN},
-    {"gten", JOP_NUMERIC_GREATER_THAN_EQUAL},
+    {"gte", JOP_GREATER_THAN_EQUAL},
     {"gtim", JOP_GREATER_THAN_IMMEDIATE},
-    {"gtn", JOP_NUMERIC_GREATER_THAN},
     {"in", JOP_IN},
     {"jmp", JOP_JUMP},
     {"jmpif", JOP_JUMP_IF},
+    {"jmpni", JOP_JUMP_IF_NIL},
+    {"jmpnn", JOP_JUMP_IF_NOT_NIL},
     {"jmpno", JOP_JUMP_IF_NOT},
     {"ldc", JOP_LOAD_CONSTANT},
     {"ldf", JOP_LOAD_FALSE},
@@ -98,9 +99,8 @@ static const JanetInstructionDef janet_ops[] = {
     {"ldu", JOP_LOAD_UPVALUE},
     {"len", JOP_LENGTH},
     {"lt", JOP_LESS_THAN},
-    {"lten", JOP_NUMERIC_LESS_THAN_EQUAL},
+    {"lte", JOP_LESS_THAN_EQUAL},
     {"ltim", JOP_LESS_THAN_IMMEDIATE},
-    {"ltn", JOP_NUMERIC_LESS_THAN},
     {"mkarr", JOP_MAKE_ARRAY},
     {"mkbtp", JOP_MAKE_BRACKET_TUPLE},
     {"mkbuf", JOP_MAKE_BUFFER},
@@ -108,10 +108,12 @@ static const JanetInstructionDef janet_ops[] = {
     {"mkstu", JOP_MAKE_STRUCT},
     {"mktab", JOP_MAKE_TABLE},
     {"mktup", JOP_MAKE_TUPLE},
+    {"mod", JOP_MODULO},
     {"movf", JOP_MOVE_FAR},
     {"movn", JOP_MOVE_NEAR},
     {"mul", JOP_MULTIPLY},
     {"mulim", JOP_MULTIPLY_IMMEDIATE},
+    {"next", JOP_NEXT},
     {"noop", JOP_NOOP},
     {"prop", JOP_PROPAGATE},
     {"push", JOP_PUSH},
@@ -120,6 +122,7 @@ static const JanetInstructionDef janet_ops[] = {
     {"pusha", JOP_PUSH_ARRAY},
     {"put", JOP_PUT},
     {"puti", JOP_PUT_INDEX},
+    {"rem", JOP_REMAINDER},
     {"res", JOP_RESUME},
     {"ret", JOP_RETURN},
     {"retn", JOP_RETURN_NIL},
@@ -582,7 +585,7 @@ static JanetAssembleResult janet_asm1(JanetAssembler *parent, Janet source, int
     x = janet_get1(s, janet_csymbolv("constants"));
     if (janet_indexed_view(x, &arr, &count)) {
         def->constants_length = count;
-        def->constants = malloc(sizeof(Janet) * count);
+        def->constants = malloc(sizeof(Janet) * (size_t) count);
         if (NULL == def->constants) {
             JANET_OUT_OF_MEMORY;
         }
@@ -661,7 +664,7 @@ static JanetAssembleResult janet_asm1(JanetAssembler *parent, Janet source, int
         }
         /* Allocate bytecode array */
         def->bytecode_length = blength;
-        def->bytecode = malloc(sizeof(uint32_t) * blength);
+        def->bytecode = malloc(sizeof(uint32_t) * (size_t) blength);
         if (NULL == def->bytecode) {
             JANET_OUT_OF_MEMORY;
         }
@@ -703,7 +706,7 @@ static JanetAssembleResult janet_asm1(JanetAssembler *parent, Janet source, int
     x = janet_get1(s, janet_csymbolv("sourcemap"));
     if (janet_indexed_view(x, &arr, &count)) {
         janet_asm_assert(&a, count == def->bytecode_length, "sourcemap must have the same length as the bytecode");
-        def->sourcemap = malloc(sizeof(JanetSourceMapping) * count);
+        def->sourcemap = malloc(sizeof(JanetSourceMapping) * (size_t) count);
         for (i = 0; i < count; i++) {
             const Janet *tup;
             Janet entry = arr[i];

src/core/buffer.c

@@ -1,5 +1,5 @@
 /*
-* Copyright (c) 2019 Calvin Rose
+* Copyright (c) 2020 Calvin Rose
 *
 * Permission is hereby granted, free of charge, to any person obtaining a copy
 * of this software and associated documentation files (the "Software"), to
@@ -21,6 +21,7 @@
 */
 
 #ifndef JANET_AMALG
+#include "features.h"
 #include <janet.h>
 #include "gc.h"
 #include "util.h"
@@ -31,8 +32,8 @@
 JanetBuffer *janet_buffer_init(JanetBuffer *buffer, int32_t capacity) {
     uint8_t *data = NULL;
     if (capacity > 0) {
-        janet_vm_next_collection += capacity;
+        janet_gcpressure(capacity);
-        data = malloc(sizeof(uint8_t) * capacity);
+        data = malloc(sizeof(uint8_t) * (size_t) capacity);
         if (NULL == data) {
             JANET_OUT_OF_MEMORY;
         }
@@ -61,8 +62,8 @@ void janet_buffer_ensure(JanetBuffer *buffer, int32_t capacity, int32_t growth)
     if (capacity <= buffer->capacity) return;
     int64_t big_capacity = ((int64_t) capacity) * growth;
     capacity = big_capacity > INT32_MAX ? INT32_MAX : (int32_t) big_capacity;
-    janet_vm_next_collection += capacity - buffer->capacity;
+    janet_gcpressure(capacity - buffer->capacity);
-    new_data = realloc(old, capacity * sizeof(uint8_t));
+    new_data = realloc(old, (size_t) capacity * sizeof(uint8_t));
     if (NULL == new_data) {
         JANET_OUT_OF_MEMORY;
     }
@@ -93,7 +94,7 @@ void janet_buffer_extra(JanetBuffer *buffer, int32_t n) {
     if (new_size > buffer->capacity) {
         int32_t new_capacity = new_size * 2;
         uint8_t *new_data = realloc(buffer->data, new_capacity * sizeof(uint8_t));
-        janet_vm_next_collection += new_capacity - buffer->capacity;
+        janet_gcpressure(new_capacity - buffer->capacity);
         if (NULL == new_data) {
             JANET_OUT_OF_MEMORY;
         }
@@ -111,6 +112,7 @@ void janet_buffer_push_cstring(JanetBuffer *buffer, const char *cstring) {
 
 /* Push multiple bytes into the buffer */
 void janet_buffer_push_bytes(JanetBuffer *buffer, const uint8_t *string, int32_t length) {
+    if (0 == length) return;
     janet_buffer_extra(buffer, length);
     memcpy(buffer->data + buffer->count, string, length);
     buffer->count += length;
@@ -332,16 +334,20 @@ static Janet cfun_buffer_blit(int32_t argc, Janet *argv) {
     } else {
         length_src = src.len - offset_src;
     }
-    int64_t last = ((int64_t) offset_dest - offset_src) + length_src;
+    int64_t last = (int64_t) offset_dest + length_src;
     if (last > INT32_MAX)
         janet_panic("buffer blit out of range");
-    janet_buffer_ensure(dest, (int32_t) last, 2);
+    int32_t last32 = (int32_t) last;
-    if (last > dest->count) dest->count = (int32_t) last;
+    janet_buffer_ensure(dest, last32, 2);
-    if (same_buf) {
+    if (last32 > dest->count) dest->count = last32;
-        src.bytes = dest->data;
+    if (length_src) {
-        memmove(dest->data + offset_dest, src.bytes + offset_src, length_src);
+        if (same_buf) {
-    } else {
+            /* janet_buffer_ensure may have invalidated src */
-        memcpy(dest->data + offset_dest, src.bytes + offset_src, length_src);
+            src.bytes = dest->data;
+            memmove(dest->data + offset_dest, src.bytes + offset_src, length_src);
+        } else {
+            memcpy(dest->data + offset_dest, src.bytes + offset_src, length_src);
+        }
     }
     return argv[0];
 }
@@ -383,7 +389,7 @@ static const JanetReg buffer_cfuns[] = {
         "buffer/push-word", cfun_buffer_word,
         JDOC("(buffer/push-word buffer x)\n\n"
              "Append a machine word to a buffer. The 4 bytes of the integer are appended "
-             "in twos complement, big endian order, unsigned. Returns the modified buffer. Will "
+             "in twos complement, little endian order, unsigned. Returns the modified buffer. Will "
              "throw an error if the buffer overflows.")
     },
     {
@@ -434,7 +440,7 @@ static const JanetReg buffer_cfuns[] = {
     },
     {
         "buffer/blit", cfun_buffer_blit,
-        JDOC("(buffer/blit dest src & opt dest-start src-start src-end)\n\n"
+        JDOC("(buffer/blit dest src &opt dest-start src-start src-end)\n\n"
              "Insert the contents of src into dest. Can optionally take indices that "
              "indicate which part of src to copy into which part of dest. Indices can be "
              "negative to index from the end of src or dest. Returns dest.")

src/core/bytecode.c

@@ -1,5 +1,5 @@
 /*
-* Copyright (c) 2019 Calvin Rose
+* Copyright (c) 2020 Calvin Rose
 *
 * Permission is hereby granted, free of charge, to any person obtaining a copy
 * of this software and associated documentation files (the "Software"), to
@@ -21,6 +21,7 @@
 */
 
 #ifndef JANET_AMALG
+#include "features.h"
 #include <janet.h>
 #include "gc.h"
 #include "util.h"
@@ -40,6 +41,8 @@ enum JanetInstructionType janet_instructions[JOP_INSTRUCTION_COUNT] = {
     JINT_SSS, /* JOP_MULTIPLY, */
     JINT_SSI, /* JOP_DIVIDE_IMMEDIATE, */
     JINT_SSS, /* JOP_DIVIDE, */
+    JINT_SSS, /* JOP_MODULO, */
+    JINT_SSS, /* JOP_REMAINDER, */
     JINT_SSS, /* JOP_BAND, */
     JINT_SSS, /* JOP_BOR, */
     JINT_SSS, /* JOP_BXOR, */
@@ -55,6 +58,8 @@ enum JanetInstructionType janet_instructions[JOP_INSTRUCTION_COUNT] = {
     JINT_L, /* JOP_JUMP, */
     JINT_SL, /* JOP_JUMP_IF, */
     JINT_SL, /* JOP_JUMP_IF_NOT, */
+    JINT_SL, /* JOP_JUMP_IF_NIL, */
+    JINT_SL, /* JOP_JUMP_IF_NOT_NIL, */
     JINT_SSS, /* JOP_GREATER_THAN, */
     JINT_SSI, /* JOP_GREATER_THAN_IMMEDIATE, */
     JINT_SSS, /* JOP_LESS_THAN, */
@@ -93,11 +98,9 @@ enum JanetInstructionType janet_instructions[JOP_INSTRUCTION_COUNT] = {
     JINT_S, /* JOP_MAKE_TABLE */
     JINT_S, /* JOP_MAKE_TUPLE */
     JINT_S, /* JOP_MAKE_BRACKET_TUPLE */
-    JINT_SSS, /* JOP_NUMERIC_LESS_THAN */
+    JINT_SSS, /* JOP_GREATER_THAN_EQUAL */
-    JINT_SSS, /* JOP_NUMERIC_LESS_THAN_EQUAL */
+    JINT_SSS, /* JOP_LESS_THAN_EQUAL */
-    JINT_SSS, /* JOP_NUMERIC_GREATER_THAN */
+    JINT_SSS, /* JOP_NEXT */
-    JINT_SSS, /* JOP_NUMERIC_GREATER_THAN_EQUAL */
-    JINT_SSS /* JOP_NUMERIC_EQUAL */
 };
 
 /* Verify some bytecode */
@@ -209,6 +212,7 @@ JanetFuncDef *janet_funcdef_alloc(void) {
     def->environments = NULL;
     def->constants = NULL;
     def->bytecode = NULL;
+    def->closure_bitset = NULL;
     def->flags = 0;
     def->slotcount = 0;
     def->arity = 0;

src/core/capi.c

@@ -1,5 +1,5 @@
 /*
-* Copyright (c) 2019 Calvin Rose
+* Copyright (c) 2020 Calvin Rose
 *
 * Permission is hereby granted, free of charge, to any person obtaining a copy
 * of this software and associated documentation files (the "Software"), to
@@ -21,25 +21,31 @@
 */
 
 #ifndef JANET_AMALG
+#include "features.h"
 #include <janet.h>
 #include "state.h"
 #include "fiber.h"
 #endif
 
-void janet_panicv(Janet message) {
+void janet_signalv(JanetSignal sig, Janet message) {
     if (janet_vm_return_reg != NULL) {
         *janet_vm_return_reg = message;
+        janet_vm_fiber->flags |= JANET_FIBER_DID_LONGJUMP;
 #if defined(JANET_BSD) || defined(JANET_APPLE)
-        _longjmp(*janet_vm_jmp_buf, 1);
+        _longjmp(*janet_vm_jmp_buf, sig);
 #else
-        longjmp(*janet_vm_jmp_buf, 1);
+        longjmp(*janet_vm_jmp_buf, sig);
 #endif
     } else {
-        fputs((const char *)janet_formatc("janet top level panic - %v\n", message), stdout);
+        fputs((const char *)janet_formatc("janet top level signal - %v\n", message), stdout);
         exit(1);
     }
 }
 
+void janet_panicv(Janet message) {
+    janet_signalv(JANET_SIGNAL_ERROR, message);
+}
+
 void janet_panicf(const char *format, ...) {
     va_list args;
     const uint8_t *ret;
@@ -149,6 +155,13 @@ DEFINE_OPTLEN(buffer, BUFFER, JanetBuffer *)
 DEFINE_OPTLEN(table, TABLE, JanetTable *)
 DEFINE_OPTLEN(array, ARRAY, JanetArray *)
 
+const char *janet_optcstring(const Janet *argv, int32_t argc, int32_t n, const char *dflt) {
+    if (n >= argc || janet_checktype(argv[n], JANET_NIL)) {
+        return dflt;
+    }
+    return janet_getcstring(argv, n);
+}
+
 #undef DEFINE_GETTER
 #undef DEFINE_OPT
 #undef DEFINE_OPTLEN

src/core/cfuns.c

@@ -1,5 +1,5 @@
 /*
-* Copyright (c) 2019 Calvin Rose
+* Copyright (c) 2020 Calvin Rose
 *
 * Permission is hereby granted, free of charge, to any person obtaining a copy
 * of this software and associated documentation files (the "Software"), to
@@ -21,12 +21,18 @@
 */
 
 #ifndef JANET_AMALG
+#include "features.h"
 #include <janet.h>
 #include "compile.h"
 #include "emit.h"
 #include "vector.h"
 #endif
 
+static int arity1or2(JanetFopts opts, JanetSlot *args) {
+    (void) opts;
+    int32_t arity = janet_v_count(args);
+    return arity == 1 || arity == 2;
+}
 static int fixarity1(JanetFopts opts, JanetSlot *args) {
     (void) opts;
     return janet_v_count(args) == 1;
@@ -62,6 +68,28 @@ static JanetSlot genericSSI(JanetFopts opts, int op, JanetSlot s, int32_t imm) {
     return target;
 }
 
+/* Emit an insruction that implements a form by itself. */
+static JanetSlot opfunction(
+    JanetFopts opts,
+    JanetSlot *args,
+    int op,
+    Janet defaultArg2) {
+    JanetCompiler *c = opts.compiler;
+    int32_t len;
+    len = janet_v_count(args);
+    JanetSlot t;
+    if (len == 1) {
+        t = janetc_gettarget(opts);
+        janetc_emit_sss(c, op, t, args[0], janetc_cslot(defaultArg2), 1);
+        return t;
+    } else {
+        /* len == 2 */
+        t = janetc_gettarget(opts);
+        janetc_emit_sss(c, op, t, args[0], args[1], 1);
+    }
+    return t;
+}
+
 /* Emit a series of instructions instead of a function call to a math op */
 static JanetSlot opreduce(
     JanetFopts opts,
@@ -111,6 +139,15 @@ static JanetSlot do_in(JanetFopts opts, JanetSlot *args) {
 static JanetSlot do_get(JanetFopts opts, JanetSlot *args) {
     return opreduce(opts, args, JOP_GET, janet_wrap_nil());
 }
+static JanetSlot do_next(JanetFopts opts, JanetSlot *args) {
+    return opfunction(opts, args, JOP_NEXT, janet_wrap_nil());
+}
+static JanetSlot do_modulo(JanetFopts opts, JanetSlot *args) {
+    return opreduce(opts, args, JOP_MODULO, janet_wrap_nil());
+}
+static JanetSlot do_remainder(JanetFopts opts, JanetSlot *args) {
+    return opreduce(opts, args, JOP_REMAINDER, janet_wrap_nil());
+}
 static JanetSlot do_put(JanetFopts opts, JanetSlot *args) {
     if (opts.flags & JANET_FOPTS_DROP) {
         janetc_emit_sss(opts.compiler, JOP_PUT, args[0], args[1], args[2], 0);
@@ -133,7 +170,7 @@ static JanetSlot do_yield(JanetFopts opts, JanetSlot *args) {
     }
 }
 static JanetSlot do_resume(JanetFopts opts, JanetSlot *args) {
-    return opreduce(opts, args, JOP_RESUME, janet_wrap_nil());
+    return opfunction(opts, args, JOP_RESUME, janet_wrap_nil());
 }
 static JanetSlot do_apply(JanetFopts opts, JanetSlot *args) {
     /* Push phase */
@@ -235,41 +272,23 @@ static JanetSlot compreduce(
     return t;
 }
 
-static JanetSlot do_order_gt(JanetFopts opts, JanetSlot *args) {
+static JanetSlot do_gt(JanetFopts opts, JanetSlot *args) {
     return compreduce(opts, args, JOP_GREATER_THAN, 0);
 }
-static JanetSlot do_order_lt(JanetFopts opts, JanetSlot *args) {
+static JanetSlot do_lt(JanetFopts opts, JanetSlot *args) {
     return compreduce(opts, args, JOP_LESS_THAN, 0);
 }
-static JanetSlot do_order_gte(JanetFopts opts, JanetSlot *args) {
-    return compreduce(opts, args, JOP_LESS_THAN, 1);
-}
-static JanetSlot do_order_lte(JanetFopts opts, JanetSlot *args) {
-    return compreduce(opts, args, JOP_GREATER_THAN, 1);
-}
-static JanetSlot do_order_eq(JanetFopts opts, JanetSlot *args) {
-    return compreduce(opts, args, JOP_EQUALS, 0);
-}
-static JanetSlot do_order_neq(JanetFopts opts, JanetSlot *args) {
-    return compreduce(opts, args, JOP_EQUALS, 1);
-}
-static JanetSlot do_gt(JanetFopts opts, JanetSlot *args) {
-    return compreduce(opts, args, JOP_NUMERIC_GREATER_THAN, 0);
-}
-static JanetSlot do_lt(JanetFopts opts, JanetSlot *args) {
-    return compreduce(opts, args, JOP_NUMERIC_LESS_THAN, 0);
-}
 static JanetSlot do_gte(JanetFopts opts, JanetSlot *args) {
-    return compreduce(opts, args, JOP_NUMERIC_GREATER_THAN_EQUAL, 0);
+    return compreduce(opts, args, JOP_GREATER_THAN_EQUAL, 0);
 }
 static JanetSlot do_lte(JanetFopts opts, JanetSlot *args) {
-    return compreduce(opts, args, JOP_NUMERIC_LESS_THAN_EQUAL, 0);
+    return compreduce(opts, args, JOP_LESS_THAN_EQUAL, 0);
 }
 static JanetSlot do_eq(JanetFopts opts, JanetSlot *args) {
-    return compreduce(opts, args, JOP_NUMERIC_EQUAL, 0);
+    return compreduce(opts, args, JOP_EQUALS, 0);
 }
 static JanetSlot do_neq(JanetFopts opts, JanetSlot *args) {
-    return compreduce(opts, args, JOP_NUMERIC_EQUAL, 1);
+    return compreduce(opts, args, JOP_EQUALS, 1);
 }
 
 /* Arranged by tag */
@@ -278,7 +297,7 @@ static const JanetFunOptimizer optimizers[] = {
     {fixarity1, do_error},
     {minarity2, do_apply},
     {maxarity1, do_yield},
-    {fixarity2, do_resume},
+    {arity1or2, do_resume},
     {fixarity2, do_in},
     {fixarity3, do_put},
     {fixarity1, do_length},
@@ -293,12 +312,6 @@ static const JanetFunOptimizer optimizers[] = {
     {NULL, do_rshift},
     {NULL, do_rshiftu},
     {fixarity1, do_bnot},
-    {NULL, do_order_gt},
-    {NULL, do_order_lt},
-    {NULL, do_order_gte},
-    {NULL, do_order_lte},
-    {NULL, do_order_eq},
-    {NULL, do_order_neq},
     {NULL, do_gt},
     {NULL, do_lt},
     {NULL, do_gte},
@@ -306,7 +319,10 @@ static const JanetFunOptimizer optimizers[] = {
     {NULL, do_eq},
     {NULL, do_neq},
     {fixarity2, do_propagate},
-    {fixarity2, do_get}
+    {fixarity2, do_get},
+    {arity1or2, do_next},
+    {fixarity2, do_modulo},
+    {fixarity2, do_remainder},
 };
 
 const JanetFunOptimizer *janetc_funopt(uint32_t flags) {

src/core/compile.c

@@ -1,5 +1,5 @@
 /*
-* Copyright (c) 2019 Calvin Rose
+* Copyright (c) 2020 Calvin Rose
 *
 * Permission is hereby granted, free of charge, to any person obtaining a copy
 * of this software and associated documentation files (the "Software"), to
@@ -21,6 +21,7 @@
 */
 
 #ifndef JANET_AMALG
+#include "features.h"
 #include <janet.h>
 #include "compile.h"
 #include "emit.h"
@@ -101,6 +102,7 @@ void janetc_scope(JanetScope *s, JanetCompiler *c, int flags, const char *name)
     scope.bytecode_start = janet_v_count(c->buffer);
     scope.flags = flags;
     scope.parent = c->scope;
+    janetc_regalloc_init(&scope.ua);
     /* Inherit slots */
     if ((!(flags & JANET_SCOPE_FUNCTION)) && c->scope) {
         janetc_regalloc_clone(&scope.ra, &(c->scope->ra));
@@ -148,6 +150,7 @@ void janetc_popscope(JanetCompiler *c) {
     janet_v_free(oldscope->envs);
     janet_v_free(oldscope->defs);
     janetc_regalloc_deinit(&oldscope->ra);
+    janetc_regalloc_deinit(&oldscope->ua);
     /* Update pointer */
     if (newscope)
         newscope->child = NULL;
@@ -201,7 +204,7 @@ JanetSlot janetc_resolve(
         switch (btype) {
             default:
             case JANET_BINDING_NONE:
-                janetc_error(c, janet_formatc("unknown symbol %q", sym));
+                janetc_error(c, janet_formatc("unknown symbol %q", janet_wrap_symbol(sym)));
                 return janetc_cslot(janet_wrap_nil());
             case JANET_BINDING_DEF:
             case JANET_BINDING_MACRO: /* Macro should function like defs when not in calling pos */
@@ -235,6 +238,11 @@ found:
         scope = scope->parent;
     janet_assert(scope, "invalid scopes");
     scope->flags |= JANET_SCOPE_ENV;
+
+    /* In the function scope, allocate the slot as an upvalue */
+    janetc_regalloc_touch(&scope->ua, ret.index);
+
+    /* Iterate through child scopes and make sure environment is propagated */
     scope = scope->child;
 
     /* Propagate env up to current scope */
@@ -454,6 +462,7 @@ static JanetSlot janetc_call(JanetFopts opts, JanetSlot *slots, JanetSlot fun) {
                 break;
                 case JANET_CFUNCTION:
                 case JANET_ABSTRACT:
+                case JANET_NIL:
                     break;
                 case JANET_KEYWORD:
                     if (min_arity == 0) {
@@ -582,18 +591,21 @@ static int macroexpand1(
             es = janet_formatc("macro arity mismatch, expected at most %d, got %d", maxar, arity);
         c->result.macrofiber = NULL;
         janetc_error(c, es);
+        return 0;
     }
     /* Set env */
     fiberp->env = c->env;
     int lock = janet_gclock();
-    JanetSignal status = janet_continue(fiberp, janet_wrap_nil(), &x);
+    Janet tempOut;
+    JanetSignal status = janet_continue(fiberp, janet_wrap_nil(), &tempOut);
     janet_gcunlock(lock);
     if (status != JANET_SIGNAL_OK) {
-        const uint8_t *es = janet_formatc("(macro) %V", x);
+        const uint8_t *es = janet_formatc("(macro) %V", tempOut);
         c->result.macrofiber = fiberp;
         janetc_error(c, es);
+        return 0;
     } else {
-        *out = x;
+        *out = tempOut;
     }
 
     return 1;
@@ -704,20 +716,20 @@ JanetFuncDef *janetc_pop_funcdef(JanetCompiler *c) {
     /* Copy bytecode (only last chunk) */
     def->bytecode_length = janet_v_count(c->buffer) - scope->bytecode_start;
     if (def->bytecode_length) {
-        size_t s = sizeof(int32_t) * def->bytecode_length;
+        size_t s = sizeof(int32_t) * (size_t) def->bytecode_length;
         def->bytecode = malloc(s);
         if (NULL == def->bytecode) {
             JANET_OUT_OF_MEMORY;
         }
-        memcpy(def->bytecode, c->buffer + scope->bytecode_start, s);
+        safe_memcpy(def->bytecode, c->buffer + scope->bytecode_start, s);
         janet_v__cnt(c->buffer) = scope->bytecode_start;
         if (NULL != c->mapbuffer && c->source) {
-            size_t s = sizeof(JanetSourceMapping) * def->bytecode_length;
+            size_t s = sizeof(JanetSourceMapping) * (size_t) def->bytecode_length;
             def->sourcemap = malloc(s);
             if (NULL == def->sourcemap) {
                 JANET_OUT_OF_MEMORY;
             }
-            memcpy(def->sourcemap, c->mapbuffer + scope->bytecode_start, s);
+            safe_memcpy(def->sourcemap, c->mapbuffer + scope->bytecode_start, s);
             janet_v__cnt(c->mapbuffer) = scope->bytecode_start;
         }
     }
@@ -732,6 +744,21 @@ JanetFuncDef *janetc_pop_funcdef(JanetCompiler *c) {
         def->flags |= JANET_FUNCDEF_FLAG_NEEDSENV;
     }
 
+    /* Copy upvalue bitset */
+    if (scope->ua.count) {
+        /* Number of u32s we need to create a bitmask for all slots */
+        int32_t numchunks = (def->slotcount + 31) >> 5;
+        uint32_t *chunks = malloc(sizeof(uint32_t) * numchunks);
+        if (NULL == chunks) {
+            JANET_OUT_OF_MEMORY;
+        }
+        memcpy(chunks, scope->ua.chunks, sizeof(uint32_t) * numchunks);
+        /* Register allocator preallocates some registers [240-255, high 16 bits of chunk index 7], we can ignore those. */
+        if (scope->ua.count > 7) chunks[7] &= 0xFFFFU;
+        def->closure_bitset = chunks;
+        def->flags |= JANET_FUNCDEF_FLAG_HASCLOBITSET;
+    }
+
     /* Pop the scope */
     janetc_popscope(c);
 

src/core/compile.h

@@ -1,5 +1,5 @@
 /*
-* Copyright (c) 2019 Calvin Rose
+* Copyright (c) 2020 Calvin Rose
 *
 * Permission is hereby granted, free of charge, to any person obtaining a copy
 * of this software and associated documentation files (the "Software"), to
@@ -24,6 +24,7 @@
 #define JANET_COMPILE_H
 
 #ifndef JANET_AMALG
+#include "features.h"
 #include <janet.h>
 #include "regalloc.h"
 #endif
@@ -48,20 +49,17 @@
 #define JANET_FUN_RSHIFT 17
 #define JANET_FUN_RSHIFTU 18
 #define JANET_FUN_BNOT 19
-#define JANET_FUN_ORDER_GT 20
+#define JANET_FUN_GT 20
-#define JANET_FUN_ORDER_LT 21
+#define JANET_FUN_LT 21
-#define JANET_FUN_ORDER_GTE 22
+#define JANET_FUN_GTE 22
-#define JANET_FUN_ORDER_LTE 23
+#define JANET_FUN_LTE 23
-#define JANET_FUN_ORDER_EQ 24
+#define JANET_FUN_EQ 24
-#define JANET_FUN_ORDER_NEQ 25
+#define JANET_FUN_NEQ 25
-#define JANET_FUN_GT 26
+#define JANET_FUN_PROP 26
-#define JANET_FUN_LT 27
+#define JANET_FUN_GET 27
-#define JANET_FUN_GTE 28
+#define JANET_FUN_NEXT 28
-#define JANET_FUN_LTE 29
+#define JANET_FUN_MODULO 29
-#define JANET_FUN_EQ 30
+#define JANET_FUN_REMAINDER 30
-#define JANET_FUN_NEQ 31
-#define JANET_FUN_PROP 32
-#define JANET_FUN_GET 33
 
 /* Compiler typedefs */
 typedef struct JanetCompiler JanetCompiler;
@@ -129,7 +127,10 @@ struct JanetScope {
     /* Regsiter allocator */
     JanetcRegisterAllocator ra;
 
-    /* Referenced closure environents. The values at each index correspond
+    /* Upvalue allocator */
+    JanetcRegisterAllocator ua;
+
+    /* Referenced closure environments. The values at each index correspond
      * to which index to get the environment from in the parent. The environment
      * that corresponds to the direct parent's stack will always have value 0. */
     int32_t *envs;

src/core/corelib.c

@@ -1,5 +1,5 @@
 /*
-* Copyright (c) 2019 Calvin Rose
+* Copyright (c) 2020 Calvin Rose
 *
 * Permission is hereby granted, free of charge, to any person obtaining a copy
 * of this software and associated documentation files (the "Software"), to
@@ -21,6 +21,7 @@
 */
 
 #ifndef JANET_AMALG
+#include "features.h"
 #include <janet.h>
 #include <math.h>
 #include "compile.h"
@@ -345,7 +346,7 @@ static Janet janet_core_tuple(int32_t argc, Janet *argv) {
 static Janet janet_core_array(int32_t argc, Janet *argv) {
     JanetArray *array = janet_array(argc);
     array->count = argc;
-    memcpy(array->data, argv, argc * sizeof(Janet));
+    safe_memcpy(array->data, argv, argc * sizeof(Janet));
     return janet_wrap_array(array);
 }
 
@@ -401,17 +402,19 @@ static Janet janet_core_gccollect(int32_t argc, Janet *argv) {
 
 static Janet janet_core_gcsetinterval(int32_t argc, Janet *argv) {
     janet_fixarity(argc, 1);
-    int32_t val = janet_getinteger(argv, 0);
+    size_t s = janet_getsize(argv, 0);
-    if (val < 0)
+    /* limit interval to 48 bits */
-        janet_panic("expected non-negative integer");
+    if (s > 0xFFFFFFFFFFFFUl) {
-    janet_vm_gc_interval = val;
+        janet_panic("interval too large");
+    }
+    janet_vm_gc_interval = s;
     return janet_wrap_nil();
 }
 
 static Janet janet_core_gcinterval(int32_t argc, Janet *argv) {
     (void) argv;
     janet_fixarity(argc, 0);
-    return janet_wrap_number(janet_vm_gc_interval);
+    return janet_wrap_number((double) janet_vm_gc_interval);
 }
 
 static Janet janet_core_type(int32_t argc, Janet *argv) {
@@ -424,20 +427,6 @@ static Janet janet_core_type(int32_t argc, Janet *argv) {
     }
 }
 
-static Janet janet_core_next(int32_t argc, Janet *argv) {
-    janet_fixarity(argc, 2);
-    JanetDictView view = janet_getdictionary(argv, 0);
-    const JanetKV *end = view.kvs + view.cap;
-    const JanetKV *kv = janet_checktype(argv[1], JANET_NIL)
-                        ? view.kvs
-                        : janet_dict_find(view.kvs, view.cap, argv[1]) + 1;
-    while (kv < end) {
-        if (!janet_checktype(kv->key, JANET_NIL)) return kv->key;
-        kv++;
-    }
-    return janet_wrap_nil();
-}
-
 static Janet janet_core_hash(int32_t argc, Janet *argv) {
     janet_fixarity(argc, 1);
     return janet_wrap_number(janet_hash(argv[0]));
@@ -500,6 +489,26 @@ ret_false:
     return janet_wrap_false();
 }
 
+static Janet janet_core_signal(int32_t argc, Janet *argv) {
+    janet_arity(argc, 1, 2);
+    int sig;
+    if (janet_checkint(argv[0])) {
+        int32_t s = janet_unwrap_integer(argv[0]);
+        if (s < 0 || s > 9) {
+            janet_panicf("expected user signal between 0 and 9, got %d", s);
+        }
+        sig = JANET_SIGNAL_USER0 + s;
+    } else {
+        JanetKeyword kw = janet_getkeyword(argv, 0);
+        if (!janet_cstrcmp(kw, "yield")) sig = JANET_SIGNAL_YIELD;
+        if (!janet_cstrcmp(kw, "error")) sig = JANET_SIGNAL_ERROR;
+        if (!janet_cstrcmp(kw, "debug")) sig = JANET_SIGNAL_DEBUG;
+        janet_panicf("unknown signal, expected :yield, :error, or :debug, got %v", argv[0]);
+    }
+    Janet payload = argc == 2 ? argv[1] : janet_wrap_nil();
+    janet_signalv(sig, payload);
+}
+
 static const JanetReg corelib_cfuns[] = {
     {
         "native", janet_core_native,
@@ -610,11 +619,10 @@ static const JanetReg corelib_cfuns[] = {
     {
         "type", janet_core_type,
         JDOC("(type x)\n\n"
-             "Returns the type of x as a keyword symbol. x is one of\n"
+             "Returns the type of x as a keyword. x is one of\n"
              "\t:nil\n"
              "\t:boolean\n"
-             "\t:integer\n"
+             "\t:number\n"
-             "\t:real\n"
              "\t:array\n"
              "\t:tuple\n"
              "\t:table\n"
@@ -625,16 +633,7 @@ static const JanetReg corelib_cfuns[] = {
              "\t:keyword\n"
              "\t:function\n"
              "\t:cfunction\n\n"
-             "or another symbol for an abstract type.")
+             "or another keyword for an abstract type.")
-    },
-    {
-        "next", janet_core_next,
-        JDOC("(next dict &opt key)\n\n"
-             "Gets the next key in a struct or table. Can be used to iterate through "
-             "the keys of a data structure in an unspecified order. Keys are guaranteed "
-             "to be seen only once per iteration if they data structure is not mutated "
-             "during iteration. If key is nil, next returns the first key. If next "
-             "returns nil, there are no more keys to iterate through. ")
     },
     {
         "hash", janet_core_hash,
@@ -645,8 +644,10 @@ static const JanetReg corelib_cfuns[] = {
     },
     {
         "getline", janet_core_getline,
-        JDOC("(getline &opt prompt buf)\n\n"
+        JDOC("(getline &opt prompt buf env)\n\n"
-             "Reads a line of input into a buffer, including the newline character, using a prompt. Returns the modified buffer. "
+             "Reads a line of input into a buffer, including the newline character, using a prompt. "
+             "An optional environment table can be provided for autocomplete. "
+             "Returns the modified buffer. "
              "Use this function to implement a simple interface for a terminal program.")
     },
     {
@@ -698,6 +699,11 @@ static const JanetReg corelib_cfuns[] = {
         JDOC("(slice x &opt start end)\n\n"
              "Extract a sub-range of an indexed data strutrue or byte sequence.")
     },
+    {
+        "signal", janet_core_signal,
+        JDOC("(signal what x)\n\n"
+             "Raise a signal with payload x. ")
+    },
     {NULL, NULL, NULL}
 };
 
@@ -945,6 +951,18 @@ static const uint32_t propagate_asm[] = {
     JOP_PROPAGATE | (1 << 24),
     JOP_RETURN
 };
+static const uint32_t next_asm[] = {
+    JOP_NEXT | (1 << 24),
+    JOP_RETURN
+};
+static const uint32_t modulo_asm[] = {
+    JOP_MODULO | (1 << 24),
+    JOP_RETURN
+};
+static const uint32_t remainder_asm[] = {
+    JOP_REMAINDER | (1 << 24),
+    JOP_RETURN
+};
 #endif /* ifdef JANET_BOOTSTRAP */
 
 /*
@@ -987,6 +1005,22 @@ static void janet_load_libs(JanetTable *env) {
 
 JanetTable *janet_core_env(JanetTable *replacements) {
     JanetTable *env = (NULL != replacements) ? replacements : janet_table(0);
+    janet_quick_asm(env, JANET_FUN_MODULO,
+                    "mod", 2, 2, 2, 2, modulo_asm, sizeof(modulo_asm),
+                    JDOC("(mod dividend divisor)\n\n"
+                         "Returns the modulo of dividend / divisor."));
+    janet_quick_asm(env, JANET_FUN_REMAINDER,
+                    "%", 2, 2, 2, 2, remainder_asm, sizeof(remainder_asm),
+                    JDOC("(% dividend divisor)\n\n"
+                         "Returns the remainder of dividend / divisor."));
+    janet_quick_asm(env, JANET_FUN_NEXT,
+                    "next", 2, 1, 2, 2, next_asm, sizeof(next_asm),
+                    JDOC("(next ds &opt key)\n\n"
+                         "Gets the next key in a datastructure. Can be used to iterate through "
+                         "the keys of a data structure in an unspecified order. Keys are guaranteed "
+                         "to be seen only once per iteration if they data structure is not mutated "
+                         "during iteration. If key is nil, next returns the first key. If next "
+                         "returns nil, there are no more keys to iterate through."));
     janet_quick_asm(env, JANET_FUN_PROP,
                     "propagate", 2, 2, 2, 2, propagate_asm, sizeof(propagate_asm),
                     JDOC("(propagate x fiber)\n\n"
@@ -1090,46 +1124,24 @@ JanetTable *janet_core_env(JanetTable *replacements) {
                           "for positive shifts the return value will always be positive."));
 
     /* Variadic comparators */
-    templatize_comparator(env, JANET_FUN_ORDER_GT, "order>", 0, JOP_GREATER_THAN,
+    templatize_comparator(env, JANET_FUN_GT, ">", 0, JOP_GREATER_THAN,
-                          JDOC("(order> & xs)\n\n"
-                               "Check if xs is strictly descending according to a total order "
-                               "over all values. Returns a boolean."));
-    templatize_comparator(env, JANET_FUN_ORDER_LT, "order<", 0, JOP_LESS_THAN,
-                          JDOC("(order< & xs)\n\n"
-                               "Check if xs is strictly increasing according to a total order "
-                               "over all values. Returns a boolean."));
-    templatize_comparator(env, JANET_FUN_ORDER_GTE, "order>=", 1, JOP_LESS_THAN,
-                          JDOC("(order>= & xs)\n\n"
-                               "Check if xs is not increasing according to a total order "
-                               "over all values. Returns a boolean."));
-    templatize_comparator(env, JANET_FUN_ORDER_LTE, "order<=", 1, JOP_GREATER_THAN,
-                          JDOC("(order<= & xs)\n\n"
-                               "Check if xs is not decreasing according to a total order "
-                               "over all values. Returns a boolean."));
-    templatize_comparator(env, JANET_FUN_ORDER_EQ, "=", 0, JOP_EQUALS,
-                          JDOC("(= & xs)\n\n"
-                               "Returns true if all values in xs are the same, false otherwise."));
-    templatize_comparator(env, JANET_FUN_ORDER_NEQ, "not=", 1, JOP_EQUALS,
-                          JDOC("(not= & xs)\n\n"
-                               "Return true if any values in xs are not equal, otherwise false."));
-    templatize_comparator(env, JANET_FUN_GT, ">", 0, JOP_NUMERIC_GREATER_THAN,
                           JDOC("(> & xs)\n\n"
-                               "Check if xs is in numerically descending order. Returns a boolean."));
+                               "Check if xs is in descending order. Returns a boolean."));
-    templatize_comparator(env, JANET_FUN_LT, "<", 0, JOP_NUMERIC_LESS_THAN,
+    templatize_comparator(env, JANET_FUN_LT, "<", 0, JOP_LESS_THAN,
                           JDOC("(< & xs)\n\n"
-                               "Check if xs is in numerically ascending order. Returns a boolean."));
+                               "Check if xs is in ascending order. Returns a boolean."));
-    templatize_comparator(env, JANET_FUN_GTE, ">=", 0, JOP_NUMERIC_GREATER_THAN_EQUAL,
+    templatize_comparator(env, JANET_FUN_GTE, ">=", 0, JOP_GREATER_THAN_EQUAL,
                           JDOC("(>= & xs)\n\n"
-                               "Check if xs is in numerically non-ascending order. Returns a boolean."));
+                               "Check if xs is in non-ascending order. Returns a boolean."));
-    templatize_comparator(env, JANET_FUN_LTE, "<=", 0, JOP_NUMERIC_LESS_THAN_EQUAL,
+    templatize_comparator(env, JANET_FUN_LTE, "<=", 0, JOP_LESS_THAN_EQUAL,
                           JDOC("(<= & xs)\n\n"
-                               "Check if xs is in numerically non-descending order. Returns a boolean."));
+                               "Check if xs is in non-descending order. Returns a boolean."));
-    templatize_comparator(env, JANET_FUN_EQ, "==", 0, JOP_NUMERIC_EQUAL,
+    templatize_comparator(env, JANET_FUN_EQ, "=", 0, JOP_EQUALS,
-                          JDOC("(== & xs)\n\n"
+                          JDOC("(= & xs)\n\n"
-                               "Check if all values in xs are numerically equal (4.0 == 4). Returns a boolean."));
+                               "Check if all values in xs are equal. Returns a boolean."));
-    templatize_comparator(env, JANET_FUN_NEQ, "not==", 1, JOP_NUMERIC_EQUAL,
+    templatize_comparator(env, JANET_FUN_NEQ, "not=", 1, JOP_EQUALS,
-                          JDOC("(not== & xs)\n\n"
+                          JDOC("(not= & xs)\n\n"
-                               "Check if any values in xs are not numerically equal (3.0 not== 4). Returns a boolean."));
+                               "Check if any values in xs are not equal. Returns a boolean."));
 
     /* Platform detection */
     janet_def(env, "janet/version", janet_cstringv(JANET_VERSION),

src/core/debug.c

@@ -1,5 +1,5 @@
 /*
-* Copyright (c) 2019 Calvin Rose
+* Copyright (c) 2020 Calvin Rose
 *
 * Permission is hereby granted, free of charge, to any person obtaining a copy
 * of this software and associated documentation files (the "Software"), to
@@ -21,6 +21,7 @@
 */
 
 #ifndef JANET_AMALG
+#include "features.h"
 #include <janet.h>
 #include "gc.h"
 #include "state.h"
@@ -274,7 +275,7 @@ static Janet doframe(JanetStackFrame *frame) {
         }
         /* Add stack arguments */
         slots = janet_array(def->slotcount);
-        memcpy(slots->data, stack, sizeof(Janet) * def->slotcount);
+        safe_memcpy(slots->data, stack, sizeof(Janet) * def->slotcount);
         slots->count = def->slotcount;
         janet_table_put(t, janet_ckeywordv("slots"), janet_wrap_array(slots));
     }

src/core/emit.c

@@ -1,5 +1,5 @@
 /*
-* Copyright (c) 2019 Calvin Rose
+* Copyright (c) 2020 Calvin Rose
 *
 * Permission is hereby granted, free of charge, to any person obtaining a copy
 * of this software and associated documentation files (the "Software"), to
@@ -21,6 +21,7 @@
 */
 
 #ifndef JANET_AMALG
+#include "features.h"
 #include <janet.h>
 #include "emit.h"
 #include "vector.h"

src/core/emit.h

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

src/core/features.h

@@ -1,5 +1,5 @@
 /*
-* Copyright (c) 2019 Calvin Rose
+* Copyright (c) 2020 Calvin Rose
 *
 * Permission is hereby granted, free of charge, to any person obtaining a copy
 * of this software and associated documentation files (the "Software"), to
@@ -20,17 +20,18 @@
 * IN THE SOFTWARE.
 */
 
-#ifndef JANET_LINE_H_defined
+/* Feature test macros */
-#define JANET_LINE_H_defined
 
-#ifndef JANET_AMALG
+#ifndef JANET_FEATURES_H_defined
-#include <janet.h>
+#define JANET_FEATURES_H_defined
+
+#ifndef _POSIX_C_SOURCE
+#define _POSIX_C_SOURCE 200112L
 #endif
 
-void janet_line_init();
+/* Needed for realpath on linux */
-void janet_line_deinit();
+#if !defined(_XOPEN_SOURCE) && defined(__linux__)
-
+#define _XOPEN_SOURCE 500
-void janet_line_get(const char *p, JanetBuffer *buffer);
+#endif
-Janet janet_line_getter(int32_t argc, Janet *argv);
 
 #endif

src/core/fiber.c

@@ -1,5 +1,5 @@
 /*
-* Copyright (c) 2019 Calvin Rose
+* Copyright (c) 2020 Calvin Rose
 *
 * Permission is hereby granted, free of charge, to any person obtaining a copy
 * of this software and associated documentation files (the "Software"), to
@@ -21,6 +21,7 @@
 */
 
 #ifndef JANET_AMALG
+#include "features.h"
 #include <janet.h>
 #include "fiber.h"
 #include "state.h"
@@ -34,7 +35,7 @@ static void fiber_reset(JanetFiber *fiber) {
     fiber->stackstart = JANET_FRAME_SIZE;
     fiber->stacktop = JANET_FRAME_SIZE;
     fiber->child = NULL;
-    fiber->flags = JANET_FIBER_MASK_YIELD;
+    fiber->flags = JANET_FIBER_MASK_YIELD | JANET_FIBER_RESUME_NO_USEVAL | JANET_FIBER_RESUME_NO_SKIP;
     fiber->env = NULL;
     janet_fiber_set_status(fiber, JANET_STATUS_NEW);
 }
@@ -46,7 +47,7 @@ static JanetFiber *fiber_alloc(int32_t capacity) {
         capacity = 32;
     }
     fiber->capacity = capacity;
-    data = malloc(sizeof(Janet) * capacity);
+    data = malloc(sizeof(Janet) * (size_t) capacity);
     if (NULL == data) {
         JANET_OUT_OF_MEMORY;
     }
@@ -64,7 +65,14 @@ JanetFiber *janet_fiber_reset(JanetFiber *fiber, JanetFunction *callee, int32_t
         if (newstacktop >= fiber->capacity) {
             janet_fiber_setcapacity(fiber, 2 * newstacktop);
         }
-        memcpy(fiber->data + fiber->stacktop, argv, argc * sizeof(Janet));
+        if (argv) {
+            memcpy(fiber->data + fiber->stacktop, argv, argc * sizeof(Janet));
+        } else {
+            /* If argv not given, fill with nil */
+            for (int32_t i = 0; i < argc; i++) {
+                fiber->data[fiber->stacktop + i] = janet_wrap_nil();
+            }
+        }
         fiber->stacktop = newstacktop;
     }
     if (janet_fiber_funcframe(fiber, callee)) return NULL;
@@ -134,7 +142,7 @@ void janet_fiber_pushn(JanetFiber *fiber, const Janet *arr, int32_t n) {
     if (newtop > fiber->capacity) {
         janet_fiber_grow(fiber, newtop);
     }
-    memcpy(fiber->data + fiber->stacktop, arr, n * sizeof(Janet));
+    safe_memcpy(fiber->data + fiber->stacktop, arr, n * sizeof(Janet));
     fiber->stacktop = newtop;
 }
 
@@ -210,18 +218,50 @@ int janet_fiber_funcframe(JanetFiber *fiber, JanetFunction *func) {
 static void janet_env_detach(JanetFuncEnv *env) {
     /* Check for closure environment */
     if (env) {
-        size_t s = sizeof(Janet) * env->length;
+        int32_t len = env->length;
+        size_t s = sizeof(Janet) * (size_t) len;
         Janet *vmem = malloc(s);
         janet_vm_next_collection += (uint32_t) s;
         if (NULL == vmem) {
             JANET_OUT_OF_MEMORY;
         }
-        memcpy(vmem, env->as.fiber->data + env->offset, s);
+        Janet *values = env->as.fiber->data + env->offset;
+        safe_memcpy(vmem, values, s);
+        uint32_t *bitset = janet_stack_frame(values)->func->def->closure_bitset;
+        if (bitset) {
+            /* Clear unneeded references in closure environment */
+            for (int32_t i = 0; i < len; i += 32) {
+                uint32_t mask = ~(bitset[i >> 5]);
+                int32_t maxj = i + 32 > len ? len : i + 32;
+                for (int32_t j = i; j < maxj; j++) {
+                    if (mask & 1) vmem[j] = janet_wrap_nil();
+                    mask >>= 1;
+                }
+            }
+        }
         env->offset = 0;
         env->as.values = vmem;
     }
 }
 
+/* Detach a fiber from the env if the target fiber has stopped mutating */
+void janet_env_maybe_detach(JanetFuncEnv *env) {
+    /* Check for detachable closure envs */
+    if (env->offset) {
+        JanetFiberStatus s = janet_fiber_status(env->as.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;
+        if (isFinished) {
+            janet_env_detach(env);
+        }
+    }
+}
+
 /* Create a tail frame for a function */
 int janet_fiber_funcframe_tail(JanetFiber *fiber, JanetFunction *func) {
     int32_t i;
@@ -361,14 +401,14 @@ static Janet cfun_fiber_new(int32_t argc, Janet *argv) {
     janet_arity(argc, 1, 2);
     JanetFunction *func = janet_getfunction(argv, 0);
     JanetFiber *fiber;
-    if (func->def->min_arity != 0) {
+    if (func->def->min_arity > 1) {
-        janet_panic("expected nullary function in fiber constructor");
+        janet_panicf("fiber function must accept 0 or 1 arguments");
     }
-    fiber = janet_fiber(func, 64, 0, NULL);
+    fiber = janet_fiber(func, 64, func->def->min_arity, NULL);
     if (argc == 2) {
         int32_t i;
         JanetByteView view = janet_getbytes(argv, 1);
-        fiber->flags = 0;
+        fiber->flags = JANET_FIBER_RESUME_NO_USEVAL | JANET_FIBER_RESUME_NO_SKIP;
         janet_fiber_set_status(fiber, JANET_STATUS_NEW);
         for (i = 0; i < view.len; i++) {
             if (view.bytes[i] >= '0' && view.bytes[i] <= '9') {
@@ -385,6 +425,15 @@ static Janet cfun_fiber_new(int32_t argc, Janet *argv) {
                             JANET_FIBER_MASK_USER |
                             JANET_FIBER_MASK_YIELD;
                         break;
+                    case 't':
+                        fiber->flags |=
+                            JANET_FIBER_MASK_ERROR |
+                            JANET_FIBER_MASK_USER0 |
+                            JANET_FIBER_MASK_USER1 |
+                            JANET_FIBER_MASK_USER2 |
+                            JANET_FIBER_MASK_USER3 |
+                            JANET_FIBER_MASK_USER4;
+                        break;
                     case 'd':
                         fiber->flags |= JANET_FIBER_MASK_DEBUG;
                         break;
@@ -447,6 +496,20 @@ static Janet cfun_fiber_setmaxstack(int32_t argc, Janet *argv) {
     return argv[0];
 }
 
+static Janet cfun_fiber_can_resume(int32_t argc, Janet *argv) {
+    janet_fixarity(argc, 1);
+    JanetFiber *fiber = janet_getfiber(argv, 0);
+    JanetFiberStatus s = janet_fiber_status(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;
+    return janet_wrap_boolean(!isFinished);
+}
+
 static const JanetReg fiber_cfuns[] = {
     {
         "fiber/new", cfun_fiber_new,
@@ -462,6 +525,7 @@ static const JanetReg fiber_cfuns[] = {
              "\ta - block all signals\n"
              "\td - block debug signals\n"
              "\te - block error signals\n"
+             "\tt - block termination signals: error + user[0-4]\n"
              "\tu - block user signals\n"
              "\ty - block yield signals\n"
              "\t0-9 - block a specific user signal\n\n"
@@ -512,6 +576,11 @@ static const JanetReg fiber_cfuns[] = {
              "Sets the environment table for a fiber. Set to nil to remove the current "
              "environment.")
     },
+    {
+        "fiber/can-resume?", cfun_fiber_can_resume,
+        JDOC("(fiber/can-resume? fiber)\n\n"
+             "Check if a fiber is finished and cannot be resumed.")
+    },
     {NULL, NULL, NULL}
 };
 

src/core/fiber.h

@@ -1,5 +1,5 @@
 /*
-* Copyright (c) 2019 Calvin Rose
+* Copyright (c) 2020 Calvin Rose
 *
 * Permission is hereby granted, free of charge, to any person obtaining a copy
 * of this software and associated documentation files (the "Software"), to
@@ -27,6 +27,34 @@
 #include <janet.h>
 #endif
 
+/* Fiber signal masks. */
+#define JANET_FIBER_MASK_ERROR 2
+#define JANET_FIBER_MASK_DEBUG 4
+#define JANET_FIBER_MASK_YIELD 8
+
+#define JANET_FIBER_MASK_USER0 (16 << 0)
+#define JANET_FIBER_MASK_USER1 (16 << 1)
+#define JANET_FIBER_MASK_USER2 (16 << 2)
+#define JANET_FIBER_MASK_USER3 (16 << 3)
+#define JANET_FIBER_MASK_USER4 (16 << 4)
+#define JANET_FIBER_MASK_USER5 (16 << 5)
+#define JANET_FIBER_MASK_USER6 (16 << 6)
+#define JANET_FIBER_MASK_USER7 (16 << 7)
+#define JANET_FIBER_MASK_USER8 (16 << 8)
+#define JANET_FIBER_MASK_USER9 (16 << 9)
+
+#define JANET_FIBER_MASK_USERN(N) (16 << (N))
+#define JANET_FIBER_MASK_USER 0x3FF0
+
+#define JANET_FIBER_STATUS_MASK 0xFF0000
+#define JANET_FIBER_STATUS_OFFSET 16
+
+#define JANET_FIBER_BREAKPOINT       0x1000000
+#define JANET_FIBER_RESUME_NO_USEVAL 0x2000000
+#define JANET_FIBER_RESUME_NO_SKIP   0x4000000
+#define JANET_FIBER_DID_LONGJUMP     0x8000000
+#define JANET_FIBER_FLAG_MASK        0xF000000
+
 extern JANET_THREAD_LOCAL JanetFiber *janet_vm_fiber;
 
 #define janet_fiber_set_status(f, s) do {\
@@ -45,5 +73,6 @@ int janet_fiber_funcframe(JanetFiber *fiber, JanetFunction *func);
 int janet_fiber_funcframe_tail(JanetFiber *fiber, JanetFunction *func);
 void janet_fiber_cframe(JanetFiber *fiber, JanetCFunction cfun);
 void janet_fiber_popframe(JanetFiber *fiber);
+void janet_env_maybe_detach(JanetFuncEnv *env);
 
 #endif

src/core/gc.c

@@ -1,5 +1,5 @@
 /*
-* Copyright (c) 2019 Calvin Rose
+* Copyright (c) 2020 Calvin Rose
 *
 * Permission is hereby granted, free of charge, to any person obtaining a copy
 * of this software and associated documentation files (the "Software"), to
@@ -21,33 +21,33 @@
 */
 
 #ifndef JANET_AMALG
+#include "features.h"
 #include <janet.h>
 #include "state.h"
 #include "symcache.h"
 #include "gc.h"
 #include "util.h"
+#include "fiber.h"
 #endif
 
+struct JanetScratch {
+    JanetScratchFinalizer finalize;
+    long long mem[]; /* for proper alignment */
+};
+
 /* GC State */
 JANET_THREAD_LOCAL void *janet_vm_blocks;
-JANET_THREAD_LOCAL uint32_t janet_vm_gc_interval;
+JANET_THREAD_LOCAL size_t janet_vm_gc_interval;
-JANET_THREAD_LOCAL uint32_t janet_vm_next_collection;
+JANET_THREAD_LOCAL size_t janet_vm_next_collection;
 JANET_THREAD_LOCAL int janet_vm_gc_suspend = 0;
 
 /* Roots */
 JANET_THREAD_LOCAL Janet *janet_vm_roots;
-JANET_THREAD_LOCAL uint32_t janet_vm_root_count;
+JANET_THREAD_LOCAL size_t janet_vm_root_count;
-JANET_THREAD_LOCAL uint32_t janet_vm_root_capacity;
+JANET_THREAD_LOCAL size_t janet_vm_root_capacity;
 
 /* Scratch Memory */
-#ifdef JANET_64
+JANET_THREAD_LOCAL JanetScratch **janet_scratch_mem;
-#define SCRATCH_HDR_SIZE 16 /* smalloc must guarantee 16 byte alignment. */
-#elif JANET_32
-#define SCRATCH_HDR_SIZE 8  /* smalloc must guarantee 8 byte alignment. */
-#else
-#error "unknown scratch alignment"
-#endif
-JANET_THREAD_LOCAL void **janet_scratch_mem;
 JANET_THREAD_LOCAL size_t janet_scratch_cap;
 JANET_THREAD_LOCAL size_t janet_scratch_len;
 
@@ -64,9 +64,14 @@ static void janet_mark_string(const uint8_t *str);
 static void janet_mark_fiber(JanetFiber *fiber);
 static void janet_mark_abstract(void *adata);
 
-/* Local state that is only temporary */
+/* Local state that is only temporary for gc */
 static JANET_THREAD_LOCAL uint32_t depth = JANET_RECURSION_GUARD;
-static JANET_THREAD_LOCAL uint32_t orig_rootcount;
+static JANET_THREAD_LOCAL size_t orig_rootcount;
+
+/* Hint to the GC that we may need to collect */
+void janet_gcpressure(size_t s) {
+    janet_vm_next_collection += s;
+}
 
 /* Mark a value */
 void janet_mark(Janet x) {
@@ -185,6 +190,9 @@ static void janet_mark_funcenv(JanetFuncEnv *env) {
     if (janet_gc_reachable(env))
         return;
     janet_gc_mark(env);
+    /* If closure env references a dead fiber, we can just copy out the stack frame we need so
+     * we don't need to keep around the whole dead fiber. */
+    janet_env_maybe_detach(env);
     if (env->offset) {
         /* On stack */
         janet_mark_fiber(env->as.fiber);
@@ -301,6 +309,7 @@ static void janet_deinit_block(JanetGCObject *mem) {
             free(def->constants);
             free(def->bytecode);
             free(def->sourcemap);
+            free(def->closure_bitset);
         }
         break;
     }
@@ -347,18 +356,18 @@ void *janet_gcalloc(enum JanetMemoryType type, size_t size) {
     mem->flags = type;
 
     /* Prepend block to heap list */
-    janet_vm_next_collection += (int32_t) size;
+    janet_vm_next_collection += size;
     mem->next = janet_vm_blocks;
     janet_vm_blocks = mem;
 
     return (void *)mem;
 }
 
-static void free_one_scratch(void *mem) {
+static void free_one_scratch(JanetScratch *s) {
-    ScratchFinalizer finalize = *(ScratchFinalizer *)mem;
+    if (NULL != s->finalize) {
-    if (finalize)
+        s->finalize((char *) s->mem);
-        finalize((char *)mem + SCRATCH_HDR_SIZE);
+    }
-    free(mem);
+    free(s);
 }
 
 /* Free all allocated scratch memory */
@@ -369,6 +378,11 @@ static void janet_free_all_scratch(void) {
     janet_scratch_len = 0;
 }
 
+static JanetScratch *janet_mem2scratch(void *mem) {
+    JanetScratch *s = (JanetScratch *)mem;
+    return s - 1;
+}
+
 /* Run garbage collection */
 void janet_collect(void) {
     uint32_t i;
@@ -390,9 +404,9 @@ void janet_collect(void) {
  * and all of its children. If gcroot is called on a value n times, unroot
  * must also be called n times to remove it as a gc root. */
 void janet_gcroot(Janet root) {
-    uint32_t newcount = janet_vm_root_count + 1;
+    size_t newcount = janet_vm_root_count + 1;
     if (newcount > janet_vm_root_capacity) {
-        uint32_t newcap = 2 * newcount;
+        size_t newcap = 2 * newcount;
         janet_vm_roots = realloc(janet_vm_roots, sizeof(Janet) * newcap);
         if (NULL == janet_vm_roots) {
             JANET_OUT_OF_MEMORY;
@@ -472,36 +486,46 @@ void janet_gcunlock(int handle) {
 /* Scratch memory API */
 
 void *janet_smalloc(size_t size) {
-    void *mem = malloc(SCRATCH_HDR_SIZE + size);
+    JanetScratch *s = malloc(sizeof(JanetScratch) + size);
-    if (NULL == mem) {
+    if (NULL == s) {
         JANET_OUT_OF_MEMORY;
     }
-    *(ScratchFinalizer *)mem = NULL;
+    s->finalize = NULL;
     if (janet_scratch_len == janet_scratch_cap) {
         size_t newcap = 2 * janet_scratch_cap + 2;
-        void **newmem = (void **) realloc(janet_scratch_mem, newcap * sizeof(void *));
+        JanetScratch **newmem = (JanetScratch **) realloc(janet_scratch_mem, newcap * sizeof(JanetScratch));
         if (NULL == newmem) {
             JANET_OUT_OF_MEMORY;
         }
         janet_scratch_cap = newcap;
         janet_scratch_mem = newmem;
     }
-    janet_scratch_mem[janet_scratch_len++] = mem;
+    janet_scratch_mem[janet_scratch_len++] = s;
-    return (char *)mem + SCRATCH_HDR_SIZE;
+    return (char *)(s->mem);
+}
+
+void *janet_scalloc(size_t nmemb, size_t size) {
+    if (nmemb && size > SIZE_MAX / nmemb) {
+        JANET_OUT_OF_MEMORY;
+    }
+    size_t n = nmemb * size;
+    void *p = janet_smalloc(n);
+    memset(p, 0, n);
+    return p;
 }
 
 void *janet_srealloc(void *mem, size_t size) {
     if (NULL == mem) return janet_smalloc(size);
-    mem = (char *)mem - SCRATCH_HDR_SIZE;
+    JanetScratch *s = janet_mem2scratch(mem);
     if (janet_scratch_len) {
         for (size_t i = janet_scratch_len - 1; ; i--) {
-            if (janet_scratch_mem[i] == mem) {
+            if (janet_scratch_mem[i] == s) {
-                void *newmem = realloc(mem, size + SCRATCH_HDR_SIZE);
+                JanetScratch *news = realloc(s, size + sizeof(JanetScratch));
-                if (NULL == newmem) {
+                if (NULL == news) {
                     JANET_OUT_OF_MEMORY;
                 }
-                janet_scratch_mem[i] = newmem;
+                janet_scratch_mem[i] = news;
-                return (char *)newmem + SCRATCH_HDR_SIZE;
+                return (char *)(news->mem);
             }
             if (i == 0) break;
         }
@@ -509,19 +533,19 @@ void *janet_srealloc(void *mem, size_t size) {
     janet_exit("invalid janet_srealloc");
 }
 
-void janet_sfinalizer(void *mem, ScratchFinalizer finalizer) {
+void janet_sfinalizer(void *mem, JanetScratchFinalizer finalizer) {
-    mem = (char *)mem - SCRATCH_HDR_SIZE;
+    JanetScratch *s = janet_mem2scratch(mem);
-    *(ScratchFinalizer *)mem = finalizer;
+    s->finalize = finalizer;
 }
 
 void janet_sfree(void *mem) {
     if (NULL == mem) return;
-    mem = (char *)mem - SCRATCH_HDR_SIZE;
+    JanetScratch *s = janet_mem2scratch(mem);
     if (janet_scratch_len) {
         for (size_t i = janet_scratch_len - 1; ; i--) {
-            if (janet_scratch_mem[i] == mem) {
+            if (janet_scratch_mem[i] == s) {
                 janet_scratch_mem[i] = janet_scratch_mem[--janet_scratch_len];
-                free_one_scratch(mem);
+                free_one_scratch(s);
                 return;
             }
             if (i == 0) break;

src/core/gc.h

@@ -1,5 +1,5 @@
 /*
-* Copyright (c) 2019 Calvin Rose
+* Copyright (c) 2020 Calvin Rose
 *
 * Permission is hereby granted, free of charge, to any person obtaining a copy
 * of this software and associated documentation files (the "Software"), to
@@ -24,6 +24,7 @@
 #define JANET_GC_H
 
 #ifndef JANET_AMALG
+#include "features.h"
 #include <janet.h>
 #endif
 

src/core/inttypes.c

@@ -1,5 +1,5 @@
 /*
-* Copyright (c) 2019 Calvin Rose & contributors
+* Copyright (c) 2020 Calvin Rose & contributors
 *
 * Permission is hereby granted, free of charge, to any person obtaining a copy
 * of this software and associated documentation files (the "Software"), to
@@ -27,6 +27,7 @@
 #include <math.h>
 
 #ifndef JANET_AMALG
+#include "features.h"
 #include <janet.h>
 #include "util.h"
 #endif
@@ -39,6 +40,24 @@
 static int it_s64_get(void *p, Janet key, Janet *out);
 static int it_u64_get(void *p, Janet key, Janet *out);
 
+static int32_t janet_int64_hash(void *p1, size_t size) {
+    (void) size;
+    int32_t *words = p1;
+    return words[0] ^ words[1];
+}
+
+static int janet_int64_compare(void *p1, void *p2) {
+    int64_t x = *((int64_t *)p1);
+    int64_t y = *((int64_t *)p2);
+    return x == y ? 0 : x < y ? -1 : 1;
+}
+
+static int janet_uint64_compare(void *p1, void *p2) {
+    uint64_t x = *((uint64_t *)p1);
+    uint64_t y = *((uint64_t *)p2);
+    return x == y ? 0 : x < y ? -1 : 1;
+}
+
 static void int64_marshal(void *p, JanetMarshalContext *ctx) {
     janet_marshal_abstract(ctx, p);
     janet_marshal_int64(ctx, *((int64_t *)p));
@@ -62,7 +81,7 @@ static void it_u64_tostring(void *p, JanetBuffer *buffer) {
     janet_buffer_push_cstring(buffer, str);
 }
 
-static const JanetAbstractType it_s64_type = {
+const JanetAbstractType janet_s64_type = {
     "core/s64",
     NULL,
     NULL,
@@ -70,10 +89,13 @@ static const JanetAbstractType it_s64_type = {
     NULL,
     int64_marshal,
     int64_unmarshal,
-    it_s64_tostring
+    it_s64_tostring,
+    janet_int64_compare,
+    janet_int64_hash,
+    JANET_ATEND_HASH
 };
 
-static const JanetAbstractType it_u64_type = {
+const JanetAbstractType janet_u64_type = {
     "core/u64",
     NULL,
     NULL,
@@ -81,7 +103,10 @@ static const JanetAbstractType it_u64_type = {
     NULL,
     int64_marshal,
     int64_unmarshal,
-    it_u64_tostring
+    it_u64_tostring,
+    janet_uint64_compare,
+    janet_int64_hash,
+    JANET_ATEND_HASH
 };
 
 int64_t janet_unwrap_s64(Janet x) {
@@ -103,8 +128,8 @@ int64_t janet_unwrap_s64(Janet x) {
         }
         case JANET_ABSTRACT: {
             void *abst = janet_unwrap_abstract(x);
-            if (janet_abstract_type(abst) == &it_s64_type ||
+            if (janet_abstract_type(abst) == &janet_s64_type ||
-                    (janet_abstract_type(abst) == &it_u64_type))
+                    (janet_abstract_type(abst) == &janet_u64_type))
                 return *(int64_t *)abst;
             break;
         }
@@ -132,8 +157,8 @@ uint64_t janet_unwrap_u64(Janet x) {
         }
         case JANET_ABSTRACT: {
             void *abst = janet_unwrap_abstract(x);
-            if (janet_abstract_type(abst) == &it_s64_type ||
+            if (janet_abstract_type(abst) == &janet_s64_type ||
-                    (janet_abstract_type(abst) == &it_u64_type))
+                    (janet_abstract_type(abst) == &janet_u64_type))
                 return *(uint64_t *)abst;
             break;
         }
@@ -145,19 +170,19 @@ uint64_t janet_unwrap_u64(Janet x) {
 JanetIntType janet_is_int(Janet x) {
     if (!janet_checktype(x, JANET_ABSTRACT)) return JANET_INT_NONE;
     const JanetAbstractType *at = janet_abstract_type(janet_unwrap_abstract(x));
-    return (at == &it_s64_type) ? JANET_INT_S64 :
+    return (at == &janet_s64_type) ? JANET_INT_S64 :
-           ((at == &it_u64_type) ? JANET_INT_U64 :
+           ((at == &janet_u64_type) ? JANET_INT_U64 :
             JANET_INT_NONE);
 }
 
 Janet janet_wrap_s64(int64_t x) {
-    int64_t *box = janet_abstract(&it_s64_type, sizeof(int64_t));
+    int64_t *box = janet_abstract(&janet_s64_type, sizeof(int64_t));
     *box = (int64_t)x;
     return janet_wrap_abstract(box);
 }
 
 Janet janet_wrap_u64(uint64_t x) {
-    uint64_t *box = janet_abstract(&it_u64_type, sizeof(uint64_t));
+    uint64_t *box = janet_abstract(&janet_u64_type, sizeof(uint64_t));
     *box = (uint64_t)x;
     return janet_wrap_abstract(box);
 }
@@ -175,51 +200,52 @@ static Janet cfun_it_u64_new(int32_t argc, Janet *argv) {
 #define OPMETHOD(T, type, name, oper) \
 static Janet cfun_it_##type##_##name(int32_t argc, Janet *argv) { \
     janet_arity(argc, 2, -1); \
-    T *box = janet_abstract(&it_##type##_type, sizeof(T)); \
+    T *box = janet_abstract(&janet_##type##_type, sizeof(T)); \
     *box = janet_unwrap_##type(argv[0]); \
-    for (int i = 1; i < argc; i++) \
+    for (int32_t i = 1; i < argc; i++) \
         *box oper##= janet_unwrap_##type(argv[i]); \
     return janet_wrap_abstract(box); \
 } \
- \
+
-static Janet cfun_it_##type##_##name##_mut(int32_t argc, Janet *argv) { \
+#define OPMETHODINVERT(T, type, name, oper) \
-    janet_arity(argc, 2, -1); \
+static Janet cfun_it_##type##_##name(int32_t argc, Janet *argv) { \
-    T *box = janet_getabstract(argv,0,&it_##type##_type); \
+    janet_fixarity(argc, 2); \
-    for (int i = 1; i < argc; i++) \
+    T *box = janet_abstract(&janet_##type##_type, sizeof(T)); \
-        *box oper##= janet_unwrap_##type(argv[i]); \
+    *box = janet_unwrap_##type(argv[1]); \
+    *box oper##= janet_unwrap_##type(argv[0]); \
     return janet_wrap_abstract(box); \
-}
+} \
 
 #define DIVMETHOD(T, type, name, oper) \
 static Janet cfun_it_##type##_##name(int32_t argc, Janet *argv) { \
     janet_arity(argc, 2, -1);                       \
-    T *box = janet_abstract(&it_##type##_type, sizeof(T)); \
+    T *box = janet_abstract(&janet_##type##_type, sizeof(T)); \
     *box = janet_unwrap_##type(argv[0]); \
-    for (int i = 1; i < argc; i++) { \
+    for (int32_t i = 1; i < argc; i++) { \
       T value = janet_unwrap_##type(argv[i]); \
       if (value == 0) janet_panic("division by zero"); \
       *box oper##= value; \
     } \
     return janet_wrap_abstract(box); \
 } \
- \
+
-static Janet cfun_it_##type##_##name##_mut(int32_t argc, Janet *argv) { \
+#define DIVMETHODINVERT(T, type, name, oper) \
-    janet_arity(argc, 2, -1); \
+static Janet cfun_it_##type##_##name(int32_t argc, Janet *argv) { \
-    T *box = janet_getabstract(argv,0,&it_##type##_type); \
+    janet_fixarity(argc, 2);                       \
-    for (int i = 1; i < argc; i++) { \
+    T *box = janet_abstract(&janet_##type##_type, sizeof(T)); \
-      T value =  janet_unwrap_##type(argv[i]); \
+    *box = janet_unwrap_##type(argv[1]); \
-      if (value == 0) janet_panic("division by zero"); \
+    T value = janet_unwrap_##type(argv[0]); \
-      *box oper##= value; \
+    if (value == 0) janet_panic("division by zero"); \
-    } \
+    *box oper##= value; \
     return janet_wrap_abstract(box); \
-}
+} \
 
 #define DIVMETHOD_SIGNED(T, type, name, oper) \
 static Janet cfun_it_##type##_##name(int32_t argc, Janet *argv) { \
     janet_arity(argc, 2, -1);                       \
-    T *box = janet_abstract(&it_##type##_type, sizeof(T)); \
+    T *box = janet_abstract(&janet_##type##_type, sizeof(T)); \
     *box = janet_unwrap_##type(argv[0]); \
-    for (int i = 1; i < argc; i++) { \
+    for (int32_t i = 1; i < argc; i++) { \
       T value = janet_unwrap_##type(argv[i]); \
       if (value == 0) janet_panic("division by zero"); \
       if ((value == -1) && (*box == INT64_MIN)) janet_panic("INT64_MIN divided by -1"); \
@@ -227,18 +253,18 @@ static Janet cfun_it_##type##_##name(int32_t argc, Janet *argv) { \
     } \
     return janet_wrap_abstract(box); \
 } \
- \
+
-static Janet cfun_it_##type##_##name##_mut(int32_t argc, Janet *argv) { \
+#define DIVMETHODINVERT_SIGNED(T, type, name, oper) \
-    janet_arity(argc, 2, -1); \
+static Janet cfun_it_##type##_##name(int32_t argc, Janet *argv) { \
-    T *box = janet_getabstract(argv,0,&it_##type##_type); \
+    janet_fixarity(argc, 2);                       \
-    for (int i = 1; i < argc; i++) { \
+    T *box = janet_abstract(&janet_##type##_type, sizeof(T)); \
-      T value = janet_unwrap_##type(argv[i]); \
+    *box = janet_unwrap_##type(argv[1]); \
-      if (value == 0) janet_panic("division by zero"); \
+    T value = janet_unwrap_##type(argv[0]); \
-      if ((value == -1) && (*box == INT64_MIN)) janet_panic("INT64_MIN divided by -1"); \
+    if (value == 0) janet_panic("division by zero"); \
-      *box oper##= value; \
+    if ((value == -1) && (*box == INT64_MIN)) janet_panic("INT64_MIN divided by -1"); \
-    } \
+    *box oper##= value; \
     return janet_wrap_abstract(box); \
-}
+} \
 
 #define COMPMETHOD(T, type, name, oper) \
 static Janet cfun_it_##type##_##name(int32_t argc, Janet *argv) { \
@@ -248,11 +274,43 @@ static Janet cfun_it_##type##_##name(int32_t argc, Janet *argv) { \
     return janet_wrap_boolean(v1 oper v2); \
 }
 
+static Janet cfun_it_s64_mod(int32_t argc, Janet *argv) {
+    janet_arity(argc, 2, -1);
+    int64_t *box = janet_abstract(&janet_s64_type, sizeof(int64_t));
+    *box = janet_unwrap_s64(argv[0]);
+    for (int32_t i = 1; i < argc; i++) {
+        int64_t value = janet_unwrap_s64(argv[i]);
+        if (value == 0) janet_panic("division by zero");
+        int64_t x = *box % value;
+        if (x < 0) {
+            x = (*box < 0) ? x - *box : x + *box;
+        }
+        *box = x;
+    }
+    return janet_wrap_abstract(box);
+}
+
+static Janet cfun_it_s64_modi(int32_t argc, Janet *argv) {
+    janet_fixarity(argc, 2);
+    int64_t *box = janet_abstract(&janet_s64_type, sizeof(int64_t));
+    int64_t op1 = janet_unwrap_s64(argv[0]);
+    int64_t op2 = janet_unwrap_s64(argv[1]);
+    int64_t x = op1 % op2;
+    if (x < 0) {
+        x = (op1 < 0) ? x - op1 : x + op1;
+    }
+    *box = x;
+    return janet_wrap_abstract(box);
+}
+
 OPMETHOD(int64_t, s64, add, +)
 OPMETHOD(int64_t, s64, sub, -)
+OPMETHODINVERT(int64_t, s64, subi, -)
 OPMETHOD(int64_t, s64, mul, *)
 DIVMETHOD_SIGNED(int64_t, s64, div, /)
-DIVMETHOD_SIGNED(int64_t, s64, mod, %)
+DIVMETHOD_SIGNED(int64_t, s64, rem, %)
+DIVMETHODINVERT_SIGNED(int64_t, s64, divi, /)
+DIVMETHODINVERT_SIGNED(int64_t, s64, remi, %)
 OPMETHOD(int64_t, s64, and, &)
 OPMETHOD(int64_t, s64, or, |)
 OPMETHOD(int64_t, s64, xor, ^)
@@ -267,9 +325,12 @@ COMPMETHOD(int64_t, s64, ne, !=)
 
 OPMETHOD(uint64_t, u64, add, +)
 OPMETHOD(uint64_t, u64, sub, -)
+OPMETHODINVERT(uint64_t, u64, subi, -)
 OPMETHOD(uint64_t, u64, mul, *)
 DIVMETHOD(uint64_t, u64, div, /)
 DIVMETHOD(uint64_t, u64, mod, %)
+DIVMETHODINVERT(uint64_t, u64, divi, /)
+DIVMETHODINVERT(uint64_t, u64, modi, %)
 OPMETHOD(uint64_t, u64, and, &)
 OPMETHOD(uint64_t, u64, or, |)
 OPMETHOD(uint64_t, u64, xor, ^)
@@ -289,65 +350,63 @@ COMPMETHOD(uint64_t, u64, ne, !=)
 
 static JanetMethod it_s64_methods[] = {
     {"+", cfun_it_s64_add},
+    {"r+", cfun_it_s64_add},
     {"-", cfun_it_s64_sub},
+    {"r-", cfun_it_s64_subi},
     {"*", cfun_it_s64_mul},
+    {"r*", cfun_it_s64_mul},
     {"/", cfun_it_s64_div},
-    {"%", cfun_it_s64_mod},
+    {"r/", cfun_it_s64_divi},
+    {"mod", cfun_it_s64_mod},
+    {"rmod", cfun_it_s64_modi},
+    {"%", cfun_it_s64_rem},
+    {"r%", cfun_it_s64_remi},
     {"<", cfun_it_s64_lt},
     {">", cfun_it_s64_gt},
     {"<=", cfun_it_s64_le},
     {">=", cfun_it_s64_ge},
-    {"==", cfun_it_s64_eq},
+    {"=", cfun_it_s64_eq},
     {"!=", cfun_it_s64_ne},
     {"&", cfun_it_s64_and},
+    {"r&", cfun_it_s64_and},
     {"|", cfun_it_s64_or},
+    {"r|", cfun_it_s64_or},
     {"^", cfun_it_s64_xor},
+    {"r^", cfun_it_s64_xor},
     {"<<", cfun_it_s64_lshift},
     {">>", cfun_it_s64_rshift},
 
-    {"+!", cfun_it_s64_add_mut},
-    {"-!", cfun_it_s64_sub_mut},
-    {"*!", cfun_it_s64_mul_mut},
-    {"/!", cfun_it_s64_div_mut},
-    {"%!", cfun_it_s64_mod_mut},
-    {"&!", cfun_it_s64_and_mut},
-    {"|!", cfun_it_s64_or_mut},
-    {"^!", cfun_it_s64_xor_mut},
-    {"<<!", cfun_it_s64_lshift_mut},
-    {">>!", cfun_it_s64_rshift_mut},
-
     {NULL, NULL}
 };
 
 static JanetMethod it_u64_methods[] = {
     {"+", cfun_it_u64_add},
+    {"r+", cfun_it_u64_add},
     {"-", cfun_it_u64_sub},
+    {"r-", cfun_it_u64_subi},
     {"*", cfun_it_u64_mul},
+    {"r*", cfun_it_u64_mul},
     {"/", cfun_it_u64_div},
+    {"r/", cfun_it_u64_divi},
+    {"mod", cfun_it_u64_mod},
+    {"rmod", cfun_it_u64_modi},
     {"%", cfun_it_u64_mod},
+    {"r%", cfun_it_u64_modi},
     {"<", cfun_it_u64_lt},
     {">", cfun_it_u64_gt},
     {"<=", cfun_it_u64_le},
     {">=", cfun_it_u64_ge},
-    {"==", cfun_it_u64_eq},
+    {"=", cfun_it_u64_eq},
     {"!=", cfun_it_u64_ne},
     {"&", cfun_it_u64_and},
+    {"r&", cfun_it_u64_and},
     {"|", cfun_it_u64_or},
+    {"r|", cfun_it_u64_or},
     {"^", cfun_it_u64_xor},
+    {"r^", cfun_it_u64_xor},
     {"<<", cfun_it_u64_lshift},
     {">>", cfun_it_u64_rshift},
 
-    {"+!", cfun_it_u64_add_mut},
-    {"-!", cfun_it_u64_sub_mut},
-    {"*!", cfun_it_u64_mul_mut},
-    {"/!", cfun_it_u64_div_mut},
-    {"%!", cfun_it_u64_mod_mut},
-    {"&!", cfun_it_u64_and_mut},
-    {"|!", cfun_it_u64_or_mut},
-    {"^!", cfun_it_u64_xor_mut},
-    {"<<!", cfun_it_u64_lshift_mut},
-    {">>!", cfun_it_u64_rshift_mut},
-
     {NULL, NULL}
 };
 
@@ -382,8 +441,8 @@ static const JanetReg it_cfuns[] = {
 /* Module entry point */
 void janet_lib_inttypes(JanetTable *env) {
     janet_core_cfuns(env, NULL, it_cfuns);
-    janet_register_abstract_type(&it_s64_type);
+    janet_register_abstract_type(&janet_s64_type);
-    janet_register_abstract_type(&it_u64_type);
+    janet_register_abstract_type(&janet_u64_type);
 }
 
 #endif

src/core/io.c

@@ -1,5 +1,5 @@
 /*
-* Copyright (c) 2019 Calvin Rose
+* Copyright (c) 2020 Calvin Rose
 *
 * Permission is hereby granted, free of charge, to any person obtaining a copy
 * of this software and associated documentation files (the "Software"), to
@@ -21,6 +21,7 @@
 */
 
 #ifndef JANET_AMALG
+#include "features.h"
 #include <janet.h>
 #include "util.h"
 #endif
@@ -32,24 +33,15 @@
 #include <sys/wait.h>
 #endif
 
-typedef struct IOFile IOFile;
-struct IOFile {
-    FILE *file;
-    int flags;
-};
-
 static int cfun_io_gc(void *p, size_t len);
 static int io_file_get(void *p, Janet key, Janet *out);
 
-JanetAbstractType cfun_io_filetype = {
+const JanetAbstractType janet_file_type = {
     "core/file",
     cfun_io_gc,
     NULL,
     io_file_get,
-    NULL,
+    JANET_ATEND_GET
-    NULL,
-    NULL,
-    NULL
 };
 
 /* Check arguments to fopen */
@@ -92,7 +84,7 @@ static int checkflags(const uint8_t *str) {
 }
 
 static Janet makef(FILE *f, int flags) {
-    IOFile *iof = (IOFile *) janet_abstract(&cfun_io_filetype, sizeof(IOFile));
+    JanetFile *iof = (JanetFile *) janet_abstract(&janet_file_type, sizeof(JanetFile));
     iof->file = f;
     iof->flags = flags;
     return janet_wrap_abstract(iof);
@@ -134,6 +126,15 @@ static Janet cfun_io_popen(int32_t argc, Janet *argv) {
 }
 #endif
 
+static Janet cfun_io_temp(int32_t argc, Janet *argv) {
+    (void)argv;
+    janet_fixarity(argc, 0);
+    FILE *tmp = tmpfile();
+    if (!tmp)
+        janet_panicf("unable to create temporary file - %s", strerror(errno));
+    return janet_makefile(tmp, JANET_FILE_WRITE | JANET_FILE_READ | JANET_FILE_BINARY);
+}
+
 static Janet cfun_io_fopen(int32_t argc, Janet *argv) {
     janet_arity(argc, 1, 2);
     const uint8_t *fname = janet_getstring(argv, 0);
@@ -150,38 +151,8 @@ static Janet cfun_io_fopen(int32_t argc, Janet *argv) {
     return f ? makef(f, flags) : janet_wrap_nil();
 }
 
-static Janet cfun_io_fdopen(int32_t argc, Janet *argv) {
-    janet_arity(argc, 1, 2);
-    const int fd = janet_getinteger(argv, 0);
-    const uint8_t *fmode;
-    int flags;
-    if (argc == 2) {
-        fmode = janet_getkeyword(argv, 1);
-        flags = checkflags(fmode);
-    } else {
-        fmode = (const uint8_t *)"r";
-        flags = JANET_FILE_READ;
-    }
-#ifdef JANET_WINDOWS
-#define fdopen _fdopen
-#endif
-    FILE *f = fdopen(fd, (const char *)fmode);
-    return f ? makef(f, flags) : janet_wrap_nil();
-}
-
-static Janet cfun_io_fileno(int32_t argc, Janet *argv) {
-    janet_fixarity(argc, 1);
-    IOFile *iof = janet_getabstract(argv, 0, &cfun_io_filetype);
-    if (iof->flags & JANET_FILE_CLOSED)
-        janet_panic("file is closed");
-#ifdef JANET_WINDOWS
-#define fileno _fileno
-#endif
-    return janet_wrap_integer(fileno(iof->file));
-}
-
 /* Read up to n bytes into buffer. */
-static void read_chunk(IOFile *iof, JanetBuffer *buffer, int32_t nBytesMax) {
+static void read_chunk(JanetFile *iof, JanetBuffer *buffer, int32_t nBytesMax) {
     if (!(iof->flags & (JANET_FILE_READ | JANET_FILE_UPDATE)))
         janet_panic("file is not readable");
     janet_buffer_extra(buffer, nBytesMax);
@@ -195,7 +166,7 @@ static void read_chunk(IOFile *iof, JanetBuffer *buffer, int32_t nBytesMax) {
 /* Read a certain number of bytes into memory */
 static Janet cfun_io_fread(int32_t argc, Janet *argv) {
     janet_arity(argc, 2, 3);
-    IOFile *iof = janet_getabstract(argv, 0, &cfun_io_filetype);
+    JanetFile *iof = janet_getabstract(argv, 0, &janet_file_type);
     if (iof->flags & JANET_FILE_CLOSED) janet_panic("file is closed");
     JanetBuffer *buffer;
     if (argc == 2) {
@@ -235,7 +206,7 @@ static Janet cfun_io_fread(int32_t argc, Janet *argv) {
 /* Write bytes to a file */
 static Janet cfun_io_fwrite(int32_t argc, Janet *argv) {
     janet_arity(argc, 1, -1);
-    IOFile *iof = janet_getabstract(argv, 0, &cfun_io_filetype);
+    JanetFile *iof = janet_getabstract(argv, 0, &janet_file_type);
     if (iof->flags & JANET_FILE_CLOSED)
         janet_panic("file is closed");
     if (!(iof->flags & (JANET_FILE_WRITE | JANET_FILE_APPEND | JANET_FILE_UPDATE)))
@@ -258,7 +229,7 @@ static Janet cfun_io_fwrite(int32_t argc, Janet *argv) {
 /* Flush the bytes in the file */
 static Janet cfun_io_fflush(int32_t argc, Janet *argv) {
     janet_fixarity(argc, 1);
-    IOFile *iof = janet_getabstract(argv, 0, &cfun_io_filetype);
+    JanetFile *iof = janet_getabstract(argv, 0, &janet_file_type);
     if (iof->flags & JANET_FILE_CLOSED)
         janet_panic("file is closed");
     if (!(iof->flags & (JANET_FILE_WRITE | JANET_FILE_APPEND | JANET_FILE_UPDATE)))
@@ -271,7 +242,7 @@ static Janet cfun_io_fflush(int32_t argc, Janet *argv) {
 /* Cleanup a file */
 static int cfun_io_gc(void *p, size_t len) {
     (void) len;
-    IOFile *iof = (IOFile *)p;
+    JanetFile *iof = (JanetFile *)p;
     if (!(iof->flags & (JANET_FILE_NOT_CLOSEABLE | JANET_FILE_CLOSED))) {
         return fclose(iof->file);
     }
@@ -281,9 +252,9 @@ static int cfun_io_gc(void *p, size_t len) {
 /* Close a file */
 static Janet cfun_io_fclose(int32_t argc, Janet *argv) {
     janet_fixarity(argc, 1);
-    IOFile *iof = janet_getabstract(argv, 0, &cfun_io_filetype);
+    JanetFile *iof = janet_getabstract(argv, 0, &janet_file_type);
     if (iof->flags & JANET_FILE_CLOSED)
-        janet_panic("file is closed");
+        return janet_wrap_nil();
     if (iof->flags & (JANET_FILE_NOT_CLOSEABLE))
         janet_panic("file not closable");
     if (iof->flags & JANET_FILE_PIPED) {
@@ -305,7 +276,7 @@ static Janet cfun_io_fclose(int32_t argc, Janet *argv) {
 /* Seek a file */
 static Janet cfun_io_fseek(int32_t argc, Janet *argv) {
     janet_arity(argc, 2, 3);
-    IOFile *iof = janet_getabstract(argv, 0, &cfun_io_filetype);
+    JanetFile *iof = janet_getabstract(argv, 0, &janet_file_type);
     if (iof->flags & JANET_FILE_CLOSED)
         janet_panic("file is closed");
     long int offset = 0;
@@ -331,7 +302,6 @@ static Janet cfun_io_fseek(int32_t argc, Janet *argv) {
 
 static JanetMethod io_file_methods[] = {
     {"close", cfun_io_fclose},
-    {"fileno", cfun_io_fileno},
     {"flush", cfun_io_fflush},
     {"read", cfun_io_fread},
     {"seek", cfun_io_fseek},
@@ -350,8 +320,8 @@ FILE *janet_dynfile(const char *name, FILE *def) {
     Janet x = janet_dyn(name);
     if (!janet_checktype(x, JANET_ABSTRACT)) return def;
     void *abstract = janet_unwrap_abstract(x);
-    if (janet_abstract_type(abstract) != &cfun_io_filetype) return def;
+    if (janet_abstract_type(abstract) != &janet_file_type) return def;
-    IOFile *iofile = abstract;
+    JanetFile *iofile = abstract;
     return iofile->file;
 }
 
@@ -378,9 +348,9 @@ static Janet cfun_io_print_impl(int32_t argc, Janet *argv,
             break;
         case JANET_ABSTRACT: {
             void *abstract = janet_unwrap_abstract(x);
-            if (janet_abstract_type(abstract) != &cfun_io_filetype)
+            if (janet_abstract_type(abstract) != &janet_file_type)
                 return janet_wrap_nil();
-            IOFile *iofile = abstract;
+            JanetFile *iofile = abstract;
             f = iofile->file;
             break;
         }
@@ -445,9 +415,9 @@ static Janet cfun_io_printf_impl(int32_t argc, Janet *argv, int newline,
             break;
         case JANET_ABSTRACT: {
             void *abstract = janet_unwrap_abstract(x);
-            if (janet_abstract_type(abstract) != &cfun_io_filetype)
+            if (janet_abstract_type(abstract) != &janet_file_type)
                 return janet_wrap_nil();
-            IOFile *iofile = abstract;
+            JanetFile *iofile = abstract;
             f = iofile->file;
             break;
         }
@@ -484,6 +454,38 @@ static Janet cfun_io_eprinf(int32_t argc, Janet *argv) {
     return cfun_io_printf_impl(argc, argv, 0, "err", stderr);
 }
 
+static void janet_flusher(const char *name, FILE *dflt_file) {
+    Janet x = janet_dyn(name);
+    switch (janet_type(x)) {
+        default:
+            break;
+        case JANET_NIL:
+            fflush(dflt_file);
+            break;
+        case JANET_ABSTRACT: {
+            void *abstract = janet_unwrap_abstract(x);
+            if (janet_abstract_type(abstract) != &janet_file_type) break;
+            JanetFile *iofile = abstract;
+            fflush(iofile->file);
+            break;
+        }
+    }
+}
+
+static Janet cfun_io_flush(int32_t argc, Janet *argv) {
+    janet_fixarity(argc, 0);
+    (void) argv;
+    janet_flusher("out", stdout);
+    return janet_wrap_nil();
+}
+
+static Janet cfun_io_eflush(int32_t argc, Janet *argv) {
+    janet_fixarity(argc, 0);
+    (void) argv;
+    janet_flusher("err", stderr);
+    return janet_wrap_nil();
+}
+
 void janet_dynprintf(const char *name, FILE *dflt_file, const char *format, ...) {
     va_list args;
     va_start(args, format);
@@ -503,9 +505,9 @@ void janet_dynprintf(const char *name, FILE *dflt_file, const char *format, ...)
             janet_formatb(&buffer, format, args);
             if (xtype == JANET_ABSTRACT) {
                 void *abstract = janet_unwrap_abstract(x);
-                if (janet_abstract_type(abstract) != &cfun_io_filetype)
+                if (janet_abstract_type(abstract) != &janet_file_type)
                     break;
-                IOFile *iofile = abstract;
+                JanetFile *iofile = abstract;
                 f = iofile->file;
             }
             fwrite(buffer.data, buffer.count, 1, f);
@@ -565,6 +567,22 @@ static const JanetReg io_cfuns[] = {
         JDOC("(eprinf fmt & xs)\n\n"
              "Like eprintf but with no trailing newline.")
     },
+    {
+        "flush", cfun_io_flush,
+        JDOC("(flush)\n\n"
+             "Flush (dyn :out stdout) if it is a file, otherwise do nothing.")
+    },
+    {
+        "eflush", cfun_io_eflush,
+        JDOC("(eflush)\n\n"
+             "Flush (dyn :err stderr) if it is a file, otherwise do nothing.")
+    },
+    {
+        "file/temp", cfun_io_temp,
+        JDOC("(file/temp)\n\n"
+             "Open an anonymous temporary file that is removed on close."
+             "Raises an error on failure.")
+    },
     {
         "file/open", cfun_io_fopen,
         JDOC("(file/open path &opt mode)\n\n"
@@ -579,32 +597,13 @@ static const JanetReg io_cfuns[] = {
              "\tb - open the file in binary mode (rather than text mode)\n"
              "\t+ - append to the file instead of overwriting it")
     },
-    {
-        "file/fdopen", cfun_io_fdopen,
-        JDOC("(file/fdopen fd &opt mode)\n\n"
-             "Create a file from an fd. fd is a platform specific file descriptor, and "
-             "mode is a set of flags indicating the mode to open the file in. "
-             "mode is a keyword where each character represents a flag. If the file "
-             "cannot be opened, returns nil, otherwise returns the new file handle. "
-             "Mode flags:\n\n"
-             "\tr - allow reading from the file\n"
-             "\tw - allow writing to the file\n"
-             "\ta - append to the file\n"
-             "\tb - open the file in binary mode (rather than text mode)\n"
-             "\t+ - append to the file instead of overwriting it")
-    },
-    {
-        "file/fileno", cfun_io_fileno,
-        JDOC("(file/fileno f)\n\n"
-             "Return the underlying file descriptor for the file as a number."
-             "The meaning of this number is platform specific.")
-    },
     {
         "file/close", cfun_io_fclose,
         JDOC("(file/close f)\n\n"
              "Close a file and release all related resources. When you are "
              "done reading a file, close it to prevent a resource leak and let "
-             "other processes read the file.")
+             "other processes read the file. If the file is the result of a file/popen "
+             "call, close waits for and returns the process exit status.")
     },
     {
         "file/read", cfun_io_fread,
@@ -655,7 +654,21 @@ static const JanetReg io_cfuns[] = {
 /* C API */
 
 FILE *janet_getfile(const Janet *argv, int32_t n, int *flags) {
-    IOFile *iof = janet_getabstract(argv, n, &cfun_io_filetype);
+    JanetFile *iof = janet_getabstract(argv, n, &janet_file_type);
+    if (NULL != flags) *flags = iof->flags;
+    return iof->file;
+}
+
+Janet janet_makefile(FILE *f, int flags) {
+    return makef(f, flags);
+}
+
+JanetAbstract janet_checkfile(Janet j) {
+    return janet_checkabstract(j, &janet_file_type);
+}
+
+FILE *janet_unwrapfile(Janet j, int *flags) {
+    JanetFile *iof = janet_unwrap_abstract(j);
     if (NULL != flags) *flags = iof->flags;
     return iof->file;
 }

src/core/marsh.c

@@ -1,5 +1,5 @@
 /*
-* Copyright (c) 2019 Calvin Rose
+* Copyright (c) 2020 Calvin Rose
 *
 * Permission is hereby granted, free of charge, to any person obtaining a copy
 * of this software and associated documentation files (the "Software"), to
@@ -21,6 +21,7 @@
 */
 
 #ifndef JANET_AMALG
+#include "features.h"
 #include <janet.h>
 #include "state.h"
 #include "vector.h"
@@ -94,8 +95,8 @@ void janet_env_lookup_into(JanetTable *renv, JanetTable *env, const char *prefix
                     const uint8_t *oldsym = janet_unwrap_symbol(env->data[i].key);
                     int32_t oldlen = janet_string_length(oldsym);
                     uint8_t *symbuf = janet_smalloc(prelen + oldlen);
-                    memcpy(symbuf, prefix, prelen);
+                    safe_memcpy(symbuf, prefix, prelen);
-                    memcpy(symbuf + prelen, oldsym, oldlen);
+                    safe_memcpy(symbuf + prelen, oldsym, oldlen);
                     Janet s = janet_symbolv(symbuf, prelen + oldlen);
                     janet_sfree(symbuf);
                     janet_table_put(renv, s, entry_getval(env->data[i].value));
@@ -183,15 +184,30 @@ static void marshal_one_env(MarshalState *st, JanetFuncEnv *env, int flags) {
         }
     }
     janet_v_push(st->seen_envs, env);
-    pushint(st, env->offset);
+    if (env->offset && (JANET_STATUS_ALIVE == janet_fiber_status(env->as.fiber))) {
-    pushint(st, env->length);
+        pushint(st, 0);
-    if (env->offset) {
+        pushint(st, env->length);
-        /* On stack variant */
+        Janet *values = env->as.fiber->data + env->offset;
-        marshal_one(st, janet_wrap_fiber(env->as.fiber), flags + 1);
+        uint32_t *bitset = janet_stack_frame(values)->func->def->closure_bitset;
+        for (int32_t i = 0; i < env->length; i++) {
+            if (1 & (bitset[i >> 5] >> (i & 0x1F))) {
+                marshal_one(st, values[i], flags + 1);
+            } else {
+                pushbyte(st, LB_NIL);
+            }
+        }
     } else {
-        /* Off stack variant */
+        janet_env_maybe_detach(env);
-        for (int32_t i = 0; i < env->length; i++)
+        pushint(st, env->offset);
-            marshal_one(st, env->as.values[i], flags + 1);
+        pushint(st, env->length);
+        if (env->offset) {
+            /* On stack variant */
+            marshal_one(st, janet_wrap_fiber(env->as.fiber), flags + 1);
+        } else {
+            /* Off stack variant */
+            for (int32_t i = 0; i < env->length; i++)
+                marshal_one(st, env->as.values[i], flags + 1);
+        }
     }
 }
 
@@ -204,6 +220,16 @@ static void janet_func_addflags(JanetFuncDef *def) {
     if (def->sourcemap) def->flags |= JANET_FUNCDEF_FLAG_HASSOURCEMAP;
 }
 
+/* Marshal a sequence of u32s */
+static void janet_marshal_u32s(MarshalState *st, const uint32_t *u32s, int32_t n) {
+    for (int32_t i = 0; i < n; i++) {
+        pushbyte(st, u32s[i] & 0xFF);
+        pushbyte(st, (u32s[i] >> 8) & 0xFF);
+        pushbyte(st, (u32s[i] >> 16) & 0xFF);
+        pushbyte(st, (u32s[i] >> 24) & 0xFF);
+    }
+}
+
 /* Marshal a function def */
 static void marshal_one_def(MarshalState *st, JanetFuncDef *def, int flags) {
     MARSH_STACKCHECK;
@@ -238,12 +264,7 @@ static void marshal_one_def(MarshalState *st, JanetFuncDef *def, int flags) {
         marshal_one(st, def->constants[i], flags);
 
     /* marshal the bytecode */
-    for (int32_t i = 0; i < def->bytecode_length; i++) {
+    janet_marshal_u32s(st, def->bytecode, def->bytecode_length);
-        pushbyte(st, def->bytecode[i] & 0xFF);
-        pushbyte(st, (def->bytecode[i] >> 8) & 0xFF);
-        pushbyte(st, (def->bytecode[i] >> 16) & 0xFF);
-        pushbyte(st, (def->bytecode[i] >> 24) & 0xFF);
-    }
 
     /* marshal the environments if needed */
     for (int32_t i = 0; i < def->environments_length; i++)
@@ -263,6 +284,11 @@ static void marshal_one_def(MarshalState *st, JanetFuncDef *def, int flags) {
             current = map.line;
         }
     }
+
+    /* Marshal closure bitset, if needed */
+    if (def->flags & JANET_FUNCDEF_FLAG_HASCLOBITSET) {
+        janet_marshal_u32s(st, def->closure_bitset, ((def->slotcount + 31) >> 5));
+    }
 }
 
 #define JANET_FIBER_FLAG_HASCHILD (1 << 29)
@@ -692,7 +718,7 @@ static const uint8_t *unmarshal_one_env(
                 janet_panic("invalid funcenv length");
         } else {
             /* Off stack variant */
-            env->as.values = malloc(sizeof(Janet) * length);
+            env->as.values = malloc(sizeof(Janet) * (size_t) length);
             if (!env->as.values) {
                 JANET_OUT_OF_MEMORY;
             }
@@ -706,6 +732,20 @@ static const uint8_t *unmarshal_one_env(
     return data;
 }
 
+/* Unmarshal a series of u32s */
+static const uint8_t *janet_unmarshal_u32s(UnmarshalState *st, const uint8_t *data, uint32_t *into, int32_t n) {
+    for (int32_t i = 0; i < n; i++) {
+        MARSH_EOS(st, data + 3);
+        into[i] =
+            (uint32_t)(data[0]) |
+            ((uint32_t)(data[1]) << 8) |
+            ((uint32_t)(data[2]) << 16) |
+            ((uint32_t)(data[3]) << 24);
+        data += 4;
+    }
+    return data;
+}
+
 /* Unmarshal a funcdef */
 static const uint8_t *unmarshal_one_def(
     UnmarshalState *st,
@@ -729,6 +769,7 @@ static const uint8_t *unmarshal_one_def(
         def->bytecode_length = 0;
         def->name = NULL;
         def->source = NULL;
+        def->closure_bitset = NULL;
         janet_v_push(st->lookup_defs, def);
 
         /* Set default lengths to zero */
@@ -784,20 +825,12 @@ static const uint8_t *unmarshal_one_def(
         if (!def->bytecode) {
             JANET_OUT_OF_MEMORY;
         }
-        for (int32_t i = 0; i < bytecode_length; i++) {
+        data = janet_unmarshal_u32s(st, data, def->bytecode, bytecode_length);
-            MARSH_EOS(st, data + 3);
-            def->bytecode[i] =
-                (uint32_t)(data[0]) |
-                ((uint32_t)(data[1]) << 8) |
-                ((uint32_t)(data[2]) << 16) |
-                ((uint32_t)(data[3]) << 24);
-            data += 4;
-        }
         def->bytecode_length = bytecode_length;
 
         /* Unmarshal environments */
         if (def->flags & JANET_FUNCDEF_FLAG_HASENVS) {
-            def->environments = calloc(1, sizeof(int32_t) * environments_length);
+            def->environments = calloc(1, sizeof(int32_t) * (size_t) environments_length);
             if (!def->environments) {
                 JANET_OUT_OF_MEMORY;
             }
@@ -811,7 +844,7 @@ static const uint8_t *unmarshal_one_def(
 
         /* Unmarshal sub funcdefs */
         if (def->flags & JANET_FUNCDEF_FLAG_HASDEFS) {
-            def->defs = calloc(1, sizeof(JanetFuncDef *) * defs_length);
+            def->defs = calloc(1, sizeof(JanetFuncDef *) * (size_t) defs_length);
             if (!def->defs) {
                 JANET_OUT_OF_MEMORY;
             }
@@ -826,7 +859,7 @@ static const uint8_t *unmarshal_one_def(
         /* Unmarshal source maps if needed */
         if (def->flags & JANET_FUNCDEF_FLAG_HASSOURCEMAP) {
             int32_t current = 0;
-            def->sourcemap = malloc(sizeof(JanetSourceMapping) * bytecode_length);
+            def->sourcemap = malloc(sizeof(JanetSourceMapping) * (size_t) bytecode_length);
             if (!def->sourcemap) {
                 JANET_OUT_OF_MEMORY;
             }
@@ -839,6 +872,15 @@ static const uint8_t *unmarshal_one_def(
             def->sourcemap = NULL;
         }
 
+        /* Unmarshal closure bitset if needed */
+        if (def->flags & JANET_FUNCDEF_FLAG_HASCLOBITSET) {
+            def->closure_bitset = malloc(sizeof(uint32_t) * def->slotcount);
+            if (NULL == def->closure_bitset) {
+                JANET_OUT_OF_MEMORY;
+            }
+            data = janet_unmarshal_u32s(st, data, def->closure_bitset, (def->slotcount + 31) >> 5);
+        }
+
         /* Validate */
         if (janet_verify(def))
             janet_panic("funcdef has invalid bytecode");
@@ -1016,7 +1058,7 @@ uint8_t janet_unmarshal_byte(JanetMarshalContext *ctx) {
 void janet_unmarshal_bytes(JanetMarshalContext *ctx, uint8_t *dest, size_t len) {
     UnmarshalState *st = (UnmarshalState *)(ctx->u_state);
     MARSH_EOS(st, ctx->data + len - 1);
-    memcpy(dest, ctx->data, len);
+    safe_memcpy(dest, ctx->data, len);
     ctx->data += len;
 }
 
@@ -1099,7 +1141,7 @@ static const uint8_t *unmarshal_one(
             u.bytes[0] = data[8];
             u.bytes[1] = data[7];
             u.bytes[2] = data[6];
-            u.bytes[5] = data[5];
+            u.bytes[3] = data[5];
             u.bytes[4] = data[4];
             u.bytes[5] = data[3];
             u.bytes[6] = data[2];
@@ -1138,7 +1180,7 @@ static const uint8_t *unmarshal_one(
             } else { /* (lead == LB_BUFFER) */
                 JanetBuffer *buffer = janet_buffer(len);
                 buffer->count = len;
-                memcpy(buffer->data, data, len);
+                safe_memcpy(buffer->data, data, len);
                 *out = janet_wrap_buffer(buffer);
             }
             janet_v_push(st->lookup, *out);
@@ -1273,7 +1315,7 @@ static Janet cfun_env_lookup(int32_t argc, Janet *argv) {
 }
 
 static Janet cfun_marshal(int32_t argc, Janet *argv) {
-    janet_arity(argc, 1, 2);
+    janet_arity(argc, 1, 3);
     JanetBuffer *buffer;
     JanetTable *rreg = NULL;
     if (argc > 1) {

src/core/math.c

@@ -1,5 +1,5 @@
 /*
-* Copyright (c) 2019 Calvin Rose
+* Copyright (c) 2020 Calvin Rose
 *
 * Permission is hereby granted, free of charge, to any person obtaining a copy
 * of this software and associated documentation files (the "Software"), to
@@ -20,13 +20,14 @@
 * IN THE SOFTWARE.
 */
 
-#include <math.h>
-
 #ifndef JANET_AMALG
+#include "features.h"
 #include <janet.h>
 #include "util.h"
 #endif
 
+#include <math.h>
+
 static JANET_THREAD_LOCAL JanetRNG janet_vm_rng = {0, 0, 0, 0, 0};
 
 static int janet_rng_get(void *p, Janet key, Janet *out);
@@ -51,7 +52,7 @@ static void *janet_rng_unmarshal(JanetMarshalContext *ctx) {
     return rng;
 }
 
-static JanetAbstractType JanetRNG_type = {
+const JanetAbstractType janet_rng_type = {
     "core/rng",
     NULL,
     NULL,
@@ -59,7 +60,7 @@ static JanetAbstractType JanetRNG_type = {
     NULL,
     janet_rng_marshal,
     janet_rng_unmarshal,
-    NULL
+    JANET_ATEND_UNMARSHAL
 };
 
 JanetRNG *janet_default_rng(void) {
@@ -114,7 +115,7 @@ double janet_rng_double(JanetRNG *rng) {
 
 static Janet cfun_rng_make(int32_t argc, Janet *argv) {
     janet_arity(argc, 0, 1);
-    JanetRNG *rng = janet_abstract(&JanetRNG_type, sizeof(JanetRNG));
+    JanetRNG *rng = janet_abstract(&janet_rng_type, sizeof(JanetRNG));
     if (argc == 1) {
         if (janet_checkint(argv[0])) {
             uint32_t seed = (uint32_t)(janet_getinteger(argv, 0));
@@ -131,13 +132,13 @@ static Janet cfun_rng_make(int32_t argc, Janet *argv) {
 
 static Janet cfun_rng_uniform(int32_t argc, Janet *argv) {
     janet_fixarity(argc, 1);
-    JanetRNG *rng = janet_getabstract(argv, 0, &JanetRNG_type);
+    JanetRNG *rng = janet_getabstract(argv, 0, &janet_rng_type);
     return janet_wrap_number(janet_rng_double(rng));
 }
 
 static Janet cfun_rng_int(int32_t argc, Janet *argv) {
     janet_arity(argc, 1, 2);
-    JanetRNG *rng = janet_getabstract(argv, 0, &JanetRNG_type);
+    JanetRNG *rng = janet_getabstract(argv, 0, &janet_rng_type);
     if (argc == 1) {
         uint32_t word = janet_rng_u32(rng) >> 1;
         return janet_wrap_integer(word);
@@ -165,7 +166,7 @@ static void rng_get_4bytes(JanetRNG *rng, uint8_t *buf) {
 
 static Janet cfun_rng_buffer(int32_t argc, Janet *argv) {
     janet_arity(argc, 2, 3);
-    JanetRNG *rng = janet_getabstract(argv, 0, &JanetRNG_type);
+    JanetRNG *rng = janet_getabstract(argv, 0, &janet_rng_type);
     int32_t n = janet_getnat(argv, 1);
     JanetBuffer *buffer = janet_optbuffer(argv, argc, 2, n);
 
@@ -222,13 +223,6 @@ static Janet janet_srand(int32_t argc, Janet *argv) {
     return janet_wrap_nil();
 }
 
-static Janet janet_remainder(int32_t argc, Janet *argv) {
-    janet_fixarity(argc, 2);
-    double x = janet_getnumber(argv, 0);
-    double y = janet_getnumber(argv, 1);
-    return janet_wrap_number(fmod(x, y));
-}
-
 #define JANET_DEFINE_MATHOP(name, fop)\
 static Janet janet_##name(int32_t argc, Janet *argv) {\
     janet_fixarity(argc, 1); \
@@ -280,11 +274,6 @@ static Janet janet_not(int32_t argc, Janet *argv) {
 }
 
 static const JanetReg math_cfuns[] = {
-    {
-        "%", janet_remainder,
-        JDOC("(% dividend divisor)\n\n"
-             "Returns the remainder of dividend / divisor.")
-    },
     {
         "not", janet_not,
         JDOC("(not x)\n\nReturns the boolean inverse of x.")
@@ -470,7 +459,7 @@ static const JanetReg math_cfuns[] = {
 /* Module entry point */
 void janet_lib_math(JanetTable *env) {
     janet_core_cfuns(env, NULL, math_cfuns);
-    janet_register_abstract_type(&JanetRNG_type);
+    janet_register_abstract_type(&janet_rng_type);
 #ifdef JANET_BOOTSTRAP
     janet_def(env, "math/pi", janet_wrap_number(3.1415926535897931),
               JDOC("The value pi."));

src/core/os.c

@@ -1,5 +1,5 @@
 /*
-* Copyright (c) 2019 Calvin Rose
+* Copyright (c) 2020 Calvin Rose
 *
 * Permission is hereby granted, free of charge, to any person obtaining a copy
 * of this software and associated documentation files (the "Software"), to
@@ -21,6 +21,7 @@
 */
 
 #ifndef JANET_AMALG
+#include "features.h"
 #include <janet.h>
 #include "util.h"
 #endif
@@ -31,6 +32,7 @@
 #include <time.h>
 #include <fcntl.h>
 #include <errno.h>
+#include <limits.h>
 #include <stdio.h>
 #include <string.h>
 #include <sys/stat.h>
@@ -51,6 +53,9 @@
 #include <sys/types.h>
 #include <sys/wait.h>
 extern char **environ;
+#ifdef JANET_THREADS
+#include <pthread.h>
+#endif
 #endif
 
 /* For macos */
@@ -65,6 +70,41 @@ extern char **environ;
 void arc4random_buf(void *buf, size_t nbytes);
 #endif
 
+/* Not POSIX, but all Unixes but Solaris have this function. */
+#if defined(JANET_POSIX) && !defined(__sun)
+time_t timegm(struct tm *tm);
+#elif defined(JANET_WINDOWS)
+#define timegm _mkgmtime
+#endif
+
+/* Access to some global variables should be synchronized if not in single threaded mode, as
+ * setenv/getenv are not thread safe. */
+#ifdef JANET_THREADS
+# ifdef JANET_WINDOWS
+static int env_lock_initialized = 0;
+static CRITICAL_SECTION env_lock;
+static void janet_lock_environ(void) {
+    EnterCriticalSection(&env_lock);
+}
+static void janet_unlock_environ(void) {
+    LeaveCriticalSection(&env_lock);
+}
+# else
+static pthread_mutex_t env_lock = PTHREAD_MUTEX_INITIALIZER;
+static void janet_lock_environ(void) {
+    pthread_mutex_lock(&env_lock);
+}
+static void janet_unlock_environ(void) {
+    pthread_mutex_unlock(&env_lock);
+}
+# endif
+#else
+static void janet_lock_environ(void) {
+}
+static void janet_unlock_environ(void) {
+}
+#endif
+
 #endif /* JANET_REDCUED_OS */
 
 /* Core OS functions */
@@ -129,13 +169,16 @@ static Janet os_arch(int32_t argc, Janet *argv) {
 
 static Janet os_exit(int32_t argc, Janet *argv) {
     janet_arity(argc, 0, 1);
+    int status;
     if (argc == 0) {
-        exit(EXIT_SUCCESS);
+        status = EXIT_SUCCESS;
     } else if (janet_checkint(argv[0])) {
-        exit(janet_unwrap_integer(argv[0]));
+        status = janet_unwrap_integer(argv[0]);
     } else {
-        exit(EXIT_FAILURE);
+        status = EXIT_FAILURE;
     }
+    janet_deinit();
+    exit(status);
     return janet_wrap_nil();
 }
 
@@ -144,7 +187,7 @@ static Janet os_exit(int32_t argc, Janet *argv) {
 
 static Janet os_getenv(int32_t argc, Janet *argv) {
     (void) argv;
-    janet_fixarity(argc, 1);
+    janet_arity(argc, 1, 2);
     return janet_wrap_nil();
 }
 
@@ -156,7 +199,7 @@ static char **os_execute_env(int32_t argc, const Janet *argv) {
     char **envp = NULL;
     if (argc > 2) {
         JanetDictView dict = janet_getdictionary(argv, 2);
-        envp = janet_smalloc(sizeof(char *) * (dict.len + 1));
+        envp = janet_smalloc(sizeof(char *) * ((size_t)dict.len + 1));
         int32_t j = 0;
         for (int32_t i = 0; i < dict.cap; i++) {
             const JanetKV *kv = dict.kvs + i;
@@ -175,7 +218,7 @@ static char **os_execute_env(int32_t argc, const Janet *argv) {
                 }
             }
             if (skip) continue;
-            char *envitem = janet_smalloc(klen + vlen + 2);
+            char *envitem = janet_smalloc((size_t) klen + (size_t) vlen + 2);
             memcpy(envitem, keys, klen);
             envitem[klen] = '=';
             memcpy(envitem + klen + 1, vals, vlen);
@@ -337,7 +380,7 @@ static Janet os_execute(int32_t argc, Janet *argv) {
     return janet_wrap_integer(status);
 #else
 
-    const char **child_argv = janet_smalloc(sizeof(char *) * (exargs.len + 1));
+    const char **child_argv = janet_smalloc(sizeof(char *) * ((size_t) exargs.len + 1));
     for (int32_t i = 0; i < exargs.len; i++)
         child_argv[i] = janet_getcstring(exargs.items, i);
     child_argv[exargs.len] = NULL;
@@ -366,7 +409,16 @@ static Janet os_execute(int32_t argc, Janet *argv) {
     }
 
     os_execute_cleanup(envp, child_argv);
-    return janet_wrap_integer(WEXITSTATUS(status));
+    /* Use POSIX shell semantics for interpreting signals */
+    int ret;
+    if (WIFEXITED(status)) {
+        ret = WEXITSTATUS(status);
+    } else if (WIFSTOPPED(status)) {
+        ret = WSTOPSIG(status) + 128;
+    } else {
+        ret = WTERMSIG(status) + 128;
+    }
+    return janet_wrap_integer(ret);
 #endif
 }
 
@@ -385,6 +437,7 @@ static Janet os_environ(int32_t argc, Janet *argv) {
     (void) argv;
     janet_fixarity(argc, 0);
     int32_t nenv = 0;
+    janet_lock_environ();
     char **env = environ;
     while (*env++)
         nenv += 1;
@@ -392,7 +445,10 @@ static Janet os_environ(int32_t argc, Janet *argv) {
     for (int32_t i = 0; i < nenv; i++) {
         char *e = environ[i];
         char *eq = strchr(e, '=');
-        if (!eq) janet_panic("no '=' in environ");
+        if (!eq) {
+            janet_unlock_environ();
+            janet_panic("no '=' in environ");
+        }
         char *v = eq + 1;
         int32_t full_len = (int32_t) strlen(e);
         int32_t val_len = (int32_t) strlen(v);
@@ -402,16 +458,22 @@ static Janet os_environ(int32_t argc, Janet *argv) {
             janet_stringv((const uint8_t *)v, val_len)
         );
     }
+    janet_unlock_environ();
     return janet_wrap_table(t);
 }
 
 static Janet os_getenv(int32_t argc, Janet *argv) {
-    janet_fixarity(argc, 1);
+    janet_arity(argc, 1, 2);
     const char *cstr = janet_getcstring(argv, 0);
     const char *res = getenv(cstr);
-    return res
+    janet_lock_environ();
-           ? janet_cstringv(res)
+    Janet ret = res
-           : janet_wrap_nil();
+                ? janet_cstringv(res)
+                : argc == 2
+                ? argv[1]
+                : janet_wrap_nil();
+    janet_unlock_environ();
+    return ret;
 }
 
 static Janet os_setenv(int32_t argc, Janet *argv) {
@@ -424,11 +486,14 @@ static Janet os_setenv(int32_t argc, Janet *argv) {
 #endif
     janet_arity(argc, 1, 2);
     const char *ks = janet_getcstring(argv, 0);
-    if (argc == 1 || janet_checktype(argv[1], JANET_NIL)) {
+    const char *vs = janet_optcstring(argv, argc, 1, NULL);
+    janet_lock_environ();
+    if (NULL == vs) {
         UNSETENV(ks);
     } else {
-        SETENV(ks, janet_getcstring(argv, 1));
+        SETENV(ks, vs);
     }
+    janet_unlock_environ();
     return janet_wrap_nil();
 }
 
@@ -573,13 +638,11 @@ static Janet os_date(int32_t argc, Janet *argv) {
     struct tm *t_info = NULL;
     if (argc) {
         int64_t integer = janet_getinteger64(argv, 0);
-        if (integer < 0)
-            janet_panicf("expected non-negative 64 bit signed integer, got %v", argv[0]);
         t = (time_t) integer;
     } else {
         time(&t);
     }
-    if (argc >= 2 && janet_truthy(argv[2])) {
+    if (argc >= 2 && janet_truthy(argv[1])) {
         /* local time */
 #ifdef JANET_WINDOWS
         localtime_s(&t_infos, &t);
@@ -610,6 +673,98 @@ static Janet os_date(int32_t argc, Janet *argv) {
     return janet_wrap_struct(janet_struct_end(st));
 }
 
+static int entry_getdst(Janet env_entry) {
+    Janet v;
+    if (janet_checktype(env_entry, JANET_TABLE)) {
+        JanetTable *entry = janet_unwrap_table(env_entry);
+        v = janet_table_get(entry, janet_ckeywordv("dst"));
+    } else if (janet_checktype(env_entry, JANET_STRUCT)) {
+        const JanetKV *entry = janet_unwrap_struct(env_entry);
+        v = janet_struct_get(entry, janet_ckeywordv("dst"));
+    } else {
+        v = janet_wrap_nil();
+    }
+    if (janet_checktype(v, JANET_NIL)) {
+        return -1;
+    } else {
+        return janet_truthy(v);
+    }
+}
+
+#ifdef JANET_WINDOWS
+typedef int32_t timeint_t;
+#else
+typedef int64_t timeint_t;
+#endif
+
+static timeint_t entry_getint(Janet env_entry, char *field) {
+    Janet i;
+    if (janet_checktype(env_entry, JANET_TABLE)) {
+        JanetTable *entry = janet_unwrap_table(env_entry);
+        i = janet_table_get(entry, janet_ckeywordv(field));
+    } else if (janet_checktype(env_entry, JANET_STRUCT)) {
+        const JanetKV *entry = janet_unwrap_struct(env_entry);
+        i = janet_struct_get(entry, janet_ckeywordv(field));
+    } else {
+        return 0;
+    }
+
+    if (janet_checktype(i, JANET_NIL)) {
+        return 0;
+    }
+
+#ifdef JANET_WINDOWS
+    if (!janet_checkint(i)) {
+        janet_panicf("bad slot #%s, expected 32 bit signed integer, got %v",
+                     field, i);
+    }
+#else
+    if (!janet_checkint64(i)) {
+        janet_panicf("bad slot #%s, expected 64 bit signed integer, got %v",
+                     field, i);
+    }
+#endif
+
+    return (timeint_t)janet_unwrap_number(i);
+}
+
+static Janet os_mktime(int32_t argc, Janet *argv) {
+    janet_arity(argc, 1, 2);
+    time_t t;
+    struct tm t_info = { 0 };
+
+    if (!janet_checktype(argv[0], JANET_TABLE) &&
+            !janet_checktype(argv[0], JANET_STRUCT))
+        janet_panic_type(argv[0], 0, JANET_TFLAG_DICTIONARY);
+
+    t_info.tm_sec = entry_getint(argv[0], "seconds");
+    t_info.tm_min = entry_getint(argv[0], "minutes");
+    t_info.tm_hour = entry_getint(argv[0], "hours");
+    t_info.tm_mday = entry_getint(argv[0], "month-day") + 1;
+    t_info.tm_mon = entry_getint(argv[0], "month");
+    t_info.tm_year = entry_getint(argv[0], "year") - 1900;
+    t_info.tm_isdst = entry_getdst(argv[0]);
+
+    if (argc >= 2 && janet_truthy(argv[1])) {
+        /* local time */
+        t = mktime(&t_info);
+    } else {
+        /* utc time */
+#ifdef __sun
+        janet_panic("os/mktime UTC not supported on Solaris");
+        return janet_wrap_nil();
+#else
+        t = timegm(&t_info);
+#endif
+    }
+
+    if (t == (time_t) -1) {
+        janet_panicf("%s", strerror(errno));
+    }
+
+    return janet_wrap_number((double)t);
+}
+
 static Janet os_link(int32_t argc, Janet *argv) {
     janet_arity(argc, 2, 3);
 #ifdef JANET_WINDOWS
@@ -620,9 +775,25 @@ static Janet os_link(int32_t argc, Janet *argv) {
 #else
     const char *oldpath = janet_getcstring(argv, 0);
     const char *newpath = janet_getcstring(argv, 1);
-    int res = ((argc == 3 && janet_getboolean(argv, 2)) ? symlink : link)(oldpath, newpath);
+    int res = ((argc == 3 && janet_truthy(argv[2])) ? symlink : link)(oldpath, newpath);
     if (-1 == res) janet_panicf("%s: %s -> %s", strerror(errno), oldpath, newpath);
-    return janet_wrap_integer(res);
+    return janet_wrap_nil();
+#endif
+}
+
+static Janet os_symlink(int32_t argc, Janet *argv) {
+    janet_fixarity(argc, 2);
+#ifdef JANET_WINDOWS
+    (void) argc;
+    (void) argv;
+    janet_panic("os/symlink not supported on Windows");
+    return janet_wrap_nil();
+#else
+    const char *oldpath = janet_getcstring(argv, 0);
+    const char *newpath = janet_getcstring(argv, 1);
+    int res = symlink(oldpath, newpath);
+    if (-1 == res) janet_panicf("%s: %s -> %s", strerror(errno), oldpath, newpath);
+    return janet_wrap_nil();
 #endif
 }
 
@@ -634,7 +805,9 @@ static Janet os_mkdir(int32_t argc, Janet *argv) {
 #else
     int res = mkdir(path, S_IRUSR | S_IWUSR | S_IXUSR | S_IRGRP | S_IWGRP | S_IXGRP | S_IROTH | S_IXOTH);
 #endif
-    return janet_wrap_boolean(res != -1);
+    if (res == 0) return janet_wrap_true();
+    if (errno == EEXIST) return janet_wrap_false();
+    janet_panicf("%s: %s", strerror(errno), path);
 }
 
 static Janet os_rmdir(int32_t argc, Janet *argv) {
@@ -689,6 +862,23 @@ static Janet os_remove(int32_t argc, Janet *argv) {
     return janet_wrap_nil();
 }
 
+static Janet os_readlink(int32_t argc, Janet *argv) {
+    janet_fixarity(argc, 1);
+#ifdef JANET_WINDOWS
+    (void) argc;
+    (void) argv;
+    janet_panic("os/readlink not supported on Windows");
+    return janet_wrap_nil();
+#else
+    static char buffer[PATH_MAX];
+    const char *path = janet_getcstring(argv, 0);
+    ssize_t len = readlink(path, buffer, sizeof buffer);
+    if (len < 0 || (size_t)len >= sizeof buffer)
+        janet_panicf("%s: %s", strerror(errno), path);
+    return janet_stringv((const uint8_t *)buffer, len);
+#endif
+}
+
 #ifdef JANET_WINDOWS
 static const uint8_t *janet_decode_permissions(unsigned short m) {
     uint8_t flags[9] = {0};
@@ -698,6 +888,35 @@ static const uint8_t *janet_decode_permissions(unsigned short m) {
     return janet_string(flags, sizeof(flags));
 }
 
+static unsigned short janet_encode_permissions(Janet *argv, int32_t n) {
+    if (janet_checkint(argv[n])) {
+        int32_t x = janet_unwrap_integer(argv[n]);
+        if (x < 0 || x > 0777) {
+            janet_panicf("expected integer in range [0, 8r777], got %v", argv[n]);
+        }
+        unsigned short m = 0;
+        if (x & 1 || x & 010 || x & 0100) m |= S_IEXEC;
+        if (x & 2 || x & 020 || x & 0200) m |= S_IWRITE;
+        if (x & 4 || x & 040 || x & 0400) m |= S_IREAD;
+        return m;
+    }
+    JanetString perm = janet_getstring(argv, n);
+    if (janet_string_length(perm) != 9) {
+        janet_panicf("expected string of length 9, got %S", perm);
+    }
+    unsigned short m = 0;
+    if (perm[0] == 'r') m |= S_IREAD;
+    if (perm[1] == 'w') m |= S_IWRITE;
+    if (perm[2] == 'x') m |= S_IEXEC;
+    if (perm[3] == 'r') m |= S_IREAD;
+    if (perm[4] == 'w') m |= S_IWRITE;
+    if (perm[5] == 'x') m |= S_IEXEC;
+    if (perm[6] == 'r') m |= S_IREAD;
+    if (perm[7] == 'w') m |= S_IWRITE;
+    if (perm[8] == 'x') m |= S_IEXEC;
+    return m;
+}
+
 static const uint8_t *janet_decode_mode(unsigned short m) {
     const char *str = "other";
     if (m & _S_IFREG) str = "file";
@@ -720,6 +939,31 @@ static const uint8_t *janet_decode_permissions(mode_t m) {
     return janet_string(flags, sizeof(flags));
 }
 
+static mode_t janet_encode_permissions(Janet *argv, int32_t n) {
+    if (janet_checkint(argv[n])) {
+        int32_t x = janet_unwrap_integer(argv[n]);
+        if (x < 0 || x > 0777) {
+            janet_panicf("expected integer in range [0, 8r777], got %v", argv[n]);
+        }
+        return (mode_t) x;
+    }
+    JanetString perm = janet_getstring(argv, n);
+    if (janet_string_length(perm) != 9) {
+        janet_panicf("expected string of length 9, got %S", perm);
+    }
+    mode_t m = 0;
+    if (perm[0] == 'r') m |= S_IRUSR;
+    if (perm[1] == 'w') m |= S_IWUSR;
+    if (perm[2] == 'x') m |= S_IXUSR;
+    if (perm[3] == 'r') m |= S_IRGRP;
+    if (perm[4] == 'w') m |= S_IWGRP;
+    if (perm[5] == 'x') m |= S_IXGRP;
+    if (perm[6] == 'r') m |= S_IROTH;
+    if (perm[7] == 'w') m |= S_IWOTH;
+    if (perm[8] == 'x') m |= S_IXOTH;
+    return m;
+}
+
 static const uint8_t *janet_decode_mode(mode_t m) {
     const char *str = "other";
     if (S_ISREG(m)) str = "file";
@@ -733,67 +977,68 @@ static const uint8_t *janet_decode_mode(mode_t m) {
 }
 #endif
 
-/* Can we do this? */
 #ifdef JANET_WINDOWS
-#define stat _stat
+typedef struct _stat jstat_t;
+#else
+typedef struct stat jstat_t;
 #endif
 
 /* Getters */
-static Janet os_stat_dev(struct stat *st) {
+static Janet os_stat_dev(jstat_t *st) {
     return janet_wrap_number(st->st_dev);
 }
-static Janet os_stat_inode(struct stat *st) {
+static Janet os_stat_inode(jstat_t *st) {
     return janet_wrap_number(st->st_ino);
 }
-static Janet os_stat_mode(struct stat *st) {
+static Janet os_stat_mode(jstat_t *st) {
     return janet_wrap_keyword(janet_decode_mode(st->st_mode));
 }
-static Janet os_stat_permissions(struct stat *st) {
+static Janet os_stat_permissions(jstat_t *st) {
     return janet_wrap_string(janet_decode_permissions(st->st_mode));
 }
-static Janet os_stat_uid(struct stat *st) {
+static Janet os_stat_uid(jstat_t *st) {
     return janet_wrap_number(st->st_uid);
 }
-static Janet os_stat_gid(struct stat *st) {
+static Janet os_stat_gid(jstat_t *st) {
     return janet_wrap_number(st->st_gid);
 }
-static Janet os_stat_nlink(struct stat *st) {
+static Janet os_stat_nlink(jstat_t *st) {
     return janet_wrap_number(st->st_nlink);
 }
-static Janet os_stat_rdev(struct stat *st) {
+static Janet os_stat_rdev(jstat_t *st) {
     return janet_wrap_number(st->st_rdev);
 }
-static Janet os_stat_size(struct stat *st) {
+static Janet os_stat_size(jstat_t *st) {
     return janet_wrap_number(st->st_size);
 }
-static Janet os_stat_accessed(struct stat *st) {
+static Janet os_stat_accessed(jstat_t *st) {
     return janet_wrap_number((double) st->st_atime);
 }
-static Janet os_stat_modified(struct stat *st) {
+static Janet os_stat_modified(jstat_t *st) {
     return janet_wrap_number((double) st->st_mtime);
 }
-static Janet os_stat_changed(struct stat *st) {
+static Janet os_stat_changed(jstat_t *st) {
     return janet_wrap_number((double) st->st_ctime);
 }
 #ifdef JANET_WINDOWS
-static Janet os_stat_blocks(struct stat *st) {
+static Janet os_stat_blocks(jstat_t *st) {
     return janet_wrap_number(0);
 }
-static Janet os_stat_blocksize(struct stat *st) {
+static Janet os_stat_blocksize(jstat_t *st) {
     return janet_wrap_number(0);
 }
 #else
-static Janet os_stat_blocks(struct stat *st) {
+static Janet os_stat_blocks(jstat_t *st) {
     return janet_wrap_number(st->st_blocks);
 }
-static Janet os_stat_blocksize(struct stat *st) {
+static Janet os_stat_blocksize(jstat_t *st) {
     return janet_wrap_number(st->st_blksize);
 }
 #endif
 
 struct OsStatGetter {
     const char *name;
-    Janet(*fn)(struct stat *st);
+    Janet(*fn)(jstat_t *st);
 };
 
 static const struct OsStatGetter os_stat_getters[] = {
@@ -814,7 +1059,7 @@ static const struct OsStatGetter os_stat_getters[] = {
     {NULL, NULL}
 };
 
-static Janet os_stat(int32_t argc, Janet *argv) {
+static Janet os_stat_or_lstat(int do_lstat, int32_t argc, Janet *argv) {
     janet_arity(argc, 1, 2);
     const char *path = janet_getcstring(argv, 0);
     JanetTable *tab = NULL;
@@ -832,8 +1077,18 @@ static Janet os_stat(int32_t argc, Janet *argv) {
     }
 
     /* Build result */
-    struct stat st;
+    jstat_t st;
-    int res = stat(path, &st);
+#ifdef JANET_WINDOWS
+    (void) do_lstat;
+    int res = _stat(path, &st);
+#else
+    int res;
+    if (do_lstat) {
+        res = lstat(path, &st);
+    } else {
+        res = stat(path, &st);
+    }
+#endif
     if (-1 == res) {
         return janet_wrap_nil();
     }
@@ -855,6 +1110,26 @@ static Janet os_stat(int32_t argc, Janet *argv) {
     }
 }
 
+static Janet os_stat(int32_t argc, Janet *argv) {
+    return os_stat_or_lstat(0, argc, argv);
+}
+
+static Janet os_lstat(int32_t argc, Janet *argv) {
+    return os_stat_or_lstat(1, argc, argv);
+}
+
+static Janet os_chmod(int32_t argc, Janet *argv) {
+    janet_fixarity(argc, 2);
+    const char *path = janet_getcstring(argv, 0);
+#ifdef JANET_WINDOWS
+    int res = _chmod(path, janet_encode_permissions(argv, 1));
+#else
+    int res = chmod(path, janet_encode_permissions(argv, 1));
+#endif
+    if (-1 == res) janet_panicf("%s: %s", strerror(errno), path);
+    return janet_wrap_nil();
+}
+
 static Janet os_dir(int32_t argc, Janet *argv) {
     janet_arity(argc, 1, 2);
     const char *dir = janet_getcstring(argv, 0);
@@ -901,6 +1176,21 @@ static Janet os_rename(int32_t argc, Janet *argv) {
     return janet_wrap_nil();
 }
 
+static Janet os_realpath(int32_t argc, Janet *argv) {
+    janet_fixarity(argc, 1);
+#ifdef JANET_WINDOWS
+    (void) argv;
+    janet_panic("os/realpath not supported on Windows");
+#else
+    const char *src = janet_getcstring(argv, 0);
+    char *dest = realpath(src, NULL);
+    if (NULL == dest) janet_panicf("%s: %s", strerror(errno), src);
+    Janet ret = janet_cstringv(dest);
+    free(dest);
+    return ret;
+#endif
+}
+
 #endif /* JANET_REDUCED_OS */
 
 static const JanetReg os_cfuns[] = {
@@ -925,7 +1215,7 @@ static const JanetReg os_cfuns[] = {
     },
     {
         "os/getenv", os_getenv,
-        JDOC("(os/getenv variable)\n\n"
+        JDOC("(os/getenv variable &opt dflt)\n\n"
              "Get the string value of an environment variable.")
     },
     {
@@ -959,7 +1249,7 @@ static const JanetReg os_cfuns[] = {
              " only that information from stat. If the file or directory does not exist, returns nil. The keys are\n\n"
              "\t:dev - the device that the file is on\n"
              "\t:mode - the type of file, one of :file, :directory, :block, :character, :fifo, :socket, :link, or :other\n"
-             "\t:permissions - A unix permission string like \"rwx--x--x\"\n"
+             "\t:permissions - A unix permission string like \"rwx--x--x\". On windows, a string like \"rwx\".\n"
              "\t:uid - File uid\n"
              "\t:gid - File gid\n"
              "\t:nlink - number of links to file\n"
@@ -971,6 +1261,19 @@ static const JanetReg os_cfuns[] = {
              "\t:changed - timestamp when file last chnaged (permissions changed)\n"
              "\t:modified - timestamp when file last modified (content changed)\n")
     },
+    {
+        "os/lstat", os_lstat,
+        JDOC("(os/lstat path &opt tab|key)\n\n"
+             "Like os/stat, but don't follow symlinks.\n")
+    },
+    {
+        "os/chmod", os_chmod,
+        JDOC("(os/chmod path mode)\n\n"
+             "Change file permissions, where mode is a permission string as returned by "
+             "os/stat, or an integer. "
+             "When mode is an integer, it is interpreted as a unix permission value, best specified in octal, like "
+             "8r666 or 8r400. Windows will not differentiate between user, group, and other permissions. Returns nil.")
+    },
     {
         "os/touch", os_touch,
         JDOC("(os/touch path &opt actime modtime)\n\n"
@@ -980,13 +1283,14 @@ static const JanetReg os_cfuns[] = {
     {
         "os/cd", os_cd,
         JDOC("(os/cd path)\n\n"
-             "Change current directory to path. Returns true on success, false on failure.")
+             "Change current directory to path. Returns nil on success, errors on failure.")
     },
     {
         "os/mkdir", os_mkdir,
         JDOC("(os/mkdir path)\n\n"
              "Create a new directory. The path will be relative to the current directory if relative, otherwise "
-             "it will be an absolute path.")
+             "it will be an absolute path. Returns true if the directory was create, false if the directoyr already exists, and "
+             "errors otherwise.")
     },
     {
         "os/rmdir", os_rmdir,
@@ -1001,8 +1305,18 @@ static const JanetReg os_cfuns[] = {
     {
         "os/link", os_link,
         JDOC("(os/link oldpath newpath &opt symlink)\n\n"
-             "Create a symlink from oldpath to newpath. The 3 optional paramater "
+             "Create a symlink from oldpath to newpath, returning nil. The 3rd optional paramater "
-             "enables a hard link over a soft link. Does not work on Windows.")
+             "enables a symlink iff truthy, hard link otherwise or if not provided. Does not work on Windows.")
+    },
+    {
+        "os/symlink", os_symlink,
+        JDOC("(os/symlink oldpath newpath)\n\n"
+             "Create a symlink from oldpath to newpath, returning nil. Same as (os/link oldpath newpath true).")
+    },
+    {
+        "os/readlink", os_readlink,
+        JDOC("(os/readlink path)\n\n"
+             "Read the contents of a symbolic link. Does not work on Windows.\n")
     },
     {
         "os/execute", os_execute,
@@ -1032,6 +1346,16 @@ static const JanetReg os_cfuns[] = {
              "Get the current time expressed as the number of seconds since "
              "January 1, 1970, the Unix epoch. Returns a real number.")
     },
+    {
+        "os/mktime", os_mktime,
+        JDOC("(os/mktime date-struct &opt local)\n\n"
+             "Get the broken down date-struct time expressed as the number "
+             " of seconds since January 1, 1970, the Unix epoch. "
+             "Returns a real number. "
+             "Date is given in UTC unless local is truthy, in which case the "
+             "date is computed for the local timezone.\n\n"
+             "Inverse function to os/date.")
+    },
     {
         "os/clock", os_clock,
         JDOC("(os/clock)\n\n"
@@ -1076,11 +1400,25 @@ static const JanetReg os_cfuns[] = {
         JDOC("(os/rename oldname newname)\n\n"
              "Rename a file on disk to a new path. Returns nil.")
     },
+    {
+        "os/realpath", os_realpath,
+        JDOC("(os/realpath path)\n\n"
+             "Get the absolute path for a given path, following ../, ./, and symlinks. "
+             "Returns an absolute path as a string. Will raise an error on Windows.")
+    },
 #endif
     {NULL, NULL, NULL}
 };
 
 /* Module entry point */
 void janet_lib_os(JanetTable *env) {
+#if !defined(JANET_REDUCED_OS) && defined(JANET_WINDOWS) && defined(JANET_THREADS)
+    /* During start up, the top-most abstract machine (thread)
+     * in the thread tree sets up the critical section. */
+    if (!env_lock_initialized) {
+        InitializeCriticalSection(&env_lock);
+        env_lock_initialized = 1;
+    }
+#endif
     janet_core_cfuns(env, NULL, os_cfuns);
 }

src/core/parse.c

@@ -1,5 +1,5 @@
 /*
-* Copyright (c) 2019 Calvin Rose
+* Copyright (c) 2020 Calvin Rose
 *
 * Permission is hereby granted, free of charge, to any person obtaining a copy
 * of this software and associated documentation files (the "Software"), to
@@ -21,6 +21,7 @@
 */
 
 #ifndef JANET_AMALG
+#include "features.h"
 #include <janet.h>
 #include "util.h"
 #endif
@@ -111,6 +112,8 @@ struct JanetParseState {
     Consumer consumer;
 };
 
+static int root(JanetParser *p, JanetParseState *state, uint8_t c);
+
 /* Define a stack on the main parser struct */
 #define DEF_PARSER_STACK(NAME, T, STACK, STACKCOUNT, STACKCAP) \
 static void NAME(JanetParser *p, T x) { \
@@ -182,8 +185,12 @@ static void popstate(JanetParser *p, Janet val) {
                 (c == ',') ? "unquote" :
                 (c == ';') ? "splice" :
                 (c == '|') ? "short-fn" :
-                (c == '~') ? "quasiquote" : "<unknown>";
+                (c == '~') ? "quasiquote" : NULL;
-            t[0] = janet_csymbolv(which);
+            if (!which) {
+                t[0] = p->args[--p->argcount];
+            } else {
+                t[0] = janet_csymbolv(which);
+            }
             t[1] = val;
             /* Quote source mapping info */
             janet_tuple_sm_line(t) = (int32_t) newtop->line;
@@ -319,6 +326,7 @@ static int tokenchar(JanetParser *p, JanetParseState *state, uint8_t c) {
     Janet ret;
     double numval;
     int32_t blen;
+    int prefix_symbol = 0;
     if (is_symbol_char(c)) {
         push_buf(p, (uint8_t) c);
         if (c > 127) state->argn = 1; /* Use to indicate non ascii */
@@ -356,10 +364,20 @@ static int tokenchar(JanetParser *p, JanetParseState *state, uint8_t c) {
                 return 0;
             }
             ret = janet_symbolv(p->buf, blen);
+            prefix_symbol = c == '"' || c == '`' || c == '[' || c == '(' || c == '{';
         }
     }
     p->bufcount = 0;
-    popstate(p, ret);
+    if (prefix_symbol) {
+        push_arg(p, ret);
+        /* Set current state to a different state */
+        JanetParseState newState = {0};
+        newState.flags = PFLAG_READERMAC;
+        newState.consumer = root;
+        *state = newState;
+    } else {
+        popstate(p, ret);
+    }
     return 0;
 }
 
@@ -454,8 +472,6 @@ static int longstring(JanetParser *p, JanetParseState *state, uint8_t c) {
     }
 }
 
-static int root(JanetParser *p, JanetParseState *state, uint8_t c);
-
 static int atsign(JanetParser *p, JanetParseState *state, uint8_t c) {
     (void) state;
     p->statecount--;
@@ -687,20 +703,19 @@ void janet_parser_clone(const JanetParser *src, JanetParser *dest) {
     if (dest->bufcap) {
         dest->buf = malloc(dest->bufcap);
         if (!dest->buf) goto nomem;
+        memcpy(dest->buf, src->buf, dest->bufcap);
     }
     if (dest->argcap) {
         dest->args = malloc(sizeof(Janet) * dest->argcap);
         if (!dest->args) goto nomem;
+        memcpy(dest->args, src->args, dest->argcap * sizeof(Janet));
     }
     if (dest->statecap) {
         dest->states = malloc(sizeof(JanetParseState) * dest->statecap);
         if (!dest->states) goto nomem;
+        memcpy(dest->states, src->states, dest->statecap * sizeof(JanetParseState));
     }
 
-    memcpy(dest->buf, src->buf, dest->bufcap);
-    memcpy(dest->args, src->args, dest->argcap * sizeof(Janet));
-    memcpy(dest->states, src->states, dest->statecap * sizeof(JanetParseState));
-
     return;
 
 nomem:
@@ -732,29 +747,26 @@ static int parsergc(void *p, size_t size) {
 
 static int parserget(void *p, Janet key, Janet *out);
 
-static JanetAbstractType janet_parse_parsertype = {
+const JanetAbstractType janet_parser_type = {
     "core/parser",
     parsergc,
     parsermark,
     parserget,
-    NULL,
+    JANET_ATEND_GET
-    NULL,
-    NULL,
-    NULL
 };
 
 /* C Function parser */
 static Janet cfun_parse_parser(int32_t argc, Janet *argv) {
     (void) argv;
     janet_fixarity(argc, 0);
-    JanetParser *p = janet_abstract(&janet_parse_parsertype, sizeof(JanetParser));
+    JanetParser *p = janet_abstract(&janet_parser_type, sizeof(JanetParser));
     janet_parser_init(p);
     return janet_wrap_abstract(p);
 }
 
 static Janet cfun_parse_consume(int32_t argc, Janet *argv) {
     janet_arity(argc, 2, 3);
-    JanetParser *p = janet_getabstract(argv, 0, &janet_parse_parsertype);
+    JanetParser *p = janet_getabstract(argv, 0, &janet_parser_type);
     JanetByteView view = janet_getbytes(argv, 1);
     if (argc == 3) {
         int32_t offset = janet_getinteger(argv, 2);
@@ -779,20 +791,21 @@ static Janet cfun_parse_consume(int32_t argc, Janet *argv) {
 
 static Janet cfun_parse_eof(int32_t argc, Janet *argv) {
     janet_fixarity(argc, 1);
-    JanetParser *p = janet_getabstract(argv, 0, &janet_parse_parsertype);
+    JanetParser *p = janet_getabstract(argv, 0, &janet_parser_type);
     janet_parser_eof(p);
     return argv[0];
 }
 
 static Janet cfun_parse_insert(int32_t argc, Janet *argv) {
     janet_fixarity(argc, 2);
-    JanetParser *p = janet_getabstract(argv, 0, &janet_parse_parsertype);
+    JanetParser *p = janet_getabstract(argv, 0, &janet_parser_type);
     JanetParseState *s = p->states + p->statecount - 1;
     if (s->consumer == tokenchar) {
         janet_parser_consume(p, ' ');
         p->column--;
         s = p->states + p->statecount - 1;
     }
+    if (s->flags & PFLAG_COMMENT) s--;
     if (s->flags & PFLAG_CONTAINER) {
         s->argn++;
         if (p->statecount == 1) p->pending++;
@@ -809,7 +822,7 @@ static Janet cfun_parse_insert(int32_t argc, Janet *argv) {
             }
             p->bufcap = newcap;
         }
-        memcpy(p->buf + p->bufcount, str, slen);
+        safe_memcpy(p->buf + p->bufcount, str, slen);
         p->bufcount = newcount;
     } else {
         janet_panic("cannot insert value into parser");
@@ -819,13 +832,13 @@ static Janet cfun_parse_insert(int32_t argc, Janet *argv) {
 
 static Janet cfun_parse_has_more(int32_t argc, Janet *argv) {
     janet_fixarity(argc, 1);
-    JanetParser *p = janet_getabstract(argv, 0, &janet_parse_parsertype);
+    JanetParser *p = janet_getabstract(argv, 0, &janet_parser_type);
     return janet_wrap_boolean(janet_parser_has_more(p));
 }
 
 static Janet cfun_parse_byte(int32_t argc, Janet *argv) {
     janet_fixarity(argc, 2);
-    JanetParser *p = janet_getabstract(argv, 0, &janet_parse_parsertype);
+    JanetParser *p = janet_getabstract(argv, 0, &janet_parser_type);
     int32_t i = janet_getinteger(argv, 1);
     janet_parser_consume(p, 0xFF & i);
     return argv[0];
@@ -833,7 +846,7 @@ static Janet cfun_parse_byte(int32_t argc, Janet *argv) {
 
 static Janet cfun_parse_status(int32_t argc, Janet *argv) {
     janet_fixarity(argc, 1);
-    JanetParser *p = janet_getabstract(argv, 0, &janet_parse_parsertype);
+    JanetParser *p = janet_getabstract(argv, 0, &janet_parser_type);
     const char *stat = NULL;
     switch (janet_parser_status(p)) {
         case JANET_PARSE_PENDING:
@@ -854,7 +867,7 @@ static Janet cfun_parse_status(int32_t argc, Janet *argv) {
 
 static Janet cfun_parse_error(int32_t argc, Janet *argv) {
     janet_fixarity(argc, 1);
-    JanetParser *p = janet_getabstract(argv, 0, &janet_parse_parsertype);
+    JanetParser *p = janet_getabstract(argv, 0, &janet_parser_type);
     const char *err = janet_parser_error(p);
     if (err) return janet_cstringv(err);
     return janet_wrap_nil();
@@ -862,20 +875,20 @@ static Janet cfun_parse_error(int32_t argc, Janet *argv) {
 
 static Janet cfun_parse_produce(int32_t argc, Janet *argv) {
     janet_fixarity(argc, 1);
-    JanetParser *p = janet_getabstract(argv, 0, &janet_parse_parsertype);
+    JanetParser *p = janet_getabstract(argv, 0, &janet_parser_type);
     return janet_parser_produce(p);
 }
 
 static Janet cfun_parse_flush(int32_t argc, Janet *argv) {
     janet_fixarity(argc, 1);
-    JanetParser *p = janet_getabstract(argv, 0, &janet_parse_parsertype);
+    JanetParser *p = janet_getabstract(argv, 0, &janet_parser_type);
     janet_parser_flush(p);
     return argv[0];
 }
 
 static Janet cfun_parse_where(int32_t argc, Janet *argv) {
     janet_fixarity(argc, 1);
-    JanetParser *p = janet_getabstract(argv, 0, &janet_parse_parsertype);
+    JanetParser *p = janet_getabstract(argv, 0, &janet_parser_type);
     Janet *tup = janet_tuple_begin(2);
     tup[0] = janet_wrap_integer(p->line);
     tup[1] = janet_wrap_integer(p->column);
@@ -892,7 +905,7 @@ 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;
-        memcpy(container_args->data, args, sizeof(args[0])*s->argn);
+        safe_memcpy(container_args->data, args, sizeof(args[0])*s->argn);
         janet_table_put(state, janet_ckeywordv("args"),
                         janet_wrap_array(container_args));
     }
@@ -929,6 +942,7 @@ static Janet janet_wrap_parse_state(JanetParseState *s, Janet *args,
         type = (c == '\'') ? "quote" :
                (c == ',') ? "unquote" :
                (c == ';') ? "splice" :
+               (c == '|') ? "short-fn" :
                (c == '~') ? "quasiquote" : "<reader>";
     } else {
         type = "root";
@@ -955,7 +969,7 @@ struct ParserStateGetter {
 };
 
 static Janet parser_state_delimiters(const JanetParser *_p) {
-    JanetParser *clone = janet_abstract(&janet_parse_parsertype, sizeof(JanetParser));
+    JanetParser *clone = janet_abstract(&janet_parser_type, sizeof(JanetParser));
     janet_parser_clone(_p, clone);
     size_t i;
     const uint8_t *str;
@@ -1006,7 +1020,7 @@ static const struct ParserStateGetter parser_state_getters[] = {
 static Janet cfun_parse_state(int32_t argc, Janet *argv) {
     janet_arity(argc, 1, 2);
     const uint8_t *key = NULL;
-    JanetParser *p = janet_getabstract(argv, 0, &janet_parse_parsertype);
+    JanetParser *p = janet_getabstract(argv, 0, &janet_parser_type);
     if (argc == 2) {
         key = janet_getkeyword(argv, 1);
     }
@@ -1033,8 +1047,8 @@ static Janet cfun_parse_state(int32_t argc, Janet *argv) {
 
 static Janet cfun_parse_clone(int32_t argc, Janet *argv) {
     janet_fixarity(argc, 1);
-    JanetParser *src = janet_getabstract(argv, 0, &janet_parse_parsertype);
+    JanetParser *src = janet_getabstract(argv, 0, &janet_parser_type);
-    JanetParser *dest = janet_abstract(&janet_parse_parsertype, sizeof(JanetParser));
+    JanetParser *dest = janet_abstract(&janet_parser_type, sizeof(JanetParser));
     janet_parser_clone(src, dest);
     return janet_wrap_abstract(dest);
 }

src/core/peg.c

@@ -1,5 +1,5 @@
 /*
-* Copyright (c) 2019 Calvin Rose
+* Copyright (c) 2020 Calvin Rose
 *
 * Permission is hereby granted, free of charge, to any person obtaining a copy
 * of this software and associated documentation files (the "Software"), to
@@ -21,6 +21,7 @@
 */
 
 #ifndef JANET_AMALG
+#include "features.h"
 #include <janet.h>
 #include <string.h>
 #include "util.h"
@@ -34,34 +35,6 @@
  * Runtime
  */
 
-/* opcodes for peg vm */
-typedef enum {
-    RULE_LITERAL,      /* [len, bytes...] */
-    RULE_NCHAR,        /* [n] */
-    RULE_NOTNCHAR,     /* [n] */
-    RULE_RANGE,        /* [lo | hi << 16 (1 word)] */
-    RULE_SET,          /* [bitmap (8 words)] */
-    RULE_LOOK,         /* [offset, rule] */
-    RULE_CHOICE,       /* [len, rules...] */
-    RULE_SEQUENCE,     /* [len, rules...] */
-    RULE_IF,           /* [rule_a, rule_b (b if a)] */
-    RULE_IFNOT,        /* [rule_a, rule_b (b if not a)] */
-    RULE_NOT,          /* [rule] */
-    RULE_BETWEEN,      /* [lo, hi, rule] */
-    RULE_GETTAG,       /* [searchtag, tag] */
-    RULE_CAPTURE,      /* [rule, tag] */
-    RULE_POSITION,     /* [tag] */
-    RULE_ARGUMENT,     /* [argument-index, tag] */
-    RULE_CONSTANT,     /* [constant, tag] */
-    RULE_ACCUMULATE,   /* [rule, tag] */
-    RULE_GROUP,        /* [rule, tag] */
-    RULE_REPLACE,      /* [rule, constant, tag] */
-    RULE_MATCHTIME,    /* [rule, constant, tag] */
-    RULE_ERROR,        /* [rule] */
-    RULE_DROP,         /* [rule] */
-    RULE_BACKMATCH,    /* [tag] */
-} Opcode;
-
 /* Hold captured patterns and match state */
 typedef struct {
     const uint8_t *text_start;
@@ -347,9 +320,9 @@ tail:
             if (!result) return NULL;
             int32_t num_sub_captures = s->captures->count - cs.cap;
             JanetArray *sub_captures = janet_array(num_sub_captures);
-            memcpy(sub_captures->data,
+            safe_memcpy(sub_captures->data,
-                   s->captures->data + cs.cap,
+                        s->captures->data + cs.cap,
-                   sizeof(Janet) * num_sub_captures);
+                        sizeof(Janet) * num_sub_captures);
             sub_captures->count = num_sub_captures;
             cap_load(s, cs);
             pushcap(s, janet_wrap_array(sub_captures), tag);
@@ -368,19 +341,23 @@ tail:
             s->mode = oldmode;
             if (!result) return NULL;
 
-            Janet cap;
+            Janet cap = janet_wrap_nil();
             Janet constant = s->constants[rule[2]];
             switch (janet_type(constant)) {
                 default:
                     cap = constant;
                     break;
                 case JANET_STRUCT:
-                    cap = janet_struct_get(janet_unwrap_struct(constant),
+                    if (s->captures->count) {
-                                           s->captures->data[s->captures->count - 1]);
+                        cap = janet_struct_get(janet_unwrap_struct(constant),
+                                               s->captures->data[s->captures->count - 1]);
+                    }
                     break;
                 case JANET_TABLE:
-                    cap = janet_table_get(janet_unwrap_table(constant),
+                    if (s->captures->count) {
-                                          s->captures->data[s->captures->count - 1]);
+                        cap = janet_table_get(janet_unwrap_table(constant),
+                                              s->captures->data[s->captures->count - 1]);
+                    }
                     break;
                 case JANET_CFUNCTION:
                     cap = janet_unwrap_cfunction(constant)(s->captures->count - cs.cap,
@@ -475,7 +452,7 @@ JANET_NO_RETURN static void peg_panic(Builder *b, const char *msg) {
 
 static void peg_fixarity(Builder *b, int32_t argc, int32_t arity) {
     if (argc != arity) {
-        peg_panicf(b, "expected %d argument%s, got %d%",
+        peg_panicf(b, "expected %d argument%s, got %d",
                    arity,
                    arity == 1 ? "" : "s",
                    argc);
@@ -727,6 +704,13 @@ static void spec_opt(Builder *b, int32_t argc, const Janet *argv) {
     emit_3(r, RULE_BETWEEN, 0, 1, subrule);
 }
 
+static void spec_repeat(Builder *b, int32_t argc, const Janet *argv) {
+    peg_fixarity(b, argc, 2);
+    Reserve r = reserve(b, 4);
+    int32_t n = peg_getnat(b, argv[0]);
+    uint32_t subrule = peg_compile1(b, argv[1]);
+    emit_3(r, RULE_BETWEEN, n, n, subrule);
+}
 
 /* Rule of the form [rule] */
 static void spec_onerule(Builder *b, int32_t argc, const Janet *argv, uint32_t op) {
@@ -869,6 +853,7 @@ static const SpecialPair peg_specials[] = {
     {"position", spec_position},
     {"quote", spec_capture},
     {"range", spec_range},
+    {"repeat", spec_repeat},
     {"replace", spec_replace},
     {"sequence", spec_sequence},
     {"set", spec_set},
@@ -1003,16 +988,9 @@ static uint32_t peg_compile1(Builder *b, Janet peg) {
  * Post-Compilation
  */
 
-typedef struct {
-    uint32_t *bytecode;
-    Janet *constants;
-    size_t bytecode_len;
-    uint32_t num_constants;
-} Peg;
-
 static int peg_mark(void *p, size_t size) {
     (void) size;
-    Peg *peg = (Peg *)p;
+    JanetPeg *peg = (JanetPeg *)p;
     if (NULL != peg->constants)
         for (uint32_t i = 0; i < peg->num_constants; i++)
             janet_mark(peg->constants[i]);
@@ -1020,7 +998,7 @@ static int peg_mark(void *p, size_t size) {
 }
 
 static void peg_marshal(void *p, JanetMarshalContext *ctx) {
-    Peg *peg = (Peg *)p;
+    JanetPeg *peg = (JanetPeg *)p;
     janet_marshal_size(ctx, peg->bytecode_len);
     janet_marshal_int(ctx, (int32_t)peg->num_constants);
     janet_marshal_abstract(ctx, p);
@@ -1042,17 +1020,17 @@ static void *peg_unmarshal(JanetMarshalContext *ctx) {
     uint32_t num_constants = (uint32_t) janet_unmarshal_int(ctx);
 
     /* Calculate offsets. Should match those in make_peg */
-    size_t bytecode_start = size_padded(sizeof(Peg), sizeof(uint32_t));
+    size_t bytecode_start = size_padded(sizeof(JanetPeg), sizeof(uint32_t));
     size_t bytecode_size = bytecode_len * sizeof(uint32_t);
     size_t constants_start = size_padded(bytecode_start + bytecode_size, sizeof(Janet));
-    size_t total_size = constants_start + sizeof(Janet) * num_constants;
+    size_t total_size = constants_start + sizeof(Janet) * (size_t) num_constants;
 
     /* DOS prevention? I.E. we could read bytecode and constants before
      * hand so we don't allocated a ton of memory on bad, short input */
 
     /* Allocate PEG */
     char *mem = janet_unmarshal_abstract(ctx, total_size);
-    Peg *peg = (Peg *)mem;
+    JanetPeg *peg = (JanetPeg *)mem;
     uint32_t *bytecode = (uint32_t *)(mem + bytecode_start);
     Janet *constants = (Janet *)(mem + constants_start);
     peg->bytecode = NULL;
@@ -1195,7 +1173,7 @@ bad:
 
 static int cfun_peg_getter(JanetAbstract a, Janet key, Janet *out);
 
-static const JanetAbstractType peg_type = {
+const JanetAbstractType janet_peg_type = {
     "core/peg",
     NULL,
     peg_mark,
@@ -1203,29 +1181,29 @@ static const JanetAbstractType peg_type = {
     NULL,
     peg_marshal,
     peg_unmarshal,
-    NULL
+    JANET_ATEND_UNMARSHAL
 };
 
-/* Convert Builder to Peg (Janet Abstract Value) */
+/* Convert Builder to JanetPeg (Janet Abstract Value) */
-static Peg *make_peg(Builder *b) {
+static JanetPeg *make_peg(Builder *b) {
-    size_t bytecode_start = size_padded(sizeof(Peg), sizeof(uint32_t));
+    size_t bytecode_start = size_padded(sizeof(JanetPeg), sizeof(uint32_t));
     size_t bytecode_size = janet_v_count(b->bytecode) * sizeof(uint32_t);
     size_t constants_start = size_padded(bytecode_start + bytecode_size, sizeof(Janet));
     size_t constants_size = janet_v_count(b->constants) * sizeof(Janet);
     size_t total_size = constants_start + constants_size;
-    char *mem = janet_abstract(&peg_type, total_size);
+    char *mem = janet_abstract(&janet_peg_type, total_size);
-    Peg *peg = (Peg *)mem;
+    JanetPeg *peg = (JanetPeg *)mem;
     peg->bytecode = (uint32_t *)(mem + bytecode_start);
     peg->constants = (Janet *)(mem + constants_start);
     peg->num_constants = janet_v_count(b->constants);
-    memcpy(peg->bytecode, b->bytecode, bytecode_size);
+    safe_memcpy(peg->bytecode, b->bytecode, bytecode_size);
-    memcpy(peg->constants, b->constants, constants_size);
+    safe_memcpy(peg->constants, b->constants, constants_size);
     peg->bytecode_len = janet_v_count(b->bytecode);
     return peg;
 }
 
 /* Compiler entry point */
-static Peg *compile_peg(Janet x) {
+static JanetPeg *compile_peg(Janet x) {
     Builder builder;
     builder.grammar = janet_table(0);
     builder.default_grammar = janet_get_core_table("default-peg-grammar");
@@ -1236,7 +1214,7 @@ static Peg *compile_peg(Janet x) {
     builder.form = x;
     builder.depth = JANET_RECURSION_GUARD;
     peg_compile1(&builder, x);
-    Peg *peg = make_peg(&builder);
+    JanetPeg *peg = make_peg(&builder);
     builder_cleanup(&builder);
     return peg;
 }
@@ -1247,15 +1225,15 @@ static Peg *compile_peg(Janet x) {
 
 static Janet cfun_peg_compile(int32_t argc, Janet *argv) {
     janet_fixarity(argc, 1);
-    Peg *peg = compile_peg(argv[0]);
+    JanetPeg *peg = compile_peg(argv[0]);
     return janet_wrap_abstract(peg);
 }
 
 static Janet cfun_peg_match(int32_t argc, Janet *argv) {
     janet_arity(argc, 2, -1);
-    Peg *peg;
+    JanetPeg *peg;
     if (janet_checktype(argv[0], JANET_ABSTRACT) &&
-            janet_abstract_type(janet_unwrap_abstract(argv[0])) == &peg_type) {
+            janet_abstract_type(janet_unwrap_abstract(argv[0])) == &janet_peg_type) {
         peg = janet_unwrap_abstract(argv[0]);
     } else {
         peg = compile_peg(argv[0]);
@@ -1314,7 +1292,7 @@ static const JanetReg peg_cfuns[] = {
 /* Load the peg module */
 void janet_lib_peg(JanetTable *env) {
     janet_core_cfuns(env, NULL, peg_cfuns);
-    janet_register_abstract_type(&peg_type);
+    janet_register_abstract_type(&janet_peg_type);
 }
 
 #endif /* ifdef JANET_PEG */

src/core/pp.c

@@ -1,5 +1,5 @@
 /*
-* Copyright (c) 2019 Calvin Rose
+* Copyright (c) 2020 Calvin Rose
 *
 * Permission is hereby granted, free of charge, to any person obtaining a copy
 * of this software and associated documentation files (the "Software"), to
@@ -20,16 +20,17 @@
 * IN THE SOFTWARE.
 */
 
-#include <string.h>
-#include <ctype.h>
-
 #ifndef JANET_AMALG
+#include "features.h"
 #include <janet.h>
 #include "util.h"
 #include "state.h"
 #include <math.h>
 #endif
 
+#include <string.h>
+#include <ctype.h>
+
 /* Implements a pretty printer for Janet. The pretty printer
  * is simple and not that flexible, but fast. */
 
@@ -176,53 +177,50 @@ static void janet_escape_string_b(JanetBuffer *buffer, const uint8_t *str) {
 }
 
 static void janet_escape_buffer_b(JanetBuffer *buffer, JanetBuffer *bx) {
+    if (bx == buffer) {
+        /* Ensures buffer won't resize while escaping */
+        janet_buffer_ensure(bx, bx->count + 5 * bx->count + 3, 1);
+    }
     janet_buffer_push_u8(buffer, '@');
     janet_escape_string_impl(buffer, bx->data, bx->count);
 }
 
-void janet_description_b(JanetBuffer *buffer, Janet x) {
+void janet_to_string_b(JanetBuffer *buffer, Janet x) {
     switch (janet_type(x)) {
         case JANET_NIL:
             janet_buffer_push_cstring(buffer, "nil");
-            return;
+            break;
         case JANET_BOOLEAN:
             janet_buffer_push_cstring(buffer,
                                       janet_unwrap_boolean(x) ? "true" : "false");
-            return;
+            break;
         case JANET_NUMBER:
             number_to_string_b(buffer, janet_unwrap_number(x));
-            return;
+            break;
-        case JANET_KEYWORD:
+        case JANET_STRING:
-            janet_buffer_push_u8(buffer, ':');
-        /* fallthrough */
         case JANET_SYMBOL:
+        case JANET_KEYWORD:
             janet_buffer_push_bytes(buffer,
                                     janet_unwrap_string(x),
                                     janet_string_length(janet_unwrap_string(x)));
-            return;
+            break;
-        case JANET_STRING:
-            janet_escape_string_b(buffer, janet_unwrap_string(x));
-            return;
         case JANET_BUFFER: {
-            JanetBuffer *b = janet_unwrap_buffer(x);
+            JanetBuffer *to = janet_unwrap_buffer(x);
-            if (b == buffer) {
+            /* Prevent resizing buffer while appending */
-                /* Ensures buffer won't resize while escaping */
+            if (buffer == to) janet_buffer_extra(buffer, to->count);
-                janet_buffer_ensure(b, 5 * b->count + 3, 1);
+            janet_buffer_push_bytes(buffer, to->data, to->count);
-            }
+            break;
-            janet_escape_buffer_b(buffer, b);
-            return;
         }
         case JANET_ABSTRACT: {
-            void *p = janet_unwrap_abstract(x);
+            JanetAbstract p = janet_unwrap_abstract(x);
-            const JanetAbstractType *at = janet_abstract_type(p);
+            const JanetAbstractType *t = janet_abstract_type(p);
-            if (at->tostring) {
+            if (t->tostring != NULL) {
-                at->tostring(p, buffer);
+                t->tostring(p, buffer);
             } else {
-                const char *n = at->name;
+                string_description_b(buffer, t->name, p);
-                string_description_b(buffer, n, janet_unwrap_abstract(x));
             }
-            return;
         }
+        return;
         case JANET_CFUNCTION: {
             Janet check = janet_table_get(janet_vm_registry, x);
             if (janet_checktype(check, JANET_SYMBOL)) {
@@ -254,26 +252,58 @@ void janet_description_b(JanetBuffer *buffer, Janet x) {
     }
 }
 
-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;
+    for (int32_t i = 0; i < len; i++) {
+        if (!pp_is_symbol_char(sym[i])) return 1;
+    }
+    return 0;
+}
+
+void janet_description_b(JanetBuffer *buffer, Janet x) {
     switch (janet_type(x)) {
         default:
-            janet_description_b(buffer, x);
             break;
-        case JANET_BUFFER: {
-            JanetBuffer *to = janet_unwrap_buffer(x);
-            /* Prevent resizing buffer while appending */
-            if (buffer == to) janet_buffer_extra(buffer, to->count);
-            janet_buffer_push_bytes(buffer, to->data, to->count);
-            break;
-        }
-        case JANET_STRING:
-        case JANET_SYMBOL:
         case JANET_KEYWORD:
-            janet_buffer_push_bytes(buffer,
+            janet_buffer_push_u8(buffer, ':');
-                                    janet_unwrap_string(x),
-                                    janet_string_length(janet_unwrap_string(x)));
             break;
+        case JANET_STRING:
+            janet_escape_string_b(buffer, janet_unwrap_string(x));
+            return;
+        case JANET_BUFFER: {
+            JanetBuffer *b = janet_unwrap_buffer(x);
+            janet_escape_buffer_b(buffer, b);
+            return;
+        }
+        case JANET_ABSTRACT: {
+            JanetAbstract p = janet_unwrap_abstract(x);
+            const JanetAbstractType *t = janet_abstract_type(p);
+            if (t->tostring != NULL) {
+                janet_buffer_push_cstring(buffer, "<");
+                janet_buffer_push_cstring(buffer, t->name);
+                janet_buffer_push_cstring(buffer, " ");
+                t->tostring(p, buffer);
+                janet_buffer_push_cstring(buffer, ">");
+            } else {
+                string_description_b(buffer, t->name, p);
+            }
+            return;
+        }
     }
+    janet_to_string_b(buffer, x);
 }
 
 const uint8_t *janet_description(Janet x) {
@@ -316,6 +346,83 @@ struct pretty {
     JanetTable seen;
 };
 
+/* Print jdn format */
+static int print_jdn_one(struct pretty *S, Janet x, int depth) {
+    if (depth == 0) return 1;
+    switch (janet_type(x)) {
+        case JANET_NIL:
+        case JANET_NUMBER:
+        case JANET_BOOLEAN:
+        case JANET_BUFFER:
+        case JANET_STRING:
+            janet_description_b(S->buffer, x);
+            break;
+        case JANET_SYMBOL:
+        case JANET_KEYWORD:
+            if (contains_bad_chars(janet_unwrap_keyword(x), janet_type(x) == JANET_SYMBOL)) return 1;
+            janet_description_b(S->buffer, x);
+            break;
+        case JANET_TUPLE: {
+            JanetTuple t = janet_unwrap_tuple(x);
+            int isb = janet_tuple_flag(t) & JANET_TUPLE_FLAG_BRACKETCTOR;
+            janet_buffer_push_u8(S->buffer, isb ? '[' : '(');
+            for (int32_t i = 0; i < janet_tuple_length(t); i++) {
+                if (i) janet_buffer_push_u8(S->buffer, ' ');
+                if (print_jdn_one(S, t[i], depth - 1)) return 1;
+            }
+            janet_buffer_push_u8(S->buffer, isb ? ']' : ')');
+        }
+        break;
+        case JANET_ARRAY: {
+            janet_table_put(&S->seen, x, janet_wrap_true());
+            JanetArray *a = janet_unwrap_array(x);
+            janet_buffer_push_cstring(S->buffer, "@[");
+            for (int32_t i = 0; i < a->count; i++) {
+                if (i) janet_buffer_push_u8(S->buffer, ' ');
+                if (print_jdn_one(S, a->data[i], depth - 1)) return 1;
+            }
+            janet_buffer_push_u8(S->buffer, ']');
+        }
+        break;
+        case JANET_TABLE: {
+            janet_table_put(&S->seen, x, janet_wrap_true());
+            JanetTable *tab = janet_unwrap_table(x);
+            janet_buffer_push_cstring(S->buffer, "@{");
+            int isFirst = 1;
+            for (int32_t i = 0; i < tab->capacity; i++) {
+                const JanetKV *kv = tab->data + i;
+                if (janet_checktype(kv->key, JANET_NIL)) continue;
+                if (!isFirst) janet_buffer_push_u8(S->buffer, ' ');
+                isFirst = 0;
+                if (print_jdn_one(S, kv->key, depth - 1)) return 1;
+                janet_buffer_push_u8(S->buffer, ' ');
+                if (print_jdn_one(S, kv->value, depth - 1)) return 1;
+            }
+            janet_buffer_push_u8(S->buffer, '}');
+        }
+        break;
+        case JANET_STRUCT: {
+            JanetStruct st = janet_unwrap_struct(x);
+            janet_buffer_push_u8(S->buffer, '{');
+            int isFirst = 1;
+            for (int32_t i = 0; i < janet_struct_capacity(st); i++) {
+                const JanetKV *kv = st + i;
+                if (janet_checktype(kv->key, JANET_NIL)) continue;
+                if (!isFirst) janet_buffer_push_u8(S->buffer, ' ');
+                isFirst = 0;
+                if (print_jdn_one(S, kv->key, depth - 1)) return 1;
+                janet_buffer_push_u8(S->buffer, ' ');
+                if (print_jdn_one(S, kv->value, depth - 1)) return 1;
+            }
+            janet_buffer_push_u8(S->buffer, '}');
+        }
+        break;
+        default:
+            return 1;
+    }
+    return 0;
+}
+
 static void print_newline(struct pretty *S, int just_a_space) {
     int i;
     if (just_a_space || (S->flags & JANET_PRETTY_ONELINE)) {
@@ -330,6 +437,7 @@ static void print_newline(struct pretty *S, int just_a_space) {
 
 /* Color coding for types */
 static const char janet_cycle_color[] = "\x1B[36m";
+static const char janet_class_color[] = "\x1B[34m";
 static const char *janet_pretty_colors[] = {
     "\x1B[32m",
     "\x1B[36m",
@@ -351,6 +459,8 @@ static const char *janet_pretty_colors[] = {
 
 #define JANET_PRETTY_DICT_ONELINE 4
 #define JANET_PRETTY_IND_ONELINE 10
+#define JANET_PRETTY_DICT_LIMIT 16
+#define JANET_PRETTY_ARRAY_LIMIT 16
 
 /* Helper for pretty printing */
 static void janet_pretty_one(struct pretty *S, Janet x, int is_dict_value) {
@@ -417,9 +527,22 @@ static void janet_pretty_one(struct pretty *S, Janet x, int is_dict_value) {
                 if (!isarray && !(S->flags & JANET_PRETTY_ONELINE) && len >= JANET_PRETTY_IND_ONELINE)
                     janet_buffer_push_u8(S->buffer, ' ');
                 if (is_dict_value && len >= JANET_PRETTY_IND_ONELINE) print_newline(S, 0);
-                for (i = 0; i < len; i++) {
+                if (len > JANET_PRETTY_ARRAY_LIMIT) {
-                    if (i) print_newline(S, len < JANET_PRETTY_IND_ONELINE);
+                    for (i = 0; i < 3; i++) {
-                    janet_pretty_one(S, arr[i], 0);
+                        if (i) print_newline(S, 0);
+                        janet_pretty_one(S, arr[i], 0);
+                    }
+                    print_newline(S, 0);
+                    janet_buffer_push_cstring(S->buffer, "...");
+                    for (i = 0; i < 3; i++) {
+                        print_newline(S, 0);
+                        janet_pretty_one(S, arr[len - 3 + i], 0);
+                    }
+                } else {
+                    for (i = 0; i < len; i++) {
+                        if (i) print_newline(S, len < JANET_PRETTY_IND_ONELINE);
+                        janet_pretty_one(S, arr[i], 0);
+                    }
                 }
             }
             S->indent -= 2;
@@ -437,10 +560,17 @@ static void janet_pretty_one(struct pretty *S, Janet x, int is_dict_value) {
                 JanetTable *t = janet_unwrap_table(x);
                 JanetTable *proto = t->proto;
                 if (NULL != proto) {
-                    Janet name = janet_table_get(proto, janet_csymbolv(":name"));
+                    Janet name = janet_table_get(proto, janet_ckeywordv("name"));
-                    if (janet_checktype(name, JANET_SYMBOL)) {
+                    const uint8_t *n;
-                        const uint8_t *sym = janet_unwrap_symbol(name);
+                    int32_t len;
-                        janet_buffer_push_bytes(S->buffer, sym, janet_string_length(sym));
+                    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, "{");
@@ -454,8 +584,9 @@ static void janet_pretty_one(struct pretty *S, Janet x, int is_dict_value) {
                 int32_t i = 0, len = 0, cap = 0;
                 int first_kv_pair = 1;
                 const JanetKV *kvs = NULL;
+                int counter = 0;
                 janet_dictionary_view(x, &kvs, &len, &cap);
-                if (!istable && len >= JANET_PRETTY_DICT_ONELINE)
+                if (!istable && !(S->flags & JANET_PRETTY_ONELINE) && len >= JANET_PRETTY_DICT_ONELINE)
                     janet_buffer_push_u8(S->buffer, ' ');
                 if (is_dict_value && len >= JANET_PRETTY_DICT_ONELINE) print_newline(S, 0);
                 for (i = 0; i < cap; i++) {
@@ -468,6 +599,12 @@ static void janet_pretty_one(struct pretty *S, Janet x, int is_dict_value) {
                         janet_pretty_one(S, kvs[i].key, 0);
                         janet_buffer_push_u8(S->buffer, ' ');
                         janet_pretty_one(S, kvs[i].value, 1);
+                        counter++;
+                        if (counter == 10) {
+                            print_newline(S, 0);
+                            janet_buffer_push_cstring(S->buffer, "...");
+                            break;
+                        }
                     }
                 }
             }
@@ -504,6 +641,29 @@ JanetBuffer *janet_pretty(JanetBuffer *buffer, int depth, int flags, Janet x) {
     return janet_pretty_(buffer, depth, flags, x, buffer ? buffer->count : 0);
 }
 
+static JanetBuffer *janet_jdn_(JanetBuffer *buffer, int depth, Janet x, int32_t startlen) {
+    struct pretty S;
+    if (NULL == buffer) {
+        buffer = janet_buffer(0);
+    }
+    S.buffer = buffer;
+    S.depth = depth;
+    S.indent = 0;
+    S.flags = 0;
+    S.bufstartlen = startlen;
+    janet_table_init(&S.seen, 10);
+    int res = print_jdn_one(&S, x, depth);
+    janet_table_deinit(&S.seen);
+    if (res) {
+        janet_panic("could not print to jdn format");
+    }
+    return S.buffer;
+}
+
+JanetBuffer *janet_jdn(JanetBuffer *buffer, int depth, Janet x) {
+    return janet_jdn_(buffer, depth, x, buffer ? buffer->count : 0);
+}
+
 static const char *typestr(Janet x) {
     JanetType t = janet_type(x);
     return (t == JANET_ABSTRACT)
@@ -528,96 +688,6 @@ static void pushtypes(JanetBuffer *buffer, int types) {
     }
 }
 
-void janet_formatb(JanetBuffer *bufp, const char *format, va_list args) {
-    for (const char *c = format; *c; c++) {
-        switch (*c) {
-            default:
-                janet_buffer_push_u8(bufp, *c);
-                break;
-            case '%': {
-                if (c[1] == '\0')
-                    break;
-                switch (*++c) {
-                    default:
-                        janet_buffer_push_u8(bufp, *c);
-                        break;
-                    case 'f':
-                        number_to_string_b(bufp, va_arg(args, double));
-                        break;
-                    case 'd':
-                        integer_to_string_b(bufp, va_arg(args, long));
-                        break;
-                    case 'S': {
-                        const uint8_t *str = va_arg(args, const uint8_t *);
-                        janet_buffer_push_bytes(bufp, str, janet_string_length(str));
-                        break;
-                    }
-                    case 's':
-                        janet_buffer_push_cstring(bufp, va_arg(args, const char *));
-                        break;
-                    case 'c':
-                        janet_buffer_push_u8(bufp, (uint8_t) va_arg(args, long));
-                        break;
-                    case 'q': {
-                        const uint8_t *str = va_arg(args, const uint8_t *);
-                        janet_escape_string_b(bufp, str);
-                        break;
-                    }
-                    case 't': {
-                        janet_buffer_push_cstring(bufp, typestr(va_arg(args, Janet)));
-                        break;
-                    }
-                    case 'T': {
-                        int types = va_arg(args, long);
-                        pushtypes(bufp, types);
-                        break;
-                    }
-                    case 'V': {
-                        janet_to_string_b(bufp, va_arg(args, Janet));
-                        break;
-                    }
-                    case 'v': {
-                        janet_description_b(bufp, va_arg(args, Janet));
-                        break;
-                    }
-                    case 'p': {
-                        janet_pretty(bufp, 4, 0, va_arg(args, Janet));
-                        break;
-                    }
-                    case 'P': {
-                        janet_pretty(bufp, 4, JANET_PRETTY_COLOR, va_arg(args, Janet));
-                        break;
-                    }
-                }
-            }
-        }
-    }
-}
-
-/* Helper function for formatting strings. Useful for generating error messages and the like.
- * Similar to printf, but specialized for operating with janet. */
-const uint8_t *janet_formatc(const char *format, ...) {
-    va_list args;
-    const uint8_t *ret;
-    JanetBuffer buffer;
-    int32_t len = 0;
-
-    /* Calculate length, init buffer and args */
-    while (format[len]) len++;
-    janet_buffer_init(&buffer, len);
-    va_start(args, format);
-
-    /* Run format */
-    janet_formatb(&buffer, format, args);
-
-    /* Iterate length */
-    va_end(args);
-
-    ret = janet_string(buffer.data, buffer.count);
-    janet_buffer_deinit(&buffer);
-    return ret;
-}
-
 /*
  * code adapted from lua/lstrlib.c http://lua.org
  */
@@ -658,6 +728,141 @@ static const char *scanformat(
     return p;
 }
 
+void janet_formatb(JanetBuffer *b, const char *format, va_list args) {
+    const char *format_end = format + strlen(format);
+    const char *c = format;
+    int32_t startlen = b->count;
+    while (c < format_end) {
+        if (*c != '%') {
+            janet_buffer_push_u8(b, (uint8_t) *c++);
+        } else if (*++c == '%') {
+            janet_buffer_push_u8(b, (uint8_t) *c++);
+        } else {
+            char form[MAX_FORMAT], item[MAX_ITEM];
+            char width[3], precision[3];
+            int nb = 0; /* number of bytes in added item */
+            c = scanformat(c, form, width, precision);
+            switch (*c++) {
+                case 'c': {
+                    int n = va_arg(args, long);
+                    nb = snprintf(item, MAX_ITEM, form, n);
+                    break;
+                }
+                case 'd':
+                case 'i':
+                case 'o':
+                case 'u':
+                case 'x':
+                case 'X': {
+                    int32_t n = va_arg(args, long);
+                    nb = snprintf(item, MAX_ITEM, form, n);
+                    break;
+                }
+                case 'a':
+                case 'A':
+                case 'e':
+                case 'E':
+                case 'f':
+                case 'g':
+                case 'G': {
+                    double d = va_arg(args, double);
+                    nb = snprintf(item, MAX_ITEM, form, d);
+                    break;
+                }
+                case 's':
+                case 'S': {
+                    const char *str = va_arg(args, const char *);
+                    int32_t len = c[-1] == 's'
+                                  ? (int32_t) strlen(str)
+                                  : janet_string_length((JanetString) str);
+                    if (form[2] == '\0')
+                        janet_buffer_push_bytes(b, (const uint8_t *) str, len);
+                    else {
+                        if (len != (int32_t) strlen((const char *) str))
+                            janet_panic("string contains zeros");
+                        if (!strchr(form, '.') && len >= 100) {
+                            janet_panic("no precision and string is too long to be formatted");
+                        } else {
+                            nb = snprintf(item, MAX_ITEM, form, str);
+                        }
+                    }
+                    break;
+                }
+                case 'V':
+                    janet_to_string_b(b, va_arg(args, Janet));
+                    break;
+                case 'v':
+                    janet_description_b(b, va_arg(args, Janet));
+                    break;
+                case 't':
+                    janet_buffer_push_cstring(b, typestr(va_arg(args, Janet)));
+                    break;
+                case 'T': {
+                    int types = va_arg(args, long);
+                    pushtypes(b, types);
+                    break;
+                }
+                case 'Q':
+                case 'q':
+                case 'P':
+                case 'p': { /* janet pretty , precision = depth */
+                    int depth = atoi(precision);
+                    if (depth < 1) depth = 4;
+                    char d = c[-1];
+                    int has_color = (d == 'P') || (d == 'Q');
+                    int has_oneline = (d == 'Q') || (d == 'q');
+                    int flags = 0;
+                    flags |= has_color ? JANET_PRETTY_COLOR : 0;
+                    flags |= has_oneline ? JANET_PRETTY_ONELINE : 0;
+                    janet_pretty_(b, depth, flags, va_arg(args, Janet), startlen);
+                    break;
+                }
+                case 'j': {
+                    int depth = atoi(precision);
+                    if (depth < 1)
+                        depth = JANET_RECURSION_GUARD;
+                    janet_jdn_(b, depth, va_arg(args, Janet), startlen);
+                    break;
+                }
+                default: {
+                    /* also treat cases 'nLlh' */
+                    janet_panicf("invalid conversion '%s' to 'format'",
+                                 form);
+                }
+            }
+            if (nb >= MAX_ITEM)
+                janet_panicf("format buffer overflow", form);
+            if (nb > 0)
+                janet_buffer_push_bytes(b, (uint8_t *) item, nb);
+        }
+
+    }
+}
+
+/* Helper function for formatting strings. Useful for generating error messages and the like.
+ * Similar to printf, but specialized for operating with janet. */
+const uint8_t *janet_formatc(const char *format, ...) {
+    va_list args;
+    const uint8_t *ret;
+    JanetBuffer buffer;
+    int32_t len = 0;
+
+    /* Calculate length, init buffer and args */
+    while (format[len]) len++;
+    janet_buffer_init(&buffer, len);
+    va_start(args, format);
+
+    /* Run format */
+    janet_formatb(&buffer, format, args);
+
+    /* Iterate length */
+    va_end(args);
+
+    ret = janet_string(buffer.data, buffer.count);
+    janet_buffer_deinit(&buffer);
+    return ret;
+}
+
 /* Shared implementation between string/format and
  * buffer/format */
 void janet_buffer_format(
@@ -749,6 +954,13 @@ void janet_buffer_format(
                     janet_pretty_(b, depth, flags, argv[arg], startlen);
                     break;
                 }
+                case 'j': {
+                    int depth = atoi(precision);
+                    if (depth < 1)
+                        depth = JANET_RECURSION_GUARD;
+                    janet_jdn_(b, depth, argv[arg], startlen);
+                    break;
+                }
                 default: {
                     /* also treat cases 'nLlh' */
                     janet_panicf("invalid conversion '%s' to 'format'",

src/core/regalloc.c

@@ -1,5 +1,5 @@
 /*
-* Copyright (c) 2019 Calvin Rose
+* Copyright (c) 2020 Calvin Rose
 *
 * Permission is hereby granted, free of charge, to any person obtaining a copy
 * of this software and associated documentation files (the "Software"), to
@@ -21,6 +21,7 @@
 */
 
 #ifndef JANET_AMALG
+#include "features.h"
 #include <janet.h>
 #include "regalloc.h"
 #include "util.h"
@@ -66,7 +67,7 @@ void janetc_regalloc_clone(JanetcRegisterAllocator *dest, JanetcRegisterAllocato
     dest->count = src->count;
     dest->capacity = src->capacity;
     dest->max = src->max;
-    size = sizeof(uint32_t) * dest->capacity;
+    size = sizeof(uint32_t) * (size_t) dest->capacity;
     dest->regtemps = 0;
     if (size) {
         dest->chunks = malloc(size);
@@ -86,7 +87,7 @@ static void pushchunk(JanetcRegisterAllocator *ra) {
     int32_t newcount = ra->count + 1;
     if (newcount > ra->capacity) {
         int32_t newcapacity = newcount * 2;
-        ra->chunks = realloc(ra->chunks, newcapacity * sizeof(uint32_t));
+        ra->chunks = realloc(ra->chunks, (size_t) newcapacity * sizeof(uint32_t));
         if (!ra->chunks) {
             JANET_OUT_OF_MEMORY;
         }

src/core/regalloc.h

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

src/core/run.c

@@ -1,5 +1,5 @@
 /*
-* Copyright (c) 2019 Calvin Rose
+* Copyright (c) 2020 Calvin Rose
 *
 * Permission is hereby granted, free of charge, to any person obtaining a copy
 * of this software and associated documentation files (the "Software"), to
@@ -21,6 +21,7 @@
 */
 
 #ifndef JANET_AMALG
+#include "features.h"
 #include <janet.h>
 #include "state.h"
 #endif

src/core/specials.c

@@ -1,5 +1,5 @@
 /*
-* Copyright (c) 2019 Calvin Rose
+* Copyright (c) 2020 Calvin Rose
 *
 * Permission is hereby granted, free of charge, to any person obtaining a copy
 * of this software and associated documentation files (the "Software"), to
@@ -21,6 +21,7 @@
 */
 
 #ifndef JANET_AMALG
+#include "features.h"
 #include <janet.h>
 #include "compile.h"
 #include "util.h"
@@ -537,6 +538,20 @@ static JanetSlot janetc_break(JanetFopts opts, int32_t argn, const Janet *argv)
     }
 }
 
+/* Check if a form matches the pattern (not= nil _) */
+static int janetc_check_notnil_form(Janet x, Janet *capture) {
+    if (!janet_checktype(x, JANET_TUPLE)) return 0;
+    JanetTuple tup = janet_unwrap_tuple(x);
+    if (!janet_checktype(tup[0], JANET_FUNCTION)) return 0;
+    if (3 != janet_tuple_length(tup)) return 0;
+    JanetFunction *fun = janet_unwrap_function(tup[0]);
+    uint32_t tag = fun->def->flags & JANET_FUNCDEF_FLAG_TAG;
+    if (tag != JANET_FUN_NEQ) return 0;
+    if (!janet_checktype(tup[1], JANET_NIL)) return 0;
+    *capture = tup[2];
+    return 1;
+}
+
 /*
  * :whiletop
  * ...
@@ -553,6 +568,9 @@ static JanetSlot janetc_while(JanetFopts opts, int32_t argn, const Janet *argv)
     JanetScope tempscope;
     int32_t labelwt, labeld, labeljt, labelc, i;
     int infinite = 0;
+    int is_notnil_form = 0;
+    uint8_t ifjmp = JOP_JUMP_IF;
+    uint8_t ifnjmp = JOP_JUMP_IF_NOT;
 
     if (argn < 2) {
         janetc_cerror(c, "expected at least 2 arguments");
@@ -563,13 +581,26 @@ static JanetSlot janetc_while(JanetFopts opts, int32_t argn, const Janet *argv)
 
     janetc_scope(&tempscope, c, JANET_SCOPE_WHILE, "while");
 
+    /* Check for `(not= nil _)` in condition, and if so, use the
+     * jmpnl or jmpnn instructions. This let's us implement `(each ...)`
+     * more efficiently. */
+    Janet condform = argv[0];
+    if (janetc_check_notnil_form(condform, &condform)) {
+        is_notnil_form = 1;
+        ifjmp = JOP_JUMP_IF_NOT_NIL;
+        ifnjmp = JOP_JUMP_IF_NIL;
+    }
+
     /* Compile condition */
-    cond = janetc_value(subopts, argv[0]);
+    cond = janetc_value(subopts, condform);
 
     /* Check for constant condition */
     if (cond.flags & JANET_SLOT_CONSTANT) {
         /* Loop never executes */
-        if (!janet_truthy(cond.constant)) {
+        int never_executes = is_notnil_form
+                             ? janet_checktype(cond.constant, JANET_NIL)
+                             : !janet_truthy(cond.constant);
+        if (never_executes) {
             janetc_popscope(c);
             return janetc_cslot(janet_wrap_nil());
         }
@@ -580,7 +611,7 @@ static JanetSlot janetc_while(JanetFopts opts, int32_t argn, const Janet *argv)
     /* Infinite loop does not need to check condition */
     labelc = infinite
              ? 0
-             : janetc_emit_si(c, JOP_JUMP_IF_NOT, cond, 0, 0);
+             : janetc_emit_si(c, ifnjmp, cond, 0, 0);
 
     /* Compile body */
     for (i = 1; i < argn; i++) {
@@ -599,10 +630,10 @@ static JanetSlot janetc_while(JanetFopts opts, int32_t argn, const Janet *argv)
         janetc_scope(&tempscope, c, JANET_SCOPE_FUNCTION, "while-iife");
 
         /* Recompile in the function scope */
-        cond = janetc_value(subopts, argv[0]);
+        cond = janetc_value(subopts, condform);
         if (!(cond.flags & JANET_SLOT_CONSTANT)) {
             /* If not an infinite loop, return nil when condition false */
-            janetc_emit_si(c, JOP_JUMP_IF, cond, 2, 0);
+            janetc_emit_si(c, ifjmp, cond, 2, 0);
             janetc_emit(c, JOP_RETURN_NIL);
         }
         for (i = 1; i < argn; i++) {

src/core/state.h

@@ -1,5 +1,5 @@
 /*
-* Copyright (c) 2019 Calvin Rose
+* Copyright (c) 2020 Calvin Rose
 *
 * Permission is hereby granted, free of charge, to any person obtaining a copy
 * of this software and associated documentation files (the "Software"), to
@@ -32,6 +32,8 @@
  * be in it. However, thread local global variables for interpreter
  * state should allow easy multi-threading. */
 
+typedef struct JanetScratch JanetScratch;
+
 /* Cache the core environment */
 extern JANET_THREAD_LOCAL JanetTable *janet_vm_core_env;
 
@@ -51,6 +53,10 @@ extern JANET_THREAD_LOCAL Janet *janet_vm_return_reg;
  * along with otherwise bare c function pointers. */
 extern JANET_THREAD_LOCAL JanetTable *janet_vm_registry;
 
+/* Registry for abstract abstract types that can be marshalled.
+ * We need this to look up the constructors when unmarshalling. */
+extern JANET_THREAD_LOCAL JanetTable *janet_vm_abstract_registry;
+
 /* Immutable value cache */
 extern JANET_THREAD_LOCAL const uint8_t **janet_vm_cache;
 extern JANET_THREAD_LOCAL uint32_t janet_vm_cache_capacity;
@@ -59,17 +65,17 @@ extern JANET_THREAD_LOCAL uint32_t janet_vm_cache_deleted;
 
 /* Garbage collection */
 extern JANET_THREAD_LOCAL void *janet_vm_blocks;
-extern JANET_THREAD_LOCAL uint32_t janet_vm_gc_interval;
+extern JANET_THREAD_LOCAL size_t janet_vm_gc_interval;
-extern JANET_THREAD_LOCAL uint32_t janet_vm_next_collection;
+extern JANET_THREAD_LOCAL size_t janet_vm_next_collection;
 extern JANET_THREAD_LOCAL int janet_vm_gc_suspend;
 
 /* GC roots */
 extern JANET_THREAD_LOCAL Janet *janet_vm_roots;
-extern JANET_THREAD_LOCAL uint32_t janet_vm_root_count;
+extern JANET_THREAD_LOCAL size_t janet_vm_root_count;
-extern JANET_THREAD_LOCAL uint32_t janet_vm_root_capacity;
+extern JANET_THREAD_LOCAL size_t janet_vm_root_capacity;
 
 /* Scratch memory */
-extern JANET_THREAD_LOCAL void **janet_scratch_mem;
+extern JANET_THREAD_LOCAL JanetScratch **janet_scratch_mem;
 extern JANET_THREAD_LOCAL size_t janet_scratch_cap;
 extern JANET_THREAD_LOCAL size_t janet_scratch_len;
 

src/core/string.c

@@ -1,5 +1,5 @@
 /*
-* Copyright (c) 2019 Calvin Rose
+* Copyright (c) 2020 Calvin Rose
 *
 * Permission is hereby granted, free of charge, to any person obtaining a copy
 * of this software and associated documentation files (the "Software"), to
@@ -20,18 +20,19 @@
 * IN THE SOFTWARE.
 */
 
-#include <string.h>
-
 #ifndef JANET_AMALG
+#include "features.h"
 #include <janet.h>
 #include "gc.h"
 #include "util.h"
 #include "state.h"
 #endif
 
+#include <string.h>
+
 /* Begin building a string */
 uint8_t *janet_string_begin(int32_t length) {
-    JanetStringHead *head = janet_gcalloc(JANET_MEMORY_STRING, sizeof(JanetStringHead) + length + 1);
+    JanetStringHead *head = janet_gcalloc(JANET_MEMORY_STRING, sizeof(JanetStringHead) + (size_t) length + 1);
     head->length = length;
     uint8_t *data = (uint8_t *)head->data;
     data[length] = 0;
@@ -46,11 +47,11 @@ const uint8_t *janet_string_end(uint8_t *str) {
 
 /* Load a buffer as a string */
 const uint8_t *janet_string(const uint8_t *buf, int32_t len) {
-    JanetStringHead *head = janet_gcalloc(JANET_MEMORY_STRING, sizeof(JanetStringHead) + len + 1);
+    JanetStringHead *head = janet_gcalloc(JANET_MEMORY_STRING, sizeof(JanetStringHead) + (size_t) len + 1);
     head->length = len;
     head->hash = janet_string_calchash(buf, len);
     uint8_t *data = (uint8_t *)head->data;
-    memcpy(data, buf, len);
+    safe_memcpy(data, buf, len);
     data[len] = 0;
     return data;
 }
@@ -186,7 +187,7 @@ static Janet cfun_string_repeat(int32_t argc, Janet *argv) {
     uint8_t *newbuf = janet_string_begin((int32_t) mulres);
     uint8_t *end = newbuf + mulres;
     for (uint8_t *p = newbuf; p < end; p += view.len) {
-        memcpy(p, view.bytes, view.len);
+        safe_memcpy(p, view.bytes, view.len);
     }
     return janet_wrap_string(janet_string_end(newbuf));
 }
@@ -342,11 +343,11 @@ static Janet cfun_string_replace(int32_t argc, Janet *argv) {
         return janet_stringv(s.kmp.text, s.kmp.textlen);
     }
     buf = janet_string_begin(s.kmp.textlen - s.kmp.patlen + s.substlen);
-    memcpy(buf, s.kmp.text, result);
+    safe_memcpy(buf, s.kmp.text, result);
-    memcpy(buf + result, s.subst, s.substlen);
+    safe_memcpy(buf + result, s.subst, s.substlen);
-    memcpy(buf + result + s.substlen,
+    safe_memcpy(buf + result + s.substlen,
-           s.kmp.text + result + s.kmp.patlen,
+                s.kmp.text + result + s.kmp.patlen,
-           s.kmp.textlen - result - s.kmp.patlen);
+                s.kmp.textlen - result - s.kmp.patlen);
     kmp_deinit(&s.kmp);
     return janet_wrap_string(janet_string_end(buf));
 }
@@ -444,11 +445,11 @@ static Janet cfun_string_join(int32_t argc, Janet *argv) {
         const uint8_t *chunk = NULL;
         int32_t chunklen = 0;
         if (i) {
-            memcpy(out, joiner.bytes, joiner.len);
+            safe_memcpy(out, joiner.bytes, joiner.len);
             out += joiner.len;
         }
         janet_bytes_view(parts.items[i], &chunk, &chunklen);
-        memcpy(out, chunk, chunklen);
+        safe_memcpy(out, chunk, chunklen);
         out += chunklen;
     }
     return janet_wrap_string(janet_string_end(buf));

src/core/strtod.c

@@ -1,5 +1,5 @@
 /*
-* Copyright (c) 2019 Calvin Rose
+* Copyright (c) 2020 Calvin Rose
 *
 * Permission is hereby granted, free of charge, to any person obtaining a copy
 * of this software and associated documentation files (the "Software"), to
@@ -40,14 +40,15 @@
  * '0xdeadbeef'.
  */
 
-#include <math.h>
-#include <string.h>
-
 #ifndef JANET_AMALG
+#include "features.h"
 #include <janet.h>
 #include "util.h"
 #endif
 
+#include <math.h>
+#include <string.h>
+
 /* Lookup table for getting values of characters when parsing numbers. Handles
  * digits 0-9 and a-z (and A-Z). A-Z have values of 10 to 35. */
 static uint8_t digit_lookup[128] = {
@@ -86,7 +87,7 @@ static uint32_t *bignat_extra(struct BigNat *mant, int32_t n) {
     int32_t newn = oldn + n;
     if (mant->cap < newn) {
         int32_t newcap = 2 * newn;
-        uint32_t *mem = realloc(mant->digits, newcap * sizeof(uint32_t));
+        uint32_t *mem = realloc(mant->digits, (size_t) newcap * sizeof(uint32_t));
         if (NULL == mem) {
             JANET_OUT_OF_MEMORY;
         }
@@ -446,12 +447,16 @@ int janet_scan_int64(const uint8_t *str, int32_t len, int64_t *out) {
     int neg;
     uint64_t bi;
     if (scan_uint64(str, len, &bi, &neg)) {
-        if (neg && bi <= 0x8000000000000000ULL) {
+        if (neg && bi <= (UINT64_MAX / 2)) {
-            *out = -((int64_t) bi);
+            if (bi > INT64_MAX) {
+                *out = INT64_MIN;
+            } else {
+                *out = -((int64_t) bi);
+            }
             return 1;
         }
-        if (!neg && bi <= 0x7FFFFFFFFFFFFFFFULL) {
+        if (!neg && bi <= INT64_MAX) {
-            *out = bi;
+            *out = (int64_t) bi;
             return 1;
         }
     }

src/core/struct.c

@@ -1,5 +1,5 @@
 /*
-* Copyright (c) 2019 Calvin Rose
+* Copyright (c) 2020 Calvin Rose
 *
 * Permission is hereby granted, free of charge, to any person obtaining a copy
 * of this software and associated documentation files (the "Software"), to
@@ -21,6 +21,7 @@
 */
 
 #ifndef JANET_AMALG
+#include "features.h"
 #include <janet.h>
 #include "gc.h"
 #include "util.h"
@@ -33,7 +34,7 @@ JanetKV *janet_struct_begin(int32_t count) {
     int32_t capacity = janet_tablen(2 * count);
     if (capacity < 0) capacity = janet_tablen(count + 1);
 
-    size_t size = sizeof(JanetStructHead) + capacity * sizeof(JanetKV);
+    size_t size = sizeof(JanetStructHead) + (size_t) capacity * sizeof(JanetKV);
     JanetStructHead *head = janet_gcalloc(JANET_MEMORY_STRUCT, size);
     head->length = count;
     head->capacity = capacity;

src/core/symcache.c

@@ -1,5 +1,5 @@
 /*
-* Copyright (c) 2019 Calvin Rose
+* Copyright (c) 2020 Calvin Rose
 *
 * Permission is hereby granted, free of charge, to any person obtaining a copy
 * of this software and associated documentation files (the "Software"), to
@@ -25,9 +25,8 @@
  * checks, all symbols are interned so that there is a single copy of it in the
  * whole program. Equality is then just a pointer check. */
 
-#include <string.h>
-
 #ifndef JANET_AMALG
+#include "features.h"
 #include <janet.h>
 #include "state.h"
 #include "gc.h"
@@ -35,6 +34,8 @@
 #include "symcache.h"
 #endif
 
+#include <string.h>
+
 /* Cache state */
 JANET_THREAD_LOCAL const uint8_t **janet_vm_cache = NULL;
 JANET_THREAD_LOCAL uint32_t janet_vm_cache_capacity = 0;
@@ -44,7 +45,7 @@ JANET_THREAD_LOCAL uint32_t janet_vm_cache_deleted = 0;
 /* Initialize the cache (allocate cache memory) */
 void janet_symcache_init() {
     janet_vm_cache_capacity = 1024;
-    janet_vm_cache = calloc(1, janet_vm_cache_capacity * sizeof(const uint8_t *));
+    janet_vm_cache = calloc(1, (size_t) janet_vm_cache_capacity * sizeof(const uint8_t *));
     if (NULL == janet_vm_cache) {
         JANET_OUT_OF_MEMORY;
     }
@@ -121,7 +122,7 @@ notfound:
 static void janet_cache_resize(uint32_t newCapacity) {
     uint32_t i, oldCapacity;
     const uint8_t **oldCache = janet_vm_cache;
-    const uint8_t **newCache = calloc(1, newCapacity * sizeof(const uint8_t *));
+    const uint8_t **newCache = calloc(1, (size_t) newCapacity * sizeof(const uint8_t *));
     if (newCache == NULL) {
         JANET_OUT_OF_MEMORY;
     }
@@ -178,11 +179,11 @@ const uint8_t *janet_symbol(const uint8_t *str, int32_t len) {
     const uint8_t **bucket = janet_symcache_findmem(str, len, hash, &success);
     if (success)
         return *bucket;
-    JanetStringHead *head = janet_gcalloc(JANET_MEMORY_SYMBOL, sizeof(JanetStringHead) + len + 1);
+    JanetStringHead *head = janet_gcalloc(JANET_MEMORY_SYMBOL, sizeof(JanetStringHead) + (size_t) len + 1);
     head->hash = hash;
     head->length = len;
     newstr = (uint8_t *)(head->data);
-    memcpy(newstr, str, len);
+    safe_memcpy(newstr, str, len);
     newstr[len] = 0;
     janet_symcache_put((const uint8_t *)newstr, bucket);
     return newstr;

src/core/symcache.h

@@ -1,5 +1,5 @@
 /*
-* Copyright (c) 2019 Calvin Rose
+* Copyright (c) 2020 Calvin Rose
 *
 * Permission is hereby granted, free of charge, to any person obtaining a copy
 * of this software and associated documentation files (the "Software"), to
@@ -24,6 +24,7 @@
 #define JANET_SYMCACHE_H_defined
 
 #ifndef JANET_AMALG
+#include "features.h"
 #include <janet.h>
 #endif
 

src/core/table.c

@@ -1,5 +1,5 @@
 /*
-* Copyright (c) 2019 Calvin Rose
+* Copyright (c) 2020 Calvin Rose
 *
 * Permission is hereby granted, free of charge, to any person obtaining a copy
 * of this software and associated documentation files (the "Software"), to
@@ -21,6 +21,7 @@
 */
 
 #ifndef JANET_AMALG
+#include "features.h"
 #include <janet.h>
 #include "gc.h"
 #include "util.h"
@@ -31,7 +32,7 @@
 
 static void *janet_memalloc_empty_local(int32_t count) {
     int32_t i;
-    void *mem = janet_smalloc(count * sizeof(JanetKV));
+    void *mem = janet_smalloc((size_t) count * sizeof(JanetKV));
     JanetKV *mmem = (JanetKV *)mem;
     for (i = 0; i < count; i++) {
         JanetKV *kv = mmem + i;
@@ -240,7 +241,7 @@ JanetTable *janet_table_clone(JanetTable *table) {
     if (NULL == newTable->data) {
         JANET_OUT_OF_MEMORY;
     }
-    memcpy(newTable->data, table->data, table->capacity * sizeof(JanetKV));
+    memcpy(newTable->data, table->data, (size_t) table->capacity * sizeof(JanetKV));
     return newTable;
 }
 

src/core/thread.c

@@ -1,5 +1,5 @@
 /*
-* Copyright (c) 2019 Calvin Rose
+* Copyright (c) 2020 Calvin Rose
 *
 * Permission is hereby granted, free of charge, to any person obtaining a copy
 * of this software and associated documentation files (the "Software"), to
@@ -21,6 +21,7 @@
 */
 
 #ifndef JANET_AMALG
+#include "features.h"
 #include <janet.h>
 #include "gc.h"
 #include "util.h"
@@ -50,13 +51,6 @@ struct JanetMailbox {
     pthread_cond_t cond;
 #endif
 
-    /* Receiving messages - (only by owner thread)  */
-    JanetTable *decode;
-
-    /* Setup procedure - requires a parent mailbox
-     * to receive thunk from */
-    JanetMailbox *parent;
-
     /* Memory management - reference counting */
     int refCount;
     int closed;
@@ -72,11 +66,25 @@ struct JanetMailbox {
     JanetBuffer messages[];
 };
 
+typedef struct {
+    JanetMailbox *original;
+    JanetMailbox *newbox;
+} JanetMailboxPair;
+
 static JANET_THREAD_LOCAL JanetMailbox *janet_vm_mailbox = NULL;
 static JANET_THREAD_LOCAL JanetThread *janet_vm_thread_current = NULL;
+static JANET_THREAD_LOCAL JanetTable *janet_vm_thread_decode = NULL;
 
-static JanetMailbox *janet_mailbox_create(JanetMailbox *parent, int refCount, uint16_t capacity) {
+static JanetTable *janet_thread_get_decode(void) {
-    JanetMailbox *mailbox = malloc(sizeof(JanetMailbox) + sizeof(JanetBuffer) * capacity);
+    if (janet_vm_thread_decode == NULL) {
+        janet_vm_thread_decode = janet_get_core_table("load-image-dict");
+        janet_gcroot(janet_wrap_table(janet_vm_thread_decode));
+    }
+    return janet_vm_thread_decode;
+}
+
+static JanetMailbox *janet_mailbox_create(int refCount, uint16_t capacity) {
+    JanetMailbox *mailbox = malloc(sizeof(JanetMailbox) + sizeof(JanetBuffer) * (size_t) capacity);
     if (NULL == mailbox) {
         JANET_OUT_OF_MEMORY;
     }
@@ -89,7 +97,6 @@ static JanetMailbox *janet_mailbox_create(JanetMailbox *parent, int refCount, ui
 #endif
     mailbox->refCount = refCount;
     mailbox->closed = 0;
-    mailbox->parent = parent;
     mailbox->messageCount = 0;
     mailbox->messageCapacity = capacity;
     mailbox->messageFirst = 0;
@@ -168,6 +175,23 @@ static int thread_mark(void *p, size_t size) {
     return 0;
 }
 
+static JanetMailboxPair *make_mailbox_pair(JanetMailbox *original) {
+    JanetMailboxPair *pair = malloc(sizeof(JanetMailboxPair));
+    if (NULL == pair) {
+        JANET_OUT_OF_MEMORY;
+    }
+    pair->original = original;
+    janet_mailbox_ref(original, 1);
+    pair->newbox = janet_mailbox_create(1, 16);
+    return pair;
+}
+
+static void destroy_mailbox_pair(JanetMailboxPair *pair) {
+    janet_mailbox_ref(pair->original, -1);
+    janet_mailbox_ref(pair->newbox, -1);
+    free(pair);
+}
+
 /* Abstract waiting for timeout across windows/posix */
 typedef struct {
     int timedwait;
@@ -355,7 +379,7 @@ int janet_thread_receive(Janet *msg_out, double timeout) {
                 const uint8_t *nextItem = NULL;
                 Janet item = janet_unmarshal(
                                  msgbuf->data, msgbuf->count,
-                                 0, mailbox->decode, &nextItem);
+                                 0, janet_thread_get_decode(), &nextItem);
                 *msg_out = item;
 
                 /* Cleanup */
@@ -385,47 +409,43 @@ int janet_thread_receive(Janet *msg_out, double timeout) {
 
 static int janet_thread_getter(void *p, Janet key, Janet *out);
 
-static JanetAbstractType Thread_AT = {
+const JanetAbstractType janet_thread_type = {
     "core/thread",
     thread_gc,
     thread_mark,
     janet_thread_getter,
-    NULL,
+    JANET_ATEND_GET
-    NULL,
-    NULL,
-    NULL
 };
 
 static JanetThread *janet_make_thread(JanetMailbox *mailbox, JanetTable *encode) {
-    JanetThread *thread = janet_abstract(&Thread_AT, sizeof(JanetThread));
+    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, &Thread_AT);
+    return (JanetThread *) janet_getabstract(argv, n, &janet_thread_type);
 }
 
 /* Runs in new thread */
-static int thread_worker(JanetMailbox *mailbox) {
+static int thread_worker(JanetMailboxPair *pair) {
     JanetFiber *fiber = NULL;
     Janet out;
 
     /* Use the mailbox we were given */
-    janet_vm_mailbox = mailbox;
+    janet_vm_mailbox = pair->newbox;
+    janet_mailbox_ref(pair->newbox, 1);
 
     /* Init VM */
     janet_init();
 
     /* Get dictionaries for default encode/decode */
     JanetTable *encode = janet_get_core_table("make-image-dict");
-    mailbox->decode = janet_get_core_table("load-image-dict");
 
     /* Create parent thread */
-    JanetThread *parent = janet_make_thread(mailbox->parent, encode);
+    JanetThread *parent = janet_make_thread(pair->original, encode);
-    janet_mailbox_ref(mailbox->parent, -1);
-    mailbox->parent = NULL; /* only used to create the thread */
     Janet parentv = janet_wrap_abstract(parent);
 
     /* Unmarshal the function */
@@ -446,16 +466,18 @@ static int thread_worker(JanetMailbox *mailbox) {
     fiber = janet_fiber(func, 64, 1, argv);
     JanetSignal sig = janet_continue(fiber, janet_wrap_nil(), &out);
     if (sig != JANET_SIGNAL_OK) {
-        janet_eprintf("in thread %v: ", janet_wrap_abstract(janet_make_thread(mailbox, encode)));
+        janet_eprintf("in thread %v: ", janet_wrap_abstract(janet_make_thread(pair->newbox, encode)));
         janet_stacktrace(fiber, out);
     }
 
     /* 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;
@@ -464,12 +486,12 @@ error:
 #ifdef JANET_WINDOWS
 
 static DWORD WINAPI janet_create_thread_wrapper(LPVOID param) {
-    thread_worker((JanetMailbox *)param);
+    thread_worker((JanetMailboxPair *)param);
     return 0;
 }
 
-static int janet_thread_start_child(JanetThread *thread) {
+static int janet_thread_start_child(JanetMailboxPair *pair) {
-    HANDLE handle = CreateThread(NULL, 0, janet_create_thread_wrapper, thread->mailbox, 0, NULL);
+    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);
@@ -479,13 +501,13 @@ static int janet_thread_start_child(JanetThread *thread) {
 #else
 
 static void *janet_pthread_wrapper(void *param) {
-    thread_worker((JanetMailbox *)param);
+    thread_worker((JanetMailboxPair *)param);
     return NULL;
 }
 
-static int janet_thread_start_child(JanetThread *thread) {
+static int janet_thread_start_child(JanetMailboxPair *pair) {
     pthread_t handle;
-    int error = pthread_create(&handle, NULL, janet_pthread_wrapper, thread->mailbox);
+    int error = pthread_create(&handle, NULL, janet_pthread_wrapper, pair);
     if (error) {
         return 1;
     } else {
@@ -502,8 +524,10 @@ static int janet_thread_start_child(JanetThread *thread) {
 
 void janet_threads_init(void) {
     if (NULL == janet_vm_mailbox) {
-        janet_vm_mailbox = janet_mailbox_create(NULL, 1, 10);
+        janet_vm_mailbox = janet_mailbox_create(1, 10);
     }
+    janet_vm_thread_decode = NULL;
+    janet_vm_thread_current = NULL;
 }
 
 void janet_threads_deinit(void) {
@@ -512,6 +536,7 @@ void janet_threads_deinit(void) {
     janet_mailbox_ref_with_lock(janet_vm_mailbox, -1);
     janet_vm_mailbox = NULL;
     janet_vm_thread_current = NULL;
+    janet_vm_thread_decode = NULL;
 }
 
 /*
@@ -523,7 +548,6 @@ static Janet cfun_thread_current(int32_t argc, Janet *argv) {
     janet_fixarity(argc, 0);
     if (NULL == janet_vm_thread_current) {
         janet_vm_thread_current = janet_make_thread(janet_vm_mailbox, janet_get_core_table("make-image-dict"));
-        janet_mailbox_ref(janet_vm_mailbox, 1);
         janet_gcroot(janet_wrap_abstract(janet_vm_thread_current));
     }
     return janet_wrap_abstract(janet_vm_thread_current);
@@ -538,15 +562,11 @@ static Janet cfun_thread_new(int32_t argc, Janet *argv) {
         janet_panicf("bad slot #1, expected integer in range [1, 65535], got %d", cap);
     }
     JanetTable *encode = janet_get_core_table("make-image-dict");
-    JanetMailbox *mailbox = janet_mailbox_create(janet_vm_mailbox, 2, (uint16_t) cap);
 
-    /* one for created thread, one for ->parent reference in new mailbox */
+    JanetMailboxPair *pair = make_mailbox_pair(janet_vm_mailbox);
-    janet_mailbox_ref(janet_vm_mailbox, 2);
+    JanetThread *thread = janet_make_thread(pair->newbox, encode);
-
+    if (janet_thread_start_child(pair)) {
-    JanetThread *thread = janet_make_thread(mailbox, encode);
+        destroy_mailbox_pair(pair);
-    if (janet_thread_start_child(thread)) {
-        janet_mailbox_ref(mailbox, -1); /* mailbox reference */
-        janet_mailbox_ref(janet_vm_mailbox, -1); /* ->parent reference */
         janet_panic("could not start thread");
     }
 
@@ -644,7 +664,7 @@ static const JanetReg threadlib_cfuns[] = {
 /* Module entry point */
 void janet_lib_thread(JanetTable *env) {
     janet_core_cfuns(env, NULL, threadlib_cfuns);
-    janet_register_abstract_type(&Thread_AT);
+    janet_register_abstract_type(&janet_thread_type);
 }
 
 #endif

src/core/tuple.c

@@ -1,5 +1,5 @@
 /*
-* Copyright (c) 2019 Calvin Rose
+* Copyright (c) 2020 Calvin Rose
 *
 * Permission is hereby granted, free of charge, to any person obtaining a copy
 * of this software and associated documentation files (the "Software"), to
@@ -21,6 +21,7 @@
 */
 
 #ifndef JANET_AMALG
+#include "features.h"
 #include <janet.h>
 #include "symcache.h"
 #include "gc.h"
@@ -31,7 +32,7 @@
  * which should be filled with Janets. The memory will not be collected until
  * janet_tuple_end is called. */
 Janet *janet_tuple_begin(int32_t length) {
-    size_t size = sizeof(JanetTupleHead) + (length * sizeof(Janet));
+    size_t size = sizeof(JanetTupleHead) + ((size_t) length * sizeof(Janet));
     JanetTupleHead *head = janet_gcalloc(JANET_MEMORY_TUPLE, size);
     head->sm_line = -1;
     head->sm_column = -1;
@@ -48,7 +49,7 @@ const Janet *janet_tuple_end(Janet *tuple) {
 /* Build a tuple with n values */
 const Janet *janet_tuple_n(const Janet *values, int32_t n) {
     Janet *t = janet_tuple_begin(n);
-    memcpy(t, values, sizeof(Janet) * n);
+    safe_memcpy(t, values, sizeof(Janet) * n);
     return janet_tuple_end(t);
 }
 

src/core/typedarray.c

@@ -1,5 +1,5 @@
 /*
-* Copyright (c) 2019 Calvin Rose & contributors
+* Copyright (c) 2020 Calvin Rose & contributors
 *
 * Permission is hereby granted, free of charge, to any person obtaining a copy
 * of this software and associated documentation files (the "Software"), to
@@ -21,6 +21,7 @@
 */
 
 #ifndef JANET_AMALG
+#include "features.h"
 #include <janet.h>
 #include "util.h"
 #endif
@@ -110,7 +111,7 @@ static void *ta_buffer_unmarshal(JanetMarshalContext *ctx) {
     return buf;
 }
 
-static const JanetAbstractType ta_buffer_type = {
+const JanetAbstractType janet_ta_buffer_type = {
     "ta/buffer",
     ta_buffer_gc,
     NULL,
@@ -118,7 +119,7 @@ static const JanetAbstractType ta_buffer_type = {
     NULL,
     ta_buffer_marshal,
     ta_buffer_unmarshal,
-    NULL
+    JANET_ATEND_UNMARSHAL
 };
 
 static int ta_mark(void *p, size_t s) {
@@ -153,7 +154,7 @@ static void *ta_view_unmarshal(JanetMarshalContext *ctx) {
     offset = janet_unmarshal_size(ctx);
     buffer = janet_unmarshal_janet(ctx);
     if (!janet_checktype(buffer, JANET_ABSTRACT) ||
-            (janet_abstract_type(janet_unwrap_abstract(buffer)) != &ta_buffer_type)) {
+            (janet_abstract_type(janet_unwrap_abstract(buffer)) != &janet_ta_buffer_type)) {
         janet_panicf("expected typed array buffer");
     }
     view->buffer = (JanetTArrayBuffer *)janet_unwrap_abstract(buffer);
@@ -274,7 +275,7 @@ static void ta_setter(void *p, Janet key, Janet value) {
     }
 }
 
-static const JanetAbstractType ta_view_type = {
+const JanetAbstractType janet_ta_view_type = {
     "ta/view",
     NULL,
     ta_mark,
@@ -282,11 +283,11 @@ static const JanetAbstractType ta_view_type = {
     ta_setter,
     ta_view_marshal,
     ta_view_unmarshal,
-    NULL
+    JANET_ATEND_UNMARSHAL
 };
 
 JanetTArrayBuffer *janet_tarray_buffer(size_t size) {
-    JanetTArrayBuffer *buf = janet_abstract(&ta_buffer_type, sizeof(JanetTArrayBuffer));
+    JanetTArrayBuffer *buf = janet_abstract(&janet_ta_buffer_type, sizeof(JanetTArrayBuffer));
     ta_buffer_init(buf, size);
     return buf;
 }
@@ -298,13 +299,13 @@ JanetTArrayView *janet_tarray_view(
     size_t offset,
     JanetTArrayBuffer *buffer) {
 
-    JanetTArrayView *view = janet_abstract(&ta_view_type, sizeof(JanetTArrayView));
+    JanetTArrayView *view = janet_abstract(&janet_ta_view_type, sizeof(JanetTArrayView));
 
     if ((stride < 1) || (size < 1)) janet_panic("stride and size should be > 0");
     size_t buf_size = offset + ta_type_sizes[type] * ((size - 1) * stride + 1);
 
     if (NULL == buffer) {
-        buffer = janet_abstract(&ta_buffer_type, sizeof(JanetTArrayBuffer));
+        buffer = janet_abstract(&janet_ta_buffer_type, sizeof(JanetTArrayBuffer));
         ta_buffer_init(buffer, buf_size);
     }
 
@@ -324,15 +325,15 @@ JanetTArrayView *janet_tarray_view(
 }
 
 JanetTArrayBuffer *janet_gettarray_buffer(const Janet *argv, int32_t n) {
-    return janet_getabstract(argv, n, &ta_buffer_type);
+    return janet_getabstract(argv, n, &janet_ta_buffer_type);
 }
 
 JanetTArrayView *janet_gettarray_any(const Janet *argv, int32_t n) {
-    return janet_getabstract(argv, n, &ta_view_type);
+    return janet_getabstract(argv, n, &janet_ta_view_type);
 }
 
 JanetTArrayView *janet_gettarray_view(const Janet *argv, int32_t n, JanetTArrayType type) {
-    JanetTArrayView *view = janet_getabstract(argv, n, &ta_view_type);
+    JanetTArrayView *view = janet_getabstract(argv, n, &janet_ta_view_type);
     if (view->type != type) {
         janet_panicf("bad slot #%d, expected typed array of type %s, got %v",
                      n, ta_type_names[type], argv[n]);
@@ -358,7 +359,7 @@ static Janet cfun_typed_array_new(int32_t argc, Janet *argv) {
                          4, argv[4]);
         }
         void *p = janet_unwrap_abstract(argv[4]);
-        if (janet_abstract_type(p) == &ta_view_type) {
+        if (janet_abstract_type(p) == &janet_ta_view_type) {
             JanetTArrayView *view = (JanetTArrayView *)p;
             offset = (view->buffer->data - view->as.u8) + offset * ta_type_sizes[view->type];
             stride *= view->stride;
@@ -374,7 +375,7 @@ static Janet cfun_typed_array_new(int32_t argc, Janet *argv) {
 static JanetTArrayView *ta_is_view(Janet x) {
     if (!janet_checktype(x, JANET_ABSTRACT)) return NULL;
     void *abst = janet_unwrap_abstract(x);
-    if (janet_abstract_type(abst) != &ta_view_type) return NULL;
+    if (janet_abstract_type(abst) != &janet_ta_view_type) return NULL;
     return (JanetTArrayView *)abst;
 }
 
@@ -395,7 +396,7 @@ static Janet cfun_typed_array_size(int32_t argc, Janet *argv) {
     if ((view = ta_is_view(argv[0]))) {
         return janet_wrap_number((double) view->size);
     }
-    JanetTArrayBuffer *buf = (JanetTArrayBuffer *)janet_getabstract(argv, 0, &ta_buffer_type);
+    JanetTArrayBuffer *buf = (JanetTArrayBuffer *)janet_getabstract(argv, 0, &janet_ta_buffer_type);
     return janet_wrap_number((double) buf->size);
 }
 
@@ -432,7 +433,7 @@ static Janet cfun_typed_array_properties(int32_t argc, Janet *argv) {
 
 static Janet cfun_typed_array_slice(int32_t argc, Janet *argv) {
     janet_arity(argc, 1, 3);
-    JanetTArrayView *src = janet_getabstract(argv, 0, &ta_view_type);
+    JanetTArrayView *src = janet_getabstract(argv, 0, &janet_ta_view_type);
     JanetRange range;
     int32_t length = (int32_t)src->size;
     if (argc == 1) {
@@ -460,9 +461,9 @@ static Janet cfun_typed_array_slice(int32_t argc, Janet *argv) {
 
 static Janet cfun_typed_array_copy_bytes(int32_t argc, Janet *argv) {
     janet_arity(argc, 4, 5);
-    JanetTArrayView *src = janet_getabstract(argv, 0, &ta_view_type);
+    JanetTArrayView *src = janet_getabstract(argv, 0, &janet_ta_view_type);
     size_t index_src = janet_getsize(argv, 1);
-    JanetTArrayView *dst = janet_getabstract(argv, 2, &ta_view_type);
+    JanetTArrayView *dst = janet_getabstract(argv, 2, &janet_ta_view_type);
     size_t index_dst = janet_getsize(argv, 3);
     size_t count = (argc == 5) ? janet_getsize(argv, 4) : 1;
     size_t src_atom_size = ta_type_sizes[src->type];
@@ -487,9 +488,9 @@ static Janet cfun_typed_array_copy_bytes(int32_t argc, Janet *argv) {
 
 static Janet cfun_typed_array_swap_bytes(int32_t argc, Janet *argv) {
     janet_arity(argc, 4, 5);
-    JanetTArrayView *src = janet_getabstract(argv, 0, &ta_view_type);
+    JanetTArrayView *src = janet_getabstract(argv, 0, &janet_ta_view_type);
     size_t index_src = janet_getsize(argv, 1);
-    JanetTArrayView *dst = janet_getabstract(argv, 2, &ta_view_type);
+    JanetTArrayView *dst = janet_getabstract(argv, 2, &janet_ta_view_type);
     size_t index_dst = janet_getsize(argv, 3);
     size_t count = (argc == 5) ? janet_getsize(argv, 4) : 1;
     size_t src_atom_size = ta_type_sizes[src->type];
@@ -573,8 +574,8 @@ static JanetMethod tarray_view_methods[] = {
 /* Module entry point */
 void janet_lib_typed_array(JanetTable *env) {
     janet_core_cfuns(env, NULL, ta_cfuns);
-    janet_register_abstract_type(&ta_buffer_type);
+    janet_register_abstract_type(&janet_ta_buffer_type);
-    janet_register_abstract_type(&ta_view_type);
+    janet_register_abstract_type(&janet_ta_view_type);
 }
 
 #endif

src/core/util.c

@@ -1,5 +1,5 @@
 /*
-* Copyright (c) 2019 Calvin Rose
+* Copyright (c) 2020 Calvin Rose
 *
 * Permission is hereby granted, free of charge, to any person obtaining a copy
 * of this software and associated documentation files (the "Software"), to
@@ -20,15 +20,16 @@
 * IN THE SOFTWARE.
 */
 
-#include <inttypes.h>
-
 #ifndef JANET_AMALG
+#include "features.h"
 #include <janet.h>
 #include "util.h"
 #include "state.h"
 #include "gc.h"
 #endif
 
+#include <inttypes.h>
+
 /* Base 64 lookup table for digits */
 const char janet_base64[65] =
     "0123456789"
@@ -93,7 +94,7 @@ const char *const janet_status_names[16] = {
     "alive"
 };
 
-/* Calculate hash for string */
+#ifdef JANET_NO_PRF
 
 int32_t janet_string_calchash(const uint8_t *str, int32_t len) {
     const uint8_t *end = str + len;
@@ -103,6 +104,118 @@ int32_t janet_string_calchash(const uint8_t *str, int32_t len) {
     return (int32_t) hash;
 }
 
+#else
+
+/*
+  Public domain siphash implementation sourced from:
+
+  https://raw.githubusercontent.com/veorq/SipHash/master/halfsiphash.c
+
+  We have made a few alterations, such as hardcoding the output size
+  and then removing dead code.
+*/
+#define cROUNDS 2
+#define dROUNDS 4
+
+#define ROTL(x, b) (uint32_t)(((x) << (b)) | ((x) >> (32 - (b))))
+
+#define U8TO32_LE(p)                                                           \
+    (((uint32_t)((p)[0])) | ((uint32_t)((p)[1]) << 8) |                        \
+     ((uint32_t)((p)[2]) << 16) | ((uint32_t)((p)[3]) << 24))
+
+#define SIPROUND                                                               \
+    do {                                                                       \
+        v0 += v1;                                                              \
+        v1 = ROTL(v1, 5);                                                      \
+        v1 ^= v0;                                                              \
+        v0 = ROTL(v0, 16);                                                     \
+        v2 += v3;                                                              \
+        v3 = ROTL(v3, 8);                                                      \
+        v3 ^= v2;                                                              \
+        v0 += v3;                                                              \
+        v3 = ROTL(v3, 7);                                                      \
+        v3 ^= v0;                                                              \
+        v2 += v1;                                                              \
+        v1 = ROTL(v1, 13);                                                     \
+        v1 ^= v2;                                                              \
+        v2 = ROTL(v2, 16);                                                     \
+    } while (0)
+
+static uint32_t halfsiphash(const uint8_t *in, const size_t inlen, const uint8_t *k) {
+
+    uint32_t v0 = 0;
+    uint32_t v1 = 0;
+    uint32_t v2 = UINT32_C(0x6c796765);
+    uint32_t v3 = UINT32_C(0x74656462);
+    uint32_t k0 = U8TO32_LE(k);
+    uint32_t k1 = U8TO32_LE(k + 4);
+    uint32_t m;
+    int i;
+    const uint8_t *end = in + inlen - (inlen % sizeof(uint32_t));
+    const int left = inlen & 3;
+    uint32_t b = ((uint32_t)inlen) << 24;
+    v3 ^= k1;
+    v2 ^= k0;
+    v1 ^= k1;
+    v0 ^= k0;
+
+    for (; in != end; in += 4) {
+        m = U8TO32_LE(in);
+        v3 ^= m;
+
+        for (i = 0; i < cROUNDS; ++i)
+            SIPROUND;
+
+        v0 ^= m;
+    }
+
+    switch (left) {
+        case 3:
+            b |= ((uint32_t)in[2]) << 16;
+        /* fallthrough */
+        case 2:
+            b |= ((uint32_t)in[1]) << 8;
+        /* fallthrough */
+        case 1:
+            b |= ((uint32_t)in[0]);
+            break;
+        case 0:
+            break;
+    }
+
+    v3 ^= b;
+
+    for (i = 0; i < cROUNDS; ++i)
+        SIPROUND;
+
+    v0 ^= b;
+
+    v2 ^= 0xff;
+
+    for (i = 0; i < dROUNDS; ++i)
+        SIPROUND;
+
+    b = v1 ^ v3;
+    return b;
+}
+/* end of siphash */
+
+static uint8_t hash_key[JANET_HASH_KEY_SIZE] = {0};
+
+void janet_init_hash_key(uint8_t new_key[JANET_HASH_KEY_SIZE]) {
+    memcpy(hash_key, new_key, sizeof(hash_key));
+}
+
+/* Calculate hash for string */
+
+int32_t janet_string_calchash(const uint8_t *str, int32_t len) {
+    uint32_t hash;
+    hash = halfsiphash(str, len, hash_key);
+    return (int32_t)hash;
+}
+
+#endif
+
 /* Computes hash of an array of values */
 int32_t janet_array_calchash(const Janet *array, int32_t len) {
     const Janet *end = array + len;
@@ -135,6 +248,12 @@ int32_t janet_tablen(int32_t n) {
     return n + 1;
 }
 
+/* Avoid some undefined behavior that was common in the code base. */
+void safe_memcpy(void *dest, const void *src, size_t len) {
+    if (!len) return;
+    memcpy(dest, src, len);
+}
+
 /* Helper to find a value in a Janet struct or table. Returns the bucket
  * containing the key, or the first empty bucket if there is no such key. */
 const JanetKV *janet_dict_find(const JanetKV *buckets, int32_t cap, Janet key) {
@@ -262,69 +381,63 @@ void janet_var(JanetTable *env, const char *name, Janet val, const char *doc) {
 
 /* Load many cfunctions at once */
 void janet_cfuns(JanetTable *env, const char *regprefix, const JanetReg *cfuns) {
+    uint8_t *longname_buffer = NULL;
+    size_t prefixlen = 0;
+    size_t bufsize = 0;
+    if (NULL != regprefix) {
+        prefixlen = strlen(regprefix);
+        bufsize = prefixlen + 256;
+        longname_buffer = malloc(bufsize);
+        if (NULL == longname_buffer) {
+            JANET_OUT_OF_MEMORY;
+        }
+        safe_memcpy(longname_buffer, regprefix, prefixlen);
+        longname_buffer[prefixlen] = '/';
+        prefixlen++;
+    }
     while (cfuns->name) {
-        Janet name = janet_csymbolv(cfuns->name);
+        Janet name;
-        Janet longname = name;
+        if (NULL != regprefix) {
-        if (regprefix) {
-            int32_t reglen = 0;
             int32_t nmlen = 0;
-            while (regprefix[reglen]) reglen++;
             while (cfuns->name[nmlen]) nmlen++;
-            int32_t symlen = reglen + 1 + nmlen;
+            int32_t totallen = (int32_t) prefixlen + nmlen;
-            uint8_t *longname_buffer = malloc(symlen);
+            if ((size_t) totallen > bufsize) {
-            memcpy(longname_buffer, regprefix, reglen);
+                bufsize = (size_t)(totallen) + 128;
-            longname_buffer[reglen] = '/';
+                longname_buffer = realloc(longname_buffer, bufsize);
-            memcpy(longname_buffer + reglen + 1, cfuns->name, nmlen);
+                if (NULL == longname_buffer) {
-            longname = janet_wrap_symbol(janet_symbol(longname_buffer, symlen));
+                    JANET_OUT_OF_MEMORY;
-            free(longname_buffer);
+                }
+            }
+            safe_memcpy(longname_buffer + prefixlen, cfuns->name, nmlen);
+            name = janet_wrap_symbol(janet_symbol(longname_buffer, totallen));
+        } else {
+            name = janet_csymbolv(cfuns->name);
         }
         Janet fun = janet_wrap_cfunction(cfuns->cfun);
         janet_def(env, cfuns->name, fun, cfuns->documentation);
-        janet_table_put(janet_vm_registry, fun, longname);
+        janet_table_put(janet_vm_registry, fun, name);
         cfuns++;
     }
+    free(longname_buffer);
 }
 
 /* Abstract type introspection */
 
-static const JanetAbstractType type_wrap = {
-    "core/type-info",
-    NULL,
-    NULL,
-    NULL,
-    NULL,
-    NULL,
-    NULL,
-    NULL
-};
-
-typedef struct {
-    const JanetAbstractType *at;
-} JanetAbstractTypeWrap;
-
 void janet_register_abstract_type(const JanetAbstractType *at) {
-    JanetAbstractTypeWrap *abstract = (JanetAbstractTypeWrap *)
-                                      janet_abstract(&type_wrap, sizeof(JanetAbstractTypeWrap));
-    abstract->at = at;
     Janet sym = janet_csymbolv(at->name);
-    if (!(janet_checktype(janet_table_get(janet_vm_registry, sym), JANET_NIL))) {
+    if (!(janet_checktype(janet_table_get(janet_vm_abstract_registry, sym), JANET_NIL))) {
         janet_panicf("cannot register abstract type %s, "
                      "a type with the same name exists", at->name);
     }
-    janet_table_put(janet_vm_registry, sym, janet_wrap_abstract(abstract));
+    janet_table_put(janet_vm_abstract_registry, sym, janet_wrap_pointer((void *) at));
 }
 
 const JanetAbstractType *janet_get_abstract_type(Janet key) {
-    Janet twrap = janet_table_get(janet_vm_registry, key);
+    Janet wrapped = janet_table_get(janet_vm_abstract_registry, key);
-    if (janet_checktype(twrap, JANET_NIL)) {
+    if (janet_checktype(wrapped, JANET_NIL)) {
         return NULL;
     }
-    if (!janet_checktype(twrap, JANET_ABSTRACT) ||
+    return (JanetAbstractType *)(janet_unwrap_pointer(wrapped));
-            (janet_abstract_type(janet_unwrap_abstract(twrap)) != &type_wrap)) {
-        janet_panic("expected abstract type");
-    }
-    JanetAbstractTypeWrap *w = (JanetAbstractTypeWrap *)janet_unwrap_abstract(twrap);
-    return w->at;
 }
 
 #ifndef JANET_BOOTSTRAP

src/core/util.h

@@ -1,5 +1,5 @@
 /*
-* Copyright (c) 2019 Calvin Rose
+* Copyright (c) 2020 Calvin Rose
 *
 * Permission is hereby granted, free of charge, to any person obtaining a copy
 * of this software and associated documentation files (the "Software"), to
@@ -23,13 +23,14 @@
 #ifndef JANET_UTIL_H_defined
 #define JANET_UTIL_H_defined
 
-#include <stdio.h>
-#include <errno.h>
-
 #ifndef JANET_AMALG
+#include "features.h"
 #include <janet.h>
 #endif
 
+#include <stdio.h>
+#include <errno.h>
+
 /* Handle runtime errors */
 #ifndef janet_exit
 #include <stdio.h>
@@ -67,6 +68,7 @@ int32_t janet_array_calchash(const Janet *array, int32_t len);
 int32_t janet_kv_calchash(const JanetKV *kvs, int32_t len);
 int32_t janet_string_calchash(const uint8_t *str, int32_t len);
 int32_t janet_tablen(int32_t n);
+void safe_memcpy(void *dest, const void *src, size_t len);
 void janet_buffer_push_types(JanetBuffer *buffer, int types);
 const JanetKV *janet_dict_find(const JanetKV *buckets, int32_t cap, Janet key);
 Janet janet_dict_get(const JanetKV *buckets, int32_t cap, Janet key);

src/core/value.c

@@ -1,5 +1,5 @@
 /*
-* Copyright (c) 2019 Calvin Rose
+* Copyright (c) 2020 Calvin Rose
 *
 * Permission is hereby granted, free of charge, to any person obtaining a copy
 * of this software and associated documentation files (the "Software"), to
@@ -21,6 +21,8 @@
 */
 
 #ifndef JANET_AMALG
+#include "features.h"
+#include "util.h"
 #include <janet.h>
 #endif
 
@@ -28,6 +30,87 @@
  * Define a number of functions that can be used internally on ANY Janet.
  */
 
+Janet janet_next(Janet ds, Janet key) {
+    JanetType t = janet_type(ds);
+    switch (t) {
+        default:
+            janet_panicf("expected iterable type, got %v", ds);
+        case JANET_TABLE:
+        case JANET_STRUCT: {
+            const JanetKV *start;
+            int32_t cap;
+            if (t == JANET_TABLE) {
+                JanetTable *tab = janet_unwrap_table(ds);
+                cap = tab->capacity;
+                start = tab->data;
+            } else {
+                JanetStruct st = janet_unwrap_struct(ds);
+                cap = janet_struct_capacity(st);
+                start = st;
+            }
+            const JanetKV *end = start + cap;
+            const JanetKV *kv = janet_checktype(key, JANET_NIL)
+                                ? start
+                                : janet_dict_find(start, cap, key) + 1;
+            while (kv < end) {
+                if (!janet_checktype(kv->key, JANET_NIL)) return kv->key;
+                kv++;
+            }
+            break;
+        }
+        case JANET_STRING:
+        case JANET_KEYWORD:
+        case JANET_SYMBOL:
+        case JANET_BUFFER:
+        case JANET_ARRAY:
+        case JANET_TUPLE: {
+            int32_t i;
+            if (janet_checktype(key, JANET_NIL)) {
+                i = 0;
+            } else if (janet_checkint(key)) {
+                i = janet_unwrap_integer(key) + 1;
+            } else {
+                break;
+            }
+            int32_t len;
+            if (t == JANET_BUFFER) {
+                len = janet_unwrap_buffer(ds)->count;
+            } else if (t == JANET_ARRAY) {
+                len = janet_unwrap_array(ds)->count;
+            } else if (t == JANET_TUPLE) {
+                len = janet_tuple_length(janet_unwrap_tuple(ds));
+            } else {
+                len = janet_string_length(janet_unwrap_string(ds));
+            }
+            if (i < len && i >= 0) {
+                return janet_wrap_integer(i);
+            }
+            break;
+        }
+        case JANET_ABSTRACT: {
+            JanetAbstract abst = janet_unwrap_abstract(ds);
+            const JanetAbstractType *at = janet_abstract_type(abst);
+            if (NULL == at->next) break;
+            return at->next(abst, key);
+        }
+    }
+    return janet_wrap_nil();
+}
+
+/* Compare two abstract values */
+static int janet_compare_abstract(JanetAbstract xx, JanetAbstract yy) {
+    if (xx == yy) return 0;
+    const JanetAbstractType *xt = janet_abstract_type(xx);
+    const JanetAbstractType *yt = janet_abstract_type(yy);
+    if (xt != yt) {
+        return xt > yt ? 1 : -1;
+    }
+    if (xt->compare == NULL) {
+        return xx > yy ? 1 : -1;
+    }
+    return xt->compare(xx, yy);
+}
+
 /* Check if two values are equal. This is strict equality with no conversion. */
 int janet_equals(Janet x, Janet y) {
     int result = 0;
@@ -53,6 +136,9 @@ int janet_equals(Janet x, Janet y) {
             case JANET_STRUCT:
                 result = janet_struct_equal(janet_unwrap_struct(x), janet_unwrap_struct(y));
                 break;
+            case JANET_ABSTRACT:
+                result = !janet_compare_abstract(janet_unwrap_abstract(x), janet_unwrap_abstract(y));
+                break;
             default:
                 /* compare pointers */
                 result = (janet_unwrap_pointer(x) == janet_unwrap_pointer(y));
@@ -83,6 +169,15 @@ int32_t janet_hash(Janet x) {
         case JANET_STRUCT:
             hash = janet_struct_hash(janet_unwrap_struct(x));
             break;
+        case JANET_ABSTRACT: {
+            JanetAbstract xx = janet_unwrap_abstract(x);
+            const JanetAbstractType *at = janet_abstract_type(xx);
+            if (at->hash != NULL) {
+                hash = at->hash(xx, janet_abstract_size(xx));
+                break;
+            }
+        }
+        /* fallthrough */
         default:
             /* TODO - test performance with different hash functions */
             if (sizeof(double) == sizeof(void *)) {
@@ -104,7 +199,7 @@ int32_t janet_hash(Janet x) {
 
 /* Compares x to y. If they are equal returns 0. If x is less, returns -1.
  * If y is less, returns 1. All types are comparable
- * and should have strict ordering. */
+ * and should have strict ordering, excepts NaNs. */
 int janet_compare(Janet x, Janet y) {
     if (janet_type(x) == janet_type(y)) {
         switch (janet_type(x)) {
@@ -112,20 +207,13 @@ int janet_compare(Janet x, Janet y) {
                 return 0;
             case JANET_BOOLEAN:
                 return janet_unwrap_boolean(x) - janet_unwrap_boolean(y);
-            case JANET_NUMBER:
+            case JANET_NUMBER: {
-                /* Check for NaNs to ensure total order */
+                double xx = janet_unwrap_number(x);
-                if (janet_unwrap_number(x) != janet_unwrap_number(x))
+                double yy = janet_unwrap_number(y);
-                    return janet_unwrap_number(y) != janet_unwrap_number(y)
+                return xx == yy
-                           ? 0
+                       ? 0
-                           : -1;
+                       : (xx < yy) ? -1 : 1;
-                if (janet_unwrap_number(y) != janet_unwrap_number(y))
+            }
-                    return 1;
-
-                if (janet_unwrap_number(x) == janet_unwrap_number(y)) {
-                    return 0;
-                } else {
-                    return janet_unwrap_number(x) > janet_unwrap_number(y) ? 1 : -1;
-                }
             case JANET_STRING:
             case JANET_SYMBOL:
             case JANET_KEYWORD:
@@ -134,6 +222,8 @@ int janet_compare(Janet x, Janet y) {
                 return janet_tuple_compare(janet_unwrap_tuple(x), janet_unwrap_tuple(y));
             case JANET_STRUCT:
                 return janet_struct_compare(janet_unwrap_struct(x), janet_unwrap_struct(y));
+            case JANET_ABSTRACT:
+                return janet_compare_abstract(janet_unwrap_abstract(x), janet_unwrap_abstract(y));
             default:
                 if (janet_unwrap_string(x) == janet_unwrap_string(y)) {
                     return 0;

src/core/vector.c

@@ -1,5 +1,5 @@
 /*
-* Copyright (c) 2019 Calvin Rose
+* Copyright (c) 2020 Calvin Rose
 *
 * Permission is hereby granted, free of charge, to any person obtaining a copy
 * of this software and associated documentation files (the "Software"), to
@@ -21,6 +21,7 @@
 */
 
 #ifndef JANET_AMALG
+#include "features.h"
 #include "vector.h"
 #include "util.h"
 #endif
@@ -40,18 +41,14 @@ void *janet_v_grow(void *v, int32_t increment, int32_t itemsize) {
 /* Convert a buffer to normal allocated memory (forget capacity) */
 void *janet_v_flattenmem(void *v, int32_t itemsize) {
     int32_t *p;
-    int32_t sizen;
     if (NULL == v) return NULL;
-    sizen = itemsize * janet_v__cnt(v);
+    size_t size = (size_t) itemsize * janet_v__cnt(v);
-    p = malloc(sizen);
+    p = malloc(size);
     if (NULL != p) {
-        memcpy(p, v, sizen);
+        safe_memcpy(p, v, size);
         return p;
     } else {
-        {
+        JANET_OUT_OF_MEMORY;
-            JANET_OUT_OF_MEMORY;
-        }
-        return NULL;
     }
 }
 

src/core/vector.h

@@ -1,5 +1,5 @@
 /*
-* Copyright (c) 2019 Calvin Rose
+* Copyright (c) 2020 Calvin Rose
 *
 * Permission is hereby granted, free of charge, to any person obtaining a copy
 * of this software and associated documentation files (the "Software"), to
@@ -24,6 +24,7 @@
 #define JANET_VECTOR_H_defined
 
 #ifndef JANET_AMALG
+#include "features.h"
 #include <janet.h>
 #endif
 

src/core/vm.c

@@ -1,5 +1,5 @@
 /*
-* Copyright (c) 2019 Calvin Rose
+* Copyright (c) 2020 Calvin Rose
 *
 * Permission is hereby granted, free of charge, to any person obtaining a copy
 * of this software and associated documentation files (the "Software"), to
@@ -21,6 +21,7 @@
 */
 
 #ifndef JANET_AMALG
+#include "features.h"
 #include <janet.h>
 #include "state.h"
 #include "fiber.h"
@@ -29,9 +30,12 @@
 #include "util.h"
 #endif
 
+#include <math.h>
+
 /* VM state */
 JANET_THREAD_LOCAL JanetTable *janet_vm_core_env;
 JANET_THREAD_LOCAL JanetTable *janet_vm_registry;
+JANET_THREAD_LOCAL JanetTable *janet_vm_abstract_registry;
 JANET_THREAD_LOCAL int janet_vm_stackn = 0;
 JANET_THREAD_LOCAL JanetFiber *janet_vm_fiber = NULL;
 JANET_THREAD_LOCAL Janet *janet_vm_return_reg = NULL;
@@ -117,12 +121,11 @@ JANET_THREAD_LOCAL jmp_buf *janet_vm_jmp_buf = NULL;
 #define vm_binop_immediate(op)\
     {\
         Janet op1 = stack[B];\
-        vm_assert_type(op1, JANET_NUMBER);\
         if (!janet_checktype(op1, JANET_NUMBER)) {\
             vm_commit();\
             Janet _argv[2] = { op1, janet_wrap_number(CS) };\
             stack[A] = janet_mcall(#op, 2, _argv);\
-            vm_pcnext();\
+            vm_checkgc_pcnext();\
         } else {\
             double x1 = janet_unwrap_number(op1);\
             stack[A] = janet_wrap_number(x1 op CS);\
@@ -132,10 +135,16 @@ JANET_THREAD_LOCAL jmp_buf *janet_vm_jmp_buf = NULL;
 #define _vm_bitop_immediate(op, type1)\
     {\
         Janet op1 = stack[B];\
-        vm_assert_type(op1, JANET_NUMBER);\
+        if (!janet_checktype(op1, JANET_NUMBER)) {\
-        type1 x1 = (type1) janet_unwrap_integer(op1);\
+            vm_commit();\
-        stack[A] = janet_wrap_integer(x1 op CS);\
+            Janet _argv[2] = { op1, janet_wrap_number(CS) };\
-        vm_pcnext();\
+            stack[A] = janet_mcall(#op, 2, _argv);\
+            vm_checkgc_pcnext();\
+        } else {\
+            type1 x1 = (type1) janet_unwrap_integer(op1);\
+            stack[A] = janet_wrap_integer(x1 op CS);\
+            vm_pcnext();\
+        }\
     }
 #define vm_bitop_immediate(op) _vm_bitop_immediate(op, int32_t);
 #define vm_bitopu_immediate(op) _vm_bitop_immediate(op, uint32_t);
@@ -143,71 +152,110 @@ JANET_THREAD_LOCAL jmp_buf *janet_vm_jmp_buf = NULL;
     {\
         Janet op1 = stack[B];\
         Janet op2 = stack[C];\
-        if (!janet_checktype(op1, JANET_NUMBER)) {\
+        if (janet_checktype(op1, JANET_NUMBER) && janet_checktype(op2, JANET_NUMBER)) {\
-            vm_commit();\
-            Janet _argv[2] = { op1, op2 };\
-            stack[A] = janet_mcall(#op, 2, _argv);\
-            vm_pcnext();\
-        } else {\
-            vm_assert_type(op1, JANET_NUMBER);\
-            vm_assert_type(op2, JANET_NUMBER);\
             double x1 = janet_unwrap_number(op1);\
             double x2 = janet_unwrap_number(op2);\
             stack[A] = wrap(x1 op x2);\
             vm_pcnext();\
+        } else {\
+            vm_commit();\
+            stack[A] = janet_binop_call(#op, "r" #op, op1, op2);\
+            vm_checkgc_pcnext();\
         }\
     }
 #define vm_binop(op) _vm_binop(op, janet_wrap_number)
-#define vm_numcomp(op) _vm_binop(op, janet_wrap_boolean)
 #define _vm_bitop(op, type1)\
     {\
         Janet op1 = stack[B];\
         Janet op2 = stack[C];\
-        vm_assert_type(op1, JANET_NUMBER);\
+        if (janet_checktype(op1, JANET_NUMBER) && janet_checktype(op2, JANET_NUMBER)) {\
-        vm_assert_type(op2, JANET_NUMBER);\
+            type1 x1 = (type1) janet_unwrap_integer(op1);\
-        type1 x1 = (type1) janet_unwrap_integer(op1);\
+            int32_t x2 = janet_unwrap_integer(op2);\
-        int32_t x2 = janet_unwrap_integer(op2);\
+            stack[A] = janet_wrap_integer(x1 op x2);\
-        stack[A] = janet_wrap_integer(x1 op x2);\
+            vm_pcnext();\
-        vm_pcnext();\
+        } else {\
+            vm_commit();\
+            stack[A] = janet_binop_call(#op, "r" #op, op1, op2);\
+            vm_checkgc_pcnext();\
+        }\
     }
 #define vm_bitop(op) _vm_bitop(op, int32_t)
 #define vm_bitopu(op) _vm_bitop(op, uint32_t)
+#define vm_compop(op) \
+    {\
+        Janet op1 = stack[B];\
+        Janet op2 = stack[C];\
+        if (janet_checktype(op1, JANET_NUMBER) && janet_checktype(op2, JANET_NUMBER)) {\
+            double x1 = janet_unwrap_number(op1);\
+            double x2 = janet_unwrap_number(op2);\
+            stack[A] = janet_wrap_boolean(x1 op x2);\
+            vm_pcnext();\
+        } else {\
+            vm_commit();\
+            stack[A] = janet_wrap_boolean(janet_compare(op1, op2) op 0);\
+            vm_checkgc_pcnext();\
+        }\
+    }
 
 /* Trace a function call */
-static void vm_do_trace(JanetFunction *func) {
+static void vm_do_trace(JanetFunction *func, int32_t argc, const Janet *argv) {
-    Janet *stack = janet_vm_fiber->data + janet_vm_fiber->stackstart;
-    int32_t start = janet_vm_fiber->stackstart;
-    int32_t end = janet_vm_fiber->stacktop;
-    int32_t argc = end - start;
     if (func->def->name) {
         janet_printf("trace (%S", func->def->name);
     } else {
         janet_printf("trace (%p", janet_wrap_function(func));
     }
     for (int32_t i = 0; i < argc; i++) {
-        janet_printf(" %p", stack[i]);
+        janet_printf(" %p", argv[i]);
     }
-    printf(")\n");
+    janet_printf(")\n");
 }
 
-/* Call a non function type */
+/* Invoke a method once we have looked it up */
+static Janet janet_method_invoke(Janet method, int32_t argc, Janet *argv) {
+    switch (janet_type(method)) {
+        case JANET_CFUNCTION:
+            return (janet_unwrap_cfunction(method))(argc, argv);
+        case JANET_FUNCTION: {
+            JanetFunction *fun = janet_unwrap_function(method);
+            return janet_call(fun, argc, argv);
+        }
+        case JANET_ABSTRACT: {
+            JanetAbstract abst = janet_unwrap_abstract(method);
+            const JanetAbstractType *at = janet_abstract_type(abst);
+            if (NULL != at->call) {
+                return at->call(abst, argc, argv);
+            }
+        }
+        /* fallthrough */
+        case JANET_STRING:
+        case JANET_BUFFER:
+        case JANET_TABLE:
+        case JANET_STRUCT:
+        case JANET_ARRAY:
+        case JANET_TUPLE: {
+            if (argc != 1) {
+                janet_panicf("%v called with %d arguments, possibly expected 1", method, argc);
+            }
+            return janet_in(method, argv[0]);
+        }
+        default: {
+            if (argc != 1) {
+                janet_panicf("%v called with %d arguments, possibly expected 1", method, argc);
+            }
+            return janet_in(argv[0], method);
+        }
+    }
+}
+
+/* Call a non function type from a JOP_CALL or JOP_TAILCALL instruction.
+ * Assumes that the arguments are on the fiber stack. */
 static Janet call_nonfn(JanetFiber *fiber, Janet callee) {
-    int32_t argn = fiber->stacktop - fiber->stackstart;
+    int32_t argc = fiber->stacktop - fiber->stackstart;
-    Janet ds, key;
-    if (argn != 1) janet_panicf("%v called with %d arguments, possibly expected 1", callee, argn);
-    if (janet_checktypes(callee, JANET_TFLAG_INDEXED | JANET_TFLAG_DICTIONARY |
-                         JANET_TFLAG_STRING | JANET_TFLAG_BUFFER | JANET_TFLAG_ABSTRACT)) {
-        ds = callee;
-        key = fiber->data[fiber->stackstart];
-    } else {
-        ds = fiber->data[fiber->stackstart];
-        key = callee;
-    }
     fiber->stacktop = fiber->stackstart;
-    return janet_in(ds, key);
+    return janet_method_invoke(callee, argc, fiber->data + fiber->stacktop);
 }
 
-/* Get a callable from a keyword method name and check ensure that it is valid. */
+/* Get a callable from a keyword method name and ensure that it is valid. */
 static Janet resolve_method(Janet name, JanetFiber *fiber) {
     int32_t argc = fiber->stacktop - fiber->stackstart;
     if (argc < 1) janet_panicf("method call (%v) takes at least 1 argument, got 0", name);
@@ -217,8 +265,33 @@ static Janet resolve_method(Janet name, JanetFiber *fiber) {
     return callee;
 }
 
+/* Lookup method on value x */
+static Janet janet_method_lookup(Janet x, const char *name) {
+    Janet kname = janet_ckeywordv(name);
+    return janet_get(x, kname);
+}
+
+/* Call a method first on the righthand side, and then on the left hand side with a prefix */
+static Janet janet_binop_call(const char *lmethod, const char *rmethod, Janet lhs, Janet rhs) {
+    Janet lm = janet_method_lookup(lhs, lmethod);
+    if (janet_checktype(lm, JANET_NIL)) {
+        /* Invert order for rmethod */
+        Janet lr = janet_method_lookup(rhs, rmethod);
+        Janet argv[2] = { rhs, lhs };
+        if (janet_checktype(lr, JANET_NIL)) {
+            janet_panicf("could not find method :%s for %v, or :%s for %v",
+                         lmethod, lhs,
+                         rmethod, rhs);
+        }
+        return janet_method_invoke(lr, 2, argv);
+    } else {
+        Janet argv[2] = { lhs, rhs };
+        return janet_method_invoke(lm, 2, argv);
+    }
+}
+
 /* Interpreter main loop */
-static JanetSignal run_vm(JanetFiber *fiber, Janet in, JanetFiberStatus status) {
+static JanetSignal run_vm(JanetFiber *fiber, Janet in) {
 
     /* opcode -> label lookup if using clang/GCC */
 #ifdef JANET_USE_COMPUTED_GOTOS
@@ -235,6 +308,8 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in, JanetFiberStatus status)
         &&label_JOP_MULTIPLY,
         &&label_JOP_DIVIDE_IMMEDIATE,
         &&label_JOP_DIVIDE,
+        &&label_JOP_MODULO,
+        &&label_JOP_REMAINDER,
         &&label_JOP_BAND,
         &&label_JOP_BOR,
         &&label_JOP_BXOR,
@@ -250,6 +325,8 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in, JanetFiberStatus status)
         &&label_JOP_JUMP,
         &&label_JOP_JUMP_IF,
         &&label_JOP_JUMP_IF_NOT,
+        &&label_JOP_JUMP_IF_NIL,
+        &&label_JOP_JUMP_IF_NOT_NIL,
         &&label_JOP_GREATER_THAN,
         &&label_JOP_GREATER_THAN_IMMEDIATE,
         &&label_JOP_LESS_THAN,
@@ -288,13 +365,9 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in, JanetFiberStatus status)
         &&label_JOP_MAKE_TABLE,
         &&label_JOP_MAKE_TUPLE,
         &&label_JOP_MAKE_BRACKET_TUPLE,
-        &&label_JOP_NUMERIC_LESS_THAN,
+        &&label_JOP_GREATER_THAN_EQUAL,
-        &&label_JOP_NUMERIC_LESS_THAN_EQUAL,
+        &&label_JOP_LESS_THAN_EQUAL,
-        &&label_JOP_NUMERIC_GREATER_THAN,
+        &&label_JOP_NEXT,
-        &&label_JOP_NUMERIC_GREATER_THAN_EQUAL,
-        &&label_JOP_NUMERIC_EQUAL,
-        &&label_unknown_op,
-        &&label_unknown_op,
         &&label_unknown_op,
         &&label_unknown_op,
         &&label_unknown_op,
@@ -487,29 +560,38 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in, JanetFiberStatus status)
     register JanetFunction *func;
     vm_restore();
 
-    /* Only should be hit if the fiber is either waiting for a child, or
+    if (fiber->flags & JANET_FIBER_DID_LONGJUMP) {
-     * waiting to be resumed. In those cases, use input and increment pc. We
+        if (janet_fiber_frame(fiber)->func == NULL) {
-     * DO NOT use input when resuming a fiber that has been interrupted at a
+            /* Inside a c function */
-     * breakpoint. */
+            janet_fiber_popframe(fiber);
-    uint8_t first_opcode;
+            vm_restore();
-    if (status != JANET_STATUS_NEW &&
+        }
-            ((*pc & 0xFF) == JOP_SIGNAL ||
+        /* Check if we were at a tail call instruction. If so, do implicit return */
-             (*pc & 0xFF) == JOP_PROPAGATE ||
+        if ((*pc & 0xFF) == JOP_TAILCALL) {
-             (*pc & 0xFF) == JOP_RESUME)) {
+            /* Tail call resume */
-        stack[A] = in;
+            int entrance_frame = janet_stack_frame(stack)->flags & JANET_STACKFRAME_ENTRANCE;
-        pc++;
+            janet_fiber_popframe(fiber);
-        first_opcode = *pc & 0xFF;
+            if (entrance_frame) {
-    } else if (status == JANET_STATUS_DEBUG) {
+                fiber->flags &= ~JANET_FIBER_FLAG_MASK;
-        first_opcode = *pc & 0x7F;
+                vm_return(JANET_SIGNAL_OK, in);
-    } else {
+            }
-        first_opcode = *pc & 0xFF;
+            vm_restore();
+        }
     }
 
+    if (!(fiber->flags & JANET_FIBER_RESUME_NO_USEVAL)) stack[A] = in;
+    if (!(fiber->flags & JANET_FIBER_RESUME_NO_SKIP)) pc++;
+
+    uint8_t first_opcode = *pc & ((fiber->flags & JANET_FIBER_BREAKPOINT) ? 0x7F : 0xFF);
+
+    fiber->flags &= ~JANET_FIBER_FLAG_MASK;
+
     /* Main interpreter loop. Semantically is a switch on
      * (*pc & 0xFF) inside of an infinite loop. */
     VM_START();
 
     VM_DEFAULT();
+    fiber->flags |= JANET_FIBER_BREAKPOINT | JANET_FIBER_RESUME_NO_USEVAL | JANET_FIBER_RESUME_NO_SKIP;
     vm_return(JANET_SIGNAL_DEBUG, janet_wrap_nil());
 
     VM_OP(JOP_NOOP)
@@ -557,27 +639,43 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in, JanetFiberStatus status)
     VM_OP(JOP_MULTIPLY)
     vm_binop(*);
 
-    VM_OP(JOP_NUMERIC_LESS_THAN)
-    vm_numcomp( <);
-
-    VM_OP(JOP_NUMERIC_LESS_THAN_EQUAL)
-    vm_numcomp( <=);
-
-    VM_OP(JOP_NUMERIC_GREATER_THAN)
-    vm_numcomp( >);
-
-    VM_OP(JOP_NUMERIC_GREATER_THAN_EQUAL)
-    vm_numcomp( >=);
-
-    VM_OP(JOP_NUMERIC_EQUAL)
-    vm_numcomp( ==);
-
     VM_OP(JOP_DIVIDE_IMMEDIATE)
     vm_binop_immediate( /);
 
     VM_OP(JOP_DIVIDE)
     vm_binop( /);
 
+    VM_OP(JOP_MODULO) {
+        Janet op1 = stack[B];
+        Janet op2 = stack[C];
+        if (janet_checktype(op1, JANET_NUMBER) && janet_checktype(op2, JANET_NUMBER)) {
+            double x1 = janet_unwrap_number(op1);
+            double x2 = janet_unwrap_number(op2);
+            double intres = x2 * floor(x1 / x2);
+            stack[A] = janet_wrap_number(x1 - intres);
+            vm_pcnext();
+        } else {
+            vm_commit();
+            stack[A] = janet_binop_call("mod", "rmod", op1, op2);
+            vm_checkgc_pcnext();
+        }
+    }
+
+    VM_OP(JOP_REMAINDER) {
+        Janet op1 = stack[B];
+        Janet op2 = stack[C];
+        if (janet_checktype(op1, JANET_NUMBER) && janet_checktype(op2, JANET_NUMBER)) {
+            double x1 = janet_unwrap_number(op1);
+            double x2 = janet_unwrap_number(op2);
+            stack[A] = janet_wrap_number(fmod(x1, x2));
+            vm_pcnext();
+        } else {
+            vm_commit();
+            stack[A] = janet_binop_call("%", "r%", op1, op2);
+            vm_checkgc_pcnext();
+        }
+    }
+
     VM_OP(JOP_BAND)
     vm_bitop(&);
 
@@ -640,17 +738,37 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in, JanetFiberStatus status)
     }
     vm_next();
 
+    VM_OP(JOP_JUMP_IF_NIL)
+    if (janet_checktype(stack[A], JANET_NIL)) {
+        pc += ES;
+    } else {
+        pc++;
+    }
+    vm_next();
+
+    VM_OP(JOP_JUMP_IF_NOT_NIL)
+    if (janet_checktype(stack[A], JANET_NIL)) {
+        pc++;
+    } else {
+        pc += ES;
+    }
+    vm_next();
+
     VM_OP(JOP_LESS_THAN)
-    stack[A] = janet_wrap_boolean(janet_compare(stack[B], stack[C]) < 0);
+    vm_compop( <);
-    vm_pcnext();
+
+    VM_OP(JOP_LESS_THAN_EQUAL)
+    vm_compop( <=);
 
     VM_OP(JOP_LESS_THAN_IMMEDIATE)
     stack[A] = janet_wrap_boolean(janet_unwrap_integer(stack[B]) < CS);
     vm_pcnext();
 
     VM_OP(JOP_GREATER_THAN)
-    stack[A] = janet_wrap_boolean(janet_compare(stack[B], stack[C]) > 0);
+    vm_compop( >);
-    vm_pcnext();
+
+    VM_OP(JOP_GREATER_THAN_EQUAL)
+    vm_compop( >=);
 
     VM_OP(JOP_GREATER_THAN_IMMEDIATE)
     stack[A] = janet_wrap_boolean(janet_unwrap_integer(stack[B]) > CS);
@@ -668,6 +786,10 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in, JanetFiberStatus status)
     stack[A] = janet_wrap_integer(janet_compare(stack[B], stack[C]));
     vm_pcnext();
 
+    VM_OP(JOP_NEXT)
+    stack[A] = janet_next(stack[B], stack[C]);
+    vm_pcnext();
+
     VM_OP(JOP_LOAD_NIL)
     stack[D] = janet_wrap_nil();
     vm_pcnext();
@@ -735,7 +857,7 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in, JanetFiberStatus status)
         vm_assert(defindex < func->def->defs_length, "invalid funcdef");
         fd = func->def->defs[defindex];
         elen = fd->environments_length;
-        fn = janet_gcalloc(JANET_MEMORY_FUNCTION, sizeof(JanetFunction) + (elen * sizeof(JanetFuncEnv *)));
+        fn = janet_gcalloc(JANET_MEMORY_FUNCTION, sizeof(JanetFunction) + ((size_t) elen * sizeof(JanetFuncEnv *)));
         fn->def = fd;
         {
             int32_t i;
@@ -799,7 +921,9 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in, JanetFiberStatus status)
         }
         if (janet_checktype(callee, JANET_FUNCTION)) {
             func = janet_unwrap_function(callee);
-            if (func->gc.flags & JANET_FUNCFLAG_TRACE) vm_do_trace(func);
+            if (func->gc.flags & JANET_FUNCFLAG_TRACE) {
+                vm_do_trace(func, fiber->stacktop - fiber->stackstart, stack);
+            }
             janet_stack_frame(stack)->pc = pc;
             if (janet_fiber_funcframe(fiber, func)) {
                 int32_t n = fiber->stacktop - fiber->stackstart;
@@ -836,7 +960,9 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in, JanetFiberStatus status)
         }
         if (janet_checktype(callee, JANET_FUNCTION)) {
             func = janet_unwrap_function(callee);
-            if (func->gc.flags & JANET_FUNCFLAG_TRACE) vm_do_trace(func);
+            if (func->gc.flags & JANET_FUNCFLAG_TRACE) {
+                vm_do_trace(func, fiber->stacktop - fiber->stackstart, stack);
+            }
             if (janet_fiber_funcframe_tail(fiber, func)) {
                 janet_stack_frame(fiber->data + fiber->frame)->pc = pc;
                 int32_t n = fiber->stacktop - fiber->stackstart;
@@ -873,8 +999,9 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in, JanetFiberStatus status)
         JanetFiber *child = janet_unwrap_fiber(stack[B]);
         fiber->child = child;
         JanetSignal sig = janet_continue(child, stack[C], &retreg);
-        if (sig != JANET_SIGNAL_OK && !(child->flags & (1 << sig)))
+        if (sig != JANET_SIGNAL_OK && !(child->flags & (1 << sig))) {
             vm_return(sig, retreg);
+        }
         fiber->child = NULL;
         stack = fiber->data + fiber->frame;
         stack[A] = retreg;
@@ -898,18 +1025,22 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in, JanetFiberStatus status)
             janet_panicf("cannot propagate from fiber with status :%s",
                          janet_status_names[sub_status]);
         }
-        janet_vm_fiber->child = f;
+        fiber->child = f;
         vm_return((int) sub_status, stack[B]);
     }
 
     VM_OP(JOP_PUT)
     vm_commit();
+    fiber->flags |= JANET_FIBER_RESUME_NO_USEVAL;
     janet_put(stack[A], stack[B], stack[C]);
+    fiber->flags &= ~JANET_FIBER_RESUME_NO_USEVAL;
     vm_checkgc_pcnext();
 
     VM_OP(JOP_PUT_INDEX)
     vm_commit();
+    fiber->flags |= JANET_FIBER_RESUME_NO_USEVAL;
     janet_putindex(stack[A], C, stack[B]);
+    fiber->flags &= ~JANET_FIBER_RESUME_NO_USEVAL;
     vm_checkgc_pcnext();
 
     VM_OP(JOP_IN)
@@ -1079,6 +1210,11 @@ Janet janet_call(JanetFunction *fun, int32_t argc, const Janet *argv) {
     if (janet_vm_stackn >= JANET_RECURSION_GUARD)
         janet_panic("C stack recursed too deeply");
 
+    /* Tracing */
+    if (fun->gc.flags & JANET_FUNCFLAG_TRACE) {
+        vm_do_trace(fun, argc, argv);
+    }
+
     /* Push frame */
     janet_fiber_pushn(janet_vm_fiber, argv, argc);
     if (janet_fiber_funcframe(janet_vm_fiber, fun)) {
@@ -1091,9 +1227,8 @@ Janet janet_call(JanetFunction *fun, int32_t argc, const Janet *argv) {
     int handle = janet_gclock();
 
     /* Run vm */
-    JanetSignal signal = run_vm(janet_vm_fiber,
+    janet_vm_fiber->flags |= JANET_FIBER_RESUME_NO_USEVAL | JANET_FIBER_RESUME_NO_SKIP;
-                                janet_wrap_nil(),
+    JanetSignal signal = run_vm(janet_vm_fiber, janet_wrap_nil());
-                                JANET_STATUS_ALIVE);
 
     /* Teardown */
     janet_vm_stackn = oldn;
@@ -1117,6 +1252,7 @@ JanetSignal janet_continue(JanetFiber *fiber, Janet in, Janet *out) {
     }
     if (old_status == JANET_STATUS_ALIVE ||
             old_status == JANET_STATUS_DEAD ||
+            (old_status >= JANET_STATUS_USER0 && old_status <= JANET_STATUS_USER4) ||
             old_status == JANET_STATUS_ERROR) {
         const uint8_t *str = janet_formatc("cannot resume fiber with status :%s",
                                            janet_status_names[old_status]);
@@ -1137,6 +1273,19 @@ JanetSignal janet_continue(JanetFiber *fiber, Janet in, Janet *out) {
         fiber->child = NULL;
     }
 
+    /* Handle new fibers being resumed with a non-nil value */
+    if (old_status == JANET_STATUS_NEW && !janet_checktype(in, JANET_NIL)) {
+        Janet *stack = fiber->data + fiber->frame;
+        JanetFunction *func = janet_stack_frame(stack)->func;
+        if (func) {
+            if (func->def->arity > 0) {
+                stack[0] = in;
+            } else if (func->def->flags & JANET_FUNCDEF_FLAG_VARARG) {
+                stack[0] = janet_wrap_tuple(janet_tuple_n(&in, 1));
+            }
+        }
+    }
+
     /* Save global state */
     int32_t oldn = janet_vm_stackn++;
     int handle = janet_vm_gc_suspend;
@@ -1153,14 +1302,16 @@ JanetSignal janet_continue(JanetFiber *fiber, Janet in, Janet *out) {
 
     /* Run loop */
     JanetSignal signal;
+    int jmpsig;
 #if defined(JANET_BSD) || defined(JANET_APPLE)
-    if (_setjmp(buf)) {
+    jmpsig = _setjmp(buf);
 #else
-    if (setjmp(buf)) {
+    jmpsig = setjmp(buf);
 #endif
-        signal = JANET_SIGNAL_ERROR;
+    if (jmpsig) {
+        signal = (JanetSignal) jmpsig;
     } else {
-        signal = run_vm(fiber, in, old_status);
+        signal = run_vm(fiber, in);
     }
 
     /* Tear down fiber */
@@ -1201,30 +1352,12 @@ 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");
     /* Find method */
-    Janet method;
+    Janet method = janet_method_lookup(argv[0], name);
-    if (janet_checktype(argv[0], JANET_ABSTRACT)) {
+    if (janet_checktype(method, JANET_NIL)) {
-        void *abst = janet_unwrap_abstract(argv[0]);
-        JanetAbstractType *type = (JanetAbstractType *)janet_abstract_type(abst);
-        if (!type->get || !(type->get)(abst, janet_ckeywordv(name), &method))
-            janet_panicf("abstract value %v does not implement :%s", argv[0], name);
-    } else if (janet_checktype(argv[0], JANET_TABLE)) {
-        JanetTable *table = janet_unwrap_table(argv[0]);
-        method = janet_table_get(table, janet_ckeywordv(name));
-    } else if (janet_checktype(argv[0], JANET_STRUCT)) {
-        const JanetKV *st = janet_unwrap_struct(argv[0]);
-        method = janet_struct_get(st, janet_ckeywordv(name));
-    } else {
         janet_panicf("could not find method :%s for %v", name, argv[0]);
     }
     /* Invoke method */
-    if (janet_checktype(method, JANET_CFUNCTION)) {
+    return janet_method_invoke(method, argc, argv);
-        return (janet_unwrap_cfunction(method))(argc, argv);
-    } else if (janet_checktype(method, JANET_FUNCTION)) {
-        JanetFunction *fun = janet_unwrap_function(method);
-        return janet_call(fun, argc, argv);
-    } else {
-        janet_panicf("method %s has unexpected value %v", name, method);
-    }
 }
 
 /* Setup VM */
@@ -1248,7 +1381,9 @@ int janet_init(void) {
     janet_scratch_cap = 0;
     /* Initialize registry */
     janet_vm_registry = janet_table(0);
+    janet_vm_abstract_registry = janet_table(0);
     janet_gcroot(janet_wrap_table(janet_vm_registry));
+    janet_gcroot(janet_wrap_table(janet_vm_abstract_registry));
     /* Core env */
     janet_vm_core_env = NULL;
     /* Seed RNG */
@@ -1269,6 +1404,7 @@ void janet_deinit(void) {
     janet_vm_root_count = 0;
     janet_vm_root_capacity = 0;
     janet_vm_registry = NULL;
+    janet_vm_abstract_registry = NULL;
     janet_vm_core_env = NULL;
 #ifdef JANET_THREADS
     janet_threads_deinit();

src/core/wrap.c

@@ -1,5 +1,5 @@
 /*
-* Copyright (c) 2019 Calvin Rose
+* Copyright (c) 2020 Calvin Rose
 *
 * Permission is hereby granted, free of charge, to any person obtaining a copy
 * of this software and associated documentation files (the "Software"), to
@@ -21,8 +21,9 @@
 */
 
 #ifndef JANET_AMALG
-#include <math.h>
+#include "features.h"
 #include <janet.h>
+#include <math.h>
 #include "util.h"
 #include "state.h"
 #endif
@@ -161,8 +162,8 @@ Janet(janet_wrap_number)(double x) {
 
 void *janet_memalloc_empty(int32_t count) {
     int32_t i;
-    void *mem = malloc(count * sizeof(JanetKV));
+    void *mem = malloc((size_t) count * sizeof(JanetKV));
-    janet_vm_next_collection += count * sizeof(JanetKV);
+    janet_vm_next_collection += (size_t) count * sizeof(JanetKV);
     if (NULL == mem) {
         JANET_OUT_OF_MEMORY;
     }

src/include/janet.h

@@ -1,5 +1,5 @@
 /*
-* Copyright (c) 2019 Calvin Rose
+* Copyright (c) 2020 Calvin Rose
 *
 * Permission is hereby granted, free of charge, to any person obtaining a copy
 * of this software and associated documentation files (the "Software"), to
@@ -49,7 +49,6 @@ extern "C" {
 #if defined(__FreeBSD__) || defined(__DragonFly__) || \
     defined(__NetBSD__) || defined(__OpenBSD__)
 #define JANET_BSD 1
-#define _BSD_SOURCE 1
 #endif
 
 /* Check for Mac */
@@ -76,7 +75,6 @@ extern "C" {
     || defined(sun) || defined(__sun) /* Solaris */ \
     || defined(unix) || defined(__unix) || defined(__unix__)
 #define JANET_POSIX 1
-#define _POSIX_C_SOURCE 200112L
 #elif defined(__EMSCRIPTEN__)
 #define JANET_WEB 1
 #elif defined(WIN32) || defined(_WIN32)
@@ -99,7 +97,14 @@ extern "C" {
 #endif
 
 /* Check big endian */
-#if defined(__MIPSEB__) /* MIPS 32-bit */ \
+#if defined(__LITTLE_ENDIAN__) || \
+    (defined(__BYTE_ORDER__) && (__BYTE_ORDER__ == __ORDER_LITTLE_ENDIAN__))
+/* If we know the target is LE, always use that - e.g. ppc64 little endian
+ * defines the __LITTLE_ENDIAN__ macro in the ABI spec, so we can rely
+ * on that and if that's not defined, fall back to big endian assumption
+ */
+#define JANET_LITTLE_ENDIAN 1
+#elif defined(__MIPSEB__) /* MIPS 32-bit */ \
     || defined(__ppc__) || defined(__PPC__) /* CPU(PPC) - PowerPC 32-bit */ \
     || defined(__powerpc__) || defined(__powerpc) || defined(__POWERPC__) \
     || defined(_M_PPC) || defined(__PPC) \
@@ -256,6 +261,11 @@ typedef struct {
 #include <stddef.h>
 #include <stdio.h>
 
+#ifdef JANET_BSD
+int _setjmp(jmp_buf);
+JANET_NO_RETURN void _longjmp(jmp_buf, int);
+#endif
+
 /* Names of all of the types */
 JANET_API extern const char *const janet_type_names[16];
 JANET_API extern const char *const janet_signal_names[14];
@@ -653,7 +663,7 @@ struct Janet {
 #define janet_type(x) ((x).type)
 #define janet_checktype(x, t) ((x).type == (t))
 #define janet_truthy(x) \
-    ((x).type != JANET_NIL && ((x).type != JANET_BOOLEAN || ((x).as.integer & 0x1)))
+    ((x).type != JANET_NIL && ((x).type != JANET_BOOLEAN || ((x).as.u64 & 0x1)))
 
 #define janet_unwrap_struct(x) ((const JanetKV *)(x).as.pointer)
 #define janet_unwrap_tuple(x) ((const Janet *)(x).as.pointer)
@@ -678,8 +688,8 @@ JANET_API int janet_checkint(Janet x);
 JANET_API int janet_checkint64(Janet x);
 JANET_API int janet_checksize(Janet x);
 JANET_API JanetAbstract janet_checkabstract(Janet x, const JanetAbstractType *at);
-#define janet_checkintrange(x) ((x) == (int32_t)(x))
+#define janet_checkintrange(x) ((x) >= INT32_MIN && (x) <= INT32_MAX && (x) == (int32_t)(x))
-#define janet_checkint64range(x) ((x) == (int64_t)(x))
+#define janet_checkint64range(x) ((x) >= INT64_MIN && (x) <= INT64_MAX && (x) == (int64_t)(x))
 #define janet_unwrap_integer(x) ((int32_t) janet_unwrap_number(x))
 #define janet_wrap_integer(x) janet_wrap_number((int32_t)(x))
 
@@ -693,28 +703,6 @@ struct JanetGCObject {
     JanetGCObject *next;
 };
 
-/* Fiber signal masks. */
-#define JANET_FIBER_MASK_ERROR 2
-#define JANET_FIBER_MASK_DEBUG 4
-#define JANET_FIBER_MASK_YIELD 8
-
-#define JANET_FIBER_MASK_USER0 (16 << 0)
-#define JANET_FIBER_MASK_USER1 (16 << 1)
-#define JANET_FIBER_MASK_USER2 (16 << 2)
-#define JANET_FIBER_MASK_USER3 (16 << 3)
-#define JANET_FIBER_MASK_USER4 (16 << 4)
-#define JANET_FIBER_MASK_USER5 (16 << 5)
-#define JANET_FIBER_MASK_USER6 (16 << 6)
-#define JANET_FIBER_MASK_USER7 (16 << 7)
-#define JANET_FIBER_MASK_USER8 (16 << 8)
-#define JANET_FIBER_MASK_USER9 (16 << 9)
-
-#define JANET_FIBER_MASK_USERN(N) (16 << (N))
-#define JANET_FIBER_MASK_USER 0x3FF0
-
-#define JANET_FIBER_STATUS_MASK 0xFF0000
-#define JANET_FIBER_STATUS_OFFSET 16
-
 /* A lightweight green thread in janet. Does not correspond to
  * operating system threads. */
 struct JanetFiber {
@@ -824,6 +812,7 @@ struct JanetAbstractHead {
 #define JANET_FUNCDEF_FLAG_HASENVS 0x400000
 #define JANET_FUNCDEF_FLAG_HASSOURCEMAP 0x800000
 #define JANET_FUNCDEF_FLAG_STRUCTARG 0x1000000
+#define JANET_FUNCDEF_FLAG_HASCLOBITSET 0x2000000
 #define JANET_FUNCDEF_FLAG_TAG 0xFFFF
 
 /* Source mapping structure for a bytecode instruction */
@@ -839,6 +828,7 @@ struct JanetFuncDef {
     Janet *constants;
     JanetFuncDef **defs;
     uint32_t *bytecode;
+    uint32_t *closure_bitset; /* Bit set indicating which slots can be referenced by closures. */
 
     /* Various debug information */
     JanetSourceMapping *sourcemap;
@@ -906,8 +896,9 @@ struct JanetParser {
     int flag;
 };
 
+/* A context for marshaling and unmarshaling abstract types */
 typedef struct {
-    void *m_state;  /* void* to not expose MarshalState ?*/
+    void *m_state;
     void *u_state;
     int flags;
     const uint8_t *data;
@@ -924,8 +915,29 @@ struct JanetAbstractType {
     void (*marshal)(void *p, JanetMarshalContext *ctx);
     void *(*unmarshal)(JanetMarshalContext *ctx);
     void (*tostring)(void *p, JanetBuffer *buffer);
+    int (*compare)(void *lhs, void *rhs);
+    int32_t (*hash)(void *p, size_t len);
+    Janet(*next)(void *p, Janet key);
+    Janet(*call)(void *p, int32_t argc, Janet *argv);
 };
 
+/* Some macros to let us add extra types to JanetAbstract types without
+ * needing to changing native modules that declare them as static const
+ * structures. If more fields are added, these macros are modified to include
+ * default values (usually NULL). This silences missing field warnings. */
+#define JANET_ATEND_NAME        NULL,JANET_ATEND_GC
+#define JANET_ATEND_GC          NULL,JANET_ATEND_GCMARK
+#define JANET_ATEND_GCMARK      NULL,JANET_ATEND_GET
+#define JANET_ATEND_GET         NULL,JANET_ATEND_PUT
+#define JANET_ATEND_PUT         NULL,JANET_ATEND_MARSHAL
+#define JANET_ATEND_MARSHAL     NULL,JANET_ATEND_UNMARSHAL
+#define JANET_ATEND_UNMARSHAL   NULL,JANET_ATEND_TOSTRING
+#define JANET_ATEND_TOSTRING    NULL,JANET_ATEND_COMPARE
+#define JANET_ATEND_COMPARE     NULL,JANET_ATEND_HASH
+#define JANET_ATEND_HASH        NULL,JANET_ATEND_NEXT
+#define JANET_ATEND_NEXT        NULL,JANET_ATEND_CALL
+#define JANET_ATEND_CALL
+
 struct JanetReg {
     const char *name;
     JanetCFunction cfun;
@@ -963,6 +975,12 @@ struct JanetRNG {
     uint32_t counter;
 };
 
+typedef struct JanetFile JanetFile;
+struct JanetFile {
+    FILE *file;
+    int flags;
+};
+
 /* Thread types */
 #ifdef JANET_THREADS
 typedef struct JanetThread JanetThread;
@@ -1022,6 +1040,8 @@ enum JanetOpCode {
     JOP_MULTIPLY,
     JOP_DIVIDE_IMMEDIATE,
     JOP_DIVIDE,
+    JOP_MODULO,
+    JOP_REMAINDER,
     JOP_BAND,
     JOP_BOR,
     JOP_BXOR,
@@ -1037,6 +1057,8 @@ enum JanetOpCode {
     JOP_JUMP,
     JOP_JUMP_IF,
     JOP_JUMP_IF_NOT,
+    JOP_JUMP_IF_NIL,
+    JOP_JUMP_IF_NOT_NIL,
     JOP_GREATER_THAN,
     JOP_GREATER_THAN_IMMEDIATE,
     JOP_LESS_THAN,
@@ -1075,11 +1097,9 @@ enum JanetOpCode {
     JOP_MAKE_TABLE,
     JOP_MAKE_TUPLE,
     JOP_MAKE_BRACKET_TUPLE,
-    JOP_NUMERIC_LESS_THAN,
+    JOP_GREATER_THAN_EQUAL,
-    JOP_NUMERIC_LESS_THAN_EQUAL,
+    JOP_LESS_THAN_EQUAL,
-    JOP_NUMERIC_GREATER_THAN,
+    JOP_NEXT,
-    JOP_NUMERIC_GREATER_THAN_EQUAL,
-    JOP_NUMERIC_EQUAL,
     JOP_INSTRUCTION_COUNT
 };
 
@@ -1091,6 +1111,7 @@ extern enum JanetInstructionType janet_instructions[JOP_INSTRUCTION_COUNT];
 /***** START SECTION MAIN *****/
 
 /* Parsing */
+extern JANET_API const JanetAbstractType janet_parser_type;
 JANET_API void janet_parser_init(JanetParser *parser);
 JANET_API void janet_parser_deinit(JanetParser *parser);
 JANET_API void janet_parser_consume(JanetParser *parser, uint8_t c);
@@ -1152,6 +1173,7 @@ JANET_API void janet_debug_find(
     JanetString source, int32_t line, int32_t column);
 
 /* RNG */
+extern JANET_API const JanetAbstractType janet_rng_type;
 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);
@@ -1310,6 +1332,7 @@ JANET_API int janet_gcunroot(Janet root);
 JANET_API int janet_gcunrootall(Janet root);
 JANET_API int janet_gclock(void);
 JANET_API void janet_gcunlock(int handle);
+JANET_API void janet_gcpressure(size_t s);
 
 /* Functions */
 JANET_API JanetFuncDef *janet_funcdef_alloc(void);
@@ -1322,12 +1345,17 @@ JANET_API int janet_verify(JanetFuncDef *def);
 JANET_API JanetBuffer *janet_pretty(JanetBuffer *buffer, int depth, int flags, Janet x);
 
 /* Misc */
+#ifndef JANET_NO_PRF
+#define JANET_HASH_KEY_SIZE 16
+JANET_API void janet_init_hash_key(uint8_t key[JANET_HASH_KEY_SIZE]);
+#endif
 JANET_API int janet_equals(Janet x, Janet y);
 JANET_API int32_t janet_hash(Janet x);
 JANET_API int janet_compare(Janet x, Janet y);
 JANET_API int janet_cstrcmp(JanetString str, const char *other);
 JANET_API Janet janet_in(Janet ds, Janet key);
 JANET_API Janet janet_get(Janet ds, Janet key);
+JANET_API Janet janet_next(Janet ds, Janet key);
 JANET_API Janet janet_getindex(Janet ds, int32_t index);
 JANET_API int32_t janet_length(Janet x);
 JANET_API Janet janet_lengthv(Janet x);
@@ -1350,10 +1378,12 @@ JANET_API Janet janet_mcall(const char *name, int32_t argc, Janet *argv);
 JANET_API void janet_stacktrace(JanetFiber *fiber, Janet err);
 
 /* Scratch Memory API */
-typedef void (*ScratchFinalizer)(void *);
+typedef void (*JanetScratchFinalizer)(void *);
+
 JANET_API void *janet_smalloc(size_t size);
 JANET_API void *janet_srealloc(void *mem, size_t size);
-JANET_API void janet_sfinalizer(void *mem, ScratchFinalizer finalizer);
+JANET_API void *janet_scalloc(size_t nmemb, size_t size);
+JANET_API void janet_sfinalizer(void *mem, JanetScratchFinalizer finalizer);
 JANET_API void janet_sfree(void *mem);
 
 /* C Library helpers */
@@ -1376,15 +1406,16 @@ JANET_API Janet janet_resolve_core(const char *name);
 
 /* Allow setting entry name for static libraries */
 #ifndef JANET_ENTRY_NAME
-#define JANET_ENTRY_NAME _janet_init
-#endif
-
 #define JANET_MODULE_ENTRY \
     JANET_API JanetBuildConfig _janet_mod_config(void) { \
         return janet_config_current(); \
     } \
-    JANET_API void JANET_ENTRY_NAME
+    JANET_API void _janet_init
+#else
+#define JANET_MODULE_ENTRY JANET_API void JANET_ENTRY_NAME
+#endif
 
+JANET_NO_RETURN JANET_API void janet_signalv(JanetSignal signal, Janet message);
 JANET_NO_RETURN JANET_API void janet_panicv(Janet message);
 JANET_NO_RETURN JANET_API void janet_panic(const char *message);
 JANET_NO_RETURN JANET_API void janet_panics(JanetString message);
@@ -1455,6 +1486,8 @@ JANET_API JanetArray *janet_optarray(const Janet *argv, int32_t argc, int32_t n,
 JANET_API Janet janet_dyn(const char *name);
 JANET_API void janet_setdyn(const char *name, Janet value);
 
+extern JANET_API const JanetAbstractType janet_file_type;
+
 #define JANET_FILE_WRITE 1
 #define JANET_FILE_READ 2
 #define JANET_FILE_APPEND 4
@@ -1465,8 +1498,11 @@ JANET_API void janet_setdyn(const char *name, Janet value);
 #define JANET_FILE_SERIALIZABLE 128
 #define JANET_FILE_PIPED 256
 
+JANET_API Janet janet_makefile(FILE *f, int flags);
 JANET_API FILE *janet_getfile(const Janet *argv, int32_t n, int *flags);
 JANET_API FILE *janet_dynfile(const char *name, FILE *def);
+JANET_API JanetAbstract janet_checkfile(Janet j);
+JANET_API FILE *janet_unwrapfile(Janet j, int *flags);
 
 /* Marshal API */
 JANET_API void janet_marshal_size(JanetMarshalContext *ctx, size_t value);
@@ -1489,8 +1525,52 @@ JANET_API JanetAbstract janet_unmarshal_abstract(JanetMarshalContext *ctx, size_
 JANET_API void janet_register_abstract_type(const JanetAbstractType *at);
 JANET_API const JanetAbstractType *janet_get_abstract_type(Janet key);
 
+#ifdef JANET_PEG
+
+extern JANET_API const JanetAbstractType janet_peg_type;
+
+/* opcodes for peg vm */
+typedef enum {
+    RULE_LITERAL,      /* [len, bytes...] */
+    RULE_NCHAR,        /* [n] */
+    RULE_NOTNCHAR,     /* [n] */
+    RULE_RANGE,        /* [lo | hi << 16 (1 word)] */
+    RULE_SET,          /* [bitmap (8 words)] */
+    RULE_LOOK,         /* [offset, rule] */
+    RULE_CHOICE,       /* [len, rules...] */
+    RULE_SEQUENCE,     /* [len, rules...] */
+    RULE_IF,           /* [rule_a, rule_b (b if a)] */
+    RULE_IFNOT,        /* [rule_a, rule_b (b if not a)] */
+    RULE_NOT,          /* [rule] */
+    RULE_BETWEEN,      /* [lo, hi, rule] */
+    RULE_GETTAG,       /* [searchtag, tag] */
+    RULE_CAPTURE,      /* [rule, tag] */
+    RULE_POSITION,     /* [tag] */
+    RULE_ARGUMENT,     /* [argument-index, tag] */
+    RULE_CONSTANT,     /* [constant, tag] */
+    RULE_ACCUMULATE,   /* [rule, tag] */
+    RULE_GROUP,        /* [rule, tag] */
+    RULE_REPLACE,      /* [rule, constant, tag] */
+    RULE_MATCHTIME,    /* [rule, constant, tag] */
+    RULE_ERROR,        /* [rule] */
+    RULE_DROP,         /* [rule] */
+    RULE_BACKMATCH,    /* [tag] */
+} JanetPegOpcode;
+
+typedef struct {
+    uint32_t *bytecode;
+    Janet *constants;
+    size_t bytecode_len;
+    uint32_t num_constants;
+} JanetPeg;
+
+#endif
+
 #ifdef JANET_TYPED_ARRAY
 
+extern JANET_API const JanetAbstractType janet_ta_view_type;
+extern JANET_API const JanetAbstractType janet_ta_buffer_type;
+
 typedef enum {
     JANET_TARRAY_TYPE_U8,
     JANET_TARRAY_TYPE_S8,
@@ -1541,6 +1621,9 @@ JanetTArrayView *janet_gettarray_any(const Janet *argv, int32_t n);
 
 #ifdef JANET_INT_TYPES
 
+extern JANET_API const JanetAbstractType janet_s64_type;
+extern JANET_API const JanetAbstractType janet_u64_type;
+
 typedef enum {
     JANET_INT_NONE,
     JANET_INT_S64,
@@ -1557,6 +1640,15 @@ JANET_API int janet_scan_uint64(const uint8_t *str, int32_t len, uint64_t *out);
 
 #endif
 
+#ifdef JANET_THREADS
+
+extern JANET_API const JanetAbstractType janet_thread_type;
+
+JANET_API int janet_thread_receive(Janet *msg_out, double timeout);
+JANET_API int janet_thread_send(JanetThread *thread, Janet msg, double timeout);
+
+#endif
+
 /***** END SECTION MAIN *****/
 
 #ifdef __cplusplus

src/mainclient/line.c

@@ -1,502 +0,0 @@
-/*
-* Copyright (c) 2019 Calvin 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 "line.h"
-#endif
-
-/* Common */
-Janet janet_line_getter(int32_t argc, Janet *argv) {
-    janet_arity(argc, 0, 2);
-    const char *str = (argc >= 1) ? (const char *) janet_getstring(argv, 0) : "";
-    JanetBuffer *buf = (argc >= 2) ? janet_getbuffer(argv, 1) : janet_buffer(10);
-    janet_line_get(str, buf);
-    return janet_wrap_buffer(buf);
-}
-
-static void simpleline(JanetBuffer *buffer) {
-    FILE *in = janet_dynfile("in", stdin);
-    buffer->count = 0;
-    int c;
-    for (;;) {
-        c = fgetc(in);
-        if (feof(in) || c < 0) {
-            break;
-        }
-        janet_buffer_push_u8(buffer, (uint8_t) c);
-        if (c == '\n') break;
-    }
-}
-
-/* Windows */
-#ifdef JANET_WINDOWS
-
-void janet_line_init() {
-    ;
-}
-
-void janet_line_deinit() {
-    ;
-}
-
-void janet_line_get(const char *p, JanetBuffer *buffer) {
-    FILE *out = janet_dynfile("out", stdout);
-    fputs(p, out);
-    fflush(out);
-    simpleline(buffer);
-}
-
-/* Posix */
-#else
-
-/*
-https://github.com/antirez/linenoise/blob/master/linenoise.c
-*/
-
-#include <termios.h>
-#include <unistd.h>
-#include <stdlib.h>
-#include <stdio.h>
-#include <errno.h>
-#include <stdlib.h>
-#include <ctype.h>
-#include <sys/stat.h>
-#include <sys/types.h>
-#include <sys/ioctl.h>
-#include <unistd.h>
-#include <string.h>
-#include <signal.h>
-
-/* static state */
-#define JANET_LINE_MAX 1024
-#define JANET_HISTORY_MAX 100
-static JANET_THREAD_LOCAL int gbl_israwmode = 0;
-static JANET_THREAD_LOCAL const char *gbl_prompt = "> ";
-static JANET_THREAD_LOCAL int gbl_plen = 2;
-static JANET_THREAD_LOCAL char gbl_buf[JANET_LINE_MAX];
-static JANET_THREAD_LOCAL int gbl_len = 0;
-static JANET_THREAD_LOCAL int gbl_pos = 0;
-static JANET_THREAD_LOCAL int gbl_cols = 80;
-static JANET_THREAD_LOCAL char *gbl_history[JANET_HISTORY_MAX];
-static JANET_THREAD_LOCAL int gbl_history_count = 0;
-static JANET_THREAD_LOCAL int gbl_historyi = 0;
-static JANET_THREAD_LOCAL int gbl_sigint_flag = 0;
-static JANET_THREAD_LOCAL struct termios gbl_termios_start;
-
-/* Unsupported terminal list from linenoise */
-static const char *badterms[] = {
-    "cons25",
-    "dumb",
-    "emacs",
-    NULL
-};
-
-static char *sdup(const char *s) {
-    size_t len = strlen(s) + 1;
-    char *mem = malloc(len);
-    if (!mem) {
-        return NULL;
-    }
-    return memcpy(mem, s, len);
-}
-
-/* Ansi terminal raw mode */
-static int rawmode() {
-    struct termios t;
-    if (!isatty(STDIN_FILENO)) goto fatal;
-    if (tcgetattr(STDIN_FILENO, &gbl_termios_start) == -1) goto fatal;
-    t = gbl_termios_start;
-    t.c_iflag &= ~(BRKINT | ICRNL | INPCK | ISTRIP | IXON);
-    t.c_cflag |= (CS8);
-    t.c_lflag &= ~(ECHO | ICANON | IEXTEN | ISIG);
-    t.c_cc[VMIN] = 1;
-    t.c_cc[VTIME] = 0;
-    if (tcsetattr(STDIN_FILENO, TCSAFLUSH, &t) < 0) goto fatal;
-    gbl_israwmode = 1;
-    return 0;
-fatal:
-    errno = ENOTTY;
-    return -1;
-}
-
-/* Disable raw mode */
-static void norawmode() {
-    if (gbl_israwmode && tcsetattr(STDIN_FILENO, TCSAFLUSH, &gbl_termios_start) != -1)
-        gbl_israwmode = 0;
-}
-
-static int curpos() {
-    char buf[32];
-    int cols, rows;
-    unsigned int i = 0;
-    if (write(STDOUT_FILENO, "\x1b[6n", 4) != 4) return -1;
-    while (i < sizeof(buf) - 1) {
-        if (read(STDIN_FILENO, buf + i, 1) != 1) break;
-        if (buf[i] == 'R') break;
-        i++;
-    }
-    buf[i] = '\0';
-    if (buf[0] != 27 || buf[1] != '[') return -1;
-    if (sscanf(buf + 2, "%d;%d", &rows, &cols) != 2) return -1;
-    return cols;
-}
-
-static int getcols() {
-    struct winsize ws;
-    if (ioctl(1, TIOCGWINSZ, &ws) == -1 || ws.ws_col == 0) {
-        int start, cols;
-        start = curpos();
-        if (start == -1) goto failed;
-        if (write(STDOUT_FILENO, "\x1b[999C", 6) != 6) goto failed;
-        cols = curpos();
-        if (cols == -1) goto failed;
-        if (cols > start) {
-            char seq[32];
-            snprintf(seq, 32, "\x1b[%dD", cols - start);
-            if (write(STDOUT_FILENO, seq, strlen(seq)) == -1) {
-                exit(1);
-            }
-        }
-        return cols;
-    } else {
-        return ws.ws_col;
-    }
-failed:
-    return 80;
-}
-
-static void clear() {
-    if (write(STDOUT_FILENO, "\x1b[H\x1b[2J", 7) <= 0) {
-        exit(1);
-    }
-}
-
-static void refresh() {
-    char seq[64];
-    JanetBuffer b;
-
-    /* Keep cursor position on screen */
-    char *_buf = gbl_buf;
-    int _len = gbl_len;
-    int _pos = gbl_pos;
-    while ((gbl_plen + _pos) >= gbl_cols) {
-        _buf++;
-        _len--;
-        _pos--;
-    }
-    while ((gbl_plen + _len) > gbl_cols) {
-        _len--;
-    }
-
-    janet_buffer_init(&b, 0);
-    /* Cursor to left edge, gbl_prompt and buffer */
-    janet_buffer_push_u8(&b, '\r');
-    janet_buffer_push_cstring(&b, gbl_prompt);
-    janet_buffer_push_bytes(&b, (uint8_t *) _buf, _len);
-    /* Erase to right */
-    janet_buffer_push_cstring(&b, "\x1b[0K");
-    /* Move cursor to original position. */
-    snprintf(seq, 64, "\r\x1b[%dC", (int)(_pos + gbl_plen));
-    janet_buffer_push_cstring(&b, seq);
-    if (write(STDOUT_FILENO, b.data, b.count) == -1) {
-        exit(1);
-    }
-    janet_buffer_deinit(&b);
-}
-
-static int insert(char c) {
-    if (gbl_len < JANET_LINE_MAX - 1) {
-        if (gbl_len == gbl_pos) {
-            gbl_buf[gbl_pos++] = c;
-            gbl_buf[++gbl_len] = '\0';
-            if (gbl_plen + gbl_len < gbl_cols) {
-                /* Avoid a full update of the line in the
-                 * trivial case. */
-                if (write(STDOUT_FILENO, &c, 1) == -1) return -1;
-            } else {
-                refresh();
-            }
-        } else {
-            memmove(gbl_buf + gbl_pos + 1, gbl_buf + gbl_pos, gbl_len - gbl_pos);
-            gbl_buf[gbl_pos++] = c;
-            gbl_buf[++gbl_len] = '\0';
-            refresh();
-        }
-    }
-    return 0;
-}
-
-static void historymove(int delta) {
-    if (gbl_history_count > 1) {
-        free(gbl_history[gbl_historyi]);
-        gbl_history[gbl_historyi] = sdup(gbl_buf);
-
-        gbl_historyi += delta;
-        if (gbl_historyi < 0) {
-            gbl_historyi = 0;
-            return;
-        } else if (gbl_historyi >= gbl_history_count) {
-            gbl_historyi = gbl_history_count - 1;
-            return;
-        }
-        strncpy(gbl_buf, gbl_history[gbl_historyi], JANET_LINE_MAX - 1);
-        gbl_pos = gbl_len = strlen(gbl_buf);
-        gbl_buf[gbl_len] = '\0';
-
-        refresh();
-    }
-}
-
-static void addhistory() {
-    int i, len;
-    char *newline = sdup(gbl_buf);
-    if (!newline) return;
-    len = gbl_history_count;
-    if (len < JANET_HISTORY_MAX) {
-        gbl_history[gbl_history_count++] = newline;
-        len++;
-    } else {
-        free(gbl_history[JANET_HISTORY_MAX - 1]);
-    }
-    for (i = len - 1; i > 0; i--) {
-        gbl_history[i] = gbl_history[i - 1];
-    }
-    gbl_history[0] = newline;
-}
-
-static void replacehistory() {
-    char *newline = sdup(gbl_buf);
-    if (!newline) return;
-    free(gbl_history[0]);
-    gbl_history[0] = newline;
-}
-
-static void kleft() {
-    if (gbl_pos > 0) {
-        gbl_pos--;
-        refresh();
-    }
-}
-
-static void kright() {
-    if (gbl_pos != gbl_len) {
-        gbl_pos++;
-        refresh();
-    }
-}
-
-static void kbackspace() {
-    if (gbl_pos > 0) {
-        memmove(gbl_buf + gbl_pos - 1, gbl_buf + gbl_pos, gbl_len - gbl_pos);
-        gbl_pos--;
-        gbl_buf[--gbl_len] = '\0';
-        refresh();
-    }
-}
-
-static void kdelete() {
-    if (gbl_pos != gbl_len) {
-        memmove(gbl_buf + gbl_pos, gbl_buf + gbl_pos + 1, gbl_len - gbl_pos);
-        gbl_buf[--gbl_len] = '\0';
-        refresh();
-    }
-}
-
-static int line() {
-    gbl_cols = getcols();
-    gbl_plen = 0;
-    gbl_len = 0;
-    gbl_pos = 0;
-    while (gbl_prompt[gbl_plen]) gbl_plen++;
-    gbl_buf[0] = '\0';
-
-    addhistory();
-
-    if (write(STDOUT_FILENO, gbl_prompt, gbl_plen) == -1) return -1;
-    for (;;) {
-        char c;
-        int nread;
-        char seq[3];
-
-        nread = read(STDIN_FILENO, &c, 1);
-        if (nread <= 0) return -1;
-
-        switch (c) {
-            default:
-                if (insert(c)) return -1;
-                break;
-            case 9:     /* tab */
-                if (insert(' ')) return -1;
-                if (insert(' ')) return -1;
-                break;
-            case 13:    /* enter */
-                return 0;
-            case 3:     /* ctrl-c */
-                errno = EAGAIN;
-                gbl_sigint_flag = 1;
-                return -1;
-            case 127:   /* backspace */
-            case 8:     /* ctrl-h */
-                kbackspace();
-                break;
-            case 4:     /* ctrl-d, eof */
-                return -1;
-            case 2:     /* ctrl-b */
-                kleft();
-                break;
-            case 6:     /* ctrl-f */
-                kright();
-                break;
-            case 21:
-                gbl_buf[0] = '\0';
-                gbl_pos = gbl_len = 0;
-                refresh();
-                break;
-            case 26: /* ctrl-z */
-                norawmode();
-                kill(getpid(), SIGSTOP);
-                rawmode();
-                refresh();
-                break;
-            case 12:
-                clear();
-                refresh();
-                break;
-            case 27:    /* escape sequence */
-                /* Read the next two bytes representing the escape sequence.
-                 * Use two calls to handle slow terminals returning the two
-                 * chars at different times. */
-                if (read(STDIN_FILENO, seq, 1) == -1) break;
-                if (read(STDIN_FILENO, seq + 1, 1) == -1) break;
-                if (seq[0] == '[') {
-                    if (seq[1] >= '0' && seq[1] <= '9') {
-                        /* Extended escape, read additional byte. */
-                        if (read(STDIN_FILENO, seq + 2, 1) == -1) break;
-                        if (seq[2] == '~') {
-                            switch (seq[1]) {
-                                case '3': /* delete */
-                                    kdelete();
-                                    break;
-                                default:
-                                    break;
-                            }
-                        }
-                    } else {
-                        switch (seq[1]) {
-                            default:
-                                break;
-                            case 'A':
-                                historymove(1);
-                                break;
-                            case 'B':
-                                historymove(-1);
-                                break;
-                            case 'C': /* Right */
-                                kright();
-                                break;
-                            case 'D': /* Left */
-                                kleft();
-                                break;
-                            case 'H':
-                                gbl_pos = 0;
-                                refresh();
-                                break;
-                            case 'F':
-                                gbl_pos = gbl_len;
-                                refresh();
-                                break;
-                        }
-                    }
-                } else if (seq[0] == 'O') {
-                    switch (seq[1]) {
-                        default:
-                            break;
-                        case 'H':
-                            gbl_pos = 0;
-                            refresh();
-                            break;
-                        case 'F':
-                            gbl_pos = gbl_len;
-                            refresh();
-                            break;
-                    }
-                }
-                break;
-        }
-    }
-    return 0;
-}
-
-void janet_line_init() {
-    ;
-}
-
-void janet_line_deinit() {
-    int i;
-    norawmode();
-    for (i = 0; i < gbl_history_count; i++)
-        free(gbl_history[i]);
-    gbl_historyi = 0;
-}
-
-static int checktermsupport() {
-    const char *t = getenv("TERM");
-    int i;
-    if (!t) return 1;
-    for (i = 0; badterms[i]; i++)
-        if (!strcmp(t, badterms[i])) return 0;
-    return 1;
-}
-
-void janet_line_get(const char *p, JanetBuffer *buffer) {
-    gbl_prompt = p;
-    buffer->count = 0;
-    gbl_historyi = 0;
-    FILE *out = janet_dynfile("out", stdout);
-    if (!isatty(STDIN_FILENO) || !checktermsupport()) {
-        simpleline(buffer);
-        return;
-    }
-    if (rawmode()) {
-        simpleline(buffer);
-        return;
-    }
-    if (line()) {
-        norawmode();
-        if (gbl_sigint_flag) {
-            raise(SIGINT);
-        } else {
-            fputc('\n', out);
-        }
-        return;
-    }
-    fflush(stdin);
-    norawmode();
-    fputc('\n', out);
-    janet_buffer_ensure(buffer, gbl_len + 1, 2);
-    memcpy(buffer->data, gbl_buf, gbl_len);
-    buffer->data[gbl_len] = '\n';
-    buffer->count = gbl_len + 1;
-    replacehistory();
-}
-
-#endif

src/mainclient/main.c

@@ -1,86 +0,0 @@
-/*
-* Copyright (c) 2019 Calvin 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 <janet.h>
-#include "line.h"
-#endif
-
-#ifdef _WIN32
-#include <windows.h>
-#include <shlwapi.h>
-#ifndef ENABLE_VIRTUAL_TERMINAL_PROCESSING
-#define ENABLE_VIRTUAL_TERMINAL_PROCESSING 0x0004
-#endif
-#endif
-
-int main(int argc, char **argv) {
-    int i, status;
-    JanetArray *args;
-    JanetTable *env;
-
-#ifdef _WIN32
-    /* Enable color console on windows 10 console and utf8 output. */
-    HANDLE hOut = GetStdHandle(STD_OUTPUT_HANDLE);
-    DWORD dwMode = 0;
-    GetConsoleMode(hOut, &dwMode);
-    dwMode |= ENABLE_VIRTUAL_TERMINAL_PROCESSING;
-    SetConsoleMode(hOut, dwMode);
-    SetConsoleOutputCP(65001);
-#endif
-
-    /* Set up VM */
-    janet_init();
-
-    /* Replace original getline with new line getter */
-    JanetTable *replacements = janet_table(0);
-    janet_table_put(replacements, janet_csymbolv("getline"), janet_wrap_cfunction(janet_line_getter));
-    janet_line_init();
-
-    /* Get core env */
-    env = janet_core_env(replacements);
-
-    /* Create args tuple */
-    args = janet_array(argc);
-    for (i = 1; i < argc; i++)
-        janet_array_push(args, janet_cstringv(argv[i]));
-
-    /* Save current executable path to (dyn :executable) */
-    janet_table_put(env, janet_ckeywordv("executable"), janet_cstringv(argv[0]));
-
-    /* Run startup script */
-    Janet mainfun, out;
-    janet_resolve(env, janet_csymbol("cli-main"), &mainfun);
-    Janet mainargs[1] = { janet_wrap_array(args) };
-    JanetFiber *fiber = janet_fiber(janet_unwrap_function(mainfun), 64, 1, mainargs);
-    fiber->env = env;
-    status = janet_continue(fiber, janet_wrap_nil(), &out);
-    if (status != JANET_SIGNAL_OK) {
-        janet_stacktrace(fiber, out);
-    }
-
-    /* Deinitialize vm */
-    janet_deinit();
-    janet_line_deinit();
-
-    return status;
-}

src/mainclient/shell.c

@@ -0,0 +1,888 @@
+/*
+* Copyright (c) 2020 Calvin Rose
+*
+* Permission is hereby granted, free of charge, to any person obtaining a copy
+* of this software and associated documentation files (the "Software"), to
+* deal in the Software without restriction, including without limitation the
+* rights to use, copy, modify, merge, publish, distribute, sublicense, and/or
+* sell copies of the Software, and to permit persons to whom the Software is
+* furnished to do so, subject to the following conditions:
+*
+* The above copyright notice and this permission notice shall be included in
+* all copies or substantial portions of the Software.
+*
+* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
+* AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
+* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
+* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS
+* IN THE SOFTWARE.
+*/
+
+#if !defined(_POSIX_C_SOURCE)
+#define _POSIX_C_SOURCE 200112L
+#endif
+
+#include <janet.h>
+
+#ifdef _WIN32
+#include <windows.h>
+#include <shlwapi.h>
+#ifndef ENABLE_VIRTUAL_TERMINAL_PROCESSING
+#define ENABLE_VIRTUAL_TERMINAL_PROCESSING 0x0004
+#endif
+#endif
+
+void janet_line_init();
+void janet_line_deinit();
+
+void janet_line_get(const char *p, JanetBuffer *buffer);
+Janet janet_line_getter(int32_t argc, Janet *argv);
+
+/*
+ * Line Editing
+ */
+
+static JANET_THREAD_LOCAL JanetTable *gbl_complete_env;
+
+/* Common */
+Janet janet_line_getter(int32_t argc, Janet *argv) {
+    janet_arity(argc, 0, 3);
+    const char *str = (argc >= 1) ? (const char *) janet_getstring(argv, 0) : "";
+    JanetBuffer *buf = (argc >= 2) ? janet_getbuffer(argv, 1) : janet_buffer(10);
+    gbl_complete_env = (argc >= 3) ? janet_gettable(argv, 2) : NULL;
+    janet_line_get(str, buf);
+    gbl_complete_env = NULL;
+    return janet_wrap_buffer(buf);
+}
+
+static void simpleline(JanetBuffer *buffer) {
+    FILE *in = janet_dynfile("in", stdin);
+    buffer->count = 0;
+    int c;
+    for (;;) {
+        c = fgetc(in);
+        if (feof(in) || c < 0) {
+            break;
+        }
+        janet_buffer_push_u8(buffer, (uint8_t) c);
+        if (c == '\n') break;
+    }
+}
+
+/* Windows */
+#ifdef JANET_WINDOWS
+
+void janet_line_init() {
+    ;
+}
+
+void janet_line_deinit() {
+    ;
+}
+
+void janet_line_get(const char *p, JanetBuffer *buffer) {
+    FILE *out = janet_dynfile("err", stderr);
+    fputs(p, out);
+    fflush(out);
+    simpleline(buffer);
+}
+
+/* Posix */
+#else
+
+/*
+https://github.com/antirez/linenoise/blob/master/linenoise.c
+*/
+
+#include <termios.h>
+#include <unistd.h>
+#include <stdlib.h>
+#include <stdio.h>
+#include <errno.h>
+#include <stdlib.h>
+#include <ctype.h>
+#include <sys/stat.h>
+#include <sys/types.h>
+#include <sys/ioctl.h>
+#include <unistd.h>
+#include <string.h>
+#include <signal.h>
+
+/* static state */
+#define JANET_LINE_MAX 1024
+#define JANET_MATCH_MAX 256
+#define JANET_HISTORY_MAX 100
+static JANET_THREAD_LOCAL int gbl_israwmode = 0;
+static JANET_THREAD_LOCAL const char *gbl_prompt = "> ";
+static JANET_THREAD_LOCAL int gbl_plen = 2;
+static JANET_THREAD_LOCAL char gbl_buf[JANET_LINE_MAX];
+static JANET_THREAD_LOCAL int gbl_len = 0;
+static JANET_THREAD_LOCAL int gbl_pos = 0;
+static JANET_THREAD_LOCAL int gbl_cols = 80;
+static JANET_THREAD_LOCAL char *gbl_history[JANET_HISTORY_MAX];
+static JANET_THREAD_LOCAL int gbl_history_count = 0;
+static JANET_THREAD_LOCAL int gbl_historyi = 0;
+static JANET_THREAD_LOCAL int gbl_sigint_flag = 0;
+static JANET_THREAD_LOCAL struct termios gbl_termios_start;
+static JANET_THREAD_LOCAL JanetByteView gbl_matches[JANET_MATCH_MAX];
+static JANET_THREAD_LOCAL int gbl_match_count = 0;
+static JANET_THREAD_LOCAL int gbl_lines_below = 0;
+
+/* Unsupported terminal list from linenoise */
+static const char *badterms[] = {
+    "cons25",
+    "dumb",
+    "emacs",
+    NULL
+};
+
+static char *sdup(const char *s) {
+    size_t len = strlen(s) + 1;
+    char *mem = malloc(len);
+    if (!mem) {
+        return NULL;
+    }
+    return memcpy(mem, s, len);
+}
+
+/* Ansi terminal raw mode */
+static int rawmode(void) {
+    struct termios t;
+    if (!isatty(STDIN_FILENO)) goto fatal;
+    if (tcgetattr(STDIN_FILENO, &gbl_termios_start) == -1) goto fatal;
+    t = gbl_termios_start;
+    t.c_iflag &= ~(BRKINT | ICRNL | INPCK | ISTRIP | IXON);
+    t.c_cflag |= (CS8);
+    t.c_lflag &= ~(ECHO | ICANON | IEXTEN | ISIG);
+    t.c_cc[VMIN] = 1;
+    t.c_cc[VTIME] = 0;
+    if (tcsetattr(STDIN_FILENO, TCSAFLUSH, &t) < 0) goto fatal;
+    gbl_israwmode = 1;
+    return 0;
+fatal:
+    errno = ENOTTY;
+    return -1;
+}
+
+/* Disable raw mode */
+static void norawmode(void) {
+    if (gbl_israwmode && tcsetattr(STDIN_FILENO, TCSAFLUSH, &gbl_termios_start) != -1)
+        gbl_israwmode = 0;
+}
+
+static int curpos(void) {
+    char buf[32];
+    int cols, rows;
+    unsigned int i = 0;
+    if (write(STDOUT_FILENO, "\x1b[6n", 4) != 4) return -1;
+    while (i < sizeof(buf) - 1) {
+        if (read(STDIN_FILENO, buf + i, 1) != 1) break;
+        if (buf[i] == 'R') break;
+        i++;
+    }
+    buf[i] = '\0';
+    if (buf[0] != 27 || buf[1] != '[') return -1;
+    if (sscanf(buf + 2, "%d;%d", &rows, &cols) != 2) return -1;
+    return cols;
+}
+
+static int getcols(void) {
+    struct winsize ws;
+    if (ioctl(1, TIOCGWINSZ, &ws) == -1 || ws.ws_col == 0) {
+        int start, cols;
+        start = curpos();
+        if (start == -1) goto failed;
+        if (write(STDOUT_FILENO, "\x1b[999C", 6) != 6) goto failed;
+        cols = curpos();
+        if (cols == -1) goto failed;
+        if (cols > start) {
+            char seq[32];
+            snprintf(seq, 32, "\x1b[%dD", cols - start);
+            if (write(STDOUT_FILENO, seq, strlen(seq)) == -1) {
+                exit(1);
+            }
+        }
+        return cols;
+    } else {
+        return ws.ws_col;
+    }
+failed:
+    return 80;
+}
+
+static void clear(void) {
+    if (write(STDOUT_FILENO, "\x1b[H\x1b[2J", 7) <= 0) {
+        exit(1);
+    }
+}
+
+static void refresh(void) {
+    char seq[64];
+    JanetBuffer b;
+
+    /* Keep cursor position on screen */
+    char *_buf = gbl_buf;
+    int _len = gbl_len;
+    int _pos = gbl_pos;
+    while ((gbl_plen + _pos) >= gbl_cols) {
+        _buf++;
+        _len--;
+        _pos--;
+    }
+    while ((gbl_plen + _len) > gbl_cols) {
+        _len--;
+    }
+
+    janet_buffer_init(&b, 0);
+    /* Cursor to left edge, gbl_prompt and buffer */
+    janet_buffer_push_u8(&b, '\r');
+    janet_buffer_push_cstring(&b, gbl_prompt);
+    janet_buffer_push_bytes(&b, (uint8_t *) _buf, _len);
+    /* Erase to right */
+    janet_buffer_push_cstring(&b, "\x1b[0K");
+    /* Move cursor to original position. */
+    snprintf(seq, 64, "\r\x1b[%dC", (int)(_pos + gbl_plen));
+    janet_buffer_push_cstring(&b, seq);
+    if (write(STDOUT_FILENO, b.data, b.count) == -1) {
+        exit(1);
+    }
+    janet_buffer_deinit(&b);
+}
+
+static void clearlines(void) {
+    for (int i = 0; i < gbl_lines_below; i++) {
+        fprintf(stderr, "\x1b[1B\x1b[999D\x1b[K");
+    }
+    if (gbl_lines_below) {
+        fprintf(stderr, "\x1b[%dA\x1b[999D", gbl_lines_below);
+        fflush(stderr);
+        gbl_lines_below = 0;
+    }
+}
+
+static int insert(char c, int draw) {
+    if (gbl_len < JANET_LINE_MAX - 1) {
+        if (gbl_len == gbl_pos) {
+            gbl_buf[gbl_pos++] = c;
+            gbl_buf[++gbl_len] = '\0';
+            if (draw) {
+                if (gbl_plen + gbl_len < gbl_cols) {
+                    /* Avoid a full update of the line in the
+                     * trivial case. */
+                    if (write(STDOUT_FILENO, &c, 1) == -1) return -1;
+                } else {
+                    refresh();
+                }
+            }
+        } else {
+            memmove(gbl_buf + gbl_pos + 1, gbl_buf + gbl_pos, gbl_len - gbl_pos);
+            gbl_buf[gbl_pos++] = c;
+            gbl_buf[++gbl_len] = '\0';
+            if (draw) refresh();
+        }
+    }
+    return 0;
+}
+
+static void historymove(int delta) {
+    if (gbl_history_count > 1) {
+        free(gbl_history[gbl_historyi]);
+        gbl_history[gbl_historyi] = sdup(gbl_buf);
+
+        gbl_historyi += delta;
+        if (gbl_historyi < 0) {
+            gbl_historyi = 0;
+        } else if (gbl_historyi >= gbl_history_count) {
+            gbl_historyi = gbl_history_count - 1;
+        }
+        strncpy(gbl_buf, gbl_history[gbl_historyi], JANET_LINE_MAX - 1);
+        gbl_pos = gbl_len = strlen(gbl_buf);
+        gbl_buf[gbl_len] = '\0';
+
+        refresh();
+    }
+}
+
+static void addhistory(void) {
+    int i, len;
+    char *newline = sdup(gbl_buf);
+    if (!newline) return;
+    len = gbl_history_count;
+    if (len < JANET_HISTORY_MAX) {
+        gbl_history[gbl_history_count++] = newline;
+        len++;
+    } else {
+        free(gbl_history[JANET_HISTORY_MAX - 1]);
+    }
+    for (i = len - 1; i > 0; i--) {
+        gbl_history[i] = gbl_history[i - 1];
+    }
+    gbl_history[0] = newline;
+}
+
+static void replacehistory(void) {
+    /* History count is always > 0 here */
+    if (gbl_len == 0 || (gbl_history_count > 1 && !strcmp(gbl_buf, gbl_history[1]))) {
+        /* Delete history */
+        free(gbl_history[0]);
+        for (int i = 1; i < gbl_history_count; i++) {
+            gbl_history[i - 1] = gbl_history[i];
+        }
+        gbl_history_count--;
+    } else {
+        char *newline = sdup(gbl_buf);
+        if (!newline) return;
+        free(gbl_history[0]);
+        gbl_history[0] = newline;
+    }
+}
+
+static void kleft(void) {
+    if (gbl_pos > 0) {
+        gbl_pos--;
+        refresh();
+    }
+}
+
+static void kleftw(void) {
+    while (gbl_pos > 0 && isspace(gbl_buf[gbl_pos - 1])) {
+        gbl_pos--;
+    }
+    while (gbl_pos > 0 && !isspace(gbl_buf[gbl_pos - 1])) {
+        gbl_pos--;
+    }
+    refresh();
+}
+
+static void kright(void) {
+    if (gbl_pos != gbl_len) {
+        gbl_pos++;
+        refresh();
+    }
+}
+
+static void krightw(void) {
+    while (gbl_pos != gbl_len && !isspace(gbl_buf[gbl_pos])) {
+        gbl_pos++;
+    }
+    while (gbl_pos != gbl_len && isspace(gbl_buf[gbl_pos])) {
+        gbl_pos++;
+    }
+    refresh();
+}
+
+static void kbackspace(int draw) {
+    if (gbl_pos > 0) {
+        memmove(gbl_buf + gbl_pos - 1, gbl_buf + gbl_pos, gbl_len - gbl_pos);
+        gbl_pos--;
+        gbl_buf[--gbl_len] = '\0';
+        if (draw) refresh();
+    }
+}
+
+static void kdelete(int draw) {
+    if (gbl_pos != gbl_len) {
+        memmove(gbl_buf + gbl_pos, gbl_buf + gbl_pos + 1, gbl_len - gbl_pos);
+        gbl_buf[--gbl_len] = '\0';
+        if (draw) refresh();
+    }
+}
+
+static void kbackspacew(void) {
+    while (gbl_pos && isspace(gbl_buf[gbl_pos - 1])) {
+        kbackspace(0);
+    }
+    while (gbl_pos && !isspace(gbl_buf[gbl_pos - 1])) {
+        kbackspace(0);
+    }
+    refresh();
+}
+
+static void kdeletew(void) {
+    while (gbl_pos < gbl_len && isspace(gbl_buf[gbl_pos])) {
+        kdelete(0);
+    }
+    while (gbl_pos < gbl_len && !isspace(gbl_buf[gbl_pos])) {
+        kdelete(0);
+    }
+    refresh();
+}
+
+
+/* See tools/symchargen.c */
+static int is_symbol_char_gen(uint8_t c) {
+    if (c & 0x80) return 1;
+    if (c >= 'a' && c <= 'z') return 1;
+    if (c >= 'A' && c <= 'Z') return 1;
+    if (c >= '0' && c <= '9') return 1;
+    return (c == '!' ||
+            c == '$' ||
+            c == '%' ||
+            c == '&' ||
+            c == '*' ||
+            c == '+' ||
+            c == '-' ||
+            c == '.' ||
+            c == '/' ||
+            c == ':' ||
+            c == '<' ||
+            c == '?' ||
+            c == '=' ||
+            c == '>' ||
+            c == '@' ||
+            c == '^' ||
+            c == '_');
+}
+
+static JanetByteView get_symprefix(void) {
+    /* Calculate current partial symbol. Maybe we could actually hook up the Janet
+     * parser here...*/
+    int i;
+    JanetByteView ret;
+    ret.len = 0;
+    for (i = gbl_pos - 1; i >= 0; i--) {
+        uint8_t c = (uint8_t) gbl_buf[i];
+        if (!is_symbol_char_gen(c)) break;
+        ret.len++;
+    }
+    /* Will be const for duration of match checking */
+    ret.bytes = (const uint8_t *)(gbl_buf + i + 1);
+    return ret;
+}
+
+static int compare_bytes(JanetByteView a, JanetByteView b) {
+    int32_t minlen = a.len < b.len ? a.len : b.len;
+    int result = strncmp((const char *) a.bytes, (const char *) b.bytes, minlen);
+    if (result) return result;
+    return a.len < b.len ? -1 : a.len > b.len ? 1 : 0;
+}
+
+static void check_match(JanetByteView src, const uint8_t *testsym, int32_t testlen) {
+    JanetByteView test;
+    test.bytes = testsym;
+    test.len = testlen;
+    if (src.len > test.len || strncmp((const char *) src.bytes, (const char *) test.bytes, src.len)) return;
+    JanetByteView mm = test;
+    for (int i = 0; i < gbl_match_count; i++) {
+        if (compare_bytes(mm, gbl_matches[i]) < 0) {
+            JanetByteView temp = mm;
+            mm = gbl_matches[i];
+            gbl_matches[i] = temp;
+        }
+    }
+    if (gbl_match_count == JANET_MATCH_MAX) return;
+    gbl_matches[gbl_match_count++] = mm;
+}
+
+static void check_cmatch(JanetByteView src, const char *cstr) {
+    check_match(src, (const uint8_t *) cstr, (int32_t) strlen(cstr));
+}
+
+static JanetByteView longest_common_prefix(void) {
+    JanetByteView bv;
+    if (gbl_match_count == 0) {
+        bv.len = 0;
+        bv.bytes = NULL;
+    } else {
+        bv = gbl_matches[0];
+        for (int i = 0; i < gbl_match_count; i++) {
+            JanetByteView other = gbl_matches[i];
+            int32_t minlen = other.len < bv.len ? other.len : bv.len;
+            for (bv.len = 0; bv.len < minlen; bv.len++) {
+                if (bv.bytes[bv.len] != other.bytes[bv.len]) {
+                    break;
+                }
+            }
+        }
+    }
+    return bv;
+}
+
+static void check_specials(JanetByteView src) {
+    check_cmatch(src, "break");
+    check_cmatch(src, "def");
+    check_cmatch(src, "do");
+    check_cmatch(src, "fn");
+    check_cmatch(src, "if");
+    check_cmatch(src, "quasiquote");
+    check_cmatch(src, "quote");
+    check_cmatch(src, "set");
+    check_cmatch(src, "splice");
+    check_cmatch(src, "unquote");
+    check_cmatch(src, "var");
+    check_cmatch(src, "while");
+}
+
+static void kshowcomp(void) {
+    JanetTable *env = gbl_complete_env;
+    if (env == NULL) {
+        insert(' ', 0);
+        insert(' ', 0);
+        return;
+    }
+
+    /* Advance while on symbol char */
+    while (is_symbol_char_gen(gbl_buf[gbl_pos]))
+        gbl_pos++;
+
+    JanetByteView prefix = get_symprefix();
+    if (prefix.len  == 0) return;
+
+    /* Find all matches */
+    gbl_match_count = 0;
+    while (NULL != env) {
+        JanetKV *kvend = env->data + env->capacity;
+        for (JanetKV *kv = env->data; kv < kvend; kv++) {
+            if (!janet_checktype(kv->key, JANET_SYMBOL)) continue;
+            const uint8_t *sym = janet_unwrap_symbol(kv->key);
+            check_match(prefix, sym, janet_string_length(sym));
+        }
+        env = env->proto;
+    }
+
+    check_specials(prefix);
+
+    JanetByteView lcp = longest_common_prefix();
+    for (int i = prefix.len; i < lcp.len; i++) {
+        insert(lcp.bytes[i], 0);
+    }
+
+    if (!gbl_lines_below && prefix.len != lcp.len) return;
+
+    int32_t maxlen = 0;
+    for (int i = 0; i < gbl_match_count; i++)
+        if (gbl_matches[i].len > maxlen)
+            maxlen = gbl_matches[i].len;
+
+    int num_cols = getcols();
+    clearlines();
+    if (gbl_match_count >= 2) {
+
+        /* Second pass, print */
+        int col_width = maxlen + 4;
+        int cols = num_cols / col_width;
+        if (cols == 0) cols = 1;
+        int current_col = 0;
+        for (int i = 0; i < gbl_match_count; i++) {
+            if (current_col == 0) {
+                putc('\n', stderr);
+                gbl_lines_below++;
+            }
+            JanetByteView s = gbl_matches[i];
+            fprintf(stderr, "%s", (const char *) s.bytes);
+            for (int j = s.len; j < col_width; j++) {
+                putc(' ', stderr);
+            }
+            current_col = (current_col + 1) % cols;
+        }
+
+        /* Go up to original line (zsh-like autocompletion) */
+        fprintf(stderr, "\x1B[%dA", gbl_lines_below);
+
+        fflush(stderr);
+    }
+}
+
+static int line() {
+    gbl_cols = getcols();
+    gbl_plen = 0;
+    gbl_len = 0;
+    gbl_pos = 0;
+    while (gbl_prompt[gbl_plen]) gbl_plen++;
+    gbl_buf[0] = '\0';
+
+    addhistory();
+
+    if (write(STDOUT_FILENO, gbl_prompt, gbl_plen) == -1) return -1;
+    for (;;) {
+        char c;
+        char seq[3];
+
+        if (read(STDIN_FILENO, &c, 1) <= 0) return -1;
+
+        switch (c) {
+            default:
+                if (c < 0x20) break;
+                if (insert(c, 1)) return -1;
+                break;
+            case 1:     /* ctrl-a */
+                gbl_pos = 0;
+                refresh();
+                break;
+            case 2:     /* ctrl-b */
+                kleft();
+                break;
+            case 3:     /* ctrl-c */
+                errno = EAGAIN;
+                gbl_sigint_flag = 1;
+                clearlines();
+                return -1;
+            case 4:     /* ctrl-d, eof */
+                if (gbl_len == 0) {   /* quit on empty line */
+                    clearlines();
+                    return -1;
+                }
+                kdelete(1);
+                break;
+            case 5:     /* ctrl-e */
+                gbl_pos = gbl_len;
+                refresh();
+                break;
+            case 6:     /* ctrl-f */
+                kright();
+                break;
+            case 127:   /* backspace */
+            case 8:     /* ctrl-h */
+                kbackspace(1);
+                break;
+            case 9:     /* tab */
+                kshowcomp();
+                refresh();
+                break;
+            case 11: /* ctrl-k */
+                gbl_buf[gbl_pos] = '\0';
+                gbl_len = gbl_pos;
+                refresh();
+                break;
+            case 12:    /* ctrl-l */
+                clear();
+                refresh();
+                break;
+            case 13:    /* enter */
+                clearlines();
+                return 0;
+            case 14: /* ctrl-n */
+                historymove(-1);
+                break;
+            case 16: /* ctrl-p */
+                historymove(1);
+                break;
+            case 21: { /* ctrl-u */
+                memmove(gbl_buf, gbl_buf + gbl_pos, gbl_len - gbl_pos);
+                gbl_len -= gbl_pos;
+                gbl_buf[gbl_len] = '\0';
+                gbl_pos = 0;
+                refresh();
+                break;
+            }
+            case 23: /* ctrl-w */
+                kbackspacew();
+                break;
+            case 26: /* ctrl-z */
+                norawmode();
+                kill(getpid(), SIGSTOP);
+                rawmode();
+                refresh();
+                break;
+            case 27:    /* escape sequence */
+                /* Read the next two bytes representing the escape sequence.
+                 * Use two calls to handle slow terminals returning the two
+                 * chars at different times. */
+                if (read(STDIN_FILENO, seq, 1) == -1) break;
+                /* Esc[ = Control Sequence Introducer (CSI) */
+                if (seq[0] == '[') {
+                    if (read(STDIN_FILENO, seq + 1, 1) == -1) break;
+                    if (seq[1] >= '0' && seq[1] <= '9') {
+                        /* Extended escape, read additional byte. */
+                        if (read(STDIN_FILENO, seq + 2, 1) == -1) break;
+                        if (seq[2] == '~') {
+                            switch (seq[1]) {
+                                case '1': /* Home */
+                                    gbl_pos = 0;
+                                    refresh();
+                                    break;
+                                case '3': /* delete */
+                                    kdelete(1);
+                                    break;
+                                case '4': /* End */
+                                    gbl_pos = gbl_len;
+                                    refresh();
+                                    break;
+                                default:
+                                    break;
+                            }
+                        }
+                    } else if (seq[0] == 'O') {
+                        if (read(STDIN_FILENO, seq + 1, 1) == -1) break;
+                        switch (seq[1]) {
+                            default:
+                                break;
+                            case 'H': /* Home (some keyboards) */
+                                gbl_pos = 0;
+                                refresh();
+                                break;
+                            case 'F': /* End (some keyboards) */
+                                gbl_pos = gbl_len;
+                                refresh();
+                                break;
+                        }
+                    } else {
+                        switch (seq[1]) {
+                            /* Single escape sequences */
+                            default:
+                                break;
+                            case 'A': /* Up */
+                                historymove(1);
+                                break;
+                            case 'B': /* Down */
+                                historymove(-1);
+                                break;
+                            case 'C': /* Right */
+                                kright();
+                                break;
+                            case 'D': /* Left */
+                                kleft();
+                                break;
+                            case 'H': /* Home */
+                                gbl_pos = 0;
+                                refresh();
+                                break;
+                            case 'F': /* End */
+                                gbl_pos = gbl_len;
+                                refresh();
+                                break;
+                        }
+                    }
+                } else {
+                    /* Check alt-(shift) bindings */
+                    switch (seq[0]) {
+                        default:
+                            break;
+                        case 'd': /* Alt-d */
+                            kdeletew();
+                            break;
+                        case 'b': /* Alt-b */
+                            kleftw();
+                            break;
+                        case 'f': /* Alt-f */
+                            krightw();
+                            break;
+                        case ',': /* Alt-, */
+                            historymove(JANET_HISTORY_MAX);
+                            break;
+                        case '.': /* Alt-. */
+                            historymove(-JANET_HISTORY_MAX);
+                            break;
+                        case 127: /* Alt-backspace */
+                            kbackspacew();
+                            break;
+                    }
+                }
+                break;
+        }
+    }
+    return 0;
+}
+
+void janet_line_init() {
+    ;
+}
+
+void janet_line_deinit() {
+    int i;
+    norawmode();
+    for (i = 0; i < gbl_history_count; i++)
+        free(gbl_history[i]);
+    gbl_historyi = 0;
+}
+
+static int checktermsupport() {
+    const char *t = getenv("TERM");
+    int i;
+    if (!t) return 1;
+    for (i = 0; badterms[i]; i++)
+        if (!strcmp(t, badterms[i])) return 0;
+    return 1;
+}
+
+void janet_line_get(const char *p, JanetBuffer *buffer) {
+    gbl_prompt = p;
+    buffer->count = 0;
+    gbl_historyi = 0;
+    FILE *out = janet_dynfile("err", stderr);
+    if (!isatty(STDIN_FILENO) || !checktermsupport()) {
+        simpleline(buffer);
+        return;
+    }
+    if (rawmode()) {
+        simpleline(buffer);
+        return;
+    }
+    if (line()) {
+        norawmode();
+        if (gbl_sigint_flag) {
+            raise(SIGINT);
+        } else {
+            fputc('\n', out);
+        }
+        return;
+    }
+    fflush(stdin);
+    norawmode();
+    fputc('\n', out);
+    janet_buffer_ensure(buffer, gbl_len + 1, 2);
+    memcpy(buffer->data, gbl_buf, gbl_len);
+    buffer->data[gbl_len] = '\n';
+    buffer->count = gbl_len + 1;
+    replacehistory();
+}
+
+#endif
+
+/*
+ * Entry
+ */
+
+int main(int argc, char **argv) {
+    int i, status;
+    JanetArray *args;
+    JanetTable *env;
+
+#ifdef _WIN32
+    /* Enable color console on windows 10 console and utf8 output. */
+    HANDLE hOut = GetStdHandle(STD_OUTPUT_HANDLE);
+    DWORD dwMode = 0;
+    GetConsoleMode(hOut, &dwMode);
+    dwMode |= ENABLE_VIRTUAL_TERMINAL_PROCESSING;
+    SetConsoleMode(hOut, dwMode);
+    SetConsoleOutputCP(65001);
+#endif
+
+    /* Set up VM */
+    janet_init();
+
+    /* Replace original getline with new line getter */
+    JanetTable *replacements = janet_table(0);
+    janet_table_put(replacements, janet_csymbolv("getline"), janet_wrap_cfunction(janet_line_getter));
+    janet_line_init();
+
+    /* Get core env */
+    env = janet_core_env(replacements);
+
+    /* Create args tuple */
+    args = janet_array(argc);
+    for (i = 1; i < argc; i++)
+        janet_array_push(args, janet_cstringv(argv[i]));
+
+    /* Save current executable path to (dyn :executable) */
+    janet_table_put(env, janet_ckeywordv("executable"), janet_cstringv(argv[0]));
+
+    /* Run startup script */
+    Janet mainfun, out;
+    janet_resolve(env, janet_csymbol("cli-main"), &mainfun);
+    Janet mainargs[1] = { janet_wrap_array(args) };
+    JanetFiber *fiber = janet_fiber(janet_unwrap_function(mainfun), 64, 1, mainargs);
+    fiber->env = env;
+    status = janet_continue(fiber, janet_wrap_nil(), &out);
+    if (status != JANET_SIGNAL_OK) {
+        janet_stacktrace(fiber, out);
+    }
+
+    /* Deinitialize vm */
+    janet_deinit();
+    janet_line_deinit();
+
+    return status;
+}

src/webclient/main.c

@@ -1,126 +0,0 @@
-/*
-* Copyright (c) 2019 Calvin 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.
-*/
-
-#include <janet.h>
-#include <emscripten.h>
-
-extern const unsigned char *janet_gen_webinit;
-extern int32_t janet_gen_webinit_size;
-
-static JanetFiber *repl_fiber = NULL;
-static JanetBuffer *line_buffer = NULL;
-static const uint8_t *line_prompt = NULL;
-
-/* Yield to JS event loop from janet. Takes a repl prompt
- * and a buffer to fill with input data. */
-static Janet repl_yield(int32_t argc, Janet *argv) {
-    janet_fixarity(argc, 2);
-    line_prompt = janet_getstring(argv, 0);
-    line_buffer = janet_getbuffer(argv, 1);
-    return janet_wrap_nil();
-}
-
-/* Re-enter the loop */
-static int enter_loop(void) {
-    Janet ret;
-    JanetSignal status = janet_continue(repl_fiber, janet_wrap_nil(), &ret);
-    if (status == JANET_SIGNAL_ERROR) {
-        janet_stacktrace(repl_fiber, ret);
-        janet_deinit();
-        repl_fiber = NULL;
-        return 1;
-    }
-    return 0;
-}
-
-/* Allow JS interoperation from within janet */
-static Janet cfun_js(int32_t argc, Janet *argv) {
-    janet_fixarity(argc, 1);
-    JanetByteView bytes = janet_getbytes(argv, 0);
-    emscripten_run_script((const char *)bytes.bytes);
-    return janet_wrap_nil();
-}
-
-/* Initialize the repl */
-EMSCRIPTEN_KEEPALIVE
-void repl_init(void) {
-    int status;
-    JanetTable *env;
-
-    /* Set up VM */
-    janet_init();
-    janet_register("repl-yield", repl_yield);
-    janet_register("js", cfun_js);
-    env = janet_core_env(NULL);
-
-    janet_def(env, "repl-yield", janet_wrap_cfunction(repl_yield), NULL);
-    janet_def(env, "js", janet_wrap_cfunction(cfun_js), NULL);
-
-    /* Run startup script */
-    Janet ret;
-    status = janet_dobytes(env, janet_gen_webinit, janet_gen_webinit_size, "webinit.janet", &ret);
-    if (status == JANET_SIGNAL_ERROR) {
-        printf("start up error.\n");
-        janet_deinit();
-        repl_fiber = NULL;
-        return;
-    }
-    janet_gcroot(ret);
-    repl_fiber = janet_unwrap_fiber(ret);
-
-    /* Start repl */
-    if (enter_loop()) return;
-}
-
-/* Deinitialize the repl */
-EMSCRIPTEN_KEEPALIVE
-void repl_deinit(void) {
-    if (!repl_fiber) {
-        return;
-    }
-    repl_fiber = NULL;
-    line_buffer = NULL;
-    janet_deinit();
-}
-
-/* Get the prompt to show in the repl */
-EMSCRIPTEN_KEEPALIVE
-const char *repl_prompt(void) {
-    return line_prompt ? ((const char *)line_prompt) : "";
-}
-
-/* Restart the repl calling from JS. Pass in the input for the next line. */
-EMSCRIPTEN_KEEPALIVE
-void repl_input(char *input) {
-
-    /* Create the repl if we haven't yet */
-    if (!repl_fiber) {
-        printf("initialize the repl first");
-    }
-
-    /* Now fill the pending line_buffer and resume the repl loop */
-    if (line_buffer) {
-        janet_buffer_push_cstring(line_buffer, input);
-        line_buffer = NULL;
-        enter_loop();
-    }
-}

src/webclient/webinit.janet

@@ -1,12 +0,0 @@
-# Copyright 2017-2019 (C) Calvin Rose
-
-(print (string "Janet " janet/version "-" janet/build "  Copyright (C) 2017-2019 Calvin Rose"))
-
-(fiber/new (fn webrepl []
-             (setdyn :pretty-format "%.20P")
-             (repl (fn get-line [buf p]
-                     (def [offset] (parser/where p))
-                     (def prompt (string "janet:" offset ":" (parser/state p :delimiters) "> "))
-                     (repl-yield prompt buf)
-                     (yield)
-                     buf))))

test/amalg/main.c

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

test/helper.janet

@@ -6,7 +6,9 @@
 (var numchecks 0)
 (var start-time 0)
 
-(defn assert [x e]
+(defn assert
+  "Override's the default assert with some nice error handling."
+  [x e]
   (++ num-tests-run)
   (when x (++ num-tests-passed))
   (if x

test/install/project.janet

@@ -5,6 +5,10 @@
     :name "testmod"
     :source @["testmod.c"])
 
+(declare-native
+    :name "testmod2"
+    :source @["testmod2.c"])
+
 (declare-executable
   :name "testexec"
   :entry "testexec.janet")

test/install/testexec.janet

@@ -1,5 +1,6 @@
 (use build/testmod)
+(use build/testmod2)
 
 (defn main [&]
   (print "Hello from executable!")
-  (print (get5)))
+  (print (+ (get5) (get6))))

test/install/testmod.c

@@ -1,5 +1,5 @@
 /*
-* Copyright (c) 2019 Calvin Rose and contributors
+* Copyright (c) 2020 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

test/install/testmod2.c

@@ -0,0 +1,40 @@
+/*
+* Copyright (c) 2020 Calvin Rose and contributors
+*
+* Permission is hereby granted, free of charge, to any person obtaining a copy
+* of this software and associated documentation files (the "Software"), to
+* deal in 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.
+*/
+
+/* A very simple native module */
+
+#include <janet.h>
+
+static Janet cfun_get_six(int32_t argc, Janet *argv) {
+    (void) argv;
+    janet_fixarity(argc, 0);
+    return janet_wrap_number(6.0);
+}
+
+static const JanetReg array_cfuns[] = {
+    {"get6", cfun_get_six, NULL},
+    {NULL, NULL, NULL}
+};
+
+JANET_MODULE_ENTRY(JanetTable *env) {
+    janet_cfuns(env, NULL, array_cfuns);
+}

test/suite0.janet

@@ -1,4 +1,4 @@
-# Copyright (c) 2019 Calvin Rose
+# Copyright (c) 2020 Calvin Rose
 #
 # Permission is hereby granted, free of charge, to any person obtaining a copy
 # of this software and associated documentation files (the "Software"), to
@@ -37,18 +37,18 @@
 (assert (= 7 (% 20 13)) "modulo 1")
 (assert (= -7 (% -20 13)) "modulo 2")
 
-(assert (order< 1.0 nil false true
+(assert (< 1.0 nil false true
-                (fiber/new (fn [] 1))
+           (fiber/new (fn [] 1))
-                "hi"
+           "hi"
-                (quote hello)
+           (quote hello)
-                :hello
+           :hello
-                (array 1 2 3)
+           (array 1 2 3)
-                (tuple 1 2 3)
+           (tuple 1 2 3)
-                (table "a" "b" "c" "d")
+           (table "a" "b" "c" "d")
-                (struct 1 2 3 4)
+           (struct 1 2 3 4)
-                (buffer "hi")
+           (buffer "hi")
-                (fn [x] (+ x x))
+           (fn [x] (+ x x))
-                print) "type ordering")
+           print) "type ordering")
 
 (assert (= (string (buffer "123" "456")) (string @"123456")) "buffer literal")
 (assert (= (get {} 1) nil) "get nil from empty struct")

test/suite1.janet

@@ -1,4 +1,4 @@
-# Copyright (c) 2019 Calvin Rose
+# Copyright (c) 2020 Calvin Rose
 #
 # Permission is hereby granted, free of charge, to any person obtaining a copy
 # of this software and associated documentation files (the "Software"), to
@@ -212,13 +212,17 @@
 
 (assert (= 7 (case :a :b 5 :c 6 :u 10 7)) "case with default")
 
-# Testing the loop and for macros
+# Testing the loop and seq macros
 (def xs (apply tuple (seq [x :range [0 10] :when (even? x)] (tuple (/ x 2) x))))
 (assert (= xs '((0 0) (1 2) (2 4) (3 6) (4 8))) "seq macro 1")
 
 (def xs (apply tuple (seq [x :down [8 -2] :when (even? x)] (tuple (/ x 2) x))))
 (assert (= xs '((4 8) (3 6) (2 4) (1 2) (0 0))) "seq macro 2")
 
+# :range-to and :down-to
+(assert (deep= (seq [x :range-to [0 10]] x) (seq [x :range [0 11]] x)) "loop :range-to")
+(assert (deep= (seq [x :down-to [10 0]] x) (seq [x :down [10 -1]] x)) "loop :down-to")
+
 # Some testing for not=
 (assert (not= 1 1 0) "not= 1")
 (assert (not= 0 1 1) "not= 2")
@@ -232,11 +236,11 @@
 (assert (= 4 ((get closures 4))) "closure in loop 4")
 
 # More numerical tests
-(assert (== 1 1.0) "numerical equal 1")
+(assert (= 1 1.0) "numerical equal 1")
-(assert (== 0 0.0) "numerical equal 2")
+(assert (= 0 0.0) "numerical equal 2")
-(assert (== 0 -0.0) "numerical equal 3")
+(assert (= 0 -0.0) "numerical equal 3")
-(assert (== 2_147_483_647 2_147_483_647.0) "numerical equal 4")
+(assert (= 2_147_483_647 2_147_483_647.0) "numerical equal 4")
-(assert (== -2_147_483_648 -2_147_483_648.0) "numerical equal 5")
+(assert (= -2_147_483_648 -2_147_483_648.0) "numerical equal 5")
 
 # Array tests
 
@@ -255,4 +259,26 @@
 (assert (array= (array/slice @[1 2 3] 0 2) @[1 2]) "array/slice 1")
 (assert (array= (array/slice @[0 7 3 9 1 4] 2 -2) @[3 9 1]) "array/slice 2")
 
+# Even and odd
+
+(assert (odd? 9) "odd? 1")
+(assert (odd? -9) "odd? 2")
+(assert (not (odd? 10)) "odd? 3")
+(assert (not (odd? 0)) "odd? 4")
+(assert (not (odd? -10)) "odd? 5")
+(assert (not (odd? 1.1)) "odd? 6")
+(assert (not (odd? -0.1)) "odd? 7")
+(assert (not (odd? -1.1)) "odd? 8")
+(assert (not (odd? -1.6)) "odd? 9")
+
+(assert (even? 10) "even? 1")
+(assert (even? -10) "even? 2")
+(assert (even? 0) "even? 3")
+(assert (not (even? 9)) "even? 4")
+(assert (not (even? -9)) "even? 5")
+(assert (not (even? 0.1)) "even? 6")
+(assert (not (even? -0.1)) "even? 7")
+(assert (not (even? -10.1)) "even? 8")
+(assert (not (even? -10.6)) "even? 9")
+
 (end-suite)

test/suite2.janet

@@ -1,4 +1,4 @@
-#' Copyright (c) 2019 Calvin Rose
+#' Copyright (c) 2020 Calvin Rose
 #
 # Permission is hereby granted, free of charge, to any person obtaining a copy
 # of this software and associated documentation files (the "Software"), to

test/suite3.janet

@@ -1,4 +1,4 @@
-# Copyright (c) 2019 Calvin Rose
+# Copyright (c) 2020 Calvin Rose
 #
 # Permission is hereby granted, free of charge, to any person obtaining a copy
 # of this software and associated documentation files (the "Software"), to
@@ -203,12 +203,12 @@
 (defn check-match
   [pat text should-match]
   (def result (peg/match pat text))
-  (assert (= (not should-match) (not result)) text))
+  (assert (= (not should-match) (not result)) (string "check-match " text)))
 
 (defn check-deep
   [pat text what]
   (def result (peg/match pat text))
-  (assert (deep= result what) text))
+  (assert (deep= result what) (string "check-deep " text)))
 
 # Just numbers
 

test/suite4.janet

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

test/suite5.janet

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

test/suite6.janet

@@ -1,4 +1,4 @@
-# Copyright (c) 2019 Calvin Rose & contributors
+# Copyright (c) 2020 Calvin Rose & contributors
 #
 # Permission is hereby granted, free of charge, to any person obtaining a copy
 # of this software and associated documentation files (the "Software"), to
@@ -62,8 +62,8 @@
    # just to big
    (def d (u64 "123456789123456789123456789"))))
 
-(assert (:== (:/ (u64 "0xffff_ffff_ffff_ffff") 8 2) "0xfffffffffffffff") "bigint operations")
+(assert (= (:/ (u64 "0xffff_ffff_ffff_ffff") 8 2) (u64 "0xfffffffffffffff")) "bigint operations 1")
-(assert (let [a (u64 0xff)] (:== (:+ a a a a) (:* a 2 2))) "bigint operations")
+(assert (let [a (u64 0xff)] (= (:+ a a a a) (:* a 2 2))) "bigint operations 2")
 
 (assert (= (string (i64 -123)) "-123") "i64 prints reasonably")
 (assert (= (string (u64 123)) "123") "u64 prints reasonably")
@@ -72,9 +72,6 @@
  "trap INT64_MIN / -1"
  (:/ (int/s64 "-0x8000_0000_0000_0000") -1))
 
-# in place operators
-(assert (let [a (u64 1e10)] (:+! a 1000000 "1000000" "0xffff") (:== a 10002065535)) "in place operators")
-
 # int64 typed arrays
 (assert (let [t (tarray/new :int64 10)
               b (i64 1000)]
@@ -84,10 +81,10 @@
           (set (t 3) (t 0))
           (set (t 4) (u64 1000))
           (and
-           (:== (t 0) (t 1))
+           (= (t 0) (t 1))
-           (:== (t 1) (t 2))
+           (= (t 1) (t 2))
-           (:== (t 2) (t 3))
+           (= (t 2) (t 3))
-           (:== (t 3) (t 4))
+           (= (t 3) (t 4))
            ))
         "int64 typed arrays")
 
@@ -167,6 +164,11 @@
 (defn test-expand [path temp]
   (string (module/expand-path path temp)))
 
+# Right hand operators
+(assert (= (int/s64 (sum (range 10))) (sum (map int/s64 (range 10)))) "right hand operators 1")
+(assert (= (int/s64 (product (range 1 10))) (product (map int/s64 (range 1 10)))) "right hand operators 2")
+(assert (= (int/s64 15) (bor 10 (int/s64 5)) (bor (int/s64 10) 5)) "right hand operators 3")
+
 (assert (= (test-expand "abc" ":cur:/:all:") "some-dir/abc") "module/expand-path 1")
 (assert (= (test-expand "./abc" ":cur:/:all:") "some-dir/abc") "module/expand-path 2")
 (assert (= (test-expand "abc/def.txt" ":cur:/:name:") "some-dir/def.txt") "module/expand-path 3")

test/suite7.janet

@@ -1,4 +1,4 @@
-# Copyright (c) 2019 Calvin Rose & contributors
+# Copyright (c) 2020 Calvin Rose & contributors
 #
 # Permission is hereby granted, free of charge, to any person obtaining a copy
 # of this software and associated documentation files (the "Software"), to
@@ -226,6 +226,23 @@
                 :week-day 3}
                (os/date 1388608200)) "os/date")
 
+# OS mktime test
+
+(assert (= 1388608200 (os/mktime {:year-day 0
+                                  :minutes 30
+                                  :month 0
+                                  :dst false
+                                  :seconds 0
+                                  :year 2014
+                                  :month-day 0
+                                  :hours 20
+                                  :week-day 3})) "os/mktime")
+
+(def now (os/time))
+(assert (= (os/mktime (os/date now)) now) "UTC os/mktime")
+(assert (= (os/mktime (os/date now true) true) now) "local os/mktime")
+(assert (= (os/mktime {:year 1970}) 0) "os/mktime default values")
+
 # Appending buffer to self
 
 (with-dyns [:out @""]
@@ -277,4 +294,26 @@
 
 (assert (= (constantly) (constantly)) "comptime 1")
 
+(assert-error "arity issue in macro" (eval '(each [])))
+(assert-error "comptime issue" (eval '(comptime (error "oops"))))
+
+(with [f (file/temp)]
+  (file/write f "foo\n")
+  (file/flush f)
+  (file/seek f :set 0)
+  (assert (= (string (file/read f :all)) "foo\n") "temp files work"))
+
+(var counter 0)
+(when-with [x nil |$]
+           (++ counter))
+(when-with [x 10 |$]
+           (+= counter 10))
+
+(assert (= 10 counter) "when-with 1")
+
+(if-with [x nil |$] (++ counter) (+= counter 10))
+(if-with [x true |$] (+= counter 20) (+= counter 30))
+
+(assert (= 40 counter) "if-with 1")
+
 (end-suite)

test/suite8.janet

@@ -0,0 +1,197 @@
+# Copyright (c) 2020 Calvin Rose & contributors
+#
+# Permission is hereby granted, free of charge, to any person obtaining a copy
+# of this software and associated documentation files (the "Software"), to
+# deal in the Software without restriction, including without limitation the
+# rights to use, copy, modify, merge, publish, distribute, sublicense, and/or
+# sell copies of the Software, and to permit persons to whom the Software is
+# furnished to do so, subject to the following conditions:
+#
+# The above copyright notice and this permission notice shall be included in
+# all copies or substantial portions of the Software.
+#
+# THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+# IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+# FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
+# AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
+# LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
+# FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS
+# IN THE SOFTWARE.
+
+(import ./helper :prefix "" :exit true)
+(start-suite 8)
+
+###
+### Compiling brainfuck to Janet.
+###
+
+(def- bf-peg
+  "Peg for compiling brainfuck into a Janet source ast."
+  (peg/compile
+    ~{:+ (/ '(some "+") ,(fn [x] ~(+= (DATA POS) ,(length x))))
+      :- (/ '(some "-") ,(fn [x] ~(-= (DATA POS) ,(length x))))
+      :> (/ '(some ">") ,(fn [x] ~(+= POS ,(length x))))
+      :< (/ '(some "<") ,(fn [x] ~(-= POS ,(length x))))
+      :. (* "." (constant (prinf "%c" (get DATA POS))))
+      :loop (/ (* "[" :main "]") ,(fn [& captures]
+                                    ~(while (not= (get DATA POS) 0)
+                                       ,;captures)))
+      :main (any (+ :s :loop :+ :- :> :< :.)) }))
+
+(defn bf
+  "Run brainfuck."
+  [text]
+  (eval
+    ~(let [DATA (array/new-filled 100 0)]
+       (var POS 50)
+       ,;(peg/match bf-peg text))))
+
+(defn test-bf
+  "Test some bf for expected output."
+  [input output]
+  (def b @"")
+  (with-dyns [:out b]
+    (bf input))
+  (assert (= (string output) (string b))
+          (string "bf input '"
+                  input
+                  "' failed, expected "
+                  (describe output)
+                  ", got "
+                  (describe (string b))
+                  ".")))
+
+(test-bf "++++++++[>++++[>++>+++>+++>+<<<<-]>+>+>->>+[<]<-]>>.>---.+++++++..+++.>>.<-.<.+++.------.--------.>>+.>++." "Hello World!\n")
+
+(test-bf ">++++++++[-<+++++++++>]<.>>+>-[+]++>++>+++[>[->+++<<+++>]<<]>-----.>->
++++..+++.>-.<<+[>[+>+]>>]<--------------.>>.+++.------.--------.>+.>+."
+         "Hello World!\n")
+
+(test-bf "+[+[<<<+>>>>]+<-<-<<<+<++]<<.<++.<++..+++.<<++.<---.>>.>.+++.------.>-.>>--."
+         "Hello, World!")
+
+# Prompts and Labels
+
+(assert (= 10 (label a (for i 0 10 (if (= i 5) (return a 10))))) "label 1")
+
+(defn recur
+  [lab x y]
+  (when (= x y) (return lab :done))
+  (def res (label newlab (recur (or lab newlab) (+ x 1) y)))
+  (if lab :oops res))
+(assert (= :done (recur nil 0 10)) "label 2")
+
+(assert (= 10 (prompt :a (for i 0 10 (if (= i 5) (return :a 10))))) "prompt 1")
+
+(defn- inner-loop
+  [i]
+  (if (= i 5)
+    (return :a 10)))
+
+(assert (= 10 (prompt :a (for i 0 10 (inner-loop i)))) "prompt 2")
+
+(defn- inner-loop2
+  [i]
+  (try
+    (if (= i 5)
+      (error 10))
+    ([err] (return :a err))))
+
+(assert (= 10 (prompt :a (for i 0 10 (inner-loop2 i)))) "prompt 3")
+
+# Match checks
+
+(assert (= :hi (match nil nil :hi)) "match 1")
+(assert (= :hi (match {:a :hi} {:a a} a)) "match 2")
+(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")
+
+# And/or checks
+
+(assert (= false (and false false)) "and 1")
+(assert (= false (or false false)) "or 1")
+
+# #300 Regression test
+
+# Just don't segfault
+(assert (peg/match '{:main (replace "S" {"S" :spade})} "S7") "regression #300")
+
+# Test cases for #293
+(assert (= :yes (match [1 2 3] [_ a _] :yes :no)) "match wildcard 1")
+(assert (= :no (match [1 2 3] [__ a __] :yes :no)) "match wildcard 2")
+(assert (= :yes (match [1 2 [1 2 3]] [_ a [_ _ _]] :yes :no)) "match wildcard 3")
+(assert (= :yes (match [1 2 3] (_ (even? 2)) :yes :no)) "match wildcard 4")
+(assert (= :yes (match {:a 1} {:a _} :yes :no)) "match wildcard 5")
+(assert (= false (match {:a 1 :b 2 :c 3} {:a a :b _ :c _ :d _} :no {:a _ :b _ :c _} false :no)) "match wildcard 6")
+(assert (= nil (match {:a 1 :b 2 :c 3} {:a a :b _ :c _ :d _} :no {:a _ :b _ :c _} nil :no)) "match wildcard 7")
+
+# Regression #301
+(def b (buffer/new-filled 128 0x78))
+(assert (= 38 (length (buffer/blit @"" b -1 90))) "buffer/blit 1")
+
+(def a @"abcdefghijklm")
+(assert (deep= @"abcde" (buffer/blit @"" a -1 0 5)) "buffer/blit 2")
+(assert (deep= @"bcde" (buffer/blit @"" a -1 1 5)) "buffer/blit 3")
+(assert (deep= @"cde" (buffer/blit @"" a -1 2 5)) "buffer/blit 4")
+(assert (deep= @"de" (buffer/blit @"" a -1 3 5)) "buffer/blit 5")
+
+# chr
+(assert (= (chr "a") 97) "chr 1")
+
+# Detaching closure over non resumable fiber.
+(do
+  (defn f1
+    [a]
+    (defn f1 [] (++ (a 0)))
+    (defn f2 [] (++ (a 0)))
+    (error [f1 f2]))
+  (def [_ [f1 f2]] (protect (f1 @[0])))
+  # At time of writing, mark phase can detach closure envs.
+  (gccollect)
+  (assert (= 1 (f1)) "detach-non-resumable-closure 1")
+  (assert (= 2 (f2)) "detach-non-resumable-closure 2"))
+
+# Marshal closure over non resumable fiber.
+(do
+  (defn f1
+    [a]
+    (defn f1 [] (++ (a 0)))
+    (defn f2 [] (++ (a 0)))
+    (error [f1 f2]))
+  (def [_ tup] (protect (f1 @[0])))
+  (def [f1 f2] (unmarshal (marshal tup make-image-dict) load-image-dict))
+  (assert (= 1 (f1)) "marshal-non-resumable-closure 1")
+  (assert (= 2 (f2)) "marshal-non-resumable-closure 2"))
+
+# Marshal closure over currently alive fiber.
+(do
+  (defn f1
+    [a]
+    (defn f1 [] (++ (a 0)))
+    (defn f2 [] (++ (a 0)))
+    (marshal [f1 f2] make-image-dict))
+  (def [f1 f2] (unmarshal (f1 @[0]) load-image-dict))
+  (assert (= 1 (f1)) "marshal-live-closure 1")
+  (assert (= 2 (f2)) "marshal-live-closure 2"))
+
+(do
+  (var a 1)
+  (defn b [x] (+ a x))
+  (def c (unmarshal (marshal b)))
+  (assert (= 2 (c 1)) "marshal-on-stack-closure 1"))
+
+# Reduce2
+
+(assert (= (reduce + 0 (range 1 10)) (reduce2 + (range 10))) "reduce2 1")
+(assert (= (reduce * 1 (range 2 10)) (reduce2 * (range 1 10))) "reduce2 2")
+(assert (= nil (reduce2 * [])) "reduce2 3")
+
+# Accumulate
+
+(assert (deep= (accumulate + 0 (range 5)) @[0 1 3 6 10]) "accumulate 1")
+(assert (deep= (accumulate2 + (range 5)) @[0 1 3 6 10]) "accumulate2 1")
+(assert (deep= @[] (accumulate2 + [])) "accumulate2 2")
+(assert (deep= @[] (accumulate 0 + [])) "accumulate 2")
+
+(end-suite)

tools/EnvVarUpdate.nsh

@@ -1,327 +0,0 @@
-/**
- *  EnvVarUpdate.nsh
- *    : Environmental Variables: append, prepend, and remove entries
- *
- *     WARNING: If you use StrFunc.nsh header then include it before this file
- *              with all required definitions. This is to avoid conflicts
- *
- *  Usage:
- *    ${EnvVarUpdate} "ResultVar" "EnvVarName" "Action" "RegLoc" "PathString"
- *
- *  Credits:
- *  Version 1.0 
- *  * Cal Turney (turnec2)
- *  * Amir Szekely (KiCHiK) and e-circ for developing the forerunners of this
- *    function: AddToPath, un.RemoveFromPath, AddToEnvVar, un.RemoveFromEnvVar,
- *    WriteEnvStr, and un.DeleteEnvStr
- *  * Diego Pedroso (deguix) for StrTok
- *  * Kevin English (kenglish_hi) for StrContains
- *  * Hendri Adriaens (Smile2Me), Diego Pedroso (deguix), and Dan Fuhry  
- *    (dandaman32) for StrReplace
- *
- *  Version 1.1 (compatibility with StrFunc.nsh)
- *  * techtonik
- *
- *  http://nsis.sourceforge.net/Environmental_Variables:_append%2C_prepend%2C_and_remove_entries
- *
- */
- 
- 
-!ifndef ENVVARUPDATE_FUNCTION
-!define ENVVARUPDATE_FUNCTION
-!verbose push
-!verbose 3
-!include "LogicLib.nsh"
-!include "WinMessages.NSH"
-!include "StrFunc.nsh"
- 
-; ---- Fix for conflict if StrFunc.nsh is already includes in main file -----------------------
-!macro _IncludeStrFunction StrFuncName
-  !ifndef ${StrFuncName}_INCLUDED
-    ${${StrFuncName}}
-  !endif
-  !ifndef Un${StrFuncName}_INCLUDED
-    ${Un${StrFuncName}}
-  !endif
-  !define un.${StrFuncName} "${Un${StrFuncName}}"
-!macroend
- 
-!insertmacro _IncludeStrFunction StrTok
-!insertmacro _IncludeStrFunction StrStr
-!insertmacro _IncludeStrFunction StrRep
- 
-; ---------------------------------- Macro Definitions ----------------------------------------
-!macro _EnvVarUpdateConstructor ResultVar EnvVarName Action Regloc PathString
-  Push "${EnvVarName}"
-  Push "${Action}"
-  Push "${RegLoc}"
-  Push "${PathString}"
-    Call EnvVarUpdate
-  Pop "${ResultVar}"
-!macroend
-!define EnvVarUpdate '!insertmacro "_EnvVarUpdateConstructor"'
- 
-!macro _unEnvVarUpdateConstructor ResultVar EnvVarName Action Regloc PathString
-  Push "${EnvVarName}"
-  Push "${Action}"
-  Push "${RegLoc}"
-  Push "${PathString}"
-    Call un.EnvVarUpdate
-  Pop "${ResultVar}"
-!macroend
-!define un.EnvVarUpdate '!insertmacro "_unEnvVarUpdateConstructor"'
-; ---------------------------------- Macro Definitions end-------------------------------------
- 
-;----------------------------------- EnvVarUpdate start----------------------------------------
-!define hklm_all_users     'HKLM "SYSTEM\CurrentControlSet\Control\Session Manager\Environment"'
-!define hkcu_current_user  'HKCU "Environment"'
- 
-!macro EnvVarUpdate UN
- 
-Function ${UN}EnvVarUpdate
- 
-  Push $0
-  Exch 4
-  Exch $1
-  Exch 3
-  Exch $2
-  Exch 2
-  Exch $3
-  Exch
-  Exch $4
-  Push $5
-  Push $6
-  Push $7
-  Push $8
-  Push $9
-  Push $R0
- 
-  /* After this point:
-  -------------------------
-     $0 = ResultVar     (returned)
-     $1 = EnvVarName    (input)
-     $2 = Action        (input)
-     $3 = RegLoc        (input)
-     $4 = PathString    (input)
-     $5 = Orig EnvVar   (read from registry)
-     $6 = Len of $0     (temp)
-     $7 = tempstr1      (temp)
-     $8 = Entry counter (temp)
-     $9 = tempstr2      (temp)
-     $R0 = tempChar     (temp)  */
- 
-  ; Step 1:  Read contents of EnvVarName from RegLoc
-  ;
-  ; Check for empty EnvVarName
-  ${If} $1 == ""
-    SetErrors
-    DetailPrint "ERROR: EnvVarName is blank"
-    Goto EnvVarUpdate_Restore_Vars
-  ${EndIf}
- 
-  ; Check for valid Action
-  ${If}    $2 != "A"
-  ${AndIf} $2 != "P"
-  ${AndIf} $2 != "R"
-    SetErrors
-    DetailPrint "ERROR: Invalid Action - must be A, P, or R"
-    Goto EnvVarUpdate_Restore_Vars
-  ${EndIf}
- 
-  ${If} $3 == HKLM
-    ReadRegStr $5 ${hklm_all_users} $1     ; Get EnvVarName from all users into $5
-  ${ElseIf} $3 == HKCU
-    ReadRegStr $5 ${hkcu_current_user} $1  ; Read EnvVarName from current user into $5
-  ${Else}
-    SetErrors
-    DetailPrint 'ERROR: Action is [$3] but must be "HKLM" or HKCU"'
-    Goto EnvVarUpdate_Restore_Vars
-  ${EndIf}
- 
-  ; Check for empty PathString
-  ${If} $4 == ""
-    SetErrors
-    DetailPrint "ERROR: PathString is blank"
-    Goto EnvVarUpdate_Restore_Vars
-  ${EndIf}
- 
-  ; Make sure we've got some work to do
-  ${If} $5 == ""
-  ${AndIf} $2 == "R"
-    SetErrors
-    DetailPrint "$1 is empty - Nothing to remove"
-    Goto EnvVarUpdate_Restore_Vars
-  ${EndIf}
- 
-  ; Step 2: Scrub EnvVar
-  ;
-  StrCpy $0 $5                             ; Copy the contents to $0
-  ; Remove spaces around semicolons (NOTE: spaces before the 1st entry or
-  ; after the last one are not removed here but instead in Step 3)
-  ${If} $0 != ""                           ; If EnvVar is not empty ...
-    ${Do}
-      ${${UN}StrStr} $7 $0 " ;"
-      ${If} $7 == ""
-        ${ExitDo}
-      ${EndIf}
-      ${${UN}StrRep} $0  $0 " ;" ";"         ; Remove '<space>;'
-    ${Loop}
-    ${Do}
-      ${${UN}StrStr} $7 $0 "; "
-      ${If} $7 == ""
-        ${ExitDo}
-      ${EndIf}
-      ${${UN}StrRep} $0  $0 "; " ";"         ; Remove ';<space>'
-    ${Loop}
-    ${Do}
-      ${${UN}StrStr} $7 $0 ";;" 
-      ${If} $7 == ""
-        ${ExitDo}
-      ${EndIf}
-      ${${UN}StrRep} $0  $0 ";;" ";"
-    ${Loop}
- 
-    ; Remove a leading or trailing semicolon from EnvVar
-    StrCpy  $7  $0 1 0
-    ${If} $7 == ";"
-      StrCpy $0  $0 "" 1                   ; Change ';<EnvVar>' to '<EnvVar>'
-    ${EndIf}
-    StrLen $6 $0
-    IntOp $6 $6 - 1
-    StrCpy $7  $0 1 $6
-    ${If} $7 == ";"
-     StrCpy $0  $0 $6                      ; Change ';<EnvVar>' to '<EnvVar>'
-    ${EndIf}
-    ; DetailPrint "Scrubbed $1: [$0]"      ; Uncomment to debug
-  ${EndIf}
- 
-  /* Step 3. Remove all instances of the target path/string (even if "A" or "P")
-     $6 = bool flag (1 = found and removed PathString)
-     $7 = a string (e.g. path) delimited by semicolon(s)
-     $8 = entry counter starting at 0
-     $9 = copy of $0
-     $R0 = tempChar      */
- 
-  ${If} $5 != ""                           ; If EnvVar is not empty ...
-    StrCpy $9 $0
-    StrCpy $0 ""
-    StrCpy $8 0
-    StrCpy $6 0
- 
-    ${Do}
-      ${${UN}StrTok} $7 $9 ";" $8 "0"      ; $7 = next entry, $8 = entry counter
- 
-      ${If} $7 == ""                       ; If we've run out of entries,
-        ${ExitDo}                          ;    were done
-      ${EndIf}                             ;
- 
-      ; Remove leading and trailing spaces from this entry (critical step for Action=Remove)
-      ${Do}
-        StrCpy $R0  $7 1
-        ${If} $R0 != " "
-          ${ExitDo}
-        ${EndIf}
-        StrCpy $7   $7 "" 1                ;  Remove leading space
-      ${Loop}
-      ${Do}
-        StrCpy $R0  $7 1 -1
-        ${If} $R0 != " "
-          ${ExitDo}
-        ${EndIf}
-        StrCpy $7   $7 -1                  ;  Remove trailing space
-      ${Loop}
-      ${If} $7 == $4                       ; If string matches, remove it by not appending it
-        StrCpy $6 1                        ; Set 'found' flag
-      ${ElseIf} $7 != $4                   ; If string does NOT match
-      ${AndIf}  $0 == ""                   ;    and the 1st string being added to $0,
-        StrCpy $0 $7                       ;    copy it to $0 without a prepended semicolon
-      ${ElseIf} $7 != $4                   ; If string does NOT match
-      ${AndIf}  $0 != ""                   ;    and this is NOT the 1st string to be added to $0,
-        StrCpy $0 $0;$7                    ;    append path to $0 with a prepended semicolon
-      ${EndIf}                             ;
- 
-      IntOp $8 $8 + 1                      ; Bump counter
-    ${Loop}                                ; Check for duplicates until we run out of paths
-  ${EndIf}
- 
-  ; Step 4:  Perform the requested Action
-  ;
-  ${If} $2 != "R"                          ; If Append or Prepend
-    ${If} $6 == 1                          ; And if we found the target
-      DetailPrint "Target is already present in $1. It will be removed and"
-    ${EndIf}
-    ${If} $0 == ""                         ; If EnvVar is (now) empty
-      StrCpy $0 $4                         ;   just copy PathString to EnvVar
-      ${If} $6 == 0                        ; If found flag is either 0
-      ${OrIf} $6 == ""                     ; or blank (if EnvVarName is empty)
-        DetailPrint "$1 was empty and has been updated with the target"
-      ${EndIf}
-    ${ElseIf} $2 == "A"                    ;  If Append (and EnvVar is not empty),
-      StrCpy $0 $0;$4                      ;     append PathString
-      ${If} $6 == 1
-        DetailPrint "appended to $1"
-      ${Else}
-        DetailPrint "Target was appended to $1"
-      ${EndIf}
-    ${Else}                                ;  If Prepend (and EnvVar is not empty),
-      StrCpy $0 $4;$0                      ;     prepend PathString
-      ${If} $6 == 1
-        DetailPrint "prepended to $1"
-      ${Else}
-        DetailPrint "Target was prepended to $1"
-      ${EndIf}
-    ${EndIf}
-  ${Else}                                  ; If Action = Remove
-    ${If} $6 == 1                          ;   and we found the target
-      DetailPrint "Target was found and removed from $1"
-    ${Else}
-      DetailPrint "Target was NOT found in $1 (nothing to remove)"
-    ${EndIf}
-    ${If} $0 == ""
-      DetailPrint "$1 is now empty"
-    ${EndIf}
-  ${EndIf}
- 
-  ; Step 5:  Update the registry at RegLoc with the updated EnvVar and announce the change
-  ;
-  ClearErrors
-  ${If} $3  == HKLM
-    WriteRegExpandStr ${hklm_all_users} $1 $0     ; Write it in all users section
-  ${ElseIf} $3 == HKCU
-    WriteRegExpandStr ${hkcu_current_user} $1 $0  ; Write it to current user section
-  ${EndIf}
- 
-  IfErrors 0 +4
-    MessageBox MB_OK|MB_ICONEXCLAMATION "Could not write updated $1 to $3"
-    DetailPrint "Could not write updated $1 to $3"
-    Goto EnvVarUpdate_Restore_Vars
- 
-  ; "Export" our change
-  SendMessage ${HWND_BROADCAST} ${WM_WININICHANGE} 0 "STR:Environment" /TIMEOUT=5000
- 
-  EnvVarUpdate_Restore_Vars:
-  ;
-  ; Restore the user's variables and return ResultVar
-  Pop $R0
-  Pop $9
-  Pop $8
-  Pop $7
-  Pop $6
-  Pop $5
-  Pop $4
-  Pop $3
-  Pop $2
-  Pop $1
-  Push $0  ; Push my $0 (ResultVar)
-  Exch
-  Pop $0   ; Restore his $0
- 
-FunctionEnd
- 
-!macroend   ; EnvVarUpdate UN
-!insertmacro EnvVarUpdate ""
-!insertmacro EnvVarUpdate "un."
-;----------------------------------- EnvVarUpdate end----------------------------------------
- 
-!verbose pop
-!endif

tools/amalg.janet

@@ -5,6 +5,7 @@
 (print "/* Generated from janet version " janet/version "-" janet/build " */")
 (print "#define JANET_BUILD \"" janet/build "\"")
 (print ```#define JANET_AMALG```)
+(print ```#define _POSIX_C_SOURCE 200112L```)
 (print ```#include "janet.h"```)
 
 # Body

tools/symcharsgen.c

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

tools/xxd.c

@@ -1,104 +0,0 @@
-/*
-* Copyright (c) 2019 Calvin 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.
-*/
-
-/* Simple clone of the xxd tool used at build time. Used to
- * create headers out of source files. Only used for core libraries
- * like the bootstrapping code and the stl. */
-
-#include <stdlib.h>
-#include <stdio.h>
-#include <stdint.h>
-
-#define BUFSIZE 1024
-#define PERLINE 10
-
-int main(int argc, const char **argv) {
-
-    static const char hex[] = "0123456789ABCDEF";
-    char buf[BUFSIZE];
-    size_t bytesRead = 0;
-    int32_t totalRead = 0;
-    int lineIndex = 0;
-    int line = 0;
-
-    if (argc != 4) {
-        fprintf(stderr, "Usage: %s infile outfile symbol\n", argv[0]);
-        return 1;
-    }
-
-    /* Open the files */
-    FILE *in = fopen(argv[1], "rb");
-    FILE *out = fopen(argv[2], "wb");
-
-    /* Check if files open successfully */
-    if (in == NULL) {
-        fprintf(stderr, "Could not open input file %s\n", argv[1]);
-        return 1;
-    } else if (out == NULL) {
-        fprintf(stderr, "Could not open output file %s\n", argv[2]);
-        return 1;
-    }
-
-    /* Write the header */
-    fprintf(out, "/* Auto generated - DO NOT EDIT */\n\n#include <stdint.h>\n\n");
-    fprintf(out, "static const unsigned char bytes_%s[] = {", argv[3]);
-
-    /* Read in chunks from buffer */
-    while ((bytesRead = fread(buf, 1, sizeof(buf), in)) > 0) {
-        size_t i;
-        totalRead += bytesRead;
-        for (i = 0; i < bytesRead; ++i) {
-            int byte = ((uint8_t *)buf) [i];
-
-            /* Write the byte */
-            if (lineIndex++ == 0) {
-                if (line++)
-                    fputc(',', out);
-                fputs("\n    ", out);
-            } else {
-                fputs(", ", out);
-            }
-            fputs("0x", out);
-            fputc(hex[byte >> 4], out);
-            fputc(hex[byte & 0xF], out);
-
-            /* Make line index wrap */
-            if (lineIndex >= PERLINE)
-                lineIndex = 0;
-
-        }
-    }
-
-    /* Write the tail */
-    fputs("\n};\n\n", out);
-
-    fprintf(out, "const unsigned char *%s = bytes_%s;\n\n", argv[3], argv[3]);
-
-    /* Write chunk size */
-    fprintf(out, "int32_t %s_size = %d;\n", argv[3], totalRead);
-
-    /* Close the file handles */
-    fclose(in);
-    fclose(out);
-
-    return 0;
-}