Changeset 11559


Ignore:
Timestamp:
Dec 28, 2008, 12:10:06 PM (11 years ago)
Author:
gb
Message:

Allow unwritten inherited variables to be assigned to NVRs; use NX2 layer
for more things.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/source/compiler/X86/x862.lisp

    r11451 r11559  
    203203
    204204(defvar *x862-result-reg* x8664::arg_z)
     205
     206(defvar *x8664-nvrs*
     207  `(,x8664::save0 ,x8664::save1 ,x8664::save2 ,x8664::save3))
     208
     209(defvar *reduced-x8664-nvrs*
     210  `(,x8664::save0 ,x8664::save1 ,x8664::save2))
     211
     212(defvar *x8632-nvrs* ())
     213
    205214
    206215(defvar *x862-arg-z* nil)
     
    894903
    895904
    896 (defun %x862-bigger-cdr-than (x y)
    897   (declare (cons x y))
    898   (> (the fixnum (cdr x)) (the fixnum (cdr y))))
    899 
    900 ;;; Return an unordered list of "varsets": each var in a varset can be
    901 ;;; assigned a register and all vars in a varset can be assigned the
    902 ;;; same register (e.g., no scope conflicts.)
    903 
    904 (defun x862-partition-vars (vars)
    905   (labels ((var-weight (var)
    906              (let* ((bits (nx-var-bits var)))
    907                (declare (fixnum bits))
    908                (if (eql 0 (logand bits (logior
    909                                         (ash 1 $vbitpuntable)
    910                                         (ash -1 $vbitspecial)
    911                                         (ash 1 $vbitnoreg))))
    912                  (if (eql (logior (ash 1 $vbitclosed) (ash 1 $vbitsetq))
    913                           (logand bits (logior (ash 1 $vbitclosed) (ash 1 $vbitsetq))))
    914                    0
    915                    (%i+ (%ilogand $vrefmask bits) (%ilsr 8 (%ilogand $vsetqmask bits))))
    916                  0)))
    917            (sum-weights (varlist)
    918              (let ((sum 0))
    919                (dolist (v varlist sum) (incf sum (var-weight v)))))
    920            (vars-disjoint-p (v1 v2)
    921              (if (eq v1 v2)
    922                nil
    923                (if (memq v1 (var-binding-info v2))
    924                  nil
    925                  (if (memq v2 (var-binding-info v1))
    926                    nil
    927                    t)))))
    928     (setq vars (%sort-list-no-key
    929                 ;(delete-if #'(lambda (v) (eql (var-weight v) 0)) vars)
    930                 (do* ((handle (cons nil vars))
    931                       (splice handle))
    932                      ((null (cdr splice)) (cdr handle))                 
    933                   (declare (dynamic-extent handle) (type cons handle splice))
    934                   (if (eql 0 (var-weight (%car (cdr splice))))
    935                     (rplacd splice (%cdr (cdr splice)))
    936                     (setq splice (cdr splice))))
    937                 #'(lambda (v1 v2) (%i> (var-weight v1) (var-weight v2)))))
    938     ;; This isn't optimal.  It partitions all register-allocatable
    939     ;; variables into sets such that
    940     ;; 1) no variable is a member of more than one set and
    941     ;; 2) all variables in a given set are disjoint from each other
    942     ;; A set might have exactly one member.
    943     ;; If a register is allocated for any member of a set, it's
    944     ;; allocated for all members of that set.
    945     (let* ((varsets nil))
    946       (do* ((all vars (cdr all)))
    947            ((null all))
    948         (let* ((var (car all)))
    949           (when (dolist (already varsets t)
    950                   (when (memq var (car already)) (return)))
    951             (let* ((varset (cons var nil)))
    952               (dolist (v (cdr all))
    953                 (when (dolist (already varsets t)
    954                         (when (memq v (car already)) (return)))
    955                   (when (dolist (d varset t)
    956                           (unless (vars-disjoint-p v d) (return)))
    957                     (push v varset))))
    958               (let* ((weight (sum-weights varset)))
    959                 (declare (fixnum weight))
    960                 (if (>= weight 3)
    961                   (push (cons (nreverse varset) weight) varsets)))))))
    962       varsets)))
    963 
    964 ;;; Maybe globally allocate registers to symbols naming functions & variables,
    965 ;;; and to simple lexical variables.
    966 (defun x862-allocate-global-registers (fcells vcells all-vars no-regs)
    967   (if (or no-regs (target-arch-case (:x8632 t)))
    968     (progn
    969       (dolist (c fcells) (%rplacd c nil))
    970       (dolist (c vcells) (%rplacd c nil))
    971       (values 0 nil))
    972     (let* ((maybe (x862-partition-vars all-vars)))
    973       (dolist (c fcells)
    974         (if (>= (the fixnum (cdr c)) 3) (push c maybe)))
    975       (dolist (c vcells)
    976         (if (>= (the fixnum (cdr c)) 3) (push c maybe)))
    977       (do* ((things (%sort-list-no-key maybe #'%x862-bigger-cdr-than) (cdr things))
    978             (n 0 (1+ n))
    979             (registers (target-arch-case
    980                         (:x8632 (error "no nvrs on x8632"))
    981                         (:x8664
    982                          (if (= (backend-lisp-context-register *target-backend*) x8664::save3)
    983                            (list x8664::save0 x8664::save1 x8664::save2)
    984                            (list x8664::save0 x8664::save1 x8664::save2 x8664::save3)))))
    985             (regno (pop registers) (pop registers))
    986             (constant-alist ()))
    987            ((or (null things) (null regno))
    988             (dolist (cell fcells) (%rplacd cell nil))
    989             (dolist (cell vcells) (%rplacd cell nil))
    990             (values n constant-alist))
    991         (declare (list things)
    992                  (fixnum n regno))
    993         (let* ((thing (car things)))
    994           (if (or (memq thing fcells)
    995                   (memq thing vcells))
    996             (push (cons thing regno) constant-alist)
    997             (dolist (var (car thing))
    998               (nx-set-var-bits var
    999                                (%ilogior (%ilogand (%ilognot $vrefmask) (nx-var-bits var))
    1000                                  regno
    1001                                  (%ilsl $vbitreg 1))))))))))
    1002 
    1003 
    1004905   
    1005906;;; Vpush the last N non-volatile-registers.
     
    1063964      (x862-set-var-ea seg arg (var-ea arg))
    1064965      (let* ((lcell (pop lcells)))
    1065         (if (setq reg (x862-assign-register-var arg))
     966        (if (setq reg (nx2-assign-register-var arg))
    1066967          (x862-init-regvar seg arg reg (x862-vloc-ea vloc))
    1067968          (x862-bind-var seg arg vloc lcell))
     
    1071972      (x862-set-var-ea seg arg (var-ea arg))
    1072973      (let* ((lcell (pop lcells)))
    1073         (if (setq reg (x862-assign-register-var arg))
     974        (if (setq reg (nx2-assign-register-var arg))
    1074975          (x862-init-regvar seg arg reg (x862-vloc-ea vloc))
    1075976          (x862-bind-var seg arg vloc lcell))
     
    1084985          (x862-set-var-ea seg var (var-ea var))
    1085986          (let* ((lcell (pop lcells)))
    1086             (if (setq reg (x862-assign-register-var var))
     987            (if (setq reg (nx2-assign-register-var var))
    1087988              (x862-init-regvar seg var reg (x862-vloc-ea vloc))
    1088989              (x862-bind-var seg var vloc lcell))
     
    1092993    (if lexpr
    1093994      (progn
    1094         (if (setq reg (x862-assign-register-var rest))
     995        (if (setq reg (nx2-assign-register-var rest))
    1095996          (progn
    1096997            (x862-copy-register seg reg *x862-arg-z*)
     
    11011002              (x862-bind-var seg rest loc *x862-top-vstack-lcell*))))
    11021003      (let* ((rvloc (+ vloc (* 2 *x862-target-node-size* nkeys))))
    1103         (if (setq reg (x862-assign-register-var rest))
     1004        (if (setq reg (nx2-assign-register-var rest))
    11041005          (x862-init-regvar seg rest reg (x862-vloc-ea rvloc))
    11051006          (x862-bind-var seg rest rvloc (pop lcells))))))
     
    11161017             (lcell (pop lcells))
    11171018             (splcell (pop splcells))
    1118              (reg (x862-assign-register-var var))
     1019             (reg (nx2-assign-register-var var))
    11191020             (regloadedlabel (if reg (backend-get-next-label))))
    11201021        (unless (nx-null initform)
     
    11321033          (x862-bind-var seg var vloc lcell))
    11331034        (when spvar
    1134           (if (setq reg (x862-assign-register-var spvar))
     1035          (if (setq reg (nx2-assign-register-var spvar))
    11351036            (x862-init-regvar seg spvar reg (x862-vloc-ea spvloc))
    11361037            (x862-bind-var seg spvar spvloc splcell))))
     
    11441045      (let* ((spvar (pop keysupp))
    11451046             (initform (pop keyinits))
    1146              (reg (x862-assign-register-var var))
     1047             (reg (nx2-assign-register-var var))
    11471048             (regloadedlabel (if reg (backend-get-next-label)))
    11481049             (var-lcell (pop lcells))
     
    11631064          (x862-bind-var seg var vloc var-lcell))
    11641065        (when spvar
    1165           (if (setq reg (x862-assign-register-var spvar))
     1066          (if (setq reg (nx2-assign-register-var spvar))
    11661067            (x862-init-regvar seg spvar reg (x862-vloc-ea sploc))
    11671068            (x862-bind-var seg spvar sploc sp-lcell))))
     
    11721073(defun x862-vpush-arg-register (seg reg var)
    11731074  (when var
    1174     (let* ((bits (nx-var-bits var)))
    1175       (declare (fixnum bits))
    1176       (if (logbitp $vbitreg bits)
    1177         var
    1178         (progn
    1179           (x862-vpush-register seg reg :reserved)
    1180           nil)))))
     1075    (if (var-nvr var)
     1076      var
     1077      (progn
     1078        (x862-vpush-register seg reg :reserved)
     1079        nil))))
    11811080
    11821081
     
    14011300  (apply (svref *x862-specials* (%ilogand operator-id-mask op)) seg vreg xfer forms))
    14021301
    1403 ;;; Returns true iff lexical variable VAR isn't setq'ed in FORM.
    1404 ;;; Punts a lot ...
    1405 (defun x862-var-not-set-by-form-p (var form)
    1406   (let* ((bits (nx-var-bits var)))
    1407     (or (not (%ilogbitp $vbitsetq bits))
    1408         (x862-setqed-var-not-set-by-form-p var form (logbitp $vbitclosed bits)))))
    1409 
    1410 (defun x862-setqed-var-not-set-by-form-p (var form &optional closed)
    1411   (setq form (acode-unwrapped-form form))
    1412   (or (atom form)
    1413       (x86-constant-form-p form)
    1414       (x862-lexical-reference-p form)
    1415       (let ((op (acode-operator form))
    1416             (subforms nil))
    1417         (if (eq op (%nx1-operator setq-lexical))
    1418           (and (neq var (cadr form))
    1419                (x862-setqed-var-not-set-by-form-p var (caddr form)))
    1420           (and (or (not closed)
    1421                    (logbitp operator-side-effect-free-bit op))
    1422                (flet ((not-set-in-formlist (formlist)
    1423                         (dolist (subform formlist t)
    1424                           (unless (x862-setqed-var-not-set-by-form-p var subform closed) (return)))))
    1425                  (if
    1426                    (cond ((%ilogbitp operator-acode-subforms-bit op) (setq subforms (%cdr form)))
    1427                          ((%ilogbitp operator-acode-list-bit op) (setq subforms (cadr form))))
    1428                    (not-set-in-formlist subforms)
    1429                    (and (or (eq op (%nx1-operator call))
    1430                             (eq op (%nx1-operator lexical-function-call)))
    1431                         (x862-setqed-var-not-set-by-form-p var (cadr form))
    1432                         (setq subforms (caddr form))
    1433                         (not-set-in-formlist (car subforms))
    1434                         (not-set-in-formlist (cadr subforms))))))))))
    14351302
    14361303(defun x862-check-fixnum-overflow (seg target &optional labelno)
     
    15421409      (! set-nargs n))))
    15431410
    1544 (defun x862-assign-register-var (v)
    1545   (let ((bits (nx-var-bits v)))
    1546     (when (%ilogbitp $vbitreg bits)
    1547       (%ilogand bits $vrefmask))))
     1411
    15481412
    15491413(defun x862-single-float-bits (the-sf)
     
    26992563            (destructuring-bind (fn-form (stack-args reg-args) &optional spread-p) (%cdr body)
    27002564               (unless (and (eq spread-p t)
    2701                            (eq (x862-lexical-reference-p (%car reg-args)) rest))
     2565                           (eq (nx2-lexical-reference-p (%car reg-args)) rest))
    27022566                (return nil))
    27032567              (flet ((independent-of-all-values (form)       
    27042568                       (setq form (acode-unwrapped-form-value form))
    27052569                       (or (x86-constant-form-p form)
    2706                            (let* ((lexref (x862-lexical-reference-p form)))
     2570                           (let* ((lexref (nx2-lexical-reference-p form)))
    27072571                             (and lexref
    27082572                                  (neq lexref rest)
    27092573                                  (dolist (val rest-values t)
    2710                                     (unless (x862-var-not-set-by-form-p lexref val)
     2574                                    (unless (nx2-var-not-set-by-form-p lexref val)
    27112575                                      (return))))))))
    27122576                (unless (or (eq op (%nx1-operator lexical-function-call))
     
    27292593              (setq body (%cadr body))
    27302594              (if (and (eq op (%nx1-operator if))
    2731                        (eq (x862-lexical-reference-p (%cadr body)) rest))
     2595                       (eq (nx2-lexical-reference-p (%cadr body)) rest))
    27322596                (setq body (%caddr body))
    27332597                (return nil)))))))))
     
    27452609              (setq arglist (list nil (reverse stack-args)))
    27462610              (setq arglist (list (butlast stack-args *x862-target-num-arg-regs*) (reverse (last stack-args *x862-target-num-arg-regs*)))))))))
    2747     (let* ((lexref (x862-lexical-reference-p fn))
     2611    (let* ((lexref (nx2-lexical-reference-p fn))
    27482612           (simple-case (or (fixnump fn)
    27492613                            (typep fn 'lreg)
     
    27542618                             (flet ((all-simple (args)
    27552619                                      (dolist (arg args t)
    2756                                         (when (and arg (not (x862-var-not-set-by-form-p lexref arg)))
     2620                                        (when (and arg (not (nx2-var-not-set-by-form-p lexref arg)))
    27572621                                          (return)))))
    27582622                               (and (all-simple (car arglist))
     
    33553219  (unless (typep breg 'lreg)
    33563220    (warn "~s is not an lreg (2/2)" breg))
    3357   (let* ((avar (x862-lexical-reference-p aform))
     3221  (let* ((avar (nx2-lexical-reference-p aform))
    33583222         (atriv (x862-trivial-p bform))
    33593223         (aconst (and (not atriv) (or (x86-side-effect-free-form-p aform)
    3360                                       (if avar (x862-var-not-set-by-form-p avar bform)))))
     3224                                      (if avar (nx2-var-not-set-by-form-p avar bform)))))
    33613225         apushed)
    33623226    (progn
     
    33753239(defun x862-two-untargeted-reg-forms (seg aform areg bform breg)
    33763240  (with-x86-local-vinsn-macros (seg)
    3377     (let* ((avar (x862-lexical-reference-p aform))
     3241    (let* ((avar (nx2-lexical-reference-p aform))
    33783242           (adest areg)
    33793243           (bdest breg)
    33803244           (atriv (x862-trivial-p bform))
    33813245           (aconst (and (not atriv) (or (x86-side-effect-free-form-p aform)
    3382                                         (if avar (x862-var-not-set-by-form-p avar bform)))))
     3246                                        (if avar (nx2-var-not-set-by-form-p avar bform)))))
    33833247           (apushed (not (or atriv aconst))))
    33843248      (progn
     
    34093273         (aconst (and (not atriv)
    34103274                      (or (x86-side-effect-free-form-p aform)
    3411                           (let ((avar (x862-lexical-reference-p aform)))
     3275                          (let ((avar (nx2-lexical-reference-p aform)))
    34123276                            (and avar
    3413                                  (x862-var-not-set-by-form-p avar bform)
    3414                                  (x862-var-not-set-by-form-p avar cform))))))
     3277                                 (nx2-var-not-set-by-form-p avar bform)
     3278                                 (nx2-var-not-set-by-form-p avar cform))))))
    34153279         (bconst (and (not btriv)
    34163280                      (or
    34173281                       (x86-side-effect-free-form-p bform)
    3418                        (let ((bvar (x862-lexical-reference-p bform)))
    3419                          (and bvar (x862-var-not-set-by-form-p bvar cform))))))
     3282                       (let ((bvar (nx2-lexical-reference-p bform)))
     3283                         (and bvar (nx2-var-not-set-by-form-p bvar cform))))))
    34203284         (apushed nil)
    34213285         (bpushed nil))
     
    34593323         (aconst (and (not atriv)
    34603324                      (or (x86-side-effect-free-form-p aform)
    3461                           (let ((avar (x862-lexical-reference-p aform)))
     3325                          (let ((avar (nx2-lexical-reference-p aform)))
    34623326                            (and avar
    3463                                  (x862-var-not-set-by-form-p avar bform)
    3464                                  (x862-var-not-set-by-form-p avar cform)
    3465                                  (x862-var-not-set-by-form-p avar dform))))))
     3327                                 (nx2-var-not-set-by-form-p avar bform)
     3328                                 (nx2-var-not-set-by-form-p avar cform)
     3329                                 (nx2-var-not-set-by-form-p avar dform))))))
    34663330         (bconst (and (not btriv)
    34673331                      (or
    34683332                       (x86-side-effect-free-form-p bform)
    3469                        (let ((bvar (x862-lexical-reference-p bform)))
     3333                       (let ((bvar (nx2-lexical-reference-p bform)))
    34703334                         (and bvar
    3471                               (x862-var-not-set-by-form-p bvar cform)
    3472                               (x862-var-not-set-by-form-p bvar dform))))))
     3335                              (nx2-var-not-set-by-form-p bvar cform)
     3336                              (nx2-var-not-set-by-form-p bvar dform))))))
    34733337         (cconst (and (not ctriv)
    34743338                      (or
    34753339                       (x86-side-effect-free-form-p cform)
    3476                        (let ((cvar (x862-lexical-reference-p cform)))
    3477                          (and cvar (x862-var-not-set-by-form-p cvar dform))))))
     3340                       (let ((cvar (nx2-lexical-reference-p cform)))
     3341                         (and cvar (nx2-var-not-set-by-form-p cvar dform))))))
    34783342         (apushed nil)
    34793343         (bpushed nil)
     
    35153379           (aconst (and (not atriv)
    35163380                        (or (x86-side-effect-free-form-p aform)
    3517                             (let ((avar (x862-lexical-reference-p aform)))
     3381                            (let ((avar (nx2-lexical-reference-p aform)))
    35183382                              (and avar
    3519                                    (x862-var-not-set-by-form-p avar bform)
    3520                                    (x862-var-not-set-by-form-p avar cform))))))
     3383                                   (nx2-var-not-set-by-form-p avar bform)
     3384                                   (nx2-var-not-set-by-form-p avar cform))))))
    35213385           (bconst (and (not btriv)
    35223386                        (or
    35233387                         (x86-side-effect-free-form-p bform)
    3524                          (let ((bvar (x862-lexical-reference-p bform)))
    3525                            (and bvar (x862-var-not-set-by-form-p bvar cform))))))
     3388                         (let ((bvar (nx2-lexical-reference-p bform)))
     3389                           (and bvar (nx2-var-not-set-by-form-p bvar cform))))))
    35263390           (adest areg)
    35273391           (bdest breg)
     
    35603424         (aconst (and (not atriv)
    35613425                      (or (x86-side-effect-free-form-p aform)
    3562                           (let ((avar (x862-lexical-reference-p aform)))
     3426                          (let ((avar (nx2-lexical-reference-p aform)))
    35633427                            (and avar
    3564                                  (x862-var-not-set-by-form-p avar bform)
    3565                                  (x862-var-not-set-by-form-p avar cform)
    3566                                  (x862-var-not-set-by-form-p avar dform))))))
     3428                                 (nx2-var-not-set-by-form-p avar bform)
     3429                                 (nx2-var-not-set-by-form-p avar cform)
     3430                                 (nx2-var-not-set-by-form-p avar dform))))))
    35673431         (bconst (and (not btriv)
    35683432                      (or
    35693433                       (x86-side-effect-free-form-p bform)
    3570                        (let ((bvar (x862-lexical-reference-p bform)))
     3434                       (let ((bvar (nx2-lexical-reference-p bform)))
    35713435                         (and bvar
    3572                               (x862-var-not-set-by-form-p bvar cform)
    3573                               (x862-var-not-set-by-form-p bvar dform))))))
     3436                              (nx2-var-not-set-by-form-p bvar cform)
     3437                              (nx2-var-not-set-by-form-p bvar dform))))))
    35743438         (cconst (and (not ctriv)
    35753439                      (or
    35763440                       (x86-side-effect-free-form-p cform)
    3577                        (let ((cvar (x862-lexical-reference-p cform)))
     3441                       (let ((cvar (nx2-lexical-reference-p cform)))
    35783442                         (and cvar
    3579                               (x862-var-not-set-by-form-p cvar dform))))))
     3443                              (nx2-var-not-set-by-form-p cvar dform))))))
    35803444         (adest areg)
    35813445         (bdest breg)
     
    44984362              (progn
    44994363                (let* ((vloc *x862-vstack*)
    4500                        (reg (let* ((r (x862-assign-register-var var)))
     4364                       (reg (let* ((r (nx2-assign-register-var var)))
    45014365                              (if r ($ r)))))
    45024366                  (if (x862-load-ea-p val)
     
    49634827                  (%ilogand (%ilogior (%ilsl $vbitclosed 1) (%ilsl $vbitsetq 1)) bits)))))))
    49644828
    4965 (defun x862-lexical-reference-p (form)
    4966   (when (acode-p form)
    4967     (let ((op (acode-operator (setq form (acode-unwrapped-form-value form)))))
    4968       (when (or (eq op (%nx1-operator lexical-reference))
    4969                 (eq op (%nx1-operator inherited-arg)))
    4970         (%cadr form)))))
     4829
    49714830
    49724831(defun x862-ref-symbol-value (seg vreg xfer sym check-boundp)
     
    54855344(defun x862-bind-structured-var (seg var vloc lcell &optional context)
    54865345  (if (not (x862-structured-var-p var))
    5487     (let* ((reg (x862-assign-register-var var)))
     5346    (let* ((reg (nx2-assign-register-var var)))
    54885347      (if reg
    54895348        (x862-init-regvar seg var reg (x862-vloc-ea vloc))
     
    61516010              (setq no-regs (%ilogbitp $fbitnoregs fbits)))
    61526011        (multiple-value-setq (pregs reglocatives)
    6153           (x862-allocate-global-registers *x862-fcells* *x862-vcells* (afunc-all-vars afunc) no-regs))
     6012          (nx2-allocate-global-registers
     6013           *x862-fcells*
     6014           *x862-vcells*
     6015           (afunc-all-vars afunc)
     6016           inherited-vars
     6017           (unless no-regs
     6018             (target-arch-case
     6019              (:x8664
     6020               (if (= (backend-lisp-context-register *target-backend*) x8664::save3)
     6021                 *reduced-x8664-nvrs*
     6022                 *x8664-nvrs*))
     6023              (:x8632
     6024               *x8632-nvrs*)))))
    61546025        (@ (backend-get-next-label)) ; generic self-reference label, should be label #1
    61556026        (! establish-fn)
     
    63186189              (let* ((var (car vars)))
    63196190                (when var
    6320                   (let* ((reg (x862-assign-register-var var)))
     6191                  (let* ((reg (nx2-assign-register-var var)))
    63216192                    (x862-copy-register seg reg arg-reg-num)
    63226193                    (setf (var-ea var) reg))))))
     
    77907661        (dolist (var vars)
    77917662          (let* ((lcell (pop lcells))
    7792                  (reg (x862-assign-register-var var)))
     7663                 (reg (nx2-assign-register-var var)))
    77937664            (if reg
    77947665              (x862-init-regvar seg var reg (x862-vloc-ea vloc))
     
    83618232        (setq val (%car valcopy))
    83628233        (cond ((or (%ilogbitp $vbitspecial (setq bits (nx-var-bits var)))
    8363                    (and (%ilogbitp $vbitreg bits)
     8234                   (and (var-nvr var)
    83648235                        (dolist (val (%cdr valcopy))
    83658236                          (unless (x862-trivial-p val) (return t)))))
Note: See TracChangeset for help on using the changeset viewer.