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

diff --git a/make-host-2.sh b/make-host-2.sh
index 19a7552..637914a 100644 (file)
--- 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 
                                       (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)))))
                                        (safety 2)
                                        (space 1)
                                       (speed 2)))))

diff --git a/src/code/sort.lisp b/src/code/sort.lisp
index 49aa8f0..de92015 100644 (file)
--- 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 (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.
     (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 (file)
--- 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."
   #!+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*)
   (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)))
   "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)
   (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))
             ;; 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))
     (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 (file)
--- 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)
 (proclaim '(optimize (compilation-speed 1)
                     (debug #+sb-show 2 #-sb-show 1)
                     (inhibit-warnings 2)

-                    (safety 1)
+                    (safety 2)

                     (space 1)
                     (speed 2)))
 \f
                     (space 1)
                     (speed 2)))
 \f

@@ -268,7 +268,7 @@
 ;;; easiest thing to do is to read them out of package-data-list.lisp-expr
 ;;; now?
 \f
 ;;; easiest thing to do is to read them out of package-data-list.lisp-expr
 ;;; now?
 \f

-;;;; 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")
 ;;;; 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 (file)
--- 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)))
 ;;; 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 * (*))))
     (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))
             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))))))
             t)
            (t
             (give-up-ir1-transform))))))

diff --git a/src/compiler/generic/genesis.lisp b/src/compiler/generic/genesis.lisp
index a7c39ee..0e20313 100644 (file)
--- 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*))
 
 (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*))
 
 (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=)
   ;; 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
           (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
          (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.
 
   (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 (file)
--- a/src/compiler/ir1tran.lisp
+++ b/src/compiler/ir1tran.lisp
@@ -1459,29 +1459,30 @@
        (setf (node-lexenv bind) *lexenv*)
        
        (let ((cont1 (make-continuation))
        (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
          (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)))
                                        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 (file)
--- 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
   (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))
 ;;; 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 (file)
--- 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.
 
 ;;;; 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 (file)
--- 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".)
 
 ;;; 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"