Changeset 11668


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

Be careful about overflow/result size when constant-folding in
PPC2-%i+, PPC2-%i- (ticket:412).

File:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/source/compiler/PPC/ppc2.lisp

    r11585 r11668  
    66466646                 (ppc2-form-typep form2 type))
    66476647        (setq overflow nil))))
    6648   (cond ((null vreg)
    6649          (ppc2-form seg nil nil form1)
    6650          (ppc2-form seg nil xfer form2))
    6651         (overflow
    6652          (multiple-value-bind (r1 r2) (ppc2-two-untargeted-reg-forms seg form1 ppc::arg_y form2 ppc::arg_z)
    6653            (ensuring-node-target (target vreg)
    6654              (if *ppc2-open-code-inline*
    6655                (! fixnum-add-overflow-inline target r1 r2)
    6656                (progn
    6657                  (! fixnum-add-overflow-ool r1 r2)
    6658                  (ppc2-copy-register seg target ($ ppc::arg_z)))))
    6659            (^)))
    6660         (t                             
    6661          ;; There isn't any "addi" that checks for overflow, which is
    6662          ;; why we didn't bother.
    6663          (let* ((fix1 (acode-fixnum-form-p form1))
    6664                 (fix2 (acode-fixnum-form-p form2))
    6665                 (other (if (and fix1
    6666                                 (typep (ash fix1 *ppc2-target-fixnum-shift*)
    6667                                        '(signed-byte 32)))
    6668                          form2
    6669                          (if (and fix2
    6670                                   (typep (ash fix2 *ppc2-target-fixnum-shift*)
    6671                                               '(signed-byte 32)))
    6672                            form1))))
    6673            (if (and fix1 fix2)
    6674              (ppc2-lri seg vreg (ash (+ fix1 fix2) *ppc2-target-fixnum-shift*))
    6675              (if other
    6676                (let* ((constant (ash (or fix1 fix2) *ppc2-target-fixnum-shift*))
    6677                       (reg (ppc2-one-untargeted-reg-form seg other ppc::arg_z))
    6678                       (high (ldb (byte 16 16) constant))
    6679                       (low (ldb (byte 16 0) constant)))
    6680                  (declare (fixnum high low))
    6681                  (if (zerop constant)
    6682                    (<- reg)
    6683                    (progn
    6684                      (if (logbitp 15 low) (setq high (ldb (byte 16 0) (1+ high))))
    6685                      (if (and (eq vreg reg) (not (zerop high)))
    6686                        (with-node-temps (vreg) (temp)
    6687                          (! add-immediate temp reg high low)
    6688                          (<- temp))
    6689                        (ensuring-node-target (target vreg)
    6690                          (! add-immediate target reg high low))))))
    6691                (multiple-value-bind (r1 r2) (ppc2-two-untargeted-reg-forms seg form1 ppc::arg_y form2 ppc::arg_z)
    6692                  (ensuring-node-target (target vreg)
    6693                    (! fixnum-add target r1 r2)))))
    6694            (^)))))
     6648  (let* ((fix1 (acode-fixnum-form-p form1))
     6649         (fix2 (acode-fixnum-form-p form2))
     6650         (sum (and fix1 fix2 (if overflow (+ fix1 fix2) (%i+ fix1 fix2)))))
     6651    (cond ((null vreg)
     6652           (ppc2-form seg nil nil form1)
     6653           (ppc2-form seg nil xfer form2))
     6654          (sum
     6655           (if (nx1-target-fixnump sum)
     6656             (ppc2-use-operator (%nx1-operator fixnum) seg vreg xfer sum)
     6657             (ppc2-use-operator (%nx1-operator immediate) seg vreg xfer sum)))
     6658          (overflow
     6659           (multiple-value-bind (r1 r2) (ppc2-two-untargeted-reg-forms seg form1 ppc::arg_y form2 ppc::arg_z)
     6660             (ensuring-node-target (target vreg)
     6661               (if *ppc2-open-code-inline*
     6662                 (! fixnum-add-overflow-inline target r1 r2)
     6663                 (progn
     6664                   (! fixnum-add-overflow-ool r1 r2)
     6665                   (ppc2-copy-register seg target ($ ppc::arg_z)))))
     6666             (^)))
     6667          (t                             
     6668           ;; There isn't any "addi" that checks for overflow, which is
     6669           ;; why we didn't bother.
     6670           (let* ((other (if (and fix1
     6671                                  (typep (ash fix1 *ppc2-target-fixnum-shift*)
     6672                                         '(signed-byte 32)))
     6673                           form2
     6674                           (if (and fix2
     6675                                    (typep (ash fix2 *ppc2-target-fixnum-shift*)
     6676                                           '(signed-byte 32)))
     6677                             form1))))
     6678             (if (and fix1 fix2)
     6679               (ppc2-lri seg vreg (ash (+ fix1 fix2) *ppc2-target-fixnum-shift*))
     6680               (if other
     6681                 (let* ((constant (ash (or fix1 fix2) *ppc2-target-fixnum-shift*))
     6682                        (reg (ppc2-one-untargeted-reg-form seg other ppc::arg_z))
     6683                        (high (ldb (byte 16 16) constant))
     6684                        (low (ldb (byte 16 0) constant)))
     6685                   (declare (fixnum high low))
     6686                   (if (zerop constant)
     6687                     (<- reg)
     6688                     (progn
     6689                       (if (logbitp 15 low) (setq high (ldb (byte 16 0) (1+ high))))
     6690                       (if (and (eq vreg reg) (not (zerop high)))
     6691                         (with-node-temps (vreg) (temp)
     6692                           (! add-immediate temp reg high low)
     6693                           (<- temp))
     6694                         (ensuring-node-target (target vreg)
     6695                           (! add-immediate target reg high low))))))
     6696                 (multiple-value-bind (r1 r2) (ppc2-two-untargeted-reg-forms seg form1 ppc::arg_y form2 ppc::arg_z)
     6697                   (ensuring-node-target (target vreg)
     6698                     (! fixnum-add target r1 r2)))))
     6699             (^))))))
    66956700
    66966701(defppc2 ppc2-%i- %i- (seg vreg xfer num1 num2 &optional overflow)
     
    67016706        (setq overflow nil))))
    67026707  (let* ((v1 (acode-fixnum-form-p num1))
    6703          (v2 (acode-fixnum-form-p num2)))
    6704     (if (and v1 v2)
    6705       (ppc2-use-operator (%nx1-operator fixnum) seg vreg xfer (%i- v1 v2))
     6708         (v2 (acode-fixnum-form-p num2))
     6709         (diff (and v1 v2 (if overflow (- v1 v2) (%i- v1 v2)))))
     6710    (if diff
     6711      (if (nx1-target-fixnump diff)
     6712        (ppc2-use-operator (%nx1-operator fixnum) seg vreg xfer diff)
     6713        (ppc2-use-operator (%nx1-operator immediate) seg vreg xfer diff))
    67066714      (if (and v2 (neq v2 most-negative-fixnum))
    67076715        (ppc2-use-operator (%nx1-operator %i+) seg vreg xfer num1 (make-acode (%nx1-operator fixnum) (- v2)) overflow)
Note: See TracChangeset for help on using the changeset viewer.