495 |
SCM_MISC_ERROR ("class object doesn't have enough fields: ~S", |
SCM_MISC_ERROR ("class object doesn't have enough fields: ~S", |
496 |
scm_list_1 (nfields)); |
scm_list_1 (nfields)); |
497 |
|
|
498 |
s = n > 0 ? scm_must_malloc (n, FUNC_NAME) : 0; |
s = n > 0 ? scm_malloc (n) : 0; |
499 |
for (i = 0; i < n; i += 2) |
for (i = 0; i < n; i += 2) |
500 |
{ |
{ |
501 |
long len; |
long len; |
544 |
} |
} |
545 |
SCM_SET_SLOT (class, scm_si_layout, scm_mem2symbol (s, n)); |
SCM_SET_SLOT (class, scm_si_layout, scm_mem2symbol (s, n)); |
546 |
if (s) |
if (s) |
547 |
scm_must_free (s); |
free (s); |
548 |
return SCM_UNSPECIFIED; |
return SCM_UNSPECIFIED; |
549 |
} |
} |
550 |
#undef FUNC_NAME |
#undef FUNC_NAME |
577 |
long n = SCM_INUM (SCM_SLOT (class, scm_si_nfields)); |
long n = SCM_INUM (SCM_SLOT (class, scm_si_nfields)); |
578 |
#if 0 |
#if 0 |
579 |
/* |
/* |
580 |
* We could avoid calling scm_must_malloc in the allocation code |
* We could avoid calling scm_gc_malloc in the allocation code |
581 |
* (in which case the following two lines are needed). Instead |
* (in which case the following two lines are needed). Instead |
582 |
* we make 0-slot instances non-light, so that the light case |
* we make 0-slot instances non-light, so that the light case |
583 |
* can be handled without special cases. |
* can be handled without special cases. |
1326 |
if (SCM_CLASS_FLAGS (class) & SCM_STRUCTF_LIGHT) |
if (SCM_CLASS_FLAGS (class) & SCM_STRUCTF_LIGHT) |
1327 |
{ |
{ |
1328 |
n = SCM_INUM (SCM_SLOT (class, scm_si_nfields)); |
n = SCM_INUM (SCM_SLOT (class, scm_si_nfields)); |
1329 |
m = (SCM *) scm_must_malloc (n * sizeof (SCM), "instance"); |
m = (SCM *) scm_gc_malloc (n * sizeof (SCM), "struct"); |
1330 |
return wrap_init (class, m, n); |
return wrap_init (class, m, n); |
1331 |
} |
} |
1332 |
|
|
1339 |
/* Entities */ |
/* Entities */ |
1340 |
if (SCM_CLASS_FLAGS (class) & SCM_CLASSF_ENTITY) |
if (SCM_CLASS_FLAGS (class) & SCM_CLASSF_ENTITY) |
1341 |
{ |
{ |
1342 |
m = (SCM *) scm_alloc_struct (n, |
m = (SCM *) scm_alloc_struct (n, scm_struct_entity_n_extra_words, |
1343 |
scm_struct_entity_n_extra_words, |
"entity struct"); |
|
"entity"); |
|
1344 |
m[scm_struct_i_setter] = SCM_BOOL_F; |
m[scm_struct_i_setter] = SCM_BOOL_F; |
1345 |
m[scm_struct_i_procedure] = SCM_BOOL_F; |
m[scm_struct_i_procedure] = SCM_BOOL_F; |
1346 |
/* Generic functions */ |
/* Generic functions */ |
1376 |
|
|
1377 |
/* Non-light instances */ |
/* Non-light instances */ |
1378 |
{ |
{ |
1379 |
m = (SCM *) scm_alloc_struct (n, |
m = (SCM *) scm_alloc_struct (n, scm_struct_n_extra_words, "heavy struct"); |
|
scm_struct_n_extra_words, |
|
|
"heavy instance"); |
|
1380 |
return wrap_init (class, m, n); |
return wrap_init (class, m, n); |
1381 |
} |
} |
1382 |
} |
} |
1501 |
if (n_hell == hell_size) |
if (n_hell == hell_size) |
1502 |
{ |
{ |
1503 |
long new_size = 2 * hell_size; |
long new_size = 2 * hell_size; |
1504 |
hell = scm_must_realloc (hell, hell_size, new_size, "hell"); |
hell = scm_realloc (hell, new_size); |
1505 |
hell_size = new_size; |
hell_size = new_size; |
1506 |
} |
} |
1507 |
hell[n_hell++] = SCM_STRUCT_DATA (obj); |
hell[n_hell++] = SCM_STRUCT_DATA (obj); |
2680 |
|
|
2681 |
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)); |
2682 |
|
|
2683 |
hell = scm_must_malloc (hell_size, "hell"); |
hell = scm_malloc (hell_size); |
2684 |
#ifdef USE_THREADS |
#ifdef USE_THREADS |
2685 |
scm_mutex_init (&hell_mutex); |
scm_mutex_init (&hell_mutex); |
2686 |
#endif |
#endif |