-/* 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 program is free software; you can redistribute it and/or modify
- * it under the terms of the GNU General Public License as published by
- * the Free Software Foundation; either version 2, or (at your option)
- * any later version.
+ * This library is free software; you can redistribute it and/or
+ * modify it under the terms of the GNU Lesser General Public
+ * License as published by the Free Software Foundation; either
+ * version 2.1 of the License, or (at your option) any later version.
*
- * This program is distributed in the hope that it will be useful,
+ * This library is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
- * GNU General Public License for more details.
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+ * Lesser General Public License for more details.
*
- * You should have received a copy of the GNU General Public License
- * along with this software; see the file COPYING. If not, write to
- * the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
- * Boston, MA 02111-1307 USA
- *
- * As a special exception, the Free Software Foundation gives permission
- * for additional uses of the text contained in its release of GUILE.
- *
- * The exception is that, if you link the GUILE library with other files
- * to produce an executable, this does not by itself cause the
- * resulting executable to be covered by the GNU General Public License.
- * Your use of that executable is in no way restricted on account of
- * linking the GUILE library code into it.
- *
- * This exception does not however invalidate any other reasons why
- * the executable file might be covered by the GNU General Public License.
- *
- * This exception applies only to the code released by the
- * Free Software Foundation under the name GUILE. If you copy
- * code from other Free Software Foundation releases into a copy of
- * GUILE, as the General Public License permits, the exception does
- * not apply to the code that you add in this way. To avoid misleading
- * anyone as to the status of such modified files, you must delete
- * this exception notice from them.
- *
- * If you write modifications of your own for GUILE, it is your choice
- * whether to permit this exception to apply to your modifications.
- * If you do not wish that, delete this exception notice. */
+ * 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., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+ */
\f
#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_num2long (SCM_CAAR (l), 0, NULL));
+ SCM *p = (SCM *) (scm_to_ulong (SCM_CAAR (l)));
scm_gc_mark (*p);
}
}
}
+ scm_mark_subr_table ();
+
+ 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;
+ }
- /* FIXME: we should have a means to register C functions to be run
- * in different phases of GC
+ //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}
scm_gc_mark (SCM ptr)
{
if (SCM_IMP (ptr))
- return ;
+ return;
if (SCM_GC_MARK_P (ptr))
- {
- return;
- }
+ return;
SCM_SET_GC_MARK (ptr);
scm_gc_mark_dependencies (ptr);
*/
+
void
scm_gc_mark_dependencies (SCM p)
#define FUNC_NAME "scm_gc_mark_dependencies"
{
register long i;
register SCM ptr;
- scm_t_bits cell_type;
+ SCM cell_type;
ptr = p;
scm_mark_dependencies_again:
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_wvect:
- SCM_SET_WVECT_GC_CHAIN (ptr, scm_weak_vectors);
- scm_weak_vectors = ptr;
- if (SCM_IS_WHVEC_ANY (ptr))
+ case scm_tc7_number:
+ if (SCM_TYP16 (ptr) == scm_tc16_fraction)
{
- 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_gc_mark (SCM_CELL_OBJECT_1 (ptr));
+ ptr = SCM_CELL_OBJECT_2 (ptr);
+ goto gc_mark_loop;
}
break;
+ case scm_tc7_wvect:
+ 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);
* on the C stack points into guile's heap and is scanned during
* conservative marking. */
break;
- case scm_tc16_big:
- case scm_tc16_real:
- case scm_tc16_complex:
- break;
default:
i = SCM_SMOBNUM (ptr);
#if (SCM_DEBUG_CELL_ACCESSES == 1)
were called with.)
*/
return ;
-
-gc_mark_loop:
+
+ gc_mark_loop:
if (SCM_IMP (ptr))
return;
HCoop / bpt / guile.git / blobdiff