Changeset 12100

Timestamp:

08/13/09 20:18:59 (14 years ago)

Author:

ehuelsmann

Message:

Move the NAME field from the NODE to the BLOCK-NODE;
with the other node types, it's no longer required to
distinguish nodes by the content of their NAME field.

BLOCKs have NAMEs; CATCHes have TAGs. So, in the end,
the NAME field belongs in the BLOCK-NODE.

Location:

trunk/abcl/src/org/armedbear/lisp

Files:

• compiler-pass1.lisp (modified) (3 diffs)
• compiler-pass2.lisp (modified) (3 diffs)
• jvm.lisp (modified) (4 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-unwind-protect-node :name '(UNWIND-PROTECT)))
+      (let* ((block (make-unwind-protect-node))
              ;; a bit of jumping through hoops...
              (unwinding-forms (p1-body (copy-tree (cddr form))))
@@ -369 +369 @@
            ;; local return anyway so that UNWIND-PROTECT can catch it and run
            ;; its cleanup forms.
-           (dformat t "*blocks* = ~S~%" (mapcar #'node-name *blocks*))
+           ;;(dformat t "*blocks* = ~S~%" (mapcar #'node-name *blocks*))
            (let ((protected (enclosed-by-protected-block-p block)))
              (dformat t "p1-return-from protected = ~S~%" protected)
@@ -386 +386 @@
 
 (defun p1-tagbody (form)
-  (let* ((block (make-tagbody-node :name '(TAGBODY)))
+  (let* ((block (make-tagbody-node))
          (*blocks* (cons block *blocks*))
          (*visible-tags* *visible-tags*)

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

@@ -838 +838 @@
 (defun single-valued-p (form)
   (cond ((node-p form)
-         (if (equal (node-name form) '(TAGBODY))
+         (if (tagbody-node-p form)
              (not (unsafe-p (node-form form)))
              (single-valued-p (node-form form))))
@@ -6411 +6411 @@
         ((node-p form)
          (let ((result t))
-           (cond ((equal (node-name form) '(LET))
+           (cond ((and (block-node-p form)
+                       (equal (block-name form) '(LET)))
                   ;;              (format t "derive-type LET/LET* node case~%")
                   (let* ((forms (cddr (node-form form)))
@@ -6422 +6423 @@
                     ;;                  )
                     (setf result derived-type)))
-                 ((symbolp (node-name form))
+                 ((and (block-node-p form)
+                       (symbolp (block-name form)))
                   (unless (block-return-p form)
                     (let* ((forms (cddr (block-form form)))

trunk/abcl/src/org/armedbear/lisp/jvm.lisp

@@ -363 +363 @@
 
 (defstruct node
-  ;; Block name or (TAGBODY) or (LET) or (MULTIPLE-VALUE-BIND).
-  name
   form
   (compiland *current-compiland*))
@@ -433 +431 @@
                        (:include control-transferring-node)
                        (:constructor %make-block-node (name)))
+  ;; Block name or (TAGBODY) or (LET) or (MULTIPLE-VALUE-BIND).
+  name
   (exit (gensym))
   target
@@ -457 +457 @@
 (defun find-block (name)
   (dolist (block *blocks*)
-    (when (eq name (node-name block))
+    (when (and (block-node-p block)
+               (eq name (block-name block)))
       (return block))))
 
@@ -479 +480 @@
 than just restore the lastSpecialBinding (= dynamic environment).
 "
-  (let ((name (node-name object)))
-    (or (equal name '(CATCH))
-        (equal name '(UNWIND-PROTECT))
-        (equal name '(THREADS:SYNCHRONIZED-ON)))))
+  (or (unwind-protect-node-p object)
+      (catch-node-p object)
+      (and (block-node-p object)
+           (equal (block-name object) '(THREADS:SYNCHRONIZED-ON)))))