Ignore:
Timestamp:
Oct 5, 2008, 2:35:06 AM (11 years ago)
Author:
gb
Message:

Two too many versions of PPC2-LONG-CONSTANT-P. Replaces some uses
with PPC2-INTEGER-CONSTANT-P, which actually cares about width
and signedness.

(The version of PPC2-LONG-CONSTANT-P that was in effect allowed
MacOS-style OSType keywords and a few other things to be interpreted
as integer constants. That was unintentional.)

The x86 backends had the same bug; it was changed/fixed about a month
ago there.

File:
1 edited

Legend:

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

    r10976 r10977  
    25912591
    25922592 
    2593 (defun ppc2-long-constant-p (form)
    2594   (setq form (acode-unwrapped-form form))
    2595   (or (acode-fixnum-form-p form)
    2596       (and (acode-p form)
    2597            (eq (acode-operator form) (%nx1-operator immediate))
    2598            (setq form (%cadr form))
    2599            (if (integerp form)
    2600              form))))
     2593(defun ppc2-integer-constant-p (form mode)
     2594  (let* ((val
     2595         (or (acode-fixnum-form-p (setq form (acode-unwrapped-form form)))
     2596             (and (acode-p form)
     2597                  (eq (acode-operator form) (%nx1-operator immediate))
     2598                  (setq form (%cadr form))
     2599                  (if (typep form 'integer)
     2600                    form)))))
     2601    (and val (%typep val (mode-specifier-type mode)) val)))
    26012602
    26022603
     
    26342635
    26352636
    2636 ;;; treat form as a 32-bit immediate value and load it into immreg.
    2637 ;;; This is the "lenient" version of 32-bit-ness; OSTYPEs and chars
    2638 ;;; count, and we don't care about the integer's sign.
    26392637
    26402638(defun ppc2-unboxed-integer-arg-to-reg (seg form immreg &optional ffi-arg-type)
     
    26462644                 (:unsigned-halfword :u16)
    26472645                 (:signed-fullword :s32)
    2648                  (:unsigned-fullword :u32)))
     2646                 (:unsigned-fullword :u32)
     2647                 (:unsigned-doubleword :u64)
     2648                 (:signed-doubleword :s64)))
    26492649         (modeval (gpr-mode-name-value mode)))
    26502650    (with-ppc-local-vinsn-macros (seg)
    2651       (let* ((value (ppc2-long-constant-p form)))
     2651      (let* ((value (ppc2-integer-constant-p form mode)))
    26522652        (if value
    26532653          (if (eql value 0)
     
    40854085      (ppc2-%immediate-set-ptr seg vreg xfer  ptr offset val)
    40864086      (let* ((size (logand #xf bits))
    4087              (long-p (eq size 4))
     4087             (nbits (ash size 3))
    40884088             (signed (not (logbitp 5 bits)))
    4089              (intval (if long-p (ppc2-long-constant-p val) (acode-fixnum-form-p val)))
     4089             (intval (acode-integer-constant-p val nbits))
    40904090             (offval (acode-fixnum-form-p offset))
    40914091             (absptr (and offval (acode-absolute-ptr-p ptr)))
     
    46394639    cd))
    46404640
    4641 (defun ppc2-long-constant-p (form)
    4642   (setq form (acode-unwrapped-form form))
    4643   (or (acode-fixnum-form-p form)
    4644       (and (acode-p form)
    4645            (eq (acode-operator form) (%nx1-operator immediate))
    4646            (setq form (%cadr form))
    4647            (if (integerp form)
    4648              form
    4649              (progn
    4650                (if (symbolp form) (setq form (symbol-name form)))
    4651                (if (and (stringp form) (eql (length form) 4))
    4652                  (logior (ash (%char-code (char form 0)) 24)
    4653                          (ash (%char-code (char form 1)) 16)
    4654                          (ash (%char-code (char form 2)) 8)
    4655                          (%char-code (char form 3)))
    4656                  (if (characterp form) (%char-code form))))))))
     4641
    46574642
    46584643;;; execute body, cleanup afterwards (if need to)
     
    83528337        (let* ((valform (car vals))
    83538338               (spec (car specs))
    8354                (longval (ppc2-long-constant-p valform))
    83558339               (absptr (acode-absolute-ptr-p valform)))
    83568340          (case spec
     
    84148398                   (valreg :natural)
    84158399                 (let* ((reg valreg))
    8416                    (if longval
    8417                      (ppc2-lri seg valreg longval)
    8418                      (setq reg (ppc2-unboxed-integer-arg-to-reg seg valform valreg spec)))
     8400                   (setq reg (ppc2-unboxed-integer-arg-to-reg seg valform valreg spec))
    84198401                   (! set-c-arg reg nextarg))))))
    84208402          (unless (eq spec :registers)(incf nextarg))))
Note: See TracChangeset for help on using the changeset viewer.