Changeset 15022


Ignore:
Timestamp:
Oct 13, 2011, 10:27:43 PM (8 years ago)
Author:
gb
Message:

vinsn.lisp: add two new slots to the VINSN struct, to track GPRs and
FPRs read by the VINSN. Deal (crudely) with bootstrapping issues that
this change raises (vreg.lisp loads earlier and there are circular
dependencies there.) Add code to access these new slots, similar to
that which had existed to track register assignments. When looking
to see if a vinsn sequence references a register, return the last
vinsn which does so (not the first.) When testing attributes in
a vinsn sequence in %VINSN-SEQUENCE-HAS-ATTRIBUTE-P, logand the vinsn's
attributes with the supplied "attr" arg, not with nothing: we want to
see if a vinsn has all of the supplied attributes, not test for an exact
match.

vreg.lisp: MATCH-VREG updates the new -refs slots in the vinsn. More
circularity and bootstrapping workarounds.

backend.lisp: %AVAILABLE-NODE-TEMP returns register number or NIL;
AVAILABLE-NODE-TEMP calls it and errs on null return.

x8632-vinsns.lisp: catch a few more cases where we can't access the low
byte of high-numbered GPRs. (Who designed this cpu ?) Add a few
vinsns for comparing fixnums to stack locations and doing fixnum
addition on stack locations. Make sure that MARK-AS-NODE notes that
the argument register is modified.

x8664-vinsns.lisp: comparisons/additions on stack locations.

