From 58490f7806d56c0b9f08e39d75f40c1b264446a6 Mon Sep 17 00:00:00 2001 From: Juho Snellman Date: Sun, 2 Oct 2005 00:32:00 +0000 Subject: [PATCH] 0.9.5.17: SB-SPROF:ADJUST-SAMPLES-FOR-ADDRESS-CHANGES was consing excessively, sometimes resulting in an endless cycle of GC / run the adjusting in a *AFTER-GC-HOOK* / GC / etc. (Reported by David Lichteblau) * Declare the &REST arguments of numeric comparison operators as DYNAMIC-EXTENT. At least I was surprised by (SORT ... #'>) consing. * Clear *DYNAMIC-SPACE-CODE-INFO* every time RECORD-DYNINFO is called (significant for multiple profiling runs without intervening RESETs) --- NEWS | 3 +++ contrib/sb-sprof/sb-sprof.lisp | 1 + src/code/numbers.lisp | 8 ++++++++ version.lisp-expr | 2 +- 4 files changed, 13 insertions(+), 1 deletion(-) diff --git a/NEWS b/NEWS index 63aa706..00ef33b 100644 --- a/NEWS +++ b/NEWS @@ -5,6 +5,9 @@ changes in sbcl-0.9.6 relative to sbcl-0.9.5: (thanks to Svein Ove Aas) * bug fix: Unicode symbols are correctly printed in LDB backtraces (thanks to David Lichteblau) + * optimization: non-open coded uses of numeric comparison operators + (e.g. >) no longer cons when called with more than one parameter + on platforms supporting dynamic-extent allocation. * enhancement: saving cores with foreign code loaded is now supported on MIPS/Linux in addition to the previously supported platforms. diff --git a/contrib/sb-sprof/sb-sprof.lisp b/contrib/sb-sprof/sb-sprof.lisp index 0fc7423..5d6a32b 100644 --- a/contrib/sb-sprof/sb-sprof.lisp +++ b/contrib/sb-sprof/sb-sprof.lisp @@ -648,6 +648,7 @@ ;;; Record the addresses of dynamic-space code objects in ;;; *DYNAMIC-SPACE-CODE-INFO*. Call this with GC disabled. (defun record-dyninfo () + (setf *dynamic-space-code-info* nil) (flet ((record-address (code size) (declare (ignore size)) (multiple-value-bind (start end) diff --git a/src/code/numbers.lisp b/src/code/numbers.lisp index a0fff99..caafd1b 100644 --- a/src/code/numbers.lisp +++ b/src/code/numbers.lisp @@ -742,6 +742,7 @@ (defun = (number &rest more-numbers) #!+sb-doc "Return T if all of its arguments are numerically equal, NIL otherwise." + (declare (dynamic-extent more-numbers)) (the number number) (do ((nlist more-numbers (cdr nlist))) ((atom nlist) t) @@ -751,6 +752,7 @@ (defun /= (number &rest more-numbers) #!+sb-doc "Return T if no two of its arguments are numerically equal, NIL otherwise." + (declare (dynamic-extent more-numbers)) (do* ((head (the number number) (car nlist)) (nlist more-numbers (cdr nlist))) ((atom nlist) t) @@ -764,6 +766,7 @@ (defun < (number &rest more-numbers) #!+sb-doc "Return T if its arguments are in strictly increasing order, NIL otherwise." + (declare (dynamic-extent more-numbers)) (do* ((n (the number number) (car nlist)) (nlist more-numbers (cdr nlist))) ((atom nlist) t) @@ -773,6 +776,7 @@ (defun > (number &rest more-numbers) #!+sb-doc "Return T if its arguments are in strictly decreasing order, NIL otherwise." + (declare (dynamic-extent more-numbers)) (do* ((n (the number number) (car nlist)) (nlist more-numbers (cdr nlist))) ((atom nlist) t) @@ -782,6 +786,7 @@ (defun <= (number &rest more-numbers) #!+sb-doc "Return T if arguments are in strictly non-decreasing order, NIL otherwise." + (declare (dynamic-extent more-numbers)) (do* ((n (the number number) (car nlist)) (nlist more-numbers (cdr nlist))) ((atom nlist) t) @@ -791,6 +796,7 @@ (defun >= (number &rest more-numbers) #!+sb-doc "Return T if arguments are in strictly non-increasing order, NIL otherwise." + (declare (dynamic-extent more-numbers)) (do* ((n (the number number) (car nlist)) (nlist more-numbers (cdr nlist))) ((atom nlist) t) @@ -801,6 +807,7 @@ #!+sb-doc "Return the greatest of its arguments; among EQUALP greatest, return the first." + (declare (dynamic-extent more-numbers)) (do ((nlist more-numbers (cdr nlist)) (result number)) ((null nlist) (return result)) @@ -812,6 +819,7 @@ the first." #!+sb-doc "Return the least of its arguments; among EQUALP least, return the first." + (declare (dynamic-extent more-numbers)) (do ((nlist more-numbers (cdr nlist)) (result number)) ((null nlist) (return result)) diff --git a/version.lisp-expr b/version.lisp-expr index 0877902..d521fc7 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.9.5.16" +"0.9.5.17" -- 1.7.10.4