- num)
- ;; toy@rtp.ericsson.se: We need to watch out if the
- ;; exponent is too small or too large. We add enough to
- ;; EXPONENT to make it within range and scale NUMBER
- ;; appropriately. This should avoid any unnecessary
- ;; underflow or overflow problems.
- (multiple-value-bind (min-expo max-expo)
- ;; FIXME: These #. forms are broken w.r.t.
- ;; cross-compilation portability. Maybe expressions
- ;; like
- ;; (LOG SB!XC:MOST-POSITIVE-SHORT-FLOAT 10s0)
- ;; could be used instead? Or perhaps some sort of
- ;; load-time-form magic?
- (case float-format
- (short-float
- (values
- #.(log least-positive-normalized-short-float 10s0)
- #.(log most-positive-short-float 10s0)))
- (single-float
- (values
- #.(log least-positive-normalized-single-float 10f0)
- #.(log most-positive-single-float 10f0)))
- (double-float
- (values
- #.(log least-positive-normalized-double-float 10d0)
- #.(log most-positive-double-float 10d0)))
- (long-float
- (values
- #.(log least-positive-normalized-long-float 10L0)
- #.(log most-positive-long-float 10L0))))
- (let ((correction (cond ((<= exponent min-expo)
- (ceiling (- min-expo exponent)))
- ((>= exponent max-expo)
- (floor (- max-expo exponent)))
- (t
- 0))))
- (incf exponent correction)
- (setf number (/ number (expt 10 correction)))
- (setq num (make-float-aux number divisor float-format))
- (setq num (* num (expt 10 exponent)))
- (return-from make-float (if negative-fraction
- (- num)
- num))))))
- ;; should never happen