New method of counting consed bytes, does not cons any bignum and provides also GC counts

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:
 

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 {

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("");
 

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}};
 

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}};
 

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
 
 

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)

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)