Changeset 12100


Ignore:
Timestamp:
08/13/09 20:18:59 (12 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:
3 edited

Legend:

Unmodified
Added
Removed
  • trunk/abcl/src/org/armedbear/lisp/compiler-pass1.lisp

    r12099 r12100  
    341341      ;; However, p1 transforms the forms being processed, so, we
    342342      ;; need to copy the forms to create a second copy.
    343       (let* ((block (make-unwind-protect-node :name '(UNWIND-PROTECT)))
     343      (let* ((block (make-unwind-protect-node))
    344344             ;; a bit of jumping through hoops...
    345345             (unwinding-forms (p1-body (copy-tree (cddr form))))
     
    369369           ;; local return anyway so that UNWIND-PROTECT can catch it and run
    370370           ;; its cleanup forms.
    371            (dformat t "*blocks* = ~S~%" (mapcar #'node-name *blocks*))
     371           ;;(dformat t "*blocks* = ~S~%" (mapcar #'node-name *blocks*))
    372372           (let ((protected (enclosed-by-protected-block-p block)))
    373373             (dformat t "p1-return-from protected = ~S~%" protected)
     
    386386
    387387(defun p1-tagbody (form)
    388   (let* ((block (make-tagbody-node :name '(TAGBODY)))
     388  (let* ((block (make-tagbody-node))
    389389         (*blocks* (cons block *blocks*))
    390390         (*visible-tags* *visible-tags*)
  • trunk/abcl/src/org/armedbear/lisp/compiler-pass2.lisp

    r12099 r12100  
    838838(defun single-valued-p (form)
    839839  (cond ((node-p form)
    840          (if (equal (node-name form) '(TAGBODY))
     840         (if (tagbody-node-p form)
    841841             (not (unsafe-p (node-form form)))
    842842             (single-valued-p (node-form form))))
     
    64116411        ((node-p form)
    64126412         (let ((result t))
    6413            (cond ((equal (node-name form) '(LET))
     6413           (cond ((and (block-node-p form)
     6414                       (equal (block-name form) '(LET)))
    64146415                  ;;              (format t "derive-type LET/LET* node case~%")
    64156416                  (let* ((forms (cddr (node-form form)))
     
    64226423                    ;;                  )
    64236424                    (setf result derived-type)))
    6424                  ((symbolp (node-name form))
     6425                 ((and (block-node-p form)
     6426                       (symbolp (block-name form)))
    64256427                  (unless (block-return-p form)
    64266428                    (let* ((forms (cddr (block-form form)))
  • trunk/abcl/src/org/armedbear/lisp/jvm.lisp

    r12095 r12100  
    363363
    364364(defstruct node
    365   ;; Block name or (TAGBODY) or (LET) or (MULTIPLE-VALUE-BIND).
    366   name
    367365  form
    368366  (compiland *current-compiland*))
     
    433431                       (:include control-transferring-node)
    434432                       (:constructor %make-block-node (name)))
     433  ;; Block name or (TAGBODY) or (LET) or (MULTIPLE-VALUE-BIND).
     434  name
    435435  (exit (gensym))
    436436  target
     
    457457(defun find-block (name)
    458458  (dolist (block *blocks*)
    459     (when (eq name (node-name block))
     459    (when (and (block-node-p block)
     460               (eq name (block-name block)))
    460461      (return block))))
    461462
     
    479480than just restore the lastSpecialBinding (= dynamic environment).
    480481"
    481   (let ((name (node-name object)))
    482     (or (equal name '(CATCH))
    483         (equal name '(UNWIND-PROTECT))
    484         (equal name '(THREADS:SYNCHRONIZED-ON)))))
     482  (or (unwind-protect-node-p object)
     483      (catch-node-p object)
     484      (and (block-node-p object)
     485           (equal (block-name object) '(THREADS:SYNCHRONIZED-ON)))))
    485486
    486487
Note: See TracChangeset for help on using the changeset viewer.