guile/guile-core/libguile gc.h gc.c

[Marius Vollmer]

CVSROOT:        /cvs
Module name:    guile
Changes by:     Marius Vollmer <address@hidden> 01/11/25 10:00:31

Modified files:
        guile-core/libguile: gc.h gc.c 

Log message:
        (SCM_GC_SET_ALLOCATED, scm_debug_newcell,
        scm_debug_newcell2, scm_tc16_allocated): Removed from header.
        (scm_deprecated_newcell, scm_deprecated_newcell2): New.
        (SCM_NEWCELL, SCM_NEWCELL2): Implement in terms of
        scm_deprecated_newcell and scm_deprecated_newcell2.
        
        gc.c (scm_tc16_allocated): Only define when including deprecated
        features.
        (scm_debug_newcell, scm_debug_newcell2): Removed.
        (scm_init_storage): Do not initialize scm_tc16_allocated.
        (scm_init_gc): Do it here.
        (allocated_mark): New, from old code.
        (scm_deprecated_newcell, scm_deprecated_newcell2): New.

CVSWeb URLs:
http://savannah.gnu.org/cgi-bin/viewcvs/guile/guile-core/libguile/gc.h.diff?cvsroot=OldCVS&tr1=1.84&tr2=1.85&r1=text&r2=text
http://savannah.gnu.org/cgi-bin/viewcvs/guile/guile-core/libguile/gc.c.diff?cvsroot=OldCVS&tr1=1.220&tr2=1.221&r1=text&r2=text

Patches:
Index: guile/guile-core/libguile/gc.c
diff -u guile/guile-core/libguile/gc.c:1.220 
guile/guile-core/libguile/gc.c:1.221
--- guile/guile-core/libguile/gc.c:1.220        Thu Nov  1 19:09:28 2001
+++ guile/guile-core/libguile/gc.c      Sun Nov 25 10:00:31 2001
@@ -107,8 +107,6 @@
 
 #if (SCM_DEBUG_CELL_ACCESSES == 1)
 
-scm_t_bits scm_tc16_allocated;
-
 /* Set this to != 0 if every cell that is accessed shall be checked:
  */
 unsigned int scm_debug_cell_accesses_p = 1;
@@ -695,65 +693,6 @@
 }
 #undef FUNC_NAME
 
-
-SCM
-scm_debug_newcell (void)
-{
-  SCM new;
-
-  scm_newcell_count++;
-  if (scm_debug_check_freelist)
-    {
-      scm_check_freelist (scm_freelist);
-      scm_gc();
-    }
-
-  /* The rest of this is supposed to be identical to the SCM_NEWCELL
-     macro.  */
-  if (SCM_NULLP (scm_freelist))
-    {
-      new = scm_gc_for_newcell (&scm_master_freelist, &scm_freelist);
-      SCM_GC_SET_ALLOCATED (new);
-    }
-  else
-    {
-      new = scm_freelist;
-      scm_freelist = SCM_FREE_CELL_CDR (scm_freelist);
-      SCM_GC_SET_ALLOCATED (new);
-    }
-
-  return new;
-}
-
-SCM
-scm_debug_newcell2 (void)
-{
-  SCM new;
-
-  scm_newcell2_count++;
-  if (scm_debug_check_freelist)
-    {
-      scm_check_freelist (scm_freelist2);
-      scm_gc ();
-    }
-
-  /* The rest of this is supposed to be identical to the SCM_NEWCELL
-     macro.  */
-  if (SCM_NULLP (scm_freelist2))
-    {
-      new = scm_gc_for_newcell (&scm_master_freelist2, &scm_freelist2);
-      SCM_GC_SET_ALLOCATED (new);
-    }
-  else
-    {
-      new = scm_freelist2;
-      scm_freelist2 = SCM_FREE_CELL_CDR (scm_freelist2);
-      SCM_GC_SET_ALLOCATED (new);
-    }
-
-  return new;
-}
-
 #endif /* GUILE_DEBUG_FREELIST */
 
 
@@ -2703,10 +2642,6 @@
   size_t init_heap_size_2;
   size_t j;
 
-#if (SCM_DEBUG_CELL_ACCESSES == 1)
-  scm_tc16_allocated = scm_make_smob_type ("allocated cell", 0);
-#endif  /* SCM_DEBUG_CELL_ACCESSES == 1 */
-
   j = SCM_NUM_PROTECTS;
   while (j)
     scm_sys_protects[--j] = SCM_BOOL_F;
@@ -2829,11 +2764,63 @@
   return NULL;
 }
 
