diff options
-rw-r--r-- | libguile/gc.c | 120 | ||||
-rw-r--r-- | libguile/gc.h | 4 |
2 files changed, 51 insertions, 73 deletions
diff --git a/libguile/gc.c b/libguile/gc.c index eba10038c..31c1eab5b 100644 --- a/libguile/gc.c +++ b/libguile/gc.c @@ -235,11 +235,14 @@ double scm_gc_cells_marked_acc = 0.; double scm_gc_cells_swept_acc = 0.; int scm_gc_cell_yield_percentage =0; int scm_gc_malloc_yield_percentage = 0; -unsigned long protected_obj_count = 0; + +static unsigned long protected_obj_count = 0; SCM_SYMBOL (sym_cells_allocated, "cells-allocated"); -SCM_SYMBOL (sym_heap_size, "cell-heap-size"); +SCM_SYMBOL (sym_heap_size, "heap-size"); +SCM_SYMBOL (sym_heap_free_size, "heap-free-size"); +SCM_SYMBOL (sym_heap_total_allocated, "heap-total-allocated"); SCM_SYMBOL (sym_mallocated, "bytes-malloced"); SCM_SYMBOL (sym_mtrigger, "gc-malloc-threshold"); SCM_SYMBOL (sym_heap_segments, "cell-heap-segments"); @@ -307,81 +310,27 @@ SCM_DEFINE (scm_gc_stats, "gc-stats", 0, 0, 0, "use of storage.\n") #define FUNC_NAME s_scm_gc_stats { - long i = 0; - SCM heap_segs = SCM_EOL ; - unsigned long int local_scm_mtrigger; - unsigned long int local_scm_mallocated; - unsigned long int local_scm_heap_size; - int local_scm_gc_cell_yield_percentage; - int local_scm_gc_malloc_yield_percentage; - 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; - unsigned long int local_protected_obj_count; - double local_scm_gc_cells_swept; - double local_scm_gc_cells_marked; SCM answer; - unsigned long *bounds = 0; - SCM_CRITICAL_SECTION_START; - - /* - temporarily store the numbers, so as not to cause GC. - */ -#if 0 - bounds = malloc (sizeof (unsigned long) * table_size * 2); - if (!bounds) - abort(); -#endif + size_t heap_size, free_bytes, bytes_since_gc, total_bytes; + size_t gc_times; - /* Below, we cons to produce the resulting list. We want a snapshot of - * the heap situation before consing. - */ - local_scm_mtrigger = scm_mtrigger; - local_scm_mallocated = scm_mallocated; - local_scm_heap_size = GC_get_heap_size (); - - local_scm_cells_allocated = scm_cells_allocated; - - local_scm_gc_time_taken = scm_gc_time_taken; - local_scm_gc_mark_time_taken = scm_gc_mark_time_taken; - local_scm_gc_times = scm_gc_times; - local_scm_gc_malloc_yield_percentage = scm_gc_malloc_yield_percentage; - local_scm_gc_cell_yield_percentage= scm_gc_cell_yield_percentage; - local_protected_obj_count = protected_obj_count; - local_scm_gc_cells_swept = - (double) scm_gc_cells_swept_acc - + (double) scm_gc_cells_swept; - local_scm_gc_cells_marked = scm_gc_cells_marked_acc - +(double) scm_gc_cells_swept - -(double) scm_gc_cells_collected; - -#if 0 - for (i = table_size; i--;) - { - heap_segs = scm_cons (scm_cons (scm_from_ulong (bounds[2*i]), - scm_from_ulong (bounds[2*i+1])), - heap_segs); - } -#else - heap_segs = scm_list (SCM_INUM0); /* FIXME */ -#endif + heap_size = GC_get_heap_size (); + free_bytes = GC_get_free_bytes (); + bytes_since_gc = GC_get_bytes_since_gc (); + total_bytes = GC_get_total_bytes (); + gc_times = GC_gc_no; /* njrev: can any of these scm_cons's or scm_list_n signal a memory error? If so we need a frame here. */ answer = - scm_list_n (scm_cons (sym_gc_time_taken, - scm_from_ulong (local_scm_gc_time_taken)), + scm_list_n (scm_cons (sym_gc_time_taken, SCM_INUM0), +#if 0 scm_cons (sym_cells_allocated, scm_from_ulong (local_scm_cells_allocated)), - scm_cons (sym_heap_size, - scm_from_ulong (local_scm_heap_size)), scm_cons (sym_mallocated, scm_from_ulong (local_scm_mallocated)), scm_cons (sym_mtrigger, scm_from_ulong (local_scm_mtrigger)), - scm_cons (sym_times, - scm_from_ulong (local_scm_gc_times)), scm_cons (sym_gc_mark_time_taken, scm_from_ulong (local_scm_gc_mark_time_taken)), scm_cons (sym_cells_marked, @@ -392,13 +341,17 @@ SCM_DEFINE (scm_gc_stats, "gc-stats", 0, 0, 0, scm_from_long(local_scm_gc_malloc_yield_percentage)), scm_cons (sym_cell_yield, scm_from_long (local_scm_gc_cell_yield_percentage)), - scm_cons (sym_protected_objects, - scm_from_ulong (local_protected_obj_count)), scm_cons (sym_heap_segments, heap_segs), +#endif + scm_cons (sym_heap_size, scm_from_size_t (heap_size)), + scm_cons (sym_heap_free_size, scm_from_size_t (free_bytes)), + scm_cons (sym_heap_total_allocated, + scm_from_size_t (total_bytes)), + scm_cons (sym_protected_objects, + scm_from_ulong (protected_obj_count)), + scm_cons (sym_times, scm_from_size_t (gc_times)), SCM_UNDEFINED); - SCM_CRITICAL_SECTION_END; -/* free (bounds); */ return answer; } #undef FUNC_NAME @@ -417,6 +370,29 @@ SCM_DEFINE (scm_object_address, "object-address", 1, 0, 0, #undef FUNC_NAME +SCM_DEFINE (scm_gc_disable, "gc-disable", 0, 0, 0, + (), + "Disables the garbage collector. Nested calls are permitted. " + "GC is re-enabled once @code{gc-enable} has been called the " + "same number of times @code{gc-disable} was called.") +#define FUNC_NAME s_scm_gc_disable +{ + GC_disable (); + return SCM_UNSPECIFIED; +} +#undef FUNC_NAME + +SCM_DEFINE (scm_gc_enable, "gc-enable", 0, 0, 0, + (), + "Enables the garbage collector.") +#define FUNC_NAME s_scm_gc_enable +{ + GC_enable (); + return SCM_UNSPECIFIED; +} +#undef FUNC_NAME + + SCM_DEFINE (scm_gc, "gc", 0, 0, 0, (), "Scans all of SCM objects and reclaims for further use those that are\n" @@ -703,8 +679,10 @@ void scm_storage_prehistory () { GC_INIT (); - GC_add_roots ((char *)scm_sys_protects, - (char *)(scm_sys_protects + SCM_NUM_PROTECTS)); + + /* Sanity check. */ + if (!GC_is_visible (scm_sys_protects)) + abort (); scm_c_hook_init (&scm_before_gc_c_hook, 0, SCM_C_HOOK_NORMAL); scm_c_hook_init (&scm_before_mark_c_hook, 0, SCM_C_HOOK_NORMAL); diff --git a/libguile/gc.h b/libguile/gc.h index 117301272..4ad21b462 100644 --- a/libguile/gc.h +++ b/libguile/gc.h @@ -208,11 +208,11 @@ SCM_API SCM scm_set_debug_cell_accesses_x (SCM flag); SCM_API SCM scm_object_address (SCM obj); +SCM_API SCM scm_gc_enable (void); +SCM_API SCM scm_gc_disable (void); SCM_API SCM scm_gc_stats (void); SCM_API SCM scm_gc_live_object_stats (void); SCM_API SCM scm_gc (void); -SCM_API void scm_gc_for_alloc (struct scm_t_cell_type_statistics *freelist); -SCM_API SCM scm_gc_for_newcell (struct scm_t_cell_type_statistics *master, SCM *freelist); SCM_API void scm_i_gc (const char *what); SCM_API void scm_gc_mark (SCM p); SCM_API int scm_in_heap_p (SCM value); |