Changeset 11819 for trunk/abcl/src/org/armedbear/lisp/compiler-pass1.lisp

Timestamp:

05/03/09 08:46:39 (14 years ago)

Author:

ehuelsmann

Message:

Small refactoring: introduce a centralized definition of
"enclosed by a block which associates extensive cleanup
with a transfer of control exception".

Also some reordering of functions in jvm.lisp.

File:

• trunk/abcl/src/org/armedbear/lisp/compiler-pass1.lisp (modified) (2 diffs)

trunk/abcl/src/org/armedbear/lisp/compiler-pass1.lisp

@@ -313 +313 @@
            ;; its cleanup forms.
            (dformat t "*blocks* = ~S~%" (mapcar #'block-name *blocks*))
-           (let ((protected
-                  (dolist (enclosing-block *blocks*)
-                    (when (eq enclosing-block block)
-                      (return nil))
-                    (when (block-requires-non-local-exit-p enclosing-block)
-                      (return t)))))
+           (let ((protected (enclosed-by-protected-block-p block)))
              (dformat t "p1-return-from protected = ~S~%" protected)
              (when protected
@@ -366 +361 @@
       (cond ((eq (tag-compiland tag) *current-compiland*)
              ;; Does the GO leave an enclosing UNWIND-PROTECT?
-             (let ((protected
-                    (dolist (enclosing-block *blocks*)
-                      (when (eq enclosing-block tag-block)
-                        (return nil))
-                      (when (block-requires-non-local-exit-p enclosing-block)
-                        (return t)))))
-               (when protected
-                 (setf (block-non-local-go-p tag-block) t))))
+             (when (enclosed-by-protected-block-p tag-block)
+               (setf (block-non-local-go-p tag-block) t)))
             (t
              (setf (block-non-local-go-p tag-block) t)))))