0.8alpha.0.45:
authorChristophe Rhodes <csr21@cam.ac.uk>
Thu, 22 May 2003 16:46:58 +0000 (16:46 +0000)
committerChristophe Rhodes <csr21@cam.ac.uk>
Thu, 22 May 2003 16:46:58 +0000 (16:46 +0000)
Fix profiler bug reported by APD sbcl-devel 2003-05-21:
... update *N-BYTES-FREED-OR-PURIFIED* in SUB-GC;
... add a smoke test.
Increment FASL file version number due to change in
DEFSTRUCT-SLOT-DESCRIPTION structure.

src/code/early-fasl.lisp
src/code/gc.lisp
tests/smoke.impure.lisp
version.lisp-expr

index 30bcfd0..e63caf7 100644 (file)
@@ -76,7 +76,7 @@
 ;;; versions which break binary compatibility. But it certainly should
 ;;; be incremented for release versions which break binary
 ;;; compatibility.
-(def!constant +fasl-file-version+ 41)
+(def!constant +fasl-file-version+ 42)
 ;;; (record of versions before 2003 deleted in 2003-04-26/0.pre8.107 or so)
 ;;; 38: (2003-01-05) changed names of internal SORT machinery
 ;;; 39: (2003-02-20) in 0.7.12.1 a slot was added to
@@ -84,6 +84,8 @@
 ;;; 40: (2003-03-11) changed value of (SXHASH NIL)
 ;;; 41: (2003-04-26) enforced binary incompatibility between +SB-THREAD
 ;;;     and -SB-THREAD builds
+;;; 42: (2003-05-22) %NAME slot changed to NAME in
+;;;     DEFSTRUCT-SLOT-DESCRIPTION
 
 ;;; the conventional file extension for our fasl files
 (declaim (type simple-string *fasl-file-type*))
index 3bcc1d9..917b6d0 100644 (file)
@@ -250,7 +250,7 @@ and submit it as a patch."
 ;;; For GENCGC all generations < GEN will be GC'ed.
 
 #!+sb-thread
-(defun sub-gc (&key (gen 0))
+(defun sub-gc (&key (gen 0) &aux (pre-gc-dynamic-usage (dynamic-usage)))
   (setf *need-to-collect-garbage* t)
   (when (zerop *gc-inhibit*)
     (setf (sb!alien:extern-alien "maybe_gc_pending" (sb!alien:unsigned 32))
@@ -261,6 +261,8 @@ and submit it as a patch."
      (when (zerop
            (sb!alien:extern-alien "maybe_gc_pending" (sb!alien:unsigned 32)))
        (return nil)))
+    (incf *n-bytes-freed-or-purified*
+         (max 0 (- pre-gc-dynamic-usage (dynamic-usage))))
     (setf *need-to-collect-garbage* nil)
     (scrub-control-stack))
   (values))
@@ -268,12 +270,14 @@ and submit it as a patch."
 #!-sb-thread
 (defvar *already-in-gc* nil "System is running SUB-GC")
 #!-sb-thread
-(defun sub-gc (&key (gen 0))
+(defun sub-gc (&key (gen 0) &aux (pre-gc-dynamic-usage (dynamic-usage)))
   (when *already-in-gc* (return-from sub-gc nil))
   (setf *need-to-collect-garbage* t)
   (when (zerop *gc-inhibit*)
     (let ((*already-in-gc* t))
       (without-interrupts (collect-garbage gen))
+      (incf *n-bytes-freed-or-purified*
+           (max 0 (- pre-gc-dynamic-usage (dynamic-usage))))
       (setf *need-to-collect-garbage* nil))
     (scrub-control-stack))
   (values))
@@ -288,7 +292,7 @@ and submit it as a patch."
   #!+(and sb-doc (not gencgc))
   "Initiate a garbage collection. GEN may be provided for compatibility with
   generational garbage collectors, but is ignored in this implementation."
-  (sub-gc  :gen (if full 6 gen)))
+  (sub-gc :gen (if full 6 gen)))
 
 \f
 ;;;; auxiliary functions
index 5f59c48..b155ff7 100644 (file)
 (assert (typep (setq *baz* 1) 'integer))
 (assert (typep (in-package :cl-user) 'package))
 
+;;; PROFILE should run without obvious breakage
+(defun profiled-fun ()
+  (random 1d0))
+(profile profiled-fun)
+(loop repeat 100000 do (profiled-fun))
+(report)
+
 ;;; success
 (quit :unix-status 104)
index 2eda528..9647e52 100644 (file)
@@ -17,4 +17,4 @@
 ;;; checkins which aren't released. (And occasionally for internal
 ;;; versions, especially for internal versions off the main CVS
 ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
-"0.8alpha.0.44"
+"0.8alpha.0.45"