new gc

libguile/ChangeLog

@@ -1,3 +1,13 @@
+2002-08-04  Han-Wen  <hanwen@cs.uu.nl>
+
+	* numbers.c (big2str): return "0" for 0 iso. ""
+
+        * gc-segment.c, gc-malloc.c gc-mark.c, gc-freelist.c, gc-card.c, private-gc.h:
+        new file
+
+        * gc.c: completely revised and cleaned up the GC. It now uses lazy
+        sweeping. More documentation in workbook/newgc.text
+
 2002-07-25  Marius Vollmer  <marius.vollmer@uni-dortmund.de>
 
 	* random.c (rstate_free): Return zero.

libguile/Makefile.am

@@ -64,7 +64,8 @@ libguile_la_SOURCES = alist.c arbiters.c async.c backtrace.c boolean.c	    \
     chars.c continuations.c convert.c debug.c deprecation.c                 \
     dynwind.c environments.c eq.c error.c eval.c evalext.c extensions.c     \
     feature.c fluids.c fports.c						    \
-    gc.c gc_os_dep.c gdbint.c gh_data.c gh_eval.c gh_funcs.c gh_init.c	    \
+    gc.c gc-mark.c gc-segment.c gc-malloc.c gc-card.c gc-freelist.c \
+	gc_os_dep.c gdbint.c gh_data.c gh_eval.c gh_funcs.c gh_init.c	    \
     gh_io.c gh_list.c gh_predicates.c goops.c gsubr.c guardians.c hash.c    \
     hashtab.c hooks.c init.c inline.c ioext.c iselect.c keywords.c	    \
     lang.c list.c							    \
@@ -79,7 +80,7 @@ DOT_X_FILES = alist.x arbiters.x async.x backtrace.x boolean.x chars.x	  \
     continuations.x debug.x deprecation.x dynl.x dynwind.x		  \
     environments.x eq.x							  \
     error.x eval.x evalext.x extensions.x feature.x fluids.x fports.x	  \
-    gc.x goops.x							  \
+    gc.x  gc-mark.x gc-segment.x gc-malloc.x gc-card.x goops.x \
     gsubr.x guardians.x hash.x hashtab.x hooks.x init.x ioext.x iselect.x \
     keywords.x lang.x list.x load.x macros.x mallocs.x modules.x	  \
     numbers.x objects.x objprop.x options.x pairs.x ports.x print.x	  \
@@ -95,7 +96,7 @@ DOT_DOC_FILES = alist.doc arbiters.doc async.doc backtrace.doc		    \
     boolean.doc chars.doc continuations.doc debug.doc dynl.doc		    \
     dynwind.doc environments.doc eq.doc error.doc eval.doc evalext.doc	    \
     extensions.doc feature.doc fluids.doc fports.doc gc.doc goops.doc	    \
-    gsubr.doc								    \
+    gsubr.doc gc-mark.doc gc-segment.doc gc-malloc.doc gc-card.doc \
     guardians.doc hash.doc hashtab.doc hooks.doc init.doc ioext.doc	    \
     iselect.doc keywords.doc lang.doc list.doc load.doc macros.doc	    \
     mallocs.doc modules.doc numbers.doc objects.doc objprop.doc		    \
@@ -130,7 +131,8 @@ install-exec-hook:
 ## working.
 noinst_HEADERS = coop-threads.c coop-threads.h coop.c \
     num2integral.i.c num2float.i.c convert.i.c        \
-    win32-uname.h win32-dirent.h win32-socket.h
+    win32-uname.h win32-dirent.h win32-socket.h\
+	private-gc.h
 
 libguile_la_DEPENDENCIES = @LIBLOBJS@
 libguile_la_LIBADD = @LIBLOBJS@ $(LIBLTDL) $(THREAD_LIBS_LOCAL)

libguile/continuations.c

@@ -270,7 +270,7 @@ scm_dynthrow (SCM cont, SCM val)
     grow_stack (cont, val);
 #else
   dst -= continuation->num_stack_items;
-  if (SCM_PTR_LE (dst, &stack_top_element))
+  if (dst <= &stack_top_element)
     grow_stack (cont, val);
 #endif /* def SCM_STACK_GROWS_UP */
 

libguile/gc-card.c

