This is the mail archive of the guile@sourceware.cygnus.com mailing list for the Guile project.


Index Nav: [Date Index] [Subject Index] [Author Index] [Thread Index]
Message Nav: [Date Prev] [Date Next] [Thread Prev] [Thread Next]

Re: SCM_DEBUG_FREELIST


Hello everybody!


Here comes extremely good news:  With the enclosed patch, guile offers the
possibility to detect dropped heap references and references to non-heap
areas exhaustively.


On Fri, 23 Jun 2000, Dirk Herrmann wrote:

> 2) when doing (set-debug-cell-accesses! <some number>) for numbers smaller
>    than 20, the system seems to run into some endless loop.  Again, your ideas
>    are welcomed to figure out why this happens.

Solved!

The reason for this effect was, that there are a couple of cell accesses
which are not enclosed within

  ++scm_gc_heap_lock
  ...
  --scm_gc_heap_lock

but which are performed with every gc.  Thus, the scm_check_cell function
would decrement its counter again, even before the gc was _really_
finished.  Thus, a new gc was started immediately after.  There were
actually two different sides to this story:

* scm_gc_heap_lock is not immediately set when scm_igc is entered, but
  rather somewhere in the middle of scm_igc.  I have fixed this by
  introducing a variable scm_gc_running_p which is set at the very
  beginning of scm_igc and cleared at the very end.  The cell checks are
  not performed if scm_gc_running_p is true.

* at the end of the gc, scm_system_async_mark is called on the
  scm_gc_async.  This async, however, only performs the functions in
  scm_after_gc_hook, which are also performed at the end of the gc anyway.
  I have removed that scm_gc_async, so everything works now.  But:  I am
  not really sure that removing that async is OK.  It would be great if
  someone could take a look at the use of scm_gc_async in current cvs and
  see if I am right that this can be removed.

So, with the new set of patches you can do (set-debug-cell-accesses! 1),
which means that for every single cell access a garbage collection is
performed.  This will allow to perform extremely fine grained debugging of
heap references!!!  However, after (set-debug-cell-accesses! 1) is done,
even just pressing return on the repl takes 28 seconds on my
machine :-)  Thus, you will only want to enable the exhaustive checking
for short sequences of the code where you suspect inadequate object
protection.


Some notes about the patch:
- Since there is no gc async any more, I have moved the initialization of
  scm_asyncs to async.c.
- at the end of the gc, scm_gc_end is called, which was responsible for
  activating the scm_gc_async.  This call is removed, and instead the
  functionality of the async is performed explicitly within scm_igc.
- There are a couple of macros added that are to be used when working on
  free cells.  Remember:  SCM_CELL_WORD_* will abort when accessing a free
  cell.  Thus, when it is known that a free cell is accessed, use
  SCM_FREE_CELL* and friends.
- I made SCM_CELL_WORD* and SCM_CELL_OBJECT* use const pointers.  Thus,
  code like the following will cause a compiler warning/error:
  SCM_CELL_WORD_0 (x) = v;
  The right way to do this is to use SCM_SET_CELL_WORD_0.  Fortunately,
  guile is already completely clean with respect to this usage!
- I suggest to deprecate SCM_FREEP and SCM_NFREEP and use SCM_FREE_CELL_P
  instead.  The patch already contains that code.


However, I did not look into problem 1) of my previous mail any more, thus I
still don't know why there occur references to free cells during garbage
collection.  Thus, the patch disables cell access checking during garbage
collection completely.  In other words:  Cell accessing errors during garbage
collection can still not be found.


Best regards
Dirk



Index: libguile/async.c
===================================================================
RCS file: /cvs/guile/guile/guile-core/libguile/async.c,v
retrieving revision 1.46
diff -u -r1.46 async.c
--- async.c	2000/05/18 08:47:52	1.46
+++ async.c	2000/06/23 16:30:32
@@ -51,7 +51,6 @@
 #include "libguile/throw.h"
 #include "libguile/root.h"
 #include "libguile/smob.h"
