diff --git a/src/CHANGELOG b/src/CHANGELOG index 1e516ad4d..19eba8659 100644 --- a/src/CHANGELOG +++ b/src/CHANGELOG @@ -31,6 +31,9 @@ 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. + * Bugs fixed: - STREAMP signals an error for Gray streams. diff --git a/src/c/alloc_2.d b/src/c/alloc_2.d index bffaa40af..176c80295 100644 --- a/src/c/alloc_2.d +++ b/src/c/alloc_2.d @@ -25,6 +25,10 @@ #ifdef GBC_BOEHM +#if GBC_BOEHM == 0 +#include +#endif + static void finalize_queued(); /********************************************************** @@ -162,6 +166,7 @@ init_alloc(void) int i; if (alloc_initialized) return; alloc_initialized = TRUE; + cl_core.bytes_consed = OBJNULL; GC_no_dls = 1; GC_init(); @@ -310,6 +315,12 @@ static void finalize_queued() { cl_object l = cl_core.to_be_finalized; +#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)); + } +#endif if (l == Cnil) return; CL_NEWENV_BEGIN { diff --git a/src/configure.in b/src/configure.in index 1274d5318..f5efe36e6 100644 --- a/src/configure.in +++ b/src/configure.in @@ -306,6 +306,7 @@ else [FASL_LIBS="${FASL_LIBS} -lgc"], [AC_MSG_ERROR([System Boehm GC library requested but not found.])]) AC_MSG_CHECKING( [if we need to copy GC private headers] ) + AC_DEFINE(GBC_BOEHM, [1], [Use Boehm's garbage collector]) else enable_boehm="included" SUBDIRS="${SUBDIRS} gc" @@ -313,9 +314,9 @@ else if test "${enable_shared}" = "no"; then LIBRARIES="${LIBRARIES} ${LIBPREFIX}eclgc.${LIBEXT}" fi + AC_DEFINE(GBC_BOEHM, [0], [Use Boehm's garbage collector]) fi EXTRA_OBJS="${EXTRA_OBJS} alloc_2.${OBJEXT}" - AC_DEFINE(GBC_BOEHM, [1], [Use Boehm's garbage collector]) fi diff --git a/src/h/external.h b/src/h/external.h index c91993fb6..1d9b797a9 100644 --- a/src/h/external.h +++ b/src/h/external.h @@ -171,6 +171,7 @@ 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; }; diff --git a/src/lsp/mislib.lsp b/src/lsp/mislib.lsp index 349938e6c..e747b524d 100644 --- a/src/lsp/mislib.lsp +++ b/src/lsp/mislib.lsp @@ -34,30 +34,54 @@ t))) (defun do-time (closure) + #-boehm-gc (let* ((real-start (get-internal-real-time)) (run-start (get-internal-run-time)) - #-boehm-gc (gc-start (si::gc-time)) + (gc-start (si::gc-time)) + bytes-consed real-end run-end gc-end) (multiple-value-prog1 (funcall closure) (setq run-end (get-internal-run-time) - real-end (get-internal-real-time)) - #-boehm-gc - (setq gc-end (si::gc-time)) - (fresh-line *trace-output*) + real-end (get-internal-real-time) + gc-end (si::gc-time)) (format *trace-output* - #-boehm-gc "real time : ~,3F secs~%~ run time : ~,3F secs~%~ GC time : ~,3F secs~%" - #+boehm-gc + (/ (- real-end real-start) internal-time-units-per-second) + (/ (- 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)) + real-end + run-end + gc-end) + ;; Garbage collection forces counter in GC to be cleaned + (si::gc t) + (ffi::c-inline () () :void "cl_core.bytes_consed = MAKE_FIXNUM(0);") + (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 + (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;") + (fresh-line *trace-output*) + (format *trace-output* "real time : ~,3F secs~%~ - run time : ~,3F secs~%" - (/ (- real-end real-start) internal-time-units-per-second) - (/ (- run-end run-start) internal-time-units-per-second) - #-boehm-gc(/ (- gc-end gc-start) internal-time-units-per-second))))) + run time : ~,3F secs~%~ + consed : ~D bytes~%" + (/ (- real-end real-start) internal-time-units-per-second) + (/ (- run-end run-start) internal-time-units-per-second) + bytes-consed)))) (defmacro time (form) "Syntax: (time form)