* Made SCM_DEBUG_CELL_ACCESSES working again.

NEWS

@@ -655,7 +655,8 @@ SCM_ROUCHARS, SCM_SETLENGTH, SCM_SETCHARS, SCM_LENGTH_MAX, SCM_GC8MARKP,
 SCM_SETGC8MARK, SCM_CLRGC8MARK, SCM_GCTYP16, SCM_GCCDR, SCM_SUBR_DOC,
 SCM_OPDIRP, SCM_VALIDATE_OPDIR, SCM_WTA, RETURN_SCM_WTA, SCM_CONST_LONG,
 SCM_WNA, SCM_FUNC_NAME, SCM_VALIDATE_NUMBER_COPY,
-SCM_VALIDATE_NUMBER_DEF_COPY, SCM_SLOPPY_CONSP, SCM_SLOPPY_NCONSP
+SCM_VALIDATE_NUMBER_DEF_COPY, SCM_SLOPPY_CONSP, SCM_SLOPPY_NCONSP,
+SCM_SETAND_CDR, SCM_SETOR_CDR
 
 Use SCM_ASSERT_RANGE or SCM_VALIDATE_XXX_RANGE instead of SCM_OUTOFRANGE.
 Use scm_memory_error instead of SCM_NALLOC.

RELEASE

@@ -69,7 +69,8 @@ In release 1.6:
   SCM_GC8MARKP, SCM_SETGC8MARK, SCM_CLRGC8MARK, SCM_GCTYP16, SCM_GCCDR,
   SCM_SUBR_DOC, SCM_OPDIRP, SCM_VALIDATE_OPDIR, SCM_WTA, RETURN_SCM_WTA,
   SCM_WNA, SCM_FUNC_NAME, SCM_VALIDATE_NUMBER_COPY,
-  SCM_VALIDATE_NUMBER_DEF_COPY, SCM_SLOPPY_CONSP, SCM_SLOPPY_NCONSP
+  SCM_VALIDATE_NUMBER_DEF_COPY, SCM_SLOPPY_CONSP, SCM_SLOPPY_NCONSP,
+  SCM_SETAND_CDR, SCM_SETOR_CDR
 - remove scm_vector_set_length_x
 - remove function scm_call_catching_errors
   (replaced by catch functions from throw.[ch])

libguile/ChangeLog

@@ -1,3 +1,47 @@
+2001-03-30  Dirk Herrmann  <D.Herrmann@tu-bs.de>
+
+	* gc.[ch] (scm_tc16_allocated):  New type tag for allocated cells.
+	It is only defined and used if guile is compiled with
+	SCM_DEBUG_CELL_ACCESSES set to true.  It's purpose is, to never
+	let cells with a free_cell type tag be visible outside of the
+	garbage collector when in debug mode.
+
+	* gc.c (scm_debug_cell_accesses_p):  Set to true as default.
+
+	(scm_assert_cell_valid):  Use a local static variable to avoid
+	recursion.
+
+	(MARK):  Only check for rogue cell pointers in debug mode.  Use
+	scm_cellp for this purpose and place all checks for rogue pointers
+	into that function.  Further, since due to conservative scanning
+	we may encounter free cells during marking, don't use the standard
+	cell type accessor macro to determine the cell type.
+
+	(scm_cellp):  Check if the cell pointer actually points into a
+	card header.
+
+	(scm_init_gc):  Initalize scm_tc16_allocated.
+
+	* gc.h (GCH):  Renamed to SCM_GC_H.
+
+	(SCM_VALIDATE_CELL):  Enclose the expression in brackets.  This
+	might be unnecessary, but I feel better this way :-)
+
+	(SCM_GC_CELL_TYPE):  New macro.
+
+	(SCM_SETAND_CDR, SCM_SETOR_CDR):  Deprecated.  These are not used
+	in guile, and it is unlikely that they will be applied to real
+	pairs anyway.
+
+	(SCM_SET_FREE_CELL_TYPE):  Removed.  It was not used.
+
+	(SCM_GC_SET_ALLOCATED):  New macro.  Only non-empty if guile is
+	compiled with SCM_DEBUG_CELL_ACCESSES set to true.
+
+	(SCM_NEWCELL, SCM_NEWCELL2):  Use of SCM_GC_SET_ALLOCATED will
+	make sure that in debug mode no free cell will ever be visible
+	outside of the garbage collector.
+
 2001-03-30  Dirk Herrmann  <D.Herrmann@tu-bs.de>
 
 	* async.c (scm_asyncs_pending):  Don't use != to compare SCM

