Changeset 12123


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.

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

Legend:

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

    r12116 r12123  
    201201  (declare (type cons form))
    202202  (let* ((*visible-variables* *visible-variables*)
    203          (block (make-block-node '(LET)))
    204          (*blocks* (cons block *blocks*))
     203         (block (make-let/let*-node))
    205204         (op (%car form))
    206205         (varlist (cadr form))
     
    223222        (when (special-variable-p (variable-name variable))
    224223          (setf (variable-special-p variable) t
    225                 (block-environment-register block) t)))
     224                (let-environment-register block) t)))
    226225      ;; For processing declarations, we want to walk the variable list from
    227226      ;; last to first, since declarations apply to the last-defined variable
    228227      ;; with the specified name.
    229       (setf (block-free-specials block)
     228      (setf (let-free-specials block)
    230229            (process-declarations-for-vars body (reverse vars) block))
    231       (setf (block-vars block) vars)
     230      (setf (let-vars block) vars)
    232231      ;; Make free specials visible.
    233       (dolist (variable (block-free-specials block))
     232      (dolist (variable (let-free-specials block))
    234233        (push variable *visible-variables*)))
    235     (setf body (p1-body body))
    236     (setf (block-form block) (list* op varlist body))
     234    (let ((*blocks* (cons block *blocks*)))
     235      (setf body (p1-body body)))
     236    (setf (let-form block) (list* op varlist body))
    237237    block))
    238238
  • 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)
  • trunk/abcl/src/org/armedbear/lisp/jvm.lisp

    r12101 r12123  
    439439  return-p
    440440  ;; True if there is a non-local RETURN from this block.
    441   non-local-return-p
    442   ;; If non-nil, register containing saved dynamic environment for this block.
    443   environment-register
    444   ;; Only used in LET/LET*/M-V-B nodes.
    445   vars
    446   free-specials
    447   )
     441  non-local-return-p)
    448442
    449443(defvar *blocks* ())
     
    482476  (or (unwind-protect-node-p object)
    483477      (catch-node-p object)
    484       (synchronized-node-p object)
    485       (and (block-node-p object)
    486            (equal (block-name object) '(THREADS:SYNCHRONIZED-ON)))))
     478      (synchronized-node-p object)))
    487479
    488480
     
    504496    (when (eq enclosing-block outermost-block)
    505497      (return nil))
    506     (when (or (and (binding-node-p enclosing-block)
    507                    (binding-node-environment-register enclosing-block))
    508               (and (block-node-p enclosing-block)
    509                    (block-environment-register enclosing-block)))
     498    (when (and (binding-node-p enclosing-block)
     499               (binding-node-environment-register enclosing-block))
    510500      (return t))))
    511501
     
    521511           (or (and (binding-node-p block)
    522512                    (binding-node-environment-register block))
    523                (and (block-node-p block)
    524                     (block-environment-register block))
    525513               last-register)))
    526514    (reduce #'outermost-register *blocks*
Note: See TracChangeset for help on using the changeset viewer.