From: Han-Wen Nienhuys Date: Thu, 8 Aug 2002 19:47:31 +0000 (+0000) Subject: * gc.h: add scm_debug_cells_gc_interval to public interface X-Git-Url: https://git.hcoop.net/bpt/guile.git/commitdiff_plain/eab1b25970c21df7da67bd8f48290a1a1e1bf3d7 * gc.h: add scm_debug_cells_gc_interval to public interface * gc-card.c ("sweep_card"): set scm_gc_running while sweeping. * gc.c (scm_i_expensive_validation_check): separate expensive validation checks from cheap ones. --- diff --git a/NEWS b/NEWS index 0734b3bfd..25a081053 100644 --- a/NEWS +++ b/NEWS @@ -142,9 +142,9 @@ cause aborts in long running programs. The new functions are more symmetrical and do not need cooperation from smob free routines, among other improvements. -The new functions are scm_malloc, scm_realloc, scm_strdup, -scm_strndup, scm_gc_malloc, scm_gc_calloc, scm_gc_realloc, scm_gc_free, -scm_gc_register_collectable_memory, and +The new functions are scm_malloc, scm_realloc, scm_calloc, scm_strdup, +scm_strndup, scm_gc_malloc, scm_gc_calloc, scm_gc_realloc, +scm_gc_free, scm_gc_register_collectable_memory, and scm_gc_unregister_collectable_memory. Refer to the manual for more details and for upgrading instructions. diff --git a/doc/ref/scheme-memory.texi b/doc/ref/scheme-memory.texi index 8fad86466..ea3f8bfd1 100644 --- a/doc/ref/scheme-memory.texi +++ b/doc/ref/scheme-memory.texi @@ -76,6 +76,7 @@ For really specialized needs, take at look at @code{scm_gc_unregister_collectable_memory}. @deftypefn {C Function} void *scm_malloc (size_t @var{size}) +@deftypefnx {C Function} void *scm_calloc (size_t @var{size}) Allocate @var{size} bytes of memory and return a pointer to it. When @var{size} is 0, return @code{NULL}. When not enough memory is available, signal an error. This function runs the GC to free up some @@ -85,6 +86,9 @@ The memory is allocated by the libc @code{malloc} function and can be freed with @code{free}. There is no @code{scm_free} function to go with @code{scm_malloc} to make it easier to pass memory back and forth between different modules. + +The function @code{scm_calloc} is similar to @code{scm_malloc}, but +initializes the block of memory to zero as well. @end deftypefn @deftypefn {C Function} void *scm_realloc (void *@var{mem}, size_t @var{new_size}) @@ -98,6 +102,9 @@ When not enough memory is available, signal an error. This function runs the GC to free up some memory when it deems it appropriate. @end deftypefn + + + @deftypefn {C Function} void scm_gc_register_collectable_memory (void *@var{mem}, size_t @var{size}, const char *@var{what}) Informs the GC that the memory at @var{mem} of size @var{size} can potentially be freed during a GC. That is, announce that @var{mem} is @@ -127,12 +134,14 @@ much less efficiently than it could. @deftypefn {C Function} void *scm_gc_malloc (size_t @var{size}, const char *@var{what}) @deftypefnx {C Function} void *scm_gc_realloc (void *@var{mem}, size_t @var{old_size}, size_t @var{new_size}, const char *@var{what}); -Like @code{scm_malloc} or @code{scm_realloc}, but also call -@code{scm_gc_register_collectable_memory}. Note that you need to pass -the old size of a reallocated memory block as well. See below for a -motivation. +@deftypefnx {C Function} void *scm_gc_calloc (size_t @var{size}, const char *@var{what}) +Like @code{scm_malloc}, @code{scm_realloc} or @code{scm_calloc}, but +also call @code{scm_gc_register_collectable_memory}. Note that you +need to pass the old size of a reallocated memory block as well. See +below for a motivation. @end deftypefn + @deftypefn {C Function} void scm_gc_free (void *@var{mem}, size_t @var{size}, const char *@var{what}) Like @code{free}, but also call @code{scm_gc_unregister_collectable_memory}. diff --git a/libguile/ChangeLog b/libguile/ChangeLog index 5835323d0..0bb54712e 100644 --- a/libguile/ChangeLog +++ b/libguile/ChangeLog @@ -1,3 +1,12 @@ +2002-08-08 Han-Wen Nienhuys + + * gc.h: add scm_debug_cells_gc_interval to public interface + + * gc-card.c ("sweep_card"): set scm_gc_running while sweeping. + + * gc.c (scm_i_expensive_validation_check): separate expensive + validation checks from cheap ones. + 2002-08-06 Han-Wen Nienhuys * read.c (scm_input_error): new function: give meaningful error diff --git a/libguile/gc-card.c b/libguile/gc-card.c index 6f82488ba..309ac88ab 100644 --- a/libguile/gc-card.c +++ b/libguile/gc-card.c @@ -86,12 +86,13 @@ scm_i_sweep_card (scm_t_cell * p, SCM *free_list, int span) int offset =SCM_MAX (SCM_GC_CARD_N_HEADER_CELLS, span); int free_count = 0; + ++ scm_gc_running_p; + /* I tried something fancy with shifting by one bit every word from the bitvec in turn, but it wasn't any faster, but quite bit hairier. */ - for (p += offset; p < end; p += span, offset += span) { SCM scmptr = PTR2SCM(p); @@ -273,6 +274,8 @@ scm_i_sweep_card (scm_t_cell * p, SCM *free_list, int span) *free_list = PTR2SCM (p); free_count ++; } + + --scm_gc_running_p; return free_count; } #undef FUNC_NAME @@ -301,6 +304,7 @@ scm_init_card_freelist (scm_t_cell * card, SCM *free_list, int span) } + #if 0 /* These functions are meant to be called from GDB as a debug aid. @@ -318,6 +322,16 @@ typedef struct scm_t_list_cell_struct { struct scm_t_list_cell_struct * cdr; } scm_t_list_cell; + +typedef struct scm_t_double_cell +{ + scm_t_bits word_0; + scm_t_bits word_1; + scm_t_bits word_2; + scm_t_bits word_3; +} scm_t_double_cell; + + int scm_gc_marked_p (SCM obj) { diff --git a/libguile/gc-mark.c b/libguile/gc-mark.c index 466874ad2..d7414d648 100644 --- a/libguile/gc-mark.c +++ b/libguile/gc-mark.c @@ -83,9 +83,6 @@ extern unsigned long * __libc_ia64_register_backing_store_base; #include #endif - - - #ifdef __ia64__ # define SCM_MARK_BACKING_STORE() do { \ ucontext_t ctx; \ @@ -101,6 +98,7 @@ extern unsigned long * __libc_ia64_register_backing_store_base; # define SCM_MARK_BACKING_STORE() #endif + /* Entry point for this file. */ @@ -108,10 +106,10 @@ void scm_mark_all (void) { long j; - + scm_i_clear_mark_space (); - + #ifndef USE_THREADS /* Mark objects on the C stack. */ @@ -157,12 +155,14 @@ scm_mark_all (void) } } } + /* FIXME: we should have a means to register C functions to be run * in different phases of GC */ scm_mark_subr_table (); + #ifndef USE_THREADS scm_gc_mark (scm_root->handle); #endif @@ -171,7 +171,6 @@ scm_mark_all (void) /* {Mark/Sweep} */ - /* Mark an object precisely, then recurse. */ @@ -182,7 +181,9 @@ scm_gc_mark (SCM ptr) return ; if (SCM_GC_MARK_P (ptr)) - return; + { + return; + } SCM_SET_GC_MARK (ptr); scm_gc_mark_dependencies (ptr); @@ -475,9 +476,12 @@ gc_mark_loop: } if (SCM_GC_MARK_P (ptr)) + { return; - + } + SCM_SET_GC_MARK (ptr); + goto scm_mark_dependencies_again; } @@ -485,6 +489,7 @@ gc_mark_loop: + /* Mark a region conservatively */ void scm_mark_locations (SCM_STACKITEM x[], unsigned long n) @@ -570,4 +575,3 @@ scm_gc_init_mark(void) #endif } - diff --git a/libguile/gc-segment.c b/libguile/gc-segment.c index d3a48f2ab..593aa29a2 100644 --- a/libguile/gc-segment.c +++ b/libguile/gc-segment.c @@ -546,6 +546,7 @@ scm_i_get_new_heap_segment (scm_t_cell_type_statistics *freelist, policy_on_erro } + void scm_i_make_initial_segment (size_t init_heap_size, scm_t_cell_type_statistics *freelist) { @@ -568,4 +569,3 @@ scm_i_make_initial_segment (size_t init_heap_size, scm_t_cell_type_statistics *f freelist->min_yield = (freelist->heap_size * freelist->min_yield_fraction / 100); } - diff --git a/libguile/gc.c b/libguile/gc.c index 58ede2266..b29138573 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 desired, perform additional garbage collections after a user + * defined number of cell accesses. + */ + if (scm_debug_cells_gc_interval) + { + static unsigned int counter = 0; - if (!already_running) + if (counter != 0) + { + --counter; + } + else + { + counter = scm_debug_cells_gc_interval; + scm_igc ("scm_assert_cell_valid"); + } + } +} + +void +scm_assert_cell_valid (SCM cell) +{ + if (!scm_i_cell_validation_already_running && scm_debug_cell_accesses_p) { - already_running = 1; /* set to avoid recursion */ + 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 @@ -497,6 +524,8 @@ scm_gc_for_newcell (scm_t_cell_type_statistics *freelist, SCM *free_cells) --scm_ints_disabled; *free_cells = SCM_FREE_CELL_CDR (cell); + + return cell; } @@ -525,7 +554,7 @@ scm_igc (const char *what) /* During the critical section, only the current thread may run. */ SCM_CRITICAL_SECTION_START; - if (!scm_stack_base || scm_block_gc) + if (!scm_root || !scm_stack_base || scm_block_gc) { --scm_gc_running_p; return; @@ -585,15 +614,13 @@ scm_igc (const char *what) SCM_CRITICAL_SECTION_END; 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} @@ -939,7 +966,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); diff --git a/libguile/gc.h b/libguile/gc.h index 7161e3805..f0f89b7f7 100644 --- a/libguile/gc.h +++ b/libguile/gc.h @@ -218,6 +218,7 @@ typedef unsigned long scm_t_c_bvec_long; #define SCM_SET_CELL_TYPE(x, t) SCM_SET_CELL_WORD_0 (x, t) + /* Freelists consist of linked cells where the type entry holds the value * scm_tc_free_cell and the second entry holds a pointer to the next cell of * the freelist. Due to this structure, freelist cells are not cons cells @@ -245,7 +246,11 @@ typedef unsigned long scm_t_c_bvec_long; #if (SCM_DEBUG_CELL_ACCESSES == 1) -SCM_API unsigned int scm_debug_cell_accesses_p; +/* Set this to != 0 if every cell that is accessed shall be checked: + */ +SCM_API int scm_debug_cell_accesses_p; +SCM_API int scm_expensive_debug_cell_accesses_p; +SCM_API int scm_debug_cells_gc_interval ; #endif SCM_API int scm_block_gc; @@ -274,10 +279,11 @@ SCM_API size_t scm_max_segment_size; Deprecated scm_freelist, scm_master_freelist. No warning; this is not a user serviceable part. */ -SCM_API SCM scm_i_freelist; -SCM_API struct scm_t_cell_type_statistics scm_i_master_freelist; -SCM_API SCM scm_i_freelist2; -SCM_API struct scm_t_cell_type_statistics scm_i_master_freelist2; +extern SCM scm_i_freelist; +extern struct scm_t_cell_type_statistics scm_i_master_freelist; +extern SCM scm_i_freelist2; +extern struct scm_t_cell_type_statistics scm_i_master_freelist2; + SCM_API unsigned long scm_gc_cells_swept; SCM_API unsigned long scm_gc_cells_collected; diff --git a/libguile/inline.c b/libguile/inline.c index 914f309b2..66e348b1c 100644 --- a/libguile/inline.c +++ b/libguile/inline.c @@ -39,10 +39,13 @@ * whether to permit this exception to apply to your modifications. * If you do not wish that, delete this exception notice. */ +#include #include "libguile/scmconfig.h" - +#ifndef HAVE_INLINE #define HAVE_INLINE +#endif + #define EXTERN_INLINE #undef SCM_INLINE_H diff --git a/libguile/inline.h b/libguile/inline.h index c1df037c3..ea6b51277 100644 --- a/libguile/inline.h +++ b/libguile/inline.h @@ -50,10 +50,6 @@ */ -#if (SCM_DEBUG_CELL_ACCESSES == 1) -#include -#endif - #include "libguile/pairs.h" #include "libguile/gc.h" @@ -64,8 +60,6 @@ SCM_API SCM scm_double_cell (scm_t_bits car, scm_t_bits cbr, #ifdef HAVE_INLINE - - #ifndef EXTERN_INLINE #define EXTERN_INLINE extern inline #endif @@ -74,6 +68,7 @@ extern unsigned scm_newcell2_count; extern unsigned scm_newcell_count; + EXTERN_INLINE SCM scm_cell (scm_t_bits car, scm_t_bits cdr) @@ -137,6 +132,10 @@ scm_cell (scm_t_bits car, scm_t_bits cdr) #endif +#if (SCM_DEBUG_CELL_ACCESSES == 1) + if (scm_expensive_debug_cell_accesses_p ) + scm_i_expensive_validation_check (z); +#endif return z; } @@ -201,5 +200,7 @@ scm_double_cell (scm_t_bits car, scm_t_bits cbr, return z; } + + #endif #endif diff --git a/libguile/private-gc.h b/libguile/private-gc.h index 3924e5044..f5acd9450 100644 --- a/libguile/private-gc.h +++ b/libguile/private-gc.h @@ -236,5 +236,6 @@ void scm_gc_init_malloc (void); void scm_gc_init_freelist (void); void scm_gc_init_segments (void); void scm_gc_init_mark (void); - + + #endif diff --git a/libguile/procs.c b/libguile/procs.c index 948934de2..7269fa558 100644 --- a/libguile/procs.c +++ b/libguile/procs.c @@ -139,7 +139,7 @@ scm_mark_subr_table () long i; for (i = 0; i < scm_subr_table_size; ++i) { - SCM_SET_GC_MARK (scm_subr_table[i].name); + scm_gc_mark (scm_subr_table[i].name); if (scm_subr_table[i].generic && *scm_subr_table[i].generic) scm_gc_mark (*scm_subr_table[i].generic); if (SCM_NIMP (scm_subr_table[i].properties))