diff --git a/src/mzscheme/include/mzscheme.exp b/src/mzscheme/include/mzscheme.exp index 463f50c863..46febadb2b 100644 --- a/src/mzscheme/include/mzscheme.exp +++ b/src/mzscheme/include/mzscheme.exp @@ -525,6 +525,7 @@ scheme_set_box scheme_make_weak_box scheme_make_ephemeron scheme_ephemeron_value +scheme_ephemeron_key scheme_load scheme_load_extension scheme_register_extension_global diff --git a/src/mzscheme/include/mzscheme3m.exp b/src/mzscheme/include/mzscheme3m.exp index f4c66b67f2..120f797e6a 100644 --- a/src/mzscheme/include/mzscheme3m.exp +++ b/src/mzscheme/include/mzscheme3m.exp @@ -536,6 +536,7 @@ scheme_set_box scheme_make_weak_box scheme_make_ephemeron scheme_ephemeron_value +scheme_ephemeron_key scheme_load scheme_load_extension scheme_register_extension_global diff --git a/src/mzscheme/include/mzwin.def b/src/mzscheme/include/mzwin.def index 428cfe110e..76d166a662 100644 --- a/src/mzscheme/include/mzwin.def +++ b/src/mzscheme/include/mzwin.def @@ -513,6 +513,7 @@ EXPORTS scheme_make_weak_box scheme_make_ephemeron scheme_ephemeron_value + scheme_ephemeron_key scheme_load scheme_load_extension scheme_register_extension_global diff --git a/src/mzscheme/include/mzwin3m.def b/src/mzscheme/include/mzwin3m.def index caafcadb21..e94ce92b80 100644 --- a/src/mzscheme/include/mzwin3m.def +++ b/src/mzscheme/include/mzwin3m.def @@ -528,6 +528,7 @@ EXPORTS scheme_make_weak_box scheme_make_ephemeron scheme_ephemeron_value + scheme_ephemeron_key scheme_load scheme_load_extension scheme_register_extension_global diff --git a/src/mzscheme/src/list.c b/src/mzscheme/src/list.c index a767f16ee0..c9ce6ab5f9 100644 --- a/src/mzscheme/src/list.c +++ b/src/mzscheme/src/list.c @@ -2114,6 +2114,11 @@ Scheme_Object *scheme_ephemeron_value(Scheme_Object *o) return ((Scheme_Ephemeron *)o)->val; } +Scheme_Object *scheme_ephemeron_key(Scheme_Object *o) +{ + return ((Scheme_Ephemeron *)o)->key; +} + #ifndef MZ_PRECISE_GC static void set_ephemerons(Scheme_Ephemeron *ae, Scheme_Ephemeron *be) diff --git a/src/mzscheme/src/mzmark.c b/src/mzscheme/src/mzmark.c index 77025ecd1e..071af667f8 100644 --- a/src/mzscheme/src/mzmark.c +++ b/src/mzscheme/src/mzmark.c @@ -4010,35 +4010,6 @@ static int mark_will_FIXUP(void *p) { #define mark_will_IS_CONST_SIZE 1 -static int mark_will_registration_SIZE(void *p) { - return - gcBYTES_TO_WORDS(sizeof(WillRegistration)); -} - -static int mark_will_registration_MARK(void *p) { - WillRegistration *r = (WillRegistration *)p; - - gcMARK(r->proc); - gcMARK(r->w); - - return - gcBYTES_TO_WORDS(sizeof(WillRegistration)); -} - -static int mark_will_registration_FIXUP(void *p) { - WillRegistration *r = (WillRegistration *)p; - - gcFIXUP(r->proc); - gcFIXUP(r->w); - - return - gcBYTES_TO_WORDS(sizeof(WillRegistration)); -} - -#define mark_will_registration_IS_ATOMIC 0 -#define mark_will_registration_IS_CONST_SIZE 1 - - static int mark_evt_SIZE(void *p) { return gcBYTES_TO_WORDS(sizeof(Evt)); diff --git a/src/mzscheme/src/mzmarksrc.c b/src/mzscheme/src/mzmarksrc.c index e884f84dfe..4a9bedf8ef 100644 --- a/src/mzscheme/src/mzmarksrc.c +++ b/src/mzscheme/src/mzmarksrc.c @@ -1626,17 +1626,6 @@ mark_will { gcBYTES_TO_WORDS(sizeof(ActiveWill)); } -mark_will_registration { - mark: - WillRegistration *r = (WillRegistration *)p; - - gcMARK(r->proc); - gcMARK(r->w); - - size: - gcBYTES_TO_WORDS(sizeof(WillRegistration)); -} - mark_evt { mark: size: diff --git a/src/mzscheme/src/schemef.h b/src/mzscheme/src/schemef.h index 1ef39cc62e..73b855b720 100644 --- a/src/mzscheme/src/schemef.h +++ b/src/mzscheme/src/schemef.h @@ -1024,6 +1024,7 @@ MZ_EXTERN Scheme_Object *scheme_make_weak_box(Scheme_Object *v); MZ_EXTERN Scheme_Object *scheme_make_ephemeron(Scheme_Object *key, Scheme_Object *val); MZ_EXTERN Scheme_Object *scheme_ephemeron_value(Scheme_Object *o); +MZ_EXTERN Scheme_Object *scheme_ephemeron_key(Scheme_Object *o); MZ_EXTERN Scheme_Object *scheme_load(const char *file); MZ_EXTERN Scheme_Object *scheme_load_extension(const char *filename, Scheme_Env *env); diff --git a/src/mzscheme/src/schemex.h b/src/mzscheme/src/schemex.h index c97cdad4b8..ee66883d67 100644 --- a/src/mzscheme/src/schemex.h +++ b/src/mzscheme/src/schemex.h @@ -845,6 +845,7 @@ void (*scheme_set_box)(Scheme_Object *b, Scheme_Object *v); Scheme_Object *(*scheme_make_weak_box)(Scheme_Object *v); Scheme_Object *(*scheme_make_ephemeron)(Scheme_Object *key, Scheme_Object *val); Scheme_Object *(*scheme_ephemeron_value)(Scheme_Object *o); +Scheme_Object *(*scheme_ephemeron_key)(Scheme_Object *o); Scheme_Object *(*scheme_load)(const char *file); Scheme_Object *(*scheme_load_extension)(const char *filename, Scheme_Env *env); void (*scheme_register_extension_global)(void *ptr, long size); diff --git a/src/mzscheme/src/schemex.inc b/src/mzscheme/src/schemex.inc index 00780dc0c3..05e5d6c508 100644 --- a/src/mzscheme/src/schemex.inc +++ b/src/mzscheme/src/schemex.inc @@ -580,6 +580,7 @@ scheme_extension_table->scheme_make_weak_box = scheme_make_weak_box; scheme_extension_table->scheme_make_ephemeron = scheme_make_ephemeron; scheme_extension_table->scheme_ephemeron_value = scheme_ephemeron_value; + scheme_extension_table->scheme_ephemeron_key = scheme_ephemeron_key; scheme_extension_table->scheme_load = scheme_load; scheme_extension_table->scheme_load_extension = scheme_load_extension; scheme_extension_table->scheme_register_extension_global = scheme_register_extension_global; diff --git a/src/mzscheme/src/schemexm.h b/src/mzscheme/src/schemexm.h index ff0abdcc60..144256b278 100644 --- a/src/mzscheme/src/schemexm.h +++ b/src/mzscheme/src/schemexm.h @@ -580,6 +580,7 @@ #define scheme_make_weak_box (scheme_extension_table->scheme_make_weak_box) #define scheme_make_ephemeron (scheme_extension_table->scheme_make_ephemeron) #define scheme_ephemeron_value (scheme_extension_table->scheme_ephemeron_value) +#define scheme_ephemeron_key (scheme_extension_table->scheme_ephemeron_key) #define scheme_load (scheme_extension_table->scheme_load) #define scheme_load_extension (scheme_extension_table->scheme_load_extension) #define scheme_register_extension_global (scheme_extension_table->scheme_register_extension_global) diff --git a/src/mzscheme/src/stypes.h b/src/mzscheme/src/stypes.h index dfcab7145d..a2722f45f7 100644 --- a/src/mzscheme/src/stypes.h +++ b/src/mzscheme/src/stypes.h @@ -204,40 +204,39 @@ enum { scheme_rt_namespace_option, /* 182 */ scheme_rt_param_data, /* 183 */ scheme_rt_will, /* 184 */ - scheme_rt_will_registration, /* 185 */ - scheme_rt_struct_proc_info, /* 186 */ - scheme_rt_linker_name, /* 187 */ - scheme_rt_param_map, /* 188 */ - scheme_rt_finalization, /* 189 */ - scheme_rt_finalizations, /* 190 */ - scheme_rt_cpp_object, /* 191 */ - scheme_rt_cpp_array_object, /* 192 */ - scheme_rt_stack_object, /* 193 */ - scheme_rt_preallocated_object, /* 194 */ - scheme_thread_hop_type, /* 195 */ - scheme_rt_srcloc, /* 196 */ - scheme_rt_evt, /* 197 */ - scheme_rt_syncing, /* 198 */ - scheme_rt_comp_prefix, /* 199 */ - scheme_rt_user_input, /* 200 */ - scheme_rt_user_output, /* 201 */ - scheme_rt_compact_port, /* 202 */ - scheme_rt_read_special_dw, /* 203 */ - scheme_rt_regwork, /* 204 */ - scheme_rt_buf_holder, /* 205 */ - scheme_rt_parameterization, /* 206 */ - scheme_rt_print_params, /* 207 */ - scheme_rt_read_params, /* 208 */ - scheme_rt_native_code, /* 209 */ - scheme_rt_native_code_plus_case, /* 210 */ - scheme_rt_jitter_data, /* 211 */ - scheme_rt_module_exports, /* 212 */ - scheme_rt_delay_load_info, /* 213 */ - scheme_rt_marshal_info, /* 214 */ - scheme_rt_unmarshal_info, /* 215 */ - scheme_rt_runstack, /* 216 */ - scheme_rt_sfs_info, /* 217 */ - scheme_rt_validate_clearing, /* 218 */ + scheme_rt_struct_proc_info, /* 185 */ + scheme_rt_linker_name, /* 186 */ + scheme_rt_param_map, /* 187 */ + scheme_rt_finalization, /* 188 */ + scheme_rt_finalizations, /* 189 */ + scheme_rt_cpp_object, /* 190 */ + scheme_rt_cpp_array_object, /* 191 */ + scheme_rt_stack_object, /* 192 */ + scheme_rt_preallocated_object, /* 193 */ + scheme_thread_hop_type, /* 194 */ + scheme_rt_srcloc, /* 195 */ + scheme_rt_evt, /* 196 */ + scheme_rt_syncing, /* 197 */ + scheme_rt_comp_prefix, /* 198 */ + scheme_rt_user_input, /* 199 */ + scheme_rt_user_output, /* 200 */ + scheme_rt_compact_port, /* 201 */ + scheme_rt_read_special_dw, /* 202 */ + scheme_rt_regwork, /* 203 */ + scheme_rt_buf_holder, /* 204 */ + scheme_rt_parameterization, /* 205 */ + scheme_rt_print_params, /* 206 */ + scheme_rt_read_params, /* 207 */ + scheme_rt_native_code, /* 208 */ + scheme_rt_native_code_plus_case, /* 209 */ + scheme_rt_jitter_data, /* 210 */ + scheme_rt_module_exports, /* 211 */ + scheme_rt_delay_load_info, /* 212 */ + scheme_rt_marshal_info, /* 213 */ + scheme_rt_unmarshal_info, /* 214 */ + scheme_rt_runstack, /* 215 */ + scheme_rt_sfs_info, /* 216 */ + scheme_rt_validate_clearing, /* 217 */ #endif _scheme_last_type_ diff --git a/src/mzscheme/src/thread.c b/src/mzscheme/src/thread.c index 089ca8e8ed..6fb732a686 100644 --- a/src/mzscheme/src/thread.c +++ b/src/mzscheme/src/thread.c @@ -6793,32 +6793,30 @@ typedef struct WillExecutor { ActiveWill *first, *last; } WillExecutor; -typedef struct WillRegistration { - MZTAG_IF_REQUIRED - Scheme_Object *proc; - WillExecutor *w; -} WillRegistration; - static void activate_will(void *o, void *data) { - WillRegistration *r = (WillRegistration *)data; ActiveWill *a; WillExecutor *w; - - a = MALLOC_ONE_RT(ActiveWill); + Scheme_Object *proc; + + w = (WillExecutor *)scheme_ephemeron_key(data); + proc = scheme_ephemeron_value(data); + + if (w) { + a = MALLOC_ONE_RT(ActiveWill); #ifdef MZTAG_REQUIRED - a->type = scheme_rt_will; + a->type = scheme_rt_will; #endif - a->o = (Scheme_Object *)o; - a->proc = r->proc; + a->o = (Scheme_Object *)o; + a->proc = proc; - w = r->w; - if (w->last) - w->last->next = a; - else - w->first = a; - w->last = a; - scheme_post_sema(w->sema); + if (w->last) + w->last->next = a; + else + w->first = a; + w->last = a; + scheme_post_sema(w->sema); + } } static Scheme_Object *do_next_will(WillExecutor *w) @@ -6862,20 +6860,16 @@ static Scheme_Object *will_executor_p(int argc, Scheme_Object **argv) static Scheme_Object *register_will(int argc, Scheme_Object **argv) { - WillRegistration *r; + Scheme_Object *e; if (NOT_SAME_TYPE(SCHEME_TYPE(argv[0]), scheme_will_executor_type)) scheme_wrong_type("will-register", "will-executor", 0, argc, argv); scheme_check_proc_arity("will-register", 1, 2, argc, argv); - r = MALLOC_ONE_RT(WillRegistration); -#ifdef MZTAG_REQUIRED - r->type = scheme_rt_will_registration; -#endif - r->proc = argv[2]; - r->w = (WillExecutor *)argv[0]; + /* If we lose track of the will executor, then drop the finalizer. */ + e = scheme_make_ephemeron(argv[0], argv[2]); - scheme_add_scheme_finalizer(argv[1], activate_will, (void *)r); + scheme_add_scheme_finalizer(argv[1], activate_will, e); return scheme_void; } @@ -7332,7 +7326,6 @@ static void register_traversers(void) GC_REG_TRAV(scheme_rt_namespace_option, mark_namespace_option); GC_REG_TRAV(scheme_rt_param_data, mark_param_data); GC_REG_TRAV(scheme_rt_will, mark_will); - GC_REG_TRAV(scheme_rt_will_registration, mark_will_registration); GC_REG_TRAV(scheme_rt_evt, mark_evt); GC_REG_TRAV(scheme_rt_syncing, mark_syncing); GC_REG_TRAV(scheme_rt_parameterization, mark_parameterization);