1477 |
static scm_t_bits **hell; |
static scm_t_bits **hell; |
1478 |
static long n_hell = 1; /* one place for the evil one himself */ |
static long n_hell = 1; /* one place for the evil one himself */ |
1479 |
static long hell_size = 4; |
static long hell_size = 4; |
|
#ifdef USE_THREADS |
|
1480 |
static SCM hell_mutex; |
static SCM hell_mutex; |
|
#endif |
|
1481 |
|
|
1482 |
static long |
static long |
1483 |
burnin (SCM o) |
burnin (SCM o) |
1493 |
go_to_hell (void *o) |
go_to_hell (void *o) |
1494 |
{ |
{ |
1495 |
SCM obj = SCM_PACK ((scm_t_bits) o); |
SCM obj = SCM_PACK ((scm_t_bits) o); |
|
#ifdef USE_THREADS |
|
1496 |
scm_lock_mutex (hell_mutex); |
scm_lock_mutex (hell_mutex); |
|
#endif |
|
1497 |
if (n_hell == hell_size) |
if (n_hell == hell_size) |
1498 |
{ |
{ |
1499 |
long new_size = 2 * hell_size; |
long new_size = 2 * hell_size; |
1501 |
hell_size = new_size; |
hell_size = new_size; |
1502 |
} |
} |
1503 |
hell[n_hell++] = SCM_STRUCT_DATA (obj); |
hell[n_hell++] = SCM_STRUCT_DATA (obj); |
|
#ifdef USE_THREADS |
|
1504 |
scm_unlock_mutex (hell_mutex); |
scm_unlock_mutex (hell_mutex); |
|
#endif |
|
1505 |
} |
} |
1506 |
|
|
1507 |
static void |
static void |
1508 |
go_to_heaven (void *o) |
go_to_heaven (void *o) |
1509 |
{ |
{ |
|
#ifdef USE_THREADS |
|
1510 |
scm_lock_mutex (hell_mutex); |
scm_lock_mutex (hell_mutex); |
|
#endif |
|
1511 |
hell[burnin (SCM_PACK ((scm_t_bits) o))] = hell[--n_hell]; |
hell[burnin (SCM_PACK ((scm_t_bits) o))] = hell[--n_hell]; |
|
#ifdef USE_THREADS |
|
1512 |
scm_unlock_mutex (hell_mutex); |
scm_unlock_mutex (hell_mutex); |
|
#endif |
|
1513 |
} |
} |
1514 |
|
|
1515 |
|
|
1945 |
#undef FUNC_NAME |
#undef FUNC_NAME |
1946 |
|
|
1947 |
|
|
|
#ifdef USE_THREADS |
|
1948 |
static void |
static void |
1949 |
lock_cache_mutex (void *m) |
lock_cache_mutex (void *m) |
1950 |
{ |
{ |
1958 |
SCM mutex = SCM_PACK ((scm_t_bits) m); |
SCM mutex = SCM_PACK ((scm_t_bits) m); |
1959 |
scm_unlock_mutex (mutex); |
scm_unlock_mutex (mutex); |
1960 |
} |
} |
|
#endif |
|
1961 |
|
|
1962 |
static SCM |
static SCM |
1963 |
call_memoize_method (void *a) |
call_memoize_method (void *a) |
1979 |
scm_memoize_method (SCM x, SCM args) |
scm_memoize_method (SCM x, SCM args) |
1980 |
{ |
{ |
1981 |
SCM gf = SCM_CAR (scm_last_pair (x)); |
SCM gf = SCM_CAR (scm_last_pair (x)); |
|
#ifdef USE_THREADS |
|
1982 |
return scm_internal_dynamic_wind ( |
return scm_internal_dynamic_wind ( |
1983 |
lock_cache_mutex, |
lock_cache_mutex, |
1984 |
call_memoize_method, |
call_memoize_method, |
1985 |
unlock_cache_mutex, |
unlock_cache_mutex, |
1986 |
(void *) SCM_UNPACK (scm_cons2 (gf, x, args)), |
(void *) SCM_UNPACK (scm_cons2 (gf, x, args)), |
1987 |
(void *) SCM_UNPACK (SCM_SLOT (gf, scm_si_cache_mutex))); |
(void *) SCM_UNPACK (SCM_SLOT (gf, scm_si_cache_mutex))); |
|
#else |
|
|
return call_memoize_method ((void *) SCM_UNPACK (scm_cons2 (gf, x, args))); |
|
|
#endif |
|
1988 |
} |
} |
1989 |
|
|
1990 |
/****************************************************************************** |
/****************************************************************************** |
2021 |
|
|
2022 |
if (class == scm_class_generic || class == scm_class_generic_with_setter) |
if (class == scm_class_generic || class == scm_class_generic_with_setter) |
2023 |
{ |
{ |
|
#ifdef USE_THREADS |
|
2024 |
z = scm_make_struct (class, SCM_INUM0, |
z = scm_make_struct (class, SCM_INUM0, |
2025 |
scm_list_4 (SCM_EOL, |
scm_list_4 (SCM_EOL, |
2026 |
SCM_INUM0, |
SCM_INUM0, |
2027 |
SCM_BOOL_F, |
SCM_BOOL_F, |
2028 |
scm_make_mutex ())); |
scm_make_mutex ())); |
|
#else |
|
|
z = scm_make_struct (class, SCM_INUM0, |
|
|
scm_list_3 (SCM_EOL, SCM_INUM0, SCM_BOOL_F)); |
|
|
#endif |
|
2029 |
scm_set_procedure_property_x (z, scm_sym_name, |
scm_set_procedure_property_x (z, scm_sym_name, |
2030 |
scm_get_keyword (k_name, |
scm_get_keyword (k_name, |
2031 |
args, |
args, |
2173 |
SCM amethod_slots = scm_list_1 (scm_list_3 (scm_str2symbol ("slot-definition"), |
SCM amethod_slots = scm_list_1 (scm_list_3 (scm_str2symbol ("slot-definition"), |
2174 |
k_init_keyword, |
k_init_keyword, |
2175 |
k_slot_definition)); |
k_slot_definition)); |
|
#ifdef USE_THREADS |
|
2176 |
SCM mutex_slot = scm_list_1 (scm_str2symbol ("make-mutex")); |
SCM mutex_slot = scm_list_1 (scm_str2symbol ("make-mutex")); |
|
#else |
|
|
SCM mutex_slot = SCM_BOOL_F; |
|
|
#endif |
|
2177 |
SCM gf_slots = scm_list_4 (scm_str2symbol ("methods"), |
SCM gf_slots = scm_list_4 (scm_str2symbol ("methods"), |
2178 |
scm_list_3 (scm_str2symbol ("n-specialized"), |
scm_list_3 (scm_str2symbol ("n-specialized"), |
2179 |
k_init_value, |
k_init_value, |
2670 |
list_of_no_method = scm_permanent_object (scm_list_1 (sym_no_method)); |
list_of_no_method = scm_permanent_object (scm_list_1 (sym_no_method)); |
2671 |
|
|
2672 |
hell = scm_malloc (hell_size); |
hell = scm_malloc (hell_size); |
|
#ifdef USE_THREADS |
|
2673 |
hell_mutex = scm_permanent_object (scm_make_mutex ()); |
hell_mutex = scm_permanent_object (scm_make_mutex ()); |
|
#endif |
|
2674 |
|
|
2675 |
create_basic_classes (); |
create_basic_classes (); |
2676 |
create_standard_classes (); |
create_standard_classes (); |