+#if SCM_ENABLE_DEPRECATED == 1
+
+/* If an allocated cell is detected during garbage collection, this
+ * means that some code has just obtained the object but was preempted
+ * before the initialization of the object was completed.  This meanst
+ * that some entries of the allocated cell may already contain SCM
+ * objects.  Therefore, allocated cells are scanned conservatively.
+ */
+
+scm_t_bits scm_tc16_allocated;
+
+static SCM
+allocated_mark (SCM cell)
+{
+  unsigned long int cell_segment = heap_segment (cell);
+  unsigned int span = scm_heap_table[cell_segment].span;
+  unsigned int i;
+
+  for (i = 1; i != span * 2; ++i)
+    {
+      SCM obj = SCM_CELL_OBJECT (cell, i);
+      long int obj_segment = heap_segment (obj);
+      if (obj_segment >= 0)
+       scm_gc_mark (obj);
+    }
+  return SCM_BOOL_F;
+}
+
+SCM
+scm_deprecated_newcell (void)
+{
+  scm_c_issue_deprecation_warning 
+    ("SCM_NEWCELL is deprecated.  Use `scm_alloc_cell' instead.\n");
+
+  return scm_alloc_cell (scm_tc16_allocated, 0);
+}
 
+SCM
+scm_deprecated_newcell2 (void)
+{
+  scm_c_issue_deprecation_warning 
+    ("SCM_NEWCELL2 is deprecated.  Use `scm_alloc_double_cell' instead.\n");
+
+  return scm_alloc_double_cell (scm_tc16_allocated, 0, 0, 0);
+}
+
+#endif /* SCM_ENABLE_DEPRECATED == 1 */
+
 void
 scm_init_gc ()
 {
   SCM after_gc_thunk;
+
+#if SCM_ENABLE_DEPRECATED == 1
+  scm_tc16_allocated = scm_make_smob_type ("allocated cell", 0);
+  scm_set_smob_mark (scm_tc16_allocated, allocated_mark);
+#endif
 
   scm_after_gc_hook = scm_permanent_object (scm_make_hook (SCM_INUM0));
   scm_c_define ("after-gc-hook", scm_after_gc_hook);
Index: guile/guile-core/libguile/gc.h
diff -u guile/guile-core/libguile/gc.h:1.84 guile/guile-core/libguile/gc.h:1.85
--- guile/guile-core/libguile/gc.h:1.84 Fri Nov 16 10:04:17 2001
+++ guile/guile-core/libguile/gc.h      Sun Nov 25 10:00:30 2001
@@ -245,57 +245,10 @@
   (((scm_t_bits *) SCM2PTR (x)) [1] = SCM_UNPACK (v))
 
 
-#if (SCM_DEBUG_CELL_ACCESSES == 1)
-#  define SCM_GC_SET_ALLOCATED(x) \
-     (((scm_t_bits *) 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)
-#else
-/* When we introduce POSIX threads support, every thread will have
-   a freelist of its own.  */
-#define SCM_NEWCELL(_into) \
-        do { \
-          if (SCM_NULLP (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_NULLP (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
-
-
 #define SCM_MARKEDP    SCM_GCMARKP
 #define SCM_NMARKEDP(x) (!SCM_MARKEDP (x))
 
 #if (SCM_DEBUG_CELL_ACCESSES == 1)
-SCM_API scm_t_bits scm_tc16_allocated;
 SCM_API unsigned int scm_debug_cell_accesses_p;
 #endif
 
@@ -339,8 +292,6 @@
 SCM_API SCM scm_free_list_length (void);
 #endif
 #ifdef GUILE_DEBUG_FREELIST
-SCM_API SCM scm_debug_newcell (void);
-SCM_API SCM scm_debug_newcell2 (void);
 SCM_API SCM scm_gc_set_debug_check_freelist_x (SCM flag);
 #endif
 
@@ -388,6 +339,18 @@
 SCM_API int scm_init_storage (void);
 SCM_API void *scm_get_stack_base (void);
 SCM_API void scm_init_gc (void);
+
+#if SCM_ENABLE_DEPRECATED == 1
+
+SCM_API SCM scm_deprecated_newcell (void);
+SCM_API SCM scm_deprecated_newcell2 (void);
+
+#define SCM_NEWCELL(_into) \
+  do { _into = scm_deprecated_newcell (); } while (0)
+#define SCM_NEWCELL2(_into) \
+  do { _into = scm_deprecated_newcell2 (); } while (0)
+
+#endif
 
 #endif  /* SCM_GC_H */