X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Freader.lisp;h=e6652f3e144cc2d8f647a92465ebd4addb57f54c;hb=89f3ce96b6c5d0b80308be2a8145aefe80fe1e9b;hp=5b9fdfcc524735af5d73785b8df0d20c60a971b8;hpb=faf3b69d1062a987aa18d83459f60c4c8a8d0987;p=sbcl.git diff --git a/src/code/reader.lisp b/src/code/reader.lisp index 5b9fdfc..e6652f3 100644 --- a/src/code/reader.lisp +++ b/src/code/reader.lisp @@ -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,7 +456,7 @@ standard Lisp readtable when NIL." (declaim (inline ouch-read-buffer)) (defun ouch-read-buffer (char) ;; When buffer overflow - (when (>= *ouch-ptr* *read-buffer-length*) + (when (>= *ouch-ptr* (length *read-buffer*)) ;; Size should be doubled. (grow-read-buffer)) (setf (elt *read-buffer* *ouch-ptr*) char) @@ -470,8 +466,7 @@ standard Lisp readtable when NIL." (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 +489,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 +551,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 +571,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 +591,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))