Changeset 14982


Ignore:
Timestamp:
Sep 15, 2011, 9:46:53 PM (13 years ago)
Author:
Gary Byers
Message:

We've traditionally tried to estimate the number of references/assignments
to a VAR by using two 8-bit fields in its VAR-BITS slot. That means that
we have to treat 255 references/assignments as being infinite (rather than
"unusually large"); we're also out of bits on 32-bit machines.
Stop using these bitfields; use two new slots in the VAR istruct instead.
We've been inconsisten about whether or not the bitfields were loop-weighted
or not. They aren't, but the VAR-REFS slot in the per-function version of
a VAR is.

Change frontend sources to stop using the bitfields; add accessors/setters
for the new slots and use them instead. Like NX-VAR-BITS, these slots are
only maintained for "root" (non-inherited) VARs.

in compiler/*/???2.lisp: in the function that tries to eliminate &REST args,
there was never any need to test the (old) $vsetqmask field. Since that
field doesn't exist anymore, stop doing so.

Add IMM-REG-P to backend.lisp.

in compiler/ARM/arm2.lisp:

ARM2-CR-BIT-FOR-REVERSED-COMPARISON: handle unsigned comparisons too.

ARM2-TWO-UNTARGETED-REG-FORMS: if both target registers are imm regs
and both expressions look "simple", mark the first used imm reg as
being in use before evaluating the second form. (Some cases of
evaluating "simple" things to imm regs may otherwise want to use
other imm regs as temporaries.)

ARM2-CONSTANT-FOR-COMPARE-P takes an optional UNBOXED argument.

Add ARM2-NATURAL-COMPARE, which does comparisons between (UNSIGNED-BYTE 32)s.
Make ARM2-%NATURAL<> use it.

If we process a binding of A to B and conclude that B is so uninteresting
that A doesn't need to exist, if the VAR for A has type information about
B replace refs to A with the acode equivalent of (THE <type> B).

This all seems to work on ARM; haven't tried to compile on other platforms.

Location:
trunk/source/compiler
Files:
8 edited

Legend:

Unmodified
Added
Removed

  • trunk/source/compiler/ARM/arm2.lisp

    r14972 r14982  
    355355    (#.arm::arm-cond-le arm::arm-cond-ge)
    356356    (#.arm::arm-cond-gt arm::arm-cond-lt)
    357     (#.arm::arm-cond-ge arm::arm-cond-le)))
     357    (#.arm::arm-cond-ge arm::arm-cond-le)
     358    (#.arm::arm-cond-lo arm::arm-cond-hi)
     359    (#.arm::arm-cond-ls arm::arm-cond-hs)
     360    (#.arm::arm-cond-hi arm::arm-cond-lo)
     361    (#.arm::arm-cond-hs arm::arm-cond-ls)))
    358362
    359363   
    … …  
    23662370  (when (and rest (not key-p) (not (cadr auxen)) rest-values)
    23672371    (when (eq (logand (the fixnum (nx-var-bits rest))
    2368                       (logior $vsetqmask (ash -1 $vbitspecial)
     2372                      (logior (ash -1 $vbitspecial)
    23692373                              (ash 1 $vbitclosed) (ash 1 $vbitsetq) (ash 1 $vbitcloseddownward)))
    23702374              0)               ; Nothing but simple references
    … …  
    30203024      (values aalready balready)
    30213025      (with-arm-local-vinsn-macros (seg)
    3022         (let* ((avar (arm2-lexical-reference-p aform))
     3026        (let* ((*available-backend-imm-temps* *available-backend-imm-temps*)
     3027               (avar (arm2-lexical-reference-p aform))
    30233028               (adest areg)
    30243029               (bdest breg)
    … …  
    30323037                (progn
    30333038                  (setq adest (arm2-one-untargeted-reg-form seg aform areg))
     3039                  (when (imm-reg-p adest)
     3040                    (use-imm-temp (%hard-regspec-value adest)))
    30343041                  (when (same-arm-reg-p adest breg)
    30353042                    (setq breg areg)))
    … …  
    30403047              (setq bdest (arm2-one-untargeted-reg-form seg bform breg)))
    30413048            (if aconst
    3042               (setq adest (arm2-one-untargeted-reg-form seg aform areg))
     3049              (progn
     3050                (if (imm-reg-p bdest)
     3051                  (use-imm-temp (%hard-regspec-value bdest)))
     3052                (setq adest (arm2-one-untargeted-reg-form seg aform areg)))
    30433053              (if apushed
    30443054                (arm2-elide-pushes seg apushed (arm2-pop-register seg areg)))))
    … …  
    33583368  arglist)
    33593369
    3360 (defun arm2-constant-for-compare-p (form)
     3370(defun arm2-constant-for-compare-p (form &optional unboxed)
    33613371  (setq form (acode-unwrapped-form form))
    33623372  (when (acode-p form)
    33633373    (let* ((op (acode-operator form)))
    33643374      (if (eql op (%nx1-operator fixnum))
    3365         (let* ((val (ash (cadr form) arm::fixnumshift)))
     3375        (let* ((val (if unboxed
     3376                      (cadr form)
     3377                      (ash (cadr form) arm::fixnumshift))))
    33663378          (if (or (arm::encode-arm-immediate val)
    33673379                  (arm::encode-arm-immediate (- val)))
    … …  
    34403452              (multiple-value-bind (ireg jreg) (arm2-two-untargeted-reg-forms seg i arm::arg_y j arm::arg_z)
    34413453                (arm2-compare-registers seg vreg xfer ireg jreg cr-bit true-p)))))))))
     3454
     3455(defun arm2-natural-compare (seg vreg xfer i j cr-bit true-p)
     3456  (with-arm-local-vinsn-macros (seg vreg xfer)
     3457    (let* ((jconst (arm2-constant-for-compare-p j t))
     3458           (iconst (arm2-constant-for-compare-p i t))
     3459           (boolean (backend-crf-p vreg)))
     3460          (if (and boolean (or iconst jconst))
     3461            (let* ((reg (arm2-one-untargeted-reg-form seg (if jconst i j) ($ arm::imm0 :mode :u32))))
     3462              (! compare-immediate vreg reg (or jconst iconst))
     3463              (unless (or jconst (eq cr-bit arm::arm-cond-eq))
     3464                (setq cr-bit (arm2-cr-bit-for-reversed-comparison cr-bit)))
     3465              (^ cr-bit true-p))
     3466            (if (and (eq cr-bit arm::arm-cond-eq)
     3467                     (or jconst iconst))
     3468              (arm2-test-reg-%izerop
     3469               seg
     3470               vreg
     3471               xfer
     3472               (arm2-one-untargeted-reg-form
     3473                seg
     3474                (if jconst i j)
     3475                ($ arm::imm0 :mode :u32))
     3476               cr-bit
     3477               true-p
     3478               (or jconst iconst))
     3479              (multiple-value-bind (ireg jreg) (arm2-two-untargeted-reg-forms seg i ($ arm::imm0 :mode :u32)  j ($ arm::imm1 :mode :u32))
     3480                (arm2-compare-registers seg vreg xfer ireg jreg cr-bit true-p)))))))
    34423481
    34433482
    … …  
    38893928              (progn
    38903929                (nx-set-var-bits var (%ilogior (%ilsl $vbitpunted 1) bits))
    3891                 (nx2-replace-var-refs var puntval)
     3930                (let* ((type (var-inittype var)))
     3931                  (if (and type (not (eq t type)))
     3932                    (nx2-replace-var-refs var
     3933                                          (make-acode (%nx1-operator typed-form)
     3934                                                      type
     3935                                                      puntval))
     3936                    (nx2-replace-var-refs var puntval)))
    38923937                (arm2-set-var-ea seg var puntval))
    38933938              (progn
    … …  
    60146059    (arm2-compare seg vreg xfer form1 form2 cr-bit true-p)))
    60156060
     6061
    60166062(defarm2 arm2-numcmp numcmp (seg vreg xfer cc form1 form2)
    60176063  (or (acode-optimize-numcmp seg vreg xfer cc form1 form2 *arm2-trust-declarations*)
    … …  
    70807126  (multiple-value-bind (cr-bit true-p) (acode-condition-to-arm-cr-bit cc)
    70817127    (setq cr-bit (arm-cr-bit-to-arm-unsigned-cr-bit cr-bit))
    7082     (arm2-compare seg vreg xfer form1 form2 cr-bit true-p)))
     7128    (arm2-natural-compare seg vreg xfer form1 form2 cr-bit true-p)))
    70837129
    70847130(defarm2 arm2-double-float-compare double-float-compare (seg vreg xfer cc form1 form2)

  • trunk/source/compiler/PPC/ppc2.lisp

    r14959 r14982  
    22012201  (when (and rest (not key-p) (not (cadr auxen)) rest-values)
    22022202    (when (eq (logand (the fixnum (nx-var-bits rest))
    2203                       (logior $vsetqmask (ash -1 $vbitspecial)
     2203                      (logior (ash -1 $vbitspecial)
    22042204                              (ash 1 $vbitclosed) (ash 1 $vbitsetq) (ash 1 $vbitcloseddownward)))
    22052205              0)               ; Nothing but simple references

  • trunk/source/compiler/X86/x862.lisp

    r14979 r14982  
    27242724  (when (and rest (not key-p) (not (cadr auxen)) rest-values)
    27252725    (when (eq (logand (the fixnum (nx-var-bits rest))
    2726                       (logior $vsetqmask (ash -1 $vbitspecial)
     2726                      (logior (ash -1 $vbitspecial)
    27272727                              (ash 1 $vbitclosed) (ash 1 $vbitsetq) (ash 1 $vbitcloseddownward)))
    27282728              0)               ; Nothing but simple references

  • trunk/source/compiler/backend.lisp

    r14848 r14982  
    151151       (= (get-regspec-mode reg) hard-reg-class-gpr-mode-node)))
    152152
     153(defun imm-reg-p (reg)
     154  (and (= (hard-regspec-class reg) hard-reg-class-gpr)
     155       (/= (get-regspec-mode reg) hard-reg-class-gpr-mode-node)))
     156
    153157(defun node-reg-value (reg)
    154158  (if (node-reg-p reg)

  • trunk/source/compiler/nx-basic.lisp

    r14972 r14982  
    512512 
    513513(defun nx-cons-var (name &optional (bits 0))
    514   (%istruct 'var name bits nil nil nil nil 0 nil nil))
     514  (%istruct 'var name bits nil nil nil nil 0 nil nil 0 0 nil))
    515515
    516516

  • trunk/source/compiler/nx0.lisp

    r14980 r14982  
    491491                                             (punted (logbitp $vbitpunted bits)))
    492492                                        (if (or punted
    493                                                 (eql 0 (%ilogand $vsetqmask bits)))
     493                                                (eql 0 (nx-var-root-nsetqs var)))
    494494                                          (var-inittype var)))))
    495495                                  (if (or (eq op (%nx1-operator %aref1))
    … …  
    10071007        (or ignored ignoreunused
    10081008            (progn (and (consp expansion) (eq (car expansion) :symbol-macro) (setq sym (list :symbol-macro sym))) (nx1-whine :unused sym)))
    1009         (when (%izerop (%ilogand bits (%ilogior $vrefmask $vsetqmask)))
     1009        (when (eql 0 (logior (nx-var-root-nrefs var) (nx-var-root-nsetqs var)))
    10101010          (nx-set-var-bits var (%ilogior (%ilsl $vbitignore 1) bits)))))))
    10111011
    … …  
    10451045;;; setq'ed, and the old guy wasn't setq'ed in the body, the binding
    10461046;;; can be punted.
     1047
    10471048(defun nx1-note-var-binding (var initform)
    10481049  (let* ((inittype (nx-acode-form-type initform *nx-lexical-environment*))
    … …  
    10561057        (if (eq op (%nx1-operator lexical-reference))
    10571058          (let* ((target (%cadr init))
    1058                  (setq-count (%ilsr 8 (%ilogand $vsetqmask (nx-var-bits target)))))
    1059             (unless (eq setq-count (%ilsr 8 $vsetqmask))
    1060               (cons var (cons setq-count target))))
     1059                 (setq-count (nx-var-root-nsetqs var)))
     1060            (cons var (cons setq-count target)))
    10611061          (if (and (%ilogbitp $vbitdynamicextent bits)
    10621062                   (or (eq op (%nx1-operator closed-function))
    … …  
    10991099                   (%ilogand
    11001100                     (%ilogior (%ilsl $vbitsetq 1) (%ilsl $vbitclosed 1))
    1101                      target-bits))
    1102                (neq (%ilsr 8 (%ilogand $vsetqmask target-bits)) (cadr pair)))
     1101                     target-bits))               
     1102               (neq (nx-var-root-nsetqs target) (cadr pair)))
    11031103             (push (cons var target) *nx-punted-vars*)))))
    11041104
    … …  
    11061106  (let* ((bits (nx-var-bits var))
    11071107         (mask (%ilogior (%ilsl $vbitsetq 1) (ash -1 $vbitspecial) (%ilsl $vbitclosed 1)))
    1108          (nrefs (%ilogand $vrefmask bits))
     1108         (nrefs (nx-var-root-nrefs var))
    11091109         (val (nx-untyped-form initform))
    11101110         (op (if (acode-p val) (acode-operator val))))
    … …  
    12071207          (setf (lexenv.lambda (setq result (new-lexical-environment result))) fn))))))
    12081208
    1209 (defun nx-root-var (v)
    1210   (do* ((v v bits)
    1211         (bits (var-bits v) (var-bits v)))
    1212        ((fixnump bits) v)))
    12131209
    12141210(defun nx-reconcile-inherited-vars (more)
    … …  
    13451341      (declare (fixnum varbits boundtobits))
    13461342      (unless (eq (%ilogior
     1343                   (%ilsl $vbitsetq 1)
     1344                   (%ilsl $vbitclosed 1))
     1345                  (%ilogand
     1346                   (%ilogior
    13471347                    (%ilsl $vbitsetq 1)
    13481348                    (%ilsl $vbitclosed 1))
    1349                   (%ilogand
    1350                     (%ilogior
    1351                       (%ilsl $vbitsetq 1)
    1352                       (%ilsl $vbitclosed 1))
    1353                     boundtobits))
     1349                   boundtobits))
    13541350        ;; Can't happen -
    13551351        (unless (%izerop (%ilogand (%ilogior
    1356                                      (%ilsl $vbitsetq 1)
    1357                                      (ash -1 $vbitspecial)
    1358                                      (%ilsl $vbitclosed 1)) varbits))
     1352                                    (%ilsl $vbitsetq 1)
     1353                                    (ash -1 $vbitspecial)
     1354                                    (%ilsl $vbitclosed 1)) varbits))
    13591355          (error "Bug-o-rama - \"punted\" var had bogus bits. ~
    13601356Or something. Right? ~s ~s" var varbits))
    1361         (let* ((varcount     (%ilogand $vrefmask varbits))
    1362                (boundtocount (%ilogand $vrefmask boundtobits)))
     1357        (let* ((varcount     (nx-var-root-nrefs var))
     1358               (boundtocount (nx-var-root-nrefs boundto)))
    13631359          (nx-set-var-bits var (%ilogior
    1364                                  (%ilsl $vbitpuntable 1)
    1365                                  (%i- varbits varcount)))
    1366           (setf (var-refs var) (+ (var-refs var) (var-refs boundto)))
    1367           (nx-set-var-bits
    1368            boundto
    1369            (%i+ (%i- boundtobits boundtocount)
    1370                 (%ilogand $vrefmask
    1371                           (%i+ (%i- boundtocount 1) varcount)))))))))
     1360                                (%ilsl $vbitpuntable 1)
     1361                                varbits))
     1362          (setf (var-refs var) 0
     1363                (var-refs boundto) (+ (var-refs var) (var-refs boundto)))
     1364          (nx-set-var-root-nrefs boundto
     1365                                 (+ (1- boundtocount) varcount)))))))
    13721366
    13731367;;; Home-baked handler-case replacement.  About 10 times as fast as full handler-case.
    … …  
    26312625
    26322626
     2627(defun nx-root-var (var)
     2628  (do* ((var var bits)
     2629        (bits (var-bits var) (var-bits var)))
     2630       ((typep bits 'fixnum) var)))
     2631
    26332632(defun nx-var-bits (var)
    26342633  (do* ((var var bits)
    … …  
    26412640       ((fixnump bits) (setf (var-bits var) newbits))))
    26422641
     2642(defun nx-var-root-nrefs (var)
     2643  (do* ((var var bits)
     2644        (bits (var-bits var) (var-bits var)))
     2645       ((fixnump bits) (var-root-nrefs var))))
     2646
     2647
     2648(defun nx-set-var-root-nrefs (var new)
     2649  (do* ((var var bits)
     2650        (bits (var-bits var) (var-bits var)))
     2651       ((fixnump bits) (setf (var-root-nrefs var) new))))
     2652
     2653(defun nx-var-root-nsetqs (var)
     2654  (do* ((var var bits)
     2655        (bits (var-bits var) (var-bits var)))
     2656       ((fixnump bits) (var-root-nsetqs var))))
     2657
     2658(defun nx-set-var-root-nsetqs (var new)
     2659  (do* ((var var bits)
     2660        (bits (var-bits var) (var-bits var)))
     2661       ((fixnump bits) (setf (var-root-nsetqs var) new))))
     2662
    26432663(defun nx-make-lexical-reference (var)
    26442664  (let* ((ref (make-acode (%nx1-operator lexical-reference) var)))
    … …  
    26502670         (temp-p (%ilogbitp $vbittemporary bits))
    26512671         (by (if temp-p 1 (expt  4 *nx-loop-nesting-level*)))
    2652          (new (%imin (%i+ (%ilogand2 $vrefmask bits) by) 255)))
    2653     (setf (var-refs var) (+ (var-refs var) by))
    2654     (nx-set-var-bits var (%ilogior (%ilogand (%ilognot $vrefmask) bits) new))
     2672         (new (+ (var-refs var) by)))
     2673    (setf (var-refs var) new)
     2674    (nx-set-var-root-nrefs var (+ (nx-var-root-nrefs var) 1))
    26552675    new))
    26562676

  • trunk/source/compiler/nx1.lisp

    r14940 r14982  
    16011601    (let ((tagbits (nx-var-bits tagvar)))
    16021602      (if (not (%ilogbitp $vbitclosed tagbits))
    1603         (if (neq 0 (%ilogand $vrefmask tagbits))
     1603        (if (neq 0 (nx-var-root-nrefs tagvar))
    16041604          (make-acode
    16051605           (%nx1-operator local-block)
    … …  
    21952195                (let ((old-bits (nx-var-bits var)))
    21962196                  (push (nx1-form `(the ,type ,sym)) typechecks)
    2197                   (when (%izerop (%ilogand2 old-bits
    2198                                             (%ilogior (%ilsl $vbitspecial 1)
    2199                                                       (%ilsl $vbitreffed 1)
    2200                                                       (%ilsl $vbitclosed 1)
    2201                                                       $vrefmask
    2202                                                       $vsetqmask)))
     2197                  (when (%izerop (logior
     2198                                  (%ilogand2 old-bits
     2199                                             (%ilogior (%ilsl $vbitspecial 1)
     2200                                                       (%ilsl $vbitreffed 1)
     2201                                                       (%ilsl $vbitclosed 1)))
     2202                                  (nx-var-root-nrefs var)
     2203                                  (nx-var-root-nsetqs var)))
    22032204                    (nx-set-var-bits var (%ilogand2 (nx-var-bits var)
    22042205                                                    (%ilognot (%ilsl $vbitignore 1))))))))))))))

  • trunk/source/compiler/nxenv.lisp

    r14972 r14982  
    4242  var-nvr
    4343  var-declared-unboxed-type             ; NIL or float or natural-integer type
     44  var-root-nrefs                        ; reference count of "root" var
     45  var-root-nsetqs                       ; setq count of root var
     46  var-initform                          ; initial value acode or NIL.
    4447)
    4548
    … …  
    5962(defconstant $vbitreffed 27)
    6063(defconstant $vbitspecial 28)
    61 (defconstant $vsetqmask #xff00)
    62 (defconstant $vrefmask #xff)
    6364
    6465(defconstant $decl_optimize (%ilsl 16 0))  ; today's chuckle
    … …  
    561562(defun nx-adjust-setq-count (var &optional (by 1) catchp)
    562563  (let* ((bits (nx-var-bits var))
     564         (nsetqs (nx-var-root-nsetqs var))
    563565         (scaled-by (if (%ilogbitp $vbittemporary bits)
    564566                      by
    565567                      (expt 4 *nx-loop-nesting-level*)))
    566          (new (%i+ (%ilsr 8 (%ilogand2 $vsetqmask bits)) scaled-by)))
    567     (if (%i> new 255) (setq new 255))
    568     (setq bits (nx-set-var-bits var (%ilogior (%ilogand (%ilognot $vsetqmask) bits) (%ilsl 8 new))))
     568         (new (%i+ nsetqs scaled-by)))
     569    (nx-set-var-root-nsetqs var (1+ nsetqs))
    569570    ;; If a variable is setq'ed from a catch nested within the construct that
    570571    ;; bound it, it can't be allocated to a register. *
    … …  
    575576    (when catchp
    576577      (nx-set-var-bits var (%ilogior2 bits (%ilsl $vbitnoreg 1))))
    577     (setf (var-refs var) (+ (the fixnum (var-refs var)) scaled-by))
     578    (setf (var-refs var) new)
    578579    new))
    579580
Note: See TracChangeset for help on using the changeset viewer.