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
*/
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

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

@ -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);
}
}

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

@ -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;

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

@ -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*/
/* **************************************** */

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

@ -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");

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);
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;

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

@ -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;
}

95
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");
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();

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));
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);
}

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_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);

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);
#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,
@ -4057,6 +4056,11 @@ 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);

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 *);
#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,15 +218,15 @@ 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--) {
@ -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;