git » jacl.git » commit 7890d45

diff --git a/boot.lisp b/boot.lisp
index 323720c..a8d1110 100644
--- a/boot.lisp
+++ b/boot.lisp
@@ -503,39 +503,24 @@
                                              (%mapcar (lambda (step-form)
                                                         (when (caddr step-form)
                                                           `(setq ,(car step-form) ,(caddr step-form))))
-                                                      step-forms)))
-         (end#                      (gensym "end")))
+                                                      step-forms))))
     `(block nil
        (let ,bindings
          (tagbody
             ,begin#
-            (if ,end-test-form (go ,end#))
+            (if ,end-test-form
+                (return (progn ,@result-forms)))
             ,@assignments
             ,@body
-            (go ,begin#)
-            ,end#
-            (progn ,@result-forms))))))
+            (go ,begin#))))))
 
 (%export 'dolist)
 (defmacro dolist (binding &rest body)
-  (let ((var         (car binding))
-        (list#       (gensym "list"))
-        (result-form (caddr binding))
-        (begin#      (gensym "begin"))
-        (end#        (gensym "end")))
-    `(block nil
-       (let ((,var   nil)
-             (,list# ,(cadr binding)))
-         (tagbody
-            ,begin#
-            (if (null ,list#) (go ,end#))
-            (setq ,var (car ,list#))
-            ,@body
-            (setq ,list# (cdr ,list#))
-            (go ,begin#)
-            ,end#)
-         (setq ,var nil)
-         ,result-form))))
+  (let ((list# (gensym "list")))
+    `(do ((,(car binding) nil (car ,list#))
+          (,list# ,(cadr binding) (cdr ,list#)))
+         ((not ,list#) ,(caddr binding))
+       ,@body)))
 
 ;; designators
 
diff --git a/jacl-tests.lisp b/jacl-tests.lisp
index 33ac26e..00af486 100644
--- a/jacl-tests.lisp
+++ b/jacl-tests.lisp
@@ -159,7 +159,12 @@
     (assert=
      (dolist (i '(1 2 3 4 5) x)
        (setq x (+ x i)))
-     15)))
+     15))
+  (assert=
+   (dolist (i '(1 2 3))
+     (when (eql i 2)
+       (return i)))
+   2))
 
 (start-tests)