0.8.3.81:

        * DOLIST: take CDR before execution of the body as suggested
          by Paul F. Dietz;
        * DELETE-COMPONENT: do not try to delete deleted lambda
          (bug reported by Paul Dietz);
        * fix building with #+HIGH-SECURITY:
        ... {IN,OUT}-SYNONYM-OF: fix comma placing;
        ... src/pcl/gray-streams.lisp: make redefinition of
          {INPUT,OUTPUT}-STREAM-P be atomic.

diff --git a/NEWS b/NEWS
index c7c736c..30e4b50 100644 (file)
--- a/NEWS
+++ b/NEWS
@@ -2062,6 +2062,9 @@ changes in sbcl-0.8.4 relative to sbcl-0.8.3:
     streams.  (thanks to Nikodemus Siivola)
   * bug fix: result form in DO is not contained in the implicit
     TAGBODY.
+  * incompatible change: ICR structure is changed; the value part of
+    CONTINUATION is now called LVAR; corresponding functions are
+    renamed (e.g. SB-C::CONTINUATION-TYPE has become SB-C::LVAR-TYPE).
   * fixed some bugs revealed by Paul Dietz' test suite:
     ** the RETURN clause in LOOP is now equivalent to DO (RETURN ...).
     ** ROUND and FROUND now give the right answer when given very

diff --git a/src/code/defboot.lisp b/src/code/defboot.lisp
index 2cd77e9..f05fb0a 100644 (file)
--- a/src/code/defboot.lisp
+++ b/src/code/defboot.lisp
@@ -304,18 +304,23 @@
   ;; since we don't want to use IGNORABLE on what might be a special
   ;; var.
   (multiple-value-bind (forms decls) (parse-body body :doc-string-allowed nil)
-    (let ((n-list (gensym)))
-      `(do* ((,n-list ,list (cdr ,n-list)))
-       ((endp ,n-list)
-        ,@(if result
-              `((let ((,var nil))
-                  ,var
-                  ,result))
-              '(nil)))
-       (let ((,var (car ,n-list)))
-         ,@decls
-         (tagbody
-            ,@forms))))))
+    (let ((n-list (gensym "N-LIST"))
+          (start (gensym "START")))
+      `(block nil
+         (let ((,n-list ,list))
+           (tagbody
+              ,start
+              (unless (endp ,n-list)
+                (let ((,var (car ,n-list)))
+                  ,@decls
+                  (setq ,n-list (cdr ,n-list))
+                  (tagbody ,@forms))
+                (go ,start))))
+         ,(if result
+              `(let ((,var nil))
+                 ,var
+                 ,result)
+               nil)))))
 \f
 ;;;; conditions, handlers, restarts
 

diff --git a/src/code/sysmacs.lisp b/src/code/sysmacs.lisp
index dc1358e..6a7100f 100644 (file)
--- a/src/code/sysmacs.lisp
+++ b/src/code/sysmacs.lisp
@@ -59,7 +59,7 @@
                         :datum ,svar
                         :expected-type '(satisfies input-stream-p)
                         :format-control "~S isn't an input stream"
-                        :format-arguments ,(list  svar)))              
+                        :format-arguments (list ,svar)))
                ,svar)))))
 (defmacro out-synonym-of (stream &optional check-type)
   (let ((svar (gensym)))
@@ -73,7 +73,7 @@
                         :datum ,svar
                         :expected-type '(satisfies output-stream-p)
                         :format-control "~S isn't an output stream."
-                        :format-arguments ,(list  svar)))
+                        :format-arguments (list ,svar)))
                ,svar)))))
 
 ;;; WITH-mumble-STREAM calls the function in the given SLOT of the

diff --git a/src/compiler/ir1util.lisp b/src/compiler/ir1util.lisp
index d909bf1..5ac3a6a 100644 (file)
--- a/src/compiler/ir1util.lisp
+++ b/src/compiler/ir1util.lisp
@@ -838,7 +838,7 @@
                  (delete clambda (tail-set-funs tails)))
            (setf (lambda-tail-set clambda) nil))
          (setf (component-lambdas component)
-               (delete clambda (component-lambdas component)))))
+               (delq clambda (component-lambdas component)))))
 
     ;; If the lambda is an XEP, then we null out the ENTRY-FUN in its
     ;; ENTRY-FUN so that people will know that it is not an entry