@@ -0,0 +1,337 @@
+/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001, 2002 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 program 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.
+ *
+ * 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.  */
+
+
+#include "libguile/_scm.h"
+#include "libguile/eval.h"
+#include "libguile/stime.h"
+#include "libguile/stackchk.h"
+#include "libguile/struct.h"
+#include "libguile/smob.h"
+#include "libguile/unif.h"
+#include "libguile/async.h"
+#include "libguile/ports.h"
+#include "libguile/root.h"
+#include "libguile/strings.h"
+#include "libguile/vectors.h"
+#include "libguile/weaks.h"
+#include "libguile/hashtab.h"
+#include "libguile/tags.h"
+#include "libguile/private-gc.h"
+#include "libguile/validate.h"
+#include "libguile/deprecation.h"
+#include "libguile/gc.h"
+
+
+#include "libguile/private-gc.h"
+
+long int scm_i_deprecated_memory_return;
+
+
+/*
+  Init all the free cells in CARD, prepending to *FREE_LIST.
+
+  Return: number of free cells found in this card.
+
+  It would be cleaner to have a separate function sweep_value(), but
+  that is too slow (functions with switch statements can't be
+  inlined).
+  
+ */
+
+int
+scm_i_sweep_card (scm_t_cell *  p, SCM *free_list, int span)
+#define FUNC_NAME "sweep_card"
+{
+  scm_t_c_bvec_long *bitvec = SCM_GC_CARD_BVEC(p);
+  scm_t_cell * end = p + SCM_GC_CARD_N_CELLS;
+  int offset =SCM_MAX (SCM_GC_CARD_N_HEADER_CELLS, span);
+  int free_count  = 0;
+
+  /*
+    I tried something fancy with shifting by one bit every word from
+    the bitvec in turn, but it wasn't any faster, but quite bit
+    hairier.
+   */
+  for (p += offset; p < end; p += span, offset += span)
+    {
+      SCM scmptr = PTR2SCM(p);
+      if (SCM_C_BVEC_GET (bitvec, offset))
+        continue;
+
+      switch (SCM_TYP7 (scmptr))
+	{
+	case scm_tcs_struct:
+	  {
+	    /* Structs need to be freed in a special order.
+	     * This is handled by GC C hooks in struct.c.
+	     */
+	    SCM_SET_STRUCT_GC_CHAIN (p, scm_structs_to_free);
+	    scm_structs_to_free = scmptr;
+	  }
+	  continue;
+      
+	case scm_tcs_cons_imcar:
+	case scm_tcs_cons_nimcar:
+	case scm_tcs_closures:
+	case scm_tc7_pws:
+	  break;
+	case scm_tc7_wvect:
+	case scm_tc7_vector:
+	  {
+	    unsigned long int length = SCM_VECTOR_LENGTH (scmptr);
+	    if (length > 0)
+	      {
+		scm_gc_free (SCM_VECTOR_BASE (scmptr),
+			     length * sizeof (scm_t_bits),
+			     "vector");
+	      }
+	    break;
+	  }
+#ifdef CCLO
+	case scm_tc7_cclo:
+	  scm_gc_free (SCM_CCLO_BASE (scmptr), 
+		       SCM_CCLO_LENGTH (scmptr) * sizeof (SCM),
+		       "compiled closure");
+	  break;
+#endif
+#ifdef HAVE_ARRAYS
+	case scm_tc7_bvect:
+	  {
+	    unsigned long int length = SCM_BITVECTOR_LENGTH (scmptr);
+	    if (length > 0)
+	      {
+		scm_gc_free (SCM_BITVECTOR_BASE (scmptr),
+			     (sizeof (long)
+			      * ((length+SCM_LONG_BIT-1) / SCM_LONG_BIT)),
+			     "vector");
+	      }
+	  }
+	  break;
+	case scm_tc7_byvect:
+	case scm_tc7_ivect:
+	case scm_tc7_uvect:
+	case scm_tc7_svect:
+#ifdef HAVE_LONG_LONGS
+	case scm_tc7_llvect:
+#endif
+	case scm_tc7_fvect:
+	case scm_tc7_dvect:
+	case scm_tc7_cvect:
+	  scm_gc_free (SCM_UVECTOR_BASE (scmptr), 
+		       (SCM_UVECTOR_LENGTH (scmptr)
+			* scm_uniform_element_size (scmptr)),
+		       "vector");
+	  break;
+#endif
+	case scm_tc7_string:
+	  scm_gc_free (SCM_STRING_CHARS (scmptr), 
+		       SCM_STRING_LENGTH (scmptr) + 1, "string");
+	  break;
+	case scm_tc7_symbol:
+	  scm_gc_free (SCM_SYMBOL_CHARS (scmptr), 
+		       SCM_SYMBOL_LENGTH (scmptr) + 1, "symbol");
+	  break;
+	case scm_tc7_variable:
+	  break;
+	case scm_tcs_subrs:
+	  /* the various "subrs" (primitives) are never freed */
+	  continue;
+	case scm_tc7_port:
+	  if SCM_OPENP (scmptr)
+	    {
+	      int k = SCM_PTOBNUM (scmptr);
+	      size_t mm;
+#if (SCM_DEBUG_CELL_ACCESSES == 1)
+	      if (!(k < scm_numptob))
+		SCM_MISC_ERROR ("undefined port type", SCM_EOL);
+#endif
+	      /* Keep "revealed" ports alive.  */
+	      if (scm_revealed_count (scmptr) > 0)
+		continue;
+	  
+	      /* Yes, I really do mean scm_ptobs[k].free */
+	      /* rather than ftobs[k].close.  .close */
+	      /* is for explicit CLOSE-PORT by user */
+	      mm = scm_ptobs[k].free (scmptr);
+
+	      if (mm != 0)
+		{
+#if SCM_ENABLE_DEPRECATED == 1
+		  scm_c_issue_deprecation_warning
+		    ("Returning non-0 from a port free function is "
+		     "deprecated.  Use scm_gc_free et al instead.");
+		  scm_c_issue_deprecation_warning_fmt
+		    ("(You just returned non-0 while freeing a %s.)",
+		     SCM_PTOBNAME (k));
+		  scm_i_deprecated_memory_return += mm;
+#else
+		  abort ();
+#endif
+		}
+
+	      SCM_SETSTREAM (scmptr, 0);
+	      scm_remove_from_port_table (scmptr);
+	      scm_gc_ports_collected++;
+	      SCM_CLR_PORT_OPEN_FLAG (scmptr);
+	    }
+	  break;
+	case scm_tc7_smob:
+	  switch SCM_TYP16 (scmptr)
+	    {
+	    case scm_tc_free_cell:
+	    case scm_tc16_real:
+	      break;
+#ifdef SCM_BIGDIG
+	    case scm_tc16_big:
+	      scm_gc_free (SCM_BDIGITS (scmptr),
+			   ((SCM_NUMDIGS (scmptr) * SCM_BITSPERDIG
+			     / SCM_CHAR_BIT)), "bignum");
+	      break;
+#endif /* def SCM_BIGDIG */
+	    case scm_tc16_complex:
+	      scm_gc_free (SCM_COMPLEX_MEM (scmptr), 2*sizeof (double),
+			   "complex");
+	      break;
+	    default:
+	      {
+		int k;
+		k = SCM_SMOBNUM (scmptr);
+#if (SCM_DEBUG_CELL_ACCESSES == 1)
+		if (!(k < scm_numsmob))
+		  SCM_MISC_ERROR ("undefined smob type", SCM_EOL);
+#endif
+		if (scm_smobs[k].free)
+		  {
+		    size_t mm;
+		    mm = scm_smobs[k].free (scmptr);
+		    if (mm != 0)
+		      {
+#if SCM_ENABLE_DEPRECATED == 1
+			scm_c_issue_deprecation_warning
+			  ("Returning non-0 from a smob free function is "
+			   "deprecated.  Use scm_gc_free et al instead.");
+			scm_c_issue_deprecation_warning_fmt
+			  ("(You just returned non-0 while freeing a %s.)",
+			   SCM_SMOBNAME (k));
+			scm_i_deprecated_memory_return += mm;
+#else
+			abort();
+#endif
+		      }
+		  }
+		break;
+	      }
+	    }
+	  break;
+	default:
+	  SCM_MISC_ERROR ("unknown type", SCM_EOL);
+	}
+
+	  
+      SCM_SET_CELL_TYPE (p, scm_tc_free_cell);
+      SCM_SET_FREE_CELL_CDR (p, PTR2SCM (*free_list));
+      *free_list = PTR2SCM (p);
+      free_count ++;
+    }
+  return free_count;
+}
+#undef FUNC_NAME
+
+
+/*
+  Like sweep, but no complicated logic to do the sweeping.
+ */
+int
+scm_init_card_freelist (scm_t_cell *  card, SCM *free_list, int span)
+{
+  scm_t_cell *end = card + SCM_GC_CARD_N_CELLS;
+  scm_t_cell *p = end - span;
+
+  /*
+     ASSUMPTION: n_header_cells <= 2. 
+   */
+  for (; p > card;  p -= span)
+    {
+      SCM_SET_CELL_TYPE (p, scm_tc_free_cell);
+      SCM_SET_FREE_CELL_CDR (p, PTR2SCM (*free_list));
+      *free_list = PTR2SCM (p);
+    }
+
+  return SCM_GC_CARD_N_CELLS - SCM_MAX(span, SCM_GC_CARD_N_HEADER_CELLS);
+}
+
+
+#if 0
+/*
+  These functions are meant to be called from GDB as a debug aid.
+
+  I've left them as a convenience for future generations.
+ */
+
+
+int scm_gc_marked_p (SCM obj);
+scm_t_cell * scm_gc_get_card (SCM obj);
+long * scm_gc_get_bvec (SCM obj);
+
+typedef struct scm_t_list_cell_struct {
+  scm_t_bits car;  
+  struct scm_t_list_cell_struct * cdr;
+} scm_t_list_cell;
+
+int
+scm_gc_marked_p (SCM obj)
+{
+  return SCM_GC_MARK_P(obj);
+}
+
+scm_t_cell *
+scm_gc_get_card (SCM obj)
+{
+  return SCM_GC_CELL_CARD(obj);
+}
+
+long *
+scm_gc_get_bvec (SCM obj)
+{
+  return SCM_GC_CARD_BVEC(SCM_GC_CELL_CARD(obj));
+}
+#endif

