X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Freader.lisp;h=27ec01a06356b400097d5dce0411eda911789aca;hb=bd2df60f7c3f579a9c7610925c79a0e783adaa0e;hp=5b9fdfcc524735af5d73785b8df0d20c60a971b8;hpb=faf3b69d1062a987aa18d83459f60c4c8a8d0987;p=sbcl.git

diff --git a/src/code/reader.lisp b/src/code/reader.lisp
index 5b9fdfc..27ec01a 100644
--- a/src/code/reader.lisp
+++ b/src/code/reader.lisp
@@ -292,8 +292,8 @@ standard Lisp readtable when NIL."
     (values fun-value
             ;; NON-TERMINATING-P return value:
             (if fun-value
-                (or (constituentp char)
-                    (not (terminating-macrop char)))
+                (or (constituentp char designated-readtable)
+                    (not (terminating-macrop char designated-readtable)))
                 ;; ANSI's definition of GET-MACRO-CHARACTER says this
                 ;; value is NIL when CHAR is not a macro character.
                 ;; I.e. this value means not just "non-terminating
@@ -440,15 +440,11 @@ standard Lisp readtable when NIL."
 ;;;; implementation of the read buffer
 
 (defvar *read-buffer*)
-(defvar *read-buffer-length*)
-;;; FIXME: Is it really helpful to have *READ-BUFFER-LENGTH* be a
-;;; separate variable instead of just calculating it on the fly as
-;;; (LENGTH *READ-BUFFER*)?
 
 (defvar *inch-ptr*) ; *OUCH-PTR* always points to next char to write.
 (defvar *ouch-ptr*) ; *INCH-PTR* always points to next char to read.
 
-(declaim (type index *read-buffer-length* *inch-ptr* *ouch-ptr*))
+(declaim (type index *inch-ptr* *ouch-ptr*))
 (declaim (type (simple-array character (*)) *read-buffer*))
 
 (declaim (inline reset-read-buffer))
@@ -460,18 +456,19 @@ standard Lisp readtable when NIL."
 (declaim (inline ouch-read-buffer))
 (defun ouch-read-buffer (char)
   ;; When buffer overflow
-  (when (>= *ouch-ptr* *read-buffer-length*)
+  (let ((op *ouch-ptr*))
+    (declare (optimize (sb!c::insert-array-bounds-checks 0)))
+    (when (>= op (length *read-buffer*))
     ;; Size should be doubled.
-    (grow-read-buffer))
-  (setf (elt *read-buffer* *ouch-ptr*) char)
-  (setq *ouch-ptr* (1+ *ouch-ptr*)))
+      (grow-read-buffer))
+    (setf (elt *read-buffer* op) char)
+    (setq *ouch-ptr* (1+ op))))
 
 (defun grow-read-buffer ()
   (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)))
+    (setq *read-buffer* (replace new-buffer *read-buffer*))))
 
 (defun inch-read-buffer ()
   (if (>= *inch-ptr* *ouch-ptr*)
@@ -494,22 +491,23 @@ standard Lisp readtable when NIL."
 
 (defmacro with-read-buffer (() &body body)
   `(let* ((*read-buffer* (make-string 128))
-          (*read-buffer-length* 128)
           (*ouch-ptr* 0)
           (*inch-ptr* 0))
      ,@body))
 
-(defun check-for-recursive-read (recursive-p operator-name)
-  (when (and recursive-p
-             (not (and (boundp '*read-buffer*)
-                       (boundp '*read-buffer-length*)
-                       (boundp '*ouch-ptr*)
-                       (boundp '*inch-ptr*))))
-    (error 'simple-reader-error
-           :format-control "~A was invoked with RECURSIVE-P being true outside ~
-                            of a recursive read operation."
-           :format-arguments `(,operator-name))))
-
+(declaim (inline read-buffer-boundp))
+(defun read-buffer-boundp ()
+  (and (boundp '*read-buffer*)
+       (boundp '*ouch-ptr*)
+       (boundp '*inch-ptr*)))
+
+(defun check-for-recursive-read (stream recursive-p operator-name)
+  (when (and recursive-p (not (read-buffer-boundp)))
+    (simple-reader-error
+     stream
+     "~A was invoked with RECURSIVE-P being true outside ~
+      of a recursive read operation."
+     `(,operator-name))))
 
 ;;;; READ-PRESERVING-WHITESPACE, READ-DELIMITED-LIST, and READ
 
@@ -555,7 +553,7 @@ standard Lisp readtable when NIL."
   #!+sb-doc
   "Read from STREAM and return the value read, preserving any whitespace
    that followed the object."
-  (check-for-recursive-read recursive-p 'read-preserving-whitespace)
+  (check-for-recursive-read stream recursive-p 'read-preserving-whitespace)
   (%read-preserving-whitespace stream eof-error-p eof-value recursive-p))
 
 ;;; Return NIL or a list with one thing, depending.
@@ -575,7 +573,7 @@ standard Lisp readtable when NIL."
                        (recursive-p nil))
   #!+sb-doc
   "Read the next Lisp value from STREAM, and return it."
-  (check-for-recursive-read recursive-p 'read)
+  (check-for-recursive-read stream recursive-p 'read)
   (let ((result (%read-preserving-whitespace stream eof-error-p eof-value
                                              recursive-p)))
     ;; This function generally discards trailing whitespace. If you
@@ -595,7 +593,7 @@ standard Lisp readtable when NIL."
   #!+sb-doc
   "Read Lisp values from INPUT-STREAM until the next character after a
    value's representation is ENDCHAR, and return the objects as a list."
-  (check-for-recursive-read recursive-p 'read-delimited-list)
+  (check-for-recursive-read input-stream recursive-p 'read-delimited-list)
   (flet ((%read-delimited-list (endchar input-stream)
            (do ((char (flush-whitespace input-stream)
                       (flush-whitespace input-stream))