Changeset 12104


Ignore:
Timestamp:
08/14/09 21:08:05 (12 years ago)
Author:
ehuelsmann
Message:

Switch MULTIPLE-VALUE-BIND block-nodes to M-V-B-NODEs.

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

Legend:

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

    r12103 r12104  
    256256      (return-from p1-m-v-b (p1-let/let* new-form))))
    257257  (let* ((*visible-variables* *visible-variables*)
    258          (block (make-block-node '(MULTIPLE-VALUE-BIND)))
     258         (block (make-m-v-b-node))
     259         (varlist (cadr form))
     260         ;; Process the values-form first. ("The scopes of the name binding and
     261         ;; declarations do not include the values-form.")
     262         (values-form (p1 (caddr form)))
    259263         (*blocks* (cons block *blocks*))
    260          (varlist (cadr form))
    261          (values-form (caddr form))
    262264         (body (cdddr form)))
    263     ;; Process the values-form first. ("The scopes of the name binding and
    264     ;; declarations do not include the values-form.")
    265     (setf values-form (p1 values-form))
    266265    (let ((vars ()))
    267266      (dolist (symbol varlist)
     
    274273        (when (special-variable-p (variable-name variable))
    275274          (setf (variable-special-p variable) t
    276                 (block-environment-register block) t)))
    277       (setf (block-free-specials block)
     275                (m-v-b-environment-register block) t)))
     276      (setf (m-v-b-free-specials block)
    278277            (process-declarations-for-vars body vars block))
    279       (dolist (special (block-free-specials block))
     278      (dolist (special (m-v-b-free-specials block))
    280279        (push special *visible-variables*))
    281       (setf (block-vars block) (nreverse vars)))
     280      (setf (m-v-b-vars block) (nreverse vars)))
    282281    (setf body (p1-body body))
    283     (setf (block-form block)
     282    (setf (m-v-b-form block)
    284283          (list* 'MULTIPLE-VALUE-BIND varlist values-form body))
    285284    block))
  • trunk/abcl/src/org/armedbear/lisp/compiler-pass2.lisp

    r12103 r12104  
    39883988
    39893989(defun p2-m-v-b-node (block target)
    3990   (let* ((*blocks* (cons block *blocks*))
    3991          (*register* *register*)
    3992          (form (block-form block))
     3990  (let* ((*register* *register*)
     3991         (form (m-v-b-form block))
    39933992         (*visible-variables* *visible-variables*)
    39943993         (vars (second form))
    39953994         (bind-special-p nil)
    3996          (variables (block-vars block))
     3995         (variables (m-v-b-vars block))
    39973996         (label-START (gensym)))
    39983997    (dolist (variable variables)
     
    40074006      (dformat t "p2-m-v-b-node lastSpecialBinding~%")
    40084007      ;; Save current dynamic environment.
    4009       (setf (block-environment-register block) (allocate-register))
    4010       (save-dynamic-environment (block-environment-register block))
     4008      (setf (m-v-b-environment-register block) (allocate-register))
     4009      (save-dynamic-environment (m-v-b-environment-register block))
    40114010      (label label-START))
    40124011    ;; Make sure there are no leftover values from previous calls.
     
    40634062    (dolist (variable variables)
    40644063      (push variable *visible-variables*))
    4065     (dolist (variable (block-free-specials block))
     4064    (dolist (variable (m-v-b-free-specials block))
    40664065      (push variable *visible-variables*))
    40674066    ;; Body.
    4068     (compile-progn-body (cdddr form) target)
     4067    (let ((*blocks* (cons block *blocks*)))
     4068      (compile-progn-body (cdddr form) target))
    40694069    (when bind-special-p
    40704070      (restore-environment-and-make-handler (block-environment-register block)
     
    79187918                   ((eq name 'LABELS)
    79197919                    (p2-labels-node form target representation))
    7920                    ((eq name 'MULTIPLE-VALUE-BIND)
    7921                     (p2-m-v-b-node form target)
    7922                     (fix-boxing representation nil))
    79237920                   )))))
    79247921        ((node-p form)
     
    79297926           ((unwind-protect-node-p form)
    79307927            (p2-unwind-protect-node form target)
     7928            (fix-boxing representation nil))
     7929           ((m-v-b-node-p form)
     7930            (p2-m-v-b-node form target)
    79317931            (fix-boxing representation nil))
    79327932           ((locally-node-p form)
     
    79407940            (p2-threads-synchronized-on form target)
    79417941            (fix-boxing representation nil))
     7942           (t
     7943            (aver (not "Can't happen")))
    79427944))
    79437945        ((constantp form)
Note: See TracChangeset for help on using the changeset viewer.