-/* Copyright (C) 1995,1996 Free Software Foundation, Inc.
+/* Copyright (C) 1995, 1996, 1997, 1998 Free Software Foundation, Inc.
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
/* scm_mtrigger
* is the number of bytes of must_malloc allocation needed to trigger gc.
*/
-long scm_mtrigger;
+unsigned long scm_mtrigger;
/* scm_gc_heap_lock
SCM_THREAD_CRITICAL_SECTION_START;
#endif
- // fprintf (stderr, "gc: %s\n", what);
+ /* fprintf (stderr, "gc: %s\n", what); */
scm_gc_start (what);
if (!scm_stack_base || scm_block_gc)
#endif
case scm_tc7_string:
- case scm_tc7_mb_string:
SCM_SETGC8MARK (ptr);
break;
case scm_tc7_substring:
- case scm_tc7_mb_substring:
if (SCM_GC8MARKP(ptr))
break;
SCM_SETGC8MARK (ptr);
sizeof (SCM *) * (scm_weak_size *= 2)));
if (scm_weak_vectors == NULL)
{
- scm_gen_puts (scm_regular_string,
- "weak vector table",
- scm_cur_errp);
- scm_gen_puts (scm_regular_string,
- "\nFATAL ERROR DURING CRITICAL SCM_CODE SECTION\n",
- scm_cur_errp);
+ scm_puts ("weak vector table", scm_cur_errp);
+ scm_puts ("\nFATAL ERROR DURING CRITICAL SCM_CODE SECTION\n",
+ scm_cur_errp);
exit(SCM_EXIT_FAILURE);
}
}
goto def;
if (SCM_GC8MARKP (ptr))
break;
+ SCM_SETGC8MARK (ptr);
if (SCM_PTAB_ENTRY(ptr))
scm_gc_mark (SCM_PTAB_ENTRY(ptr)->file_name);
- ptr = (scm_ptobs[i].mark) (ptr);
- goto gc_mark_loop;
+ if (scm_ptobs[i].mark)
+ {
+ ptr = (scm_ptobs[i].mark) (ptr);
+ goto gc_mark_loop;
+ }
+ else
+ return;
break;
case scm_tc7_smob:
if (SCM_GC8MARKP (ptr))
break;
- switch SCM_TYP16 (ptr)
+ SCM_SETGC8MARK (ptr);
+ switch SCM_GCTYP16 (ptr)
{ /* should be faster than going through scm_smobs */
case scm_tc_free_cell:
/* printf("found free_cell %X ", ptr); fflush(stdout); */
- SCM_SETGC8MARK (ptr);
SCM_SETCDR (ptr, SCM_EOL);
break;
case scm_tcs_bignums:
case scm_tc16_flo:
- SCM_SETGC8MARK (ptr);
break;
default:
i = SCM_SMOBNUM (ptr);
if (!(i < scm_numsmob))
goto def;
- ptr = (scm_smobs[i].mark) (ptr);
- goto gc_mark_loop;
+ if (scm_smobs[i].mark)
+ {
+ ptr = (scm_smobs[i].mark) (ptr);
+ goto gc_mark_loop;
+ }
+ else
+ return;
}
break;
default:
#endif
register SCM nfreelist;
register SCM *hp_freelist;
- register long n;
register long m;
- register scm_sizet j;
register int span;
- scm_sizet i;
+ long i;
scm_sizet seg_size;
- n = 0;
m = 0;
/* Reset all free list pointers. We'll reconstruct them completely
for (i = 0; i < scm_n_heap_segs; i++)
{
+ register scm_sizet n = 0;
+ register scm_sizet j;
+
/* Unmarked cells go onto the front of the freelist this heap
segment points to. Rather than updating the real freelist
pointer as we go along, we accumulate the new head in
m += SCM_HUGE_LENGTH (scmptr) * 2 * sizeof (double);
goto freechars;
case scm_tc7_substring:
- case scm_tc7_mb_substring:
if (SCM_GC8MARKP (scmptr))
goto c8mrkcontinue;
break;
case scm_tc7_string:
- case scm_tc7_mb_string:
if (SCM_GC8MARKP (scmptr))
goto c8mrkcontinue;
m += SCM_HUGE_LENGTH (scmptr) + 1;
/* Yes, I really do mean scm_ptobs[k].free */
/* rather than ftobs[k].close. .close */
/* is for explicit CLOSE-PORT by user */
- (scm_ptobs[k].free) (SCM_STREAM (scmptr));
+ (scm_ptobs[k].free) (scmptr);
SCM_SETSTREAM (scmptr, 0);
scm_remove_from_port_table (scmptr);
scm_gc_ports_collected++;
if (SCM_CAR (scmptr) == (SCM) scm_tc_free_cell)
exit (2);
#endif
- /* Stick the new cell on the front of nfreelist. */
+ /* Stick the new cell on the front of nfreelist. It's
+ critical that we mark this cell as freed; otherwise, the
+ conservative collector might trace it as some other type
+ of object. */
SCM_SETCAR (scmptr, (SCM) scm_tc_free_cell);
SCM_SETCDR (scmptr, nfreelist);
nfreelist = scmptr;
#ifdef GC_FREE_SEGMENTS
if (n == seg_size)
{
+ register long j;
+
scm_heap_size -= seg_size;
free ((char *) scm_heap_table[i].bounds[0]);
scm_heap_table[i].bounds[0] = 0;
#endif
scm_gc_cells_collected += n;
- n = 0;
}
/* Scan weak vectors. */
{
{
if (!SCM_IS_WHVEC_ANY (scm_weak_vectors[i]))
{
+ register long j, n;
+
ptr = SCM_VELTS (scm_weak_vectors[i]);
n = SCM_LENGTH (scm_weak_vectors[i]);
for (j = 0; j < n; ++j)
}
else /* if (SCM_IS_WHVEC_ANY (scm_weak_vectors[i])) */
{
- SCM obj;
- obj = scm_weak_vectors[i];
+ SCM obj = scm_weak_vectors[i];
+ register long n = SCM_LENGTH (scm_weak_vectors[i]);
+ register long j;
+
ptr = SCM_VELTS (scm_weak_vectors[i]);
- n = SCM_LENGTH (scm_weak_vectors[i]);
+
for (j = 0; j < n; ++j)
{
SCM * fixup;
*/
char *
scm_must_malloc (len, what)
- long len;
+ scm_sizet len;
char *what;
{
char *ptr;
scm_sizet size = len;
- long nm = scm_mallocated + size;
+ unsigned long nm = scm_mallocated + size;
if (len != size)
malerr:
scm_wta (SCM_MAKINUM (len), (char *) SCM_NALLOC, what);
* is similar to scm_must_malloc.
*/
char *
-scm_must_realloc (where, olen, len, what)
- char *where;
- long olen;
- long len;
- char *what;
+scm_must_realloc (char *where,
+ scm_sizet olen,
+ scm_sizet len,
+ char *what)
{
char *ptr;
scm_sizet size = len;
- long nm = scm_mallocated + size - olen;
+ scm_sizet nm = scm_mallocated + size - olen;
if (len != size)
ralerr:
scm_wta (SCM_MAKINUM (len), (char *) SCM_NALLOC, what);
/* scm_heap_size
* is the total number of cells in heap segments.
*/
-long scm_heap_size = 0;
+unsigned long scm_heap_size = 0;
/* init_heap_seg
* initializes a new heap segment and return the number of objects it contains.
#define scmptr ptr
#endif
SCM_CELLPTR seg_end;
- scm_sizet new_seg_index;
- scm_sizet n_new_objects;
+ int new_seg_index;
+ int n_new_objects;
if (seg_org == NULL)
return 0;
{}
-#ifdef __STDC__
SCM
scm_return_first (SCM elt, ...)
-#else
-SCM
-scm_return_first (elt, va_alist)
- SCM elt;
- va_dcl
-#endif
{
return elt;
}
even if all other references are dropped, until someone applies
scm_unprotect_object to it. This function returns OBJ.
- Note that calls to scm_protect_object do not nest. You can call
- scm_protect_object any number of times on a given object, and the
- next call to scm_unprotect_object will unprotect it completely.
-
- Basically, scm_protect_object and scm_unprotect_object just
- maintain a list of references to things. Since the GC knows about
- this list, all objects it mentions stay alive. scm_protect_object
- adds its argument to the list; scm_unprotect_object remove its
- argument from the list. */
+ Calls to scm_protect_object nest. For every object O, there is a
+ counter which scm_protect_object(O) increments and
+ scm_unprotect_object(O) decrements, if it is greater than zero. If
+ an object's counter is greater than zero, the garbage collector
+ will not free it.
+
+ Of course, that's not how it's implemented. scm_protect_object and
+ scm_unprotect_object just maintain a list of references to things.
+ Since the GC knows about this list, all objects it mentions stay
+ alive. scm_protect_object adds its argument to the list;
+ scm_unprotect_object removes the first occurrence of its argument
+ to the list. */
SCM
scm_protect_object (obj)
SCM obj;
{
- /* This function really should use address hashing tables, but I
- don't know how to use them yet. For now we just use a list. */
scm_protects = scm_cons (obj, scm_protects);
return obj;
/* Remove any protection for OBJ established by a prior call to
- scm_protect_obj. This function returns OBJ.
+ scm_protect_object. This function returns OBJ.
- See scm_protect_obj for more information. */
+ See scm_protect_object for more information. */
SCM
scm_unprotect_object (obj)
SCM obj;
{
- scm_protects = scm_delq_x (obj, scm_protects);
+ SCM *tail_ptr = &scm_protects;
+
+ while (SCM_NIMP (*tail_ptr) && SCM_CONSP (*tail_ptr))
+ if (SCM_CAR (*tail_ptr) == obj)
+ {
+ *tail_ptr = SCM_CDR (*tail_ptr);
+ break;
+ }
+ else
+ tail_ptr = SCM_CDRLOC (*tail_ptr);
return obj;
}
\f
int
-scm_init_storage (init_heap_size)
- long init_heap_size;
+scm_init_storage (scm_sizet init_heap_size)
{
scm_sizet j;
scm_listofnull = scm_cons (SCM_EOL, SCM_EOL);
scm_nullstr = scm_makstr (0L, 0);
- scm_nullvect = scm_make_vector (SCM_INUM0, SCM_UNDEFINED, SCM_UNDEFINED);
- scm_symhash = scm_make_vector ((SCM) SCM_MAKINUM (scm_symhash_dim), SCM_EOL, SCM_UNDEFINED);
+ scm_nullvect = scm_make_vector (SCM_INUM0, SCM_UNDEFINED);
+ scm_symhash = scm_make_vector ((SCM) SCM_MAKINUM (scm_symhash_dim), SCM_EOL);
scm_weak_symhash = scm_make_weak_key_hash_table ((SCM) SCM_MAKINUM (scm_symhash_dim));
- scm_symhash_vars = scm_make_vector ((SCM) SCM_MAKINUM (scm_symhash_dim), SCM_EOL, SCM_UNDEFINED);
+ scm_symhash_vars = scm_make_vector ((SCM) SCM_MAKINUM (scm_symhash_dim), SCM_EOL);
scm_stand_in_procs = SCM_EOL;
scm_permobjs = SCM_EOL;
scm_protects = SCM_EOL;
HCoop / bpt / guile.git / blobdiff