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

[Erik Huelsmann]

Author: ehuelsmann
Date: Mon Aug 24 15:21:13 2009
New Revision: 12116

Log:
Convert LABELS BLOCK-NODEs to LABELS-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	Mon Aug 24 15:21:13 2009
@@ -670,15 +670,15 @@
 	 (let ((*visible-variables* *visible-variables*)
 	       (*current-compiland* (local-function-compiland local-function)))
 	   (p1-compiland (local-function-compiland local-function))))
-       (let* ((block (make-block-node '(LABELS)))
+       (let* ((block (make-labels-node))
               (*blocks* (cons block *blocks*))
               (body (cddr form))
               (*visible-variables* *visible-variables*))
-         (setf (block-free-specials block)
+         (setf (labels-free-specials block)
                (process-declarations-for-vars body nil block))
-         (dolist (special (block-free-specials block))
+         (dolist (special (labels-free-specials block))
            (push special *visible-variables*))
-         (setf (block-form block)
+         (setf (labels-form block)
                (list* (car form) local-functions (p1-body (cddr form))))
          block))))
 

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	Mon Aug 24 15:21:13 2009
@@ -4970,7 +4970,7 @@
 
 (defknown p2-labels-node (t t t) t)
 (defun p2-labels-node (block target representation)
-  (let* ((form (block-form block))
+  (let* ((form (labels-form block))
          (*local-functions* *local-functions*)
          (*visible-variables* *visible-variables*)
          (local-functions (cadr form))
@@ -4985,9 +4985,10 @@
           (setf (variable-register variable) (allocate-register)))))
     (dolist (local-function local-functions)
       (p2-labels-process-compiland local-function))
-    (dolist (special (block-free-specials block))
+    (dolist (special (labels-free-specials block))
       (push special *visible-variables*))
-    (compile-progn-body body target representation)))
+    (let ((*blocks* (cons block *blocks*)))
+      (compile-progn-body body target representation))))
 
 (defun p2-lambda (compiland target)
   (let* ((lambda-list (cadr (compiland-lambda-expression compiland))))
@@ -7914,11 +7915,11 @@
                  (cond
                    ((eq name 'LET)
                     (p2-let/let*-node form target representation))
-                   ((eq name 'LABELS)
-                    (p2-labels-node form target representation))
-                   ((eq name 'SETF) ;; SETF functions create
+;;                   ((eq name 'LABELS)
+;;                    (p2-labels-node form target representation))
+;;                   ((eq name 'SETF) ;; SETF functions create
                     ;; consp block names, if we're unlucky
-                    (p2-block-node form target representation))
+;;                    (p2-block-node form target representation))
                    (t
                     (print name)
                     (aver (not "Can't happen.")))
@@ -7936,6 +7937,8 @@
             (fix-boxing representation nil))
            ((flet-node-p form)
             (p2-flet-node form target representation))
+           ((labels-node-p form)
+            (p2-labels-node form target representation))
            ((locally-node-p form)
             (p2-locally-node form target representation))
            ((catch-node-p form)