Changeset 11667


Ignore:
Timestamp:
Jan 30, 2009, 12:18:51 PM (11 years ago)
Author:
gb
Message:

In x862-%i+, only try to use ADD-CONSTANT if a boxed fixnum constant
fits in 32 bits. (I think that this fixes ticket:411, but other
people have been trying other approaches; it seems to fix the test
cases that we have.)

When constant-folding in X862-%i+ and X862-%i-, return an arithmetically
correct result if we're supposed to detect overflow (and a fixnum otherwise;
this is hard to get right if cross-compiling, but unconditionally doing
fixnum arithmetic in the host is no better.) Be careful about handling
results correctly (e.g., may not be able to use LRI vinsn.) I think that
this closes ticket:412.

File:
1 edited

Legend:

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

    r11601 r11667  
    17891789                 (! nref-bit-vector-fixnum target bitnum src))))))))
    17901790    (^)))
     1791
     1792
    17911793
    17921794;;; safe = T means assume "vector" is miscobj, do bounds check.
     
    68586860    (^)))
    68596861
     6862
     6863
    68606864(pushnew (%nx1-operator fixnum) *x862-operator-supports-push*)
    68616865(defx862 x862-fixnum fixnum (seg vreg xfer value)
     
    68716875        (^))
    68726876      (let* ((class (hard-regspec-class vreg))
    6873            (mode (get-regspec-mode vreg))
    6874            (unboxed (if (= class hard-reg-class-gpr)
    6875                       (not (or (= hard-reg-class-gpr-mode-node mode)
    6876                                (= hard-reg-class-gpr-mode-address mode))))))
    6877       (if unboxed
    6878         (x862-absolute-natural seg vreg xfer value)
    6879         (if (= class hard-reg-class-crf)
    6880           (progn
    6881             ;compiler-bug "Would have clobbered a GPR!")
    6882             (x862-branch seg (x862-cd-true xfer)))
    6883           (progn
    6884             (ensuring-node-target (target vreg)
    6885               (x862-absolute-natural seg target nil (ash value *x862-target-fixnum-shift*)))
    6886             (^))))))))
     6877             (mode (get-regspec-mode vreg))
     6878             (unboxed (if (= class hard-reg-class-gpr)
     6879                        (not (or (= hard-reg-class-gpr-mode-node mode)
     6880                                 (= hard-reg-class-gpr-mode-address mode))))))
     6881        (if unboxed
     6882          (x862-absolute-natural seg vreg xfer value)
     6883          (if (= class hard-reg-class-crf)
     6884            (progn
     6885                                        ;compiler-bug "Would have clobbered a GPR!")
     6886              (x862-branch seg (x862-cd-true xfer)))
     6887            (progn
     6888              (ensuring-node-target (target vreg)
     6889                (x862-absolute-natural seg target nil (ash value *x862-target-fixnum-shift*)))
     6890              (^))))))))
    68876891
    68886892(defx862 x862-%ilogbitp %ilogbitp (seg vreg xfer cc bitnum form)
     
    74307434
    74317435(defx862 x862-logand2 logand2 (seg vreg xfer form1 form2)
    7432 
    7433   (if (or (x862-explicit-non-fixnum-type-p form1)
    7434           (x862-explicit-non-fixnum-type-p form2))
    7435     (x862-binary-builtin seg vreg xfer 'logand-2 form1 form2)
    7436     (x862-inline-logand2 seg vreg xfer form1 form2)))
     7436    (if (or (x862-explicit-non-fixnum-type-p form1)
     7437            (x862-explicit-non-fixnum-type-p form2))
     7438      (x862-binary-builtin seg vreg xfer 'logand-2 form1 form2)
     7439      (x862-inline-logand2 seg vreg xfer form1 form2)))
    74377440
    74387441(defx862 x862-%quo2 %quo2 (seg vreg xfer form1 form2)
     
    74947497        (x862-ternary-builtin seg vreg xfer '%aset1 v i n))))))
    74957498
     7499;;; Return VAL if its a fixnum whose boxed representation fits in 32
     7500;;; bits.  (On a 32-bit platform, that's true of all native fixnums.)
     7501(defun s32-fixnum-constant-p (val)
     7502  (when val
     7503    (target-arch-case
     7504     (:x8632
     7505      ;; On x8632, all fixnums fit in 32 bits.
     7506      val)
     7507     (:x8664
     7508      (if (typep val '(signed-byte #.(- 32 x8664::fixnumshift)))
     7509        val)))))
     7510
    74967511(defx862 x862-%i+ %i+ (seg vreg xfer form1 form2 &optional overflow)
    74977512  (when overflow
     
    75047519         (x862-form seg nil xfer form2))
    75057520        (t                             
    7506          (let* ((fix1 (acode-fixnum-form-p form1))
    7507                 (fix2 (acode-fixnum-form-p form2))
    7508                 (other (if (and fix1
    7509                                 (typep (ash fix1 *x862-target-fixnum-shift*)
    7510                                        '(signed-byte 32)))
     7521         (let* ((c1 (acode-fixnum-form-p form1))
     7522                (c2 (acode-fixnum-form-p form2))
     7523                (fix1 (s32-fixnum-constant-p c1))
     7524                (fix2 (s32-fixnum-constant-p c2))
     7525                (other (if fix1                               
    75117526                         form2
    7512                          (if (and fix2
    7513                                   (typep (ash fix2 *x862-target-fixnum-shift*)
    7514                                          '(signed-byte 32)))
    7515                            form1))))
    7516            (if (and fix1 fix2 (not overflow))
    7517              (x862-lri seg vreg (ash (+ fix1 fix2) *x862-target-fixnum-shift*))
     7527                         (if fix2
     7528                           form1)))
     7529                (sum (and c1 c2 (if overflow (+ c1 c2) (%i+ c1 c2)))))
     7530
     7531           (if sum
     7532             (if (nx1-target-fixnump sum)
     7533               (x862-use-operator (%nx1-operator fixnum) seg vreg nil sum)
     7534               (x862-use-operator (%nx1-operator immediate) seg vreg nil sum))
    75187535             (if other
    7519                (let* ((constant (ash (or fix1 fix2) *x862-target-fixnum-shift*)))
     7536               (let* ((constant (ash (or fix1 fix2) *x862-target-fixnum-shift*))) 
    75207537                 (if (zerop constant)
    75217538                   (x862-form seg vreg nil other)
     
    75577574         (v2 (acode-fixnum-form-p num2)))
    75587575    (if (and v1 v2)
    7559       (x862-use-operator (%nx1-operator fixnum) seg vreg xfer (%i- v1 v2))
    7560       (if (and v2 (neq v2 most-negative-fixnum))
     7576      (x862-use-operator (%nx1-operator immediate) seg vreg xfer (if overflow (- v1 v2)(%i- v1 v2)))
     7577      (if (and v2 (/= v2 (arch::target-most-negative-fixnum (backend-target-arch *target-backend*))))
    75617578        (x862-use-operator (%nx1-operator %i+) seg vreg xfer num1 (make-acode (%nx1-operator fixnum) (- v2)) overflow)
    75627579          (cond
     
    75647581            (x862-form seg nil nil num1)
    75657582            (x862-form seg nil xfer num2))
    7566            (t                             
    7567             (let* ((fix1 (acode-fixnum-form-p num1))
    7568                    (fix2 (acode-fixnum-form-p num2)))
    7569               (if (and fix1 fix2 (not overflow))
    7570                 (x862-lri seg vreg (ash (- fix1 fix2) *x862-target-fixnum-shift*))
    7571                 (multiple-value-bind (r1 r2) (x862-two-untargeted-reg-forms seg num1 *x862-arg-y* num2 *x862-arg-z*)
    7572                       ;; This isn't guaranteed to set the overflow flag,
    7573                       ;; but may do so.
    7574                       (ensuring-node-target (target vreg)
    7575                         (! fixnum-sub2 target r1 r2)
    7576                         (if overflow
    7577                           (x862-check-fixnum-overflow seg target))))))
    7578             (^)))))))
     7583           (t
     7584            (multiple-value-bind (r1 r2) (x862-two-untargeted-reg-forms seg num1 *x862-arg-y* num2 *x862-arg-z*)
     7585              ;; This isn't guaranteed to set the overflow flag,
     7586              ;; but may do so.
     7587              (ensuring-node-target (target vreg)
     7588                (! fixnum-sub2 target r1 r2)
     7589                (if overflow
     7590                  (x862-check-fixnum-overflow seg target)))
     7591              (^))))))))
    75797592
    75807593(defx862 x862-%i* %i* (seg vreg xfer num1 num2)
Note: See TracChangeset for help on using the changeset viewer.