0.8.5.3:
[sbcl.git] / src / code / reader.lisp
index 2372ef8..3ec1059 100644 (file)
 (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.
        (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)
        (#.+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)))
                ;; 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))
                 ;; 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)
    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*))
               `(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 (or end (length string))))
+                     (end (%check-vector-sequence-bounds string start end)))
       (let ((index (do ((i start (1+ i)))
                       ((= i end)
                        (if junk-allowed
                        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
             (if junk-allowed
                 nil
                 (parse-error "no digits in string ~S")))
-        index)))))
+        (- index offset))))))
 \f
 ;;;; reader initialization code