0.8.7.2:

[sbcl.git] / src / code / reader.lisp

diff --git a/src/code/reader.lisp b/src/code/reader.lisp
index 49a0ba0..92d8ee4 100644 (file)
--- a/src/code/reader.lisp
+++ b/src/code/reader.lisp
@@ -256,9 +256,9 @@
                   +char-attr-whitespace+)
               (done-with-fast-read-char)
               char)))
-       ;; fundamental-stream
+       ;; CLOS stream
        (do ((attribute-table (character-attribute-table *readtable*))
-            (char (stream-read-char stream) (stream-read-char stream)))
+            (char (read-char stream nil :eof) (read-char stream nil :eof)))
            ((or (eq char :eof)
                 (/= (the fixnum (aref attribute-table (char-code char)))
                     +char-attr-whitespace+))
@@ -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.
@@ -483,8 +483,8 @@
                     (fast-read-char nil nil)))
              ((or (not char) (char= char #\newline))
               (done-with-fast-read-char))))
-       ;; FUNDAMENTAL-STREAM
-       (do ((char (stream-read-char stream) (stream-read-char stream)))
+       ;; CLOS stream
+       (do ((char (read-char stream nil :eof) (read-char stream nil :eof)))
            ((or (eq char :eof) (char= char #\newline))))))
   ;; Don't return anything.
   (values))
@@ -547,13 +547,13 @@
               (done-with-fast-read-char))
            (if (escapep char) (setq char (fast-read-char t)))
            (ouch-read-buffer char)))
-       ;; FUNDAMENTAL-STREAM
-       (do ((char (stream-read-char stream) (stream-read-char stream)))
+       ;; CLOS stream
+       (do ((char (read-char stream nil :eof) (read-char stream nil :eof)))
            ((or (eq char :eof) (char= char closech))
             (if (eq char :eof)
                 (error 'end-of-file :stream stream)))
          (when (escapep char)
-           (setq char (stream-read-char stream))
+           (setq char (read-char stream nil :eof))
            (if (eq char :eof)
                (error 'end-of-file :stream stream)))
          (ouch-read-buffer char))))
@@ -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)
@@ -926,15 +927,15 @@
                 (#.+char-attr-package-delimiter+ (done-with-fast-read-char)
                                                  (go COLON))
                 (t (go SYMBOL-LOOP)))))
-           ;; fundamental-stream
+           ;; CLOS stream
            (prog ()
             SYMBOL-LOOP
             (ouch-read-buffer char)
-            (setq char (stream-read-char stream))
+            (setq char (read-char stream nil :eof))
             (when (eq char :eof) (go RETURN-SYMBOL))
             (case (char-class char attribute-table)
               (#.+char-attr-escape+ (go ESCAPE))
-              (#.+char-attr-delimiter+ (stream-unread-char stream char)
+              (#.+char-attr-delimiter+ (unread-char char stream)
                            (go RETURN-SYMBOL))
               (#.+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))
@@ -1427,7 +1431,7 @@
               `(error 'simple-parse-error
                       :format-control ,format-control
                       :format-arguments (list string))))
-    (with-array-data ((string string)
+    (with-array-data ((string string :offset-var offset)
                      (start start)
                      (end (%check-vector-sequence-bounds string start end)))
       (let ((index (do ((i start (1+ i)))
@@ -1456,10 +1460,10 @@
                        found-digit t))
                 (junk-allowed (return nil))
                 ((whitespacep char)
-                 (do ((jndex (1+ index) (1+ jndex)))
-                     ((= jndex end))
-                   (declare (fixnum jndex))
-                   (unless (whitespacep (char string jndex))
+                  (loop
+                   (incf index)
+                   (when (= index end) (return))
+                   (unless (whitespacep (char string index))
                      (parse-error "junk in string ~S")))
                  (return nil))
                 (t
@@ -1471,7 +1475,7 @@
             (if junk-allowed
                 nil
                 (parse-error "no digits in string ~S")))
-        index)))))
+        (- index offset))))))
 \f
 ;;;; reader initialization code