diff --git a/racket/src/racket/src/mzmark_read.inc b/racket/src/racket/src/mzmark_read.inc index 64cdf82a79..541c04d991 100644 --- a/racket/src/racket/src/mzmark_read.inc +++ b/racket/src/racket/src/mzmark_read.inc @@ -246,7 +246,9 @@ static int mark_unmarshal_tables_MARK(void *p, struct NewGC *gc) { #ifndef GC_NO_MARK_PROCEDURE_NEEDED Scheme_Unmarshal_Tables *ut = (Scheme_Unmarshal_Tables *)p; gcMARK2(ut->rns, gc); + gcMARK2(ut->current_rns, gc); gcMARK2(ut->multi_scope_pairs, gc); + gcMARK2(ut->current_multi_scope_pairs, gc); gcMARK2(ut->rp, gc); gcMARK2(ut->decoded, gc); # ifdef GC_NO_SIZE_NEEDED_FROM_PROCS @@ -262,7 +264,9 @@ static int mark_unmarshal_tables_FIXUP(void *p, struct NewGC *gc) { #ifndef GC_NO_FIXUP_PROCEDURE_NEEDED Scheme_Unmarshal_Tables *ut = (Scheme_Unmarshal_Tables *)p; gcFIXUP2(ut->rns, gc); + gcFIXUP2(ut->current_rns, gc); gcFIXUP2(ut->multi_scope_pairs, gc); + gcFIXUP2(ut->current_multi_scope_pairs, gc); gcFIXUP2(ut->rp, gc); gcFIXUP2(ut->decoded, gc); # ifdef GC_NO_SIZE_NEEDED_FROM_PROCS diff --git a/racket/src/racket/src/mzmarksrc.c b/racket/src/racket/src/mzmarksrc.c index 31e8fd52f1..96d438a8df 100644 --- a/racket/src/racket/src/mzmarksrc.c +++ b/racket/src/racket/src/mzmarksrc.c @@ -2326,7 +2326,9 @@ mark_unmarshal_tables { mark: Scheme_Unmarshal_Tables *ut = (Scheme_Unmarshal_Tables *)p; gcMARK2(ut->rns, gc); + gcMARK2(ut->current_rns, gc); gcMARK2(ut->multi_scope_pairs, gc); + gcMARK2(ut->current_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 d358c322fc..3ec0ef105e 100644 --- a/racket/src/racket/src/read.c +++ b/racket/src/racket/src/read.c @@ -4397,6 +4397,34 @@ static void make_ut(CPort *port) port->ut->multi_scope_pairs = rht; } +static void prepare_current_unmarshal(Scheme_Unmarshal_Tables *ut) +{ + /* in case a previous unmarshal was interrupted: */ + ut->current_rns = NULL; + ut->current_multi_scope_pairs = NULL; +} + +static void merge_ht(Scheme_Hash_Table *f, Scheme_Hash_Table *t) +{ + int i; + for (i = f->size; i--; ) { + if (f->vals[i]) + scheme_hash_set(t, f->keys[i], f->vals[i]); + } +} + +static void complete_current_unmarshal(Scheme_Unmarshal_Tables *ut) +{ + if (ut->current_rns) { + merge_ht(ut->current_rns, ut->rns); + ut->current_rns = NULL; + } + if (ut->current_multi_scope_pairs) { + merge_ht(ut->current_multi_scope_pairs, ut->multi_scope_pairs); + ut->current_multi_scope_pairs = NULL; + } +} + /* Since read_compact_number is called often, we want it to be a cheap call in 3m, so avoid anything that allocated --- even error reporting, since we can make up a valid number. */ @@ -4563,20 +4591,33 @@ static Scheme_Object *resolve_symtab_refs(Scheme_Object *v, CPort *port) if (SCHEME_NULLP(port->symtab_refs)) return v; - v = scheme_make_pair(v, port->symtab_refs); + if (v) { + v = scheme_make_pair(v, port->symtab_refs); + + v = resolve_references(v, port->orig_port, NULL, + scheme_make_hash_table(SCHEME_hash_ptr), + scheme_make_hash_table(SCHEME_hash_ptr), + 0, 0); + + l = SCHEME_CDR(v); + } else + l = port->symtab_refs; - v = resolve_references(v, port->orig_port, NULL, - scheme_make_hash_table(SCHEME_hash_ptr), - scheme_make_hash_table(SCHEME_hash_ptr), - 0, 0); - - for (l = SCHEME_CDR(v); !SCHEME_NULLP(l); l = SCHEME_CDR(l)) { - port->symtab[SCHEME_INT_VAL(SCHEME_CAR(SCHEME_CAR(l)))] = SCHEME_CDR(SCHEME_CAR(l)); + for (; !SCHEME_NULLP(l); l = SCHEME_CDR(l)) { + if (v) + port->symtab[SCHEME_INT_VAL(SCHEME_CAR(SCHEME_CAR(l)))] = SCHEME_CDR(SCHEME_CAR(l)); + else { + /* interrupted; discard partial constructions */ + port->symtab[SCHEME_INT_VAL(SCHEME_CAR(SCHEME_CAR(l)))] = NULL; + } } port->symtab_refs = scheme_null; - - return SCHEME_CAR(v); + + if (v) + return SCHEME_CAR(v); + else + return NULL; } static Scheme_Object *read_compact(CPort *port, int use_stack); @@ -4804,6 +4845,7 @@ static Scheme_Object *read_compact(CPort *port, int use_stack) save_ht = *port->ht; *port->ht = NULL; + prepare_current_unmarshal(port->ut); v = read_compact(port, 1); if (!SCHEME_NULLP(port->symtab_refs)) @@ -4822,6 +4864,7 @@ static Scheme_Object *read_compact(CPort *port, int use_stack) scheme_num_read_syntax_objects++; if (!v) scheme_ill_formed_code(port); + complete_current_unmarshal(port->ut); } break; case CPT_MARSHALLED: @@ -5936,6 +5979,9 @@ Scheme_Object *scheme_load_delayed_code(int _which, Scheme_Load_Delay *_delay_in rp->pos = delay_info->shared_offsets[which - 1]; + if (delay_info->ut) + prepare_current_unmarshal(delay_info->ut); + /* Perform the read, catching escapes so we can clean up: */ savebuf = scheme_current_thread->error_buf; scheme_current_thread->error_buf = &newbuf; @@ -5954,8 +6000,10 @@ Scheme_Object *scheme_load_delayed_code(int _which, Scheme_Load_Delay *_delay_in v = resolve_symtab_refs(v, rp); delay_info->current_rp = old_rp; - if (delay_info->ut) + if (delay_info->ut) { delay_info->ut->rp = old_rp; + complete_current_unmarshal(delay_info->ut); + } if (!old_rp && !delay_info->perma_cache) { /* No one using the cache, to register it to be cleaned up */ diff --git a/racket/src/racket/src/schpriv.h b/racket/src/racket/src/schpriv.h index 1ad35bdb3a..cfbd1fa113 100644 --- a/racket/src/racket/src/schpriv.h +++ b/racket/src/racket/src/schpriv.h @@ -35,6 +35,17 @@ #define HOOK_SHARED_OK /* EMPTY */ #endif +#ifdef OS_X +# define MZ_CHECK_ASSERTS +#endif + +#ifdef MZ_CHECK_ASSERTS +# include +# define MZ_ASSERT(x) assert(x) +#else +# define MZ_ASSERT(x) /* empty */ +#endif + /*========================================================================*/ /* optimization flags */ /*========================================================================*/ @@ -3377,7 +3388,9 @@ void scheme_marshal_pop_refs(Scheme_Marshal_Tables *mt, int keep); typedef struct Scheme_Unmarshal_Tables { MZTAG_IF_REQUIRED Scheme_Hash_Table *rns; + Scheme_Hash_Table *current_rns; /* in-progress unmarshal, commit to `rns` at end */ Scheme_Hash_Table *multi_scope_pairs; /* records conversions */ + Scheme_Hash_Table *current_multi_scope_pairs; /* commit to `multi_scope_pairs` at end */ 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 a7d07b3bed..400fb17b57 100644 --- a/racket/src/racket/src/syntax.c +++ b/racket/src/racket/src/syntax.c @@ -263,16 +263,7 @@ int stx_alloc_prop_table, stx_skip_alloc_prop_table; - => clean, but inspector needs to be proagated to children - (list ...+) [interned] => armed; first inspector is to propagate */ -#ifdef OS_X -# define CHECK_STX_ASSERTS -#endif - -#ifdef CHECK_STX_ASSERTS -# include -# define STX_ASSERT(x) assert(x) -#else -# define STX_ASSERT(x) /* empty */ -#endif +#define STX_ASSERT(x) MZ_ASSERT(x) static Scheme_Object *make_vector3(Scheme_Object *a, Scheme_Object *b, Scheme_Object *c) { @@ -6531,6 +6522,37 @@ Scheme_Object *scheme_syntax_to_datum(Scheme_Object *stx, int with_scopes, #define return_NULL return NULL +Scheme_Object *scheme_hash_get_either(Scheme_Hash_Table *ht, Scheme_Hash_Table *ht2, + Scheme_Object *key) +{ + Scheme_Object *val; + val = scheme_hash_get(ht, key); + if (val) + return val; + else if (ht2) + return scheme_hash_get(ht2, key); + else + return NULL; +} + +static void ensure_current_rns(Scheme_Unmarshal_Tables *ut) +{ + Scheme_Hash_Table *rht; + if (!ut->current_rns) { + rht = scheme_make_hash_table(SCHEME_hash_ptr); + ut->current_rns = rht; + } +} + +static void ensure_current_multi_scope_pairs(Scheme_Unmarshal_Tables *ut) +{ + Scheme_Hash_Table *rht; + if (!ut->current_multi_scope_pairs) { + rht = scheme_make_hash_table(SCHEME_hash_ptr); + ut->current_multi_scope_pairs = rht; + } +} + Scheme_Scope_Set *list_to_scope_set(Scheme_Object *l, Scheme_Unmarshal_Tables *ut) { Scheme_Scope_Set *scopes = NULL; @@ -6538,7 +6560,7 @@ Scheme_Scope_Set *list_to_scope_set(Scheme_Object *l, Scheme_Unmarshal_Tables *u while (!SCHEME_NULLP(l)) { if (!SCHEME_PAIRP(l)) return_NULL; - scopes = (Scheme_Scope_Set *)scheme_hash_get(ut->rns, l); + scopes = (Scheme_Scope_Set *)scheme_hash_get_either(ut->rns, ut->current_rns, l); if (scopes) break; r = scheme_make_pair(l, r); @@ -6554,7 +6576,8 @@ Scheme_Scope_Set *list_to_scope_set(Scheme_Object *l, Scheme_Unmarshal_Tables *u if (!scope) return_NULL; scopes = scope_set_set(scopes, scope, scheme_true); - scheme_hash_set(ut->rns, l, (Scheme_Object *)scopes); + ensure_current_rns(ut); + scheme_hash_set(ut->current_rns, l, (Scheme_Object *)scopes); r = SCHEME_CDR(r); } @@ -6571,7 +6594,7 @@ static Scheme_Hash_Table *vector_to_multi_scope(Scheme_Object *mht, Scheme_Unmar if (!SCHEME_VECTORP(mht)) return_NULL; - multi_scope = (Scheme_Hash_Table *)scheme_hash_get(ut->rns, mht); + multi_scope = (Scheme_Hash_Table *)scheme_hash_get_either(ut->rns, ut->current_rns, mht); if (multi_scope) return multi_scope; multi_scope = scheme_make_hash_table(SCHEME_hash_ptr); @@ -6591,7 +6614,8 @@ static Scheme_Hash_Table *vector_to_multi_scope(Scheme_Object *mht, Scheme_Unmar len -= 1; /* A multi-scope can refer back to itself via free-id=? info: */ - scheme_hash_set(ut->rns, mht, (Scheme_Object *)multi_scope); + ensure_current_rns(ut); + scheme_hash_set(ut->current_rns, mht, (Scheme_Object *)multi_scope); for (i = 0; i < len; i += 2) { if (!SCHEME_PHASEP(SCHEME_VEC_ELS(mht)[i])) @@ -6633,9 +6657,9 @@ Scheme_Object *unmarshal_multi_scopes(Scheme_Object *multi_scopes, if (!SCHEME_PAIRP(l)) return_NULL; if (!SCHEME_PAIRP(SCHEME_CAR(l))) return_NULL; - p = scheme_hash_get(ut->multi_scope_pairs, l); + p = scheme_hash_get_either(ut->multi_scope_pairs, ut->current_multi_scope_pairs, l); if (!p) { - p = scheme_hash_get(ut->multi_scope_pairs, SCHEME_CAR(l)); + p = scheme_hash_get_either(ut->multi_scope_pairs, ut->current_multi_scope_pairs, SCHEME_CAR(l)); if (p) { p = scheme_make_pair(p, scheme_null); } else { @@ -6645,11 +6669,13 @@ Scheme_Object *unmarshal_multi_scopes(Scheme_Object *multi_scopes, 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); + ensure_current_multi_scope_pairs(ut); + scheme_hash_set(ut->current_multi_scope_pairs, SCHEME_CAR(l), p); } else return_NULL; } - scheme_hash_set(ut->multi_scope_pairs, SCHEME_CAR(l), p); + ensure_current_multi_scope_pairs(ut); + scheme_hash_set(ut->current_multi_scope_pairs, SCHEME_CAR(l), p); p = scheme_make_pair(p, scheme_null); stop = 0; } else @@ -6663,8 +6689,10 @@ Scheme_Object *unmarshal_multi_scopes(Scheme_Object *multi_scopes, if (stop) break; - else - scheme_hash_set(ut->multi_scope_pairs, l, p); + else { + ensure_current_multi_scope_pairs(ut); + scheme_hash_set(ut->current_multi_scope_pairs, l, p); + } } if (SCHEME_FALLBACKP(mm_l)) { @@ -6694,7 +6722,7 @@ static Scheme_Object *datum_to_wraps(Scheme_Object *w, Scheme_Scope_Set *scopes; Scheme_Object *l; - l = scheme_hash_get(ut->rns, w); + l = scheme_hash_get_either(ut->rns, ut->current_rns, w); if (l) { if (!SCHEME_PAIRP(l) || !SAME_TYPE(SCHEME_TYPE(SCHEME_CAR(l)), scheme_scope_table_type)) @@ -6719,7 +6747,8 @@ static Scheme_Object *datum_to_wraps(Scheme_Object *w, st->multi_scopes = l; l = scheme_make_pair((Scheme_Object *)st, SCHEME_VEC_ELS(w)[0]); - scheme_hash_set(ut->rns, w, l); + ensure_current_rns(ut); + scheme_hash_set(ut->current_rns, w, l); return l; } @@ -6828,7 +6857,7 @@ Scheme_Object *scope_unmarshal_content(Scheme_Object *box, Scheme_Unmarshal_Tabl if (SAME_OBJ(box, root_scope)) return root_scope; - r = scheme_hash_get(ut->rns, box); + r = scheme_hash_get_either(ut->rns, ut->current_rns, box); if (r) return r; @@ -6848,7 +6877,9 @@ Scheme_Object *scope_unmarshal_content(Scheme_Object *box, Scheme_Unmarshal_Tabl c = SCHEME_CDR(c); } else m = scheme_new_scope(SCHEME_STX_MACRO_SCOPE); - scheme_hash_set(ut->rns, box, m); + + ensure_current_rns(ut); + scheme_hash_set(ut->current_rns, box, m); /* Since we've created the scope before unmarshaling its content, cycles among scopes are ok. */