Merge branch 'master' into ev

CHANGELOG.md

@@ -2,7 +2,35 @@
 All notable changes to this project will be documented in this file.
 
 ## Unreleased - ???
-- Add JANET_GIT environment variable to jpm to use a specific git binary (useful mainly on windows).
+- `janet_dobytes` and `janet_dostring` return parse errors in \*out
+- Add `repeat` macro for iterating something n times.
+- Add `eachy` (each yield) macro for iterating a fiber.
+- Fix `:generate` verb in loop macro to accept non symbols as bindings.
+- Fix `%j` formatter to print numbers precisely (using the `%.17g` format string to printf).
+
+## 1.10.1 - 2020-06-18
+- Expose `janet_table_clear` in API.
+- Respect `JANET_NO_PROCESSES` define when building
+- Fix `jpm` rules having multiple copies of the same dependency.
+- Fix `jpm` install in some cases.
+- Add `array/trim` and `buffer/trim` to shrink the backing capacity of these types
+  to their current length.
+
+## 1.10.0 - 2020-06-14
+- Hardcode default jpm paths on install so env variables are needed in fewer cases.
+- Add `:no-compile` to `create-executable` option for jpm.
+- Fix bug with the `trace` function.
+- Add `:h`, `:a`, and `:c` flags to `thread/new` for creating new kinds of threads.
+  By default, threads will now consume much less memory per thread, but sending data between
+  threads may cost more.
+- Fix flychecking when using the `use` macro.
+- CTRL-C no longer exits the repl, and instead cancels the current form.
+- Various small bug fixes
+- New MSI installer instead of NSIS based installer.
+- Make `os/realpath` work on windows.
+- Add polymorphic `compare` functions for comparing numbers.
+- Add `to` and `thru` peg combinators.
+- Add `JANET_GIT` environment variable to jpm to use a specific git binary (useful mainly on windows).
 - `asm` and `disasm` functions now use keywords instead of macros for keys. Also
   some slight changes to the way constants are encoded (remove wrapping `quote` in some cases).
 - Expose current macro form inside macros as (dyn :macro-form)

Makefile

@@ -150,7 +150,7 @@ build/janet.c: build/janet_boot src/boot/boot.janet
 ##### Amalgamation #####
 ########################
 
-SONAME=libjanet.so.1.9
+SONAME=libjanet.so.1.10
 
 build/shell.c: src/mainclient/shell.c
 	cp $< $@
@@ -234,6 +234,10 @@ build/doc.html: $(JANET_TARGET) tools/gendoc.janet
 ##### Installation #####
 ########################
 
+build/jpm: jpm $(JANET_TARGET)
+	$(JANET_TARGET) tools/patch-jpm.janet jpm build/jpm "--libpath=$(LIBDIR)" "--headerpath=$(INCLUDEDIR)/janet" "--binpath=$(BINDIR)"
+	chmod +x build/jpm
+
 .INTERMEDIATE: build/janet.pc
 build/janet.pc: $(JANET_TARGET)
 	echo 'prefix=$(PREFIX)' > $@
@@ -249,7 +253,7 @@ build/janet.pc: $(JANET_TARGET)
 	echo 'Libs: -L$${libdir} -ljanet' >> $@
 	echo 'Libs.private: $(CLIBS)' >> $@
 
-install: $(JANET_TARGET) build/janet.pc
+install: $(JANET_TARGET) build/janet.pc build/jpm
 	mkdir -p '$(DESTDIR)$(BINDIR)'
 	cp $(JANET_TARGET) '$(DESTDIR)$(BINDIR)/janet'
 	mkdir -p '$(DESTDIR)$(INCLUDEDIR)/janet'
@@ -260,7 +264,7 @@ install: $(JANET_TARGET) build/janet.pc
 	cp $(JANET_STATIC_LIBRARY) '$(DESTDIR)$(LIBDIR)/libjanet.a'
 	ln -sf $(SONAME) '$(DESTDIR)$(LIBDIR)/libjanet.so'
 	ln -sf libjanet.so.$(shell $(JANET_TARGET) -e '(print janet/version)') $(DESTDIR)$(LIBDIR)/$(SONAME)
-	cp -rf jpm '$(DESTDIR)$(BINDIR)'
+	cp -rf build/jpm '$(DESTDIR)$(BINDIR)'
 	mkdir -p '$(DESTDIR)$(MANPATH)'
 	cp janet.1 '$(DESTDIR)$(MANPATH)'
 	cp jpm.1 '$(DESTDIR)$(MANPATH)'

README.md

@@ -146,6 +146,7 @@ cd janet
 meson setup build \
           --buildtype release \
           --optimization 2 \
+          --libdir /usr/local/lib \
           -Dgit_hash=$(git log --pretty=format:'%h' -n 1)
 ninja -C build
 

jpm

@@ -19,6 +19,9 @@
 # Defaults
 #
 
+###START###
+
+# Overriden on some installs.
 (def- exe-dir
   "Directory containing jpm script"
   (do
@@ -26,21 +29,28 @@
     (def i (last (string/find-all sep exe)))
     (slice exe 0 i)))
 
