* inline.h: include stdio.h

* smob.c (free_print): abort if scm_debug_cell_accesses_p is set

libguile/ChangeLog

@@ -1,3 +1,9 @@
+2002-09-08  Han-Wen Nienhuys  <hanwen@cs.uu.nl>
+
+	* inline.h: include stdio.h
+
+	* smob.c (free_print): abort if scm_debug_cell_accesses_p is set
+
 2002-09-05  Han-Wen Nienhuys  <hanwen@cs.uu.nl>
 
 	* gc-segment.c (scm_i_make_initial_segment): check user settings
@@ -5,15 +11,14 @@
 
 	* gc-malloc.c (scm_gc_init_malloc): check user settings for
 	sanity.
-	(scm_gc_register_collectable_memory): prevent overflow of memory
-	counts.
 
 	* gc-freelist.c (scm_init_freelist): check user settings for sanity. 
 
 	* struct.h: change scm_structs_to_free to scm_i_structs_to_free
 
 	* gc-malloc.c (scm_gc_register_collectable_memory): use floats;
-	these won't ever wrap around with high memory usage.
+	these won't ever wrap around with high memory usage. Thanks to
+	Sven Hartrumpf for finding this.
 
 	* gc-freelist.c: include <stdio.h>
 

libguile/gc-card.c

@@ -327,6 +327,13 @@ scm_i_init_card_freelist (scm_t_cell *  card, SCM *free_list,
 }
 
 
+#if (SCM_DEBUG_CELL_ACCESSES == 1)
+int
+scm_gc_marked_p (SCM obj)
+{
+  return SCM_GC_MARK_P(obj);
+}
+#endif
 
 #if 0
 /*
@@ -355,11 +362,6 @@ typedef struct scm_t_double_cell
 } scm_t_double_cell;
 
 
-int
-scm_gc_marked_p (SCM obj)
-{
-  return SCM_GC_MARK_P(obj);
-}
 
 scm_t_cell *
 scm_gc_get_card (SCM obj)

libguile/gc.c

@@ -239,7 +239,7 @@ SCM_DEFINE (scm_set_debug_cell_accesses_x, "set-debug-cell-accesses!", 1, 0, 0,
   /*
     do nothing
    */
-
+  fprintf (stderr, "\nWARNING: GUILE was not compiled with SCM_DEBUG_CELL_ACCESSES");
   scm_remember_upto_here (flag);
   return SCM_UNSPECIFIED;
 }

libguile/gc.h

@@ -251,6 +251,7 @@ typedef unsigned long scm_t_c_bvec_long;
 SCM_API int scm_debug_cell_accesses_p;
 SCM_API int scm_expensive_debug_cell_accesses_p;
 SCM_API int scm_debug_cells_gc_interval ;
+void scm_i_expensive_validation_check (SCM cell);
 #endif
 
 SCM_API int scm_block_gc;

libguile/inline.h

@@ -50,6 +50,11 @@
 */
 
 
+#if (SCM_DEBUG_CELL_ACCESSES == 1)
+#include <stdio.h>
+
+#endif
+
 #include "libguile/pairs.h"
 #include "libguile/gc.h"
 
@@ -94,20 +99,31 @@ scm_cell (scm_t_bits car, scm_t_bits cdr)
 
 #if (SCM_DEBUG_CELL_ACCESSES == 1)
     if (scm_debug_cell_accesses_p)
-    {
+      {
-      if (SCM_GC_MARK_P (z))
+	if (SCM_GC_MARK_P (z))
-	{
+	  {
-	  fprintf(stderr, "scm_cell tried to allocate a marked cell.\n");
+	    fprintf(stderr, "scm_cell tried to allocate a marked cell.\n");
-	  abort();
+	    abort();
-	}
+	  }
-      else if (SCM_GC_CELL_TYPE(z) != scm_tc_free_cell)
+	else if (SCM_GC_CELL_TYPE(z) != scm_tc_free_cell)
-	{
+	  {
-	  fprintf(stderr, "cell from freelist is not a free cell.\n");
+	    fprintf(stderr, "cell from freelist is not a free cell.\n");
-	  abort();
+	    abort();
-	}
+	  }
+      }
+
+    /*
+      Always set mark. Otherwise cells that are alloced before
+      scm_debug_cell_accesses_p is toggled seem invalid.
+    */
+    SCM_SET_GC_MARK (z);
+
+    /*
+      TODO: figure out if this use of mark bits is valid with
+      threading. What if another thread is doing GC at this point
+      ... ?
+     */
       
-      SCM_SET_GC_MARK (z);
-    }
 #endif
 
   

libguile/smob.c

@@ -473,11 +473,16 @@ static int
 free_print (SCM exp, SCM port, scm_print_state *pstate SCM_UNUSED)
 {
   char buf[100];
-
   sprintf (buf, "#<freed cell %p; GC missed a reference>",
 	   (void *) SCM_UNPACK (exp));
   scm_puts (buf, port);
   
+#if (SCM_DEBUG_CELL_ACCESSES == 1)
+  if (scm_debug_cell_accesses_p)
+    abort();
+#endif
+  
+
   return 1;
 }