libguile/gc.h

@@ -58,11 +58,17 @@ typedef struct scm_t_cell
   scm_t_bits word_1;
 } scm_t_cell;
 
+/*
+  CARDS
+
+  A card is a small `page' of memory; it will be the unit for lazy
+  sweeping, generations, etc. The first cell of a card contains a
+  pointer to the mark bitvector, so that we can find the bitvector efficiently: we
+  knock off some lowerorder bits.
+
+  The size on a 32 bit machine is 256 cells = 2kb. The card 
+*/
 
-/* SCM_CELLPTR is a pointer to a cons cell which may be compared or
- * differenced.
- */
-typedef scm_t_cell * SCM_CELLPTR;
 
 
 /* Cray machines have pointers that are incremented once for each word,
@@ -73,39 +79,32 @@ typedef scm_t_cell * SCM_CELLPTR;
  * pointers to scm_vector elts, functions, &c are not munged.
  */
 #ifdef _UNICOS
-#  define SCM2PTR(x) ((SCM_CELLPTR) (SCM_UNPACK (x) >> 3))
+#  define SCM2PTR(x) ((scm_t_cell *) (SCM_UNPACK (x) >> 3))
 #  define PTR2SCM(x) (SCM_PACK (((scm_t_bits) (x)) << 3))
 #else
-#  define SCM2PTR(x) ((SCM_CELLPTR) (SCM_UNPACK (x)))
+#  define SCM2PTR(x) ((scm_t_cell *) (SCM_UNPACK (x)))
 #  define PTR2SCM(x) (SCM_PACK ((scm_t_bits) (x)))
 #endif /* def _UNICOS */
 
+
 #define SCM_GC_CARD_N_HEADER_CELLS 1
 #define SCM_GC_CARD_N_CELLS        256
+#define SCM_GC_SIZEOF_CARD 		SCM_GC_CARD_N_CELLS * sizeof (scm_t_cell)
 
-#define SCM_GC_CARD_BVEC(card)  ((scm_t_c_bvec_limb *) ((card)->word_0))
+#define SCM_GC_CARD_BVEC(card)  ((scm_t_c_bvec_long *) ((card)->word_0))
 #define SCM_GC_SET_CARD_BVEC(card, bvec) \
     ((card)->word_0 = (scm_t_bits) (bvec))
 
 
-#define SCM_GC_CARD_SIZE           (SCM_GC_CARD_N_CELLS * sizeof (scm_t_cell))
-#define SCM_GC_CARD_N_DATA_CELLS   (SCM_GC_CARD_N_CELLS - SCM_GC_CARD_N_HEADER_CELLS)
-
-#define SCM_GC_CARD_BVEC_SIZE_IN_LIMBS \
-    ((SCM_GC_CARD_N_CELLS + SCM_C_BVEC_LIMB_BITS - 1) / SCM_C_BVEC_LIMB_BITS)
-
-#define SCM_GC_IN_CARD_HEADERP(x) \
-    SCM_PTR_LT ((scm_t_cell *) (x), SCM_GC_CELL_CARD (x) + SCM_GC_CARD_N_HEADER_CELLS)
-
 #define SCM_GC_GET_CARD_FLAGS(card) ((long) ((card)->word_1))
 #define SCM_GC_SET_CARD_FLAGS(card, flags) \
     ((card)->word_1 = (scm_t_bits) (flags))
-#define SCM_GC_CLR_CARD_FLAGS(card) (SCM_GC_SET_CARD_FLAGS (card, 0L))
+#define SCM_GC_CLEAR_CARD_FLAGS(card) (SCM_GC_SET_CARD_FLAGS (card, 0L))
 
 #define SCM_GC_GET_CARD_FLAG(card, shift) (SCM_GC_GET_CARD_FLAGS (card) & (1L << (shift)))
 #define SCM_GC_SET_CARD_FLAG(card, shift) \
     (SCM_GC_SET_CARD_FLAGS (card, SCM_GC_GET_CARD_FLAGS(card) | (1L << (shift))))
-#define SCM_GC_CLR_CARD_FLAG(card, shift) \
+#define SCM_GC_CLEAR_CARD_FLAG(card, shift) \
     (SCM_GC_SET_CARD_FLAGS (card, SCM_GC_GET_CARD_FLAGS(card) & ~(1L << (shift))))
 
 #define SCM_GC_CARDF_DOUBLECELL 0
@@ -116,31 +115,31 @@ typedef scm_t_cell * SCM_CELLPTR;
 /* card addressing. for efficiency, cards are *always* aligned to
    SCM_GC_CARD_SIZE. */
 
