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

[Erik Huelsmann]

Author: ehuelsmann
Date: Thu Aug 13 17:13:54 2009
New Revision: 12102

Log:
Convert PROGV block-nodes to PROGV-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	Thu Aug 13 17:13:54 2009
@@ -779,7 +779,7 @@
       (return-from p1-progv (p1 new-form))))
   (let* ((symbols-form (p1 (cadr form)))
          (values-form (p1 (caddr form)))
-         (block (make-block-node '(PROGV)))
+         (block (make-progv-node))
          (*blocks* (cons block *blocks*))
          (body (cdddr form)))
 ;;  The (commented out) block below means to detect compile-time
@@ -790,9 +790,9 @@
 ;;      (dolist (name (second symbols-form))
 ;;        (let ((variable (make-variable :name name :special-p t)))
 ;;          (push 
-    (setf (block-form block)
+    (setf (progv-form block)
           `(progv ,symbols-form ,values-form ,@(p1-body body))
-          (block-environment-register block) t)
+          (progv-environment-register block) t)
     block))
 
 (defknown rewrite-progv (t) t)

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	Thu Aug 13 17:13:54 2009
@@ -4791,12 +4791,12 @@
 
 (defun p2-progv-node (block target representation)
   (declare (ignore representation))
-  (let* ((form (block-form block))
+  (let* ((form (progv-form block))
          (symbols-form (cadr form))
          (values-form (caddr form))
          (*register* *register*)
          (environment-register
-          (setf (block-environment-register block) (allocate-register)))
+          (setf (progv-environment-register block) (allocate-register)))
          (label-START (gensym)))
     (compile-form symbols-form 'stack nil)
     (compile-form values-form 'stack nil)
@@ -7920,19 +7920,11 @@
                    ((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)