X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;ds=sidebyside;f=src%2Fcode%2Freader.lisp;h=08d6ea30f8a913c2174db52a85eec0257e484ef9;hb=8479d3ade615e93a48757da061807223a6a902d2;hp=243fd0cadb2ef7aec3daae6224a6b007da6e9ba3;hpb=c364434c07423e4b033f286397667b3fe0310e97;p=sbcl.git

diff --git a/src/code/reader.lisp b/src/code/reader.lisp
index 243fd0c..08d6ea3 100644
--- a/src/code/reader.lisp
+++ b/src/code/reader.lisp
@@ -215,12 +215,11 @@
     really-to-readtable))
 
 (defun set-syntax-from-char (to-char from-char &optional
-                                     (to-readtable *readtable*)
-                                     (from-readtable ()))
+                             (to-readtable *readtable*) (from-readtable ()))
   #!+sb-doc
-  "Causes the syntax of TO-CHAR to be the same as FROM-CHAR in the
-  optional readtable (defaults to the current readtable). The
-  FROM-TABLE defaults to the standard Lisp readtable when NIL."
+  "Causes the syntax of TO-CHAR to be the same as FROM-CHAR in the optional
+readtable (defaults to the current readtable). The FROM-TABLE defaults to the
+standard Lisp readtable when NIL."
   (let ((really-from-readtable (or from-readtable *standard-readtable*)))
     (let ((att (get-cat-entry from-char really-from-readtable))
           (mac (get-raw-cmt-entry from-char really-from-readtable))
@@ -402,12 +401,11 @@
      (setq *ouch-ptr* (1- (the fixnum *ouch-ptr*)))))
 
 (defun grow-read-buffer ()
-  (let ((rbl (length (the simple-string *read-buffer*))))
-    (setq *read-buffer*
-          (concatenate 'simple-string
-                       *read-buffer*
-                       (make-string rbl)))
-    (setq *read-buffer-length* (* 2 rbl))))
+  (let* ((rbl (length *read-buffer*))
+         (new-length (* 2 rbl))
+         (new-buffer (make-string new-length)))
+    (setq *read-buffer* (replace new-buffer *read-buffer*))
+    (setq *read-buffer-length* new-length)))
 
 (defun inchpeek-read-buffer ()
   (if (>= (the fixnum *inch-ptr*) (the fixnum *ouch-ptr*))
@@ -777,16 +775,20 @@ variables to allow for nested and thread safe reading."
   (let ((case (readtable-case *readtable*)))
     (cond
      ((and (null escapes) (eq case :upcase))
-      (dotimes (i *ouch-ptr*)
-        (setf (schar *read-buffer* i)
-              (char-upcase (schar *read-buffer* i)))))
+      ;; Pull the special variable access out of the loop.
+      (let ((buffer *read-buffer*))
+        (dotimes (i *ouch-ptr*)
+          (declare (optimize (sb!c::insert-array-bounds-checks 0)))
+          (setf (schar buffer i) (char-upcase (schar buffer i))))))
      ((eq case :preserve))
      (t
       (macrolet ((skip-esc (&body body)
                    `(do ((i (1- *ouch-ptr*) (1- i))
+                         (buffer *read-buffer*)
                          (escapes escapes))
                         ((minusp i))
-                      (declare (fixnum i))
+                      (declare (fixnum i)
+                               (optimize (sb!c::insert-array-bounds-checks 0)))
                       (when (or (null escapes)
                                 (let ((esc (first escapes)))
                                   (declare (fixnum esc))
@@ -795,12 +797,12 @@ variables to allow for nested and thread safe reading."
                                          (aver (= esc i))
                                          (pop escapes)
                                          nil))))
-                        (let ((ch (schar *read-buffer* i)))
+                        (let ((ch (schar buffer i)))
                           ,@body)))))
         (flet ((lower-em ()
-                 (skip-esc (setf (schar *read-buffer* i) (char-downcase ch))))
+                 (skip-esc (setf (schar buffer i) (char-downcase ch))))
                (raise-em ()
-                 (skip-esc (setf (schar *read-buffer* i) (char-upcase ch)))))
+                 (skip-esc (setf (schar buffer i) (char-upcase ch)))))
           (ecase case
             (:upcase (raise-em))
             (:downcase (lower-em))