-#define SCM_GC_CARD_SIZE_MASK  (SCM_GC_CARD_SIZE - 1)
+#define SCM_GC_CARD_SIZE_MASK  (SCM_GC_CARD_N_CELLS * sizeof (scm_t_cell) - 1)
 #define SCM_GC_CARD_ADDR_MASK  (~SCM_GC_CARD_SIZE_MASK)
 
-#define SCM_GC_CELL_CARD(x)    ((SCM_CELLPTR) ((long) (x) & SCM_GC_CARD_ADDR_MASK))
+#define SCM_GC_CELL_CARD(x)    ((scm_t_cell *) ((long) (x) & SCM_GC_CARD_ADDR_MASK))
-#define SCM_GC_CELL_SPAN(x)    ((SCM_GC_CARD_DOUBLECELLP (SCM_GC_CELL_CARD (x))) ? 2 : 1)
 #define SCM_GC_CELL_OFFSET(x)  (((long) (x) & SCM_GC_CARD_SIZE_MASK) >> SCM_CELL_SIZE_SHIFT)
 #define SCM_GC_CELL_BVEC(x)    SCM_GC_CARD_BVEC (SCM_GC_CELL_CARD (x))
 #define SCM_GC_CELL_GET_BIT(x) SCM_C_BVEC_GET (SCM_GC_CELL_BVEC (x), SCM_GC_CELL_OFFSET (x))
 #define SCM_GC_CELL_SET_BIT(x) SCM_C_BVEC_SET (SCM_GC_CELL_BVEC (x), SCM_GC_CELL_OFFSET (x))
-#define SCM_GC_CELL_CLR_BIT(x) SCM_C_BVEC_CLR (SCM_GC_CELL_BVEC (x), SCM_GC_CELL_OFFSET (x))
+#define SCM_GC_CELL_CLEAR_BIT(x) SCM_C_BVEC_CLEAR (SCM_GC_CELL_BVEC (x), SCM_GC_CELL_OFFSET (x))
 
-#define SCM_GC_CARD_UP(x)      SCM_GC_CELL_CARD ((char *) (x) + SCM_GC_CARD_SIZE - 1)
+#define SCM_GC_CARD_UP(x)      SCM_GC_CELL_CARD ((char *) (x) + SCM_GC_SIZEOF_CARD - 1)
 #define SCM_GC_CARD_DOWN       SCM_GC_CELL_CARD
 
 /* low level bit banging aids */
-
+typedef unsigned long scm_t_c_bvec_long;
-typedef unsigned long scm_t_c_bvec_limb;
 
 #if (SIZEOF_LONG == 8)
-#       define SCM_C_BVEC_LIMB_BITS    64
+#       define SCM_C_BVEC_LONG_BITS    64
 #       define SCM_C_BVEC_OFFSET_SHIFT 6
 #       define SCM_C_BVEC_POS_MASK     63
 #       define SCM_CELL_SIZE_SHIFT     4
+#	define SCM_SIZEOF_LONG SIZEOF_LONG
 #else
-#       define SCM_C_BVEC_LIMB_BITS    32
+#       define SCM_C_BVEC_LONG_BITS    32
+#	define SCM_SIZEOF_LONG SIZEOF_LONG
 #       define SCM_C_BVEC_OFFSET_SHIFT 5
 #       define SCM_C_BVEC_POS_MASK     31
 #       define SCM_CELL_SIZE_SHIFT     3
@@ -150,23 +149,12 @@ typedef unsigned long scm_t_c_bvec_limb;
 
 #define SCM_C_BVEC_GET(bvec, pos) (bvec[SCM_C_BVEC_OFFSET (pos)] & (1L << (pos & SCM_C_BVEC_POS_MASK)))
 #define SCM_C_BVEC_SET(bvec, pos) (bvec[SCM_C_BVEC_OFFSET (pos)] |= (1L << (pos & SCM_C_BVEC_POS_MASK)))
-#define SCM_C_BVEC_CLR(bvec, pos) (bvec[SCM_C_BVEC_OFFSET (pos)] &= ~(1L << (pos & SCM_C_BVEC_POS_MASK)))
+#define SCM_C_BVEC_CLEAR(bvec, pos) (bvec[SCM_C_BVEC_OFFSET (pos)] &= ~(1L << (pos & SCM_C_BVEC_POS_MASK)))
-
-#define SCM_C_BVEC_BITS2BYTES(bits) \
-    (sizeof (scm_t_c_bvec_limb) * ((((bits) & SCM_C_BVEC_POS_MASK) ? 1L : 0L) + SCM_C_BVEC_OFFSET (bits)))
-
-#define SCM_C_BVEC_SET_BYTES(bvec, bytes)   (memset (bvec, 0xff, bytes))
-#define SCM_C_BVEC_SET_ALL_BITS(bvec, bits) SCM_C_BVEC_SET_BYTES (bvec, SCM_C_BVEC_BITS2BYTES (bits))
-
-#define SCM_C_BVEC_CLR_BYTES(bvec, bytes)   (memset (bvec, 0, bytes))
-#define SCM_C_BVEC_CLR_ALL_BITS(bvec, bits) SCM_C_BVEC_CLR_BYTES (bvec, SCM_C_BVEC_BITS2BYTES (bits))
 
 /* testing and changing GC marks */
-
+#define SCM_GC_MARK_P(x)   SCM_GC_CELL_GET_BIT (x)
-#define SCM_GCMARKP(x)   SCM_GC_CELL_GET_BIT (x)
+#define SCM_SET_GC_MARK(x) SCM_GC_CELL_SET_BIT (x)
-#define SCM_SETGCMARK(x) SCM_GC_CELL_SET_BIT (x)
+#define SCM_CLEAR_GC_MARK(x) SCM_GC_CELL_CLEAR_BIT (x)
-#define SCM_CLRGCMARK(x) SCM_GC_CELL_CLR_BIT (x)
-
 
 /* Low level cell data accessing macros.  These macros should only be used
  * from within code related to garbage collection issues, since they will
@@ -181,7 +169,7 @@ typedef unsigned long scm_t_c_bvec_limb;
 #define SCM_GC_SET_CELL_WORD(x, n, v) \
   (((scm_t_bits *) SCM2PTR (x)) [n] = (scm_t_bits) (v))
 #define SCM_GC_SET_CELL_OBJECT(x, n, v) \
-  (((scm_t_bits *) SCM2PTR (x)) [n] = SCM_UNPACK (v))
+ (((scm_t_bits *) SCM2PTR (x)) [n] = SCM_UNPACK (v))
 #define SCM_GC_CELL_TYPE(x) SCM_GC_CELL_WORD (x, 0)
 
 
@@ -235,8 +223,14 @@ typedef unsigned long scm_t_c_bvec_limb;
  * the freelist.  Due to this structure, freelist cells are not cons cells
  * and thus may not be accessed using SCM_CAR and SCM_CDR.  */
 
