X-Git-Url: http://git.hcoop.net/bpt/guile.git/blobdiff_plain/c2cbcc57687ca716fb3e2166859b7be5880d80e2..9bc4701cd397c375cca4fa77b579af0673e6a584:/libguile/gc.c diff --git a/libguile/gc.c b/libguile/gc.c index 58ede2266..6ad9c4ec2 100644 --- a/libguile/gc.c +++ b/libguile/gc.c @@ -90,53 +90,87 @@ extern unsigned long * __libc_ia64_register_backing_store_base; 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)) { @@ -148,54 +182,47 @@ scm_assert_cell_valid (SCM 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 @@ -214,7 +241,7 @@ SCM_DEFINE (scm_set_debug_cell_accesses_x, "set-debug-cell-accesses!", 1, 0, 0, /* do nothing */ - + fprintf (stderr, "\nWARNING: GUILE was not compiled with SCM_DEBUG_CELL_ACCESSES"); scm_remember_upto_here (flag); return SCM_UNSPECIFIED; } @@ -224,8 +251,8 @@ SCM_DEFINE (scm_set_debug_cell_accesses_x, "set-debug-cell-accesses!", 1, 0, 0, -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 @@ -250,13 +277,9 @@ int scm_block_gc = 1; */ 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 */ @@ -310,7 +333,7 @@ SCM_DEFINE (scm_gc_stats, "gc-stats", 0, 0, 0, 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; @@ -365,7 +388,7 @@ SCM_DEFINE (scm_gc_stats, "gc-stats", 0, 0, 0, } 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)), @@ -436,7 +459,9 @@ SCM_DEFINE (scm_gc, "gc", 0, 0, 0, #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; } @@ -454,6 +479,8 @@ scm_gc_for_newcell (scm_t_cell_type_statistics *freelist, SCM *free_cells) { SCM cell; + scm_i_thread_put_to_sleep (); + ++scm_ints_disabled; *free_cells = scm_i_sweep_some_segments (freelist); @@ -497,6 +524,9 @@ scm_gc_for_newcell (scm_t_cell_type_statistics *freelist, SCM *free_cells) --scm_ints_disabled; *free_cells = SCM_FREE_CELL_CDR (cell); + + scm_i_thread_wake_up (); + return cell; } @@ -517,15 +547,19 @@ scm_igc (const char *what) 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 + 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; @@ -579,21 +613,30 @@ scm_igc (const char *what) 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 */ SCM_CRITICAL_SECTION_END; +#endif + + /* + See above. + */ scm_c_hook_run (&scm_after_gc_c_hook, 0); --scm_gc_running_p; -} - - - - - - - + /* + For debugging purposes, you could do + scm_i_sweep_all_segments("debug"), but then the remains of the + cell aren't left to analyse. + */ +} /* {GC Protection Helper Functions} @@ -865,9 +908,9 @@ scm_init_storage () 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 @@ -939,7 +982,7 @@ mark_gc_async (void * hook_data SCM_UNUSED, * 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); @@ -951,17 +994,13 @@ mark_gc_async (void * hook_data SCM_UNUSED, 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); @@ -985,8 +1024,8 @@ scm_gc_sweep (void) /* 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