X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Freader.lisp;h=49a0ba0aaa466d9b6d9a6955e4a2223347b7857d;hb=2f2fad31a662b5387376003fab7ef328b4ac9063;hp=d85f441a2c4ea0a961c96444ec227842d33ba6dc;hpb=bff8455d98c50672cdc29abcf1809b8823f5f117;p=sbcl.git diff --git a/src/code/reader.lisp b/src/code/reader.lisp index d85f441..49a0ba0 100644 --- a/src/code/reader.lisp +++ b/src/code/reader.lisp @@ -800,13 +800,13 @@ 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)) @@ -859,12 +859,12 @@ 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)) @@ -883,12 +883,12 @@ 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)) @@ -1147,7 +1147,7 @@ (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) @@ -1181,7 +1181,8 @@ (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) @@ -1219,22 +1220,19 @@ ;; 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 + ((short-float single-float) (values (log sb!xc:least-positive-normalized-single-float 10f0) (log sb!xc:most-positive-single-float 10f0))) - (double-float + ((double-float #!-long-float long-float) (values (log sb!xc:least-positive-normalized-double-float 10d0) (log sb!xc:most-positive-double-float 10d0))) + #!+long-float (long-float (values - (log sb!xc:least-positive-normalized-long-float 10L0) - (log sb!xc:most-positive-long-float 10L0)))) + (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) @@ -1243,7 +1241,7 @@ 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) @@ -1251,10 +1249,15 @@ ;; 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. ;; @@ -1278,7 +1281,12 @@ (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)))) ;;;; cruft for dispatch macros @@ -1389,9 +1397,10 @@ 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*)) @@ -1420,7 +1429,7 @@ :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