Changeset 14062


Ignore:
Timestamp:
Jul 27, 2010, 10:52:51 PM (9 years ago)
Author:
gb
Message:

Fix runtime versions of REALP, NUMBERP, too.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/arm/level-0/l0-pred.lisp

    r13841 r14062  
    115115  (let* ((typecode (typecode x)))
    116116    (declare (fixnum typecode))
    117     #+(or ppc32-target x8632-target arm-target)
    118     (or (= typecode target::tag-fixnum)
    119         (and (>= typecode target::min-numeric-subtag)
    120              (<= typecode target::max-real-subtag)))
    121     #+ppc64-target
    122     (if (<= typecode ppc64::subtag-double-float)
    123       (logbitp (the (integer 0 #.ppc64::subtag-double-float) typecode)
    124                (logior (ash 1 ppc64::tag-fixnum)
    125                        (ash 1 ppc64::subtag-single-float)
    126                        (ash 1 ppc64::subtag-double-float)
    127                        (ash 1 ppc64::subtag-bignum)
    128                        (ash 1 ppc64::subtag-ratio))))
    129     #+x8664-target
    130     (if (<= typecode x8664::subtag-double-float)
    131       (logbitp (the (integer 0 #.x8664::subtag-double-float) typecode)
    132                (logior (ash 1 x8664::tag-fixnum)
    133                        (ash 1 x8664::subtag-bignum)
    134                        (ash 1 x8664::tag-single-float)
    135                        (ash 1 x8664::subtag-double-float)
    136                        (ash 1 x8664::subtag-ratio))))))
     117    (and (<= typecode target::max-real-subtag)
     118         (logbitp (the (integer 0 #.target::max-real-subtag)
     119                    typecode)
     120                  (logior (ash 1 target::tag-fixnum)
     121                          (ash 1 target::subtag-single-float)
     122                          (ash 1 target::subtag-double-float)
     123                          (ash 1 target::subtag-bignum)
     124                          (ash 1 target::subtag-ratio))))))
     125
    137126
    138127(defun complexp (x)
     
    144133  (let* ((typecode (typecode x)))
    145134    (declare (fixnum typecode))
    146     #+(or ppc32-target x8632-target arm-target)
    147     (or (= typecode target::tag-fixnum)
    148         (and (>= typecode target::min-numeric-subtag)
    149              (<= typecode target::max-numeric-subtag)))
    150     #+ppc64-target
    151     (if (<= typecode ppc64::subtag-double-float)
    152       (logbitp (the (integer 0 #.ppc64::subtag-double-float) typecode)
    153                (logior (ash 1 ppc64::tag-fixnum)
    154                        (ash 1 ppc64::subtag-bignum)
    155                        (ash 1 ppc64::subtag-single-float)
    156                        (ash 1 ppc64::subtag-double-float)
    157                        (ash 1 ppc64::subtag-ratio)
    158                        (ash 1 ppc64::subtag-complex))))
    159     #+x8664-target
    160     (if (< typecode x8664::nbits-in-word)
    161       (logbitp (the (integer 0 #.x8664::subtag-double-float) typecode)
    162                (logior (ash 1 x8664::tag-fixnum)
    163                        (ash 1 x8664::subtag-bignum)
    164                        (ash 1 x8664::tag-single-float)
    165                        (ash 1 x8664::subtag-double-float)
    166                        (ash 1 x8664::subtag-ratio)
    167                        (ash 1 x8664::subtag-complex))))
    168    
    169     ))
     135    (and (<= typecode target::max-numeric-subtag)
     136         (logbitp (the (integer 0 #.target::max-numeric-subtag)
     137                    typecode)
     138                  (logior (ash 1 target::tag-fixnum)
     139                          (ash 1 target::subtag-bignum)
     140                          (ash 1 target::subtag-single-float)
     141                          (ash 1 target::subtag-double-float)
     142                          (ash 1 target::subtag-ratio)
     143                          (ash 1 target::subtag-complex))))))
    170144
    171145(defun arrayp (x)
Note: See TracChangeset for help on using the changeset viewer.