-/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001, 2002, 2003 Free Software Foundation, Inc.
+/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001, 2002, 2003, 2004 Free Software Foundation, Inc.
*
* This library is free software; you can redistribute it and/or
* modify it under the terms of the GNU Lesser General Public
*
* You should have received a copy of the GNU Lesser General Public
* License along with this library; if not, write to the Free Software
- * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
*/
#include "libguile/validate.h"
#include "libguile/deprecation.h"
#include "libguile/gc.h"
+#include "libguile/guardians.h"
#ifdef GUILE_DEBUG_MALLOC
#include "libguile/debug-malloc.h"
#include <unistd.h>
#endif
-#ifdef __ia64__
-# define SCM_MARK_BACKING_STORE() do { \
- ucontext_t ctx; \
- SCM_STACKITEM * top, * bot; \
- getcontext (&ctx); \
- scm_mark_locations ((SCM_STACKITEM *) &ctx.uc_mcontext, \
- ((size_t) (sizeof (SCM_STACKITEM) - 1 + sizeof ctx.uc_mcontext) \
- / sizeof (SCM_STACKITEM))); \
- bot = (SCM_STACKITEM *) __libc_ia64_register_backing_store_base; \
- top = (SCM_STACKITEM *) ctx.uc_mcontext.sc_ar_bsp; \
- scm_mark_locations (bot, top - bot); } while (0)
-#else
-# define SCM_MARK_BACKING_STORE()
-#endif
-
-
/*
Entry point for this file.
*/
scm_mark_all (void)
{
long j;
-
+
+ scm_i_init_weak_vectors_for_gc ();
+ scm_i_init_guardians_for_gc ();
scm_i_clear_mark_space ();
size_t i;
for (i = 0; i < SCM_HASHTABLE_N_BUCKETS (scm_gc_registered_roots); ++i)
{
- SCM l = SCM_HASHTABLE_BUCKETS (scm_gc_registered_roots)[i];
- for (; !SCM_NULLP (l); l = SCM_CDR (l))
+ SCM l = SCM_HASHTABLE_BUCKET (scm_gc_registered_roots, i);
+ for (; !scm_is_null (l); l = SCM_CDR (l))
{
SCM *p = (SCM *) (scm_to_ulong (SCM_CAAR (l)));
scm_gc_mark (*p);
}
}
+ scm_mark_subr_table ();
- /* FIXME: we should have a means to register C functions to be run
- * in different phases of GC
+ int loops = 0;
+ while (1)
+ {
+ loops++;
+ int again;
+
+ /* Mark the non-weak references of weak vectors. For a weak key
+ alist vector, this would mark the values for keys that are
+ marked. We need to do this in a loop until everything
+ settles down since the newly marked values might be keys in
+ other weak key alist vectors, for example.
+ */
+ again = scm_i_mark_weak_vectors_non_weaks ();
+ if (again)
+ continue;
+
+ /* Now we scan all marked guardians and move all unmarked objects
+ from the accessible to the inaccessible list.
+ */
+ scm_i_identify_inaccessible_guardeds ();
+
+ /* When we have identified all inaccessible objects, we can mark
+ them.
+ */
+ again = scm_i_mark_inaccessible_guardeds ();
+
+ /* This marking might have changed the situation for weak vectors
+ and might have turned up new guardians that need to be processed,
+ so we do it all over again.
+ */
+ if (again)
+ continue;
+
+ /* Nothing new marked in this round, we are done.
+ */
+ break;
+ }
+
+ /* fprintf (stderr, "%d loops\n", loops); */
+
+ /* Remove all unmarked entries from the weak vectors.
*/
- scm_mark_subr_table ();
+ scm_i_remove_weaks_from_weak_vectors ();
+
+ /* Bring hashtables upto date.
+ */
+ scm_i_scan_weak_hashtables ();
}
/* {Mark/Sweep}
*/
+
void
scm_gc_mark_dependencies (SCM p)
#define FUNC_NAME "scm_gc_mark_dependencies"
scm_t_bits word0 = SCM_CELL_WORD_0 (ptr) - scm_tc3_struct;
scm_t_bits * vtable_data = (scm_t_bits *) word0;
SCM layout = SCM_PACK (vtable_data [scm_vtable_index_layout]);
- long len = SCM_SYMBOL_LENGTH (layout);
- char * fields_desc = SCM_SYMBOL_CHARS (layout);
- scm_t_bits * struct_data = (scm_t_bits *) SCM_STRUCT_DATA (ptr);
+ long len = scm_i_symbol_length (layout);
+ const char *fields_desc = scm_i_symbol_chars (layout);
+ scm_t_bits *struct_data = (scm_t_bits *) SCM_STRUCT_DATA (ptr);
if (vtable_data[scm_struct_i_flags] & SCM_STRUCTF_ENTITY)
{
ptr = SCM_ENV (ptr);
goto gc_mark_nimp;
case scm_tc7_vector:
- i = SCM_VECTOR_LENGTH (ptr);
+ i = SCM_SIMPLE_VECTOR_LENGTH (ptr);
if (i == 0)
break;
while (--i > 0)
{
- if (SCM_NIMP (SCM_VELTS (ptr)[i]))
- scm_gc_mark (SCM_VELTS (ptr)[i]);
+ SCM elt = SCM_SIMPLE_VECTOR_REF (ptr, i);
+ if (SCM_NIMP (elt))
+ scm_gc_mark (elt);
}
- ptr = SCM_VELTS (ptr)[0];
+ ptr = SCM_SIMPLE_VECTOR_REF (ptr, 0);
goto gc_mark_loop;
#ifdef CCLO
case scm_tc7_cclo:
goto gc_mark_loop;
}
#endif
-#if SCM_HAVE_ARRAYS
- case scm_tc7_bvect:
- case scm_tc7_byvect:
- case scm_tc7_ivect:
- case scm_tc7_uvect:
- case scm_tc7_fvect:
- case scm_tc7_dvect:
- case scm_tc7_cvect:
- case scm_tc7_svect:
-#if SCM_SIZEOF_LONG_LONG != 0
- case scm_tc7_llvect:
-#endif
-#endif
+
case scm_tc7_string:
- break;
+ ptr = scm_i_string_mark (ptr);
+ goto gc_mark_loop;
+ case scm_tc7_stringbuf:
+ ptr = scm_i_stringbuf_mark (ptr);
+ goto gc_mark_loop;
case scm_tc7_number:
if (SCM_TYP16 (ptr) == scm_tc16_fraction)
break;
case scm_tc7_wvect:
- SCM_SET_WVECT_GC_CHAIN (ptr, scm_weak_vectors);
- scm_weak_vectors = ptr;
- if (SCM_IS_WHVEC_ANY (ptr))
- {
- long x;
- long len;
- int weak_keys;
- int weak_values;
-
- len = SCM_VECTOR_LENGTH (ptr);
- weak_keys = SCM_WVECT_WEAK_KEY_P (ptr);
- weak_values = SCM_WVECT_WEAK_VALUE_P (ptr);
-
- for (x = 0; x < len; ++x)
- {
- SCM alist;
- alist = SCM_VELTS (ptr)[x];
-
- /* mark everything on the alist except the keys or
- * values, according to weak_values and weak_keys. */
- while ( SCM_CONSP (alist)
- && !SCM_GC_MARK_P (alist)
- && SCM_CONSP (SCM_CAR (alist)))
- {
- SCM kvpair;
- SCM next_alist;
-
- kvpair = SCM_CAR (alist);
- next_alist = SCM_CDR (alist);
- /*
- * Do not do this:
- * SCM_SET_GC_MARK (alist);
- * SCM_SET_GC_MARK (kvpair);
- *
- * It may be that either the key or value is protected by
- * an escaped reference to part of the spine of this alist.
- * If we mark the spine here, and only mark one or neither of the
- * key and value, they may never be properly marked.
- * This leads to a horrible situation in which an alist containing
- * freelist cells is exported.
- *
- * So only mark the spines of these arrays last of all marking.
- * If somebody confuses us by constructing a weak vector
- * with a circular alist then we are hosed, but at least we
- * won't prematurely drop table entries.
- */
- if (!weak_keys)
- scm_gc_mark (SCM_CAR (kvpair));
- if (!weak_values)
- scm_gc_mark (SCM_CDR (kvpair));
- alist = next_alist;
- }
- if (SCM_NIMP (alist))
- scm_gc_mark (alist);
- }
- }
+ scm_i_mark_weak_vector (ptr);
break;
case scm_tc7_symbol:
- ptr = SCM_PROP_SLOTS (ptr);
+ ptr = scm_i_symbol_mark (ptr);
goto gc_mark_loop;
case scm_tc7_variable:
ptr = SCM_CELL_OBJECT_1 (ptr);
were called with.)
*/
return ;
-
-gc_mark_loop:
+
+ gc_mark_loop:
if (SCM_IMP (ptr))
return;