x862.lisp: a bunch of changes to try to reduce stack traffic a little
more. Do some cases of fixnum comparison/addition directly on stack
locations if the location's value isn't known to be in a GPR. (This
may be faster than a load or load+store and may reduce register
pressure a bit. We do this if the stack location isn't in a register;
the real question is whether we want it to be, possibly more than we
want something that's currently in a register to stay there.) When
loading a set of values into an arbitrary set of registers
(x862-*-untargeted-reg-forms), try to use an unused temporary if the
suggested register contains a stack location value. (Again, the real
question is whether or not it contains a value that we'd prefer keeping
there.) This change means that vinsns generally operate on a wider set
of registers than they had previously and exposed some issues (extracting
the low byte of high-numbered registers on x8632, avoiding conflicts when
some registers have dedicated roles due to hardware (shifts by variable
amounts) or software (consing uses allocptr/temp0).
X862-ELIDE-PUSHES tries to remove speculative pushes/pops on the vstack.
In order for this to work, we have to know whether or not the vinsn sequence
between PUSH Rx and POP Ry references Ry and whether the last such reference
precedes the first assignment (if any) to Rx. (This is why we needed to
track register references in vinsns. A reference to Ry can occur in that
sequence becuause Ry just happens to contain a cached stack location or
other interesting value.)

When these functions (and their cousins, the -targeted-reg-forms
functions) think that they need to push a register, the heuristics
that they use to try to decide between pushing a specific register or
an arbitrary one have changed (and aren't always consistent.) We want
to avoid copies before the push, but also want to elide the push if
possible and want to avoid introducing another copy if we do so.
It's more important to be able to eliminate push/pop pairs than it
is to eliminate a register copy or two, so we should probably think
in those terms.

This stuff is a work in progress; it builds and passes its test suite
on Linuxx8632/64, but it wouldn't be a total shock if bugs were intoduced.
I think that we see fewer load, pushes, and pops (which was the goal)
and more register copies (some of which are probably necessary and some
of which are just kind of silly-looking ...)

Location:
trunk/source/compiler
Files:
6 edited

Legend:

Unmodified
Added
Removed
  • trunk/source/compiler/X86/X8632/x8632-vinsns.lisp

    r15006 r15022  
    252252
    253253(define-x8632-vinsn set-nargs (()
    254                                ((n :u16const)))
     254                               ((n :u16const))
     255                               ((casualty (:lisp #.x8632::nargs))))
    255256  ((:pred = n 0)
    256257   (xorl (:%l x8632::nargs) (:%l x8632::nargs)))
     
    446447  (cmpl (:$l (:apply target-nil-value)) (:@ (:apply - (:apply + frame-offset x8632::word-size-in-bytes)) (:%l x8632::ebp))))
    447448
     449
     450(define-x8632-vinsn compare-vframe-offset-to-fixnum (()
     451                                                     ((frame-offset :u16const)
     452                                                      (fixval :s32const)))
     453  ((:and (:pred < fixval 128) (:pred >= fixval -128))
     454   (cmpl (:$b fixval) (:@ (:apply - (:apply + frame-offset x8632::word-size-in-bytes)) (:%l x8632::ebp))))
     455  ((:not (:and (:pred < fixval 128) (:pred >= fixval -128)))
     456   (cmpl (:$l fixval) (:@ (:apply - (:apply + frame-offset x8632::word-size-in-bytes)) (:%l x8632::ebp)))))
     457
     458(define-x8632-vinsn add-constant-to-vframe-offset (()
     459                                                   ((frame-offset :u16const)
     460                                                    (constant :s32const)))
     461  ((:and (:pred < constant 128) (:pred >= constant -128))
     462   (addl (:$b constant) (:@ (:apply - (:apply + frame-offset x8632::word-size-in-bytes)) (:%l x8632::ebp))))
     463  ((:not (:and (:pred < constant 128) (:pred >= constant -128)))
     464   (addl (:$l constant) (:@ (:apply - (:apply + frame-offset x8632::word-size-in-bytes)) (:%l x8632::ebp)))))
     465
    448466(define-x8632-vinsn compare-value-cell-to-nil (()
    449467                                               ((vcell :lisp)))
     
    10131031(define-x8632-vinsn zero-extend-u8 (((dest :s32))
    10141032                                    ((src :u8)))
    1015   (movzbl (:%b src) (:%l dest)))
     1033  ((:pred < (:apply %hard-regspec-value src) 4)
     1034   (movzbl (:%b src) (:%l dest)))
     1035  ((:pred >= (:apply %hard-regspec-value src) 4)
     1036   (movl (:%l src) (:%l dest))
     1037   (movzbl (:%b dest) (:%l dest))))
     1038 
    10161039
    10171040(define-x8632-vinsn zero-extend-u16 (((dest :s32))
     
    19421965(define-x8632-vinsn u8->u32 (((dest :u32))
    19431966                             ((src :u8)))
    1944   (movzbl (:%b src) (:%l dest)))
     1967  ((:pred < (:apply %hard-regspec-value src) 4)
     1968   (movzbl (:%b src) (:%l dest)))
     1969  ((:pred >= (:apply %hard-regspec-value src) 4)
     1970   (movl (:%l src) (:%l dest))
     1971   (movzbl (:%b dest) (:%l dest))))
     1972   
    19451973
    19461974(define-x8632-vinsn s16->s32 (((dest :s32))
     
    27112739(define-x8632-vinsn mask-base-char (((dest :u8))
    27122740                                    ((src :lisp)))
    2713   (movzbl (:%b src) (:%l dest)))
     2741  ((:pred < (:apply %hard-regspec-value src) 4)
     2742   (movzbl (:%b src) (:%l dest)))
     2743  ((:pred >= (:apply %hard-regspec-value src) 4)
     2744   (movl (:%l src) (:%l dest))
     2745   (movzbl (:%b dest) (:%l dest))))
     2746   
     2747   
    27142748
    27152749(define-x8632-vinsn event-poll (()
     
    28192853  (sarl (:$ub x8632::charcode-shift) (:%l dest)))
    28202854
    2821 (define-x8632-vinsn adjust-vsp (()
    2822                                 ((amount :s32const)))
     2855(define-x8632-vinsn (adjust-vsp :vsp :pop :discard)
     2856    (()
     2857     ((amount :s32const)))
    28232858  ((:and (:pred >= amount -128) (:pred <= amount 127))
    28242859   (addl (:$b amount) (:%l x8632::esp)))
     
    40274062  (btrl (:$ub (:apply %hard-regspec-value reg)) (:@ (:%seg :rcontext) x8632::tcr.node-regs-mask)))
    40284063
    4029 (define-x8632-vinsn mark-as-node (()
     4064(define-x8632-vinsn mark-as-node (((reg :imm))
    40304065                                  ((reg :imm)))
    40314066  (xorl (:%l reg) (:%l reg))
  • trunk/source/compiler/X86/X8664/x8664-vinsns.lisp

    r15006 r15022  
    548548  (cmpb (:$b x8664::fulltag-nil) (:@ (:apply - (:apply + frame-offset x8664::word-size-in-bytes)) (:%q x8664::rbp))))
    549549
     550(define-x8664-vinsn compare-vframe-offset-to-fixnum (()
     551                                                     ((frame-offset :u16const)
     552                                                      (fixval :s32const)))
     553  ((:and (:pred < fixval 128) (:pred >= fixval -128))
     554   (cmpq (:$b fixval) (:@ (:apply - (:apply + frame-offset x8664::word-size-in-bytes)) (:%q x8664::rbp))))
     555  ((:not (:and (:pred < fixval 128) (:pred >= fixval -128)))
     556   (cmpq (:$l fixval) (:@ (:apply - (:apply + frame-offset x8664::word-size-in-bytes)) (:%q x8664::rbp)))))
     557
     558
     559(define-x8664-vinsn add-constant-to-vframe-offset (()
     560                                                   ((frame-offset :u16const)
     561                                                    (constant :s32const)))
     562  ((:and (:pred < constant 128) (:pred >= constant -128))
     563   (addq (:$b constant) (:@ (:apply - (:apply + frame-offset x8664::word-size-in-bytes)) (:%q x8664::rbp))))
     564  ((:not (:and (:pred < constant 128) (:pred >= constant -128)))
     565   (addq (:$l constant) (:@ (:apply - (:apply + frame-offset x8664::word-size-in-bytes)) (:%q x8664::rbp)))))
     566 
    550567
    551568(define-x8664-vinsn compare-value-cell-to-nil (()
     
    970987  (movq (:%q car) (:@ x8664::cons.car (:%q allocptr)))
    971988  (movq (:%q cdr) (:@ x8664::cons.cdr (:%q allocptr)))
    972   (movq (:%q allocptr) (:%q dest)))
     989  ((:pred /= (:apply %hard-regspec-value dest) (:apply %hard-regspec-value x8664::allocptr))
     990   (movq (:%q allocptr) (:%q dest))))
    973991
    974992(define-x8664-vinsn unbox-u8 (((dest :u8))
     
    35233541  (sarq (:$ub x8664::charcode-shift) (:%q  dest)))
    35243542
    3525 (define-x8664-vinsn adjust-vsp (()
    3526                                 ((amount :s32const)))
     3543(define-x8664-vinsn (adjust-vsp :vsp :pop :discard)
     3544    (()
     3545     ((amount :s32const)))
    35273546  ((:and (:pred >= amount -128) (:pred <= amount 127))
    35283547   (addq (:$b amount) (:%q x8664::rsp)))
  • trunk/source/compiler/X86/x862.lisp

    r15006 r15022  
    226226(defvar *x862-ra0* nil)
    227227(defvar *x862-codecoverage-reg* nil)
    228 
     228(defvar *x862-variable-shift-count-mask* 0)
    229229(defvar *x862-allocptr* nil)
    230230
     
    356356          ((addrspec-vcell-p ea)     ; closed-over vcell
    357357           (x862-copy-register seg *x862-arg-z* valreg)
     358           (setq valreg *x862-arg-z*)
    358359           (let* ((gvector (target-arch-case (:x8632 x8632::temp0)
    359360                                             (:x8664 x8664::arg_x))))
     
    551552                                         (:x8632 $numx8632saveregs)
    552553                                         (:x8664  $numx8664saveregs)))
     554           (*x862-variable-shift-count-mask* (ash 1 (hard-regspec-value
     555                                                     (target-arch-case
     556                                                      (:x8632 x8632::ecx)
     557                                                      (:x8664 x8664::rcx)))))
    553558           (*x862-target-lcell-size* (arch::target-lisp-node-size (backend-target-arch *target-backend*)))
    554559           (*x862-target-fixnum-shift* (arch::target-fixnum-shift (backend-target-arch *target-backend*)))
     
    14711476                   (memq offset (svref info reg)))
    14721477          (return reg))))))
     1478
     1479
     1480(defun x862-reg-for-form (form hint)
     1481  (let* ((var (nx2-lexical-reference-p form)))
     1482    (cond ((node-reg-p hint)
     1483           (if var
     1484             (let* ((ea (var-ea var)))
     1485               (if (and (memory-spec-p ea)
     1486                          (not (addrspec-vcell-p ea)))
     1487                 (let* ((offset (memspec-frame-address-offset ea))
     1488                        (mask *x862-gpr-locations-valid-mask*)
     1489                        (info *x862-gpr-locations*))
     1490                   (declare (fixnum mask) (simple-vector info))
     1491                   (dotimes (reg 16)
     1492                     (when (and (logbitp reg mask)
     1493                                (memq offset (svref info reg)))
     1494                       (return reg))))
     1495                 (if (register-spec-p ea)
     1496                   ea)))
     1497             (if (acode-p (setq form (acode-unwrapped-form form)))
     1498               (let* ((op (acode-operator form)))
     1499                 (if (eql op (%nx1-operator immediate))
     1500                   (x862-register-constant-p (cadr form)))))))
     1501          ((eql (hard-regspec-class hint) hard-reg-class-fpr)
     1502           (when var
     1503             (let* ((ea (var-ea var)))
     1504               (when (register-spec-p ea)
     1505                 (and (eql (hard-regspec-class ea) hard-reg-class-fpr)
     1506                      (eql (get-regspec-mode ea) (get-regspec-mode hint))
     1507                      ea))))))))
     1508
     1509(defun same-x86-reg-p (x y)
     1510  (and (eql (%hard-regspec-value x) (%hard-regspec-value y))
     1511       (eql (hard-regspec-class x) (hard-regspec-class y))))
     1512           
    14731513
    14741514(defun x862-stack-to-register (seg memspec reg)
     
    33243364  (x862-one-lreg-form seg form (if (typep reg 'lreg) reg (make-unwired-lreg reg))))
    33253365
    3326 (defun x862-one-untargeted-reg-form (seg form suggested)
    3327   (with-x86-local-vinsn-macros (seg)
    3328     (let* ((gpr-p (= (hard-regspec-class suggested) hard-reg-class-gpr))
    3329            (node-p (if gpr-p (= (get-regspec-mode suggested) hard-reg-class-gpr-mode-node))))
    3330       (if node-p
    3331         (let* ((ref (x862-lexical-reference-ea form))
    3332                (reg (backend-ea-physical-reg ref hard-reg-class-gpr)))
    3333           (if reg
    3334             ref
    3335             (if (nx-null form)
    3336               (progn
    3337                 (! load-nil suggested)
    3338                 suggested)
    3339               (if (and (acode-p form)
    3340                        (eq (acode-operator form) (%nx1-operator immediate))
    3341                        (setq reg (x862-register-constant-p (cadr form))))
    3342                 reg
    3343                 (x862-one-untargeted-lreg-form seg form suggested)))))
    3344         (x862-one-untargeted-lreg-form seg form suggested)))))
     3366;;; If REG is a node reg, add it to the bitmask.
     3367(defun x862-restrict-node-target (reg mask)
     3368  (if (node-reg-p reg)
     3369    (logior mask (ash 1 (hard-regspec-value reg)))
     3370    mask))
     3371
     3372;;; If suggested reg is a node reg that contains a stack location,
     3373;;; try to use some other node temp.
     3374(defun x862-try-non-conflicting-reg (suggested reserved)
     3375  (let* ((mask *x862-gpr-locations-valid-mask*))
     3376    (or (when (and (node-reg-p suggested)
     3377                   (logbitp (hard-regspec-value suggested) mask))
     3378          (setq mask (logior mask reserved))
     3379          (%available-node-temp (logand *available-backend-node-temps*
     3380                                        (lognot mask))))
     3381        suggested)))
     3382
     3383(defun x862-one-untargeted-reg-form (seg form suggested &optional (reserved 0))
     3384  (or (x862-reg-for-form form suggested)
     3385      (with-x86-local-vinsn-macros (seg)
     3386        (let* ((gpr-p (= (hard-regspec-class suggested) hard-reg-class-gpr))
     3387               (node-p (if gpr-p (= (get-regspec-mode suggested) hard-reg-class-gpr-mode-node))))
     3388          (if node-p
     3389            (let* ((ref (x862-lexical-reference-ea form))
     3390                   (reg (backend-ea-physical-reg ref hard-reg-class-gpr)))
     3391              (if reg
     3392                ref
     3393                (let* ((target (x862-try-non-conflicting-reg suggested reserved)))
     3394                  (if (nx-null form)
     3395                    (progn
     3396                      (! load-nil target)
     3397                      target)
     3398                    (if (and (acode-p form)
     3399                             (eq (acode-operator form) (%nx1-operator immediate))
     3400                             (setq reg (x862-register-constant-p (cadr form))))
     3401                      reg
     3402                      (x862-one-untargeted-lreg-form seg form target))))))
     3403            (x862-one-untargeted-lreg-form seg form suggested))))))
    33453404             
    33463405
    33473406
    33483407
    3349 (defun x862-push-register (seg areg)
     3408(defun x862-push-register (seg areg &optional inhibit-note)
    33503409  (let* ((a-float (= (hard-regspec-class areg) hard-reg-class-fpr))
    33513410         (a-single (if a-float (= (get-regspec-mode areg) hard-reg-class-fpr-mode-single)))
     
    33543413    (with-x86-local-vinsn-macros (seg)
    33553414      (if a-node
    3356         (setq vinsn (x862-vpush-register seg areg :node-temp))
     3415        (setq vinsn (x862-vpush-register seg areg :node-temp nil nil inhibit-note))
    33573416        (if a-single
    33583417          (target-arch-case
     
    34333492           (popped-reg (svref (vinsn-variable-parts pop-vinsn) 0))
    34343493           (same-reg (eq (hard-regspec-value pushed-reg)
    3435                          (hard-regspec-value popped-reg)))
    3436            (csp-p (vinsn-attribute-p push-vinsn :csp)))
    3437       (when csp-p                       ; vsp case is harder.
     3494                         (hard-regspec-value popped-reg))))
     3495      (when (vinsn-attribute-p push-vinsn :csp)
    34383496        (unless (vinsn-sequence-has-attribute-p push-vinsn pop-vinsn :csp :discard)
    34393497          (let* ((pushed-reg-is-set (vinsn-sequence-sets-reg-p
     
    34853543                       (insert-dll-node-before restore pop-vinsn)
    34863544                       (elide-vinsn push-vinsn)
    3487                        (elide-vinsn pop-vinsn)))))))))))))
     3545                       (elide-vinsn pop-vinsn))))))))))
     3546      (when (and (vinsn-attribute-p push-vinsn :vsp))
     3547        (unless (or
     3548                 (vinsn-sequence-has-attribute-p push-vinsn pop-vinsn :vsp :push)
     3549                 (vinsn-sequence-has-attribute-p push-vinsn pop-vinsn :vsp :pop)
     3550                 (let* ((pushed-reg-is-set (vinsn-sequence-sets-reg-p
     3551                                            push-vinsn pop-vinsn pushed-reg))
     3552                        (popped-reg-is-set (if same-reg
     3553                                             pushed-reg-is-set
     3554                                             (vinsn-sequence-sets-reg-p
     3555                                              push-vinsn pop-vinsn popped-reg)))
     3556                        (popped-reg-is-reffed (unless same-reg
     3557                                                (vinsn-sequence-refs-reg-p
     3558                                                 push-vinsn pop-vinsn popped-reg))))
     3559                   (cond ((and (not (and pushed-reg-is-set popped-reg-is-set))
     3560                               (or (null popped-reg-is-reffed)
     3561                                   (vinsn-in-sequence-p pushed-reg-is-set popped-reg-is-reffed pop-vinsn)))
     3562                          (unless same-reg
     3563                            (let* ((copy (! copy-gpr popped-reg pushed-reg)))
     3564                              (remove-dll-node copy)
     3565                              (if popped-reg-is-reffed
     3566                                (insert-dll-node-after copy popped-reg-is-reffed)
     3567                                (if pushed-reg-is-set
     3568                                  (insert-dll-node-after copy push-vinsn)
     3569                                  (insert-dll-node-before copy push-vinsn)))))
     3570                          (elide-vinsn push-vinsn)
     3571                          (elide-vinsn pop-vinsn))
     3572                   (t                   ; maybe allocate a node temp
     3573                    )))))))))
    34883574               
    34893575       
     
    35003586        (if atriv
    35013587          (x862-one-targeted-reg-form seg aform areg)
    3502           (setq apushed (x862-push-register seg (x862-one-untargeted-reg-form seg aform (x862-acc-reg-for areg))))))
     3588          (setq apushed (x862-push-register
     3589                         seg
     3590                         (x862-one-untargeted-reg-form seg aform areg)))))
    35033591      (x862-one-targeted-reg-form seg bform breg)
    35043592      (if aconst
     
    35083596    (values areg breg)))
    35093597
    3510 
    3511 (defun x862-two-untargeted-reg-forms (seg aform areg bform breg)
     3598 
     3599(defun x862-two-untargeted-reg-forms (seg aform areg bform breg &optional (restricted 0))
     3600  (unless (eql restricted 0)
     3601    (setq *x862-gpr-locations-valid-mask* (logandc2 *x862-gpr-locations-valid-mask* restricted)))
    35123602  (with-x86-local-vinsn-macros (seg)
    35133603    (let* ((avar (nx2-lexical-reference-p aform))
     
    35213611        (unless aconst
    35223612          (if atriv
    3523             (setq adest (x862-one-untargeted-reg-form seg aform areg))
    3524             (setq apushed (x862-push-register seg (x862-one-untargeted-reg-form seg aform (x862-acc-reg-for areg))))))
    3525         (setq bdest (x862-one-untargeted-reg-form seg bform breg))
     3613            (progn
     3614              (setq adest (x862-one-untargeted-reg-form seg aform areg restricted)
     3615                    restricted (x862-restrict-node-target adest restricted))
     3616              (when (same-x86-reg-p adest breg)
     3617                (setq breg areg)))
     3618            (setq apushed (x862-push-register
     3619                           seg
     3620                           (x862-one-untargeted-reg-form seg aform areg)
     3621                           t))))
     3622        (setq bdest (x862-one-untargeted-reg-form seg bform breg restricted)
     3623              restricted (x862-restrict-node-target bdest restricted))
     3624        (when (same-x86-reg-p bdest areg)         
     3625          (setq areg breg)
     3626          (when apushed
     3627            (setq adest areg)))
    35263628        (if aconst
    3527           (setq adest (x862-one-untargeted-reg-form seg aform areg))
    3528           (if apushed
     3629          (setq adest (x862-one-untargeted-reg-form seg aform areg restricted))
     3630          (when apushed
    35293631            (x862-elide-pushes seg apushed (x862-pop-register seg areg)))))
    35303632      (values adest bdest))))
     
    35583660      (if atriv
    35593661        (x862-one-targeted-reg-form seg aform areg)
    3560         (setq apushed (x862-push-register seg (x862-one-untargeted-reg-form seg aform (x862-acc-reg-for areg))))))
     3662        (setq apushed (x862-push-register
     3663                       seg
     3664                       (x862-one-targeted-reg-form seg aform areg)))))
    35613665    (if (and bform (not bconst))
    35623666      (if btriv
    35633667        (x862-one-targeted-reg-form seg bform breg)
    3564         (setq bpushed (x862-push-register seg (x862-one-untargeted-reg-form seg bform (x862-acc-reg-for breg))))))
     3668        (setq bpushed (x862-push-register
     3669                       seg
     3670                       (x862-one-targeted-reg-form seg bform breg)))))
    35653671    (x862-one-targeted-reg-form seg cform creg)
    35663672    (unless btriv
     
    36183724      (if atriv
    36193725        (x862-one-targeted-reg-form seg aform areg)
    3620         (setq apushed (x862-push-register seg (x862-one-untargeted-reg-form seg aform (x862-acc-reg-for areg))))))
     3726        (setq apushed (x862-push-register seg (x862-one-targeted-reg-form seg aform areg)))))
    36213727    (if (and bform (not bconst))
    36223728      (if btriv
    36233729        (x862-one-targeted-reg-form seg bform breg)
    3624         (setq bpushed (x862-push-register seg (x862-one-untargeted-reg-form seg bform (x862-acc-reg-for breg))))))
     3730        (setq bpushed (x862-push-register seg (x862-one-targeted-reg-form seg bform breg)))))
    36253731    (if (and cform (not cconst))
    36263732      (if ctriv
    36273733        (x862-one-targeted-reg-form seg cform creg)
    3628         (setq cpushed (x862-push-register seg (x862-one-untargeted-reg-form seg cform (x862-acc-reg-for creg))))))
     3734        (setq cpushed (x862-push-register seg (x862-one-targeted-reg-form seg cform creg)))))
    36293735    (x862-one-targeted-reg-form seg dform dreg)
    36303736    (unless ctriv
     
    36423748    (values areg breg creg dreg)))
    36433749
    3644 (defun x862-three-untargeted-reg-forms (seg aform areg bform breg cform creg)
     3750(defun x862-three-untargeted-reg-forms (seg aform areg bform breg cform creg &optional (restricted 0))
    36453751  (with-x86-local-vinsn-macros (seg)
    36463752    (let* ((bnode (nx2-node-gpr-p breg))
     
    36723778      (if (and aform (not aconst))
    36733779        (if atriv
    3674           (setq adest (x862-one-untargeted-reg-form seg aform ($ areg)))
    3675           (setq apushed (x862-push-register seg (x862-one-untargeted-reg-form seg aform (x862-acc-reg-for areg))))))
     3780          (progn
     3781            (setq adest (x862-one-untargeted-reg-form seg aform ($ areg) restricted)
     3782                  restricted (x862-restrict-node-target adest restricted))
     3783            (when (same-x86-reg-p adest breg)
     3784              (setq breg areg))
     3785            (when (same-x86-reg-p adest creg)
     3786              (setq creg areg)))
     3787          (setq apushed (x862-push-register
     3788                         seg
     3789                         (x862-one-untargeted-reg-form seg aform areg)))))
    36763790      (if (and bform (not bconst))
    36773791        (if btriv
    3678           (setq bdest (x862-one-untargeted-reg-form seg bform ($ breg)))
    3679           (setq bpushed (x862-push-register seg (x862-one-untargeted-reg-form seg bform (x862-acc-reg-for breg))))))
    3680       (setq cdest (x862-one-untargeted-reg-form seg cform creg))
     3792          (progn
     3793            (setq bdest (x862-one-untargeted-reg-form seg bform ($ breg) restricted)
     3794                  restricted (x862-restrict-node-target bdest restricted))
     3795            (when (same-x86-reg-p bdest creg)
     3796              (setq creg breg))
     3797            (when (same-x86-reg-p bdest areg)
     3798              (setq areg breg)))
     3799          (setq bpushed (x862-push-register
     3800                         seg (x862-one-untargeted-reg-form seg bform breg)))))
     3801      (setq cdest (x862-one-untargeted-reg-form seg cform creg restricted)
     3802            restricted (x862-restrict-node-target cdest restricted))
     3803      (when (same-x86-reg-p cdest areg)
     3804        (setq areg creg)
     3805        (when apushed
     3806          (setq adest areg)))
     3807      (when (same-x86-reg-p cdest breg)
     3808        (setq breg creg)
     3809        (when bpushed
     3810          (setq bdest breg)))
    36813811      (unless btriv
    36823812        (if bconst
    3683           (setq bdest (x862-one-untargeted-reg-form seg bform breg))
     3813          (progn
     3814            (setq bdest (x862-one-untargeted-reg-form seg bform breg restricted)
     3815                  restricted (x862-restrict-node-target bdest restricted))
     3816            (when (same-x86-reg-p bdest areg)
     3817              (setq areg breg)
     3818              (when apushed
     3819                (setq adest areg))))
    36843820          (x862-elide-pushes seg bpushed (x862-pop-register seg breg))))
    36853821      (unless atriv
    36863822        (if aconst
    3687           (setq adest (x862-one-untargeted-reg-form seg aform areg))
     3823          (setq adest (x862-one-untargeted-reg-form seg aform areg restricted))
    36883824          (x862-elide-pushes seg apushed (x862-pop-register seg areg))))
    36893825      (values adest bdest cdest))))
    36903826
    3691 (defun x862-four-untargeted-reg-forms (seg aform areg bform breg cform creg dform dreg)
     3827(defun x862-four-untargeted-reg-forms (seg aform areg bform breg cform creg dform dreg &optional (restricted 0))
    36923828  (let* ((bnode (nx2-node-gpr-p breg))
    36933829         (cnode (nx2-node-gpr-p creg))
     
    37363872    (if (and aform (not aconst))
    37373873      (if atriv
    3738         (setq adest (x862-one-targeted-reg-form seg aform areg))
    3739         (setq apushed (x862-push-register seg (x862-one-untargeted-reg-form seg aform (x862-acc-reg-for areg))))))
     3874        (progn
     3875          (setq adest (x862-one-untargeted-reg-form seg aform areg restricted)
     3876                restricted (x862-restrict-node-target adest restricted))
     3877          (when (same-x86-reg-p adest breg)
     3878            (setq breg areg))
     3879          (when (same-x86-reg-p adest creg)
     3880            (setq creg areg))
     3881          (when (same-x86-reg-p adest dreg)
     3882            (setq dreg areg)))
     3883        (setq apushed (x862-push-register seg (x862-one-untargeted-reg-form seg aform areg)))))
    37403884    (if (and bform (not bconst))
    37413885      (if btriv
    3742         (setq bdest (x862-one-untargeted-reg-form seg bform breg))
    3743         (setq bpushed (x862-push-register seg (x862-one-untargeted-reg-form seg bform (x862-acc-reg-for breg))))))
     3886        (progn
     3887          (setq bdest (x862-one-untargeted-reg-form seg bform breg restricted)
     3888                restricted (x862-restrict-node-target bdest restricted))
     3889          (when (same-x86-reg-p bdest creg)
     3890            (setq creg breg))
     3891          (when (same-x86-reg-p bdest dreg)
     3892            (setq dreg breg)))
     3893        (setq bpushed (x862-push-register seg (x862-one-untargeted-reg-form seg bform breg)))))
    37443894    (if (and cform (not cconst))
    37453895      (if ctriv
    3746         (setq cdest (x862-one-untargeted-reg-form seg cform creg))
    3747         (setq cpushed (x862-push-register seg (x862-one-untargeted-reg-form seg cform (x862-acc-reg-for creg))))))
    3748     (setq ddest (x862-one-untargeted-reg-form seg dform dreg))
     3896        (progn
     3897          (setq cdest (x862-one-untargeted-reg-form seg cform creg restricted)
     3898                restricted (x862-restrict-node-target cdest restricted))
     3899          (when (same-x86-reg-p cdest dreg)
     3900            (setq dreg creg)))
     3901        (setq cpushed (x862-push-register seg (x862-one-untargeted-reg-form seg cform creg)))))
     3902    (setq ddest (x862-one-untargeted-reg-form seg dform dreg restricted)
     3903          restricted (x862-restrict-node-target ddest restricted))
     3904    (when (same-x86-reg-p ddest areg)
     3905      (setq areg dreg)
     3906      (when apushed
     3907        (setq adest areg)))
     3908    (when (same-x86-reg-p ddest breg)
     3909      (setq breg dreg)
     3910      (when bpushed
     3911        (setq bdest breg)))
     3912    (when (same-x86-reg-p ddest creg)
     3913      (setq creg dreg)
     3914      (when cpushed
     3915        (setq cdest creg)))
    37493916    (unless ctriv
    37503917      (if cconst
    3751         (setq cdest (x862-one-untargeted-reg-form seg cform creg))
     3918        (progn
     3919          (setq cdest (x862-one-untargeted-reg-form seg cform creg restricted)
     3920                restricted (x862-restrict-node-target cdest restricted))
     3921          (when (same-x86-reg-p cdest breg)
     3922            (setq breg creg)
     3923            (when bpushed
     3924              (setq bdest breg))))
    37523925        (x862-elide-pushes seg cpushed (x862-pop-register seg creg))))
    37533926    (unless btriv
    37543927      (if bconst
    3755         (setq bdest (x862-one-untargeted-reg-form seg bform breg))
     3928        (progn
     3929          (setq bdest (x862-one-untargeted-reg-form seg bform breg restricted)
     3930                restricted (x862-restrict-node-target bdest restricted))
     3931          (when (same-x86-reg-p bdest areg)
     3932            (setq areg bdest)
     3933            (when apushed
     3934              (setq adest areg))))
    37563935        (x862-elide-pushes seg bpushed (x862-pop-register seg breg))))
    37573936    (unless atriv
    37583937      (if aconst
    3759         (setq adest (x862-one-untargeted-reg-form seg aform areg))
     3938        (setq adest (x862-one-untargeted-reg-form seg aform areg restricted))
    37603939        (x862-elide-pushes seg apushed (x862-pop-register seg areg))))
    37613940    (values adest bdest cdest ddest)))
     
    38704049          (x862-compare-u8 seg vreg xfer u8-operand u8 (if (and iu8 (not (eq cr-bit x86::x86-e-bits))) (logxor 1 cr-bit) cr-bit) true-p u8-operator)
    38714050          (if (and boolean (or js32 is32))
    3872             (let* ((reg (x862-one-untargeted-reg-form seg (if js32 i j) *x862-arg-z*))
     4051            (let* ((ea (x862-lexical-reference-ea (if js32 i j)))
     4052                   (offset (and ea (memory-spec-p ea) (memspec-frame-address-offset ea)))
     4053                   (reg (unless offset (x862-one-untargeted-reg-form seg (if js32 i j) *x862-arg-z*)))
    38734054                   (constant (or js32 is32)))
    3874               (if (zerop constant)
    3875                 (! compare-reg-to-zero reg)
    3876                 (! compare-s32-constant reg (or js32 is32)))
     4055              (if offset
     4056                (! compare-vframe-offset-to-fixnum offset constant)
     4057                (if (zerop constant)
     4058                  (! compare-reg-to-zero reg)
     4059                  (! compare-s32-constant reg (or js32 is32))))
    38774060              (unless (or js32 (eq cr-bit x86::x86-e-bits))
    38784061                (setq cr-bit (x862-reverse-cr-bit cr-bit)))
     
    41074290
    41084291
    4109 (defun x862-vpush-register (seg src &optional why info attr)
     4292(defun x862-vpush-register (seg src &optional why info attr inhibit-note)
    41104293  (with-x86-local-vinsn-macros (seg)
    41114294    (prog1
    41124295      (! vpush-register src)
    4113       (x862-regmap-note-store src *x862-vstack*)
     4296      (unless inhibit-note
     4297        (x862-regmap-note-store src *x862-vstack*))
    41144298      (x862-new-vstack-lcell (or why :node) *x862-target-lcell-size* (or attr 0) info)
    41154299      (x862-adjust-vstack *x862-target-node-size*))))
     
    65896773      (unless *x862-reckless*
    65906774        (! check-misc-bound i v))
    6591       (with-node-temps (v) (temp)
     6775      (with-node-temps (v i) (temp)
    65926776        (! %slot-ref temp v i)
    65936777        (x862-copy-register seg target temp))))
     
    66476831      (x862-form seg nil nil y)
    66486832      (x862-form seg nil xfer z))
    6649     (multiple-value-bind (yreg zreg) (x862-two-untargeted-reg-forms seg y *x862-arg-y* z *x862-arg-z*)
     6833    (multiple-value-bind (yreg zreg)
     6834        (x862-two-untargeted-reg-forms seg y *x862-arg-y* z *x862-arg-z*
     6835                                       (ash 1 (hard-regspec-value *x862-allocptr*)))
    66506836      (ensuring-node-target (target vreg)
    66516837        (! cons target yreg zreg))
     
    69257111              (! %ilsl-c target const src)
    69267112              (!  lri target 0)))
    6927           (multiple-value-bind (count src) (x862-two-untargeted-reg-forms seg form1 *x862-arg-y* form2 *x862-arg-z*)
    6928             (! %ilsl target count src))))
     7113          (multiple-value-bind (count src) (x862-two-untargeted-reg-forms seg form1 *x862-arg-y* form2 *x862-arg-z* *x862-variable-shift-count-mask*)
     7114            (if (= (ash 1 (hard-regspec-value target))
     7115                   *x862-variable-shift-count-mask*)
     7116              (progn
     7117                (! %ilsl src count src)
     7118                (! copy-gpr target src))
     7119              (! %ilsl target count src)))))
    69297120      (^))))
    69307121
     
    71527343        (^)))))
    71537344
     7345;;; try to use a CISCy instruction for (SETQ stack-var (op stack-var other)).
     7346;;; Don't do this if some register (incidentally) contains the value of EA.
     7347(defun x862-two-address-op (seg vreg xfer ea form)
     7348  (when (and (memory-spec-p ea)
     7349             (null vreg)
     7350             (not (addrspec-vcell-p ea))
     7351             (acode-p (setq form (acode-unwrapped-form form))))
     7352    (let* ((offset (memspec-frame-address-offset ea)))
     7353      (unless (x862-register-for-frame-offset ea)
     7354        (let* ((op (acode-operator form))
     7355               (constant nil))
     7356          (with-x86-local-vinsn-macros (seg vreg xfer)
     7357            (cond ((eql op (%nx1-operator %i+))
     7358                   (destructuring-bind (arg1 arg2 &optional check-overflow)
     7359                       (cdr form)
     7360                     (unless check-overflow
     7361                       (when (or
     7362                              (and (setq constant (acode-s32-constant-p arg1))
     7363                                   (eql ea (x862-lexical-reference-ea arg2 t)))
     7364                              (and (setq constant (acode-s32-constant-p arg2))
     7365                                   (eql ea (x862-lexical-reference-ea arg2 t))))
     7366                         (! add-constant-to-vframe-offset offset constant)
     7367                         (^)
     7368                         t)))))))))))
     7369
     7370       
    71547371(defx862 x862-setq-lexical setq-lexical (seg vreg xfer varspec form)
    71557372  (let* ((ea (var-ea varspec)))
    7156     ;(unless (fixnump ea) compiler-bug "setq lexical is losing BIG"))
    7157     (let* ((valreg (x862-one-untargeted-reg-form seg form (if (and (register-spec-p ea)
    7158                                                                    (or (null vreg) (eq ea vreg)))
    7159                                                             ea
    7160                                                             *x862-arg-z*))))
    7161       (x862-do-lexical-setq seg vreg ea valreg))
     7373    ;;(unless (fixnump ea) compiler-bug "setq lexical is losing BIG"))
     7374    (or (and ea (x862-two-address-op seg vreg xfer ea form))
     7375        (let* ((valreg (x862-one-untargeted-reg-form seg form (if (and (register-spec-p ea)
     7376                                                                       (or (null vreg) (eq ea vreg)))
     7377                                                                ea
     7378                                                                *x862-arg-z*))))
     7379          (x862-do-lexical-setq seg vreg ea valreg)))
    71627380    (^)))
    71637381
     
    80998317             (x862-one-untargeted-reg-form seg form2 *x862-arg-z*))
    81008318          (multiple-value-bind (cnt src) (x862-two-targeted-reg-forms seg form1 ($ *x862-arg-y*) form2 ($ *x862-arg-z*))
    8101             (! %iasr target cnt src))))
     8319            (if (= (ash 1 (hard-regspec-value target))
     8320                   *x862-variable-shift-count-mask*)
     8321              (progn
     8322                (! %iasr src cnt src)
     8323                (! copy-gpr target src))
     8324              (! %iasr target cnt src)))))
    81028325      (^))))
    81038326
     
    81158338              (!  lri target 0)))
    81168339          (multiple-value-bind (cnt src) (x862-two-targeted-reg-forms seg form1 ($ *x862-arg-y*) form2 ($ *x862-arg-z*))
    8117             (! %ilsr target cnt src))))
     8340            (if (= (ash 1 (hard-regspec-value target))
     8341                   *x862-variable-shift-count-mask*)
     8342              (progn
     8343                (! %ilsr src cnt src)
     8344                (! copy-gpr target src))
     8345              (! %ilsr target cnt src)))))
    81188346      (^))))
    81198347
  • trunk/source/compiler/backend.lisp

    r14982 r15022  
    171171  (backend-ea-physical-reg vreg hard-reg-class-crf))
    172172
     173(defun %available-node-temp (mask)
     174  (unless (eql 0 mask)
     175    (if *backend-allocate-high-node-temps*
     176      (do* ((bit 31 (1- bit)))
     177           ((< bit 0))
     178        (when (logbitp bit mask)
     179          (return bit)))   
     180      (dotimes (bit 32)
     181        (when (logbitp bit mask)
     182          (return bit))))))
     183
    173184(defun available-node-temp (mask)
    174   (if *backend-allocate-high-node-temps*
    175     (do* ((bit 31 (1- bit)))
    176          ((< bit 0) (error "Bug: ran out of node temp registers."))
    177       (when (logbitp bit mask)
    178         (return bit)))   
    179     (dotimes (bit 32 (error "Bug: ran out of node temp registers."))
    180       (when (logbitp bit mask)
    181         (return bit)))))
     185  (or (%available-node-temp mask)
     186      (error "Bug: ran out of node temp registers.")))
     187
    182188
    183189(defun ensure-node-target (reg)
  • trunk/source/compiler/vinsn.lisp

    r14972 r15022  
    7777  (gprs-set 0)
    7878  (fprs-set 0)
     79  (gprs-read 0)
     80  (fprs-read 0)
    7981)
    8082
     
    8486  (let* ((vinsn (alloc-dll-node *vinsn-freelist*)))
    8587    (loop
    86       ; Sometimes, the compiler seems to return its node list
    87       ; to the freelist without first removing the vinsn-labels in it.
     88      ;; Sometimes, the compiler seems to return its node list
     89      ;; to the freelist without first removing the vinsn-labels in it.
     90      #-bootstrapped (when (and (typep vinsn 'vinsn)
     91                                (not (> (uvsize vinsn) 8)))
     92                       (setf (pool.data *vinsn-freelist*) nil)
     93                       (setq vinsn nil))
    8894      (if (or (null vinsn) (typep vinsn 'vinsn)) (return))
    8995      (setq vinsn (alloc-dll-node *vinsn-freelist*)))
     
    94100              (vinsn-annotation vinsn) nil
    95101              (vinsn-gprs-set vinsn) 0
    96               (vinsn-fprs-set vinsn) 0)
     102              (vinsn-fprs-set vinsn) 0
     103              (vinsn-gprs-read vinsn) 0
     104              (vinsn-fprs-read vinsn) 0)
    97105        vinsn)
    98106      (%make-vinsn template))))
     
    359367               (fixup-vinsn-template template opcode-hash-table))
    360368           templates))
    361                                        
     369
     370
     371
     372
    362373;;; Could probably split this up and do some arg checking at macroexpand time.
    363374(defun match-template-vregs (template vinsn supplied-vregs)
     
    482493   (eq (hard-regspec-value varpart-value) regval)))
    483494
     495(defun vinsn-refs-reg-p (element reg)
     496  (if (typep element 'vinsn)
     497    (if (vinsn-attribute-p element :call)
     498      t
     499      (let* ((class (hard-regspec-class reg))
     500             (value (hard-regspec-value reg)))
     501        (if (eq class hard-reg-class-gpr)
     502          (logbitp value (vinsn-gprs-read element))
     503          (if (eq class hard-reg-class-fpr)
     504            ;; The FPR is logically read in the vinsn if it or any
     505            ;; conflicting FPR is physically read in the vinsn.
     506            (logtest (fpr-mask-for-vreg reg) (vinsn-fprs-read element))))))))
     507
    484508(defun vinsn-sets-reg-p (element reg)
    485509  (if (typep element 'vinsn)
     
    508532          (setq gprs-set (logior gprs-set (vinsn-gprs-set element))
    509533                fprs-set (logior fprs-set (vinsn-fprs-set element))))))))
     534
     535
    510536     
    511 ;;; Return T if any vinsn between START and END (exclusive) sets REG.
     537;;; If any vinsn between START and END (exclusive) sets REG, return
     538;;; that vinsn; otherwise, return NIL.
    512539(defun vinsn-sequence-sets-reg-p (start end reg)
    513540  (do* ((element (dll-node-succ start) (dll-node-succ element)))
    514541       ((eq element end))
    515542    (if (vinsn-sets-reg-p element reg)
    516       (return t))))
     543      (return element))))
    517544       
     545;;; If any vinsn between START and END (exclusive) refs REG, return
     546;;; the last such vinsn; otherwise, return NIL.
     547(defun vinsn-sequence-refs-reg-p (start end reg)
     548  (do* ((element (dll-node-pred end) (dll-node-pred element)))
     549       ((eq element start))
     550    (if (vinsn-refs-reg-p element reg)
     551      (return element))))
     552
    518553
    519554;;; Return T if any vinsn between START and END (exclusive) has all
     
    523558       ((eq element end))
    524559    (when (typep element 'vinsn)
    525       (when (eql attr (logand (vinsn-template-attributes (vinsn-template element))))
     560      (when (eql attr (logand (vinsn-template-attributes (vinsn-template element)) attr))
    526561        (return t)))))
    527562
     
    529564  `(%vinsn-sequence-has-attribute-p ,start ,end ,(encode-vinsn-attributes attrs)))
    530565
    531                                
     566;;; Return T iff vinsn is between START and END (exclusive).
     567(defun vinsn-in-sequence-p (vinsn start end)
     568  (do* ((element (dll-node-succ start) (dll-node-succ element)))
     569       ((eq element end))
     570    (when (eq vinsn element)
     571      (return t))))
     572
     573(defun last-vinsn (seg)
     574  ;; Try to find something that isn't a SOURCE-NOTE.  Go ahead.  I dare you.
     575  (do* ((element (dll-header-last seg) (dll-node-pred element)))
     576       ((eq element seg))               ;told ya!
     577    (when (typep element 'vinsn)
     578      (return element))))
     579
     580
    532581;;; Flow-graph nodes (FGNs)
    533582
  • trunk/source/compiler/vreg.lisp

    r14972 r15022  
    2626(def-standard-initial-binding *lreg-freelist* (%cons-pool))
    2727
     28 
    2829(defstruct (lreg
    2930            (:print-function print-lreg)
     
    253254  (setf (vinsn-gprs-set vinsn) (logior (vinsn-gprs-set vinsn) (ash 1 gpr))))
    254255
    255 (defun note-vinsn-sets-fpr (vinsn fpr)
    256   (setf (vinsn-fprs-set vinsn) (logior (vinsn-fprs-set vinsn) (ash 1 fpr))))
    257 
    258256(defun note-vinsn-sets-fpr-lreg (vinsn fpr)
    259257  (setf (vinsn-fprs-set vinsn) (logior (vinsn-fprs-set vinsn)
     
    263261                                                          :single-float
    264262                                                          :double-float)))))
     263
     264(defun note-vinsn-refs-gpr (vinsn gpr)
     265  (when (and (fboundp 'vinsn-gprs-read)
     266             (> (uvsize vinsn) 8))
     267    (setf (vinsn-gprs-read vinsn) (logior (vinsn-gprs-read vinsn) (ash 1 gpr)))))
     268
     269(defun note-vinsn-refs-fpr-lreg (vinsn fpr)
     270  (when (and (fboundp 'vinsn-gprs-read)
     271             (> (uvsize vinsn) 8))
     272    (setf (vinsn-fprs-read vinsn) (logior (vinsn-fprs-read vinsn)
     273                                       (target-fpr-mask (hard-regspec-value fpr)
     274                                                        (if (eql (get-regspec-mode fpr)
     275                                                                 hard-reg-class-fpr-mode-single)
     276                                                          :single-float
     277                                                          :double-float))))))
    265278
    266279
     
    285298              (:crf (use-crf-temp vreg-value))
    286299              ((:u8 :s8 :u16 :s16 :u32 :s32 :u64 :s64 :address)
    287                (when result-p (note-vinsn-sets-gpr vinsn vreg-value))
     300               (if result-p
     301                 (note-vinsn-sets-gpr vinsn vreg-value)
     302                 (note-vinsn-refs-gpr vinsn vreg-value))
    288303               (use-imm-temp vreg-value))
    289304              ((:single-float :double-float)
    290305               (use-fp-reg vreg)
    291                (when result-p (note-vinsn-sets-fpr-lreg vinsn vreg)))
     306               (if result-p
     307                 (note-vinsn-sets-fpr-lreg vinsn vreg)
     308                 (note-vinsn-refs-fpr-lreg vinsn vreg)))
    292309              ((:imm t)
    293                (when result-p (note-vinsn-sets-gpr vinsn vreg-value))
     310               (if result-p
     311                 (note-vinsn-sets-gpr vinsn vreg-value)
     312                 (note-vinsn-refs-gpr vinsn vreg-value))
    294313               (if (logbitp vreg-value *backend-imm-temps*)
    295314                 (use-imm-temp vreg-value)
     
    297316              (:lisp
    298317               (use-node-temp vreg-value)
    299                (when result-p (note-vinsn-sets-gpr vinsn vreg-value)))
     318               (if result-p
     319                 (note-vinsn-sets-gpr vinsn vreg-value)
     320                 (note-vinsn-refs-gpr vinsn vreg-value)))
    300321              (:extended)))
    301322          (unless (or (eq class 't) (vreg-ok-for-storage-class vreg class))
Note: See TracChangeset for help on using the changeset viewer.