Make builds deterministic again.

Also prevent marshal from creating multiple copies of
a function - (marshal function pointer before function def pointer).

src/boot/boot.janet

@@ -2063,7 +2063,8 @@
      'quasiquote expandqq
      'var expanddef
      'while expandall
-     'break expandall})
+     'break expandall
+     'upscope expandall})
 
   (defn dotup [t]
     (def h (in t 0))
@@ -2499,16 +2500,16 @@
         (error (parser/error p))
         (error "no value")))))
 
-(def make-image-dict
-  `A table used in combination with marshal to marshal code (images), such that
-  (make-image x) is the same as (marshal x make-image-dict).`
-  @{})
-
 (def load-image-dict
   `A table used in combination with unmarshal to unmarshal byte sequences created
   by make-image, such that (load-image bytes) is the same as (unmarshal bytes load-image-dict).`
   @{})
 
+(def make-image-dict
+  `A table used in combination with marshal to marshal code (images), such that
+  (make-image x) is the same as (marshal x make-image-dict).`
+  @{})
+
 (defmacro comptime
   "Evals x at compile time and returns the result. Similar to a top level unquote."
   [x]
@@ -3225,8 +3226,7 @@
   (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 load-image-dict load-dict))
-  (merge-into make-image-dict (invert load-dict)))
 
 ###
 ###

src/core/corelib.c

@@ -1250,6 +1250,21 @@ JanetTable *janet_core_env(JanetTable *replacements) {
     JanetTable *env = janet_unwrap_table(marsh_out);
     janet_vm_core_env = env;
 
+    /* Invert image dict manually here. We can't do this in boot.janet as it
+     * breaks deterministic builds */
+    Janet lidv, midv;
+    lidv = midv = janet_wrap_nil();
+    janet_resolve(env, janet_csymbol("load-image-dict"), &lidv);
+    janet_resolve(env, janet_csymbol("make-image-dict"), &midv);
+    JanetTable *lid = janet_unwrap_table(lidv);
+    JanetTable *mid = janet_unwrap_table(midv);
+    for (int32_t i = 0; i < lid->capacity; i++) {
+        const JanetKV *kv = lid->data + i;
+        if (!janet_checktype(kv->key, JANET_NIL)) {
+            janet_table_put(mid, kv->value, kv->key);
+        }
+    }
+
     return env;
 }
 

src/core/gc.c

@@ -226,11 +226,14 @@ static void janet_mark_function(JanetFunction *func) {
     if (janet_gc_reachable(func))
         return;
     janet_gc_mark(func);
+    if (NULL != func->def) {
+        /* this should always be true, except if function is only partially constructed */
         numenvs = func->def->environments_length;
         for (i = 0; i < numenvs; ++i) {
             janet_mark_funcenv(func->envs[i]);
         }
         janet_mark_funcdef(func->def);
+    }
 }
 
 static void janet_mark_fiber(JanetFiber *fiber) {

src/core/marsh.c

@@ -542,9 +542,10 @@ static void marshal_one(MarshalState *st, Janet x, int flags) {
         case JANET_FUNCTION: {
             pushbyte(st, LB_FUNCTION);
             JanetFunction *func = janet_unwrap_function(x);
-            marshal_one_def(st, func->def, flags);
+            /* Mark seen before reading def */
-            /* Mark seen after reading def, but before envs */
             MARK_SEEN();
+            pushint(st, func->def->environments_length);
+            marshal_one_def(st, func->def, flags);
             for (int32_t i = 0; i < func->def->environments_length; i++)
                 marshal_one_env(st, func->envs[i], flags + 1);
             return;
@@ -1228,12 +1229,20 @@ static const uint8_t *unmarshal_one(
         case LB_FUNCTION: {
             JanetFunction *func;
             JanetFuncDef *def;
-            data = unmarshal_one_def(st, data + 1, &def, flags + 1);
+            data++;
+            int32_t len = readnat(st, &data);
+            if (len > 255) {
+                janet_panicf("invalid function");
+            }
             func = janet_gcalloc(JANET_MEMORY_FUNCTION, sizeof(JanetFunction) +
-                                 def->environments_length * sizeof(JanetFuncEnv));
+                                 len * sizeof(JanetFuncEnv));
-            func->def = def;
             *out = janet_wrap_function(func);
             janet_v_push(st->lookup, *out);
+            data = unmarshal_one_def(st, data, &def, flags + 1);
+            if (def->environments_length != len) {
+                janet_panicf("invalid function");
+            }
+            func->def = def;
             for (int32_t i = 0; i < def->environments_length; i++) {
                 data = unmarshal_one_env(st, data, &(func->envs[i]), flags + 1);
             }

test/suite0008.janet

@@ -221,20 +221,6 @@
 neldb\0\0\0\xD8\x05printG\x01\0\xDE\xDE\xDE'\x03\0marshal_tes/\x02
 \0\0\0\0\0*\xFE\x01\04\x02\0\0'\x03\0\r\0\r\0\r\0\r" load-image-dict))
 
-# No segfault, valgrind clean.
-
-(def x @"\xCC\xCD.nd\x80\0\r\x1C\xCDg!\0\x07\xCC\xCD\r\x1Ce\x10\0\r;\xCDb\x04\xFF9\xFF\x80\x04\x04\x04\x04\x04\x04\x04\x04\x04\x04\x04uu\x04\x04\x04\x04\x04\x04\x04\x04\x04\x04\x04\x04\x04\x04\0\x04\x04\x04\x04\x04\x04\x04\x04\x04\x04\x04\x04\x04\x04\x04\x04\x04\x04}\x04\x04\x04\x04\x04\x04\x04\x04#\x04\x04\x04\x04\x04\x04\x04\x04\x04\x04\x04\0\x01\0\0\x03\x04\x04\x04\xE2\x03\x04\x04\x04\x04\x04\x04\x04\x04\x04\x14\x1A\x04\x04\x04\x04\x04\x18\x04\x04!\x04\xE2\x03\x04\x04\x04\x04\x04\x04$\x04\x04\x04\x04\x04\x04\x04\x04\x04\x80\x04\x04\x04\x04\x04\x04\x04\x04\x04\x04\x04\x04\x04A\0\0\0\x03\0\0!\xBF\xFF")
-(assert-error "bad fiber status" (unmarshal x load-image-dict))
-(gccollect)
-(marshal x make-image-dict)
-
-(def b @"\xCC\xCD\0\x03\0\x08\x04\rm\xCD\x7F\xFF\xFF\xFF\x02\0\x02\xD7\xCD\0\x98\0\0\x05\x01\x01\x01\x01\x08\xCE\x01f\xCE../tools/afl/generate_unmarshal_testcases.janet\xCE\x012,\x01\0\0&\x03\0\06\x02\x03\x03)\x03\x01\0*\x04\0\00\x03\x04\0>\x03\0\0\x03\x03\0\0*\x05\0\x11\0\x11\0\x05\0\x05\0\x05\0\x05\0\x05\xC9\xDA\x04\xC9\xC9\xC9")
-(unmarshal b load-image-dict)
-(gccollect)
-
-(def v (unmarshal
-         @"\xD7\xCD0\xD4000000\0\x03\x01\xCE\00\0\x01\0\0000\x03\0\0\0000000000\xCC0\0000"
-         load-image-dict))
 (gccollect)
 
 # in vs get regression