diff --git a/racket/src/racket/src/mzmark_read.inc b/racket/src/racket/src/mzmark_read.inc index 1675c8d255..174103aba0 100644 --- a/racket/src/racket/src/mzmark_read.inc +++ b/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 diff --git a/racket/src/racket/src/mzmarksrc.c b/racket/src/racket/src/mzmarksrc.c index 96eed8c542..61a22b3cc0 100644 --- a/racket/src/racket/src/mzmarksrc.c +++ b/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: diff --git a/racket/src/racket/src/read.c b/racket/src/racket/src/read.c index 94f944dcaf..156e711f12 100644 --- a/racket/src/racket/src/read.c +++ b/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 diff --git a/racket/src/racket/src/schpriv.h b/racket/src/racket/src/schpriv.h index 4bb6a034c7..fb8ce29794 100644 --- a/racket/src/racket/src/schpriv.h +++ b/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; diff --git a/racket/src/racket/src/syntax.c b/racket/src/racket/src/syntax.c index 97083f6763..815d967465 100644 --- a/racket/src/racket/src/syntax.c +++ b/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); - if (!multi_scope) return_NULL; - SCHEME_CAR(SCHEME_CAR(l)) = (Scheme_Object *)multi_scope; - if (!SCHEME_PHASE_SHIFTP(SCHEME_CDR(SCHEME_CAR(l)))) return_NULL; - } else { - /* rest of list must be converted already, too */ + + p = scheme_hash_get(ut->multi_scope_pairs, l); + if (!p) { + p = scheme_hash_get(ut->multi_scope_pairs, SCHEME_CAR(l)); + if (p) { + p = scheme_make_pair(p, scheme_null); + } 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,