From bcbbce86c47a1c530d488c7876a453100fcd933e Mon Sep 17 00:00:00 2001 From: William Harold Newman Date: Tue, 19 Mar 2002 20:17:50 +0000 Subject: [PATCH] 0.7.1.47: reviewed OPTIMIZE declarations, (mostly trying to avoid inadvertently imposing large %DETECT-STACK-EXHAUSTION overhead)... ...bumped SAFETY 1 to SAFETY 2 in warm.lisp (since (> SPEED SAFETY) isn't what we want) ...changed (SPEED 3) (SAFETY 3) to (SPEED 2) (SAFETY 2) in SORT logic ...removed OPTIMIZE declarations in time.lisp, since there's no up-to-date compelling reason to use other than the default optimization there. ...removed (OPTIMIZE (SAFETY 3)) in DEFTRANSFORM ARRAY-HEADER-P, since there seems to be no reason for it rearranged insert-%DETECT-STACK-EXHAUSTION code to make indentation less ridiculous --- make-host-2.sh | 4 +++- src/code/sort.lisp | 7 ++++++- src/code/time.lisp | 9 --------- src/cold/warm.lisp | 4 ++-- src/compiler/array-tran.lisp | 5 ++--- src/compiler/generic/genesis.lisp | 18 +++++++++++------ src/compiler/ir1tran.lisp | 39 +++++++++++++++++++------------------ src/compiler/srctran.lisp | 2 +- tests/exhaust.impure.lisp | 2 +- version.lisp-expr | 2 +- 10 files changed, 48 insertions(+), 44 deletions(-) diff --git a/make-host-2.sh b/make-host-2.sh index 19a7552..637914a 100644 --- a/make-host-2.sh +++ b/make-host-2.sh @@ -60,7 +60,9 @@ $SBCL_XC_HOST <<-'EOF' || exit 1 (sb!ext:inhibit-warnings 2) ;; SAFETY = SPEED (and < 3) should ;; reasonable safety, but might skip - ;; some unreasonably expensive stuff. + ;; some unreasonably expensive stuff + ;; (e.g. %DETECT-STACK-EXHAUSTION + ;; in sbcl-0.7.2). (safety 2) (space 1) (speed 2))))) diff --git a/src/code/sort.lisp b/src/code/sort.lisp index 49aa8f0..de92015 100644 --- a/src/code/sort.lisp +++ b/src/code/sort.lisp @@ -79,7 +79,12 @@ (declare (type index start end)) (declare (type function predicate)) (declare (type (or function null) key)) - (declare (optimize (speed 3) (safety 3) (debug 1) (space 1))) + ;; This used to be (OPTIMIZE (SPEED 3) (SAFETY 3)), but now + ;; (0.7.1.39) that (SAFETY 3) means "absolutely safe (including + ;; expensive things like %DETECT-STACK-EXHAUSTION)" we get closer + ;; to what we want by using (SPEED 2) (SAFETY 2): "pretty fast, + ;; pretty safe, and safety is no more important than speed". + (declare (optimize (speed 2) (safety 2) (debug 1) (space 1))) (if (typep vector 'simple-vector) ;; (VECTOR T) is worth optimizing for, and SIMPLE-VECTOR is ;; what we get from (VECTOR T) inside WITH-ARRAY-DATA. diff --git a/src/code/time.lisp b/src/code/time.lisp index 33d39cd..3694425 100644 --- a/src/code/time.lisp +++ b/src/code/time.lisp @@ -29,8 +29,6 @@ #!+sb-doc "Return the real time in the internal time format. This is useful for finding elapsed time. See INTERNAL-TIME-UNITS-PER-SECOND." - ;; FIXME: See comment on OPTIMIZE declaration in GET-INTERNAL-RUN-TIME. - (declare (optimize (speed 3) (safety 3))) (multiple-value-bind (ignore seconds useconds) (sb!unix:unix-gettimeofday) (declare (ignore ignore) (type (unsigned-byte 32) seconds useconds)) (let ((base *internal-real-time-base-seconds*) @@ -52,12 +50,6 @@ "Return the run time in the internal time format. This is useful for finding CPU usage." (declare (values (unsigned-byte 32))) - ;; FIXME: In CMU CL this was (SPEED 3) (SAFETY 0), and perhaps - ;; someday it should be again, since overhead here is annoying. But - ;; it's even more annoying to worry about this function returning - ;; out-of-range values, so while debugging the profiling code, - ;; I set it to (SAFETY 3) for now. - (declare (optimize (speed 3) (safety 3))) (multiple-value-bind (ignore utime-sec utime-usec stime-sec stime-usec) (sb!unix:unix-fast-getrusage sb!unix:rusage_self) (declare (ignore ignore) @@ -67,7 +59,6 @@ ;; documented anywhere and the observed behavior is to ;; sometimes return 1000000 exactly.) (type (integer 0 1000000) utime-usec stime-usec)) - (let ((result (+ (the (unsigned-byte 32) (* (the (unsigned-byte 32) (+ utime-sec stime-sec)) sb!xc:internal-time-units-per-second)) diff --git a/src/cold/warm.lisp b/src/cold/warm.lisp index 4e5ca8e..36430af 100644 --- a/src/cold/warm.lisp +++ b/src/cold/warm.lisp @@ -16,7 +16,7 @@ (proclaim '(optimize (compilation-speed 1) (debug #+sb-show 2 #-sb-show 1) (inhibit-warnings 2) - (safety 1) + (safety 2) (space 1) (speed 2))) @@ -268,7 +268,7 @@ ;;; easiest thing to do is to read them out of package-data-list.lisp-expr ;;; now? -;;;; restoring compilation policy to neutral values in preparation for +;;;; resetting compilation policy to neutral values in preparation for ;;;; SAVE-LISP-AND-DIE as final SBCL core (sb-int:/show "setting compilation policy to neutral values") diff --git a/src/compiler/array-tran.lisp b/src/compiler/array-tran.lisp index 5551e17..3e3329b 100644 --- a/src/compiler/array-tran.lisp +++ b/src/compiler/array-tran.lisp @@ -721,15 +721,14 @@ ;;; Pick off some constant cases. (deftransform array-header-p ((array) (array)) (let ((type (continuation-type array))) - (declare (optimize (safety 3))) (unless (array-type-p type) (give-up-ir1-transform)) (let ((dims (array-type-dimensions type))) (cond ((csubtypep type (specifier-type '(simple-array * (*)))) - ;; No array header. + ;; no array header nil) ((and (listp dims) (> (length dims) 1)) - ;; Multi-dimensional array, will have a header. + ;; multi-dimensional array, will have a header t) (t (give-up-ir1-transform)))))) diff --git a/src/compiler/generic/genesis.lisp b/src/compiler/generic/genesis.lisp index a7c39ee..0e20313 100644 --- a/src/compiler/generic/genesis.lisp +++ b/src/compiler/generic/genesis.lisp @@ -1008,8 +1008,8 @@ (defvar *cold-package-symbols*) (declaim (type list *cold-package-symbols*)) -;;; a map from descriptors to symbols, so that we can back up. The key is the -;;; address in the target core. +;;; a map from descriptors to symbols, so that we can back up. The key +;;; is the address in the target core. (defvar *cold-symbols*) (declaim (type hash-table *cold-symbols*)) @@ -1035,7 +1035,12 @@ ;; need is SB!KERNEL:%BYTE-BLT. (let ((package-name (package-name package))) (cond ((find package-name '("COMMON-LISP" "KEYWORD") :test #'string=) - ;; That's OK then. + ;; Cold interning things in these standard packages is OK. + ;; (Cold interning things in the other standard package, + ;; CL-USER, isn't OK. We just use CL-USER to expose symbols + ;; whose homes are in other packages. Thus, trying to cold + ;; intern a symbol whose home package is CL-USER probably + ;; means that a coding error has been made somewhere.) (values)) ((string= package-name "SB!" :end1 3 :end2 3) ;; That looks OK, too. (All the target-code packages @@ -1044,9 +1049,10 @@ (t ;; looks bad: maybe COMMON-LISP-USER? maybe an extension ;; package in the xc host? something we can't think of - ;; a valid reason to dump, anyway... - (bug "internal error: PACKAGE-NAME=~S looks too much like a typo." - package-name)))) + ;; a valid reason to cold intern, anyway... + (error ; not #'BUG, because #'BUG isn't defined yet + "internal error: PACKAGE-NAME=~S looks too much like a typo." + package-name)))) (let (;; Information about each cold-interned symbol is stored ;; in COLD-INTERN-INFO. diff --git a/src/compiler/ir1tran.lisp b/src/compiler/ir1tran.lisp index 74832d6..520b624 100644 --- a/src/compiler/ir1tran.lisp +++ b/src/compiler/ir1tran.lisp @@ -1459,29 +1459,30 @@ (setf (node-lexenv bind) *lexenv*) (let ((cont1 (make-continuation)) - (cont2 (make-continuation))) + (cont2 (make-continuation)) + (revised-body (if (policy bind + (or (> safety + (max speed space)) + (= safety 3))) + ;; (Stuffing this in at IR1 level like + ;; this is pretty crude. And it's + ;; particularly inefficient to execute + ;; it on *every* LAMBDA, including + ;; LET-converted LAMBDAs. Improvements + ;; are welcome, but meanwhile, when + ;; SAFETY is high, it's still arguably + ;; an improvement over the old CMU CL + ;; approach of doing nothing (waiting + ;; for evolution to breed careful + ;; users:-). -- WHN) + `((%detect-stack-exhaustion) + ,@body) + body))) (continuation-starts-block cont1) (link-node-to-previous-continuation bind cont1) (use-continuation bind cont2) (ir1-convert-special-bindings cont2 result - (if (policy bind - (or (> safety - (max speed space)) - (= safety 3))) - ;; (Stuffing this in at IR1 level - ;; like this is pretty crude. And - ;; it's particularly inefficient - ;; to execute it on *every* LAMBDA, - ;; including LET-converted LAMBDAs. - ;; But when SAFETY is high, it's - ;; still arguably an improvement - ;; over the old CMU CL approach of - ;; doing nothing (proactively - ;; waiting for evolution to breed - ;; stronger programmers:-). -- WHN) - `((%detect-stack-exhaustion) - ,@body) - body) + revised-body aux-vars aux-vals (svars))) (let ((block (continuation-block result))) diff --git a/src/compiler/srctran.lisp b/src/compiler/srctran.lisp index db2a385..aa09fb9 100644 --- a/src/compiler/srctran.lisp +++ b/src/compiler/srctran.lisp @@ -3057,7 +3057,7 @@ (multi-compare 'char-lessp args t)) ;;; This function does source transformation of N-arg inequality -;;; functions such as /=. This is similar to Multi-Compare in the <3 +;;; functions such as /=. This is similar to MULTI-COMPARE in the <3 ;;; arg cases. If there are more than two args, then we expand into ;;; the appropriate n^2 comparisons only when speed is important. (declaim (ftype (function (symbol list) *) multi-not-equal)) diff --git a/tests/exhaust.impure.lisp b/tests/exhaust.impure.lisp index 54bd7e7..0956f29 100644 --- a/tests/exhaust.impure.lisp +++ b/tests/exhaust.impure.lisp @@ -1,4 +1,4 @@ -;;;; tests of the system's ability to catch resource exhaustion errors +;;;; tests of the system's ability to catch resource exhaustion problems ;;;; This software is part of the SBCL system. See the README file for ;;;; more information. diff --git a/version.lisp-expr b/version.lisp-expr index 0a3d994..2a0de55 100644 --- a/version.lisp-expr +++ b/version.lisp-expr @@ -18,4 +18,4 @@ ;;; for internal versions, especially for internal versions off the ;;; main CVS branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".) -"0.7.1.46" +"0.7.1.47" -- 1.7.10.4