Changeset 8515


Ignore:
Timestamp:
Feb 19, 2008, 8:12:16 AM (14 years ago)
Author:
gb
Message:

Propagate changeset:8513 to trunk.

Location:
trunk/source/compiler
Files:
2 edited

Legend:

Unmodified
Added
Removed
  • trunk/source/compiler/nx0.lisp

    r7939 r8515  
    928928    (nx1-punt-var v (pop initforms))))
    929929
    930 ; at the beginning of a binding construct, note which lexical variables are bound to other
    931 ; variables and the number of setqs done so far on the initform.
    932 ; After executing the body, if neither variable has been closed over,
    933 ; the new variable hasn't been setq'ed, and the old guy wasn't setq'ed
    934 ; in the body, the binding can be punted.
    935 (defun nx1-note-var-bindings (vars initforms &aux alist)
    936   (dolist (var vars alist)
    937     (let* ((binding (nx1-note-var-binding var (pop initforms))))
    938       (if binding (push binding alist)))))
    939930
    940931(defun nx1-note-var-binding (var initform)
     
    961952                                               (the fixnum (afunc-bits afunc))))
    962953              nil)))))))
    963                      
     954
     955
     956;;; Process entries involving variables bound to other variables at
     957;;; the end of a binding construct.  Each entry is of the form
     958;;; (source-var setq-count . target-var), where setq-count is the
     959;;; assignment count of TARGET-VAR at the time that the binding's
     960;;; initform was evaluated (not, in the case of LET, at the time that
     961;;; the bindinw was established.).  If the target isn't closed-over
     962;;; and SETQed (somewhere), and wasn't setqed in the body (e.g.,
     963;;; still has the same assignment-count as it had when the initform
     964;;; was executed), then we can "punt" the source (and replace references
     965;;; to it with references to the target.)
     966;;; It obviously makes no sense to do this if the source is SPECIAL;
     967;;; in some cases (LET), we create the source variable and add it to
     968;;; this alist before it's known whether or not the source variable
     969;;; is SPECIAL. so we have to ignore that case here.
    964970(defun nx1-check-var-bindings (alist)
    965971  (dolist (pair alist)
     
    969975           (target-bits (nx-var-bits target)))
    970976      (unless (or
    971                ; var can't be setq'ed or closed; target can't be setq'ed AND closed.
    972                (neq (%ilogand vbits (%ilogior (%ilsl $vbitsetq 1) (%ilsl $vbitclosed 1))) 0)
     977               ;; var can't be special, setq'ed or closed; target can't be
     978               ;; setq'ed AND closed.
     979               (neq (%ilogand vbits (%ilogior (%ilsl $vbitsetq 1)
     980                                              (%ilsl $vbitclosed 1)
     981                                              (%ilsl $vbitspecial 1))) 0)
    973982               (eq (%ilogior (%ilsl $vbitsetq 1) (%ilsl $vbitclosed 1))
    974983                   (%ilogand
     
    12331242                                     (ash -1 $vbitspecial)
    12341243                                     (%ilsl $vbitclosed 1)) varbits))
    1235           (error "Bug-o-rama - \"punted\" var had bogus bits. ~
     1244          (error "Bug-o-rama - \"punted\" var had bogus bits.
    12361245Or something. Right? ~s ~s" var varbits))
    12371246        (let* ((varcount     (%ilogand $vrefmask varbits))
  • trunk/source/compiler/nx1.lisp

    r7624 r8515  
    17721772
    17731773(defnx1 nx1-let let (pairs &body forms &environment old-env)
    1774   (let* ((vars nil)
    1775          (vals nil)
    1776          (varspecs nil))
     1774  (collect ((vars)
     1775            (vals)
     1776            (varbindings))
    17771777    (with-nx-declarations (pending)
    17781778      (multiple-value-bind (body decls)
    17791779                           (parse-body forms *nx-lexical-environment* nil)
    17801780        (nx-process-declarations pending decls)
    1781         ; Make sure that the initforms are processed in the outer
    1782         ; environment (in case any declaration handlers side-effected
    1783         ; the environment.)
     1781        ;; Make sure that the initforms are processed in the outer
     1782        ;; environment (in case any declaration handlers side-effected
     1783        ;; the environment.)
     1784       
    17841785        (let* ((*nx-lexical-environment* old-env))
    17851786          (dolist (pair pairs)
    1786             (push (nx-need-var (nx-pair-name pair)) vars)
    1787             (push (nx1-typed-var-initform pending (car vars) (nx-pair-initform pair)) vals)))
    1788         (let* ((*nx-bound-vars* (append vars *nx-bound-vars*))
    1789                (varbindings (nx1-note-var-bindings
    1790                              (dolist (sym vars varspecs)
    1791                                (push (nx-new-var pending sym) varspecs))
    1792                              (setq vals (nreverse vals))))
    1793                (form
    1794                 (make-acode
    1795                  (%nx1-operator let)
    1796                  varspecs
    1797                  vals
    1798                  (progn
    1799                    (nx-effect-other-decls pending *nx-lexical-environment*)
    1800                    (nx1-env-body body old-env))
     1787            (let* ((sym (nx-need-var (nx-pair-name pair)))
     1788                   (var (nx-cons-var sym))
     1789                   (val (nx1-typed-var-initform pending sym (nx-pair-initform pair)))
     1790                   (binding (nx1-note-var-binding var val)))
     1791              (vars var)
     1792              (vals val)
     1793              (when binding (varbindings binding)))))
     1794        (let* ((*nx-bound-vars* *nx-bound-vars*)
     1795               (varbindings (varbindings)))
     1796          (dolist (v (vars)) (nx-init-var pending v))
     1797          (let* ((form
     1798                  (make-acode
     1799                   (%nx1-operator let)
     1800                   (vars)
     1801                   (vals)
     1802                   (progn
     1803                     (nx-effect-other-decls pending *nx-lexical-environment*)
     1804                     (nx1-env-body body old-env))
    18011805                 *nx-new-p2decls*)))
    18021806          (nx1-check-var-bindings varbindings)
    1803           (nx1-punt-bindings varspecs vals)
    1804           form)))))
     1807          (nx1-punt-bindings (vars) (vals))
     1808          form))))))
    18051809
    18061810
Note: See TracChangeset for help on using the changeset viewer.