-(def JANET_MODPATH (or (os/getenv "JANET_MODPATH") (dyn :syspath)))
+(defn- install-paths []
+  {:headerpath (os/realpath (string exe-dir "/../include/janet"))
+   :libpath (os/realpath (string exe-dir "/../lib"))
+   :binpath exe-dir})
+
+###END###
 
 # Default based on janet binary location
 (def JANET_HEADERPATH (or (os/getenv "JANET_HEADERPATH")
-                          (string exe-dir "/../include/janet")))
+                          (get (install-paths) :headerpath)))
 (def JANET_LIBPATH (or (os/getenv "JANET_LIBPATH")
-                       (string exe-dir "/../lib")))
+                       (get (install-paths) :libpath)))
-
 # We want setting JANET_PATH to contain installed binaries. However, it is convenient
 # to have globally installed binaries got to the same place as jpm itself, which is on
 # the $PATH.
 (def JANET_BINPATH (or (os/getenv "JANET_BINPATH")
                        (if-let [mp (os/getenv "JANET_MODPATH")] (string mp "/bin"))
                        (if-let [mp (os/getenv "JANET_PATH")] (string mp "/bin"))
-                       exe-dir))
+                       (get (install-paths) :binpath)))
+
+# modpath should only be derived from the syspath being used or an environment variable.
+(def JANET_MODPATH (or (os/getenv "JANET_MODPATH") (dyn :syspath)))
 
 #
 # Utilities
@@ -66,11 +76,13 @@
 (defn rm
   "Remove a directory and all sub directories."
   [path]
-  (if (= (os/lstat path :mode) :directory)
+  (case (os/lstat path :mode)
-    (do
+    :directory (do
       (each subpath (os/dir path)
         (rm (string path sep subpath)))
       (os/rmdir path))
+    nil nil # do nothing if file does not exist
+    # Default, try to remove
     (os/rm path)))
 
 (defn- rimraf
@@ -78,7 +90,8 @@
   [path]
   (if is-win
     # windows get rid of read-only files
-    (os/shell (string `rmdir /S /Q "` path `"`))
+    (when (os/stat path :mode)
+      (os/shell (string `rmdir /S /Q "` path `"`)))
     (rm path)))
 
 (defn clear-cache
@@ -175,9 +188,27 @@
   (unless item (error (string "No rule for target " target)))
   item)
 
+(defn add-dep
+  "Add a dependency to an existing rule. Useful for extending phony
+  rules or extending the dependency graph of existing rules."
+  [target dep]
+  (def [deps] (gettarget target))
+  (unless (find |(= dep $) deps)
+    (array/push deps dep)))
+
+(defn- add-thunk
+  [target more &opt phony]
+  (def item (gettarget target))
+  (def [_ thunks pthunks] item)
+  (array/push (if phony pthunks thunks) more)
+  item)
+
 (defn- rule-impl
   [target deps thunk &opt phony]
-  (put (getrules) target @[(array/slice deps) @[thunk] phony]))
+  (def rules (getrules))
+  (unless (rules target) (put rules target @[(array/slice deps) @[] @[]]))
+  (each d deps (add-dep target d))
+  (add-thunk target thunk phony))
 
 (defmacro rule
   "Add a rule to the rule graph."
@@ -201,20 +232,6 @@
   [target deps & body]
   ~(,rule-impl ,target ,deps (fn [] (,assert (,zero? (,os/shell (,string ,;body))))) true))
 
-(defn add-dep
-  "Add a dependency to an existing rule. Useful for extending phony
-  rules or extending the dependency graph of existing rules."
-  [target dep]
-  (def [deps] (gettarget target))
-  (array/push deps dep))
-
-(defn- add-thunk
-  [target more]
-  (def item (gettarget target))
-  (def [_ thunks] item)
-  (array/push thunks more)
-  item)
-
 (defmacro add-body
   "Add recipe code to an existing rule. This makes existing rules do more but
   does not modify the dependency graph."
@@ -244,9 +261,11 @@
       (error (string "No rule for file " target " found."))))
   (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))
+  (each thunk phony (thunk))
-    (each thunk thunks (thunk)))
+  (unless (empty? thunks)
-  (unless phony target))
+    (when (needs-build-some target realdeps)
+      (each thunk thunks (thunk))
+    target)))
 
 #
 # Importing a file
