- 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:
- (t (error "internal error in floating point reader")))))
-
-(defun make-float-aux (number divisor float-format)
- (coerce (/ number divisor) float-format))
-
-(defun make-ratio ()
+ (result (make-float-aux (* (expt 10 exponent) number)
+ divisor float-format stream)))
+ (return-from make-float
+ (if negative-fraction (- result) result))))
+ (t (bug "bad fallthrough in floating point reader")))))
+
+(defun make-float-aux (number divisor float-format stream)
+ (handler-case
+ (coerce (/ number divisor) float-format)
+ (type-error (c)
+ (error 'reader-impossible-number-error
+ :error c :stream stream
+ :format-control "failed to build float"))))
+
+(defun make-ratio (stream)