:stream stream
:context context))
-(defun %reader-error (stream control &rest args)
- (error 'reader-error
+;;; If The Gods didn't intend for us to use multiple namespaces, why
+;;; did They specify them?
+(defun simple-reader-error (stream control &rest args)
+ (error 'simple-reader-error
:stream stream
:format-control control
:format-arguments args))
(defun undefined-macro-char (stream char)
(unless *read-suppress*
- (%reader-error stream "undefined read-macro character ~S" char)))
+ (simple-reader-error stream "undefined read-macro character ~S" char)))
;;; The character attribute table is a CHAR-CODE-LIMIT vector of integers.
(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*))
(cond ((token-delimiterp nextchar)
(cond ((eq listtail thelist)
(unless *read-suppress*
- (%reader-error
+ (simple-reader-error
stream
"Nothing appears before . in list.")))
((whitespace[2]p nextchar)
((char= char #\) )
(if *read-suppress*
(return-from read-after-dot nil)
- (%reader-error stream "Nothing appears after . in list.")))
+ (simple-reader-error stream "Nothing appears after . in list.")))
;; See whether there's something there.
(setq lastobj (read-maybe-nothing stream char))
(when lastobj (return t)))
;; Try reading virtual whitespace.
(if (and (read-maybe-nothing stream lastchar)
(not *read-suppress*))
- (%reader-error stream "More than one object follows . in list.")))))
+ (simple-reader-error stream
+ "More than one object follows . in list.")))))
(defun read-string (stream closech)
;; This accumulates chars until it sees same char that invoked it.
(defun read-right-paren (stream ignore)
(declare (ignore ignore))
- (%reader-error stream "unmatched close parenthesis"))
+ (simple-reader-error stream "unmatched close parenthesis"))
;;; Read from the stream up to the next delimiter. Leave the resulting
;;; token in *READ-BUFFER*, and return two values:
((< att +char-attr-constituent+) att)
(t (setf att (get-constituent-trait ,char))
(if (= att +char-attr-invalid+)
- (%reader-error stream "invalid constituent")
+ (simple-reader-error stream "invalid constituent")
att)))))
;;; Return the character class for CHAR, which might be part of a
((digit-char-p ,char *read-base*) +char-attr-constituent-digit+)
((= att +char-attr-constituent-digit+) +char-attr-constituent+)
((= att +char-attr-invalid+)
- (%reader-error stream "invalid constituent"))
+ (simple-reader-error stream "invalid constituent"))
(t att))))))
;;; Return the character class for a char which might be part of a
+char-attr-constituent-digit+)
+char-attr-constituent-decimal-digit+))
((= att +char-attr-invalid+)
- (%reader-error stream "invalid constituent"))
+ (simple-reader-error stream "invalid constituent"))
(t att))))))
\f
;;;; token fetching
(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))
(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))
(#.+char-attr-single-escape+ (go SINGLE-ESCAPE))
(#.+char-attr-package-delimiter+ (go COLON))
(#.+char-attr-multiple-escape+ (go MULT-ESCAPE))
- (#.+char-attr-invalid+ (%reader-error stream "invalid constituent"))
+ (#.+char-attr-invalid+ (simple-reader-error stream
+ "invalid constituent"))
;; can't have eof, whitespace, or terminating macro as first char!
(t (go SYMBOL)))
SIGN ; saw "sign"
FRONTDOT ; saw "dot"
(ouch-read-buffer char)
(setq char (read-char stream nil nil))
- (unless char (%reader-error stream "dot context error"))
+ (unless char (simple-reader-error stream "dot context error"))
(case (char-class char attribute-array attribute-hash-table)
(#.+char-attr-constituent-digit+ (go RIGHTDIGIT))
(#.+char-attr-constituent-dot+ (go DOTS))
- (#.+char-attr-delimiter+ (%reader-error stream "dot context error"))
+ (#.+char-attr-delimiter+ (simple-reader-error stream
+ "dot context error"))
(#.+char-attr-single-escape+ (go SINGLE-ESCAPE))
(#.+char-attr-multiple-escape+ (go MULT-ESCAPE))
(#.+char-attr-package-delimiter+ (go COLON))
DOTS ; saw "dot {dot}+"
(ouch-read-buffer char)
(setq char (read-char stream nil nil))
- (unless char (%reader-error stream "too many dots"))
+ (unless char (simple-reader-error stream "too many dots"))
(case (char-class char attribute-array attribute-hash-table)
(#.+char-attr-constituent-dot+ (go DOTS))
(#.+char-attr-delimiter+
(unread-char char stream)
- (%reader-error stream "too many dots"))
+ (simple-reader-error stream "too many dots"))
(#.+char-attr-single-escape+ (go SINGLE-ESCAPE))
(#.+char-attr-multiple-escape+ (go MULT-ESCAPE))
(#.+char-attr-package-delimiter+ (go COLON))
COLON
(casify-read-buffer escapes)
(unless (zerop colons)
- (%reader-error stream "too many colons in ~S"
- (read-buffer-to-string)))
+ (simple-reader-error stream
+ "too many colons in ~S"
+ (read-buffer-to-string)))
(setq colons 1)
(setq package-designator
(if (plusp *ouch-ptr*)
(case (char-class char attribute-array attribute-hash-table)
(#.+char-attr-delimiter+
(unread-char char stream)
- (%reader-error stream
- "illegal terminating character after a colon: ~S"
- char))
+ (simple-reader-error stream
+ "illegal terminating character after a colon: ~S"
+ char))
(#.+char-attr-single-escape+ (go SINGLE-ESCAPE))
(#.+char-attr-multiple-escape+ (go MULT-ESCAPE))
(#.+char-attr-package-delimiter+ (go INTERN))
(case (char-class char attribute-array attribute-hash-table)
(#.+char-attr-delimiter+
(unread-char char stream)
- (%reader-error stream
- "illegal terminating character after a colon: ~S"
- char))
+ (simple-reader-error stream
+ "illegal terminating character after a colon: ~S"
+ char))
(#.+char-attr-single-escape+ (go SINGLE-ESCAPE))
(#.+char-attr-multiple-escape+ (go MULT-ESCAPE))
(#.+char-attr-package-delimiter+
- (%reader-error stream
- "too many colons after ~S name"
- package-designator))
+ (simple-reader-error stream
+ "too many colons after ~S name"
+ package-designator))
(t (go SYMBOL)))
RETURN-SYMBOL
(casify-read-buffer escapes)
(find-package package-designator)
(sane-package))))
(unless found
- (error 'reader-package-error :stream stream
+ (error 'simple-reader-package-error :stream stream
:format-arguments (list package-designator)
:format-control "package ~S not found"))
(when (eq test :external) (return symbol))
(let ((name (read-buffer-to-string)))
(with-simple-restart (continue "Use symbol anyway.")
- (error 'reader-package-error :stream stream
+ (error 'simple-reader-package-error :stream stream
:format-arguments (list name (package-name found))
:format-control
(if test
(declare (ignore ignore))
(if *read-suppress*
(values)
- (%reader-error stream "no dispatch function defined for ~S" sub-char)))
+ (simple-reader-error stream
+ "no dispatch function defined for ~S"
+ sub-char)))
(defun make-dispatch-macro-character (char &optional
(non-terminating-p nil)
(funcall (the function
(gethash sub-char (cdr dpair) #'dispatch-char-error))
stream sub-char (if numargp numarg nil))
- (%reader-error stream "no dispatch table for dispatch char")))))
+ (simple-reader-error stream
+ "no dispatch table for dispatch char")))))
\f
;;;; READ-FROM-STRING
projects / sbcl.git / blobdiff