Changeset 12096

Timestamp:

08/12/09 11:29:01 (14 years ago)

Author:

ehuelsmann

Message:

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

Location:

trunk/abcl/src/org/armedbear/lisp

Files:

• compiler-pass1.lisp (modified) (2 diffs)
• compiler-pass2.lisp (modified) (3 diffs)

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

@@ -341 +341 @@
       ;; 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))))
@@ -349 +349 @@
              (*blocks* (cons block *blocks*))
              (protected-form (p1 (cadr form))))
-        (setf (block-form block)
+        (setf (unwind-protect-form block)
               `(unwind-protect ,protected-form
                  (progn ,@unwinding-forms)

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

@@ -7784 +7784 @@
 
 (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)
@@ -7903 +7903 @@
         ((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))
@@ -7946 +7918 @@
            ((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)