From 2fb7ed1815097a415d80e133c9b91ceb74bf5eda Mon Sep 17 00:00:00 2001 From: Christophe Rhodes Date: Thu, 22 May 2003 16:46:58 +0000 Subject: [PATCH] 0.8alpha.0.45: 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 | 4 +++- src/code/gc.lisp | 10 +++++++--- tests/smoke.impure.lisp | 7 +++++++ version.lisp-expr | 2 +- 4 files changed, 18 insertions(+), 5 deletions(-) diff --git a/src/code/early-fasl.lisp b/src/code/early-fasl.lisp index 30bcfd0..e63caf7 100644 --- a/src/code/early-fasl.lisp +++ b/src/code/early-fasl.lisp @@ -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*)) diff --git a/src/code/gc.lisp b/src/code/gc.lisp index 3bcc1d9..917b6d0 100644 --- a/src/code/gc.lisp +++ b/src/code/gc.lisp @@ -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))) ;;;; auxiliary functions diff --git a/tests/smoke.impure.lisp b/tests/smoke.impure.lisp index 5f59c48..b155ff7 100644 --- a/tests/smoke.impure.lisp +++ b/tests/smoke.impure.lisp @@ -40,5 +40,12 @@ (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) diff --git a/version.lisp-expr b/version.lisp-expr index 2eda528..9647e52 100644 --- a/version.lisp-expr +++ b/version.lisp-expr @@ -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" -- 1.7.10.4