Ignore:
Timestamp:
08/28/09 09:04:44 (12 years ago)
Author:
ehuelsmann
Message:

Convert LET BLOCK-NODEs to LET/LET*-NODEs and
clean up the BLOCK-NODE structure to serve BLOCKs only.

File:
1 edited

Legend:

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

    r12120 r12123  
    40734073(defun propagate-vars (block)
    40744074  (let ((removed '()))
    4075     (dolist (variable (block-vars block))
     4075    (dolist (variable (let-vars block))
    40764076      (unless (or (variable-special-p variable)
    40774077                  (variable-closure-index variable))
     
    41054105                                  (let* ((symbol (get (variable-name variable)
    41064106                                                      'sys::dotimes-index-variable-name))
    4107                                          (index-variable (find-variable symbol (block-vars block))))
     4107                                         (index-variable (find-variable symbol (let-vars block))))
    41084108                                    (when index-variable
    41094109                                      (setf (get (variable-name index-variable)
     
    41204120    (when removed
    41214121      (dolist (variable removed)
    4122         (setf (block-vars block) (remove variable (block-vars block)))))))
     4122        (setf (let-vars block) (remove variable (let-vars block)))))))
    41234123
    41244124(defun derive-variable-representation (variable block
     
    41574157                  (limit-variable (and name
    41584158                                       (or (find-variable name
    4159                                                           (block-vars block))
     4159                                                          (let-vars block))
    41604160                                           (find-visible-variable name)))))
    41614161             (when limit-variable
     
    42654265(defknown p2-let-bindings (t) t)
    42664266(defun p2-let-bindings (block)
    4267   (dolist (variable (block-vars block))
     4267  (dolist (variable (let-vars block))
    42684268    (unless (or (variable-special-p variable)
    42694269                (variable-closure-index variable)
     
    42804280    ;; because we'll lose JVM stack consistency if there is a non-local
    42814281    ;; transfer of control from one of the initforms.
    4282     (dolist (variable (block-vars block))
     4282    (dolist (variable (let-vars block))
    42834283      (let* ((initform (variable-initform variable))
    42844284             (unused-p (and (not (variable-special-p variable))
     
    43214321      (compile-binding (cdr temp))))
    43224322  ;; Now make the variables visible.
    4323   (dolist (variable (block-vars block))
     4323  (dolist (variable (let-vars block))
    43244324    (push variable *visible-variables*))
    43254325  t)
     
    43304330    (declare (type boolean must-clear-values))
    43314331    ;; Generate code to evaluate initforms and bind variables.
    4332     (dolist (variable (block-vars block))
     4332    (dolist (variable (let-vars block))
    43334333      (let* ((initform (variable-initform variable))
    43344334             (unused-p (and (not (variable-special-p variable))
     
    44024402
    44034403(defun p2-let/let*-node (block target representation)
    4404   (let* ((*blocks* (cons block *blocks*))
     4404  (let* (
    44054405         (*register* *register*)
    4406          (form (block-form block))
     4406         (form (let-form block))
    44074407         (*visible-variables* *visible-variables*)
    44084408         (specialp nil)
    44094409         (label-START (gensym)))
    44104410    ;; Walk the variable list looking for special bindings and unused lexicals.
    4411     (dolist (variable (block-vars block))
     4411    (dolist (variable (let-vars block))
    44124412      (cond ((variable-special-p variable)
    44134413             (setf specialp t))
     
    44174417    (when specialp
    44184418      ;; We need to save current dynamic environment.
    4419       (setf (block-environment-register block) (allocate-register))
    4420       (save-dynamic-environment (block-environment-register block))
     4419      (setf (let-environment-register block) (allocate-register))
     4420      (save-dynamic-environment (let-environment-register block))
    44214421      (label label-START))
    44224422    (propagate-vars block)
     
    44274427       (p2-let*-bindings block)))
    44284428    ;; Make declarations of free specials visible.
    4429     (dolist (variable (block-free-specials block))
     4429    (dolist (variable (let-free-specials block))
    44304430      (push variable *visible-variables*))
    44314431    ;; Body of LET/LET*.
    44324432    (with-saved-compiler-policy
    44334433      (process-optimization-declarations (cddr form))
    4434       (compile-progn-body (cddr form) target representation))
     4434      (let ((*blocks* (cons block *blocks*)))
     4435        (compile-progn-body (cddr form) target representation)))
    44354436    (when specialp
    4436       (restore-environment-and-make-handler (block-environment-register block)
     4437      (restore-environment-and-make-handler (let-environment-register block)
    44374438              label-START))))
    44384439
     
    79087909        ((var-ref-p form)
    79097910         (compile-var-ref form target representation))
    7910         ((block-node-p form)
    7911          (let ((name (block-name form)))
    7912            (if (not (consp name))
    7913                (p2-block-node form target representation)
    7914                (let ((name (car name)))
    7915                  (cond
    7916                    ((eq name 'LET)
    7917                     (p2-let/let*-node form target representation))
    7918                    ((eq name 'SETF) ;; SETF functions create
    7919                     ;; consp block names, if we're unlucky
    7920                     (p2-block-node form target representation))
    7921                    (t
    7922                     (print name)
    7923                     (aver (not "Can't happen.")))
    7924                    )))))
    79257911        ((node-p form)
    79267912         (cond
     7913           ((block-node-p form)
     7914            (p2-block-node form target representation))
     7915           ((let/let*-node-p form)
     7916            (p2-let/let*-node form target representation))
    79277917           ((tagbody-node-p form)
    79287918            (p2-tagbody-node form target)
Note: See TracChangeset for help on using the changeset viewer.