-#define SCM_FREE_CELL_P(x) \
+/*
-  (!SCM_IMP (x) && (SCM_GC_CELL_TYPE (x) == scm_tc_free_cell))
+  SCM_FREECELL_P removed ; the semantics are ambiguous with lazy
+  sweeping. Could mean "this cell is no longer in use (will be swept)"
+  or "this cell has just been swept, and is not yet in use".
+ */
+
+#define SCM_FREECELL_P  this_macro_has_been_removed_see_gc_header_file
+
 #define SCM_FREE_CELL_CDR(x) \
   (SCM_GC_CELL_OBJECT ((x), 1))
 #define SCM_SET_FREE_CELL_CDR(x, v) \
@@ -248,49 +242,54 @@ typedef unsigned long scm_t_c_bvec_limb;
 #define SCM_CDRLOC(x) ((SCM *) SCM_CELL_WORD_LOC ((x), 1))
 
 
-/* SCM_PTR_LT and friends define how to compare two SCM_CELLPTRs (which may
- * point to cells in different heap segments).
- */
-#define SCM_PTR_LT(x, y) ((x) < (y))
-#define SCM_PTR_GT(x, y) (SCM_PTR_LT (y, x))
-#define SCM_PTR_LE(x, y) (!SCM_PTR_GT (x, y))
-#define SCM_PTR_GE(x, y) (!SCM_PTR_LT (x, y))
 
 
-#define SCM_MARKEDP    SCM_GCMARKP
-#define SCM_NMARKEDP(x) (!SCM_MARKEDP (x))
-
 #if (SCM_DEBUG_CELL_ACCESSES == 1)
 SCM_API unsigned int scm_debug_cell_accesses_p;
 #endif
 
-SCM_API struct scm_t_heap_seg_data *scm_heap_table;
-SCM_API size_t scm_n_heap_segs;
 SCM_API int scm_block_gc;
 SCM_API int scm_gc_heap_lock;
 SCM_API unsigned int scm_gc_running_p;
 
 
+#if (SCM_ENABLE_DEPRECATED == 1)
 SCM_API size_t scm_default_init_heap_size_1;
 SCM_API int scm_default_min_yield_1;
 SCM_API size_t scm_default_init_heap_size_2;
 SCM_API int scm_default_min_yield_2;
 SCM_API size_t scm_default_max_segment_size;
+#else
+#define  scm_default_init_heap_size_1 deprecated
+#define  scm_default_min_yield_1 deprecated
+#define  scm_default_init_heap_size_2 deprecated
+#define  scm_default_min_yield_2 deprecated
+#define  scm_default_max_segment_size deprecated
+#endif
+
 
 SCM_API size_t scm_max_segment_size;
-SCM_API SCM_CELLPTR scm_heap_org;
+
-SCM_API SCM scm_freelist;
+/*
-SCM_API struct scm_t_freelist scm_master_freelist;
+  Deprecated scm_freelist, scm_master_freelist.
-SCM_API SCM scm_freelist2;
+  No warning; this is not a user serviceable part.
-SCM_API struct scm_t_freelist scm_master_freelist2;
+ */
+SCM_API SCM scm_i_freelist;
+SCM_API struct scm_t_cell_type_statistics scm_i_master_freelist;
+SCM_API SCM scm_i_freelist2;
+SCM_API struct scm_t_cell_type_statistics scm_i_master_freelist2;
+
+SCM_API unsigned long scm_gc_cells_swept;
+SCM_API unsigned long scm_gc_cells_collected;
 SCM_API unsigned long scm_gc_cells_collected;
-SCM_API unsigned long scm_gc_yield;
 SCM_API unsigned long scm_gc_malloc_collected;
 SCM_API unsigned long scm_gc_ports_collected;
 SCM_API unsigned long scm_cells_allocated;
 SCM_API unsigned long scm_mallocated;
 SCM_API unsigned long scm_mtrigger;
 
+
+
 SCM_API SCM scm_after_gc_hook;
 
 SCM_API scm_t_c_hook scm_before_gc_c_hook;
@@ -300,32 +299,32 @@ SCM_API scm_t_c_hook scm_after_sweep_c_hook;
 SCM_API scm_t_c_hook scm_after_gc_c_hook;
 
 #if defined (GUILE_DEBUG) || defined (GUILE_DEBUG_FREELIST)
-SCM_API SCM scm_map_free_list (void);
+#define scm_map_free_list deprecated
-SCM_API SCM scm_free_list_length (void);
+#define scm_free_list_length deprecated
-#endif
-#ifdef GUILE_DEBUG_FREELIST
-SCM_API SCM scm_gc_set_debug_check_freelist_x (SCM flag);
 #endif
 
+#if (SCM_ENABLE_DEPRECATED == 1) && defined (GUILE_DEBUG_FREELIST)
+SCM_API SCM scm_gc_set_debug_check_freelist_x (SCM flag);
+#endif
 
 
 #if (SCM_DEBUG_CELL_ACCESSES == 1)
 SCM_API void scm_assert_cell_valid (SCM);
-SCM_API SCM scm_set_debug_cell_accesses_x (SCM flag);
 #endif
+
+SCM_API SCM scm_set_debug_cell_accesses_x (SCM flag);
+
+
 SCM_API SCM scm_object_address (SCM obj);
 SCM_API SCM scm_gc_stats (void);
 SCM_API SCM scm_gc (void);
-SCM_API void scm_gc_for_alloc (struct scm_t_freelist *freelist);
+SCM_API void scm_gc_for_alloc (struct scm_t_cell_type_statistics *freelist);
-SCM_API SCM scm_gc_for_newcell (struct scm_t_freelist *master, SCM *freelist);
+SCM_API SCM scm_gc_for_newcell (struct scm_t_cell_type_statistics *master, SCM *freelist);
-#if 0
-SCM_API void scm_alloc_cluster (struct scm_t_freelist *master);
-#endif
 SCM_API void scm_igc (const char *what);
 SCM_API void scm_gc_mark (SCM p);
 SCM_API void scm_gc_mark_dependencies (SCM p);
 SCM_API void scm_mark_locations (SCM_STACKITEM x[], unsigned long n);
