unsigned int scm_gc_running_p = 0;
-#if (SCM_DEBUG_CELL_ACCESSES == 1)
-
/* Set this to != 0 if every cell that is accessed shall be checked:
*/
-unsigned int scm_debug_cell_accesses_p = 1;
+int scm_debug_cell_accesses_p = 0;
+int scm_expensive_debug_cell_accesses_p = 0;
/* Set this to 0 if no additional gc's shall be performed, otherwise set it to
* the number of cell accesses after which a gc shall be called.
*/
-static unsigned int debug_cells_gc_interval = 0;
-
+int scm_debug_cells_gc_interval = 0;
-/* Assert that the given object is a valid reference to a valid cell. This
- * test involves to determine whether the object is a cell pointer, whether
- * this pointer actually points into a heap segment and whether the cell
- * pointed to is not a free cell. Further, additional garbage collections may
- * get executed after a user defined number of cell accesses. This helps to
- * find places in the C code where references are dropped for extremely short
- * periods.
+/*
+ Global variable, so you can switch it off at runtime by setting
+ scm_i_cell_validation_already_running.
*/
+int scm_i_cell_validation_already_running ;
+
+#if (SCM_DEBUG_CELL_ACCESSES == 1)
+
+
+/*
+
+ Assert that the given object is a valid reference to a valid cell. This
+ test involves to determine whether the object is a cell pointer, whether
+ this pointer actually points into a heap segment and whether the cell
+ pointed to is not a free cell. Further, additional garbage collections may
+ get executed after a user defined number of cell accesses. This helps to
+ find places in the C code where references are dropped for extremely short
+ periods.
+*/
void
-scm_assert_cell_valid (SCM cell)
+scm_i_expensive_validation_check (SCM cell)
{
- static unsigned int already_running = 0;
+ if (!scm_in_heap_p (cell))
+ {
+ fprintf (stderr, "scm_assert_cell_valid: this object does not live in the heap: %lux\n",
+ (unsigned long) SCM_UNPACK (cell));
+ abort ();
+ }
- if (!already_running)
+ /* If desired, perform additional garbage collections after a user
+ * defined number of cell accesses.
+ */
+ if (scm_debug_cells_gc_interval)
{
- already_running = 1; /* set to avoid recursion */
+ static unsigned int counter = 0;
+
+ if (counter != 0)
+ {
+ --counter;
+ }
+ else
+ {
+ counter = scm_debug_cells_gc_interval;
+ scm_i_thread_put_to_sleep ();
+ scm_igc ("scm_assert_cell_valid");
+ scm_i_thread_wake_up ();
+ }
+ }
+}
+
+void
+scm_assert_cell_valid (SCM cell)
+{
+ if (!scm_i_cell_validation_already_running && scm_debug_cell_accesses_p)
+ {
+ scm_i_cell_validation_already_running = 1; /* set to avoid recursion */
/*
- During GC, no user-code should be run, and the guile core should
- use non-protected accessors.
- */
+ During GC, no user-code should be run, and the guile core
+ should use non-protected accessors.
+ */
if (scm_gc_running_p)
- abort();
+ return;
/*
- Only scm_in_heap_p is wildly expensive.
- */
- if (scm_debug_cell_accesses_p)
- if (!scm_in_heap_p (cell))
- {
- fprintf (stderr, "scm_assert_cell_valid: this object does not live in the heap: %lux\n",
- (unsigned long) SCM_UNPACK (cell));
- abort ();
- }
+ Only scm_in_heap_p and rescanning the heap is wildly
+ expensive.
+ */
+ if (scm_expensive_debug_cell_accesses_p)
+ scm_i_expensive_validation_check (cell);
if (!SCM_GC_MARK_P (cell))
{
abort ();
}
-
- /* If desired, perform additional garbage collections after a user
- * defined number of cell accesses.
- */
- if (scm_debug_cell_accesses_p && debug_cells_gc_interval)
- {
- static unsigned int counter = 0;
-
- if (counter != 0)
- {
- --counter;
- }
- else
- {
- counter = debug_cells_gc_interval;
- scm_igc ("scm_assert_cell_valid");
- }
- }
- already_running = 0; /* re-enable */
+ scm_i_cell_validation_already_running = 0; /* re-enable */
}
}
+
SCM_DEFINE (scm_set_debug_cell_accesses_x, "set-debug-cell-accesses!", 1, 0, 0,
(SCM flag),
"If @var{flag} is @code{#f}, cell access checking is disabled.\n"
- "If @var{flag} is @code{#t}, cell access checking is enabled,\n"
+ "If @var{flag} is @code{#t}, cheap cell access checking is enabled,\n"
"but no additional calls to garbage collection are issued.\n"
- "If @var{flag} is a number, cell access checking is enabled,\n"
+ "If @var{flag} is a number, strict cell access checking is enabled,\n"
"with an additional garbage collection after the given\n"
"number of cell accesses.\n"
"This procedure only exists when the compile-time flag\n"
"@code{SCM_DEBUG_CELL_ACCESSES} was set to 1.")
#define FUNC_NAME s_scm_set_debug_cell_accesses_x
{
- if (SCM_FALSEP (flag)) {
- scm_debug_cell_accesses_p = 0;
- } else if (SCM_EQ_P (flag, SCM_BOOL_T)) {
- debug_cells_gc_interval = 0;
- scm_debug_cell_accesses_p = 1;
- } else if (SCM_INUMP (flag)) {
- long int f = SCM_INUM (flag);
- if (f <= 0) SCM_OUT_OF_RANGE (1, flag);
- debug_cells_gc_interval = f;
- scm_debug_cell_accesses_p = 1;
- } else {
- SCM_WRONG_TYPE_ARG (1, flag);
- }
+ if (SCM_FALSEP (flag))
+ {
+ scm_debug_cell_accesses_p = 0;
+ }
+ else if (SCM_EQ_P (flag, SCM_BOOL_T))
+ {
+ scm_debug_cells_gc_interval = 0;
+ scm_debug_cell_accesses_p = 1;
+ scm_expensive_debug_cell_accesses_p = 0;
+ }
+ else if (SCM_INUMP (flag))
+ {
+ long int f = SCM_INUM (flag);
+ if (f <= 0)
+ SCM_OUT_OF_RANGE (1, flag);
+ scm_debug_cells_gc_interval = f;
+ scm_debug_cell_accesses_p = 1;
+ scm_expensive_debug_cell_accesses_p = 1;
+ }
+ else
+ {
+ SCM_WRONG_TYPE_ARG (1, flag);
+ }
return SCM_UNSPECIFIED;
}
#undef FUNC_NAME
/*
do nothing
*/
-
+ fprintf (stderr, "\nWARNING: GUILE was not compiled with SCM_DEBUG_CELL_ACCESSES");
scm_remember_upto_here (flag);
return SCM_UNSPECIFIED;
}
\f
-SCM scm_i_freelist = SCM_EOL;
-SCM scm_i_freelist2 = SCM_EOL;
+scm_t_key scm_i_freelist;
+scm_t_key scm_i_freelist2;
/* scm_mtrigger
*/
SCM scm_weak_vectors;
-/* During collection, this accumulates structures which are to be freed.
- */
-SCM scm_structs_to_free;
-
/* GC Statistics Keeping
*/
-long scm_cells_allocated = 0;
+unsigned long scm_cells_allocated = 0;
unsigned long scm_mallocated = 0;
unsigned long scm_gc_cells_collected;
unsigned long scm_gc_cells_collected_1 = 0; /* previous GC yield */
unsigned long int local_scm_heap_size;
int local_scm_gc_cell_yield_percentage;
int local_scm_gc_malloc_yield_percentage;
- long int local_scm_cells_allocated;
+ unsigned long int local_scm_cells_allocated;
unsigned long int local_scm_gc_time_taken;
unsigned long int local_scm_gc_times;
unsigned long int local_scm_gc_mark_time_taken;
}
answer = scm_list_n (scm_cons (sym_gc_time_taken, scm_ulong2num (local_scm_gc_time_taken)),
- scm_cons (sym_cells_allocated, scm_long2num (local_scm_cells_allocated)),
+ scm_cons (sym_cells_allocated, scm_ulong2num (local_scm_cells_allocated)),
scm_cons (sym_heap_size, scm_ulong2num (local_scm_heap_size)),
scm_cons (sym_mallocated, scm_ulong2num (local_scm_mallocated)),
scm_cons (sym_mtrigger, scm_ulong2num (local_scm_mtrigger)),
#define FUNC_NAME s_scm_gc
{
SCM_DEFER_INTS;
+ scm_i_thread_put_to_sleep ();
scm_igc ("call");
+ scm_i_thread_wake_up ();
SCM_ALLOW_INTS;
return SCM_UNSPECIFIED;
}
{
SCM cell;
+ scm_i_thread_put_to_sleep ();
+
++scm_ints_disabled;
*free_cells = scm_i_sweep_some_segments (freelist);
--scm_ints_disabled;
*free_cells = SCM_FREE_CELL_CDR (cell);
+
+ scm_i_thread_wake_up ();
+
return cell;
}
fprintf (stderr,"gc reason %s\n", what);
fprintf (stderr,
- SCM_NULLP (scm_i_freelist)
+ SCM_NULLP (*SCM_FREELIST_LOC (scm_i_freelist))
? "*"
- : (SCM_NULLP (scm_i_freelist2) ? "o" : "m"));
+ : (SCM_NULLP (*SCM_FREELIST_LOC (scm_i_freelist2)) ? "o" : "m"));
#endif
/* During the critical section, only the current thread may run. */
+#if 0 /* MDJ 021207 <djurfeldt@nada.kth.se>
+ Currently, a much larger piece of the GC is single threaded.
+ Can we shrink it again? */
SCM_CRITICAL_SECTION_START;
+#endif
- if (!scm_stack_base || scm_block_gc)
+ if (!scm_root || !scm_stack_base || scm_block_gc)
{
--scm_gc_running_p;
return;
scm_gc_sweep ();
+
+ /*
+ TODO: this hook should probably be moved to just before the mark,
+ since that's where the sweep is finished in lazy sweeping.
+ */
scm_c_hook_run (&scm_after_sweep_c_hook, 0);
gc_end_stats ();
+#if 0 /* MDJ 021207 <djurfeldt@nada.kth.se> */
SCM_CRITICAL_SECTION_END;
+#endif
+
+ /*
+ See above.
+ */
scm_c_hook_run (&scm_after_gc_c_hook, 0);
--scm_gc_running_p;
-}
-
-\f
-
-
-
-
-\f
+ /*
+ For debugging purposes, you could do
+ scm_i_sweep_all_segments("debug"), but then the remains of the
+ cell aren't left to analyse.
+ */
+}
\f
/* {GC Protection Helper Functions}
scm_c_hook_init (&scm_after_gc_c_hook, 0, SCM_C_HOOK_NORMAL);
/* Initialise the list of ports. */
- scm_port_table = (scm_t_port **)
- malloc (sizeof (scm_t_port *) * scm_port_table_room);
- if (!scm_port_table)
+ scm_i_port_table = (scm_t_port **)
+ malloc (sizeof (scm_t_port *) * scm_i_port_table_room);
+ if (!scm_i_port_table)
return 1;
#ifdef HAVE_ATEXIT
* after-gc-hook.
*/
#if (SCM_DEBUG_CELL_ACCESSES == 1)
- if (debug_cells_gc_interval == 0)
+ if (scm_debug_cells_gc_interval == 0)
scm_system_async_mark (gc_async);
#else
scm_system_async_mark (gc_async);
void
scm_init_gc ()
{
- SCM after_gc_thunk;
-
-
scm_gc_init_mark ();
scm_after_gc_hook = scm_permanent_object (scm_make_hook (SCM_INUM0));
scm_c_define ("after-gc-hook", scm_after_gc_hook);
- after_gc_thunk = scm_c_make_subr ("%gc-thunk", scm_tc7_subr_0,
- gc_async_thunk);
- gc_async = scm_system_async (after_gc_thunk); /* protected via scm_asyncs */
+ gc_async = scm_c_make_subr ("%gc-thunk", scm_tc7_subr_0,
+ gc_async_thunk);
scm_c_hook_add (&scm_after_gc_c_hook, mark_gc_async, NULL, 0);
/* When we move to POSIX threads private freelists should probably
be GC-protected instead. */
- scm_i_freelist = SCM_EOL;
- scm_i_freelist2 = SCM_EOL;
+ *SCM_FREELIST_LOC (scm_i_freelist) = SCM_EOL;
+ *SCM_FREELIST_LOC (scm_i_freelist2) = SCM_EOL;
}
#undef FUNC_NAME
HCoop / bpt / guile.git / blobdiff