Changeset 12096


Ignore:
Timestamp:
08/12/09 11:29:01 (12 years ago)
Author:
ehuelsmann
Message:

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

Location:
trunk/abcl/src/org/armedbear/lisp
Files:
2 edited

Legend:

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

    r12094 r12096  
    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-block-node '(UNWIND-PROTECT)))
     343      (let* ((block (make-unwind-protect-node :name '(UNWIND-PROTECT)))
    344344             ;; a bit of jumping through hoops...
    345345             (unwinding-forms (p1-body (copy-tree (cddr form))))
     
    349349             (*blocks* (cons block *blocks*))
    350350             (protected-form (p1 (cadr form))))
    351         (setf (block-form block)
     351        (setf (unwind-protect-form block)
    352352              `(unwind-protect ,protected-form
    353353                 (progn ,@unwinding-forms)
  • trunk/abcl/src/org/armedbear/lisp/compiler-pass2.lisp

    r12094 r12096  
    77847784
    77857785(defun p2-unwind-protect-node (block target)
    7786   (let ((form (block-form block)))
     7786  (let ((form (unwind-protect-form block)))
    77877787    (when (= (length form) 2) ; No cleanup form.
    77887788      (compile-form (second form) target nil)
     
    79037903        ((var-ref-p form)
    79047904         (compile-var-ref form target representation))
    7905         ((block-node-p form)
    7906          (let ((name (block-name form)))
    7907            (if (not (consp name))
    7908                (p2-block-node form target representation)
    7909                (let ((name (car name)))
    7910                  (cond
    7911                    ((eq name 'LET)
    7912                     (p2-let/let*-node form target representation))
    7913                    ((eq name 'FLET)
    7914                     (p2-flet-node form target representation))
    7915                    ((eq name 'LABELS)
    7916                     (p2-labels-node form target representation))
    7917                    ((eq name 'MULTIPLE-VALUE-BIND)
    7918                     (p2-m-v-b-node form target)
    7919                     (fix-boxing representation nil))
    7920                    ((eq name 'UNWIND-PROTECT)
    7921                     (p2-unwind-protect-node form target)
    7922                     (fix-boxing representation nil))
    7923                    ((eq name 'CATCH)
    7924                     (p2-catch-node form target)
    7925                     (fix-boxing representation nil))
    7926                    ((eq name 'PROGV)
    7927                     (p2-progv-node form target representation))
    7928                    ((eq name 'LOCALLY)
    7929                     (p2-locally-node form target representation))
    7930                    ((eq name 'THREADS:SYNCHRONIZED-ON)
    7931                     (p2-threads-synchronized-on form target)
    7932                     (fix-boxing representation nil)))))))
    79337905        ((node-p form)
    79347906         (cond
    7935            ((tagbody-node-p form)
     7907           ((tagbody-node-p form) ;; done
    79367908            (p2-tagbody-node form target)
    79377909            (fix-boxing representation nil))
    7938            ((unwind-protect-node-p form)
     7910           ((unwind-protect-node-p form) ;; done
    79397911            (p2-unwind-protect-node form target)
    79407912            (fix-boxing representation nil))
     
    79467918           ((progv-node-p form)
    79477919            (p2-progv-node form target representation))
     7920           ((block-node-p form)
     7921            (let ((name (block-name form)))
     7922              (if (not (consp name))
     7923                  (p2-block-node form target representation)
     7924                  ;; TODO: this branch of the IF is to be eliminated
     7925                  (let ((name (car name)))
     7926                    (cond
     7927                      ((eq name 'LET)
     7928                       (p2-let/let*-node form target representation))
     7929                      ((eq name 'FLET)
     7930                       (p2-flet-node form target representation))
     7931                      ((eq name 'LABELS)
     7932                       (p2-labels-node form target representation))
     7933                      ((eq name 'MULTIPLE-VALUE-BIND)
     7934                       (p2-m-v-b-node form target)
     7935                       (fix-boxing representation nil))
     7936                      ((eq name 'CATCH)
     7937                       (p2-catch-node form target)
     7938                       (fix-boxing representation nil))
     7939                      ((eq name 'LOCALLY)
     7940                       (p2-locally-node form target representation))
     7941                      ((eq name 'PROGV)
     7942                       (p2-progv-node form target representation))
     7943                      ((eq name 'THREADS:SYNCHRONIZED-ON)
     7944                       (p2-threads-synchronized-on form target)
     7945                       (fix-boxing representation nil)))))))
    79487946))
    79497947        ((constantp form)
Note: See TracChangeset for help on using the changeset viewer.