0.8.3.39:

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

diff --git a/src/code/reader.lisp b/src/code/reader.lisp
index 2372ef8..afb6909 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*))

@@ -1431,7 +1433,7 @@
                       :format-arguments (list string))))
     (with-array-data ((string string)
                      (start start)
                       :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
       (let ((index (do ((i start (1+ i)))
                       ((= i end)
                        (if junk-allowed