From 5e6d7052a58fdaeb886ba1b960c094dbedaccb74 Mon Sep 17 00:00:00 2001 From: jgarcia Date: Sun, 24 Dec 2006 12:12:37 +0000 Subject: [PATCH] New method of counting consed bytes, does not cons any bignum and provides also GC counts --- src/CHANGELOG | 4 ++-- src/c/alloc_2.d | 43 ++++++++++++++++++++++++++++++++++++++----- src/c/main.d | 3 +++ src/c/symbols_list.h | 2 ++ src/c/symbols_list2.h | 2 ++ src/configure | 13 +++++++++---- src/h/external.h | 5 ++++- src/lsp/mislib.lsp | 34 ++++++++++++++++++++-------------- 8 files changed, 80 insertions(+), 26 deletions(-) diff --git a/src/CHANGELOG b/src/CHANGELOG index 19eba8659..6d1179bc0 100644 --- a/src/CHANGELOG +++ b/src/CHANGELOG @@ -31,8 +31,8 @@ ECL 1.0: a patch by Lars Brinkhoff). Still missing compiler support for unboxed long double types. - - TIME outputs information about consed bytes, but only when using the - Boehm-Weiser garbage collector which is shipped with ECL. + - TIME outputs information about consed bytes and calls to the garbage + collector. * Bugs fixed: diff --git a/src/c/alloc_2.d b/src/c/alloc_2.d index 176c80295..3723543cf 100644 --- a/src/c/alloc_2.d +++ b/src/c/alloc_2.d @@ -166,7 +166,6 @@ init_alloc(void) int i; if (alloc_initialized) return; alloc_initialized = TRUE; - cl_core.bytes_consed = OBJNULL; GC_no_dls = 1; GC_init(); @@ -306,6 +305,17 @@ si_set_finalizer(cl_object o, cl_object finalizer) @(return) } +cl_object +si_gc_stats(cl_object enable) +{ + cl_object old_status = cl_core.gc_stats? Ct : Cnil; + cl_object origin = MAKE_FIXNUM(MOST_POSITIVE_FIXNUM); + cl_core.gc_stats = (enable != Cnil); + @(return number_minus(cl_core.bytes_consed,origin) + number_minus(cl_core.gc_counter,origin) + old_status) +} + /* * This procedure is invoked after garbage collection. It invokes * finalizers for all objects that are to be reclaimed by the @@ -315,12 +325,35 @@ static void finalize_queued() { cl_object l = cl_core.to_be_finalized; + if (cl_core.gc_stats) { #if GBC_BOEHM == 0 - if (cl_core.bytes_consed != OBJNULL) { - cl_core.bytes_consed = number_plus(cl_core.bytes_consed, - make_integer(GC_words_allocd)); - } + mpz_add_ui(cl_core.bytes_consed->big.big_num, + cl_core.bytes_consed->big.big_num, + GC_words_allocd * sizeof(cl_index)); +#else + /* This is less accurate and may wrap around. We try + to detect this assuming that an overflow in an + unsigned integer will produce an smaller + integer.*/ + static cl_index bytes = 0; + cl_index new_bytes = GC_total_bytes(); + if (bytes < new_bytes) { + cl_index wrapped; + wrapped = ~((cl_index)0) - bytes; + mpz_add_ui(cl_core.bytes_consed->big.big_num, + cl_core.bytes_consed->big.big_num, + wrapped); + bytes = 0; + } + mpz_add_ui(cl_core.bytes_consed->big.big_num, + cl_core.bytes_consed->big.big_num, + new_bytes - bytes); + bytes = 0; #endif + mpz_add_ui(cl_core.gc_counter->big.big_num, + cl_core.gc_counter->big.big_num, + 1); + } if (l == Cnil) return; CL_NEWENV_BEGIN { diff --git a/src/c/main.d b/src/c/main.d index 9579f187b..0482daa5c 100644 --- a/src/c/main.d +++ b/src/c/main.d @@ -292,6 +292,9 @@ cl_boot(int argc, char **argv) @'nil', @'nil'); #endif cl_core.to_be_finalized = Cnil; + cl_core.bytes_consed = make_integer(MOST_POSITIVE_FIXNUM+1); + cl_core.gc_counter = make_integer(MOST_POSITIVE_FIXNUM+1); + cl_core.gc_stats = FALSE; cl_core.null_string = make_constant_base_string(""); diff --git a/src/c/symbols_list.h b/src/c/symbols_list.h index 1f6f269dd..0328c820b 100644 --- a/src/c/symbols_list.h +++ b/src/c/symbols_list.h @@ -1655,6 +1655,8 @@ cl_symbols[] = { {SYS_ "WRONG-TYPE-ARGUMENT", SI_ORDINARY, NULL, -1, OBJNULL}, +{SYS_ "GC-STATS", SI_ORDINARY, si_gc_stats, 1, OBJNULL}, + /* Tag for end of list */ {NULL, CL_ORDINARY, NULL, -1, OBJNULL}}; diff --git a/src/c/symbols_list2.h b/src/c/symbols_list2.h index 9a46071f5..924abba06 100644 --- a/src/c/symbols_list2.h +++ b/src/c/symbols_list2.h @@ -1655,6 +1655,8 @@ cl_symbols[] = { {SYS_ "WRONG-TYPE-ARGUMENT",NULL}, +{SYS_ "GC-STATS","si_gc_stats"}, + /* Tag for end of list */ {NULL,NULL}}; diff --git a/src/configure b/src/configure index 85114cd2a..507604f40 100755 --- a/src/configure +++ b/src/configure @@ -1,5 +1,5 @@ #! /bin/sh -# From configure.in Revision. +# From configure.in Revision: 1.140 . # Guess values for system-dependent variables and create Makefiles. # Generated by GNU Autoconf 2.60 for ecl 0.9i. # @@ -4897,6 +4897,11 @@ fi { echo "$as_me:$LINENO: checking if we need to copy GC private headers " >&5 echo $ECHO_N "checking if we need to copy GC private headers ... $ECHO_C" >&6; } + +cat >>confdefs.h <<\_ACEOF +#define GBC_BOEHM 1 +_ACEOF + else enable_boehm="included" SUBDIRS="${SUBDIRS} gc" @@ -4904,13 +4909,13 @@ echo $ECHO_N "checking if we need to copy GC private headers ... $ECHO_C" >&6; } if test "${enable_shared}" = "no"; then LIBRARIES="${LIBRARIES} ${LIBPREFIX}eclgc.${LIBEXT}" fi - fi - EXTRA_OBJS="${EXTRA_OBJS} alloc_2.${OBJEXT}" cat >>confdefs.h <<\_ACEOF -#define GBC_BOEHM 1 +#define GBC_BOEHM 0 _ACEOF + fi + EXTRA_OBJS="${EXTRA_OBJS} alloc_2.${OBJEXT}" fi diff --git a/src/h/external.h b/src/h/external.h index 1d9b797a9..d63b3ff80 100644 --- a/src/h/external.h +++ b/src/h/external.h @@ -171,9 +171,11 @@ struct cl_core_struct { cl_object processes; pthread_mutex_t global_lock; #endif - cl_object bytes_consed; cl_object libraries; cl_object to_be_finalized; + cl_object bytes_consed; + cl_object gc_counter; + bool gc_stats; }; #if defined(mingw32) || defined(_MSC_VER) || defined(cygwin) @@ -190,6 +192,7 @@ extern void cl_dealloc(void *p, cl_index s); #ifdef GBC_BOEHM extern cl_object si_gc(cl_object area); extern cl_object si_gc_dump(void); +extern cl_object si_gc_stats(cl_object enable); #define cl_alloc GC_malloc_ignore_off_page #define cl_alloc_atomic GC_malloc_atomic_ignore_off_page #define cl_alloc_align(s,d) GC_malloc_ignore_off_page(s) diff --git a/src/lsp/mislib.lsp b/src/lsp/mislib.lsp index e747b524d..2ba809028 100644 --- a/src/lsp/mislib.lsp +++ b/src/lsp/mislib.lsp @@ -37,11 +37,14 @@ #-boehm-gc (let* ((real-start (get-internal-real-time)) (run-start (get-internal-run-time)) - (gc-start (si::gc-time)) + gc-start bytes-consed real-end run-end gc-end) + ;; Garbage collection forces counters to be updated + (si::gc t) + (setf gc-start (si::gc-time)) (multiple-value-prog1 (funcall closure) (setq run-end (get-internal-run-time) @@ -55,33 +58,36 @@ (/ (- run-end run-start) internal-time-units-per-second) (/ (- gc-end gc-start) internal-time-units-per-second)))) #+boehm-gc - (let* ((real-start (get-internal-real-time)) - (run-start (get-internal-run-time)) - #-boehm-gc (gc-start (si::gc-time)) + (let* (real-start + run-start + consed-start + gc-no-start real-end run-end - gc-end) - ;; Garbage collection forces counter in GC to be cleaned + consed-end + gc-no-end) + ;; Garbage collection forces the value of counters to be updated (si::gc t) - (ffi::c-inline () () :void "cl_core.bytes_consed = MAKE_FIXNUM(0);") + (multiple-value-setq (consed-start gc-no-start) (gc-stats t)) + (setq real-start (get-internal-real-time) + run-start (get-internal-run-time)) (multiple-value-prog1 (funcall closure) (setq run-end (get-internal-run-time) real-end (get-internal-real-time)) - ;; Garbage collection forces the value of bytes_consed to be updated + ;; Garbage collection forces the value of counters to be updated (si::gc t) - (setq bytes-consed (ffi::c-inline () () :object "cl_core.bytes_consed" - :one-liner t)) - ;; And this deactivates statistics of GC - (ffi::c-inline () () :void "cl_core.bytes_consed = OBJNULL;") + (multiple-value-setq (consed-end gc-no-end) (gc-stats nil)) (fresh-line *trace-output*) (format *trace-output* "real time : ~,3F secs~%~ run time : ~,3F secs~%~ - consed : ~D bytes~%" + gc count : ~D times~%~ + consed : ~D words~%" (/ (- real-end real-start) internal-time-units-per-second) (/ (- run-end run-start) internal-time-units-per-second) - bytes-consed)))) + (- gc-no-end gc-no-start) + (- consed-end consed-start))))) (defmacro time (form) "Syntax: (time form)