static void register_traversers(void)
{
GC_REG_TRAV(scheme_rt_sfs_info, mark_sfs_info);
}
void scheme_register_traversers(void)
{
GC_REG_TRAV(scheme_toplevel_type, toplevel_obj);
GC_REG_TRAV(scheme_static_toplevel_type, static_toplevel_obj);
GC_REG_TRAV(scheme_variable_type, variable_obj);
GC_REG_TRAV(scheme_local_type, local_obj);
GC_REG_TRAV(scheme_local_unbox_type, local_obj);
GC_REG_TRAV(scheme_application_type, app_rec);
GC_REG_TRAV(scheme_application2_type, app2_rec);
GC_REG_TRAV(scheme_application3_type, app3_rec);
GC_REG_TRAV(scheme_sequence_type, seq_rec);
GC_REG_TRAV(scheme_branch_type, branch_rec);
GC_REG_TRAV(scheme_lambda_type, unclosed_proc);
GC_REG_TRAV(scheme_let_value_type, let_value);
GC_REG_TRAV(scheme_let_void_type, let_void);
GC_REG_TRAV(scheme_letrec_type, letrec);
GC_REG_TRAV(scheme_let_one_type, let_one);
GC_REG_TRAV(scheme_with_cont_mark_type, with_cont_mark);
GC_REG_TRAV(scheme_define_values_type, vector_obj);
GC_REG_TRAV(scheme_varref_form_type, twoptr_obj);
GC_REG_TRAV(scheme_apply_values_type, twoptr_obj);
GC_REG_TRAV(scheme_with_immed_mark_type, with_cont_mark);
GC_REG_TRAV(scheme_boxenv_type, twoptr_obj);
GC_REG_TRAV(scheme_case_lambda_sequence_type, case_closure);
GC_REG_TRAV(scheme_begin0_sequence_type, seq_rec);
GC_REG_TRAV(scheme_set_bang_type, set_bang);
GC_REG_TRAV(scheme_inline_variant_type, vector_obj);
GC_REG_TRAV(_scheme_values_types_, bad_trav);
GC_REG_TRAV(scheme_ir_lambda_type, unclosed_proc);
GC_REG_TRAV(scheme_ir_local_type, ir_local);
GC_REG_TRAV(scheme_ir_toplevel_type, ir_toplevel);
GC_REG_TRAV(scheme_ir_let_value_type, ir_let_value);
GC_REG_TRAV(scheme_ir_let_header_type, let_header);
GC_REG_TRAV(scheme_quote_compilation_type, small_object);
GC_REG_TRAV(scheme_linklet_type, linklet_val);
GC_REG_TRAV(scheme_instance_type, instance_val);
GC_REG_TRAV(scheme_linklet_directory_type, small_object);
GC_REG_TRAV(scheme_linklet_bundle_type, small_object);
GC_REG_TRAV(_scheme_ir_values_types_, bad_trav);
GC_REG_TRAV(scheme_prefix_type, prefix_val);
GC_REG_TRAV(scheme_prim_type, prim_proc);
GC_REG_TRAV(scheme_closed_prim_type, closed_prim_proc);
GC_REG_TRAV(scheme_closure_type, scm_closure);
GC_REG_TRAV(scheme_case_closure_type, case_closure);
GC_REG_TRAV(scheme_cont_type, cont_proc);
GC_REG_TRAV(scheme_rt_dyn_wind, mark_dyn_wind);
GC_REG_TRAV(scheme_rt_overflow, mark_overflow);
GC_REG_TRAV(scheme_rt_overflow_jmp, mark_overflow_jmp);
GC_REG_TRAV(scheme_rt_meta_cont, meta_cont_proc);
GC_REG_TRAV(scheme_escaping_cont_type, escaping_cont_proc);
GC_REG_TRAV(scheme_rt_cont_jmp, cont_jmp_proc);
GC_REG_TRAV(scheme_char_type, small_atomic_obj);
GC_REG_TRAV(scheme_integer_type, bad_trav);
GC_REG_TRAV(scheme_bignum_type, bignum_obj);
GC_REG_TRAV(scheme_rational_type, rational_obj);
GC_REG_TRAV(scheme_float_type, float_obj);
GC_REG_TRAV(scheme_double_type, double_obj);
GC_REG_TRAV(scheme_long_double_type, long_double_obj);
GC_REG_TRAV(scheme_complex_type, complex_obj);
GC_REG_TRAV(scheme_char_string_type, string_obj);
GC_REG_TRAV(scheme_byte_string_type, bstring_obj);
GC_REG_TRAV(scheme_unix_path_type, bstring_obj);
GC_REG_TRAV(scheme_windows_path_type, bstring_obj);
GC_REG_TRAV(scheme_symbol_type, symbol_obj);
#ifdef MZ_USE_PLACES
GC_REG_TRAV(scheme_serialized_symbol_type, bstring_obj);
GC_REG_TRAV(scheme_serialized_keyword_type, bstring_obj);
GC_REG_TRAV(scheme_place_dead_type, small_object);
#endif
GC_REG_TRAV(scheme_keyword_type, symbol_obj);
GC_REG_TRAV(scheme_null_type, small_atomic_obj);
GC_REG_TRAV(scheme_pair_type, cons_cell);
GC_REG_TRAV(scheme_mutable_pair_type, cons_cell);
GC_REG_TRAV(scheme_raw_pair_type, cons_cell);
GC_REG_TRAV(scheme_vector_type, vector_obj);
GC_REG_TRAV(scheme_flvector_type, flvector_obj);
#ifdef MZ_LONG_DOUBLE
GC_REG_TRAV(scheme_extflvector_type, extflvector_obj);
#endif
GC_REG_TRAV(scheme_fxvector_type, fxvector_obj);
GC_REG_TRAV(scheme_cpointer_type, cpointer_obj);
GC_REG_TRAV(scheme_bucket_type, bucket_obj);
GC_REG_TRAV(scheme_input_port_type, input_port);
GC_REG_TRAV(scheme_output_port_type, output_port);
GC_REG_TRAV(scheme_eof_type, small_atomic_obj);
GC_REG_TRAV(scheme_true_type, small_atomic_obj);
GC_REG_TRAV(scheme_false_type, small_atomic_obj);
GC_REG_TRAV(scheme_void_type, small_atomic_obj);
GC_REG_TRAV(scheme_box_type, small_object);
GC_REG_TRAV(scheme_thread_type, thread_val);
GC_REG_TRAV(scheme_prompt_type, prompt_val);
GC_REG_TRAV(scheme_prompt_tag_type, cons_cell);
GC_REG_TRAV(scheme_continuation_mark_key_type, small_object);
GC_REG_TRAV(scheme_cont_mark_set_type, cont_mark_set_val);
GC_REG_TRAV(scheme_sema_type, sema_val);
GC_REG_TRAV(scheme_channel_type, channel_val);
GC_REG_TRAV(scheme_channel_put_type, channel_put_val);
GC_REG_TRAV(scheme_semaphore_repost_type, small_object);
GC_REG_TRAV(scheme_thread_suspend_type, twoptr_obj);
GC_REG_TRAV(scheme_thread_resume_type, twoptr_obj);
GC_REG_TRAV(scheme_thread_dead_type, small_object);
GC_REG_TRAV(scheme_hash_table_type, hash_table_val);
GC_REG_TRAV(scheme_bucket_table_type, bucket_table_val);
GC_REG_TRAV(scheme_env_type, env_val);
GC_REG_TRAV(scheme_startup_env_type, startup_env_val);
GC_REG_TRAV(scheme_random_state_type, random_state_val);
GC_REG_TRAV(scheme_eval_waiting_type, bad_trav);
GC_REG_TRAV(scheme_tail_call_waiting_type, bad_trav);
GC_REG_TRAV(scheme_undefined_type, small_atomic_obj);
GC_REG_TRAV(scheme_placeholder_type, small_object);
GC_REG_TRAV(scheme_table_placeholder_type, iptr_obj);
GC_REG_TRAV(scheme_svector_type, svector_val);
GC_REG_TRAV(scheme_stx_type, stx_val);
GC_REG_TRAV(scheme_security_guard_type, guard_val);
GC_REG_TRAV(scheme_nack_evt_type, twoptr_obj);
GC_REG_TRAV(scheme_always_evt_type, small_atomic_obj);
GC_REG_TRAV(scheme_never_evt_type, small_atomic_obj);
GC_REG_TRAV(scheme_thread_recv_evt_type, small_atomic_obj);
GC_REG_TRAV(scheme_port_closed_evt_type, small_object);
GC_REG_TRAV(scheme_inspector_type, mark_inspector);
GC_REG_TRAV(scheme_rt_buf_holder, buf_holder);
GC_REG_TRAV(scheme_rt_pipe, mark_pipe);
GC_REG_TRAV(scheme_tcp_accept_evt_type, twoptr_obj);
GC_REG_TRAV(scheme_progress_evt_type, twoptr_obj);
GC_REG_TRAV(scheme_will_be_lambda_type, iptr_obj);
GC_REG_TRAV(scheme_thread_cell_values_type, small_object);
GC_REG_TRAV(scheme_global_ref_type, twoptr_obj);
GC_REG_TRAV(scheme_delay_syntax_type, small_object);
GC_REG_TRAV(scheme_logger_type, mark_logger);
GC_REG_TRAV(scheme_log_reader_type, mark_log_reader);
GC_REG_TRAV(scheme_rt_runstack, runstack_val);
GC_REG_TRAV(scheme_noninline_proc_type, small_object);
GC_REG_TRAV(scheme_proc_shape_type, small_atomic_obj);
GC_REG_TRAV(scheme_struct_proc_shape_type, struct_proc_shape);
GC_REG_TRAV(scheme_struct_prop_proc_shape_type, small_atomic_obj);
GC_REG_TRAV(scheme_environment_variables_type, small_object);
GC_REG_TRAV(scheme_plumber_handle_type, twoptr_obj);
GC_REG_TRAV(scheme_unquoted_printing_string_type, small_object);
}
static void add_finalizer(void *v, void (*f)(void*,void*), void *data,
int prim, int ext,
void (**ext_oldf)(void *p, void *data),
void **ext_olddata,
int no_dup, int rmve)
{
finalizer_function oldf;
void *olddata;
Finalizations *fns, **fns_ptr, *prealloced;
Finalization *fn;
if (!traversers_registered) {
#ifdef MZ_PRECISE_GC
GC_REG_TRAV(scheme_rt_finalization, mark_finalization);
GC_REG_TRAV(scheme_rt_finalizations, mark_finalizations);
traversers_registered = 1;
#endif
REGISTER_SO(save_fns_ptr);
}
#ifndef MZ_PRECISE_GC
if (v != GC_base(v))
return;
#endif
/* Allocate everything first so that we're not changing
finalizations when finalizations could run: */
if (save_fns_ptr) {
fns_ptr = save_fns_ptr;
save_fns_ptr = NULL;
} else
fns_ptr = MALLOC_ONE(Finalizations*);
if (!ext && !rmve) {
fn = MALLOC_ONE_RT(Finalization);
#ifdef MZTAG_REQUIRED
fn->type = scheme_rt_finalization;
#endif
fn->f = f;
fn->data = data;
} else
fn = NULL;
if (!rmve) {
prealloced = MALLOC_ONE_RT(Finalizations); /* may not need this... */
#ifdef MZTAG_REQUIRED
prealloced->type = scheme_rt_finalizations;
#endif
} else
prealloced = NULL;
GC_register_eager_finalizer(v, prim ? 2 : 1, do_next_finalization, fns_ptr, &oldf, &olddata);
if (oldf) {
if (oldf != do_next_finalization) {
/* This happens if an extenal use of GC_ routines conflicts with us. */
scheme_warning("warning: non-MzScheme finalization on object dropped!");
} else {
*fns_ptr = *(Finalizations **)olddata;
save_fns_ptr = (Finalizations **)olddata;
*save_fns_ptr = NULL;
}
} else if (rmve) {
GC_register_finalizer(v, NULL, NULL, NULL, NULL);
save_fns_ptr = fns_ptr;
return;
}
if (!(*fns_ptr)) {
prealloced->lifetime = current_lifetime;
*fns_ptr = prealloced;
}
fns = *fns_ptr;
if (ext) {
if (ext_oldf)
*ext_oldf = fns->ext_f;
fns->ext_f = f;
if (ext_olddata)
*ext_olddata = fns->ext_data;
fns->ext_data = data;
if (!f && !fns->prim_first && !fns->scheme_first) {
/* Removed all finalization */
GC_register_finalizer(v, NULL, NULL, NULL, NULL);
save_fns_ptr = fns_ptr;
*save_fns_ptr = NULL;
}
} else {
if (prim) {
if (no_dup) {
/* Make sure it's not already here */
Finalization *fnx;
for (fnx = fns->prim_first; fnx; fnx = fnx->next) {
if (fnx->f == f && fnx->data == data) {
if (rmve) {
if (fnx->prev)
fnx->prev->next = fnx->next;
else
fns->prim_first = fnx->next;
if (fnx->next)
fnx->next->prev = fnx->prev;
else
fns->prim_last = fnx->prev;
}
fn = NULL;
break;
}
}
}
if (fn) {
fn->next = fns->prim_first;
fns->prim_first = fn;
if (!fn->next)
fns->prim_last = fn;
else
fn->next->prev = fn;
}
/* Removed all finalization? */
if (!fns->ext_f && !fns->prim_first && !fns->scheme_first) {
GC_register_finalizer(v, NULL, NULL, NULL, NULL);
save_fns_ptr = fns_ptr;
*save_fns_ptr = NULL;
}
} else {
fn->next = fns->scheme_first;
fns->scheme_first = fn;
if (!fn->next)
fns->scheme_last = fn;
else
fn->next->prev = fn;
}
}
}
static void register_traversers(void)
{
GC_REG_TRAV(scheme_place_type, place_val);
GC_REG_TRAV(scheme_place_async_channel_type, place_async_channel_val);
GC_REG_TRAV(scheme_place_bi_channel_type, place_bi_channel_val);
}