libguile/gc.c

@@ -101,7 +101,11 @@ unsigned int scm_gc_running_p = 0;
 
 #if (SCM_DEBUG_CELL_ACCESSES == 1)
 
-unsigned int scm_debug_cell_accesses_p = 0;
+scm_bits_t scm_tc16_allocated;
+
+/* Set this to != 0 if every cell that is accessed shall be checked: 
+ */
+unsigned int scm_debug_cell_accesses_p = 1;
 
 
 /* Assert that the given object is a valid reference to a valid cell.  This
@@ -112,9 +116,11 @@ unsigned int scm_debug_cell_accesses_p = 0;
 void
 scm_assert_cell_valid (SCM cell)
 {
-  if (scm_debug_cell_accesses_p)
+  static unsigned int already_running = 0;
+
+  if (scm_debug_cell_accesses_p && !already_running)
     {
-      scm_debug_cell_accesses_p = 0;  /* disable to avoid recursion */
+      already_running = 1;  /* set to avoid recursion */
 
       if (!scm_cellp (cell))
 	{
@@ -138,7 +144,7 @@ scm_assert_cell_valid (SCM cell)
 	      abort ();
 	    }
 	}
-      scm_debug_cell_accesses_p = 1;  /* re-enable */
+      already_running = 0;  /* re-enable */
     }
 }
 