-#include "libguile/gc.h"
 
 #include "libguile/validate.h"
 #include "libguile/async.h"
@@ -442,36 +441,6 @@
 #undef FUNC_NAME
 
 #endif
-
-
-/* points to the GC system-async, so that scm_gc_end can find it.  */
-SCM scm_gc_async;
-
-/* the vcell for gc-thunk.  */
-static SCM scm_gc_vcell;
-
-/* the thunk installed in the GC system-async, which is marked at the
-   end of garbage collection.  */
-static SCM
-scm_sys_gc_async_thunk (void)
-{
-  scm_c_run_hook (scm_after_gc_hook, SCM_EOL);
-
-#if (SCM_DEBUG_DEPRECATED == 0)
-
-  /* The following code will be removed in Guile 1.5.  */
-  if (SCM_NFALSEP (scm_gc_vcell))
-    {
-      SCM proc = SCM_CDR (scm_gc_vcell);
-
-      if (SCM_NFALSEP (proc) && !SCM_UNBNDP (proc))
-	scm_apply (proc, SCM_EOL, SCM_EOL);
-    }
-
-#endif  /* SCM_DEBUG_DEPRECATED == 0 */
-
-  return SCM_UNSPECIFIED;
-}
 
 
 
@@ -501,12 +470,9 @@
 void
 scm_init_async ()
 {
-  SCM a_thunk;
-  tc16_async = scm_make_smob_type_mfpe ("async", 0,
-                                           mark_async, NULL, NULL, NULL);
-  scm_gc_vcell = scm_sysintern ("gc-thunk", SCM_BOOL_F);
-  a_thunk = scm_make_gsubr ("%gc-thunk", 0, 0, 0, scm_sys_gc_async_thunk);
-  scm_gc_async = scm_system_async (a_thunk);
+  scm_asyncs = SCM_EOL;
+  tc16_async = scm_make_smob_type ("async", 0);
+  scm_set_smob_mark (tc16_async, mark_async);
 
 #include "libguile/async.x"
 }
Index: libguile/async.h
===================================================================
RCS file: /cvs/guile/guile/guile-core/libguile/async.h,v
retrieving revision 1.16
diff -u -r1.16 async.h
--- async.h	2000/04/05 15:28:28	1.16
+++ async.h	2000/06/23 16:30:32
@@ -49,11 +49,10 @@
 
 #include "libguile/__scm.h"
 
-
 
 
 extern unsigned int scm_mask_ints;
-extern SCM scm_gc_async;
+
 
 
 extern int scm_asyncs_pending (void);
Index: libguile/gc.c
===================================================================
RCS file: /cvs/guile/guile/guile-core/libguile/gc.c,v
retrieving revision 1.134
diff -u -r1.134 gc.c
--- gc.c	2000/06/20 02:37:22	1.134
+++ gc.c	2000/06/23 16:30:33
@@ -52,7 +52,6 @@
 #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"
@@ -84,6 +83,92 @@
 #endif
 
 
