Changeset 11670


Ignore:
Timestamp:
Jan 30, 2009, 2:06:34 PM (10 years ago)
Author:
gz
Message:

r11667 from trunk

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/working-0711/ccl/compiler/X86/x862.lisp

    r11662 r11670  
    18961896                 (! nref-bit-vector-fixnum target bitnum src))))))))
    18971897    (^)))
     1898
     1899
    18981900
    18991901;;; safe = T means assume "vector" is miscobj, do bounds check.
     
    70137015    (^)))
    70147016
     7017
     7018
    70157019(pushnew (%nx1-operator fixnum) *x862-operator-supports-push*)
    70167020(defx862 x862-fixnum fixnum (seg vreg xfer value)
     
    70267030        (^))
    70277031      (let* ((class (hard-regspec-class vreg))
    7028            (mode (get-regspec-mode vreg))
    7029            (unboxed (if (= class hard-reg-class-gpr)
    7030                       (not (or (= hard-reg-class-gpr-mode-node mode)
    7031                                (= hard-reg-class-gpr-mode-address mode))))))
    7032       (if unboxed
    7033         (x862-absolute-natural seg vreg xfer value)
    7034         (if (= class hard-reg-class-crf)
    7035           (progn
    7036             ;compiler-bug "Would have clobbered a GPR!")
    7037             (x862-branch seg (x862-cd-true xfer)))
    7038           (progn
    7039             (ensuring-node-target (target vreg)
    7040               (x862-absolute-natural seg target nil (ash value *x862-target-fixnum-shift*)))
    7041             (^))))))))
     7032             (mode (get-regspec-mode vreg))
     7033             (unboxed (if (= class hard-reg-class-gpr)
     7034                        (not (or (= hard-reg-class-gpr-mode-node mode)
     7035                                 (= hard-reg-class-gpr-mode-address mode))))))
     7036        (if unboxed
     7037          (x862-absolute-natural seg vreg xfer value)
     7038          (if (= class hard-reg-class-crf)
     7039            (progn
     7040                                        ;compiler-bug "Would have clobbered a GPR!")
     7041              (x862-branch seg (x862-cd-true xfer)))
     7042            (progn
     7043              (ensuring-node-target (target vreg)
     7044                (x862-absolute-natural seg target nil (ash value *x862-target-fixnum-shift*)))
     7045              (^))))))))
    70427046
    70437047(defx862 x862-%ilogbitp %ilogbitp (seg vreg xfer cc bitnum form)
     
    75857589
    75867590(defx862 x862-logand2 logand2 (seg vreg xfer form1 form2)
    7587 
    7588   (if (or (x862-explicit-non-fixnum-type-p form1)
    7589           (x862-explicit-non-fixnum-type-p form2))
    7590     (x862-binary-builtin seg vreg xfer 'logand-2 form1 form2)
    7591     (x862-inline-logand2 seg vreg xfer form1 form2)))
     7591    (if (or (x862-explicit-non-fixnum-type-p form1)
     7592            (x862-explicit-non-fixnum-type-p form2))
     7593      (x862-binary-builtin seg vreg xfer 'logand-2 form1 form2)
     7594      (x862-inline-logand2 seg vreg xfer form1 form2)))
    75927595
    75937596(defx862 x862-%quo2 %quo2 (seg vreg xfer form1 form2)
     
    76477650        (x862-ternary-builtin seg vreg xfer '%aset1 v i n))))))
    76487651
     7652;;; Return VAL if its a fixnum whose boxed representation fits in 32
     7653;;; bits.  (On a 32-bit platform, that's true of all native fixnums.)
     7654(defun s32-fixnum-constant-p (val)
     7655  (when val
     7656    (target-arch-case
     7657     (:x8632
     7658      ;; On x8632, all fixnums fit in 32 bits.
     7659      val)
     7660     (:x8664
     7661      (if (typep val '(signed-byte #.(- 32 x8664::fixnumshift)))
     7662        val)))))
     7663
    76497664(defx862 x862-%i+ %i+ (seg vreg xfer form1 form2 &optional overflow)
    76507665  (when overflow
     
    76577672         (x862-form seg nil xfer form2))
    76587673        (t                             
    7659          (let* ((fix1 (acode-fixnum-form-p form1))
    7660                 (fix2 (acode-fixnum-form-p form2))
    7661                 (other (if (and fix1
    7662                                 (typep (ash fix1 *x862-target-fixnum-shift*)
    7663                                        '(signed-byte 32)))
     7674         (let* ((c1 (acode-fixnum-form-p form1))
     7675                (c2 (acode-fixnum-form-p form2))
     7676                (fix1 (s32-fixnum-constant-p c1))
     7677                (fix2 (s32-fixnum-constant-p c2))
     7678                (other (if fix1                               
    76647679                         form2
    7665                          (if (and fix2
    7666                                   (typep (ash fix2 *x862-target-fixnum-shift*)
    7667                                          '(signed-byte 32)))
    7668                            form1))))
    7669            (if (and fix1 fix2 #+bug-411 (not overflow))
    7670              (x862-lri seg vreg (ash (+ fix1 fix2) *x862-target-fixnum-shift*))
     7680                         (if fix2
     7681                           form1)))
     7682                (sum (and c1 c2 (if overflow (+ c1 c2) (%i+ c1 c2)))))
     7683
     7684           (if sum
     7685             (if (nx1-target-fixnump sum)
     7686               (x862-use-operator (%nx1-operator fixnum) seg vreg nil sum)
     7687               (x862-use-operator (%nx1-operator immediate) seg vreg nil sum))
    76717688             (if other
    7672                (let* ((constant (ash (or fix1 fix2) *x862-target-fixnum-shift*)))
     7689               (let* ((constant (ash (or fix1 fix2) *x862-target-fixnum-shift*))) 
    76737690                 (if (zerop constant)
    76747691                   (x862-form seg vreg nil other)
     
    77107727         (v2 (acode-fixnum-form-p num2)))
    77117728    (if (and v1 v2)
    7712       (x862-use-operator (%nx1-operator fixnum) seg vreg xfer (%i- v1 v2))
    7713       (if (and v2 (neq v2 most-negative-fixnum))
     7729      (x862-use-operator (%nx1-operator immediate) seg vreg xfer (if overflow (- v1 v2)(%i- v1 v2)))
     7730      (if (and v2 (/= v2 (arch::target-most-negative-fixnum (backend-target-arch *target-backend*))))
    77147731        (x862-use-operator (%nx1-operator %i+) seg vreg xfer num1 (make-acode (%nx1-operator fixnum) (- v2)) overflow)
    77157732          (cond
     
    77177734            (x862-form seg nil nil num1)
    77187735            (x862-form seg nil xfer num2))
    7719            (t                             
    7720             (let* ((fix1 (acode-fixnum-form-p num1))
    7721                    (fix2 (acode-fixnum-form-p num2)))
    7722               (if (and fix1 fix2 (not overflow))
    7723                 (x862-lri seg vreg (ash (- fix1 fix2) *x862-target-fixnum-shift*))
    7724                 (multiple-value-bind (r1 r2) (x862-two-untargeted-reg-forms seg num1 *x862-arg-y* num2 *x862-arg-z*)
    7725                       ;; This isn't guaranteed to set the overflow flag,
    7726                       ;; but may do so.
    7727                       (ensuring-node-target (target vreg)
    7728                         (! fixnum-sub2 target r1 r2)
    7729                         (if overflow
    7730                           (x862-check-fixnum-overflow seg target))))))
    7731             (^)))))))
     7736           (t
     7737            (multiple-value-bind (r1 r2) (x862-two-untargeted-reg-forms seg num1 *x862-arg-y* num2 *x862-arg-z*)
     7738              ;; This isn't guaranteed to set the overflow flag,
     7739              ;; but may do so.
     7740              (ensuring-node-target (target vreg)
     7741                (! fixnum-sub2 target r1 r2)
     7742                (if overflow
     7743                  (x862-check-fixnum-overflow seg target)))
     7744              (^))))))))
    77327745
    77337746(defx862 x862-%i* %i* (seg vreg xfer num1 num2)
Note: See TracChangeset for help on using the changeset viewer.