suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

No shared symbols

Browse Source
This commit is contained in:
Kevin Tew 2010-05-20 17:32:55 -06:00
parent 24c5a9aed8
commit 4d23b11d8f
12 changed files with 329 additions and 201 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
src/racket/gc2/gc2.h
View File

@ -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 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 # ifdef __cplusplus
}; };
# endif # endif

34
src/racket/gc2/newgc.c
View File

@ -1881,6 +1881,16 @@ void GC_write_barrier(void *p)
#include "sighand.c" #include "sighand.c"
#ifdef MZ_USE_PLACES #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() { static void NewGCMasterInfo_initialize() {
int i; int i;
MASTERGCINFO = ofm_malloc_zero(sizeof(NewGCMasterInfo)); MASTERGCINFO = ofm_malloc_zero(sizeof(NewGCMasterInfo));
@ -1889,7 +1899,7 @@ static void NewGCMasterInfo_initialize() {
MASTERGCINFO->ready = 0; MASTERGCINFO->ready = 0;
MASTERGCINFO->signal_fds = realloc(MASTERGCINFO->signal_fds, sizeof(void*) * MASTERGCINFO->size); MASTERGCINFO->signal_fds = realloc(MASTERGCINFO->signal_fds, sizeof(void*) * MASTERGCINFO->size);
for (i=0; i < 32; i++ ) { 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_rwlock_create(&MASTERGCINFO->cangc);
mzrt_sema_create(&MASTERGCINFO->wait_sema, 0); mzrt_sema_create(&MASTERGCINFO->wait_sema, 0);
@ -1925,6 +1935,11 @@ static void master_collect_initiate() {
#endif #endif
count++; 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)) { if (count == (MASTERGCINFO->alive -1)) {
break; break;
} }
@ -2026,7 +2041,7 @@ static long NewGCMasterInfo_find_free_id() {
int i; int i;
int size = MASTERGCINFO->size; int size = MASTERGCINFO->size;
for (i = 0; i < size; i++) { for (i = 0; i < size; i++) {
if (MASTERGCINFO->signal_fds[i] == (void*)-2) { if (MASTERGCINFO->signal_fds[i] == (void*) REAPED_SLOT_AVAILABLE) {
MASTERGCINFO->alive++; MASTERGCINFO->alive++;
return i; return i;
} }
@ -2042,7 +2057,7 @@ static void NewGCMasterInfo_register_gc(NewGC *newgc) {
{ {
long newid = NewGCMasterInfo_find_free_id(); long newid = NewGCMasterInfo_find_free_id();
newgc->place_id = newid; 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"); GC_LOCK_DEBUG("UNMGCLOCK NewGCMasterInfo_register_gc\n");
mzrt_rwlock_unlock(MASTERGCINFO->cangc); mzrt_rwlock_unlock(MASTERGCINFO->cangc);
@ -2053,6 +2068,10 @@ void GC_set_put_external_event_fd(void *fd) {
mzrt_rwlock_wrlock(MASTERGCINFO->cangc); mzrt_rwlock_wrlock(MASTERGCINFO->cangc);
GC_LOCK_DEBUG("MGCLOCK GC_set_put_external_event_fd\n"); 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; MASTERGCINFO->signal_fds[gc->place_id] = fd;
} }
GC_LOCK_DEBUG("UNMGCLOCK GC_set_put_external_event_fd\n"); GC_LOCK_DEBUG("UNMGCLOCK GC_set_put_external_event_fd\n");
@ -2159,6 +2178,7 @@ void GC_construct_child_gc() {
NewGC *gc = MASTERGC; 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 *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->primoridal_gc = MASTERGC;
newgc->dont_master_gc_until_child_registers = 1;
} }
void GC_destruct_child_gc() { void GC_destruct_child_gc() {
@ -2170,7 +2190,7 @@ void GC_destruct_child_gc() {
GC_LOCK_DEBUG("MGCLOCK GC_destruct_child_gc\n"); GC_LOCK_DEBUG("MGCLOCK GC_destruct_child_gc\n");
waiting = MASTERGC->major_places_gc; waiting = MASTERGC->major_places_gc;
if (!waiting) { if (!waiting) {
MASTERGCINFO->signal_fds[gc->place_id] = (void *)-2; MASTERGCINFO->signal_fds[gc->place_id] = (void *) REAPED_SLOT_AVAILABLE;
gc->place_id = -1; gc->place_id = -1;
MASTERGCINFO->alive--; MASTERGCINFO->alive--;
} }
@ -2178,6 +2198,7 @@ void GC_destruct_child_gc() {
mzrt_rwlock_unlock(MASTERGCINFO->cangc); mzrt_rwlock_unlock(MASTERGCINFO->cangc);
if (waiting) { if (waiting) {
garbage_collect(gc, 1, 0); garbage_collect(gc, 1, 0);
waiting = 1; waiting = 1;
@ -2203,18 +2224,21 @@ void GC_switch_out_master_gc() {
if(!initialized) { if(!initialized) {
NewGC *gc = GC_get_GC(); NewGC *gc = GC_get_GC();
initialized = 1; initialized = 1;
garbage_collect(gc, 1, 1); garbage_collect(gc, 1, 1);
#ifdef MZ_USE_PLACES #ifdef MZ_USE_PLACES
GC_gen0_alloc_page_ptr = 2; GC_gen0_alloc_page_ptr = 2;
GC_gen0_alloc_page_end = 1; GC_gen0_alloc_page_end = 1;
gc->dont_master_gc_until_child_registers = 0;
#endif #endif
MASTERGC = gc; MASTERGC = gc;
MASTERGC->dumping_avoid_collection = 1; MASTERGC->dumping_avoid_collection = 1;
save_globals_to_gc(MASTERGC); save_globals_to_gc(MASTERGC);
GC_construct_child_gc(); GC_construct_child_gc();
GC_allow_master_gc_check();
} }
else { else {
GCPRINT(GCOUTF, "GC_switch_out_master_gc should only be called once!\n"); 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 #ifdef MZ_USE_PLACES
if (postmaster_and_place_gc(gc)) { 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); wait_if_master_in_progress(gc);
} }
} }

1
src/racket/gc2/newgc.h
View File

@ -178,6 +178,7 @@ typedef struct NewGC {
#ifdef MZ_USE_PLACES #ifdef MZ_USE_PLACES
int place_id; int place_id;
int major_places_gc; /* :1; */ int major_places_gc; /* :1; */
int dont_master_gc_until_child_registers; /* :1: */
#endif #endif
struct mpage *thread_local_pages; struct mpage *thread_local_pages;

8
src/racket/include/schthread.h
View File

@ -286,6 +286,10 @@ typedef struct Thread_Local_Variables {
struct mzrt_mutex *jit_lock_; struct mzrt_mutex *jit_lock_;
struct free_list_entry *free_list_; struct free_list_entry *free_list_;
int free_list_bucket_count_; 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*/ /*KPLAKE1*/
} Thread_Local_Variables; } 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 jit_lock XOA (scheme_get_thread_local_variables()->jit_lock_)
#define free_list XOA (scheme_get_thread_local_variables()->free_list_) #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 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*/ /*KPLAKE2*/
/* **************************************** */ /* **************************************** */

6
src/racket/src/env.c
View File

@ -361,6 +361,7 @@ Scheme_Env *scheme_engine_instance_init() {
scheme_places_block_child_signal(); scheme_places_block_child_signal();
GC_switch_out_master_gc(); GC_switch_out_master_gc();
scheme_spawn_master_place(); scheme_spawn_master_place();
#endif #endif
@ -463,6 +464,11 @@ static Scheme_Env *place_instance_init(void *stack_base, int initial_main_os_thr
scheme_make_thread(stack_base); 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; Scheme_Object *sym;
sym = scheme_intern_symbol("mzscheme"); sym = scheme_intern_symbol("mzscheme");

4
src/racket/src/fun.c
View File

@ -7695,9 +7695,7 @@ scheme_get_stack_trace(Scheme_Object *mark_set)
name = scheme_make_pair(scheme_false, loc); name = scheme_make_pair(scheme_false, loc);
else else
name = scheme_make_pair(SCHEME_VEC_ELS(name)[0], loc); name = scheme_make_pair(SCHEME_VEC_ELS(name)[0], loc);
} else if (SCHEME_PAIRP(name) } else if (SCHEME_PAIRP(name) && SCHEME_RMPP(SCHEME_CAR(name))) {
&& SAME_TYPE(SCHEME_TYPE(SCHEME_CAR(name)),
scheme_resolved_module_path_type)) {
/* a resolved module path means that we're running a module body */ /* a resolved module path means that we're running a module body */
const char *what; const char *what;

136
src/racket/src/module.c
View File

@ -29,6 +29,8 @@
#include "schmach.h" #include "schmach.h"
#include "schexpobs.h" #include "schexpobs.h"
#define MIN(l,o) ((l) < (o) ? (l) : (o))
/* globals */ /* globals */
SHARED_OK Scheme_Object *(*scheme_module_demand_hook)(int, Scheme_Object **); 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_Module_Exports *make_module_exports();
static Scheme_Object *scheme_sys_wraps_phase_worker(long p); 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 #define cons scheme_make_pair
@ -224,6 +227,7 @@ THREAD_LOCAL_DECL(static Scheme_Object *global_shift_cache);
#endif #endif
#define SCHEME_MODNAMEP(obj) SAME_TYPE(SCHEME_TYPE(obj), scheme_resolved_module_path_type) #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, typedef void (*Check_Func)(Scheme_Object *prnt_name, Scheme_Object *name,
Scheme_Object *nominal_modname, Scheme_Object *nominal_export, 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) if (argc == 1)
return scheme_void; /* ignore notify */ return scheme_void; /* ignore notify */
/* if (quote SYMBOL) */
if (SCHEME_PAIRP(p) if (SCHEME_PAIRP(p)
&& SAME_OBJ(SCHEME_CAR(p), quote_symbol) && SAME_OBJ(SCHEME_CAR(p), quote_symbol)
&& SCHEME_PAIRP(SCHEME_CDR(p)) && 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]); m = scheme_extract_compiled_module(argv[0]);
if (m) { 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); 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(); 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_Object *rmp;
Scheme_Bucket *b; Scheme_Object *newo;
Scheme_Object *return_value;
mzrt_mutex_lock(modpath_table_mutex); #if defined(MZ_USE_PLACES)
if (SCHEME_SYMBOLP(o)) {
rmp = scheme_alloc_small_object(); newo = scheme_make_sized_offset_byte_string(SCHEME_SYM_VAL(o), 0, SCHEME_SYM_LEN(o), 1);
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;
} }
else {
#if defined(MZ_USE_PLACES) && defined(MZ_PRECISE_GC) newo = o;
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;
} }
#else
newo = o;
#endif #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_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) #if defined(MZ_USE_PLACES) && defined(MZ_PRECISE_GC)
void *return_payload; if (place_local_modpath_table) {
if (SCHEME_SYMBOLP(o) && SCHEME_SYM_UNINTERNEDP(o)) { b = scheme_bucket_or_null_from_table(place_local_modpath_table, (const char *)rmp, 0);
return scheme_intern_local_resolved_module_path_worker(o); if (b) {
return (Scheme_Object *)HT_EXTRACT_WEAK(b->key);
}
} }
return_payload = scheme_master_fast_path(1, o);
return (Scheme_Object*) return_payload;
#endif #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[]) 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])) if (!SCHEME_MODNAMEP(argv[0]))
scheme_wrong_type("resolved-module-path-name", "resolved-module-path", 0, argc, argv); 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); 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): */ /* phase shift to replace self_modidx of previous expansion (if any): */
fm = scheme_stx_phase_shift(fm, 0, empty_self_modidx, self_modidx, NULL); 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); 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_make_pair(mb, scheme_make_pair(fm, scheme_null));
fm = scheme_datum_to_syntax(fm, form, form, 0, 2); 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: */ /* Since fm is a newly-created syntax object, we need to re-add renamings: */
fm = scheme_add_rename(fm, rn_set); 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(scheme_false, l);
l = cons(m->me->src_modidx, l); l = cons(m->me->src_modidx, l);
l = cons(SCHEME_PTR_VAL(m->modsrc), l); l = cons(resolved_module_path_value(m->modsrc), l);
l = cons(SCHEME_PTR_VAL(m->modname), l); l = cons(resolved_module_path_value(m->modname), l);
return l; return l;
} }

91
src/racket/src/places.c
View File

@ -504,6 +504,7 @@ Scheme_Object *scheme_places_deep_copy_worker(Scheme_Object *so, Scheme_Hash_Tab
scheme_log_abort("cannot copy uninterned symbol"); scheme_log_abort("cannot copy uninterned symbol");
abort(); abort();
} else } else
scheme_log_abort("NEED SERIALZATION WORK");
new_so = so; new_so = so;
break; break;
case scheme_pair_type: 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[0] = scheme_places_deep_copy(place_data->module);
a[1] = scheme_places_deep_copy(place_data->function); 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)) { if (!SAME_TYPE(SCHEME_TYPE(place_data->channel), scheme_place_bi_channel_type)) {
channel = scheme_places_deep_copy(place_data->channel); 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); mzrt_sema_post(place_data->ready);
place_data = NULL; 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 /* at point point, don't refer to place_data or its content
anymore, because it's allocated in the other place */ 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; return (void*) rc;
} }
# ifdef MZ_PRECISE_GC
Scheme_Hash_Table *force_hash(Scheme_Object *so);
# endif
Scheme_Object *scheme_places_deep_copy_in_master(Scheme_Object *so) { Scheme_Object *scheme_places_deep_copy_in_master(Scheme_Object *so) {
#if defined(MZ_USE_PLACES) && defined(MZ_PRECISE_GC) #if defined(MZ_USE_PLACES) && defined(MZ_PRECISE_GC)
void *return_payload; Scheme_Object *o;
return_payload = scheme_master_fast_path(5, so); void *original_gc;
return (Scheme_Object*) return_payload; Scheme_Hash_Table *ht;
ht = force_hash(so);
# ifdef MZ_PRECISE_GC
original_gc = GC_switch_to_master_gc();
scheme_start_atomic();
# endif # 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; return so;
#endif
} }
Scheme_Object *scheme_place_send(int argc, Scheme_Object *args[]) { 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; 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() { void scheme_spawn_master_place() {
mzrt_proc_first_thread_init(); mzrt_proc_first_thread_init();

9
src/racket/src/portfun.c
View File

@ -4109,7 +4109,7 @@ static Scheme_Object *do_load_handler(void *data)
m = scheme_extract_compiled_module(SCHEME_STX_VAL(d)); m = scheme_extract_compiled_module(SCHEME_STX_VAL(d));
if (m) { if (m) {
if (check_module_name) { 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; other = m->modname;
d = NULL; d = NULL;
} }
@ -4139,8 +4139,9 @@ static Scheme_Object *do_load_handler(void *data)
/* If d is NULL, shape was wrong */ /* If d is NULL, shape was wrong */
if (!d) { if (!d) {
Scheme_Object *err_msg;
if (!other || !SCHEME_SYMBOLP(other)) if (!other || !SCHEME_SYMBOLP(other))
other = scheme_make_byte_string("something else"); err_msg = scheme_make_byte_string("something else");
else { else {
char *s, *t; char *s, *t;
long len, slen; long len, slen;
@ -4155,7 +4156,7 @@ static Scheme_Object *do_load_handler(void *data)
s[len + slen] = '\''; s[len + slen] = '\'';
s[len + slen + 1]= 0; 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, scheme_raise_exn(MZEXN_FAIL,
"default-load-handler: expected a `module' declaration for `%S', found: %T in: %V", "default-load-handler: expected a `module' declaration for `%S', found: %T in: %V",
lhd->expected_module, lhd->expected_module,
other, err_msg,
ip->name); ip->name);
} }

7
src/racket/src/schpriv.h
View File

@ -263,6 +263,7 @@ void scheme_init_variable_references_constants(void);
void scheme_init_logger(void); void scheme_init_logger(void);
void scheme_init_file_places(void); void scheme_init_file_places(void);
void scheme_init_foreign_places(void); void scheme_init_foreign_places(void);
void scheme_init_place_local_symbol_table(void);
Scheme_Logger *scheme_get_main_logger(void); Scheme_Logger *scheme_get_main_logger(void);
void scheme_init_logger_config(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_from_modidx,
Scheme_Object *shift_to_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(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 *scheme_hash_module_variable(Scheme_Env *env, Scheme_Object *modidx,
Scheme_Object *stxsym, Scheme_Object *insp, Scheme_Object *stxsym, Scheme_Object *insp,
@ -3322,7 +3324,6 @@ void scheme_alloc_global_fdset();
/*========================================================================*/ /*========================================================================*/
#ifdef MEMORY_COUNTING_ON #ifdef MEMORY_COUNTING_ON
extern Scheme_Hash_Table *scheme_symbol_table;
extern long scheme_type_table_count; extern long scheme_type_table_count;
extern long scheme_misc_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); 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_intern_exact_parallel_symbol(const char *name, unsigned int len);
Scheme_Object *scheme_symbol_append(Scheme_Object *s1, Scheme_Object *s2); Scheme_Object *scheme_symbol_append(Scheme_Object *s1, Scheme_Object *s2);
Scheme_Object *scheme_copy_list(Scheme_Object *l); Scheme_Object *scheme_copy_list(Scheme_Object *l);
@ -3436,7 +3436,6 @@ typedef struct Scheme_Symbol_Parts {
} Scheme_Symbol_Parts; } Scheme_Symbol_Parts;
void scheme_spawn_master_place(); void scheme_spawn_master_place();
void *scheme_master_fast_path(int msg_type, void *msg_payload);
void scheme_places_block_child_signal(); void scheme_places_block_child_signal();
int scheme_get_child_status(int pid, int *status); int scheme_get_child_status(int pid, int *status);
int scheme_places_register_child(int pid, void *signal_fd, int *status); int scheme_places_register_child(int pid, void *signal_fd, int *status);

49
src/racket/src/struct.c
View File

@ -166,7 +166,7 @@ static Scheme_Object *make_chaperone_property(int argc, Scheme_Object *argv[]);
static void register_traversers(void); static void register_traversers(void);
#endif #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); static Scheme_Object *make_prefab_key(Scheme_Struct_Type *type);
#define cons scheme_make_pair #define cons scheme_make_pair
@ -632,9 +632,6 @@ scheme_init_struct (Scheme_Env *env)
REGISTER_SO(prefab_symbol); REGISTER_SO(prefab_symbol);
prefab_symbol = scheme_intern_symbol("prefab"); prefab_symbol = scheme_intern_symbol("prefab");
REGISTER_SO(prefab_table);
prefab_table = scheme_make_weak_equal_table();
REGISTER_SO(scheme_source_property); REGISTER_SO(scheme_source_property);
{ {
@ -3677,10 +3674,12 @@ static Scheme_Struct_Type *scheme_make_prefab_struct_type(Scheme_Object *base,
char *immutable_array) char *immutable_array)
{ {
#ifdef MZ_USE_PLACES #ifdef MZ_USE_PLACES
/*
return scheme_make_prefab_struct_type_in_master return scheme_make_prefab_struct_type_in_master
*/
#else #else
return scheme_make_prefab_struct_type_raw
#endif #endif
return scheme_make_prefab_struct_type_raw
(base, (base,
parent, parent,
num_fields, num_fields,
@ -4057,6 +4056,11 @@ static Scheme_Struct_Type *hash_prefab(Scheme_Struct_Type *type)
{ {
Scheme_Object *k, *v; Scheme_Object *k, *v;
if (!prefab_table) {
REGISTER_SO(prefab_table);
prefab_table = scheme_make_weak_equal_table();
}
k = make_prefab_key(type); k = make_prefab_key(type);
type->prefab_key = k; type->prefab_key = k;
@ -4330,7 +4334,19 @@ static Scheme_Object *make_prefab_key(Scheme_Struct_Type *type)
if (!SCHEME_NULLP(stack)) if (!SCHEME_NULLP(stack))
key = scheme_make_pair(scheme_make_integer(icnt), key); 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); key = scheme_make_pair(type->name, key);
#endif
if (SCHEME_PAIRP(stack)) { if (SCHEME_PAIRP(stack)) {
type = (Scheme_Struct_Type *)SCHEME_CAR(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; int ucnt, icnt;
char *immutable_array = NULL; 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)) if (SCHEME_SYMBOLP(key))
key = scheme_make_pair(key, scheme_null); key = scheme_make_pair(key, scheme_null);
#endif
if (scheme_proper_list_length(key) < 0) if (scheme_proper_list_length(key) < 0)
return NULL; return NULL;
@ -4465,9 +4492,21 @@ Scheme_Struct_Type *scheme_lookup_prefab_type(Scheme_Object *key, int field_coun
a = SCHEME_CAR(key); a = SCHEME_CAR(key);
key = SCHEME_CDR(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)) if (!SCHEME_SYMBOLP(a))
return NULL; return NULL;
name = a; name = a;
#endif
immutable_array = mutability_data_to_immutability_data(icnt + ucnt, mutables); immutable_array = mutability_data_to_immutability_data(icnt + ucnt, mutables);

167
src/racket/src/symbol.c
View File

@ -48,18 +48,16 @@ extern MZ_DLLIMPORT void (*GC_custom_finalize)(void);
extern int GC_is_marked(void *); extern int GC_is_marked(void *);
#endif #endif
SHARED_OK Scheme_Hash_Table *scheme_symbol_table = NULL; #if defined(MZ_USE_PLACES) && defined(MZ_PRECISE_GC)
SHARED_OK Scheme_Hash_Table *scheme_keyword_table = NULL; THREAD_LOCAL_DECL(static Scheme_Hash_Table *place_local_symbol_table = NULL;)
SHARED_OK Scheme_Hash_Table *scheme_parallel_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;)
#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 */
#endif #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; SHARED_OK static unsigned long scheme_max_symbol_length;
/* globals */ /* globals */
@ -220,15 +218,15 @@ static Scheme_Object *rehash_symbol_bucket(Scheme_Hash_Table *table,
} }
#ifndef MZ_PRECISE_GC #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 /* Clean the symbol table by removing pointers to collected
symbols. The correct way to do this is to install a GC symbols. The correct way to do this is to install a GC
finalizer on symbol pointers, but that would be expensive. */ finalizer on symbol pointers, but that would be expensive. */
if (symbol_table) { if (table) {
Scheme_Object **buckets = (Scheme_Object **)symbol_table->keys; Scheme_Object **buckets = (Scheme_Object **)table->keys;
int i = symbol_table->size; int i = table->size;
void *b; void *b;
while (i--) { while (i--) {
@ -246,9 +244,10 @@ static void clean_one_symbol_table(Scheme_Hash_Table *symbol_table)
static void clean_symbol_table(void) static void clean_symbol_table(void)
{ {
clean_one_symbol_table(scheme_symbol_table); clean_one_symbol_table(symbol_table);
clean_one_symbol_table(scheme_keyword_table); clean_one_symbol_table(keyword_table);
clean_one_symbol_table(scheme_parallel_symbol_table); clean_one_symbol_table(parallel_symbol_table);
scheme_clear_ephemerons(); scheme_clear_ephemerons();
# ifdef MZ_USE_JIT # ifdef MZ_USE_JIT
scheme_clean_native_symtab(); scheme_clean_native_symtab();
@ -266,46 +265,56 @@ static void clean_symbol_table(void)
static Scheme_Hash_Table *init_one_symbol_table() static Scheme_Hash_Table *init_one_symbol_table()
{ {
Scheme_Hash_Table *symbol_table; Scheme_Hash_Table *table;
int size; int size;
Scheme_Object **ba; 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 #ifdef MZ_PRECISE_GC
ba = (Scheme_Object **)GC_malloc_weak_array(size, SYMTAB_LOST_CELL); ba = (Scheme_Object **)GC_malloc_weak_array(size, SYMTAB_LOST_CELL);
#else #else
ba = MALLOC_N_ATOMIC(Scheme_Object *, size); ba = MALLOC_N_ATOMIC(Scheme_Object *, size);
memset((char *)ba, 0, size); memset((char *)ba, 0, size);
#endif #endif
symbol_table->keys = ba; table->keys = ba;
return symbol_table; return table;
} }
void void
scheme_init_symbol_table () scheme_init_symbol_table ()
{ {
REGISTER_SO(scheme_symbol_table); REGISTER_SO(symbol_table);
REGISTER_SO(scheme_keyword_table); REGISTER_SO(keyword_table);
REGISTER_SO(scheme_parallel_symbol_table); REGISTER_SO(parallel_symbol_table);
scheme_symbol_table = init_one_symbol_table(); symbol_table = init_one_symbol_table();
scheme_keyword_table = init_one_symbol_table(); keyword_table = init_one_symbol_table();
scheme_parallel_symbol_table = init_one_symbol_table(); parallel_symbol_table = init_one_symbol_table();
#ifdef MZ_USE_PLACES
mzrt_rwlock_create(&symbol_table_lock);
#endif
#ifndef MZ_PRECISE_GC #ifndef MZ_PRECISE_GC
GC_custom_finalize = clean_symbol_table; GC_custom_finalize = clean_symbol_table;
#endif #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 void
scheme_init_symbol_type (Scheme_Env *env) 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); return make_a_symbol(bs, blen, 0x1);
} }
Scheme_Object * typedef enum {
scheme_intern_exact_symbol_in_table_worker(Scheme_Hash_Table *symbol_table, int kind, const char *name, unsigned int len) 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_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 = NULL;
sym = symbol_bucket(symbol_table, name, len, NULL);
mzrt_rwlock_unlock(symbol_table_lock);
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) { 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_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); newsymbol = make_a_symbol(name, len, kind);
/* we must return the result of this symbol bucket call because another /* we must return the result of this symbol bucket call because another
* thread could have inserted the same symbol between the first * thread could have inserted the same symbol between the first
* :qsymbol_bucket call above and this one */ * symbol_bucket call above and this one */
mzrt_rwlock_wrlock(symbol_table_lock); sym = symbol_bucket(create_table, name, len, newsymbol);
sym = symbol_bucket(symbol_table, name, len, newsymbol);
mzrt_rwlock_unlock(symbol_table_lock);
} }
return sym; return sym;
} }
Scheme_Object * static Scheme_Object *
scheme_intern_exact_symbol_in_table(Scheme_Hash_Table *symbol_table, int kind, const char *name, unsigned int len) 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) return intern_exact_symbol_in_table_worker(type, kind, name, len);
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);
} }
Scheme_Object * Scheme_Object *
scheme_intern_exact_symbol(const char *name, unsigned int len) 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_Object *
scheme_intern_exact_parallel_symbol(const char *name, unsigned int len) 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 * Scheme_Object *
@ -446,14 +493,14 @@ scheme_intern_exact_char_symbol(const mzchar *name, unsigned int len)
char buf[64], *bs; char buf[64], *bs;
long blen; long blen;
bs = scheme_utf8_encode_to_buffer_len(name, len, buf, 64, &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_Object *
scheme_intern_exact_keyword(const char *name, unsigned int len) scheme_intern_exact_keyword(const char *name, unsigned int len)
{ {
Scheme_Object *s; 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) if (s->type == scheme_symbol_type)
s->type = scheme_keyword_type; s->type = scheme_keyword_type;
return s; return s;
@ -465,7 +512,7 @@ Scheme_Object *scheme_intern_exact_char_keyword(const mzchar *name, unsigned int
long blen; long blen;
Scheme_Object *s; Scheme_Object *s;
bs = scheme_utf8_encode_to_buffer_len(name, len, buf, 64, &blen); 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) if (s->type == scheme_symbol_type)
s->type = scheme_keyword_type; s->type = scheme_keyword_type;
return s; return s;