+
+static unsigned int scm_gc_running_p = 0;
+
+
+
+#if (SCM_DEBUG_CELL_ACCESSES == 1)
+
+static unsigned int debug_cells_p = 0;
+static unsigned int debug_cells_gc_counter = 0;
+static unsigned int debug_cells_gc_counter_init = 0;
+
+
+void
+scm_check_cell (SCM cell) 
+{
+  if (debug_cells_p)
+    {
+      debug_cells_p = 0;  /* disable to avoid recursion */
+
+      if (!scm_cellp (cell)) 
+	{
+	  abort ();
+	}
+      else if (!scm_gc_running_p)
+	{
+	  /* Dirk::FIXME:: (is the following comment correct?)
+	     During garbage collection there may occur references to free
+	     cells.
+	   */
+	  if (SCM_FREE_CELL_P (cell))
+	    {
+	      abort ();
+	    }
+
+	  /* Dirk:FIXME:: The test for scm_gc_running_p is required in order
+	     not to start garbage collection within an already running garbage
+	     collection.
+	  */
+	  if (debug_cells_gc_counter_init)
+	    {
+	      if (--debug_cells_gc_counter == 0)
+		{
+		  debug_cells_gc_counter = debug_cells_gc_counter_init;
+		  scm_igc ("scm_check_cell");
+		}
+	    }
+	}
+      debug_cells_p = 1;  /* re-enable */
+    }
+}
+
+
+SCM_DEFINE (scm_set_debug_cell_accesses_x, "set-debug-cell-accesses!", 1, 0, 0,
+            (SCM flag),
+            "If FLAG is #f, cell access checking is disabled.\n"
+            "If FLAG is #t, cell access checking is enabled, but no\n"
+	    "additional calls to garbage collection are issued.\n"
+	    "If FLAG is a number, cell access checking is enabled,\n"
+	    "with an additional garbage collection after the given\n"
+	    "number of cell accesses.\n"
+            "This procedure only exists because the compile-time flag\n"
+	    "SCM_DEBUG_CELL_ACCESSES was set to 1.\n")
+#define FUNC_NAME s_scm_set_debug_cell_accesses_x
+{
+  if (SCM_FALSEP (flag)) {
+    debug_cells_p = 0;
+  } else if (SCM_EQ_P (flag, SCM_BOOL_T)) {
+    debug_cells_gc_counter_init = 0;
+    debug_cells_p = 1;
+  } else if (SCM_INUMP (flag)) {
+    long int f = SCM_INUM (flag);
+    if (f <= 0) SCM_OUT_OF_RANGE(1, flag);
+    debug_cells_gc_counter_init = f;
+    debug_cells_gc_counter = f;
+    debug_cells_p = 1;
+  } else {
+    SCM_WRONG_TYPE_ARG (1, flag);
+  }
+  return SCM_UNSPECIFIED;
+}
+#undef FUNC_NAME
+
+#endif  /* SCM_DEBUG_CELL_ACCESSES == 1 */
+
+
+
 /* {heap tuning parameters}
  *
  * These are parameters for controlling memory allocation.  The heap
@@ -317,7 +402,7 @@
   int last_seg = -1, count = 0;
   SCM f;
 
-  for (f = freelist; SCM_NIMP (f); f = SCM_CDR (f))
+  for (f = freelist; !SCM_NULLP (f); f = SCM_FREE_CELL_CDR (f))
     {
       int this_seg = which_seg (f);
 
@@ -368,8 +453,8 @@
 {
   SCM ls;
   int n = 0;
-  for (ls = freelist; SCM_NNULLP (ls); ls = SCM_CDR (ls))
-    if (SCM_CELL_TYPE (ls) == scm_tc_free_cell)
+  for (ls = freelist; !SCM_NULLP (ls); ls = SCM_FREE_CELL_CDR (ls))
+    if (SCM_FREE_CELL_P (ls))
       ++n;
     else
       {
@@ -444,8 +529,8 @@
   SCM f;
   int i = 0;
 
-  for (f = freelist; SCM_NIMP (f); f = SCM_CDR (f), i++)
-    if (SCM_CAR (f) != (SCM) scm_tc_free_cell)
+  for (f = freelist; !SCM_NULLP (f); f = SCM_FREE_CELL_CDR (f), i++)
+    if (!SCM_FREE_CELL_P (f))
       {
 	fprintf (stderr, "Bad cell in freelist on newcell %lu: %d'th elt\n",
 		 scm_newcell_count, i);
@@ -483,13 +568,13 @@
 
   /* The rest of this is supposed to be identical to the SCM_NEWCELL
      macro.  */