-SCM_API int scm_cellp (SCM value);
+SCM_API int scm_in_heap_p (SCM value);
 SCM_API void scm_gc_sweep (void);
 
 SCM_API void *scm_malloc (size_t size);

libguile/gdbint.c

@@ -142,14 +142,14 @@ static void
 unmark_port (SCM port)
 {
   SCM stream, string;
-  port_mark_p = SCM_GCMARKP (port);
+  port_mark_p = SCM_GC_MARK_P (port);
-  SCM_CLRGCMARK (port);
+  SCM_CLEAR_GC_MARK (port);
   stream = SCM_PACK (SCM_STREAM (port));
-  stream_mark_p = SCM_GCMARKP (stream);
+  stream_mark_p = SCM_GC_MARK_P (stream);
-  SCM_CLRGCMARK (stream);
+  SCM_CLEAR_GC_MARK (stream);
   string = SCM_CDR (stream);
-  string_mark_p = SCM_GCMARKP (string);
+  string_mark_p = SCM_GC_MARK_P (string);
-  SCM_CLRGCMARK (string);
+  SCM_CLEAR_GC_MARK (string);
 }
 
 
@@ -158,16 +158,19 @@ remark_port (SCM port)
 {
   SCM stream = SCM_PACK (SCM_STREAM (port));
   SCM string = SCM_CDR (stream);
-  if (string_mark_p) SCM_SETGCMARK (string);
+  if (string_mark_p)
-  if (stream_mark_p) SCM_SETGCMARK (stream);
+    SCM_SET_GC_MARK (string);
-  if (port_mark_p) SCM_SETGCMARK (port);
+  if (stream_mark_p)
+    SCM_SET_GC_MARK (stream);
+  if (port_mark_p)
+    SCM_SET_GC_MARK (port);
 }
 
 
 int
 gdb_maybe_valid_type_p (SCM value)
 {
-  return SCM_IMP (value) || scm_cellp (value);
+  return SCM_IMP (value) || scm_in_heap_p (value);
 }
 
 
@@ -211,8 +214,8 @@ gdb_read (char *str)
   scm_truncate_file (gdb_input_port, SCM_UNDEFINED);
   scm_seek (gdb_input_port, SCM_INUM0, SCM_MAKINUM (SEEK_SET));
   /* Read one object */
