Changeset 12418


Ignore:
Timestamp:
Jul 17, 2009, 2:25:46 AM (10 years ago)
Author:
rme
Message:

In DECODE-FLOAT, always return a positive significand. (ticket:458)

File:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/source/level-0/l0-float.lisp

    r10149 r12418  
    225225            (sign (if (%double-float-sign n) -1.0d0 1.0d0)))   
    226226       (if (eq 0 old-exp)
    227          (if  (%double-float-zerop n)
     227         (if (%double-float-zerop n)
    228228           (values 0.0d0 0 sign)
    229229           (let* ((val (%make-dfloat))
    230230                  (zeros (dfloat-significand-zeros n)))
    231              (%copy-double-float n val)
    232              (%%scale-dfloat! n (+ 2 IEEE-double-float-bias zeros) val) ; get it normalized
     231             (%%double-float-abs! n val)
     232             (%%scale-dfloat! val (+ 2 IEEE-double-float-bias zeros) val) ; get it normalized
    233233             (set-%double-float-exp val IEEE-double-float-bias)      ; then bash exponent
    234              (values val (- old-exp zeros IEEE-double-float-bias) sign )))
    235          (if (> old-exp 2046)
     234             (values val (- old-exp zeros IEEE-double-float-bias) sign)))
     235         (if (> old-exp IEEE-double-float-normal-exponent-max)
    236236           (error "Can't decode NAN or infinity ~s" n)
    237237           (let ((val (%make-dfloat)))
    238              (%copy-double-float n val)
     238             (%%double-float-abs! n val)
    239239             (set-%double-float-exp val IEEE-double-float-bias)
    240240             (values val (- old-exp IEEE-double-float-bias) sign))))))
     
    243243            (sign (if (%short-float-sign n) -1.0s0 1.0s0)))
    244244       (if (eq 0 old-exp)
    245          (if  (%short-float-zerop n)
     245         (if (%short-float-zerop n)
    246246           (values 0.0s0 0 sign)
    247247           #+32-bit-target
    248248           (let* ((val (%make-sfloat))
    249249                  (zeros (sfloat-significand-zeros n)))
    250              (%copy-short-float n val)
    251              (%%scale-sfloat! n (+ 2 IEEE-single-float-bias zeros) val) ; get it normalized
     250             (%%short-float-abs! n val)
     251             (%%scale-sfloat! val (+ 2 IEEE-single-float-bias zeros) val) ; get it normalized
    252252             (set-%short-float-exp val IEEE-single-float-bias)      ; then bash exponent
    253              (values val (- old-exp zeros IEEE-single-float-bias) sign ))
     253             (values val (- old-exp zeros IEEE-single-float-bias) sign))
    254254           #+64-bit-target
    255255           (let* ((zeros (sfloat-significand-zeros n))
    256                   (val (%%scale-sfloat n (+ 2 IEEE-single-float-bias zeros))))
     256                  (val (%%scale-sfloat (%short-float-abs n)
     257                                       (+ 2 IEEE-single-float-bias zeros))))
    257258             (values (set-%short-float-exp val IEEE-single-float-bias)
    258                      (- old-exp zeros IEEE-single-float-bias) sign )))
     259                     (- old-exp zeros IEEE-single-float-bias) sign)))
    259260         (if (> old-exp IEEE-single-float-normal-exponent-max)
    260261           (error "Can't decode NAN or infinity ~s" n)
    261262           #+32-bit-target
    262263           (let ((val (%make-sfloat)))
    263              (%copy-short-float n val)
     264             (%%short-float-abs! n val)
    264265             (set-%short-float-exp val IEEE-single-float-bias)
    265266             (values val (- old-exp IEEE-single-float-bias) sign))
    266267           #+64-bit-target
    267            (values (set-%short-float-exp n IEEE-single-float-bias)
    268                    (- old-exp IEEE-single-float-bias) sign)))))))
     268           (values (set-%short-float-exp (%short-float-abs n)
     269                                         IEEE-single-float-bias)
     270                   (- old-exp IEEE-single-float-bias) sign)))))))
    269271
    270272; (* float (expt 2 int))
Note: See TracChangeset for help on using the changeset viewer.