-  if (SCM_IMP (scm_freelist))
+  if (SCM_NULLP (scm_freelist))
     new = scm_gc_for_newcell (&scm_master_freelist, &scm_freelist);
   else
     {
       new = scm_freelist;
-      scm_freelist = SCM_CDR (scm_freelist);
-      SCM_SETCAR (new, scm_tc16_allocated);
+      scm_freelist = SCM_FREE_CELL_CDR (scm_freelist);
+      SCM_SET_FREE_CELL_TYPE (new, scm_tc16_allocated);
     }
 
   return new;
@@ -509,13 +594,13 @@
 
   /* The rest of this is supposed to be identical to the SCM_NEWCELL
      macro.  */
-  if (SCM_IMP (scm_freelist2))
+  if (SCM_NULLP (scm_freelist2))
     new = scm_gc_for_newcell (&scm_master_freelist2, &scm_freelist2);
   else
     {
       new = scm_freelist2;
-      scm_freelist2 = SCM_CDR (scm_freelist2);
-      SCM_SETCAR (new, scm_tc16_allocated);
+      scm_freelist2 = SCM_FREE_CELL_CDR (scm_freelist2);
+      SCM_SET_FREE_CELL_TYPE (new, scm_tc16_allocated);
     }
 
   return new;
@@ -538,7 +623,7 @@
 freelist_length (SCM freelist)
 {
   int n;
-  for (n = 0; SCM_NNULLP (freelist); freelist = SCM_CDR (freelist))
+  for (n = 0; !SCM_NULLP (freelist); freelist = SCM_FREE_CELL_CDR (freelist))
     ++n;
   return n;
 }
@@ -624,7 +709,6 @@
 {
   scm_gc_rt = SCM_INUM (scm_get_internal_run_time ()) - scm_gc_rt;
   scm_gc_time_taken += scm_gc_rt;
-  scm_system_async_mark (scm_gc_async);
 }
 
 
@@ -725,8 +809,8 @@
     }
   while (SCM_NULLP (cell));
   --scm_ints_disabled;
-  *freelist = SCM_CDR (cell);
-  SCM_SET_CELL_TYPE (cell, scm_tc16_allocated);
+  *freelist = SCM_FREE_CELL_CDR (cell);
+  SCM_SET_FREE_CELL_TYPE (cell, scm_tc16_allocated);
   return cell;
 }
 
@@ -759,6 +843,8 @@
 {
   int j;
 
+  ++scm_gc_running_p;
+
   scm_c_hook_run (&scm_before_gc_c_hook, 0);
 #ifdef DEBUGINFO
   fprintf (stderr,
@@ -778,6 +864,7 @@
   if (!scm_stack_base || scm_block_gc)
     {
       scm_gc_end ();
+      --scm_gc_running_p;
       return;
     }
 
@@ -899,6 +986,8 @@
   SCM_THREAD_CRITICAL_SECTION_END;
 #endif
   scm_c_hook_run (&scm_after_gc_c_hook, 0);
+
+  --scm_gc_running_p;
 }
 
 
@@ -922,7 +1011,7 @@
     return;
 
 gc_mark_nimp:
-  if (SCM_NCELLP (ptr))
+  if (!SCM_CELLP (ptr))
     scm_wta (ptr, "rogue pointer in heap", NULL);
 
   switch (SCM_TYP7 (ptr))
@@ -1262,7 +1351,17 @@
 		  }
 		if (scm_heap_table[seg_id].span == 1
 		    || SCM_DOUBLE_CELLP (* (SCM *) &x[m]))
-		  scm_gc_mark (* (SCM *) &x[m]);
+		  {
+#if (SCM_DEBUG_CELL_ACCESSES == 1)
+		    /* We might stumble over pointers to free cells.  We don't
+		       want to access these if cell access debugging is
+		       enabled.
+		    */
+		    if (SCM_FREE_CELL_P (* (SCM *) &x[m]))
+		      break;
+#endif
+		    scm_gc_mark (* (SCM *) &x[m]);
+		  }
 		break;
 	      }
 
