#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;
}
#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 */
\f
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;
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);
(((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
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
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 */
/*