Fix NaNboxing bug that cause flaky builds.

The macro janet_checktype(x, JANET_NUMBER) was incorrect when
x was NaN. This caused the initial unmarshalling dictionary to be missing
entries in certain cases.

Makefile

@@ -149,7 +149,7 @@ build/janet_boot: $(JANET_BOOT_OBJECTS)
 
 # Now the reason we bootstrap in the first place
 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)' > $@
 	cksum $@
 
 ########################

src/boot/boot.janet

@@ -7,6 +7,8 @@
 ###
 ###
 
+(def root-env "The root environment used to create environments with (make-env)" _env)
+
 (def defn :macro
   "(defn name & more)\n\nDefine a function. Equivalent to (def name (fn name [args] ...))."
   (fn defn [name & more]
@@ -567,15 +569,6 @@
   [head & body]
   (loop1 body head 0))
 
-(put _env 'loop1 nil)
-(put _env 'check-indexed nil)
-(put _env 'for-template nil)
-(put _env 'for-var-template nil)
-(put _env 'iterate-template nil)
-(put _env 'each-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.
   See loop for details."
@@ -594,6 +587,16 @@
   [& body]
   (tuple fiber/new (tuple 'fn '[] ;body) :yi))
 
+(defmacro- undef
+  "Remove binding from root-env"
+  [& syms]
+  ~(do ,;(seq [s :in syms] ~(put root-env ',s nil))))
+
+(undef _env)
+
+(undef loop1 check-indexed for-template for-var-template iterate-template
+       each-template range-template loop-fiber-template)
+
 (defn sum
   "Returns the sum of xs. If xs is empty, returns 0."
   [xs]
@@ -749,7 +752,7 @@
   [& xs]
   (compare-reduce >= xs))
 
-(put _env 'compare-reduce nil)
+(undef compare-reduce)
 
 ###
 ###
@@ -785,8 +788,8 @@
   [a &opt by]
   (sort-help a 0 (- (length a) 1) (or by <)))
 
-(put _env 'sort-part nil)
+(undef sort-part)
-(put _env 'sort-help nil)
+(undef sort-help)
 
 (defn sort-by
   "Returns a new sorted array that compares elements by invoking
@@ -1140,8 +1143,8 @@
     :tuple (tuple/slice (walk-ind f form))
     form))
 
-(put _env 'walk-ind nil)
+(undef walk-ind)
-(put _env 'walk-dict nil)
+(undef walk-dict)
 
 (defn postwalk
   "Do a post-order traversal of a data structure and call (f x)
@@ -1350,7 +1353,7 @@
   [tab & colls]
   (loop [c :in colls
          key :keys c]
-    (set (tab key) (in c key)))
+    (put tab key (in c key)))
   tab)
 
 (defn merge
@@ -1361,7 +1364,7 @@
   (def container @{})
   (loop [c :in colls
          key :keys c]
-    (set (container key) (in c key)))
+    (put container key (in c key)))
   container)
 
 (defn keys
@@ -1615,9 +1618,9 @@
                           ,(aux (+ 2 i))
                           ,$res)))) 0)))
 
-(put _env 'sentinel nil)
+(undef sentinel)
-(put _env 'match-1 nil)
+(undef match-1)
-(put _env 'with-idemp nil)
+(undef with-idemp)
 
 ###
 ###
@@ -1742,8 +1745,8 @@
   [&opt sym]
   ~(,doc* ',sym))
 
-(put _env 'env-walk nil)
+(undef env-walk)
-(put _env 'print-index nil)
+(undef print-index)
 
 ###
 ###
@@ -2032,7 +2035,7 @@
   will inherit bindings from the parent environment, but new
   bindings will not pollute the parent environment."
   [&opt parent]
-  (def parent (if parent parent _env))
+  (def parent (if parent parent root-env))
   (def newenv (table/setproto @{} parent))
   newenv)
 
@@ -2248,10 +2251,11 @@
   by make-image, such that (load-image bytes) is the same as (unmarshal bytes load-image-dict)."
   @{})
 
-(def comptime
+(defmacro comptime
   "(comptime x)\n\n
   Evals x at compile time and returns the result. Similar to a top level unquote."
-  :macro eval)
+  [x]
+  (eval x))
 
 (defn make-image
   "Create an image from an environment returned by require.
@@ -2305,7 +2309,7 @@
 (module/add-paths ".jimage" :image)
 
 # Version of fexists that works even with a reduced OS
-(if-let [has-stat (_env 'os/stat)]
+(if-let [has-stat (root-env 'os/stat)]
   (let [stat (has-stat :value)]
     (defglobal "fexists" (fn fexists [path] (= :file (stat path :mode)))))
   (defglobal "fexists"
@@ -2352,10 +2356,10 @@
           str-parts (interpose "\n    " paths)]
       [nil (string "could not find module " path ":\n    " ;str-parts)])))
 
-(put _env 'fexists nil)
+(undef fexists)
-(put _env 'mod-filter nil)
+(undef mod-filter)
-(put _env 'check-. nil)
+(undef check-.)
-(put _env 'not-check-. nil)
+(undef not-check-.)
 
 (def module/cache
   "Table mapping loaded module identifiers to their environments."
@@ -2463,7 +2467,7 @@
     (def newv (table/setproto @{:private (not ep)} v))
     (put env (symbol prefix k) newv)))
 
-(put _env 'require-1 nil)
+(undef require-1)
 
 (defmacro import
   "Import a module. First requires the module, and then merges its
@@ -2530,7 +2534,7 @@
   (in (.slots frame-idx) (or nth 0)))
 
 # Conditional compilation for disasm
-(def disasm-alias (if-let [x (_env 'disasm)] (x :value)))
+(def disasm-alias (if-let [x (root-env 'disasm)] (x :value)))
 
 (defn .disasm
   "Gets the assembly for the current function."
@@ -2592,13 +2596,9 @@
     (debug/unfbreak fun i))
   (print "Cleared " (length bytecode) " breakpoints in " fun))
 
-(unless (get _env 'disasm)
+(unless (get root-env 'disasm)
-  (put _env '.disasm nil)
+  (undef .disasm .bytecode .breakall .clearall .ppasm))
-  (put _env '.bytecode nil)
+(undef disasm-alias)
-  (put _env '.breakall nil)
-  (put _env '.clearall nil)
-  (put _env '.ppasm nil))
-(put _env 'disasm-alias nil)
 
 (defn .source
   "Show the source code for the function being debugged."
@@ -2652,9 +2652,9 @@
   "An environment that contains dot prefixed functions for debugging."
   @{})
 
-(def- debugger-keys (filter (partial string/has-prefix? ".") (keys _env)))
+(def- debugger-keys (filter (partial string/has-prefix? ".") (keys root-env)))
-(each k debugger-keys (put debugger-env k (_env k)) (put _env k nil))
+(each k debugger-keys (put debugger-env k (root-env k)) (put root-env k nil))
-(put _env 'debugger-keys nil)
+(undef debugger-keys)
 
 ###
 ###
@@ -2750,7 +2750,7 @@
   (each a args (import* (string a) :prefix "" :evaluator evaluator)))
 
 # conditional compilation for reduced os
-(def- getenv-alias (if-let [entry (in _env 'os/getenv)] (entry :value) (fn [&])))
+(def- getenv-alias (if-let [entry (in root-env 'os/getenv)] (entry :value) (fn [&])))
 
 (defn cli-main
   "Entrance for the Janet CLI tool. Call this functions with the command line
@@ -2885,12 +2885,7 @@
     (setdyn :err-color (if *colorize* true))
     (repl getchunk nil env)))
 
-(put _env 'no-side-effects nil)
+(undef no-side-effects is-safe-def safe-forms importers use-2 getenv-alias)
-(put _env 'is-safe-def nil)
-(put _env 'safe-forms nil)
-(put _env 'importers nil)
-(put _env 'use-2 nil)
-(put _env 'getenv-alias nil)
 
 ###
 ###
@@ -2898,12 +2893,13 @@
 ###
 ###
 
-(def root-env "The root environment used to create environments with (make-env)" _env)
-
 (do
-  (put _env 'boot/opts nil)
+  (undef boot/opts undef)
-  (put _env '_env nil)
+  (def load-dict (env-lookup root-env))
-  (def load-dict (env-lookup _env))
+  (put load-dict 'boot/config nil)
+  (put load-dict 'boot/args nil)
+  (each [k v] (pairs load-dict)
+    (if (number? v) (put load-dict k nil)))
   (merge-into load-image-dict load-dict)
   (merge-into make-image-dict (invert load-dict)))
 
@@ -2924,25 +2920,29 @@
         (put into k (x k))))
     into)
 
-  (def env (fiber/getenv (fiber/current)))
-
   # Modify env based on some options.
-  (loop [[k v] :pairs env
+  (loop [[k v] :pairs root-env
          :when (symbol? k)]
     (def flat (proto-flatten @{} v))
     (when (boot/config :no-docstrings)
       (put flat :doc nil))
     (when (boot/config :no-sourcemaps)
       (put flat :source-map nil))
-    (put env k flat))
+    (put root-env k flat))
 
-  (put env 'boot/config nil)
+  (put root-env 'boot/config nil)
-  (put env 'boot/args nil)
+  (put root-env 'boot/args nil)
-  (def image (let [env-pairs (pairs (env-lookup env))
+
+  (def image (let [env-pairs (pairs (env-lookup root-env))
                    essential-pairs (filter (fn [[k v]] (or (cfunction? v) (abstract? v))) env-pairs)
                    lookup (table ;(mapcat identity essential-pairs))
                    reverse-lookup (invert lookup)]
-               (marshal env reverse-lookup)))
+               # Check no duplicate values
+               (def temp @{})
+               (eachp [k v] lookup
+                 (if (in temp v) (errorf "duplicate value: %v" v))
+                 (put temp v k))
+               (marshal root-env reverse-lookup)))
 
   # Create amalgamation
 

src/boot/system_test.c

@@ -23,6 +23,7 @@
 #include <janet.h>
 #include <assert.h>
 #include <stdio.h>
+#include <math.h>
 
 #include "tests.h"
 
@@ -44,6 +45,11 @@ int system_test() {
     assert(janet_equals(janet_wrap_integer(INT32_MIN), janet_wrap_integer(INT32_MIN)));
     assert(janet_equals(janet_wrap_number(1.4), janet_wrap_number(1.4)));
     assert(janet_equals(janet_wrap_number(3.14159265), janet_wrap_number(3.14159265)));
+#ifdef NAN
+    assert(janet_checktype(janet_wrap_number(NAN), JANET_NUMBER));
+#else
+    assert(janet_checktype(janet_wrap_number(0.0 / 0.0), JANET_NUMBER));
+#endif
 
     assert(NULL != &janet_wrap_nil);
 

src/core/corelib.c

@@ -1218,7 +1218,7 @@ JanetTable *janet_core_env(JanetTable *replacements) {
     }
 
     /* Load core cfunctions (and some built in janet assembly functions) */
-    JanetTable *dict = janet_table(300);
+    JanetTable *dict = janet_table(512);
     janet_load_libs(dict);
 
     /* Add replacements */

src/core/value.c

@@ -274,9 +274,9 @@ int32_t janet_hash(Janet x) {
             if (sizeof(double) == sizeof(void *)) {
                 /* Assuming 8 byte pointer */
                 uint64_t i = janet_u64(x);
-                uint32_t lo = (uint32_t) (i & 0xFFFFFFFF);
+                uint32_t lo = (uint32_t)(i & 0xFFFFFFFF);
-                uint32_t hi = (uint32_t) (i >> 32);
+                uint32_t hi = (uint32_t)(i >> 32);
-                hash = (int32_t) (hi ^ (lo >> 3));
+                hash = (int32_t)(hi ^ (lo >> 3));
             } else {
                 /* Assuming 4 byte pointer (or smaller) */
                 hash = (int32_t)((char *)janet_unwrap_pointer(x) - (char *)0);

src/include/janet.h

@@ -579,7 +579,7 @@ JANET_API Janet janet_wrap_integer(int32_t x);
     (((x).u64 & JANET_NANBOX_TAGBITS) == janet_nanbox_tag((type)))
 
 #define janet_nanbox_isnumber(x) \
-    (!isnan((x).number) || janet_nanbox_checkauxtype((x), JANET_NUMBER))
+    (!isnan((x).number) || ((((x).u64 >> 47) & 0xF) == JANET_NUMBER))
 
 #define janet_checktype(x, t) \
     (((t) == JANET_NUMBER) \