@@ -1322,7 +1421,7 @@
 {
   int collected;
   *freelist->clustertail = freelist->cells;
-  if (SCM_NNULLP (freelist->cells))
+  if (!SCM_NULLP (freelist->cells))
     {
       SCM c = freelist->cells;
       SCM_SETCAR (c, SCM_CDR (c));
@@ -1573,7 +1672,7 @@
 	    sweeperr:scm_wta (scmptr, "unknown type in ", "gc_sweep");
 	    }
 #if 0
-	  if (SCM_CAR (scmptr) == (SCM) scm_tc_free_cell)
+	  if (SCM_FREE_CELL_P (scmptr))
 	    exit (2);
 #endif
 	  if (!--left_to_collect)
@@ -1593,7 +1692,7 @@
 		 conservative collector might trace it as some other type
 		 of object.  */
 	      SCM_SET_CELL_TYPE (scmptr, scm_tc_free_cell);
-	      SCM_SETCDR (scmptr, nfreelist);
+	      SCM_SET_FREE_CELL_CDR (scmptr, nfreelist);
 	      nfreelist = scmptr;
 	    }
 
@@ -1925,11 +2024,11 @@
 	    SCM scmptr = PTR2SCM (ptr);
 
 	    SCM_SET_CELL_TYPE (scmptr, scm_tc_free_cell);
-	    SCM_SETCDR (scmptr, PTR2SCM (ptr + span));
+	    SCM_SET_FREE_CELL_CDR (scmptr, PTR2SCM (ptr + span));
 	    ptr += span;
 	  }
 
-	SCM_SETCDR (PTR2SCM (ptr - span), SCM_EOL);
+	SCM_SET_FREE_CELL_CDR (PTR2SCM (ptr - span), SCM_EOL);
       }
 
     /* Patch up the last cluster pointer in the segment
@@ -2331,7 +2430,6 @@
   scm_stand_in_procs = SCM_EOL;
   scm_permobjs = SCM_EOL;
   scm_protects = scm_make_vector (SCM_MAKINUM (31), SCM_EOL);
-  scm_asyncs = SCM_EOL;
   scm_sysintern ("most-positive-fixnum", SCM_MAKINUM (SCM_MOST_POSITIVE_FIXNUM));
   scm_sysintern ("most-negative-fixnum", SCM_MAKINUM (SCM_MOST_NEGATIVE_FIXNUM));
 #ifdef SCM_BIGDIG
Index: libguile/gc.h
===================================================================
RCS file: /cvs/guile/guile/guile-core/libguile/gc.h,v
retrieving revision 1.53
diff -u -r1.53 gc.h
--- gc.h	2000/06/20 14:57:35	1.53
+++ gc.h	2000/06/23 16:30:33
@@ -85,40 +85,45 @@
 /* Low level cell data accessing macros:
  */
 
-#if SCM_DEBUG_CELL_ACCESSES == 1
-#define SCM_VALIDATE_CELL(cell, expr) \
-  (!scm_cellp (cell) ? abort (), 0 : (expr))
+#define SCM_FREE_CELL_P(x) \
+  (!SCM_IMP (x) && (* (const scm_bits_t *) SCM2PTR (x) == scm_tc_free_cell))
+#define SCM_FREE_CELL_CDR(x) \
+  (((const scm_bits_t *) SCM2PTR (x)) [1])
+#define SCM_SET_FREE_CELL_TYPE(x, v) \
+  (((scm_bits_t *) SCM2PTR (x)) [0] = (v))
+#define SCM_SET_FREE_CELL_CDR(x, v) \
+  (((scm_bits_t *) SCM2PTR (x)) [1] = (v))
+
+#if (SCM_DEBUG_CELL_ACCESSES == 1)
+   extern void scm_check_cell (SCM);
+#  define SCM_VALIDATE_CELL(cell, expr) (scm_check_cell (cell), (expr))
 #else
-#define SCM_VALIDATE_CELL(cell, expr) expr
+#  define SCM_VALIDATE_CELL(cell, expr) expr
 #endif
 
