[armedbear-cvs] r12096 - trunk/abcl/src/org/armedbear/lisp

[Erik Huelsmann]

Author: ehuelsmann
Date: Wed Aug 12 07:29:01 2009
New Revision: 12096

Log:
Switch UNWIND-PROTECT block-nodes to UNWIND-PROTECT-NODEs.

Modified:
   trunk/abcl/src/org/armedbear/lisp/compiler-pass1.lisp
   trunk/abcl/src/org/armedbear/lisp/compiler-pass2.lisp

Modified: trunk/abcl/src/org/armedbear/lisp/compiler-pass1.lisp
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/compiler-pass1.lisp	(original)
+++ trunk/abcl/src/org/armedbear/lisp/compiler-pass1.lisp	Wed Aug 12 07:29:01 2009
@@ -340,7 +340,7 @@
       ;;
       ;; However, p1 transforms the forms being processed, so, we
       ;; need to copy the forms to create a second copy.
-      (let* ((block (make-block-node '(UNWIND-PROTECT)))
+      (let* ((block (make-unwind-protect-node :name '(UNWIND-PROTECT)))
              ;; a bit of jumping through hoops...
              (unwinding-forms (p1-body (copy-tree (cddr form))))
              (unprotected-forms (p1-body (cddr form)))
@@ -348,7 +348,7 @@
              ;; protected by the UNWIND-PROTECT block
              (*blocks* (cons block *blocks*))
              (protected-form (p1 (cadr form))))
-        (setf (block-form block)
+        (setf (unwind-protect-form block)
               `(unwind-protect ,protected-form
                  (progn , at unwinding-forms)
                  , at unprotected-forms))

Modified: trunk/abcl/src/org/armedbear/lisp/compiler-pass2.lisp
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/compiler-pass2.lisp	(original)
+++ trunk/abcl/src/org/armedbear/lisp/compiler-pass2.lisp	Wed Aug 12 07:29:01 2009
@@ -7783,7 +7783,7 @@
     (emit-move-from-stack target)))
 
 (defun p2-unwind-protect-node (block target)
-  (let ((form (block-form block)))
+  (let ((form (unwind-protect-form block)))
     (when (= (length form) 2) ; No cleanup form.
       (compile-form (second form) target nil)
       (return-from p2-unwind-protect-node))
@@ -7902,40 +7902,12 @@
                 (aver nil))))
         ((var-ref-p form)
          (compile-var-ref form target representation))
-        ((block-node-p form)
-         (let ((name (block-name form)))
-           (if (not (consp name))
-               (p2-block-node form target representation)
-               (let ((name (car name)))
-                 (cond
-                   ((eq name 'LET)
-                    (p2-let/let*-node form target representation))
-                   ((eq name 'FLET)
-                    (p2-flet-node form target representation))
-                   ((eq name 'LABELS)
-                    (p2-labels-node form target representation))
-                   ((eq name 'MULTIPLE-VALUE-BIND)
-                    (p2-m-v-b-node form target)
-                    (fix-boxing representation nil))
-                   ((eq name 'UNWIND-PROTECT)
-                    (p2-unwind-protect-node form target)
-                    (fix-boxing representation nil))
-                   ((eq name 'CATCH)
-                    (p2-catch-node form target)
-                    (fix-boxing representation nil))
-                   ((eq name 'PROGV)
-                    (p2-progv-node form target representation))
-                   ((eq name 'LOCALLY)
-                    (p2-locally-node form target representation))
-                   ((eq name 'THREADS:SYNCHRONIZED-ON)
-                    (p2-threads-synchronized-on form target)
-                    (fix-boxing representation nil)))))))
         ((node-p form)
          (cond
-           ((tagbody-node-p form)
+           ((tagbody-node-p form) ;; done
             (p2-tagbody-node form target)
             (fix-boxing representation nil))
-           ((unwind-protect-node-p form)
+           ((unwind-protect-node-p form) ;; done
             (p2-unwind-protect-node form target)
             (fix-boxing representation nil))
            ((locally-node-p form)
@@ -7945,6 +7917,32 @@
             (fix-boxing representation nil))
            ((progv-node-p form)
             (p2-progv-node form target representation))
+           ((block-node-p form)
+            (let ((name (block-name form)))
+              (if (not (consp name))
+                  (p2-block-node form target representation)
+                  ;; TODO: this branch of the IF is to be eliminated
+                  (let ((name (car name)))
+                    (cond
+                      ((eq name 'LET)
+                       (p2-let/let*-node form target representation))
+                      ((eq name 'FLET)
+                       (p2-flet-node form target representation))
+                      ((eq name 'LABELS)
+                       (p2-labels-node form target representation))
+                      ((eq name 'MULTIPLE-VALUE-BIND)
+                       (p2-m-v-b-node form target)
+                       (fix-boxing representation nil))
+                      ((eq name 'CATCH)
+                       (p2-catch-node form target)
+                       (fix-boxing representation nil))
+                      ((eq name 'LOCALLY)
+                       (p2-locally-node form target representation))
+                      ((eq name 'PROGV)
+                       (p2-progv-node form target representation))
+                      ((eq name 'THREADS:SYNCHRONIZED-ON)
+                       (p2-threads-synchronized-on form target)
+                       (fix-boxing representation nil)))))))
 ))
         ((constantp form)
          (compile-constant form target representation))