{
new = scm_freelist;
scm_freelist = SCM_FREE_CELL_CDR (scm_freelist);
- SCM_SET_FREE_CELL_TYPE (new, scm_tc16_allocated);
}
return new;
{
new = scm_freelist2;
scm_freelist2 = SCM_FREE_CELL_CDR (scm_freelist2);
- SCM_SET_FREE_CELL_TYPE (new, scm_tc16_allocated);
}
return new;
--scm_ints_disabled;
*freelist = SCM_FREE_CELL_CDR (cell);
- SCM_SET_FREE_CELL_TYPE (cell, scm_tc16_allocated);
return cell;
}
int bound;
SCM * elts;
elts = SCM_VELTS (scm_continuation_stack);
- bound = SCM_LENGTH (scm_continuation_stack);
+ bound = SCM_VECTOR_LENGTH (scm_continuation_stack);
x = SCM_INUM (scm_continuation_stack_ptr);
while (x < bound)
{
#ifndef USE_THREADS
- /* Protect from the C stack. This must be the first marking
- * done because it provides information about what objects
- * are "in-use" by the C code. "in-use" objects are those
- * for which the values from SCM_LENGTH and SCM_CHARS must remain
- * usable. This requirement is stricter than a liveness
- * requirement -- in particular, it constrains the implementation
- * of scm_vector_set_length_x.
- */
+ /* Mark objects on the C stack. */
SCM_FLUSH_REGISTER_WINDOWS;
/* This assumes that all registers are saved into the jmp_buf */
setjmp (scm_save_regs_gc_mark);
#endif /* USE_THREADS */
- /* FIXME: insert a phase to un-protect string-data preserved
- * in scm_vector_set_length_x.
- */
-
j = SCM_NUM_PROTECTS;
while (j--)
scm_gc_mark (scm_sys_protects[j]);
{
/* ptr is a struct */
SCM layout = SCM_PACK (vtable_data [scm_vtable_index_layout]);
- int len = SCM_LENGTH (layout);
- char * fields_desc = SCM_CHARS (layout);
+ int len = SCM_SYMBOL_LENGTH (layout);
+ char * fields_desc = SCM_SYMBOL_CHARS (layout);
scm_bits_t * struct_data = (scm_bits_t *) SCM_STRUCT_DATA (ptr);
if (vtable_data[scm_struct_i_flags] & SCM_STRUCTF_ENTITY)
ptr = SCM_CDR (ptr);
goto gc_mark_nimp;
case scm_tc7_vector:
- case scm_tc7_lvector:
-#ifdef CCLO
- case scm_tc7_cclo:
-#endif
- i = SCM_LENGTH (ptr);
+ i = SCM_VECTOR_LENGTH (ptr);
if (i == 0)
break;
while (--i > 0)
scm_gc_mark (SCM_VELTS (ptr)[i]);
ptr = SCM_VELTS (ptr)[0];
goto gc_mark_loop;
- case scm_tc7_contin:
- if (SCM_VELTS (ptr))
- scm_mark_locations (SCM_VELTS_AS_STACKITEMS (ptr),
- (scm_sizet)
- (SCM_LENGTH (ptr) +
- (sizeof (SCM_STACKITEM) + -1 +
- sizeof (scm_contregs)) /
- sizeof (SCM_STACKITEM)));
- break;
+#ifdef CCLO
+ case scm_tc7_cclo:
+ {
+ unsigned long int i = SCM_CCLO_LENGTH (ptr);
+ unsigned long int j;
+ for (j = 1; j != i; ++j)
+ {
+ SCM obj = SCM_CCLO_REF (ptr, j);
+ if (!SCM_IMP (obj))
+ scm_gc_mark (obj);
+ }
+ ptr = SCM_CCLO_REF (ptr, 0);
+ goto gc_mark_loop;
+ }
+#endif
#ifdef HAVE_ARRAYS
case scm_tc7_bvect:
case scm_tc7_byvect:
int weak_keys;
int weak_values;
- len = SCM_LENGTH (ptr);
+ len = SCM_VECTOR_LENGTH (ptr);
weak_keys = SCM_IS_WHVEC (ptr) || SCM_IS_WHVEC_B (ptr);
weak_values = SCM_IS_WHVEC_V (ptr) || SCM_IS_WHVEC_B (ptr);
}
break;
- case scm_tc7_msymbol:
- scm_gc_mark (SCM_SYMBOL_FUNC (ptr));
- ptr = SCM_SYMBOL_PROPS (ptr);
+ case scm_tc7_symbol:
+ ptr = SCM_PROP_SLOTS (ptr);
goto gc_mark_loop;
- case scm_tc7_ssymbol:
case scm_tcs_subrs:
break;
case scm_tc7_port:
if (!(i < scm_numptob))
goto def;
if (SCM_PTAB_ENTRY(ptr))
- scm_gc_mark (SCM_PTAB_ENTRY(ptr)->file_name);
+ scm_gc_mark (SCM_FILENAME (ptr));
if (scm_ptobs[i].mark)
{
ptr = (scm_ptobs[i].mark) (ptr);
{ /* should be faster than going through scm_smobs */
case scm_tc_free_cell:
/* printf("found free_cell %X ", ptr); fflush(stdout); */
- case scm_tc16_allocated:
case scm_tc16_big:
case scm_tc16_real:
case scm_tc16_complex:
if (scm_heap_table[seg_id].span == 1
|| SCM_DOUBLE_CELLP (obj))
- {
- if (!SCM_FREE_CELL_P (obj))
- scm_gc_mark (obj);
- }
+ scm_gc_mark (obj);
+
break;
}
}
case scm_tc7_pws:
break;
case scm_tc7_wvect:
- m += (2 + SCM_LENGTH (scmptr)) * sizeof (SCM);
- scm_must_free ((char *)(SCM_VELTS (scmptr) - 2));
+ m += (2 + SCM_VECTOR_LENGTH (scmptr)) * sizeof (SCM);
+ scm_must_free (SCM_VECTOR_BASE (scmptr) - 2);
break;
case scm_tc7_vector:
- case scm_tc7_lvector:
+ {
+ unsigned long int length = SCM_VECTOR_LENGTH (scmptr);
+ if (length > 0)
+ {
+ m += length * sizeof (scm_bits_t);
+ scm_must_free (SCM_VECTOR_BASE (scmptr));
+ }
+ break;
+ }
#ifdef CCLO
case scm_tc7_cclo:
-#endif
- m += (SCM_LENGTH (scmptr) * sizeof (SCM));
- freechars:
- scm_must_free (SCM_CHARS (scmptr));
- /* SCM_SETCHARS(scmptr, 0);*/
+ m += (SCM_CCLO_LENGTH (scmptr) * sizeof (SCM));
+ scm_must_free (SCM_CCLO_BASE (scmptr));
break;
+#endif
#ifdef HAVE_ARRAYS
case scm_tc7_bvect:
- m += sizeof (long) * ((SCM_HUGE_LENGTH (scmptr) + SCM_LONG_BIT - 1) / SCM_LONG_BIT);
- goto freechars;
+ {
+ unsigned long int length = SCM_BITVECTOR_LENGTH (scmptr);
+ if (length > 0)
+ {
+ m += sizeof (long) * ((length + SCM_LONG_BIT - 1) / SCM_LONG_BIT);
+ scm_must_free (SCM_BITVECTOR_BASE (scmptr));
+ }
+ }
+ break;
case scm_tc7_byvect:
- m += SCM_HUGE_LENGTH (scmptr) * sizeof (char);
- goto freechars;
case scm_tc7_ivect:
case scm_tc7_uvect:
- m += SCM_HUGE_LENGTH (scmptr) * sizeof (long);
- goto freechars;
case scm_tc7_svect:
- m += SCM_HUGE_LENGTH (scmptr) * sizeof (short);
- goto freechars;
#ifdef HAVE_LONG_LONGS
case scm_tc7_llvect:
- m += SCM_HUGE_LENGTH (scmptr) * sizeof (long_long);
- goto freechars;
#endif
case scm_tc7_fvect:
- m += SCM_HUGE_LENGTH (scmptr) * sizeof (float);
- goto freechars;
case scm_tc7_dvect:
- m += SCM_HUGE_LENGTH (scmptr) * sizeof (double);
- goto freechars;
case scm_tc7_cvect:
- m += SCM_HUGE_LENGTH (scmptr) * 2 * sizeof (double);
- goto freechars;
+ m += SCM_UVECTOR_LENGTH (scmptr) * scm_uniform_element_size (scmptr);
+ scm_must_free (SCM_UVECTOR_BASE (scmptr));
+ break;
#endif
case scm_tc7_substring:
break;
case scm_tc7_string:
- m += SCM_HUGE_LENGTH (scmptr) + 1;
- goto freechars;
- case scm_tc7_msymbol:
- m += (SCM_LENGTH (scmptr) + 1
- + (SCM_CHARS (scmptr) - (char *) SCM_SLOTS (scmptr)));
- scm_must_free ((char *)SCM_SLOTS (scmptr));
+ m += SCM_STRING_LENGTH (scmptr) + 1;
+ scm_must_free (SCM_STRING_CHARS (scmptr));
break;
- case scm_tc7_contin:
- m += SCM_LENGTH (scmptr) * sizeof (SCM_STACKITEM) + sizeof (scm_contregs);
- if (SCM_VELTS (scmptr))
- goto freechars;
- case scm_tc7_ssymbol:
+ case scm_tc7_symbol:
+ m += SCM_SYMBOL_LENGTH (scmptr) + 1;
+ scm_must_free (SCM_SYMBOL_CHARS (scmptr));
break;
case scm_tcs_subrs:
/* the various "subrs" (primitives) are never freed */
#ifdef SCM_BIGDIG
case scm_tc16_big:
m += (SCM_NUMDIGS (scmptr) * SCM_BITSPERDIG / SCM_CHAR_BIT);
- goto freechars;
+ scm_must_free (SCM_BDIGITS (scmptr));
+ break;
#endif /* def SCM_BIGDIG */
case scm_tc16_complex:
- m += 2 * sizeof (double);
- goto freechars;
+ m += sizeof (scm_complex_t);
+ scm_must_free (SCM_COMPLEX_MEM (scmptr));
+ break;
default:
{
int k;
void
scm_remember (SCM *ptr)
-{ /* empty */ }
+{
+ /* empty */
+}
/*
scm_listofnull = scm_cons (SCM_EOL, SCM_EOL);
scm_nullstr = scm_makstr (0L, 0);
scm_nullvect = scm_make_vector (SCM_INUM0, SCM_UNDEFINED);
- scm_symhash = scm_make_vector (SCM_MAKINUM (scm_symhash_dim), SCM_EOL);
- scm_weak_symhash = scm_make_weak_key_hash_table (SCM_MAKINUM (scm_symhash_dim));
- scm_symhash_vars = scm_make_vector (SCM_MAKINUM (scm_symhash_dim), SCM_EOL);
+
+#define DEFAULT_SYMHASH_SIZE 277
+ scm_symhash = scm_make_vector (SCM_MAKINUM (DEFAULT_SYMHASH_SIZE), SCM_EOL);
+ scm_weak_symhash = scm_make_weak_key_hash_table (SCM_MAKINUM (DEFAULT_SYMHASH_SIZE));
+ scm_symhash_vars = scm_make_vector (SCM_MAKINUM (DEFAULT_SYMHASH_SIZE), SCM_EOL);
+
scm_stand_in_procs = SCM_EOL;
scm_permobjs = SCM_EOL;
scm_protects = scm_make_vector (SCM_MAKINUM (31), SCM_EOL);
#if (SCM_DEBUG_DEPRECATED == 0)
scm_gc_vcell = scm_sysintern ("gc-thunk", SCM_BOOL_F);
#endif /* SCM_DEBUG_DEPRECATED == 0 */
- /* Dirk:FIXME:: We don't really want a binding here. */
- after_gc_thunk = scm_make_gsubr ("%gc-thunk", 0, 0, 0, gc_async_thunk);
- gc_async = scm_system_async (after_gc_thunk);
+ after_gc_thunk = scm_make_subr_opt ("%gc-thunk", scm_tc7_subr_0, gc_async_thunk, 0);
+ gc_async = scm_system_async (after_gc_thunk); /* protected via scm_asyncs */
scm_c_hook_add (&scm_after_gc_c_hook, mark_gc_async, NULL, 0);
+#ifndef SCM_MAGIC_SNARFER
#include "libguile/gc.x"
+#endif
}
/*
HCoop / bpt / guile.git / blobdiff