-#define SCM_CELL_WORD(x, n)					\
-    SCM_VALIDATE_CELL ((x),					\
-		       ((scm_bits_t *) SCM2PTR (x)) [n])
+#define SCM_CELL_WORD(x, n) \
+  SCM_VALIDATE_CELL ((x), ((const scm_bits_t *) SCM2PTR (x)) [n])
 #define SCM_CELL_WORD_0(x) SCM_CELL_WORD (x, 0)
 #define SCM_CELL_WORD_1(x) SCM_CELL_WORD (x, 1)
 #define SCM_CELL_WORD_2(x) SCM_CELL_WORD (x, 2)
 #define SCM_CELL_WORD_3(x) SCM_CELL_WORD (x, 3)
 
-#define SCM_CELL_OBJECT(x, n)						\
-    SCM_VALIDATE_CELL ((x),						\
-		       SCM_PACK (((scm_bits_t *) SCM2PTR (x)) [n]))
+#define SCM_CELL_OBJECT(x, n) \
+  SCM_VALIDATE_CELL ((x), SCM_PACK (((const scm_bits_t *) SCM2PTR (x)) [n]))
 #define SCM_CELL_OBJECT_0(x) SCM_CELL_OBJECT (x, 0)
 #define SCM_CELL_OBJECT_1(x) SCM_CELL_OBJECT (x, 1)
 #define SCM_CELL_OBJECT_2(x) SCM_CELL_OBJECT (x, 2)
 #define SCM_CELL_OBJECT_3(x) SCM_CELL_OBJECT (x, 3)
 
-#define SCM_SET_CELL_WORD(x, n, v)					    \
-    SCM_VALIDATE_CELL ((x),						    \
-		       ((scm_bits_t *) SCM2PTR (x)) [n] = (scm_bits_t) (v))
+#define SCM_SET_CELL_WORD(x, n, v) \
+  SCM_VALIDATE_CELL ((x), ((scm_bits_t *) SCM2PTR (x)) [n] = (scm_bits_t) (v))
 #define SCM_SET_CELL_WORD_0(x, v) SCM_SET_CELL_WORD (x, 0, v)
 #define SCM_SET_CELL_WORD_1(x, v) SCM_SET_CELL_WORD (x, 1, v)
 #define SCM_SET_CELL_WORD_2(x, v) SCM_SET_CELL_WORD (x, 2, v)
 #define SCM_SET_CELL_WORD_3(x, v) SCM_SET_CELL_WORD (x, 3, v)
 
-#define SCM_SET_CELL_OBJECT(x, n, v)					  \
-    SCM_VALIDATE_CELL ((x),						  \
-		       ((scm_bits_t *) SCM2PTR (x)) [n] = SCM_UNPACK (v))
+#define SCM_SET_CELL_OBJECT(x, n, v) \
+  SCM_VALIDATE_CELL ((x), ((scm_bits_t *) SCM2PTR (x)) [n] = SCM_UNPACK (v))
 #define SCM_SET_CELL_OBJECT_0(x, v) SCM_SET_CELL_OBJECT (x, 0, v)
 #define SCM_SET_CELL_OBJECT_1(x, v) SCM_SET_CELL_OBJECT (x, 1, v)
 #define SCM_SET_CELL_OBJECT_2(x, v) SCM_SET_CELL_OBJECT (x, 2, v)
@@ -136,9 +141,9 @@
 #define SCM_SETOR_CDR(x, y)\
   (SCM_SETCDR ((x), SCM_PACK (SCM_UNPACK (SCM_CDR (x)) | (y))))
 
-#define SCM_CELL_WORD_LOC(x, n) (&SCM_CELL_WORD (x, n))
-#define SCM_CARLOC(x) ((SCM *) (&(((scm_bits_t *) SCM2PTR (x)) [0])))
-#define SCM_CDRLOC(x) ((SCM *) (&(((scm_bits_t *) SCM2PTR (x)) [1])))
+#define SCM_CELL_WORD_LOC(x, n) ((scm_bits_t *) & SCM_CELL_WORD (x, n))
+#define SCM_CARLOC(x) ((SCM *) SCM_CELL_WORD_LOC ((x), 0))
+#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
@@ -150,7 +155,6 @@
 #define SCM_PTR_GE(x, y) (!SCM_PTR_LT (x, y))
 
 
