Changeset 8970


Ignore:
Timestamp:
Mar 30, 2008, 11:27:04 PM (11 years ago)
Author:
gb
Message:

Fix inlined typep of REAL (e.g., object doesn't have to be a fixnum
even if bounds are both fixnums unless type is an INTEGER type.)

Inline REALP.

File:
1 edited

Legend:

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

    r8554 r8970  
    14041404                     (type (if (eq class 'float)
    14051405                             (or format class)
    1406                              class)))
     1406                             (or class 'real))))
    14071407                (cond ((and low (eql low high) (or (not (eq class 'float))
    14081408                                                   format))
     
    14421442                      (t
    14431443                       (let* ((temp (gensym)))
    1444                          (if (and (typep low 'fixnum) (typep high 'fixnum))
     1444                         (if (and (typep low 'fixnum) (typep high 'fixnum)
     1445                                  (eq class 'integer))
    14451446                           (setq type 'fixnum))
    14461447                         (if (or low high)
     
    18821883        t
    18831884        (= ,typecode ,bignum-tag)))))
    1884        
     1885
     1886(define-compiler-macro realp (&whole call x)
     1887  (if (not (eq *host-backend* *target-backend*))
     1888    call
     1889    (let* ((typecode (gensym)))
     1890      `(let* ((,typecode (typecode ,x)))
     1891        (declare (type (unsigned-byte 8) ,typecode))
     1892        #+ppc32-target
     1893        (or (= ,typecode ppc32::tag-fixnum)
     1894         (and (>= ,typecode ppc32::min-numeric-subtag)
     1895          (<= ,typecode ppc32::max-real-subtag)))
     1896        #+ppc64-target
     1897        (if (<= ,typecode ppc64::subtag-double-float)
     1898          (logbitp (the (integer 0 #.ppc64::subtag-double-float) ,typecode)
     1899                   (logior (ash 1 ppc64::tag-fixnum)
     1900                           (ash 1 ppc64::subtag-single-float)
     1901                           (ash 1 ppc64::subtag-double-float)
     1902                           (ash 1 ppc64::subtag-bignum)
     1903                           (ash 1 ppc64::subtag-ratio))))
     1904        #+x8664-target
     1905        (if (<= ,typecode x8664::subtag-double-float)
     1906          (logbitp (the (integer 0 #.x8664::subtag-double-float) ,typecode)
     1907                   (logior (ash 1 x8664::tag-fixnum)
     1908                           (ash 1 x8664::subtag-bignum)
     1909                           (ash 1 x8664::tag-single-float)
     1910                           (ash 1 x8664::subtag-double-float)
     1911                           (ash 1 x8664::subtag-ratio))))))))
     1912       
    18851913(define-compiler-macro %composite-pointer-ref (size pointer offset)
    18861914  (if (constantp size)
     
    20292057        (and (integerp ,val) (not (< ,val 0)))))))
    20302058
     2059
     2060
    20312061(provide "OPTIMIZERS")
    20322062
Note: See TracChangeset for help on using the changeset viewer.