@@ -1236,10 +1236,11 @@
   (do-blocks (block component)
     (setf (block-delete-p block) t))
   (dolist (fun (component-lambdas component))
-    (setf (functional-kind fun) nil)
-    (setf (functional-entry-fun fun) nil)
-    (setf (leaf-refs fun) nil)
-    (delete-functional fun))
+    (unless (eq (functional-kind fun) :deleted)
+      (setf (functional-kind fun) nil)
+      (setf (functional-entry-fun fun) nil)
+      (setf (leaf-refs fun) nil)
+      (delete-functional fun)))
   (do-blocks (block component)
     (delete-block block))
   (values))

diff --git a/src/compiler/srctran.lisp b/src/compiler/srctran.lisp
index cd22846..a403e28 100644 (file)
--- a/src/compiler/srctran.lisp
+++ b/src/compiler/srctran.lisp
@@ -2268,8 +2268,7 @@
 
 (defoptimizer (integer-length derive-type) ((x))
   (let ((x-type (lvar-type x)))
-    (when (and (numeric-type-p x-type)
-               (csubtypep x-type (specifier-type 'integer)))
+    (when (numeric-type-p x-type)
       ;; If the X is of type (INTEGER LO HI), then the INTEGER-LENGTH
       ;; of X is (INTEGER (MIN lo hi) (MAX lo hi), basically.  Be
       ;; careful about LO or HI being NIL, though.  Also, if 0 is

diff --git a/src/pcl/gray-streams.lisp b/src/pcl/gray-streams.lisp
index b273412..554c904 100644 (file)
--- a/src/pcl/gray-streams.lisp
+++ b/src/pcl/gray-streams.lisp
@@ -60,29 +60,31 @@
 
 (setf (fdefinition 'close) #'pcl-close)
 \f
-(fmakunbound 'input-stream-p)
+(let ()
+  (fmakunbound 'input-stream-p)
 
-(defgeneric input-stream-p (stream)
-  #+sb-doc
-  (:documentation "Can STREAM perform input operations?"))
+  (defgeneric input-stream-p (stream)
+    #+sb-doc
+    (:documentation "Can STREAM perform input operations?"))
 
-(defmethod input-stream-p ((stream ansi-stream))
-  (ansi-stream-input-stream-p stream))
+  (defmethod input-stream-p ((stream ansi-stream))
+    (ansi-stream-input-stream-p stream))
 
-(defmethod input-stream-p ((stream fundamental-input-stream))
-  t)
+  (defmethod input-stream-p ((stream fundamental-input-stream))
+    t))
 \f
-(fmakunbound 'output-stream-p)
+(let ()
+  (fmakunbound 'output-stream-p)
 
-(defgeneric output-stream-p (stream)
-  #+sb-doc
-  (:documentation "Can STREAM perform output operations?"))
+  (defgeneric output-stream-p (stream)
+    #+sb-doc
+    (:documentation "Can STREAM perform output operations?"))
 
-(defmethod output-stream-p ((stream ansi-stream))
-  (ansi-stream-output-stream-p stream))
+  (defmethod output-stream-p ((stream ansi-stream))
+    (ansi-stream-output-stream-p stream))
 
-(defmethod output-stream-p ((stream fundamental-output-stream))
-  t)
+  (defmethod output-stream-p ((stream fundamental-output-stream))
+    t))
 \f
 ;;; character input streams
 ;;;

diff --git a/tests/compiler.pure-cload.lisp b/tests/compiler.pure-cload.lisp
index c21dad7..854c1a5 100644 (file)
--- a/tests/compiler.pure-cload.lisp
+++ b/tests/compiler.pure-cload.lisp
@@ -101,6 +101,11 @@
            (optimize (speed 3) (safety 1) (debug 1)))
   (let ((v3 (min -1720 b))) (max v3 (logcount (if (= v3 b) b b)))))
 
+(defun #:foo (d)
+  (let ((v7 (flet ((%f16 () (labels ((%f3 () -8)) (%f3))))
+              (labels ((%f7 () (%f16)))  d))))
+    132887443))
+
 ;;; RESULT-FORM in DO is not contained in the implicit TAGBODY
 (assert (eq (handler-case (eval `(do ((x '(1 2 3) (cdr x)))
                                      ((endp x) (go :loop))

diff --git a/version.lisp-expr b/version.lisp-expr
index 6354209..c75f4ad 100644 (file)
--- 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.8.3.80"
+"0.8.3.81"