-/* Dirk:FIXME:: */
 /* Freelists consist of linked cells where the type entry holds the value
  * scm_tc_free_cell and the second entry holds a pointer to the next cell of
  * the freelist.  Due to this structure, freelist cells are not cons cells
@@ -178,8 +182,8 @@
           else \
             { \
                _into = scm_freelist; \
-               scm_freelist = SCM_CDR (scm_freelist); \
-               SCM_SET_CELL_TYPE (_into, scm_tc16_allocated); \
+               scm_freelist = SCM_FREE_CELL_CDR (scm_freelist); \
+               SCM_SET_FREE_CELL_TYPE (_into, scm_tc16_allocated); \
             } \
         } while(0)
 #define SCM_NEWCELL2(_into) \
@@ -190,16 +194,13 @@
           else \
             { \
                _into = scm_freelist2; \
-               scm_freelist2 = SCM_CDR (scm_freelist2); \
-               SCM_SET_CELL_TYPE (_into, scm_tc16_allocated); \
+               scm_freelist2 = SCM_FREE_CELL_CDR (scm_freelist2); \
+               SCM_SET_FREE_CELL_TYPE (_into, scm_tc16_allocated); \
             } \
         } while(0)
 #endif
 
 
-#define SCM_FREEP(x) (SCM_NIMP (x) && (SCM_CELL_TYPE (x) == scm_tc_free_cell))
-#define SCM_NFREEP(x) (!SCM_FREEP (x))
-
 /* 1. This shouldn't be used on immediates.
    2. It thinks that subrs are always unmarked (harmless). */
 #define SCM_MARKEDP(x) ((SCM_CELL_TYPE (x) & 5) == 5 \
@@ -286,6 +287,16 @@
                              scm_sizet init_heap2_size, int trig2,
 			     scm_sizet max_segment_size);
 extern void scm_init_gc (void);
+
+
+
+#if (SCM_DEBUG_DEPRECATED == 0)
+
+#define SCM_FREEP(x) (SCM_FREE_CELL_P (x))
+#define SCM_NFREEP(x) (!SCM_FREE_CELL_P (x))
+
+#endif  /* SCM_DEBUG_DEPRECATED == 0 */
+
 #endif  /* GCH */
 
 /*
Index: libguile/weaks.c
===================================================================
RCS file: /cvs/guile/guile/guile-core/libguile/weaks.c,v
retrieving revision 1.26
diff -u -r1.26 weaks.c
--- weaks.c	2000/05/05 11:10:57	1.26
+++ weaks.c	2000/06/23 16:30:33
@@ -264,7 +264,7 @@
 	  ptr = SCM_VELTS (w);
 	  n = SCM_LENGTH (w);
 	  for (j = 0; j < n; ++j)
-	    if (SCM_FREEP (ptr[j]))
+	    if (SCM_FREE_CELL_P (ptr[j]))
 	      ptr[j] = SCM_BOOL_F;
 	}
       else /* if (SCM_IS_WHVEC_ANY (scm_weak_vectors[i])) */
@@ -296,8 +296,8 @@
 
 		  key = SCM_CAAR (alist);
 		  value = SCM_CDAR (alist);
-		  if (   (weak_keys && SCM_FREEP (key))
-			 || (weak_values && SCM_FREEP (value)))
+		  if (   (weak_keys && SCM_FREE_CELL_P (key))
+			 || (weak_values && SCM_FREE_CELL_P (value)))
 		    {
 		      *fixup = SCM_CDR (alist);
 		    }


Index Nav: [Date Index] [Subject Index] [Author Index] [Thread Index]
Message Nav: [Date Prev] [Date Next] [Thread Prev] [Thread Next]