- ;; If not, we've read the whole number.
- (let ((num (make-float-aux number divisor
- *read-default-float-format*)))
- (return-from make-float (if negative-fraction (- num) num))))
- ((exponent-letterp char)
- (setq float-char char)
- ;; Build exponent.
- (setq char (inch-read-buffer))
- ;; Check leading sign.
- (if (cond ((char= char #\+) t)
- ((char= char #\-) (setq negative-exponent t)))
- ;; Flush sign.
- (setq char (inch-read-buffer)))
- ;; Read digits for exponent.
- (do* ((ch char (inch-read-buffer))
- (dig (and (not (eofp ch)) (digit-char-p ch))
- (and (not (eofp ch)) (digit-char-p ch))))
- ((not dig)
- (setq exponent (if negative-exponent (- exponent) exponent)))
- (setq exponent (+ (* exponent 10) dig)))
- ;; Generate and return the float, depending on FLOAT-CHAR:
- (let* ((float-format (case (char-upcase float-char)
- (#\E *read-default-float-format*)
- (#\S 'short-float)
- (#\F 'single-float)
- (#\D 'double-float)
- (#\L 'long-float)))
- 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, as the
- ;; cross-compiler will call the host's LOG function
- ;; while attempting to constant-fold. Maybe some sort
- ;; of load-time-form magic could be used instead?
- (case float-format
- (short-float
- (values
- (log sb!xc:least-positive-normalized-short-float 10s0)
- (log sb!xc:most-positive-short-float 10s0)))
- (single-float
- (values
- (log sb!xc:least-positive-normalized-single-float 10f0)
- (log sb!xc:most-positive-single-float 10f0)))
- (double-float
- (values
- (log sb!xc:least-positive-normalized-double-float 10d0)
- (log sb!xc:most-positive-double-float 10d0)))
- (long-float
- (values
- (log sb!xc:least-positive-normalized-long-float 10L0)
- (log sb!xc: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 (bug "bad fallthrough in floating point reader")))))
-
-(defun make-float-aux (number divisor float-format)
- (coerce (/ number divisor) float-format))
-
-(defun make-ratio ()
+ ;; If not, we've read the whole number.
+ (let ((num (make-float-aux number divisor
+ *read-default-float-format*
+ stream)))
+ (return-from make-float (if negative-fraction (- num) num))))
+ ((exponent-letterp char)
+ (setq float-char char)
+ ;; Build exponent.
+ (setq char (inch-read-buffer))
+ ;; Check leading sign.
+ (if (cond ((char= char #\+) t)
+ ((char= char #\-) (setq negative-exponent t)))
+ ;; Flush sign.
+ (setq char (inch-read-buffer)))
+ ;; Read digits for exponent.
+ (do* ((ch char (inch-read-buffer))
+ (dig (and (not (eofp ch)) (digit-char-p ch))
+ (and (not (eofp ch)) (digit-char-p ch))))
+ ((not dig)
+ (setq exponent (if negative-exponent (- exponent) exponent)))
+ (setq exponent (+ (* exponent 10) dig)))
+ ;; Generate and return the float, depending on FLOAT-CHAR:
+ (let* ((float-format (case (char-upcase float-char)
+ (#\E *read-default-float-format*)
+ (#\S 'short-float)
+ (#\F 'single-float)
+ (#\D 'double-float)
+ (#\L 'long-float)))
+ (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)