X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Freader.lisp;h=afb69097eccf74acd00905ec7259c63b2bad1ee6;hb=22c1de0a40df83bb5628974010a879cb2c17ff53;hp=d85f441a2c4ea0a961c96444ec227842d33ba6dc;hpb=bff8455d98c50672cdc29abcf1809b8823f5f117;p=sbcl.git diff --git a/src/code/reader.lisp b/src/code/reader.lisp index d85f441..afb6909 100644 --- a/src/code/reader.lisp +++ b/src/code/reader.lisp @@ -316,7 +316,7 @@ (defvar *ouch-ptr*) (declaim (type index *read-buffer-length* *inch-ptr* *ouch-ptr*)) -(declaim (simple-string *read-buffer*)) +(declaim (type (simple-array character (*)) *read-buffer*)) (defmacro reset-read-buffer () ;; Turn *READ-BUFFER* into an empty read buffer. @@ -736,7 +736,8 @@ (colons 0) (possibly-rational t) (possibly-float t) - (escapes ())) + (escapes ()) + (seen-multiple-escapes nil)) (reset-read-buffer) (prog ((char firstchar)) (case (char-class3 char attribute-table) @@ -800,13 +801,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 +860,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 +884,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)) @@ -956,6 +957,7 @@ (#.+char-attr-package-delimiter+ (go COLON)) (t (go SYMBOL))) MULT-ESCAPE + (setq seen-multiple-escapes t) (do ((char (read-char stream t) (read-char stream t))) ((multiple-escape-p char)) (if (escapep char) (setq char (read-char stream t))) @@ -983,7 +985,9 @@ ;; a FIND-PACKAGE* function analogous to INTERN* ;; and friends? (read-buffer-to-string) - *keyword-package*)) + (if seen-multiple-escapes + (read-buffer-to-string) + *keyword-package*))) (reset-read-buffer) (setq escapes ()) (setq char (read-char stream nil nil)) @@ -1147,7 +1151,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 +1185,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 +1224,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 +1245,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 +1253,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 +1285,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 +1401,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 +1433,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