RIGHTDIGIT ; saw "[sign] {digit}* dot {digit}+"
(ouch-read-buffer char)
(setq char (read-char stream nil nil))
- (unless char (return (make-float)))
+ (unless char (return (make-float stream)))
(case (char-class char attribute-table)
(#.+char-attr-constituent-digit+ (go RIGHTDIGIT))
(#.+char-attr-constituent-expt+ (go EXPONENT))
(#.+char-attr-delimiter+
(unread-char char stream)
- (return (make-float)))
+ (return (make-float stream)))
(#.+char-attr-escape+ (go ESCAPE))
(#.+char-attr-multiple-escape+ (go MULT-ESCAPE))
(#.+char-attr-package-delimiter+ (go COLON))
EXPTDIGIT ; got to EXPONENT, saw "[sign] {digit}+"
(ouch-read-buffer char)
(setq char (read-char stream nil nil))
- (unless char (return (make-float)))
+ (unless char (return (make-float stream)))
(case (char-class char attribute-table)
(#.+char-attr-constituent-digit+ (go EXPTDIGIT))
(#.+char-attr-delimiter+
(unread-char char stream)
- (return (make-float)))
+ (return (make-float stream)))
(#.+char-attr-escape+ (go ESCAPE))
(#.+char-attr-multiple-escape+ (go MULT-ESCAPE))
(#.+char-attr-package-delimiter+ (go COLON))
RATIODIGIT ; saw "[sign] {digit}+ slash {digit}+"
(ouch-read-buffer char)
(setq char (read-char stream nil nil))
- (unless char (return (make-ratio)))
+ (unless char (return (make-ratio stream)))
(case (char-class2 char attribute-table)
(#.+char-attr-constituent-digit+ (go RATIODIGIT))
(#.+char-attr-delimiter+
(unread-char char stream)
- (return (make-ratio)))
+ (return (make-ratio stream)))
(#.+char-attr-escape+ (go ESCAPE))
(#.+char-attr-multiple-escape+ (go MULT-ESCAPE))
(#.+char-attr-package-delimiter+ (go COLON))
(the index (* num base))))))))
(setq number (+ num (* number base-power)))))))
-(defun make-float ()
+(defun make-float (stream)
;; Assume that the contents of *read-buffer* are a legal float, with nothing
;; else after it.
(read-unwind-read-buffer)
(cond ((eofp char)
;; If not, we've read the whole number.
(let ((num (make-float-aux number divisor
- *read-default-float-format*)))
+ *read-default-float-format*
+ stream)))
(return-from make-float (if negative-fraction (- num) num))))
((exponent-letterp char)
(setq float-char char)
0))))
(incf exponent correction)
(setf number (/ number (expt 10 correction)))
- (setq num (make-float-aux number divisor float-format))
+ (setq num (make-float-aux number divisor float-format stream))
(setq num (* num (expt 10 exponent)))
(return-from make-float (if negative-fraction
(- 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-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 ()
+(defun make-ratio (stream)
;; Assume *READ-BUFFER* contains a legal ratio. Build the number from
;; the string.
;;
(dig ()))
((or (eofp ch) (not (setq dig (digit-char-p ch *read-base*)))))
(setq denominator (+ (* denominator *read-base*) dig)))
- (let ((num (/ numerator denominator)))
+ (let ((num (handler-case
+ (/ numerator denominator)
+ (arithmetic-error (c)
+ (error 'reader-impossible-number-error
+ :error c :stream stream
+ :format-control "failed to build ratio")))))
(if negative-number (- num) num))))
\f
;;;; cruft for dispatch macros
and the lisp object built by the reader is returned. Macro chars
will take effect."
(declare (string string))
+
(with-array-data ((string string)
(start start)
- (end (or end (length string))))
+ (end (%check-vector-sequence-bounds string start end)))
(unless *read-from-string-spares*
(push (internal-make-string-input-stream "" 0 0)
*read-from-string-spares*))
:format-arguments (list string))))
(with-array-data ((string string)
(start start)
- (end (or end (length string))))
+ (end (%check-vector-sequence-bounds string start end)))
(let ((index (do ((i start (1+ i)))
((= i end)
(if junk-allowed