-  tok_buf_mark_p = SCM_GCMARKP (tok_buf);
+  tok_buf_mark_p = SCM_GC_MARK_P (tok_buf);
-  SCM_CLRGCMARK (tok_buf);
+  SCM_CLEAR_GC_MARK (tok_buf);
   ans = scm_lreadr (&tok_buf, gdb_input_port, &ans);
   if (SCM_GC_P)
     {
@@ -229,7 +232,7 @@ gdb_read (char *str)
     scm_permanent_object (ans);
 exit:
   if (tok_buf_mark_p)
-    SCM_SETGCMARK (tok_buf);
+    SCM_SET_GC_MARK (tok_buf);
   remark_port (gdb_input_port);
   SCM_END_FOREIGN_BLOCK;
   return status;

libguile/guardians.c

@@ -447,19 +447,19 @@ mark_dependencies_in_tconc (t_tconc *tc)
       SCM obj = SCM_CAR (pair);
       next_pair = SCM_CDR (pair);
             
-      if (! SCM_MARKEDP (obj))
+      if (! SCM_GC_MARK_P (obj))
         {
           /* a candidate for finalizing */
           scm_gc_mark_dependencies (obj);
 
-          if (SCM_MARKEDP (obj))
+          if (SCM_GC_MARK_P (obj))
             {
               /* uh oh.  a cycle.  transfer this object (the
                  spine cell, to be exact) to
                  self_centered_zombies, so we'll be able to
                  complain about it later. */
               *prev_ptr = next_pair;
-              SCM_SETGCMARK (pair);
+              SCM_SET_GC_MARK (pair);
               SCM_SETCDR (pair, self_centered_zombies);
               self_centered_zombies = pair;
             }
@@ -494,7 +494,7 @@ mark_and_zombify (t_guardian *g)
     {
       SCM next_pair = SCM_CDR (pair);
 
-      if (!SCM_MARKEDP (SCM_CAR (pair)))
+      if (!SCM_GC_MARK_P (SCM_CAR (pair)))
         {
           /* got you, zombie! */
 
@@ -504,7 +504,7 @@ mark_and_zombify (t_guardian *g)
           if (GREEDY_P (g))
             /* if the guardian is greedy, mark this zombie now.  this
                way it won't be zombified again this time around. */
-            SCM_SETGCMARK (SCM_CAR (pair));
+            SCM_SET_GC_MARK (SCM_CAR (pair));
 
           /* into the zombie list! */
           TCONC_IN (g->zombies, SCM_CAR (pair), pair);
@@ -519,7 +519,7 @@ mark_and_zombify (t_guardian *g)
      don't care about objects pointed to by the list cars, since we
      know they are already marked).  */
   for (pair = g->live.head; !SCM_NULLP (pair); pair = SCM_CDR (pair))
-    SCM_SETGCMARK (pair);
+    SCM_SET_GC_MARK (pair);
 }
 
 

libguile/init.c

@@ -453,7 +453,9 @@ scm_init_guile_1 (SCM_STACKITEM *base)
 #ifdef GUILE_DEBUG_MALLOC
   scm_debug_malloc_prehistory ();
 #endif
-  scm_init_storage ();	          /* requires smob_prehistory */
+  if (scm_init_storage ())	          /* requires smob_prehistory */
+    abort ();
+  
   scm_struct_prehistory ();	  /* requires storage */
   scm_symbols_prehistory ();      /* requires storage */
   scm_weaks_prehistory ();	  /* requires storage */

libguile/inline.c

@@ -41,9 +41,10 @@
 
 #include "libguile/scmconfig.h"
 
-#ifndef HAVE_INLINE
 
 #define HAVE_INLINE
+#define EXTERN_INLINE
+#undef SCM_INLINE_H
+
 #include "libguile/inline.h"
 
-#endif

libguile/inline.h

@@ -49,35 +49,73 @@
    "inline.c".
 */
 
+
+#if (SCM_DEBUG_CELL_ACCESSES == 1)
+#include <stdio.h>
+#endif
+
 #include "libguile/pairs.h"
 #include "libguile/gc.h"
 
+
+SCM_API SCM scm_cell (scm_t_bits car, scm_t_bits cdr);
+SCM_API SCM scm_double_cell (scm_t_bits car, scm_t_bits cbr,
+			     scm_t_bits ccr, scm_t_bits cdr);
+
 #ifdef HAVE_INLINE
 
-static inline SCM
+
+
+#ifndef EXTERN_INLINE
+#define EXTERN_INLINE extern inline
+#endif
+
+extern unsigned scm_newcell2_count;
+extern unsigned scm_newcell_count;
+
+
+EXTERN_INLINE
+SCM
 scm_cell (scm_t_bits car, scm_t_bits cdr)
 {
   SCM z;
 
-#ifdef GUILE_DEBUG_FREELIST
+  if (SCM_NULLP (scm_i_freelist))
-  scm_newcell_count++;
-  if (scm_debug_check_freelist)
     {
-      scm_check_freelist (scm_freelist);
+      z = scm_gc_for_newcell (&scm_i_master_freelist, &scm_i_freelist);
-      scm_gc();
-    }
-#endif
-
-  if (SCM_NULLP (scm_freelist))
-    {
-      z = scm_gc_for_newcell (&scm_master_freelist, &scm_freelist);
     }
   else
     {
-      z = scm_freelist;
+      z = scm_i_freelist;
-      scm_freelist = SCM_FREE_CELL_CDR (scm_freelist);
+      scm_i_freelist = SCM_FREE_CELL_CDR (scm_i_freelist);
     }
 
+  /*
+    We update scm_cells_allocated from this function. If we don't
+    update this explicitly, we will have to walk a freelist somewhere
+    later on, which seems a lot more expensive.
+   */
+  scm_cells_allocated += 1;  
+
+#if (SCM_DEBUG_CELL_ACCESSES == 1)
+    if (scm_debug_cell_accesses_p)
+    {
+      if (SCM_GC_MARK_P (z))
+	{
+	  fprintf(stderr, "scm_cell tried to allocate a marked cell.\n");
+	  abort();
+	}
+      else if (SCM_GC_CELL_TYPE(z) != scm_tc_free_cell)
+	{
+	  fprintf(stderr, "cell from freelist is not a free cell.\n");
+	  abort();
+	}
+      
+      SCM_SET_GC_MARK (z);
+    }
+#endif
+
+  
   /* Initialize the type slot last so that the cell is ignored by the
      GC until it is completely initialized.  This is only relevant
      when the GC can actually run during this code, which it can't for
@@ -98,34 +136,31 @@ scm_cell (scm_t_bits car, scm_t_bits cdr)
 #endif
 #endif
 
+
+  
   return z;
 }
 
-static inline SCM
+EXTERN_INLINE
+SCM
 scm_double_cell (scm_t_bits car, scm_t_bits cbr,
 		 scm_t_bits ccr, scm_t_bits cdr)
 {
   SCM z;
 
-#ifdef GUILE_DEBUG_FREELIST
-  scm_newcell2_count++;
-  if (scm_debug_check_freelist)
-    {
-      scm_check_freelist (scm_freelist2);
-      scm_gc();
-    }
-#endif
 
-  if (SCM_NULLP (scm_freelist2))
+  if (SCM_NULLP (scm_i_freelist2))
     {
-      z = scm_gc_for_newcell (&scm_master_freelist2, &scm_freelist2);
+      z = scm_gc_for_newcell (&scm_i_master_freelist2, &scm_i_freelist2);
     }
   else
     {
-      z = scm_freelist2;
+      z = scm_i_freelist2;
-      scm_freelist2 = SCM_FREE_CELL_CDR (scm_freelist2);
+      scm_i_freelist2 = SCM_FREE_CELL_CDR (scm_i_freelist2);
     }
 
+  scm_cells_allocated += 2;
+
   /* Initialize the type slot last so that the cell is ignored by the
      GC until it is completely initialized.  This is only relevant
      when the GC can actually run during this code, which it can't for
@@ -148,15 +183,23 @@ scm_double_cell (scm_t_bits car, scm_t_bits cbr,
 #endif
 #endif
 
+
+#if (SCM_DEBUG_CELL_ACCESSES == 1)
+  if (scm_debug_cell_accesses_p)
+    {
+      if (SCM_GC_MARK_P (z))
+	{
+	  fprintf(stderr,
+		  "scm_double_cell tried to allocate a marked cell.\n");
+	  abort();
+	}
+
+      SCM_SET_GC_MARK (z);
+    }
+#endif
+
   return z;
 }
 
-#else /* !HAVE_INLINE */
-
-SCM_API SCM scm_cell (scm_t_bits car, scm_t_bits cdr);
-SCM_API SCM scm_double_cell (scm_t_bits car, scm_t_bits cbr,
-			     scm_t_bits ccr, scm_t_bits cdr);
-
 #endif
-
 #endif

libguile/numbers.c

@@ -2288,6 +2288,12 @@ big2str (SCM b, unsigned int radix)
   SCM_BIGDIG radpow = 1, radmod = 0;
   SCM ss = scm_allocate_string (j);
   char *s = SCM_STRING_CHARS (ss), c;
+
+  if (i == 0)
+    {
+      return scm_makfrom0str ("0");
+    }
+  
   while ((long) radpow * radix < SCM_BIGRAD)
     {
       radpow *= radix;

libguile/pairs.c

@@ -54,7 +54,7 @@
 
 #if (SCM_DEBUG_PAIR_ACCESSES == 1)
 
-#include "libguile/ports.h"
+/~#include "libguile/ports.h"
 #include "libguile/strings.h"
 
 void scm_error_pair_access (SCM non_pair)

libguile/print.c

@@ -739,7 +739,7 @@ scm_ipruk (char *hdr, SCM ptr, SCM port)
 {
   scm_puts ("#<unknown-", port);
   scm_puts (hdr, port);
-  if (scm_cellp (ptr))
+  if (scm_in_heap_p (ptr))
     {
       scm_puts (" (0x", port);
       scm_intprint (SCM_CELL_WORD_0 (ptr), 16, port);

libguile/procs.c

@@ -139,7 +139,7 @@ scm_mark_subr_table ()
   long i;
   for (i = 0; i < scm_subr_table_size; ++i)
     {
-      SCM_SETGCMARK (scm_subr_table[i].name);
+      SCM_SET_GC_MARK (scm_subr_table[i].name);
       if (scm_subr_table[i].generic && *scm_subr_table[i].generic)
 	scm_gc_mark (*scm_subr_table[i].generic);
       if (SCM_NIMP (scm_subr_table[i].properties))

libguile/regex-posix.c

@@ -270,14 +270,13 @@ SCM_DEFINE (scm_regexp_exec, "regexp-exec", 2, 2, 0,
       /* The match vector must include a cell for the string that was matched,
 	 so add 1. */
       mvec = scm_c_make_vector (nmatches + 1, SCM_UNSPECIFIED);
-      SCM_VELTS(mvec)[0] = str;
+      SCM_VECTOR_SET(mvec,0, str);
       for (i = 0; i < nmatches; ++i)
 	if (matches[i].rm_so == -1)
-	  SCM_VELTS(mvec)[i+1] = scm_cons (SCM_MAKINUM (-1), SCM_MAKINUM (-1));
+	  SCM_VECTOR_SET(mvec,i+1, scm_cons (SCM_MAKINUM (-1), SCM_MAKINUM (-1)));
 	else
-	  SCM_VELTS(mvec)[i+1]
+	  SCM_VECTOR_SET(mvec,i+1,scm_cons (scm_long2num (matches[i].rm_so + offset),
-	    = scm_cons (scm_long2num (matches[i].rm_so + offset),
+				       scm_long2num (matches[i].rm_eo + offset)));
-			scm_long2num (matches[i].rm_eo + offset));
     }
   free (matches);
   SCM_ALLOW_INTS;

libguile/struct.c

@@ -378,7 +378,7 @@ scm_free_structs (void *dummy1 SCM_UNUSED,
 	{
 	  SCM vtable = SCM_STRUCT_VTABLE (chain);
 	  if (SCM_STRUCT_GC_CHAIN (vtable) != 0 && vtable != chain)
-	    SCM_SETGCMARK (vtable);
+	    SCM_SET_GC_MARK (vtable);
 	  chain = SCM_STRUCT_GC_CHAIN (chain);
 	}
       /* Free unmarked structs.  */
@@ -388,9 +388,9 @@ scm_free_structs (void *dummy1 SCM_UNUSED,
 	{
 	  SCM obj = chain;
 	  chain = SCM_STRUCT_GC_CHAIN (chain);
-	  if (SCM_GCMARKP (obj))
+	  if (SCM_GC_MARK_P (obj))
 	    {
-	      SCM_CLRGCMARK (obj);
+	      SCM_CLEAR_GC_MARK (obj);
 	      SCM_SET_STRUCT_GC_CHAIN (obj, newchain);
 	      newchain = obj;
 	    }

libguile/symbols.c

@@ -120,19 +120,14 @@ scm_mem2symbol (const char *name, size_t len)
 
   {
     /* The symbol was not found - create it. */
-
+    SCM symbol = scm_double_cell (SCM_MAKE_SYMBOL_TAG (len),
-    SCM symbol;
-    SCM cell;
-    SCM slot;
-
-    symbol = scm_double_cell (SCM_MAKE_SYMBOL_TAG (len),
 			      (scm_t_bits) scm_gc_strndup (name, len,
 							   "symbol"),
 			      raw_hash,
 			      SCM_UNPACK (scm_cons (SCM_BOOL_F, SCM_EOL)));
 
-    slot = SCM_VELTS (symbols) [hash];
+    SCM slot = SCM_VELTS (symbols) [hash];
-    cell = scm_cons (symbol, SCM_UNDEFINED);
+    SCM cell = scm_cons (symbol, SCM_UNDEFINED);
     SCM_VECTOR_SET (symbols, hash, scm_cons (cell, slot));
 
     return symbol;

libguile/weaks.c

@@ -278,11 +278,11 @@ scm_mark_weak_vector_spines (void *dummy1 SCM_UNUSED,
 
 	      alist = ptr[j];
 	      while (   SCM_CONSP (alist)
-		     && !SCM_GCMARKP (alist)
+		     && !SCM_GC_MARK_P (alist)
 		     && SCM_CONSP  (SCM_CAR (alist)))
 		{
-		  SCM_SETGCMARK (alist);
+		  SCM_SET_GC_MARK (alist);
-		  SCM_SETGCMARK (SCM_CAR (alist));
+		  SCM_SET_GC_MARK (SCM_CAR (alist));
 		  alist = SCM_CDR (alist);
 		}
 	    }
@@ -292,6 +292,7 @@ scm_mark_weak_vector_spines (void *dummy1 SCM_UNUSED,
   return 0;
 }
 
+#define UNMARKED_CELL_P(x) (SCM_NIMP(x) && !SCM_GC_MARK_P (x))
 
 static void *
 scm_scan_weak_vectors (void *dummy1 SCM_UNUSED,
@@ -308,7 +309,7 @@ scm_scan_weak_vectors (void *dummy1 SCM_UNUSED,
 	  ptr = SCM_GC_WRITABLE_VELTS (w);
 	  n = SCM_VECTOR_LENGTH (w);
 	  for (j = 0; j < n; ++j)
-	    if (SCM_FREE_CELL_P (ptr[j]))
+	    if (UNMARKED_CELL_P (ptr[j]))
 	      ptr[j] = SCM_BOOL_F;
 	}
       else /* if (SCM_IS_WHVEC_ANY (scm_weak_vectors[i])) */
@@ -329,16 +330,16 @@ scm_scan_weak_vectors (void *dummy1 SCM_UNUSED,
 	      fixup = ptr + j;
 	      alist = *fixup;
 
-	      while (   SCM_CONSP (alist)
+	      while (SCM_CONSP (alist)
-			&& SCM_CONSP (SCM_CAR (alist)))
+		     && SCM_CONSP (SCM_CAR (alist)))
 		{
 		  SCM key;
 		  SCM value;
 
 		  key = SCM_CAAR (alist);
 		  value = SCM_CDAR (alist);
-		  if (   (weak_keys && SCM_FREE_CELL_P (key))
+		  if (   (weak_keys && UNMARKED_CELL_P (key))
-			 || (weak_values && SCM_FREE_CELL_P (value)))
+			 || (weak_values && UNMARKED_CELL_P (value)))
 		    {
 		      *fixup = SCM_CDR (alist);
 		    }