0.8.5.3:

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

diff --git a/src/code/reader.lisp b/src/code/reader.lisp
index 2372ef8..3ec1059 100644 (file)
--- 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*))
 (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.
 
 (defmacro reset-read-buffer ()
   ;; Turn *READ-BUFFER* into an empty read buffer.

@@ -736,7 +736,8 @@
        (colons 0)
        (possibly-rational t)
        (possibly-float t)
        (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)
     (reset-read-buffer)
     (prog ((char firstchar))
       (case (char-class3 char attribute-table)

@@ -956,6 +957,7 @@
        (#.+char-attr-package-delimiter+ (go COLON))
        (t (go SYMBOL)))
       MULT-ESCAPE
        (#.+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)))
       (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)
                ;; 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))
       (reset-read-buffer)
       (setq escapes ())
       (setq char (read-char stream nil nil))

@@ -1220,22 +1224,19 @@
                 ;; while attempting to constant-fold. Maybe some sort
                 ;; of load-time-form magic could be used instead?
                 (case float-format
                 ;; 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)))
                    (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)))
                    (values
                     (log sb!xc:least-positive-normalized-double-float 10d0)
                     (log sb!xc:most-positive-double-float 10d0)))

+                  #!+long-float

                   (long-float
                    (values
                   (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)
               (let ((correction (cond ((<= exponent min-expo)
                                        (ceiling (- min-expo exponent)))
                                       ((>= exponent max-expo)

@@ -1400,9 +1401,10 @@
    and the lisp object built by the reader is returned. Macro chars
    will take effect."
   (declare (string string))
    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)
   (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*))
     (unless *read-from-string-spares*
       (push (internal-make-string-input-stream "" 0 0)
            *read-from-string-spares*))

@@ -1429,9 +1431,9 @@
               `(error 'simple-parse-error
                       :format-control ,format-control
                       :format-arguments (list string))))
               `(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)
                      (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
       (let ((index (do ((i start (1+ i)))
                       ((= i end)
                        (if junk-allowed

@@ -1458,10 +1460,10 @@
                        found-digit t))
                 (junk-allowed (return nil))
                 ((whitespacep char)
                        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
                      (parse-error "junk in string ~S")))
                  (return nil))
                 (t

@@ -1473,7 +1475,7 @@
             (if junk-allowed
                 nil
                 (parse-error "no digits in string ~S")))
             (if junk-allowed
                 nil
                 (parse-error "no digits in string ~S")))

-        index)))))
+        (- index offset))))))

 \f
 ;;;; reader initialization code
 
 \f
 ;;;; reader initialization code