-/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001, 2002, 2003, 2004 Free Software Foundation, Inc.
+/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001, 2002, 2003, 2004, 2005, 2006, 2009 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
- * License as published by the Free Software Foundation; either
- * version 2.1 of the License, or (at your option) any later version.
+ * modify it under the terms of the GNU Lesser General Public License
+ * as published by the Free Software Foundation; either version 3 of
+ * the License, or (at your option) any later version.
*
- * This library is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * 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
* Lesser General Public License for more details.
*
* 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
*/
\f
-#if HAVE_CONFIG_H
+#ifdef HAVE_CONFIG_H
# include <config.h>
#endif
#include "libguile/smob.h"
#include "libguile/unif.h"
#include "libguile/async.h"
+#include "libguile/programs.h"
#include "libguile/ports.h"
#include "libguile/root.h"
#include "libguile/strings.h"
#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
-
+int scm_i_marking = 0;
/*
Entry point for this file.
scm_mark_all (void)
{
long j;
-
+ int loops;
+
+ scm_i_marking = 1;
+ scm_i_init_weak_vectors_for_gc ();
+ scm_i_init_guardians_for_gc ();
scm_i_clear_mark_space ();
-
+ scm_i_find_heap_calls = 0;
/* Mark every thread's stack and registers */
scm_threads_mark_stacks ();
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);
}
}
}
-
- /* FIXME: we should have a means to register C functions to be run
- * in different phases of GC
+ loops = 0;
+ while (1)
+ {
+ int again;
+ loops++;
+
+ /* 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;
+ }
+
+ /* 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 ();
+ scm_i_marking = 0;
}
/* {Mark/Sweep}
if (SCM_GC_MARK_P (ptr))
return;
+ if (!scm_i_marking)
+ {
+ static const char msg[]
+ = "Should only call scm_gc_mark() during GC.";
+ scm_c_issue_deprecation_warning (msg);
+ }
+
SCM_SET_GC_MARK (ptr);
scm_gc_mark_dependencies (ptr);
}
+void
+scm_i_ensure_marking (void)
+{
+ assert (scm_i_marking);
+}
+
/*
Mark the dependencies of an object.
Should prefetch objects before marking, i.e. if marking a cell, we
should prefetch the car, and then mark the cdr. This will improve CPU
-cache misses, because the car is more likely to be in core when we
+cache misses, because the car is more likely to be in cache when we
finish the cdr.
See http://www.hpl.hp.com/techreports/2000/HPL-2000-99.pdf, reducing
*/
+
void
scm_gc_mark_dependencies (SCM p)
#define FUNC_NAME "scm_gc_mark_dependencies"
scm_gc_mark (SCM_CLOSCAR (ptr));
ptr = SCM_ENV (ptr);
goto gc_mark_nimp;
+ case scm_tc7_program:
+ if (SCM_PROGRAM_FREE_VARIABLES (ptr) != SCM_BOOL_F)
+ scm_gc_mark (SCM_PROGRAM_FREE_VARIABLES (ptr));
+ if (SCM_PROGRAM_OBJTABLE (ptr) != SCM_BOOL_F)
+ scm_gc_mark (SCM_PROGRAM_OBJTABLE (ptr));
+ ptr = SCM_PROGRAM_OBJCODE (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:
- {
- size_t i = SCM_CCLO_LENGTH (ptr);
- size_t 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
-#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
- break;
-#endif
case scm_tc7_string:
ptr = scm_i_string_mark (ptr);
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_CELL_OBJECT_1 (ptr);
goto gc_mark_loop;
case scm_tcs_subrs:
- break;
+ if (SCM_CELL_WORD_2 (ptr) && *(SCM*)SCM_CELL_WORD_2 (ptr))
+ /* the generic associated with this primitive */
+ scm_gc_mark (*(SCM*)SCM_CELL_WORD_2 (ptr));
+ if (SCM_NIMP (((SCM*)SCM_CELL_WORD_3 (ptr))[1]))
+ scm_gc_mark (((SCM*)SCM_CELL_WORD_3 (ptr))[1]); /* props */
+ ptr = ((SCM*)SCM_CELL_WORD_3 (ptr))[0]; /* name */
+ goto gc_mark_loop;
case scm_tc7_port:
i = SCM_PTOBNUM (ptr);
#if (SCM_DEBUG_CELL_ACCESSES == 1)
if (!(i < scm_numptob))
{
fprintf (stderr, "undefined port type");
- abort();
+ abort ();
}
#endif
- if (SCM_PTAB_ENTRY(ptr))
+ if (SCM_PTAB_ENTRY (ptr))
scm_gc_mark (SCM_FILENAME (ptr));
if (scm_ptobs[i].mark)
{
if (!(i < scm_numsmob))
{
fprintf (stderr, "undefined smob type");
- abort();
+ abort ();
}
#endif
if (scm_smobs[i].mark)
break;
default:
fprintf (stderr, "unknown type");
- abort();
+ abort ();
}
/*
were called with.)
*/
return ;
-
-gc_mark_loop:
+
+ gc_mark_loop:
if (SCM_IMP (ptr))
return;
{
/* We are in debug mode. Check the ptr exhaustively. */
- valid_cell = valid_cell && (scm_i_find_heap_segment_containing_object (ptr) >= 0);
+ valid_cell = valid_cell && scm_in_heap_p (ptr);
}
#endif
if (!valid_cell)
{
fprintf (stderr, "rogue pointer in heap");
- abort();
+ abort ();
}
}
- if (SCM_GC_MARK_P (ptr))
- {
+ if (SCM_GC_MARK_P (ptr))
return;
- }
SCM_SET_GC_MARK (ptr);
#undef FUNC_NAME
-
-
/* Mark a region conservatively */
void
scm_mark_locations (SCM_STACKITEM x[], unsigned long n)
void
-scm_gc_init_mark(void)
+scm_gc_init_mark (void)
{
#if SCM_ENABLE_DEPRECATED == 1
scm_tc16_allocated = scm_make_smob_type ("allocated cell", 0);
HCoop / bpt / guile.git / blobdiff