0.8.3.80:

        * FROB-DO-BODY: wrap a body in an additional TAGBODY.

diff --git a/NEWS b/NEWS
index 05c1438..3dc1c06 100644 (file)
--- a/NEWS
+++ b/NEWS
@@ -1985,6 +1985,8 @@ changes in sbcl-0.8.3 relative to sbcl-0.8.2:
     used when the result is truncated to 32 bits.
   * VALUES declaration is partially enabled.
   * fixes in SB-GROVEL (thanks to Andreas Fuchs)
+  * bug fix: result form in DO is not contained in the implicit
+    TAGBODY.
   * fixed some bugs revealed by Paul Dietz' test suite:
     ** The system now obeys the constraint imposed by
        UPGRADED-ARRAY-ELEMENT-TYPE that the upgraded array element

diff --git a/src/code/defboot.lisp b/src/code/defboot.lisp
index 978a3c8..2cd77e9 100644 (file)
--- a/src/code/defboot.lisp
+++ b/src/code/defboot.lisp
@@ -285,14 +285,14 @@
 (defmacro-mundanely dotimes ((var count &optional (result nil)) &body body)
   (cond ((numberp count)
         `(do ((,var 0 (1+ ,var)))
-          ((>= ,var ,count) ,result)
-          (declare (type unsigned-byte ,var))
-          ,@body))
+              ((>= ,var ,count) ,result)
+            (declare (type unsigned-byte ,var))
+            ,@body))
        (t (let ((v1 (gensym)))
             `(do ((,var 0 (1+ ,var)) (,v1 ,count))
-              ((>= ,var ,v1) ,result)
-              (declare (type unsigned-byte ,var))
-              ,@body)))))
+                  ((>= ,var ,v1) ,result)
+                (declare (type unsigned-byte ,var))
+                ,@body)))))
 
 (defmacro-mundanely dolist ((var list &optional (result nil)) &body body)
   ;; We repeatedly bind the var instead of setting it so that we never

diff --git a/src/code/numbers.lisp b/src/code/numbers.lisp
index bcd2c0c..3632cd6 100644 (file)
--- a/src/code/numbers.lisp
+++ b/src/code/numbers.lisp
@@ -1358,8 +1358,8 @@
 #.
 (collect ((forms))
   (flet ((definition (name lambda-list width pattern)
-           ;; We rely on (SUBTYPEP `(UNSIGNED-BYTE ,WIDTH)
-           ;;                      'BIGNUM-ELEMENT-TYPE)
+           (assert (sb!xc:subtypep `(unsigned-byte ,width)
+                                   'bignum-element-type))
            `(defun ,name ,lambda-list
               (flet ((prepare-argument (x)
                        (declare (integer x))

diff --git a/src/code/primordial-extensions.lisp b/src/code/primordial-extensions.lisp
index a70b2c2..48be86d 100644 (file)
--- a/src/code/primordial-extensions.lisp
+++ b/src/code/primordial-extensions.lisp
@@ -104,13 +104,13 @@
           (,bind ,(nreverse r-inits)
                  ,@decls
                  (tagbody
-                  (go ,label-2)
-                  ,label-1
-                  ,@code
-                  (,step ,@(nreverse r-steps))
-                  ,label-2
-                  (unless ,(first endlist) (go ,label-1))
-                  (return-from ,block (progn ,@(rest endlist))))))))))
+                     (go ,label-2)
+                     ,label-1
+                     (tagbody ,@code)
+                     (,step ,@(nreverse r-steps))
+                     ,label-2
+                     (unless ,(first endlist) (go ,label-1))
+                     (return-from ,block (progn ,@(rest endlist))))))))))
 
 ;;; This is like DO, except it has no implicit NIL block. Each VAR is
 ;;; initialized in parallel to the value of the specified INIT form.

diff --git a/src/compiler/ir1util.lisp b/src/compiler/ir1util.lisp
index 41d7a58..d909bf1 100644 (file)
--- a/src/compiler/ir1util.lisp
+++ b/src/compiler/ir1util.lisp
@@ -792,10 +792,10 @@
                  (dolist (child (lambda-children lambda))
                    (if (eq (functional-kind child) :deleted)
                        (delete-children child)
-                       (delete-lambda child))
-                   (setf (lambda-children lambda) nil))
+                       (delete-lambda child)))
+                 (setf (lambda-children lambda) nil)
                  (setf (lambda-parent lambda) nil)))
-      (delete-children clambda)))
+        (delete-children clambda)))
     (dolist (let (lambda-lets clambda))
       (setf (lambda-bind let) nil)
       (setf (functional-kind let) :deleted))

diff --git a/tests/compiler.pure-cload.lisp b/tests/compiler.pure-cload.lisp
index 28f17a9..c21dad7 100644 (file)
--- a/tests/compiler.pure-cload.lisp
+++ b/tests/compiler.pure-cload.lisp
@@ -101,6 +101,20 @@
            (optimize (speed 3) (safety 1) (debug 1)))
   (let ((v3 (min -1720 b))) (max v3 (logcount (if (= v3 b) b b)))))
 
+;;; 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))
+                                  :loop
+                                   (unless x (return :bad))))
+              (error () :good))
+            :good))
+(assert (eq (handler-case (eval `(do* ((x '(1 2 3) (cdr x)))
+                                      ((endp x) (go :loop))
+                                  :loop
+                                   (unless x (return :bad))))
+              (error () :good))
+            :good))
+
 ;;; bug 282
 ;;;
 ;;; Verify type checking policy in full calls: the callee is supposed

diff --git a/version.lisp-expr b/version.lisp-expr
index d3c49a8..6354209 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.79"
+"0.8.3.80"