From 4d23b11d8f5c8da90c727725b595ef81d7bab10c Mon Sep 17 00:00:00 2001 From: Kevin Tew Date: Thu, 20 May 2010 17:32:55 -0600 Subject: [PATCH] No shared symbols --- src/racket/gc2/gc2.h | 6 ++ src/racket/gc2/newgc.c | 34 ++++++- src/racket/gc2/newgc.h | 1 + src/racket/include/schthread.h | 8 ++ src/racket/src/env.c | 6 ++ src/racket/src/fun.c | 4 +- src/racket/src/module.c | 140 ++++++++++++++++----------- src/racket/src/places.c | 95 +++++++----------- src/racket/src/portfun.c | 9 +- src/racket/src/schpriv.h | 7 +- src/racket/src/struct.c | 51 ++++++++-- src/racket/src/symbol.c | 169 +++++++++++++++++++++------------ 12 files changed, 329 insertions(+), 201 deletions(-) diff --git a/src/racket/gc2/gc2.h b/src/racket/gc2/gc2.h index 9c350c53ae..f51a4d40a9 100644 --- a/src/racket/gc2/gc2.h +++ b/src/racket/gc2/gc2.h @@ -454,6 +454,12 @@ GC2_EXTERN void GC_set_put_external_event_fd(void *fd); Sets the fd that can be passed to scheme_signal_received_at to wake up the place for GC */ +GC2_EXTERN void GC_allow_master_gc_check(); +/* + Signals the GC after spawning a place that the places is sufficiently set up to participate + in master gc collections +*/ + # ifdef __cplusplus }; # endif diff --git a/src/racket/gc2/newgc.c b/src/racket/gc2/newgc.c index c3222cf7cd..006b7fd7e8 100644 --- a/src/racket/gc2/newgc.c +++ b/src/racket/gc2/newgc.c @@ -1881,6 +1881,16 @@ void GC_write_barrier(void *p) #include "sighand.c" #ifdef MZ_USE_PLACES +typedef enum { + SIGNALED_BUT_NOT_REGISTERED = -3, + REAPED_SLOT_AVAILABLE = -2, + CREATED_BUT_NOT_REGISTERED = -1, +}; + +void GC_allow_master_gc_check() { + NewGC *gc = GC_get_GC(); + gc->dont_master_gc_until_child_registers = 0; +} static void NewGCMasterInfo_initialize() { int i; MASTERGCINFO = ofm_malloc_zero(sizeof(NewGCMasterInfo)); @@ -1889,7 +1899,7 @@ static void NewGCMasterInfo_initialize() { MASTERGCINFO->ready = 0; MASTERGCINFO->signal_fds = realloc(MASTERGCINFO->signal_fds, sizeof(void*) * MASTERGCINFO->size); for (i=0; i < 32; i++ ) { - MASTERGCINFO->signal_fds[i] = (void *)-2; + MASTERGCINFO->signal_fds[i] = (void *)REAPED_SLOT_AVAILABLE; } mzrt_rwlock_create(&MASTERGCINFO->cangc); mzrt_sema_create(&MASTERGCINFO->wait_sema, 0); @@ -1925,6 +1935,11 @@ static void master_collect_initiate() { #endif count++; } + else if ( signal_fd == (void*)-1) { + /* printf("%i SIGNALED BUT NOT REGISTERED YET\n", i); */ + MASTERGCINFO->signal_fds[i] = (void*) SIGNALED_BUT_NOT_REGISTERED; + count++; + } if (count == (MASTERGCINFO->alive -1)) { break; } @@ -2026,7 +2041,7 @@ static long NewGCMasterInfo_find_free_id() { int i; int size = MASTERGCINFO->size; for (i = 0; i < size; i++) { - if (MASTERGCINFO->signal_fds[i] == (void*)-2) { + if (MASTERGCINFO->signal_fds[i] == (void*) REAPED_SLOT_AVAILABLE) { MASTERGCINFO->alive++; return i; } @@ -2042,7 +2057,7 @@ static void NewGCMasterInfo_register_gc(NewGC *newgc) { { long newid = NewGCMasterInfo_find_free_id(); newgc->place_id = newid; - MASTERGCINFO->signal_fds[newid] = (void *)-1; + MASTERGCINFO->signal_fds[newid] = (void *) CREATED_BUT_NOT_REGISTERED; } GC_LOCK_DEBUG("UNMGCLOCK NewGCMasterInfo_register_gc\n"); mzrt_rwlock_unlock(MASTERGCINFO->cangc); @@ -2053,6 +2068,10 @@ void GC_set_put_external_event_fd(void *fd) { mzrt_rwlock_wrlock(MASTERGCINFO->cangc); GC_LOCK_DEBUG("MGCLOCK GC_set_put_external_event_fd\n"); { + if ( MASTERGCINFO->signal_fds[gc->place_id] == (void*) SIGNALED_BUT_NOT_REGISTERED) { + scheme_signal_received_at(fd); + /* printf("%i THERE WAITING ON ME\n", gc->place_id); */ + } MASTERGCINFO->signal_fds[gc->place_id] = fd; } GC_LOCK_DEBUG("UNMGCLOCK GC_set_put_external_event_fd\n"); @@ -2159,6 +2178,7 @@ void GC_construct_child_gc() { NewGC *gc = MASTERGC; NewGC *newgc = init_type_tags_worker(gc, 0, 0, 0, gc->weak_box_tag, gc->ephemeron_tag, gc->weak_array_tag, gc->cust_box_tag); newgc->primoridal_gc = MASTERGC; + newgc->dont_master_gc_until_child_registers = 1; } void GC_destruct_child_gc() { @@ -2170,7 +2190,7 @@ void GC_destruct_child_gc() { GC_LOCK_DEBUG("MGCLOCK GC_destruct_child_gc\n"); waiting = MASTERGC->major_places_gc; if (!waiting) { - MASTERGCINFO->signal_fds[gc->place_id] = (void *)-2; + MASTERGCINFO->signal_fds[gc->place_id] = (void *) REAPED_SLOT_AVAILABLE; gc->place_id = -1; MASTERGCINFO->alive--; } @@ -2178,6 +2198,7 @@ void GC_destruct_child_gc() { mzrt_rwlock_unlock(MASTERGCINFO->cangc); + if (waiting) { garbage_collect(gc, 1, 0); waiting = 1; @@ -2203,18 +2224,21 @@ void GC_switch_out_master_gc() { if(!initialized) { NewGC *gc = GC_get_GC(); + initialized = 1; garbage_collect(gc, 1, 1); #ifdef MZ_USE_PLACES GC_gen0_alloc_page_ptr = 2; GC_gen0_alloc_page_end = 1; + gc->dont_master_gc_until_child_registers = 0; #endif MASTERGC = gc; MASTERGC->dumping_avoid_collection = 1; save_globals_to_gc(MASTERGC); GC_construct_child_gc(); + GC_allow_master_gc_check(); } else { GCPRINT(GCOUTF, "GC_switch_out_master_gc should only be called once!\n"); @@ -3857,7 +3881,7 @@ static void garbage_collect(NewGC *gc, int force_full, int switching_master) #ifdef MZ_USE_PLACES if (postmaster_and_place_gc(gc)) { - if (gc->gc_full && master_wants_to_collect) { + if (gc->gc_full && master_wants_to_collect && !(gc->dont_master_gc_until_child_registers)) { wait_if_master_in_progress(gc); } } diff --git a/src/racket/gc2/newgc.h b/src/racket/gc2/newgc.h index 815de91646..93f59bc834 100644 --- a/src/racket/gc2/newgc.h +++ b/src/racket/gc2/newgc.h @@ -178,6 +178,7 @@ typedef struct NewGC { #ifdef MZ_USE_PLACES int place_id; int major_places_gc; /* :1; */ + int dont_master_gc_until_child_registers; /* :1: */ #endif struct mpage *thread_local_pages; diff --git a/src/racket/include/schthread.h b/src/racket/include/schthread.h index a16b62ab94..872b067452 100644 --- a/src/racket/include/schthread.h +++ b/src/racket/include/schthread.h @@ -286,6 +286,10 @@ typedef struct Thread_Local_Variables { struct mzrt_mutex *jit_lock_; struct free_list_entry *free_list_; int free_list_bucket_count_; + struct Scheme_Bucket_Table *prefab_table_; + struct Scheme_Hash_Table *place_local_symbol_table_; + struct Scheme_Hash_Table *place_local_keyword_table_; + struct Scheme_Hash_Table *place_local_parallel_symbol_table_; /*KPLAKE1*/ } Thread_Local_Variables; @@ -574,6 +578,10 @@ XFORM_GC_VARIABLE_STACK_THROUGH_THREAD_LOCAL; #define jit_lock XOA (scheme_get_thread_local_variables()->jit_lock_) #define free_list XOA (scheme_get_thread_local_variables()->free_list_) #define free_list_bucket_count XOA (scheme_get_thread_local_variables()->free_list_bucket_count_) +#define prefab_table XOA (scheme_get_thread_local_variables()->prefab_table_) +#define place_local_symbol_table XOA (scheme_get_thread_local_variables()->place_local_symbol_table_) +#define place_local_keyword_table XOA (scheme_get_thread_local_variables()->place_local_keyword_table_) +#define place_local_parallel_symbol_table XOA (scheme_get_thread_local_variables()->place_local_parallel_symbol_table_) /*KPLAKE2*/ /* **************************************** */ diff --git a/src/racket/src/env.c b/src/racket/src/env.c index d5b0447c84..5d92d25ce2 100644 --- a/src/racket/src/env.c +++ b/src/racket/src/env.c @@ -361,6 +361,7 @@ Scheme_Env *scheme_engine_instance_init() { scheme_places_block_child_signal(); GC_switch_out_master_gc(); + scheme_spawn_master_place(); #endif @@ -463,6 +464,11 @@ static Scheme_Env *place_instance_init(void *stack_base, int initial_main_os_thr scheme_make_thread(stack_base); +#if defined(MZ_PRECISE_GC) && defined(MZ_USE_PLACES) + /* each place now has a local symbol table */ + scheme_init_place_local_symbol_table(); +#endif + { Scheme_Object *sym; sym = scheme_intern_symbol("mzscheme"); diff --git a/src/racket/src/fun.c b/src/racket/src/fun.c index 419aebeb77..5bb3cad5f2 100644 --- a/src/racket/src/fun.c +++ b/src/racket/src/fun.c @@ -7695,9 +7695,7 @@ scheme_get_stack_trace(Scheme_Object *mark_set) name = scheme_make_pair(scheme_false, loc); else name = scheme_make_pair(SCHEME_VEC_ELS(name)[0], loc); - } else if (SCHEME_PAIRP(name) - && SAME_TYPE(SCHEME_TYPE(SCHEME_CAR(name)), - scheme_resolved_module_path_type)) { + } else if (SCHEME_PAIRP(name) && SCHEME_RMPP(SCHEME_CAR(name))) { /* a resolved module path means that we're running a module body */ const char *what; diff --git a/src/racket/src/module.c b/src/racket/src/module.c index bb67528cbe..59bfdcd03e 100644 --- a/src/racket/src/module.c +++ b/src/racket/src/module.c @@ -29,6 +29,8 @@ #include "schmach.h" #include "schexpobs.h" +#define MIN(l,o) ((l) < (o) ? (l) : (o)) + /* globals */ SHARED_OK Scheme_Object *(*scheme_module_demand_hook)(int, Scheme_Object **); @@ -127,6 +129,7 @@ static void eval_exptime(Scheme_Object *names, int count, static Scheme_Module_Exports *make_module_exports(); static Scheme_Object *scheme_sys_wraps_phase_worker(long p); +static Scheme_Object *resolved_module_path_value(Scheme_Object *rmp); #define cons scheme_make_pair @@ -224,6 +227,7 @@ THREAD_LOCAL_DECL(static Scheme_Object *global_shift_cache); #endif #define SCHEME_MODNAMEP(obj) SAME_TYPE(SCHEME_TYPE(obj), scheme_resolved_module_path_type) +#define SCHEME_RMP_VAL(obj) SCHEME_PTR_VAL(obj) typedef void (*Check_Func)(Scheme_Object *prnt_name, Scheme_Object *name, Scheme_Object *nominal_modname, Scheme_Object *nominal_export, @@ -804,6 +808,7 @@ static Scheme_Object *default_module_resolver(int argc, Scheme_Object **argv) if (argc == 1) return scheme_void; /* ignore notify */ + /* if (quote SYMBOL) */ if (SCHEME_PAIRP(p) && SAME_OBJ(SCHEME_CAR(p), quote_symbol) && SCHEME_PAIRP(SCHEME_CDR(p)) @@ -2791,7 +2796,7 @@ static Scheme_Object *module_compiled_name(int argc, Scheme_Object *argv[]) m = scheme_extract_compiled_module(argv[0]); if (m) { - return SCHEME_PTR_VAL(m->modname); + return resolved_module_path_value(m->modname); } scheme_wrong_type("module-compiled-name", "compiled module declaration", 0, argc, argv); @@ -2895,65 +2900,90 @@ void scheme_init_module_path_table() modpath_table = scheme_make_weak_equal_table(); } -Scheme_Object *scheme_intern_resolved_module_path_worker(Scheme_Object *o) +static Scheme_Object *make_resolved_module_path_obj(Scheme_Object *o) { Scheme_Object *rmp; - Scheme_Bucket *b; - Scheme_Object *return_value; + Scheme_Object *newo; - mzrt_mutex_lock(modpath_table_mutex); - - rmp = scheme_alloc_small_object(); - rmp->type = scheme_resolved_module_path_type; - SCHEME_PTR_VAL(rmp) = o; - - scheme_start_atomic(); - b = scheme_bucket_from_table(modpath_table, (const char *)rmp); - scheme_end_atomic_no_swap(); - if (!b->val) - b->val = scheme_true; - - return_value = (Scheme_Object *)HT_EXTRACT_WEAK(b->key); - - mzrt_mutex_unlock(modpath_table_mutex); - - return return_value; -} - -#if defined(MZ_USE_PLACES) && defined(MZ_PRECISE_GC) -static Scheme_Object *scheme_intern_local_resolved_module_path_worker(Scheme_Object *o) -{ - Scheme_Object *rmp; - Scheme_Bucket *b; - Scheme_Object *return_value; - - rmp = scheme_alloc_small_object(); - rmp->type = scheme_resolved_module_path_type; - SCHEME_PTR_VAL(rmp) = o; - - scheme_start_atomic(); - b = scheme_bucket_from_table(place_local_modpath_table, (const char *)rmp); - scheme_end_atomic_no_swap(); - if (!b->val) - b->val = scheme_true; - - return_value = (Scheme_Object *)HT_EXTRACT_WEAK(b->key); - - return return_value; -} +#if defined(MZ_USE_PLACES) + if (SCHEME_SYMBOLP(o)) { + newo = scheme_make_sized_offset_byte_string(SCHEME_SYM_VAL(o), 0, SCHEME_SYM_LEN(o), 1); + } + else { + newo = o; + } +#else + newo = o; #endif + + rmp = scheme_alloc_small_object(); + rmp->type = scheme_resolved_module_path_type; + SCHEME_PTR_VAL(rmp) = newo; + + return rmp; +} + +static Scheme_Object *resolved_module_path_value(Scheme_Object *rmp) +{ + Scheme_Object *rmp_val; + rmp_val = SCHEME_RMP_VAL(rmp); + +/*symbols aren't equal across places now*/ +#if defined(MZ_USE_PLACES) + if (SCHEME_BYTE_STRINGP(rmp_val)) + return scheme_intern_exact_symbol(SCHEME_BYTE_STR_VAL(rmp_val), SCHEME_BYTE_STRLEN_VAL(rmp_val)); +#endif + + return rmp_val; +} + +int scheme_resolved_module_path_value_matches(Scheme_Object *rmp, Scheme_Object *o) { + Scheme_Object *rmp_val = SCHEME_RMP_VAL(rmp); + if (SAME_OBJ(rmp_val, o)) return 1; + else if (SCHEME_BYTE_STRINGP(rmp_val) && SCHEME_SYMBOLP(o)) { + return !strncmp(SCHEME_BYTE_STR_VAL(rmp_val), SCHEME_SYM_VAL(o), MIN(SCHEME_BYTE_STRLEN_VAL(rmp_val), SCHEME_SYM_LEN(o))); + } + else { + scheme_arg_mismatch("scheme_resolved_module_path_value_matches", + "unknown type of resolved_module_path_value", + rmp_val); + return 0; + } +} Scheme_Object *scheme_intern_resolved_module_path(Scheme_Object *o) { + Scheme_Bucket_Table *create_table; + Scheme_Object *rmp; + Scheme_Bucket *b; + + + rmp = make_resolved_module_path_obj(o); #if defined(MZ_USE_PLACES) && defined(MZ_PRECISE_GC) - void *return_payload; - if (SCHEME_SYMBOLP(o) && SCHEME_SYM_UNINTERNEDP(o)) { - return scheme_intern_local_resolved_module_path_worker(o); + if (place_local_modpath_table) { + b = scheme_bucket_or_null_from_table(place_local_modpath_table, (const char *)rmp, 0); + if (b) { + return (Scheme_Object *)HT_EXTRACT_WEAK(b->key); + } } - return_payload = scheme_master_fast_path(1, o); - return (Scheme_Object*) return_payload; #endif - return scheme_intern_resolved_module_path_worker(o); + b = scheme_bucket_or_null_from_table(modpath_table, (const char *)rmp, 0); + if (b) { + return (Scheme_Object *)HT_EXTRACT_WEAK(b->key); + } + +#if defined(MZ_USE_PLACES) && defined(MZ_PRECISE_GC) + create_table = place_local_modpath_table ? place_local_modpath_table : modpath_table; +#else + create_table = modpath_table; +#endif + + scheme_start_atomic(); + b = scheme_bucket_from_table(create_table, (const char *)rmp); + scheme_end_atomic_no_swap(); + if (!b->val) + b->val = scheme_true; + return(Scheme_Object *)HT_EXTRACT_WEAK(b->key); } static Scheme_Object *resolved_module_path_p(int argc, Scheme_Object *argv[]) @@ -2980,7 +3010,7 @@ static Scheme_Object *resolved_module_path_name(int argc, Scheme_Object *argv[]) if (!SCHEME_MODNAMEP(argv[0])) scheme_wrong_type("resolved-module-path-name", "resolved-module-path", 0, argc, argv); - return SCHEME_PTR_VAL(argv[0]); + return resolved_module_path_value(argv[0]); } @@ -5991,7 +6021,7 @@ static Scheme_Object *do_module(Scheme_Object *form, Scheme_Comp_Env *env, SCHEME_EXPAND_OBSERVE_TAG(rec[drec].observer, fm); } - fm = scheme_stx_property(fm, module_name_symbol, SCHEME_PTR_VAL(m->modname)); + fm = scheme_stx_property(fm, module_name_symbol, resolved_module_path_value(m->modname)); /* phase shift to replace self_modidx of previous expansion (if any): */ fm = scheme_stx_phase_shift(fm, 0, empty_self_modidx, self_modidx, NULL); @@ -6010,7 +6040,7 @@ static Scheme_Object *do_module(Scheme_Object *form, Scheme_Comp_Env *env, mb = scheme_datum_to_syntax(module_begin_symbol, form, scheme_false, 0, 0); fm = scheme_make_pair(mb, scheme_make_pair(fm, scheme_null)); fm = scheme_datum_to_syntax(fm, form, form, 0, 2); - fm = scheme_stx_property(fm, module_name_symbol, SCHEME_PTR_VAL(m->modname)); + fm = scheme_stx_property(fm, module_name_symbol, resolved_module_path_value(m->modname)); /* Since fm is a newly-created syntax object, we need to re-add renamings: */ fm = scheme_add_rename(fm, rn_set); @@ -10065,8 +10095,8 @@ static Scheme_Object *write_module(Scheme_Object *obj) l = cons(scheme_false, l); l = cons(m->me->src_modidx, l); - l = cons(SCHEME_PTR_VAL(m->modsrc), l); - l = cons(SCHEME_PTR_VAL(m->modname), l); + l = cons(resolved_module_path_value(m->modsrc), l); + l = cons(resolved_module_path_value(m->modname), l); return l; } diff --git a/src/racket/src/places.c b/src/racket/src/places.c index 5560f5c5db..9a3b59924d 100644 --- a/src/racket/src/places.c +++ b/src/racket/src/places.c @@ -504,6 +504,7 @@ Scheme_Object *scheme_places_deep_copy_worker(Scheme_Object *so, Scheme_Hash_Tab scheme_log_abort("cannot copy uninterned symbol"); abort(); } else + scheme_log_abort("NEED SERIALZATION WORK"); new_so = so; break; case scheme_pair_type: @@ -647,6 +648,7 @@ static void *place_start_proc_after_stack(void *data_arg, void *stack_base) { a[0] = scheme_places_deep_copy(place_data->module); a[1] = scheme_places_deep_copy(place_data->function); + a[1] = scheme_intern_exact_symbol(SCHEME_SYM_VAL(a[1]), SCHEME_SYM_LEN(a[1])); if (!SAME_TYPE(SCHEME_TYPE(place_data->channel), scheme_place_bi_channel_type)) { channel = scheme_places_deep_copy(place_data->channel); } @@ -657,6 +659,13 @@ static void *place_start_proc_after_stack(void *data_arg, void *stack_base) { mzrt_sema_post(place_data->ready); place_data = NULL; +# ifdef MZ_PRECISE_GC + /* this prevents a master collection attempt from deadlocking with the + place_data->ready semaphore above */ + GC_allow_master_gc_check(); +# endif + + /* at point point, don't refer to place_data or its content anymore, because it's allocated in the other place */ @@ -689,13 +698,31 @@ static void *place_start_proc_after_stack(void *data_arg, void *stack_base) { return (void*) rc; } -Scheme_Object *scheme_places_deep_copy_in_master(Scheme_Object *so) { -# if defined(MZ_USE_PLACES) && defined(MZ_PRECISE_GC) - void *return_payload; - return_payload = scheme_master_fast_path(5, so); - return (Scheme_Object*) return_payload; +# ifdef MZ_PRECISE_GC +Scheme_Hash_Table *force_hash(Scheme_Object *so); # endif + +Scheme_Object *scheme_places_deep_copy_in_master(Scheme_Object *so) { +#if defined(MZ_USE_PLACES) && defined(MZ_PRECISE_GC) + Scheme_Object *o; + void *original_gc; + Scheme_Hash_Table *ht; + + ht = force_hash(so); + +# ifdef MZ_PRECISE_GC + original_gc = GC_switch_to_master_gc(); + scheme_start_atomic(); +# endif + o = scheme_places_deep_copy_worker(so, ht); +# ifdef MZ_PRECISE_GC + scheme_end_atomic_no_swap(); + GC_switch_back_from_master(original_gc); +# endif + return o; +#else return so; +#endif } Scheme_Object *scheme_place_send(int argc, Scheme_Object *args[]) { @@ -824,64 +851,6 @@ void force_hash_worker(Scheme_Object *so, Scheme_Hash_Table *ht) return; } -static void* scheme_master_place_handlemsg(int msg_type, void *msg_payload) -{ - switch(msg_type) { - case 1: - { - Scheme_Object *o; - Scheme_Object *copied_o; - copied_o = scheme_places_deep_copy((Scheme_Object *)msg_payload); - o = scheme_intern_resolved_module_path_worker(copied_o); - return o; - } - break; - case 3: - { - Scheme_Object *o; - Scheme_Symbol_Parts *parts; - parts = (Scheme_Symbol_Parts *) msg_payload; - o = (Scheme_Object *)scheme_intern_exact_symbol_in_table_worker(parts->table, parts->kind, parts->name, parts->len); - return o; - } - break; - case 5: - { - Scheme_Object *copied_o; - copied_o = scheme_places_deep_copy((Scheme_Object *)msg_payload); - return copied_o; - } - break; - } - return NULL; -} - -void* scheme_master_fast_path(int msg_type, void *msg_payload) { - Scheme_Object *o; - void *original_gc; - Scheme_Hash_Table *ht; - - switch(msg_type) { - case 1: - case 5: - ht = force_hash(msg_payload); - break; - } - -# ifdef MZ_PRECISE_GC - original_gc = GC_switch_to_master_gc(); - scheme_start_atomic(); -# endif - o = scheme_master_place_handlemsg(msg_type, msg_payload); -# ifdef MZ_PRECISE_GC - scheme_end_atomic_no_swap(); - GC_switch_back_from_master(original_gc); -# endif - - return o; -} - - void scheme_spawn_master_place() { mzrt_proc_first_thread_init(); diff --git a/src/racket/src/portfun.c b/src/racket/src/portfun.c index 21084ca292..6f03aeca98 100644 --- a/src/racket/src/portfun.c +++ b/src/racket/src/portfun.c @@ -4109,7 +4109,7 @@ static Scheme_Object *do_load_handler(void *data) m = scheme_extract_compiled_module(SCHEME_STX_VAL(d)); if (m) { if (check_module_name) { - if (!SAME_OBJ(SCHEME_PTR_VAL(m->modname), lhd->expected_module)) { + if (!scheme_resolved_module_path_value_matches(m->modname, lhd->expected_module)) { other = m->modname; d = NULL; } @@ -4139,8 +4139,9 @@ static Scheme_Object *do_load_handler(void *data) /* If d is NULL, shape was wrong */ if (!d) { + Scheme_Object *err_msg; if (!other || !SCHEME_SYMBOLP(other)) - other = scheme_make_byte_string("something else"); + err_msg = scheme_make_byte_string("something else"); else { char *s, *t; long len, slen; @@ -4155,7 +4156,7 @@ static Scheme_Object *do_load_handler(void *data) s[len + slen] = '\''; s[len + slen + 1]= 0; - other = scheme_make_sized_byte_string(s, len + slen + 1, 0); + err_msg = scheme_make_sized_byte_string(s, len + slen + 1, 0); } { @@ -4164,7 +4165,7 @@ static Scheme_Object *do_load_handler(void *data) scheme_raise_exn(MZEXN_FAIL, "default-load-handler: expected a `module' declaration for `%S', found: %T in: %V", lhd->expected_module, - other, + err_msg, ip->name); } diff --git a/src/racket/src/schpriv.h b/src/racket/src/schpriv.h index 58e854d915..1144c75240 100644 --- a/src/racket/src/schpriv.h +++ b/src/racket/src/schpriv.h @@ -263,6 +263,7 @@ void scheme_init_variable_references_constants(void); void scheme_init_logger(void); void scheme_init_file_places(void); void scheme_init_foreign_places(void); +void scheme_init_place_local_symbol_table(void); Scheme_Logger *scheme_get_main_logger(void); void scheme_init_logger_config(void); @@ -2977,8 +2978,9 @@ Scheme_Object *scheme_modidx_shift(Scheme_Object *modidx, Scheme_Object *shift_from_modidx, Scheme_Object *shift_to_modidx); +#define SCHEME_RMPP(o) (SAME_TYPE(SCHEME_TYPE((o)), scheme_resolved_module_path_type)) Scheme_Object *scheme_intern_resolved_module_path(Scheme_Object *o); -Scheme_Object *scheme_intern_resolved_module_path_worker(Scheme_Object *o); +int scheme_resolved_module_path_value_matches(Scheme_Object *rmp, Scheme_Object *o); Scheme_Object *scheme_hash_module_variable(Scheme_Env *env, Scheme_Object *modidx, Scheme_Object *stxsym, Scheme_Object *insp, @@ -3322,7 +3324,6 @@ void scheme_alloc_global_fdset(); /*========================================================================*/ #ifdef MEMORY_COUNTING_ON -extern Scheme_Hash_Table *scheme_symbol_table; extern long scheme_type_table_count; extern long scheme_misc_count; @@ -3386,7 +3387,6 @@ int scheme_hash_tree_equal_rec(Scheme_Hash_Tree *t1, Scheme_Hash_Tree *t2, void void scheme_set_root_param(int p, Scheme_Object *v); -Scheme_Object *scheme_intern_exact_symbol_in_table_worker(Scheme_Hash_Table *symbol_table, int kind, const char *name, unsigned int len); Scheme_Object *scheme_intern_exact_parallel_symbol(const char *name, unsigned int len); Scheme_Object *scheme_symbol_append(Scheme_Object *s1, Scheme_Object *s2); Scheme_Object *scheme_copy_list(Scheme_Object *l); @@ -3436,7 +3436,6 @@ typedef struct Scheme_Symbol_Parts { } Scheme_Symbol_Parts; void scheme_spawn_master_place(); -void *scheme_master_fast_path(int msg_type, void *msg_payload); void scheme_places_block_child_signal(); int scheme_get_child_status(int pid, int *status); int scheme_places_register_child(int pid, void *signal_fd, int *status); diff --git a/src/racket/src/struct.c b/src/racket/src/struct.c index 29bac4f822..f73a1619cc 100644 --- a/src/racket/src/struct.c +++ b/src/racket/src/struct.c @@ -166,7 +166,7 @@ static Scheme_Object *make_chaperone_property(int argc, Scheme_Object *argv[]); static void register_traversers(void); #endif -SHARED_OK static Scheme_Bucket_Table *prefab_table; +THREAD_LOCAL_DECL(static Scheme_Bucket_Table *prefab_table); static Scheme_Object *make_prefab_key(Scheme_Struct_Type *type); #define cons scheme_make_pair @@ -632,9 +632,6 @@ scheme_init_struct (Scheme_Env *env) REGISTER_SO(prefab_symbol); prefab_symbol = scheme_intern_symbol("prefab"); - REGISTER_SO(prefab_table); - prefab_table = scheme_make_weak_equal_table(); - REGISTER_SO(scheme_source_property); { @@ -3677,10 +3674,12 @@ static Scheme_Struct_Type *scheme_make_prefab_struct_type(Scheme_Object *base, char *immutable_array) { #ifdef MZ_USE_PLACES +/* return scheme_make_prefab_struct_type_in_master +*/ #else - return scheme_make_prefab_struct_type_raw #endif + return scheme_make_prefab_struct_type_raw (base, parent, num_fields, @@ -4056,7 +4055,12 @@ static Scheme_Struct_Type *lookup_prefab(Scheme_Object *key) { static Scheme_Struct_Type *hash_prefab(Scheme_Struct_Type *type) { Scheme_Object *k, *v; - + + if (!prefab_table) { + REGISTER_SO(prefab_table); + prefab_table = scheme_make_weak_equal_table(); + } + k = make_prefab_key(type); type->prefab_key = k; @@ -4330,7 +4334,19 @@ static Scheme_Object *make_prefab_key(Scheme_Struct_Type *type) if (!SCHEME_NULLP(stack)) key = scheme_make_pair(scheme_make_integer(icnt), key); +/*symbols aren't equal? across places now*/ +#if defined(MZ_USE_PLACES) + if (SCHEME_SYMBOLP(type->name)) { + Scheme_Object *newname; + newname = scheme_make_sized_offset_byte_string(SCHEME_SYM_VAL(type->name), 0, SCHEME_SYM_LEN(type->name), 1); + key = scheme_make_pair(newname, key); + } + else { + scheme_arg_mismatch("make_prefab_key", "unknown type of struct name", type->name); + } +#else key = scheme_make_pair(type->name, key); +#endif if (SCHEME_PAIRP(stack)) { type = (Scheme_Struct_Type *)SCHEME_CAR(stack); @@ -4390,8 +4406,19 @@ Scheme_Struct_Type *scheme_lookup_prefab_type(Scheme_Object *key, int field_coun int ucnt, icnt; char *immutable_array = NULL; +/*symbols aren't equal? across places now*/ +#if defined(MZ_USE_PLACES) + if (SCHEME_SYMBOLP(key)) { + Scheme_Object *newname; + newname = scheme_make_sized_offset_byte_string(SCHEME_SYM_VAL(key), 0, SCHEME_SYM_LEN(key), 1); + key = scheme_make_pair(newname, scheme_null); + } + if (SCHEME_BYTE_STRINGP(key)) + key = scheme_make_pair(key, scheme_null); +#else if (SCHEME_SYMBOLP(key)) key = scheme_make_pair(key, scheme_null); +#endif if (scheme_proper_list_length(key) < 0) return NULL; @@ -4465,9 +4492,21 @@ Scheme_Struct_Type *scheme_lookup_prefab_type(Scheme_Object *key, int field_coun a = SCHEME_CAR(key); key = SCHEME_CDR(key); +/*symbols aren't equal? across places now*/ +#if defined(MZ_USE_PLACES) + if (SCHEME_SYMBOLP(a)) { + name = a; + } + else if (SCHEME_BYTE_STRINGP(a)) + name = scheme_intern_exact_symbol(SCHEME_BYTE_STR_VAL(a), SCHEME_BYTE_STRLEN_VAL(a)); + else + return NULL; +#else if (!SCHEME_SYMBOLP(a)) return NULL; name = a; +#endif + immutable_array = mutability_data_to_immutability_data(icnt + ucnt, mutables); diff --git a/src/racket/src/symbol.c b/src/racket/src/symbol.c index 2d0b609854..d357fb57ab 100644 --- a/src/racket/src/symbol.c +++ b/src/racket/src/symbol.c @@ -48,18 +48,16 @@ extern MZ_DLLIMPORT void (*GC_custom_finalize)(void); extern int GC_is_marked(void *); #endif -SHARED_OK Scheme_Hash_Table *scheme_symbol_table = NULL; -SHARED_OK Scheme_Hash_Table *scheme_keyword_table = NULL; -SHARED_OK Scheme_Hash_Table *scheme_parallel_symbol_table = NULL; - -#ifdef MZ_USE_PLACES -SHARED_OK static mzrt_rwlock *symbol_table_lock; -#else -# define mzrt_rwlock_rdlock(l) /* empty */ -# define mzrt_rwlock_wrlock(l) /* empty */ -# define mzrt_rwlock_unlock(l) /* empty */ +#if defined(MZ_USE_PLACES) && defined(MZ_PRECISE_GC) +THREAD_LOCAL_DECL(static Scheme_Hash_Table *place_local_symbol_table = NULL;) +THREAD_LOCAL_DECL(static Scheme_Hash_Table *place_local_keyword_table = NULL;) +THREAD_LOCAL_DECL(static Scheme_Hash_Table *place_local_parallel_symbol_table = NULL;) #endif +SHARED_OK static Scheme_Hash_Table *symbol_table = NULL; +SHARED_OK static Scheme_Hash_Table *keyword_table = NULL; +SHARED_OK static Scheme_Hash_Table *parallel_symbol_table = NULL; + SHARED_OK static unsigned long scheme_max_symbol_length; /* globals */ @@ -220,20 +218,20 @@ static Scheme_Object *rehash_symbol_bucket(Scheme_Hash_Table *table, } #ifndef MZ_PRECISE_GC -static void clean_one_symbol_table(Scheme_Hash_Table *symbol_table) +static void clean_one_symbol_table(Scheme_Hash_Table *table) { /* Clean the symbol table by removing pointers to collected symbols. The correct way to do this is to install a GC finalizer on symbol pointers, but that would be expensive. */ - if (symbol_table) { - Scheme_Object **buckets = (Scheme_Object **)symbol_table->keys; - int i = symbol_table->size; + if (table) { + Scheme_Object **buckets = (Scheme_Object **)table->keys; + int i = table->size; void *b; while (i--) { if (buckets[WEAK_ARRAY_HEADSIZE + i] && !SAME_OBJ(buckets[WEAK_ARRAY_HEADSIZE + i], SYMTAB_LOST_CELL) - && (!(b = GC_base(buckets[WEAK_ARRAY_HEADSIZE + i])) + && (!(b = GC_base(buckets[WEAK_ARRAY_HEADSIZE + i])) #ifndef USE_SENORA_GC || !GC_is_marked(b) #endif @@ -246,9 +244,10 @@ static void clean_one_symbol_table(Scheme_Hash_Table *symbol_table) static void clean_symbol_table(void) { - clean_one_symbol_table(scheme_symbol_table); - clean_one_symbol_table(scheme_keyword_table); - clean_one_symbol_table(scheme_parallel_symbol_table); + clean_one_symbol_table(symbol_table); + clean_one_symbol_table(keyword_table); + clean_one_symbol_table(parallel_symbol_table); + scheme_clear_ephemerons(); # ifdef MZ_USE_JIT scheme_clean_native_symtab(); @@ -266,46 +265,56 @@ static void clean_symbol_table(void) static Scheme_Hash_Table *init_one_symbol_table() { - Scheme_Hash_Table *symbol_table; + Scheme_Hash_Table *table; int size; Scheme_Object **ba; - symbol_table = scheme_make_hash_table(SCHEME_hash_ptr); + table = scheme_make_hash_table(SCHEME_hash_ptr); - symbol_table->size = HASH_TABLE_INIT_SIZE; + table->size = HASH_TABLE_INIT_SIZE; - size = symbol_table->size * sizeof(Scheme_Object *); + size = table->size * sizeof(Scheme_Object *); #ifdef MZ_PRECISE_GC ba = (Scheme_Object **)GC_malloc_weak_array(size, SYMTAB_LOST_CELL); #else ba = MALLOC_N_ATOMIC(Scheme_Object *, size); memset((char *)ba, 0, size); #endif - symbol_table->keys = ba; + table->keys = ba; - return symbol_table; + return table; } void scheme_init_symbol_table () { - REGISTER_SO(scheme_symbol_table); - REGISTER_SO(scheme_keyword_table); - REGISTER_SO(scheme_parallel_symbol_table); + REGISTER_SO(symbol_table); + REGISTER_SO(keyword_table); + REGISTER_SO(parallel_symbol_table); - scheme_symbol_table = init_one_symbol_table(); - scheme_keyword_table = init_one_symbol_table(); - scheme_parallel_symbol_table = init_one_symbol_table(); - -#ifdef MZ_USE_PLACES - mzrt_rwlock_create(&symbol_table_lock); -#endif + symbol_table = init_one_symbol_table(); + keyword_table = init_one_symbol_table(); + parallel_symbol_table = init_one_symbol_table(); #ifndef MZ_PRECISE_GC GC_custom_finalize = clean_symbol_table; #endif } +#if defined(MZ_USE_PLACES) && defined(MZ_PRECISE_GC) +void +scheme_init_place_local_symbol_table () +{ + REGISTER_SO(place_local_symbol_table); + REGISTER_SO(place_local_keyword_table); + REGISTER_SO(place_local_parallel_symbol_table); + + place_local_symbol_table = init_one_symbol_table(); + place_local_keyword_table = init_one_symbol_table(); + place_local_parallel_symbol_table = init_one_symbol_table(); +} +#endif + void scheme_init_symbol_type (Scheme_Env *env) { @@ -388,56 +397,94 @@ scheme_make_exact_char_symbol(const mzchar *name, unsigned int len) return make_a_symbol(bs, blen, 0x1); } -Scheme_Object * -scheme_intern_exact_symbol_in_table_worker(Scheme_Hash_Table *symbol_table, int kind, const char *name, unsigned int len) +typedef enum { + enum_symbol, + enum_keyword, + enum_parallel_symbol, +} enum_symbol_table_type; + +static Scheme_Object * +intern_exact_symbol_in_table_worker(enum_symbol_table_type type, int kind, const char *name, unsigned int len) { Scheme_Object *sym; + Scheme_Hash_Table *table; +#if defined(MZ_USE_PLACES) && defined(MZ_PRECISE_GC) + Scheme_Hash_Table *place_local_table; +#endif - mzrt_rwlock_rdlock(symbol_table_lock); - sym = symbol_bucket(symbol_table, name, len, NULL); - mzrt_rwlock_unlock(symbol_table_lock); + sym = NULL; + switch(type) { + case enum_symbol: + table = symbol_table; +#if defined(MZ_USE_PLACES) && defined(MZ_PRECISE_GC) + place_local_table = place_local_symbol_table; +#endif + break; + case enum_keyword: + table = keyword_table; +#if defined(MZ_USE_PLACES) && defined(MZ_PRECISE_GC) + place_local_table = place_local_keyword_table; +#endif + break; + case enum_parallel_symbol: + table = parallel_symbol_table; +#if defined(MZ_USE_PLACES) && defined(MZ_PRECISE_GC) + place_local_table = place_local_parallel_symbol_table; +#endif + break; + default: + printf("Invalid enum_symbol_table_type %i\n", type); + abort(); + } + +#if defined(MZ_USE_PLACES) && defined(MZ_PRECISE_GC) + if (place_local_table) { + sym = symbol_bucket(place_local_table, name, len, NULL); + } +#endif + if (!sym && table) { + sym = symbol_bucket(table, name, len, NULL); + } if (!sym) { + /* create symbol in symbol table unless a place local symbol table has been created */ + /* once the first place has been create the symbol_table becomes read-only and + shouldn't be modified */ + Scheme_Object *newsymbol; + Scheme_Hash_Table *create_table; +#if defined(MZ_USE_PLACES) && defined(MZ_PRECISE_GC) + create_table = place_local_table ? place_local_table : table; +#else + create_table = table; +#endif newsymbol = make_a_symbol(name, len, kind); /* we must return the result of this symbol bucket call because another * thread could have inserted the same symbol between the first - * :qsymbol_bucket call above and this one */ - mzrt_rwlock_wrlock(symbol_table_lock); - sym = symbol_bucket(symbol_table, name, len, newsymbol); - mzrt_rwlock_unlock(symbol_table_lock); + * symbol_bucket call above and this one */ + sym = symbol_bucket(create_table, name, len, newsymbol); } return sym; } -Scheme_Object * -scheme_intern_exact_symbol_in_table(Scheme_Hash_Table *symbol_table, int kind, const char *name, unsigned int len) +static Scheme_Object * +intern_exact_symbol_in_table(enum_symbol_table_type type, int kind, const char *name, unsigned int len) { -#if defined(MZ_USE_PLACES) && defined(MZ_PRECISE_GC) - void *return_payload; - Scheme_Symbol_Parts parts; - parts.table = symbol_table; - parts.kind = kind; - parts.len = len; - parts.name = name; - return_payload = scheme_master_fast_path(3, &parts); - return (Scheme_Object*) return_payload; -#endif - return scheme_intern_exact_symbol_in_table_worker(symbol_table, kind, name, len); + return intern_exact_symbol_in_table_worker(type, kind, name, len); } Scheme_Object * scheme_intern_exact_symbol(const char *name, unsigned int len) { - return scheme_intern_exact_symbol_in_table(scheme_symbol_table, 0, name, len); + return intern_exact_symbol_in_table(enum_symbol, 0, name, len); } Scheme_Object * scheme_intern_exact_parallel_symbol(const char *name, unsigned int len) { - return scheme_intern_exact_symbol_in_table(scheme_parallel_symbol_table, 0x2, name, len); + return intern_exact_symbol_in_table(enum_parallel_symbol, 0x2, name, len); } Scheme_Object * @@ -446,14 +493,14 @@ scheme_intern_exact_char_symbol(const mzchar *name, unsigned int len) char buf[64], *bs; long blen; bs = scheme_utf8_encode_to_buffer_len(name, len, buf, 64, &blen); - return scheme_intern_exact_symbol_in_table(scheme_symbol_table, 0, bs, blen); + return intern_exact_symbol_in_table(enum_symbol, 0, bs, blen); } Scheme_Object * scheme_intern_exact_keyword(const char *name, unsigned int len) { Scheme_Object *s; - s = scheme_intern_exact_symbol_in_table(scheme_keyword_table, 0, name, len); + s = intern_exact_symbol_in_table(enum_keyword, 0, name, len); if (s->type == scheme_symbol_type) s->type = scheme_keyword_type; return s; @@ -465,7 +512,7 @@ Scheme_Object *scheme_intern_exact_char_keyword(const mzchar *name, unsigned int long blen; Scheme_Object *s; bs = scheme_utf8_encode_to_buffer_len(name, len, buf, 64, &blen); - s = scheme_intern_exact_symbol_in_table(scheme_keyword_table, 0, bs, blen); + s = intern_exact_symbol_in_table(enum_keyword, 0, bs, blen); if (s->type == scheme_symbol_type) s->type = scheme_keyword_type; return s;