@@ -1120,6 +1126,7 @@ MARK (SCM p)
 {
   register long i;
   register SCM ptr;
+  scm_bits_t cell_type;
 
 #ifndef MARK_DEPENDENCIES
 # define RECURSE scm_gc_mark
@@ -1149,14 +1156,9 @@ gc_mark_nimp:
 gc_mark_loop_first_time:
 #endif
   
-  if (!SCM_CELLP (ptr))
+#if (SCM_DEBUG_CELL_ACCESSES == 1) || (defined (GUILE_DEBUG_FREELIST))
+  if (!scm_cellp (ptr))
     SCM_MISC_ERROR ("rogue pointer in heap", SCM_EOL);
-
-#if (defined (GUILE_DEBUG_FREELIST))
-
-  if (SCM_GC_IN_CARD_HEADERP (SCM2PTR (ptr)))
-    SCM_MISC_ERROR ("rogue pointer in heap", SCM_EOL);
-
 #endif
 
 #ifndef MARK_DEPENDENCIES
@@ -1168,7 +1170,8 @@ gc_mark_loop_first_time:
 
 #endif
 
-  switch (SCM_TYP7 (ptr))
+  cell_type = SCM_GC_CELL_TYPE (ptr);
+  switch (SCM_ITAG7 (cell_type))
     {
     case scm_tcs_cons_nimcar:
       if (SCM_IMP (SCM_CDR (ptr)))
@@ -1499,6 +1502,9 @@ scm_cellp (SCM value)
     unsigned int i = 0;
     unsigned int j = scm_n_heap_segs - 1;
 
+    if (SCM_GC_IN_CARD_HEADERP (ptr))
+      return 0;
+
     while (i < j) {
       int k = (i + j) / 2;
       if (SCM_PTR_GT (scm_heap_table[k].bounds[1], ptr)) {
@@ -2698,6 +2704,10 @@ scm_init_gc ()
 {
   SCM after_gc_thunk;
 
+#if (SCM_DEBUG_CELL_ACCESSES == 1)
+  scm_tc16_allocated = scm_make_smob_type ("allocated cell", 0);
+#endif  /* SCM_DEBUG_CELL_ACCESSES == 1 */
+
   scm_after_gc_hook = scm_create_hook ("after-gc-hook", 0);
 
 #if (SCM_DEBUG_DEPRECATED == 0)

libguile/gc.h

@@ -1,8 +1,8 @@
 /* classes: h_files */
 
-#ifndef GCH
+#ifndef SCM_GC_H
-#define GCH
+#define SCM_GC_H
-/* Copyright (C) 1995, 96, 98, 99, 2000 Free Software Foundation, Inc.
+/* Copyright (C) 1995,1996,1998,1999,2000,2001 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
@@ -173,7 +173,7 @@ typedef unsigned long scm_c_bvec_limb_t;
 #if (SCM_DEBUG_CELL_ACCESSES == 1)
 #  define SCM_VALIDATE_CELL(cell, expr) (scm_assert_cell_valid (cell), (expr))
 #else
-#  define SCM_VALIDATE_CELL(cell, expr) expr
+#  define SCM_VALIDATE_CELL(cell, expr) (expr)
 #endif
 
 #define SCM_CELL_WORD(x, n) \
@@ -207,14 +207,21 @@ typedef unsigned long scm_c_bvec_limb_t;
 #define SCM_CELL_TYPE(x) SCM_CELL_WORD_0 (x)
 #define SCM_SET_CELL_TYPE(x, t) SCM_SET_CELL_WORD_0 (x, t)
 
+
+/* Except for the garbage collector, no part of guile should ever run over a
+ * free cell.  Thus, in debug mode the above macros report an error if they
+ * are applied to a free cell.  Since the garbage collector is allowed to
+ * access free cells, it needs its own way to access cells which will not
+ * result in errors when in debug mode.  */
+
+#define SCM_GC_CELL_TYPE(x) \
+  (((const scm_bits_t *) SCM2PTR (x)) [0])
+
+
 #define SCM_SETAND_CAR(x, y) \
   (SCM_SETCAR ((x), SCM_PACK (SCM_UNPACK (SCM_CAR (x)) & (y))))
-#define SCM_SETAND_CDR(x, y)\
-  (SCM_SETCDR ((x), SCM_PACK (SCM_UNPACK (SCM_CDR (x)) & (y))))
 #define SCM_SETOR_CAR(x, y)\
   (SCM_SETCAR ((x), SCM_PACK (SCM_UNPACK (SCM_CAR (x)) | (y))))
-#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_bits_t *) & SCM_CELL_WORD (x, n))
 #define SCM_CARLOC(x) ((SCM *) SCM_CELL_WORD_LOC ((x), 0))
@@ -240,11 +247,17 @@ typedef unsigned long scm_c_bvec_limb_t;
   (!SCM_IMP (x) && (* (const scm_bits_t *) SCM2PTR (x) == scm_tc_free_cell))
 #define SCM_FREE_CELL_CDR(x) \
   (SCM_PACK (((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] = SCM_UNPACK (v))
 
+
+#if (SCM_DEBUG_CELL_ACCESSES == 1)
+#  define SCM_GC_SET_ALLOCATED(x) \
+     (((scm_bits_t *) SCM2PTR (x)) [0] = scm_tc16_allocated)
+#else
+#  define SCM_GC_SET_ALLOCATED(x)
+#endif
+
 #ifdef GUILE_DEBUG_FREELIST
 #define SCM_NEWCELL(_into) do { _into = scm_debug_newcell (); } while (0)
 #define SCM_NEWCELL2(_into) do { _into = scm_debug_newcell2 (); } while (0)
@@ -254,23 +267,31 @@ typedef unsigned long scm_c_bvec_limb_t;
 #define SCM_NEWCELL(_into) \
         do { \
           if (SCM_IMP (scm_freelist)) \
+            { \
              _into = scm_gc_for_newcell (&scm_master_freelist, \
                                          &scm_freelist); \
+             SCM_GC_SET_ALLOCATED (_into); \
+            } \
           else \
             { \
                _into = scm_freelist; \
                scm_freelist = SCM_FREE_CELL_CDR (scm_freelist); \
+               SCM_GC_SET_ALLOCATED (_into); \
             } \
         } while(0)
 #define SCM_NEWCELL2(_into) \
         do { \
           if (SCM_IMP (scm_freelist2)) \
+            { \
              _into = scm_gc_for_newcell (&scm_master_freelist2, \
                                          &scm_freelist2); \
+             SCM_GC_SET_ALLOCATED (_into); \
+            } \
           else \
             { \
                _into = scm_freelist2; \
                scm_freelist2 = SCM_FREE_CELL_CDR (scm_freelist2); \
+               SCM_GC_SET_ALLOCATED (_into); \
             } \
         } while(0)
 #endif
@@ -279,6 +300,11 @@ typedef unsigned long scm_c_bvec_limb_t;
 #define SCM_MARKEDP    SCM_GCMARKP
 #define SCM_NMARKEDP(x) (!SCM_MARKEDP (x))
 
+#if (SCM_DEBUG_CELL_ACCESSES == 1)
+extern scm_bits_t scm_tc16_allocated;
+extern unsigned int scm_debug_cell_accesses_p;
+#endif
+
 extern struct scm_heap_seg_data_t *scm_heap_table;
 extern int scm_n_heap_segs;
 extern int scm_block_gc;
@@ -314,12 +340,6 @@ extern scm_c_hook_t scm_before_sweep_c_hook;
 extern scm_c_hook_t scm_after_sweep_c_hook;
 extern scm_c_hook_t scm_after_gc_c_hook;
 
-#if (SCM_DEBUG_CELL_ACCESSES == 1)
-extern void scm_assert_cell_valid (SCM);
-extern unsigned int scm_debug_cell_accesses_p;
-extern SCM scm_set_debug_cell_accesses_x (SCM flag);
-#endif
-
 #if defined (GUILE_DEBUG) || defined (GUILE_DEBUG_FREELIST)
 extern SCM scm_map_free_list (void);
 extern SCM scm_free_list_length (void);
@@ -332,6 +352,10 @@ extern SCM scm_gc_set_debug_check_freelist_x (SCM flag);
 
 
 
+#if (SCM_DEBUG_CELL_ACCESSES == 1)
+extern void scm_assert_cell_valid (SCM);
+extern SCM scm_set_debug_cell_accesses_x (SCM flag);
+#endif
 extern SCM scm_object_address (SCM obj);
 extern SCM scm_unhash_name (SCM name);
 extern SCM scm_gc_stats (void);
@@ -370,6 +394,10 @@ extern void scm_init_gc (void);
 
 #if (SCM_DEBUG_DEPRECATED == 0)
 
+#define SCM_SETAND_CDR(x, y)\
+  (SCM_SETCDR ((x), SCM_PACK (SCM_UNPACK (SCM_CDR (x)) & (y))))
+#define SCM_SETOR_CDR(x, y)\
+  (SCM_SETCDR ((x), SCM_PACK (SCM_UNPACK (SCM_CDR (x)) | (y))))
 #define SCM_FREEP(x) (SCM_FREE_CELL_P (x))
 #define SCM_NFREEP(x) (!SCM_FREE_CELL_P (x))
 #define SCM_GC8MARKP(x) SCM_GCMARKP (x)
@@ -381,7 +409,7 @@ extern void scm_remember (SCM * ptr);
 
 #endif  /* SCM_DEBUG_DEPRECATED == 0 */
 
-#endif  /* GCH */
+#endif  /* SCM_GC_H */
 
 /*
   Local Variables: