diff options
-rw-r--r-- | libguile/gc-mark.c | 4 | ||||
-rw-r--r-- | libguile/gc-segment-table.c | 2 | ||||
-rw-r--r-- | libguile/gc-segment.c | 1 | ||||
-rw-r--r-- | libguile/gc.c | 7 | ||||
-rw-r--r-- | libguile/private-gc.h | 1 |
5 files changed, 12 insertions, 3 deletions
diff --git a/libguile/gc-mark.c b/libguile/gc-mark.c index d8f1ecec2..50cd844c9 100644 --- a/libguile/gc-mark.c +++ b/libguile/gc-mark.c @@ -78,7 +78,7 @@ scm_mark_all (void) scm_i_init_guardians_for_gc (); scm_i_clear_mark_space (); - + scm_i_find_heap_calls = 0; /* Mark every thread's stack and registers */ scm_threads_mark_stacks (); @@ -404,7 +404,7 @@ scm_gc_mark_dependencies (SCM p) { /* We are in debug mode. Check the ptr exhaustively. */ - valid_cell = valid_cell && (scm_i_find_heap_segment_containing_object (ptr) >= 0); + valid_cell = valid_cell && scm_in_heap_p (ptr); } #endif diff --git a/libguile/gc-segment-table.c b/libguile/gc-segment-table.c index d627e9c1f..4b809ae4b 100644 --- a/libguile/gc-segment-table.c +++ b/libguile/gc-segment-table.c @@ -115,12 +115,14 @@ scm_i_insert_segment (scm_t_heap_segment *seg) I think this function is too long to be inlined. --hwn */ + int scm_i_find_heap_segment_containing_object (SCM obj) { if (!CELL_P (obj)) return -1; + scm_i_find_heap_calls ++; if ((scm_t_cell *) obj < lowest_cell || (scm_t_cell *) obj >= highest_cell) return -1; diff --git a/libguile/gc-segment.c b/libguile/gc-segment.c index 16b5ce613..0668d1561 100644 --- a/libguile/gc-segment.c +++ b/libguile/gc-segment.c @@ -44,6 +44,7 @@ scm_i_get_new_heap_segment (scm_t_cell_type_statistics *freelist, if (len < SCM_MIN_HEAP_SEG_SIZE) len = SCM_MIN_HEAP_SEG_SIZE; + /* todo: consider having a more flexible lower bound. */ { scm_t_heap_segment *seg = scm_i_make_empty_heap_segment (freelist); diff --git a/libguile/gc.c b/libguile/gc.c index 8c0417cf9..95b3318cc 100644 --- a/libguile/gc.c +++ b/libguile/gc.c @@ -210,7 +210,7 @@ unsigned long scm_mtrigger; unsigned long scm_cells_allocated = 0; unsigned long scm_last_cells_allocated = 0; unsigned long scm_mallocated = 0; - +long int scm_i_find_heap_calls = 0; /* Global GC sweep statistics since the last full GC. */ scm_t_sweep_statistics scm_i_gc_sweep_stats = { 0, 0 }; @@ -241,6 +241,7 @@ SCM_SYMBOL (sym_gc_time_taken, "gc-time-taken"); SCM_SYMBOL (sym_gc_mark_time_taken, "gc-mark-time-taken"); SCM_SYMBOL (sym_times, "gc-times"); SCM_SYMBOL (sym_cells_marked, "cells-marked"); +SCM_SYMBOL (sym_cells_marked_conservatively, "cells-marked-conservatively"); SCM_SYMBOL (sym_cells_swept, "cells-swept"); SCM_SYMBOL (sym_malloc_yield, "malloc-yield"); SCM_SYMBOL (sym_cell_yield, "cell-yield"); @@ -314,6 +315,7 @@ SCM_DEFINE (scm_gc_stats, "gc-stats", 0, 0, 0, unsigned long int local_scm_gc_times; unsigned long int local_scm_gc_mark_time_taken; unsigned long int local_protected_obj_count; + unsigned long int local_conservative_scan_count; double local_scm_gc_cells_swept; double local_scm_gc_cells_marked; double local_scm_total_cells_allocated; @@ -327,6 +329,7 @@ SCM_DEFINE (scm_gc_stats, "gc-stats", 0, 0, 0, /* Below, we cons to produce the resulting list. We want a snapshot of * the heap situation before consing. */ + local_conservative_scan_count = scm_i_find_heap_calls; local_scm_mtrigger = scm_mtrigger; local_scm_mallocated = scm_mallocated; local_scm_heap_size = @@ -369,6 +372,8 @@ SCM_DEFINE (scm_gc_stats, "gc-stats", 0, 0, 0, scm_from_double (local_scm_total_cells_allocated)), scm_cons (sym_heap_size, scm_from_ulong (local_scm_heap_size)), + scm_cons (sym_cells_marked_conservatively, + scm_from_ulong (local_conservative_scan_count)), scm_cons (sym_mallocated, scm_from_ulong (local_scm_mallocated)), scm_cons (sym_mtrigger, diff --git a/libguile/private-gc.h b/libguile/private-gc.h index 0e860b0ed..d738665e7 100644 --- a/libguile/private-gc.h +++ b/libguile/private-gc.h @@ -275,6 +275,7 @@ SCM_INTERNAL SCM scm_i_all_segments_statistics (SCM hashtab); SCM_INTERNAL unsigned long *scm_i_segment_table_info(int *size); extern long int scm_i_deprecated_memory_return; +extern long int scm_i_find_heap_calls; /* global init funcs. |