summaryrefslogtreecommitdiff
path: root/libguile
diff options
context:
space:
mode:
Diffstat (limited to 'libguile')
-rw-r--r--libguile/gc.c117
-rw-r--r--libguile/gc.h61
2 files changed, 64 insertions, 114 deletions
diff --git a/libguile/gc.c b/libguile/gc.c
index de1b3ee0d..8abe7f5e0 100644
--- a/libguile/gc.c
+++ b/libguile/gc.c
@@ -107,8 +107,6 @@ unsigned int scm_gc_running_p = 0;
#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 @@ SCM_DEFINE (scm_gc_set_debug_check_freelist_x, "gc-set-debug-check-freelist!", 1
}
#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 @@ scm_init_storage ()
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,12 +2764,64 @@ mark_gc_async (void * hook_data SCM_UNUSED,
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);
diff --git a/libguile/gc.h b/libguile/gc.h
index 5e2a01ec4..e3f70519a 100644
--- a/libguile/gc.h
+++ b/libguile/gc.h
@@ -245,57 +245,10 @@ typedef unsigned long scm_t_c_bvec_limb;
(((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_map_free_list (void);
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
@@ -389,6 +340,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 */
/*