@@ -310,26 +329,30 @@
 # Detect threads
 (def env (fiber/getenv (fiber/current)))
 (def threads? (not (not (env 'thread/new))))
-
-# Default libraries to link
 (def- thread-flags
   (if is-win []
     (if threads? ["-lpthread"] [])))
 
-# lflags needed for the janet binary.
+# flags needed for the janet binary and compiling standalone
+# executables.
 (def janet-lflags
   (case (os/which)
     :macos ["-ldl" "-lm" ;thread-flags]
     :windows [;thread-flags]
     :linux ["-lm" "-ldl" "-lrt" ;thread-flags]
     ["-lm" ;thread-flags]))
+(def janet-ldflags [])
+(def janet-cflags [])
 
 # Default flags for natives, but not required
+# How can we better detect the need for -pthread?
+# we probably want to better detect compiler
 (def default-lflags (if is-win ["/nologo"] []))
 (def default-cflags
   (if is-win
     ["/nologo" "/MD"]
     ["-std=c99" "-Wall" "-Wextra"]))
+(def default-ldflags [])
 
 # Required flags for dynamic libraries. These
 # are used no matter what for dynamic libraries.
@@ -339,7 +362,7 @@
     ["-fPIC"]))
 (def- dynamic-lflags
   (if is-win
-    ["/DLL" ;thread-flags]
+    ["/DLL"]
     (if is-mac
       ["-shared" "-undefined" "dynamic_lookup" ;thread-flags]
       ["-shared" ;thread-flags])))
@@ -385,8 +408,8 @@
   "Generate strings for adding custom defines to the compiler."
   [define value]
   (if value
-    (string (if is-win "/D" "-D") define "=" value)
+    (string "-D" define "=" value)
-    (string (if is-win "/D" "-D") define)))
+    (string "-D" define)))
 
 (defn- make-defines
   "Generate many defines. Takes a dictionary of defines. If a value is
@@ -398,8 +421,8 @@
   "Generate the c flags from the input options."
   [opts]
   @[;(opt opts :cflags default-cflags)
-    (string (if is-win "/I" "-I") (dyn :headerpath JANET_HEADERPATH))
+    (string "-I" (dyn :headerpath JANET_HEADERPATH))
-    (string (if is-win "/O" "-O") (opt opts :optimize 2))])
+    (string "-O" (opt opts :optimize 2))])
 
 (defn- entry-name
   "Name of symbol that enters static compilation of a module."
@@ -585,7 +608,8 @@ int main(int argc, const char **argv) {
 
   # Create executable's janet image
   (def cimage_dest (string dest ".c"))
-  (rule dest [source]
+  (def no-compile (opts :no-compile))
+  (rule (if no-compile cimage_dest dest) [source]
         (check-cc)
         (print "generating executable c source...")
         (create-dirs dest)
@@ -641,11 +665,11 @@ int main(int argc, const char **argv) {
         # Append main function
         (spit cimage_dest (make-bin-source declarations lookup-into-invocations) :ab)
         # Compile and link final exectable
-        (do
+        (unless no-compile
           (def cc (opt opts :compiler default-compiler))
-          (def ldflags [;dep-ldflags ;(opt opts :ldflags [])])
+          (def ldflags [;dep-ldflags ;(opt opts :ldflags []) ;janet-ldflags])
           (def lflags [;static-libs (libjanet) ;dep-lflags ;(opt opts :lflags default-lflags) ;janet-lflags])
-          (def cflags (getcflags opts))
+          (def cflags [;(getcflags opts) ;janet-cflags])
           (def defines (make-defines (opt opts :defines {})))
           (print "compiling and linking " dest "...")
           (if is-win
@@ -728,7 +752,7 @@ int main(int argc, const char **argv) {
                 :binpath (abspath (dyn :binpath JANET_BINPATH))]
       (os/cd module-dir)
       (unless fresh
-        (os/execute [(git-path) "pull" "origin" "master"] :p))
+        (os/execute [(git-path) "pull" "origin" "master" "--ff-only"] :p))
       (when tag
         (os/execute [(git-path) "reset" "--hard" tag] :p))
       (unless (dyn :offline)
@@ -747,9 +771,9 @@ int main(int argc, const char **argv) {
   (def name (last parts))
   (def path (string destdir sep name))
   (array/push (dyn :installed-files) path)
-  (add-body "install"
+  (phony "install" []
-            (mkdir destdir)
+          (mkdir destdir)
-            (copy src destdir)))
+          (copy src destdir)))
 
 (defn- make-lockfile
   [&opt filename]
@@ -884,17 +908,22 @@ int main(int argc, const char **argv) {
   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
-          :cflags cflags :lflags lflags :deps deps :ldflags ldflags}]
+          :cflags cflags :lflags lflags :deps deps :ldflags ldflags
+          :no-compile no-compile}]
   (def name (if is-win (string name ".exe") name))
   (def dest (string "build" sep name))
-  (create-executable @{:cflags cflags :lflags lflags :ldflags ldflags} entry dest)
+  (create-executable @{:cflags cflags :lflags lflags :ldflags ldflags :no-compile no-compile} entry dest)
-  (add-dep "build" dest)
+  (if no-compile
-  (when headers
+    (let [cdest (string dest ".c")]
-    (each h headers (add-dep dest h)))
+      (add-dep "build" cdest))
-  (when deps
+    (do
-    (each d deps (add-dep dest d)))
+      (add-dep "build" dest)
-  (when install
+      (when headers
-    (install-rule dest (dyn :binpath JANET_BINPATH))))
+        (each h headers (add-dep dest h)))
+      (when deps
+        (each d deps (add-dep dest d)))
+      (when install
+        (install-rule dest (dyn :binpath JANET_BINPATH))))))
 
 (defn declare-binscript
   "Declare a janet file to be installed as an executable script. Creates
@@ -908,7 +937,7 @@ int main(int argc, const char **argv) {
       (def name (last parts))
       (def path (string binpath sep name))
       (array/push (dyn :installed-files) path)
-      (add-body "install"
+      (phony "install" []
                 (def contents
                   (with [f (file/open main)]
                     (def first-line (:read f :line))
@@ -926,7 +955,7 @@ int main(int argc, const char **argv) {
     (def bat (string "@echo off\r\njanet \"" fullname "\" %*"))
     (def newname (string binpath sep name ".bat"))
     (array/push (dyn :installed-files) newname)
-    (add-body "install"
+    (phony "install" []
               (spit newname bat))))
 
 (defn- print-rule-tree
@@ -973,7 +1002,8 @@ int main(int argc, const char **argv) {
 
   (phony "build" [])
 
-  (phony "manifest" []
+  (phony "manifest" [manifest])
+  (rule manifest []
          (print "generating " manifest "...")
          (mkdir manifests)
          (def sha (pslurp (string "\"" (git-path) "\" rev-parse HEAD")))
@@ -985,7 +1015,7 @@ int main(int argc, const char **argv) {
             :paths installed-files})
          (spit manifest (string/format "%j\n" man)))
 
-  (phony "install" ["uninstall" "build" "manifest"]
+  (phony "install" ["uninstall" "build" manifest]
          (when (dyn :test)
            (do-rule "test"))
          (print "Installed as '" (meta :name) "'."))

meson.build

@@ -20,7 +20,7 @@
 
 project('janet', 'c',
   default_options : ['c_std=c99', 'b_lundef=false', 'default_library=both'],
-  version : '1.10.0')
+  version : '1.10.2')
 
 # Global settings
 janet_path = join_paths(get_option('prefix'), get_option('libdir'), 'janet')
@@ -247,7 +247,18 @@ pkg.generate(libjanet,
 
 # Installation
 install_man('janet.1')
-install_man('jpm.1')
 install_headers(['src/include/janet.h', jconf], subdir: 'janet')
-install_data(sources : ['jpm'], install_dir : get_option('bindir'))
 install_data(sources : ['tools/.keep'], install_dir : join_paths(get_option('libdir'), 'janet'))
+if get_option('peg') and not get_option('reduced_os') and get_option('processes')
+  install_man('jpm.1')
+  patched_jpm = custom_target('patched-jpm',
+    input : ['tools/patch-jpm.janet', 'jpm'],
+    install : true,
+    install_dir : get_option('bindir'),
+    build_by_default : true,
+    output : ['jpm'],
+    command : [janet_nativeclient, '@INPUT@', '@OUTPUT@',
+      '--binpath=' + join_paths(get_option('prefix'), get_option('bindir')),
+      '--libpath=' + join_paths(get_option('prefix'), get_option('libdir'), 'janet'),
+      '--headerpath=' + join_paths(get_option('prefix'), get_option('includedir'))])
+endif

src/boot/boot.janet

@@ -433,6 +433,17 @@
          (def ,binding ,i)
          ,body))))
 
+(defn- loop-fiber-template
+  [binding expr body]
+  (with-syms [f s]
+    (def ds (if (idempotent? binding) binding (gensym)))
+    ~(let [,f ,expr]
+       (while true
+         (def ,ds (,resume ,f))
+         (if (= :dead (,fiber/status ,f)) (break))
+         ,;(if (= ds binding) [] [~(def ,binding ,ds)])
+         ,;body))))
+
 (defn- loop1
   [body head i]
 
@@ -470,12 +481,7 @@
       :pairs (keys-template binding object true [rest])
       :in (each-template binding object [rest])
       :iterate (iterate-template binding object rest)
-      :generate (with-syms [f s]
+      :generate (loop-fiber-template binding object [rest])
-                  ~(let [,f ,object]
-                     (while true
-                       (def ,binding (,resume ,f))
-                       (if (= :dead (,fiber/status ,f)) (break))
-                       ,rest)))
       (error (string "unexpected loop verb " verb)))))
 
 (defmacro for
@@ -493,6 +499,18 @@
   [x ds & body]
   (keys-template x ds true body))
 
+(defmacro eachy
+  "Resume a fiber in a loop until it has errored or died. Evaluate the body
+  of the loop with binding set to the yielded value."
+  [x fiber & body]
+  (loop-fiber-template x fiber body))
+
+(defmacro repeat
+  "Evaluate body n times. If n is negative, body will be evaluated 0 times. Evaluates to nil."
+  [n & body]
+  (with-syms [iter]
+    ~(do (var ,iter ,n) (while (> ,iter 0) ,;body (-- ,iter)))))
+
 (defmacro each
   "Loop over each value in ds. Returns nil."
   [x ds & body]
@@ -542,6 +560,7 @@
 (put _env 'each-template nil)
 (put _env 'keys-template nil)
 (put _env 'range-template nil)
+(put _env 'loop-fiber-template nil)
 
 (defmacro seq
   "Similar to loop, but accumulates the loop body into an array and returns that.

src/conf/janetconf.h

@@ -28,9 +28,9 @@
 
 #define JANET_VERSION_MAJOR 1
 #define JANET_VERSION_MINOR 10
-#define JANET_VERSION_PATCH 0
+#define JANET_VERSION_PATCH 2
 #define JANET_VERSION_EXTRA "-dev"
-#define JANET_VERSION "1.10.0"
+#define JANET_VERSION "1.10.2-dev"
 
 /* #define JANET_BUILD "local" */
 

src/core/array.c

@@ -270,6 +270,26 @@ static Janet cfun_array_remove(int32_t argc, Janet *argv) {
     return argv[0];
 }
 
+static Janet cfun_array_trim(int32_t argc, Janet *argv) {
+    janet_fixarity(argc, 1);
+    JanetArray *array = janet_getarray(argv, 0);
+    if (array->count) {
+        if (array->count < array->capacity) {
+            Janet *newData = realloc(array->data, array->count * sizeof(Janet));
+            if (NULL == newData) {
+                JANET_OUT_OF_MEMORY;
+            }
+            array->data = newData;
+            array->capacity = array->count;
+        }
+    } else {
+        array->capacity = 0;
+        free(array->data);
+        array->data = NULL;
+    }
+    return argv[0];
+}
+
 static const JanetReg array_cfuns[] = {
     {
         "array/new", cfun_array_new,
@@ -345,6 +365,11 @@ static const JanetReg array_cfuns[] = {
              "By default, n is 1. "
              "Returns the array.")
     },
+    {
+        "array/trim", cfun_array_trim,
+        JDOC("(array/trim arr)\n\n"
+             "Set the backing capacity of an array to its current length. Returns the modified array.")
+    },
     {NULL, NULL, NULL}
 };
 

src/core/buffer.c

@@ -197,6 +197,26 @@ static Janet cfun_buffer_fill(int32_t argc, Janet *argv) {
     return argv[0];
 }
 
+static Janet cfun_buffer_trim(int32_t argc, Janet *argv) {
+    janet_fixarity(argc, 1);
+    JanetBuffer *buffer = janet_getbuffer(argv, 0);
+    if (buffer->count) {
+        if (buffer->count < buffer->capacity) {
+            uint8_t *newData = realloc(buffer->data, buffer->count);
+            if (NULL == newData) {
+                JANET_OUT_OF_MEMORY;
+            }
+            buffer->data = newData;
+            buffer->capacity = buffer->count;
+        }
+    } else {
+        buffer->capacity = 0;
+        free(buffer->data);
+        buffer->data = NULL;
+    }
+    return argv[0];
+}
+
 static Janet cfun_buffer_u8(int32_t argc, Janet *argv) {
     int32_t i;
     janet_arity(argc, 1, -1);
@@ -379,6 +399,12 @@ static const JanetReg buffer_cfuns[] = {
              "Fill up a buffer with bytes, defaulting to 0s. Does not change the buffer's length. "
              "Returns the modified buffer.")
     },
+    {
+        "buffer/trim", cfun_buffer_trim,
+        JDOC("(buffer/trim buffer)\n\n"
+             "Set the backing capacity of the buffer to the current length of the buffer. Returns the "
+             "modified buffer.")
+    },
     {
         "buffer/push-byte", cfun_buffer_u8,
         JDOC("(buffer/push-byte buffer x)\n\n"

src/core/capi.c

@@ -325,7 +325,10 @@ JanetRange janet_getslice(int32_t argc, const Janet *argv) {
 }
 
 Janet janet_dyn(const char *name) {
-    if (!janet_vm_fiber) return janet_wrap_nil();
+    if (!janet_vm_fiber) {
+        if (!janet_vm_top_dyns) return janet_wrap_nil();
+        return janet_table_get(janet_vm_top_dyns, janet_ckeywordv(name));
+    }
     if (janet_vm_fiber->env) {
         return janet_table_get(janet_vm_fiber->env, janet_ckeywordv(name));
     } else {
@@ -334,11 +337,15 @@ Janet janet_dyn(const char *name) {
 }
 
 void janet_setdyn(const char *name, Janet value) {
-    if (!janet_vm_fiber) return;
+    if (!janet_vm_fiber) {
-    if (!janet_vm_fiber->env) {
+        if (!janet_vm_top_dyns) janet_vm_top_dyns = janet_table(10);
-        janet_vm_fiber->env = janet_table(1);
+        janet_table_put(janet_vm_top_dyns, janet_ckeywordv(name), value);
+    } else {
+        if (!janet_vm_fiber->env) {
+            janet_vm_fiber->env = janet_table(1);
+        }
+        janet_table_put(janet_vm_fiber->env, janet_ckeywordv(name), value);
     }
-    janet_table_put(janet_vm_fiber->env, janet_ckeywordv(name), value);
 }
 
 uint64_t janet_getflags(const Janet *argv, int32_t n, const char *flags) {

src/core/inttypes.c

@@ -206,14 +206,14 @@ static Janet cfun_it_u64_new(int32_t argc, Janet *argv) {
 // In the following code explicit casts are sometimes used to help
 // make it clear when int/float conversions are happening.
 //
-static int64_t compare_double_double(double x, double y) {
+static int compare_double_double(double x, double y) {
     return (x < y) ? -1 : ((x > y) ? 1 : 0);
 }
 
-static int64_t compare_int64_double(int64_t x, double y) {
+static int compare_int64_double(int64_t x, double y) {
     if (isnan(y)) {
         return 0; // clojure and python do this
-    } else if ((y > ((double) - MAX_INT_IN_DBL)) && (y < ((double) MAX_INT_IN_DBL))) {
+    } else if ((y > (- ((double) MAX_INT_IN_DBL))) && (y < ((double) MAX_INT_IN_DBL))) {
         double dx = (double) x;
         return compare_double_double(dx, y);
     } else if (y > ((double) INT64_MAX)) {
@@ -226,7 +226,7 @@ static int64_t compare_int64_double(int64_t x, double y) {
     }
 }
 
-static int64_t compare_uint64_double(uint64_t x, double y) {
+static int compare_uint64_double(uint64_t x, double y) {
     if (isnan(y)) {
         return 0; // clojure and python do this
     } else if (y < 0) {

src/core/os.c

@@ -1225,6 +1225,9 @@ static Janet os_rename(int32_t argc, Janet *argv) {
 static Janet os_realpath(int32_t argc, Janet *argv) {
     janet_fixarity(argc, 1);
     const char *src = janet_getcstring(argv, 0);
+#ifdef JANET_NO_REALPATH
+    janet_panic("os/realpath not enabled for this platform");
+#else
 #ifdef JANET_WINDOWS
     char *dest = _fullpath(NULL, src, _MAX_PATH);
 #else
@@ -1234,6 +1237,7 @@ static Janet os_realpath(int32_t argc, Janet *argv) {
     Janet ret = janet_cstringv(dest);
     free(dest);
     return ret;
+#endif
 }
 
 static Janet os_permission_string(int32_t argc, Janet *argv) {

src/core/pp.c

@@ -123,9 +123,6 @@ static void string_description_b(JanetBuffer *buffer, const char *title, void *p
 #undef POINTSIZE
 }
 
-#undef HEX
-#undef BUFSIZE
-
 static void janet_escape_string_impl(JanetBuffer *buffer, const uint8_t *str, int32_t len) {
     janet_buffer_push_u8(buffer, '"');
     for (int32_t i = 0; i < len; ++i) {
@@ -354,12 +351,16 @@ 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_NUMBER:
+            janet_buffer_ensure(S->buffer, S->buffer->count + BUFSIZE, 2);
+            int count = snprintf((char *) S->buffer->data + S->buffer->count, BUFSIZE, "%.17g", janet_unwrap_number(x));
+            S->buffer->count += count;
+            break;
         case JANET_SYMBOL:
         case JANET_KEYWORD:
             if (contains_bad_chars(janet_unwrap_keyword(x), janet_type(x) == JANET_SYMBOL)) return 1;
@@ -994,3 +995,6 @@ void janet_buffer_format(
         }
     }
 }
+
+#undef HEX
+#undef BUFSIZE

src/core/run.c

@@ -23,7 +23,6 @@
 #ifndef JANET_AMALG
 #include "features.h"
 #include <janet.h>
-#include "state.h"
 #endif
 
 /* Run a string */
@@ -56,9 +55,10 @@ int janet_dobytes(JanetTable *env, const uint8_t *bytes, int32_t len, const char
                     done = 1;
                 }
             } else {
+                ret = janet_wrap_string(cres.error);
                 if (cres.macrofiber) {
                     janet_eprintf("compile error in %s: ", sourcePath);
-                    janet_stacktrace(cres.macrofiber, janet_wrap_string(cres.error));
+                    janet_stacktrace(cres.macrofiber, ret);
                 } else {
                     janet_eprintf("compile error in %s: %s\n", sourcePath,
                                   (const char *)cres.error);
@@ -68,25 +68,23 @@ int janet_dobytes(JanetTable *env, const uint8_t *bytes, int32_t len, const char
             }
         }
 
+        if (done) break;
+
         /* Dispatch based on parse state */
         switch (janet_parser_status(&parser)) {
             case JANET_PARSE_DEAD:
                 done = 1;
                 break;
-            case JANET_PARSE_ERROR:
+            case JANET_PARSE_ERROR: {
+                const char *e = janet_parser_error(&parser);
                 errflags |= 0x04;
-                janet_eprintf("parse error in %s: %s\n",
+                ret = janet_cstringv(e);
-                              sourcePath, janet_parser_error(&parser));
+                janet_eprintf("parse error in %s: %s\n", sourcePath, e);
                 done = 1;
                 break;
-            case JANET_PARSE_PENDING:
+            }
-                if (index == len) {
-                    janet_parser_eof(&parser);
-                } else {
-                    janet_parser_consume(&parser, bytes[index++]);
-                }
-                break;
             case JANET_PARSE_ROOT:
+            case JANET_PARSE_PENDING:
                 if (index >= len) {
                     janet_parser_eof(&parser);
                 } else {

src/core/state.h

@@ -34,6 +34,9 @@
 
 typedef struct JanetScratch JanetScratch;
 
+/* Top level dynamic bindings */
+extern JANET_THREAD_LOCAL JanetTable *janet_vm_top_dyns;
+
 /* Cache the core environment */
 extern JANET_THREAD_LOCAL JanetTable *janet_vm_core_env;
 

src/core/thread.c

@@ -66,9 +66,15 @@ struct JanetMailbox {
     JanetBuffer messages[];
 };
 
+#define JANET_THREAD_HEAVYWEIGHT 0x1
+#define JANET_THREAD_ABSTRACTS 0x2
+#define JANET_THREAD_CFUNCTIONS 0x4
+static const char janet_thread_flags[] = "hac";
+
 typedef struct {
     JanetMailbox *original;
     JanetMailbox *newbox;
+    uint64_t flags;
 } JanetMailboxPair;
 
 static JANET_THREAD_LOCAL JanetMailbox *janet_vm_mailbox = NULL;
@@ -175,7 +181,7 @@ static int thread_mark(void *p, size_t size) {
     return 0;
 }
 
-static JanetMailboxPair *make_mailbox_pair(JanetMailbox *original) {
+static JanetMailboxPair *make_mailbox_pair(JanetMailbox *original, uint64_t flags) {
     JanetMailboxPair *pair = malloc(sizeof(JanetMailboxPair));
     if (NULL == pair) {
         JANET_OUT_OF_MEMORY;
@@ -183,6 +189,7 @@ static JanetMailboxPair *make_mailbox_pair(JanetMailbox *original) {
     pair->original = original;
     janet_mailbox_ref(original, 1);
     pair->newbox = janet_mailbox_create(1, 16);
+    pair->flags = flags;
     return pair;
 }
 
@@ -442,16 +449,44 @@ static int thread_worker(JanetMailboxPair *pair) {
     janet_init();
 
     /* Get dictionaries for default encode/decode */
-    JanetTable *encode = janet_get_core_table("make-image-dict");
+    JanetTable *encode;
+    if (pair->flags & JANET_THREAD_HEAVYWEIGHT) {
+        encode = janet_get_core_table("make-image-dict");
+    } else {
+        encode = NULL;
+        janet_vm_thread_decode = janet_table(0);
+        janet_gcroot(janet_wrap_table(janet_vm_thread_decode));
+    }
 
     /* Create parent thread */
     JanetThread *parent = janet_make_thread(pair->original, encode);
     Janet parentv = janet_wrap_abstract(parent);
 
+    /* Unmarshal the abstract registry */
+    if (pair->flags & JANET_THREAD_ABSTRACTS) {
+        Janet reg;
+        int status = janet_thread_receive(&reg, INFINITY);
+        if (status) goto error;
+        if (!janet_checktype(reg, JANET_TABLE)) goto error;
+        janet_gcunroot(janet_wrap_table(janet_vm_abstract_registry));
+        janet_vm_abstract_registry = janet_unwrap_table(reg);
+        janet_gcroot(janet_wrap_table(janet_vm_abstract_registry));
+    }
+
+    /* Unmarshal the normal registry */
+    if (pair->flags & JANET_THREAD_CFUNCTIONS) {
+        Janet reg;
+        int status = janet_thread_receive(&reg, INFINITY);
+        if (status) goto error;
+        if (!janet_checktype(reg, JANET_TABLE)) goto error;
+        janet_gcunroot(janet_wrap_table(janet_vm_registry));
+        janet_vm_registry = janet_unwrap_table(reg);
+        janet_gcroot(janet_wrap_table(janet_vm_registry));
+    }
+
     /* Unmarshal the function */
     Janet funcv;
     int status = janet_thread_receive(&funcv, INFINITY);
-
     if (status) goto error;
     if (!janet_checktype(funcv, JANET_FUNCTION)) goto error;
     JanetFunction *func = janet_unwrap_function(funcv);
@@ -558,22 +593,40 @@ static Janet cfun_thread_current(int32_t argc, Janet *argv) {
 }
 
 static Janet cfun_thread_new(int32_t argc, Janet *argv) {
-    janet_arity(argc, 1, 2);
+    janet_arity(argc, 1, 3);
     /* Just type checking */
     janet_getfunction(argv, 0);
     int32_t cap = janet_optinteger(argv, argc, 1, 10);
     if (cap < 1 || cap > UINT16_MAX) {
         janet_panicf("bad slot #1, expected integer in range [1, 65535], got %d", cap);
     }
-    JanetTable *encode = janet_get_core_table("make-image-dict");
+    uint64_t flags = argc >= 3 ? janet_getflags(argv, 2, janet_thread_flags) : JANET_THREAD_ABSTRACTS;
+    JanetTable *encode;
+    if (flags & JANET_THREAD_HEAVYWEIGHT) {
+        encode = janet_get_core_table("make-image-dict");
+    } else {
+        encode = NULL;
+    }
 
-    JanetMailboxPair *pair = make_mailbox_pair(janet_vm_mailbox);
+    JanetMailboxPair *pair = make_mailbox_pair(janet_vm_mailbox, flags);
     JanetThread *thread = janet_make_thread(pair->newbox, encode);
     if (janet_thread_start_child(pair)) {
         destroy_mailbox_pair(pair);
         janet_panic("could not start thread");
     }
 
+    if (flags & JANET_THREAD_ABSTRACTS) {
+        if (janet_thread_send(thread, janet_wrap_table(janet_vm_abstract_registry), INFINITY)) {
+            janet_panic("could not send abstract registry to thread");
+        }
+    }
+
+    if (flags & JANET_THREAD_CFUNCTIONS) {
+        if (janet_thread_send(thread, janet_wrap_table(janet_vm_registry), INFINITY)) {
+            janet_panic("could not send registry to thread");
+        }
+    }
+
     /* If thread started, send the worker function. */
     if (janet_thread_send(thread, argv[0], INFINITY)) {
         janet_panicf("could not send worker function %v to thread", argv[0]);
@@ -638,10 +691,14 @@ static const JanetReg threadlib_cfuns[] = {
     },
     {
         "thread/new", cfun_thread_new,
-        JDOC("(thread/new func &opt capacity)\n\n"
+        JDOC("(thread/new func &opt capacity flags)\n\n"
              "Start a new thread that will start immediately. "
              "If capacity is provided, that is how many messages can be stored in the thread's mailbox before blocking senders. "
              "The capacity must be between 1 and 65535 inclusive, and defaults to 10. "
+             "Can optionally provide flags to the new thread - supported flags are:\n"
+             "\t:h - Start a heavyweight thread. This loads the core environment by default, so may use more memory initially. Messages may compress better, though.\n"
+             "\t:a - Allow sending over registered abstract types to the new thread\n"
+             "\t:c - Send over cfunction information to the new thread.\n"
              "Returns a handle to the new thread.")
     },
     {

src/core/vm.c

@@ -33,6 +33,7 @@
 #include <math.h>
 
 /* VM state */
+JANET_THREAD_LOCAL JanetTable *janet_vm_top_dyns;
 JANET_THREAD_LOCAL JanetTable *janet_vm_core_env;
 JANET_THREAD_LOCAL JanetTable *janet_vm_registry;
 JANET_THREAD_LOCAL JanetTable *janet_vm_abstract_registry;
@@ -929,7 +930,7 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in) {
         if (janet_checktype(callee, JANET_FUNCTION)) {
             func = janet_unwrap_function(callee);
             if (func->gc.flags & JANET_FUNCFLAG_TRACE) {
-                vm_do_trace(func, fiber->stacktop - fiber->stackstart, stack);
+                vm_do_trace(func, fiber->stacktop - fiber->stackstart, fiber->data + fiber->stackstart);
             }
             janet_stack_frame(stack)->pc = pc;
             if (janet_fiber_funcframe(fiber, func)) {
@@ -968,7 +969,7 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in) {
         if (janet_checktype(callee, JANET_FUNCTION)) {
             func = janet_unwrap_function(callee);
             if (func->gc.flags & JANET_FUNCFLAG_TRACE) {
-                vm_do_trace(func, fiber->stacktop - fiber->stackstart, stack);
+                vm_do_trace(func, fiber->stacktop - fiber->stackstart, fiber->data + fiber->stackstart);
             }
             if (janet_fiber_funcframe_tail(fiber, func)) {
                 janet_stack_frame(fiber->data + fiber->frame)->pc = pc;
@@ -1419,6 +1420,8 @@ int janet_init(void) {
     janet_vm_traversal_top = NULL;
     /* Core env */
     janet_vm_core_env = NULL;
+    /* Dynamic bindings */
+    janet_vm_top_dyns = NULL;
     /* Seed RNG */
     janet_rng_seed(janet_default_rng(), 0);
     /* Fibers */
@@ -1449,6 +1452,7 @@ void janet_deinit(void) {
     janet_vm_registry = NULL;
     janet_vm_abstract_registry = NULL;
     janet_vm_core_env = NULL;
+    janet_vm_top_dyns = NULL;
     free(janet_vm_traversal_base);
     janet_vm_fiber = NULL;
     janet_vm_root_fiber = NULL;

src/include/janet.h

@@ -1373,6 +1373,7 @@ JANET_API void janet_table_merge_table(JanetTable *table, JanetTable *other);
 JANET_API void janet_table_merge_struct(JanetTable *table, JanetStruct other);
 JANET_API JanetKV *janet_table_find(JanetTable *t, Janet key);
 JANET_API JanetTable *janet_table_clone(JanetTable *table);
+JANET_API void janet_table_clear(JanetTable *table);
 
 /* Fiber */
 JANET_API JanetFiber *janet_fiber(JanetFunction *callee, int32_t capacity, int32_t argc, const Janet *argv);

test/suite8.janet

@@ -307,4 +307,22 @@ neldb\0\0\0\xD8\x05printG\x01\0\xDE\xDE\xDE'\x03\0marshal_tes/\x02
 (assert (:match peg5 "abcabcabcac") "repeat alias 2")
 (assert (not (:match peg5 "abcabc")) "repeat alias 3")
 
+(defn check-jdn [x]
+  (assert (deep= (parse (string/format "%j" x)) x) "round trip jdn"))
+
+(check-jdn 0)
+(check-jdn nil)
+(check-jdn [])
+(check-jdn @[[] [] 1231 9.123123 -123123 0.1231231230001])
+(check-jdn -0.123123123123)
+(check-jdn 12837192371923)
+(check-jdn "a string")
+(check-jdn @"a buffer")
+
+# Issue 428
+(var result nil)
+(defn f [] (yield {:a :ok}))
+(assert-no-error "issue 428 1" (loop [{:a x} :generate (fiber/new f)] (set result x)))
+(assert (= result :ok) "issue 428 2")
+
 (end-suite)

tools/patch-jpm.janet

@@ -0,0 +1,33 @@
+# Patch jpm to have the correct paths for the current install.
+# usage: janet patch-jpm.janet output --libdir=/usr/local/lib/x64-linux/ --binpath
+
+(def- argpeg
+  (peg/compile
+    '(* "--" '(to "=") "=" '(any 1))))
+
+(def- args (tuple/slice (dyn :args) 3))
+(def- len (length args))
+(var i :private 0)
+
+(def install-paths @{})
+
+# Get flags
+(each a args
+  (if-let [m (peg/match argpeg a)]
+    (let [[key value] m]
+      (put install-paths (keyword key) value))))
+
+(def- replace-peg
+  (peg/compile
+    ~(% (* '(to "###START###")
+           (constant ,(string/format "# Inserted by tools/patch-jpm.janet\n(defn- install-paths [] %j)" install-paths))
+           (thru "###END###")
+           '(any 1)))))
+
+(def source (slurp ((dyn :args) 1)))
+(def newsource (0 (peg/match replace-peg source)))
+
+(spit ((dyn :args) 2) newsource)
+
+(unless (= :windows (os/which))
+  (os/shell (string `chmod +x "` ((dyn :args) 2) `"`)))