0.8.3.80:

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

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

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

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))

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.

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))

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

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"