make syntax-object unmarshaling more accepting

Defend against certain bad encodings, but accept an encoding
that includes more sharing than the built-in marshaling
could create.

racket/src/racket/src/mzmark_read.inc

@@ -167,6 +167,7 @@ static int mark_unmarshal_tables_SIZE(void *p, struct NewGC *gc) {
 static int mark_unmarshal_tables_MARK(void *p, struct NewGC *gc) {
   Scheme_Unmarshal_Tables *ut = (Scheme_Unmarshal_Tables *)p;
   gcMARK2(ut->rns, gc);
+  gcMARK2(ut->multi_scope_pairs, gc);
   gcMARK2(ut->rp, gc);
   gcMARK2(ut->decoded, gc);
   return
@@ -176,6 +177,7 @@ static int mark_unmarshal_tables_MARK(void *p, struct NewGC *gc) {
 static int mark_unmarshal_tables_FIXUP(void *p, struct NewGC *gc) {
   Scheme_Unmarshal_Tables *ut = (Scheme_Unmarshal_Tables *)p;
   gcFIXUP2(ut->rns, gc);
+  gcFIXUP2(ut->multi_scope_pairs, gc);
   gcFIXUP2(ut->rp, gc);
   gcFIXUP2(ut->decoded, gc);
   return

racket/src/racket/src/mzmarksrc.c

@@ -2343,6 +2343,7 @@ mark_unmarshal_tables {
  mark:
   Scheme_Unmarshal_Tables *ut = (Scheme_Unmarshal_Tables *)p;
   gcMARK2(ut->rns, gc);
+  gcMARK2(ut->multi_scope_pairs, gc);
   gcMARK2(ut->rp, gc);
   gcMARK2(ut->decoded, gc);
  size:

racket/src/racket/src/read.c

@@ -4439,6 +4439,9 @@ static void make_ut(CPort *port)
   
   rht = scheme_make_hash_table(SCHEME_hash_ptr);
   port->ut->rns = rht;
+
+  rht = scheme_make_hash_table(SCHEME_hash_ptr);
+  port->ut->multi_scope_pairs = rht;
 }
 
 /* Since read_compact_number is called often, we want it to be

racket/src/racket/src/schpriv.h

@@ -3371,8 +3371,9 @@ void scheme_marshal_push_refs(Scheme_Marshal_Tables *mt);
 void scheme_marshal_pop_refs(Scheme_Marshal_Tables *mt, int keep);
 
 typedef struct Scheme_Unmarshal_Tables {
-  MZTAG_IF_REQUIRED  
+  MZTAG_IF_REQUIRED
   Scheme_Hash_Table *rns;
+  Scheme_Hash_Table *multi_scope_pairs; /* records conversions */
   struct CPort *rp;
   char *decoded;
   mzlonglong bytecode_hash;

racket/src/racket/src/syntax.c

@@ -6613,7 +6613,8 @@ Scheme_Object *unmarshal_multi_scopes(Scheme_Object *multi_scopes,
                                      Scheme_Unmarshal_Tables *ut)
 {
   Scheme_Hash_Table *multi_scope;
-  Scheme_Object *l, *mm_l;
+  Scheme_Object *l, *mm_l, *first = NULL, *last = NULL;
+  Scheme_Object *l_first, *l_last, *p;
 
   mm_l = multi_scopes;
 
@@ -6622,27 +6623,66 @@ Scheme_Object *unmarshal_multi_scopes(Scheme_Object *multi_scopes,
     if (SCHEME_FALLBACKP(l))
       l = SCHEME_FALLBACK_FIRST(l);
 
+    l_first = scheme_null;
+    l_last = NULL;
     for (; !SCHEME_NULLP(l); l = SCHEME_CDR(l)) {
+      int stop;
+
       if (!SCHEME_PAIRP(l)) return_NULL;
       if (!SCHEME_PAIRP(SCHEME_CAR(l))) return_NULL;
-      if (SCHEME_VECTORP(SCHEME_CAR(SCHEME_CAR(l)))) {
+
-        multi_scope = vector_to_multi_scope(SCHEME_CAR(SCHEME_CAR(l)), ut);
+      p = scheme_hash_get(ut->multi_scope_pairs, l);
-        if (!multi_scope) return_NULL;
+      if (!p) {
-        SCHEME_CAR(SCHEME_CAR(l)) = (Scheme_Object *)multi_scope;
+        p = scheme_hash_get(ut->multi_scope_pairs, SCHEME_CAR(l));
-        if (!SCHEME_PHASE_SHIFTP(SCHEME_CDR(SCHEME_CAR(l)))) return_NULL;
+        if (p) {
-      } else {
+          p = scheme_make_pair(p, scheme_null);
-        /* rest of list must be converted already, too */
+        } else {
+          if (SCHEME_VECTORP(SCHEME_CAR(SCHEME_CAR(l)))) {
+            multi_scope = vector_to_multi_scope(SCHEME_CAR(SCHEME_CAR(l)), ut);
+            if (!multi_scope) return_NULL;
+            if (!SCHEME_PHASE_SHIFTP(SCHEME_CDR(SCHEME_CAR(l)))) return_NULL;
+            p = scheme_make_pair((Scheme_Object *)multi_scope,
+                                 SCHEME_CDR(SCHEME_CAR(l)));
+            scheme_hash_set(ut->multi_scope_pairs, SCHEME_CAR(l), p);
+          } else
+            return_NULL;
+        }
+        scheme_hash_set(ut->multi_scope_pairs, SCHEME_CAR(l), p);
+        p = scheme_make_pair(p, scheme_null);
+        stop = 0;
+      } else
+        stop = 1;
+
+      if (l_last)
+        SCHEME_CDR(l_last) = p;
+      else
+        l_first = p;
+      l_last = p;
+
+      if (stop)
         break;
-      }
+      else
+        scheme_hash_set(ut->multi_scope_pairs, l, p);
     }
 
-    if (SCHEME_FALLBACKP(mm_l))
+    if (SCHEME_FALLBACKP(mm_l)) {
+      p = make_fallback_pair(l_first, scheme_null);
+      if (last)
+        SCHEME_FALLBACK_REST(last) = p;
+      else
+        first = p;
+      last = p;
       mm_l = SCHEME_FALLBACK_REST(mm_l);
-    else
+    } else {
+      if (last)
+        SCHEME_FALLBACK_REST(last) = l_first;
+      else
+        first = l_first;
       break;
+    }
   }
 
-  return multi_scopes;
+  return first;
 }
 
 static Scheme_Object *datum_to_wraps(Scheme_Object *w,