X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Freader.lisp;h=bc7c7b11911c41c67a56812c4215d11c084533a6;hb=722703e7cbd3a4b279a4c1baab5d95df2c23cce9;hp=d4abe789389c09f2dcb5b36fce92e06fe7d8ccec;hpb=02ce4b1b927f1312c300047bd5a0db6663a1d2c6;p=sbcl.git

diff --git a/src/code/reader.lisp b/src/code/reader.lisp
index d4abe78..bc7c7b1 100644
--- a/src/code/reader.lisp
+++ b/src/code/reader.lisp
@@ -11,10 +11,12 @@
 
 (in-package "SB!IMPL")
 
-;;; miscellaneous global variables
+;;;; miscellaneous global variables
 
-(defvar *read-default-float-format* 'single-float
-  #!+sb-doc "Float format for 1.0E1")
+;;; ANSI: "the floating-point format that is to be used when reading a
+;;; floating-point number that has no exponent marker or that has e or
+;;; E for an exponent marker"
+(defvar *read-default-float-format* 'single-float)
 (declaim (type (member short-float single-float double-float long-float)
 	       *read-default-float-format*))
 
@@ -53,23 +55,6 @@
 	 :format-control control
 	 :format-arguments args))
 
-;;;; constants for character attributes. These are all as in the manual.
-
-(defconstant whitespace 0)
-(defconstant terminating-macro 1)
-(defconstant escape 2)
-(defconstant constituent 3)
-(defconstant constituent-dot 4)
-(defconstant constituent-expt 5)
-(defconstant constituent-slash 6)
-(defconstant constituent-digit 7)
-(defconstant constituent-sign 8)
-;; the "9" entry intentionally left blank for some reason -- WHN 19990806
-(defconstant multiple-escape 10)
-(defconstant package-delimiter 11)
-;; a fake attribute for use in read-unqualified-token
-(defconstant delimiter 12)
-
 ;;;; macros and functions for character tables
 
 ;;; FIXME: could be SB!XC:DEFMACRO inside EVAL-WHEN (COMPILE EVAL)
@@ -108,28 +93,28 @@
 
 #!-sb-fluid (declaim (inline whitespacep))
 (defun whitespacep (char &optional (rt *readtable*))
-  (test-attribute char whitespace rt))
+  (test-attribute char +char-attr-whitespace+ rt))
 
 (defmacro constituentp (char &optional (rt '*readtable*))
-  `(>= (get-cat-entry ,char ,rt) #.constituent))
+  `(>= (get-cat-entry ,char ,rt) +char-attr-constituent+))
 
 (defmacro terminating-macrop (char &optional (rt '*readtable*))
-  `(test-attribute ,char #.terminating-macro ,rt))
+  `(test-attribute ,char +char-attr-terminating-macro+ ,rt))
 
 (defmacro escapep (char &optional (rt '*readtable*))
-  `(test-attribute ,char #.escape ,rt))
+  `(test-attribute ,char +char-attr-escape+ ,rt))
 
 (defmacro multiple-escape-p (char &optional (rt '*readtable*))
-  `(test-attribute ,char #.multiple-escape ,rt))
+  `(test-attribute ,char +char-attr-multiple-escape+ ,rt))
 
 (defmacro token-delimiterp (char &optional (rt '*readtable*))
   ;; depends on actual attribute numbering above.
-  `(<= (get-cat-entry ,char ,rt) #.terminating-macro))
+  `(<= (get-cat-entry ,char ,rt) +char-attr-terminating-macro+))
 
 ;;;; secondary attribute table
 
-;;; There are a number of "secondary" attributes which are constant properties
-;;; of characters (as long as they are constituents).
+;;; There are a number of "secondary" attributes which are constant
+;;; properties of characters (as long as they are constituents).
 
 (defvar *secondary-attribute-table*)
 (declaim (type attribute-table *secondary-attribute-table*))
@@ -141,26 +126,26 @@
 (defun !cold-init-secondary-attribute-table ()
   (setq *secondary-attribute-table*
 	(make-array char-code-limit :element-type '(unsigned-byte 8)
-		    :initial-element #.constituent))
-  (!set-secondary-attribute #\: #.package-delimiter)
-  (!set-secondary-attribute #\| #.multiple-escape)	; |) [for EMACS]
-  (!set-secondary-attribute #\. #.constituent-dot)
-  (!set-secondary-attribute #\+ #.constituent-sign)
-  (!set-secondary-attribute #\- #.constituent-sign)
-  (!set-secondary-attribute #\/ #.constituent-slash)
+		    :initial-element +char-attr-constituent+))
+  (!set-secondary-attribute #\: +char-attr-package-delimiter+)
+  (!set-secondary-attribute #\| +char-attr-multiple-escape+) ; |) [for EMACS]
+  (!set-secondary-attribute #\. +char-attr-constituent-dot+)
+  (!set-secondary-attribute #\+ +char-attr-constituent-sign+)
+  (!set-secondary-attribute #\- +char-attr-constituent-sign+)
+  (!set-secondary-attribute #\/ +char-attr-constituent-slash+)
   (do ((i (char-code #\0) (1+ i)))
       ((> i (char-code #\9)))
-    (!set-secondary-attribute (code-char i) #.constituent-digit))
-  (!set-secondary-attribute #\E #.constituent-expt)
-  (!set-secondary-attribute #\F #.constituent-expt)
-  (!set-secondary-attribute #\D #.constituent-expt)
-  (!set-secondary-attribute #\S #.constituent-expt)
-  (!set-secondary-attribute #\L #.constituent-expt)
-  (!set-secondary-attribute #\e #.constituent-expt)
-  (!set-secondary-attribute #\f #.constituent-expt)
-  (!set-secondary-attribute #\d #.constituent-expt)
-  (!set-secondary-attribute #\s #.constituent-expt)
-  (!set-secondary-attribute #\l #.constituent-expt))
+    (!set-secondary-attribute (code-char i) +char-attr-constituent-digit+))
+  (!set-secondary-attribute #\E +char-attr-constituent-expt+)
+  (!set-secondary-attribute #\F +char-attr-constituent-expt+)
+  (!set-secondary-attribute #\D +char-attr-constituent-expt+)
+  (!set-secondary-attribute #\S +char-attr-constituent-expt+)
+  (!set-secondary-attribute #\L +char-attr-constituent-expt+)
+  (!set-secondary-attribute #\e +char-attr-constituent-expt+)
+  (!set-secondary-attribute #\f +char-attr-constituent-expt+)
+  (!set-secondary-attribute #\d +char-attr-constituent-expt+)
+  (!set-secondary-attribute #\s +char-attr-constituent-expt+)
+  (!set-secondary-attribute #\l +char-attr-constituent-expt+))
 
 (defmacro get-secondary-attribute (char)
   `(elt *secondary-attribute-table*
@@ -169,17 +154,20 @@
 ;;;; readtable operations
 
 (defun copy-readtable (&optional (from-readtable *readtable*)
-				 (to-readtable (make-readtable)))
-  (let ((really-from-readtable (or from-readtable *standard-readtable*)))
-    (replace (character-attribute-table to-readtable)
+				 to-readtable)
+  (let ((really-from-readtable (or from-readtable *standard-readtable*))
+        (really-to-readtable (or to-readtable (make-readtable))))
+    (replace (character-attribute-table really-to-readtable)
 	     (character-attribute-table really-from-readtable))
-    (replace (character-macro-table to-readtable)
+    (replace (character-macro-table really-to-readtable)
 	     (character-macro-table really-from-readtable))
-    (setf (dispatch-tables to-readtable)
-	  (mapcar #'(lambda (pair) (cons (car pair)
-					 (copy-seq (cdr pair))))
+    (setf (dispatch-tables really-to-readtable)
+	  (mapcar (lambda (pair) (cons (car pair)
+				       (copy-seq (cdr pair))))
 		  (dispatch-tables really-from-readtable)))
-    to-readtable))
+    (setf (readtable-case really-to-readtable)
+	  (readtable-case really-from-readtable))
+    really-to-readtable))
 
 (defun set-syntax-from-char (to-char from-char &optional
 				     (to-readtable *readtable*)
@@ -189,8 +177,8 @@
   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*)))
-    ;; Copy from-char entries to to-char entries, but make sure that if
-    ;; from char is a constituent you don't copy non-movable secondary
+    ;; Copy FROM-CHAR entries to TO-CHAR entries, but make sure that if
+    ;; FROM-CHAR is a constituent you don't copy non-movable secondary
     ;; attributes (constituent types), and that said attributes magically
     ;; appear if you transform a non-constituent to a constituent.
     (let ((att (get-cat-entry from-char really-from-readtable)))
@@ -205,23 +193,24 @@
 (defun set-macro-character (char function &optional
 				 (non-terminatingp nil) (rt *readtable*))
   #!+sb-doc
-  "Causes char to be a macro character which invokes function when
-   seen by the reader. The non-terminatingp flag can be used to
+  "Causes CHAR to be a macro character which invokes FUNCTION when
+   seen by the reader. The NON-TERMINATINGP flag can be used to
    make the macro character non-terminating. The optional readtable
-   argument defaults to the current readtable. Set-macro-character
+   argument defaults to the current readtable. SET-MACRO-CHARACTER
    returns T."
-  (if non-terminatingp
-      (set-cat-entry char (get-secondary-attribute char) rt)
-      (set-cat-entry char #.terminating-macro rt))
-  (set-cmt-entry char function rt)
-  T)
-
-(defun get-macro-character (char &optional rt)
+  (let ((rt (or rt *standard-readtable*)))
+    (if non-terminatingp
+        (set-cat-entry char (get-secondary-attribute char) rt)
+        (set-cat-entry char +char-attr-terminating-macro+ rt))
+    (set-cmt-entry char function rt)
+    t))
+
+(defun get-macro-character (char &optional (rt *readtable*))
   #!+sb-doc
-  "Returns the function associated with the specified char which is a macro
+  "Return the function associated with the specified CHAR which is a macro
   character. The optional readtable argument defaults to the current
   readtable."
-  (let ((rt (or rt *readtable*)))
+  (let ((rt (or rt *standard-readtable*)))
     ;; Check macro syntax, return associated function if it's there.
     ;; Returns a value for all constituents.
     (cond ((constituentp char)
@@ -238,12 +227,12 @@
   ;; This flushes whitespace chars, returning the last char it read (a
   ;; non-white one). It always gets an error on end-of-file.
   (let ((stream (in-synonym-of stream)))
-    (if (lisp-stream-p stream)
+    (if (ansi-stream-p stream)
 	(prepare-for-fast-read-char stream
 	  (do ((attribute-table (character-attribute-table *readtable*))
 	       (char (fast-read-char t) (fast-read-char t)))
 	      ((/= (the fixnum (aref attribute-table (char-code char)))
-		   #.whitespace)
+		   +char-attr-whitespace+)
 	       (done-with-fast-read-char)
 	       char)))
 	;; fundamental-stream
@@ -251,7 +240,7 @@
 	     (char (stream-read-char stream) (stream-read-char stream)))
 	    ((or (eq char :eof)
 		 (/= (the fixnum (aref attribute-table (char-code char)))
-		     #.whitespace))
+		     +char-attr-whitespace+))
 	     (if (eq char :eof)
 		 (error 'end-of-file :stream stream)
 		 char))))))
@@ -263,14 +252,14 @@
   ;; All characters default to "constituent" in MAKE-READTABLE.
   ;; *** un-constituent-ize some of these ***
   (let ((*readtable* *standard-readtable*))
-    (set-cat-entry (code-char tab-char-code) #.whitespace)
-    (set-cat-entry #\linefeed #.whitespace)
-    (set-cat-entry #\space #.whitespace)
-    (set-cat-entry (code-char form-feed-char-code) #.whitespace)
-    (set-cat-entry (code-char return-char-code) #.whitespace)
-    (set-cat-entry #\\ #.escape)
+    (set-cat-entry (code-char tab-char-code) +char-attr-whitespace+)
+    (set-cat-entry #\linefeed +char-attr-whitespace+)
+    (set-cat-entry #\space +char-attr-whitespace+)
+    (set-cat-entry (code-char form-feed-char-code) +char-attr-whitespace+)
+    (set-cat-entry (code-char return-char-code) +char-attr-whitespace+)
+    (set-cat-entry #\\ +char-attr-escape+)
     (set-cmt-entry #\\ #'read-token)
-    (set-cat-entry (code-char rubout-char-code) #.whitespace)
+    (set-cat-entry (code-char rubout-char-code) +char-attr-whitespace+)
     (set-cmt-entry #\: #'read-token)
     (set-cmt-entry #\| #'read-token)
     ;; macro definitions
@@ -294,8 +283,9 @@
 
 (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*)?
+;;; 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*)
 (defvar *ouch-ptr*)
@@ -304,12 +294,12 @@
 (declaim (simple-string *read-buffer*))
 
 (defmacro reset-read-buffer ()
-  ;; Turn *read-buffer* into an empty read buffer.
-  ;; *Ouch-ptr* always points to next char to write.
+  ;; Turn *READ-BUFFER* into an empty read buffer.
   `(progn
-    (setq *ouch-ptr* 0)
-    ;; *inch-ptr* always points to next char to read.
-    (setq *inch-ptr* 0)))
+     ;; *OUCH-PTR* always points to next char to write.
+     (setq *ouch-ptr* 0)
+     ;; *INCH-PTR* always points to next char to read.
+     (setq *inch-ptr* 0)))
 
 (defun !cold-init-read-buffer ()
   (setq *read-buffer* (make-string 512)) ; initial bufsize
@@ -317,9 +307,10 @@
   (reset-read-buffer))
 
 ;;; FIXME I removed "THE FIXNUM"'s from OUCH-READ-BUFFER and
-;;; OUCH-UNREAD-BUFFER, check to make sure that Python really is smart enough
-;;; to make good code without them. And while I'm at it, converting them
-;;; from macros to inline functions might be good, too.
+;;; OUCH-UNREAD-BUFFER, check to make sure that Python really is smart
+;;; enough to make good code without them. And while I'm at it,
+;;; converting them from macros to inline functions might be good,
+;;; too.
 
 (defmacro ouch-read-buffer (char)
   `(progn
@@ -379,17 +370,17 @@
 
 (declaim (special *standard-input*))
 
-;;; READ-PRESERVING-WHITESPACE behaves just like READ, only it makes sure
-;;; to leave terminating whitespace in the stream.
+;;; READ-PRESERVING-WHITESPACE behaves just like READ, only it makes
+;;; sure to leave terminating whitespace in the stream. (This is a
+;;; COMMON-LISP exported symbol.)
 (defun read-preserving-whitespace (&optional (stream *standard-input*)
 					     (eof-error-p t)
 					     (eof-value nil)
 					     (recursivep nil))
   #!+sb-doc
-  "Reads from stream and returns the object read, preserving the whitespace
+  "Read from STREAM and return the value read, preserving any whitespace
    that followed the object."
-  (cond
-   (recursivep
+  (if recursivep
     ;; a loop for repeating when a macro returns nothing
     (loop
       (let ((char (read-char stream eof-error-p *eof-object*)))
@@ -400,40 +391,46 @@
 		      (result (multiple-value-list
 			       (funcall macrofun stream char))))
 		 ;; Repeat if macro returned nothing.
-		 (if result (return (car result)))))))))
-   (t
+		  (if result (return (car result))))))))
     (let ((*sharp-equal-alist* nil))
-      (read-preserving-whitespace stream eof-error-p eof-value t)))))
+	(read-preserving-whitespace stream eof-error-p eof-value t))))
 
+;;; Return NIL or a list with one thing, depending.
+;;;
+;;; for functions that want comments to return so that they can look
+;;; past them. We assume CHAR is not whitespace.
 (defun read-maybe-nothing (stream char)
-  ;;returns nil or a list with one thing, depending.
-  ;;for functions that want comments to return so they can look
-  ;;past them. Assumes char is not whitespace.
   (let ((retval (multiple-value-list
 		 (funcall (get-cmt-entry char *readtable*) stream char))))
     (if retval (rplacd retval nil))))
 
-(defun read (&optional (stream *standard-input*) (eof-error-p t)
-		       (eof-value ()) (recursivep ()))
+(defun read (&optional (stream *standard-input*)
+		       (eof-error-p t)
+		       (eof-value ())
+		       (recursivep ()))
   #!+sb-doc
-  "Reads in the next object in the stream, which defaults to
-   *standard-input*. For details see the I/O chapter of
-   the manual."
-  (prog1
-      (read-preserving-whitespace stream eof-error-p eof-value recursivep)
-    (let ((whitechar (read-char stream nil *eof-object*)))
-      (if (and (not (eofp whitechar))
-	       (or (not (whitespacep whitechar))
-		   recursivep))
-	  (unread-char whitechar stream)))))
-
+  "Read the next Lisp value from STREAM, and return it."
+  (let ((result (read-preserving-whitespace stream
+					    eof-error-p
+					    eof-value
+					    recursivep)))
+    ;; (This function generally discards trailing whitespace. If you
+    ;; don't want to discard trailing whitespace, call
+    ;; CL:READ-PRESERVING-WHITESPACE instead.)
+    (unless (or (eql result eof-value) recursivep)
+      (let ((next-char (read-char stream nil nil)))
+	(unless (or (null next-char)
+		    (whitespacep next-char))
+	  (unread-char next-char stream))))
+    result))
+
+;;; (This is a COMMON-LISP exported symbol.)
 (defun read-delimited-list (endchar &optional
 				    (input-stream *standard-input*)
 				    recursive-p)
   #!+sb-doc
-  "Reads objects from input-stream until the next character after an
-   object's representation is endchar. A list of those objects read
-   is returned."
+  "Read Lisp values from INPUT-STREAM until the next character after a
+   value's representation is ENDCHAR, and return the objects as a list."
   (declare (ignore recursive-p))
   (do ((char (flush-whitespace input-stream)
 	     (flush-whitespace input-stream))
@@ -443,8 +440,8 @@
 
 ;;;; basic readmacro definitions
 ;;;;
-;;;; Large, hairy subsets of readmacro definitions (backquotes and sharp
-;;;; macros) are not here, but in their own source files.
+;;;; Some large, hairy subsets of readmacro definitions (backquotes
+;;;; and sharp macros) are not here, but in their own source files.
 
 (defun read-quote (stream ignore)
   (declare (ignore ignore))
@@ -453,7 +450,7 @@
 (defun read-comment (stream ignore)
   (declare (ignore ignore))
   (let ((stream (in-synonym-of stream)))
-    (if (lisp-stream-p stream)
+    (if (ansi-stream-p stream)
 	(prepare-for-fast-read-char stream
 	  (do ((char (fast-read-char nil nil)
 		     (fast-read-char nil nil)))
@@ -516,7 +513,7 @@
   ;; For a very long string, this could end up bloating the read buffer.
   (reset-read-buffer)
   (let ((stream (in-synonym-of stream)))
-    (if (lisp-stream-p stream)
+    (if (ansi-stream-p stream)
 	(prepare-for-fast-read-char stream
 	  (do ((char (fast-read-char t) (fast-read-char t)))
 	      ((char= char closech)
@@ -539,14 +536,18 @@
   (declare (ignore ignore))
   (%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:
+;;; Read from the stream up to the next delimiter. Leave the resulting
+;;; token in *READ-BUFFER*, and return two values:
 ;;; -- a list of the escaped character positions, and
 ;;; -- The position of the first package delimiter (or NIL).
-(defun internal-read-extended-token (stream firstchar)
+(defun internal-read-extended-token (stream firstchar escape-firstchar)
   (reset-read-buffer)
+  (let ((escapes '()))
+    (when escape-firstchar
+      (push *ouch-ptr* escapes)
+      (ouch-read-buffer firstchar)
+      (setq firstchar (read-char stream nil *eof-object*)))
   (do ((char firstchar (read-char stream nil *eof-object*))
-       (escapes ())
        (colon nil))
       ((cond ((eofp char) t)
 	     ((token-delimiterp char)
@@ -563,8 +564,8 @@
 		 (reader-eof-error stream "after escape character")
 		 (ouch-read-buffer nextchar))))
 	  ((multiple-escape-p char)
-	   ;; Read to next multiple-escape, escaping single chars along the
-	   ;; way.
+	   ;; Read to next multiple-escape, escaping single chars
+	   ;; along the way.
 	   (loop
 	     (let ((ch (read-char stream nil *eof-object*)))
 	       (cond
@@ -573,18 +574,21 @@
 		((multiple-escape-p ch) (return))
 		((escapep ch)
 		 (let ((nextchar (read-char stream nil *eof-object*)))
-		   (if (eofp nextchar)
-		       (reader-eof-error stream "after escape character")
-		       (ouch-read-buffer nextchar))))
+		   (cond ((eofp nextchar)
+			  (reader-eof-error stream "after escape character"))
+			 (t
+			  (push *ouch-ptr* escapes)
+			  (ouch-read-buffer nextchar)))))
 		(t
 		 (push *ouch-ptr* escapes)
 		 (ouch-read-buffer ch))))))
 	  (t
 	   (when (and (constituentp char)
-		      (eql (get-secondary-attribute char) #.package-delimiter)
+			(eql (get-secondary-attribute char)
+                             +char-attr-package-delimiter+)
 		      (not colon))
 	     (setq colon *ouch-ptr*))
-	   (ouch-read-buffer char)))))
+	   (ouch-read-buffer char))))))
 
 ;;;; character classes
 
@@ -592,57 +596,59 @@
 (defmacro char-class (char attable)
   `(let ((att (aref ,attable (char-code ,char))))
      (declare (fixnum att))
-     (if (<= att #.terminating-macro)
-	 #.delimiter
+     (if (<= att +char-attr-terminating-macro+)
+	 +char-attr-delimiter+
 	 att)))
 
-;;; Return the character class for CHAR, which might be part of a rational
-;;; number.
+;;; Return the character class for CHAR, which might be part of a
+;;; rational number.
 (defmacro char-class2 (char attable)
   `(let ((att (aref ,attable (char-code ,char))))
      (declare (fixnum att))
-     (if (<= att #.terminating-macro)
-	 #.delimiter
+     (if (<= att +char-attr-terminating-macro+)
+	 +char-attr-delimiter+
 	 (if (digit-char-p ,char *read-base*)
-	     constituent-digit
-	     (if (= att constituent-digit)
-		 constituent
+	     +char-attr-constituent-digit+
+	     (if (= att +char-attr-constituent-digit+)
+		 +char-attr-constituent+
 		 att)))))
 
-;;; Return the character class for a char which might be part of a rational or
-;;; floating number. (Assume that it is a digit if it could be.)
+;;; Return the character class for a char which might be part of a
+;;; rational or floating number. (Assume that it is a digit if it
+;;; could be.)
 (defmacro char-class3 (char attable)
   `(let ((att (aref ,attable (char-code ,char))))
      (declare (fixnum att))
      (if possibly-rational
 	 (setq possibly-rational
 	       (or (digit-char-p ,char *read-base*)
-		   (= att constituent-slash))))
+		   (= att +char-attr-constituent-slash+))))
      (if possibly-float
 	 (setq possibly-float
 	       (or (digit-char-p ,char 10)
-		   (= att constituent-dot))))
-     (if (<= att #.terminating-macro)
-	 #.delimiter
+		   (= att +char-attr-constituent-dot+))))
+     (if (<= att +char-attr-terminating-macro+)
+	 +char-attr-delimiter+
 	 (if (digit-char-p ,char (max *read-base* 10))
 	     (if (digit-char-p ,char *read-base*)
-		 constituent-digit
-		 constituent)
+		 +char-attr-constituent-digit+
+		 +char-attr-constituent+)
 	     att))))
 
 ;;;; token fetching
 
 (defvar *read-suppress* nil
   #!+sb-doc
-  "Suppresses most interpreting of the reader when T")
+  "Suppress most interpreting in the reader when T.")
 
 (defvar *read-base* 10
   #!+sb-doc
-  "The radix that Lisp reads numbers in.")
+  "the radix that Lisp reads numbers in")
 (declaim (type (integer 2 36) *read-base*))
 
-;;; Modify the read buffer according to READTABLE-CASE, ignoring escapes.
-;;; ESCAPES is a list of the escaped indices, in reverse order.
+;;; Modify the read buffer according to READTABLE-CASE, ignoring
+;;; ESCAPES. ESCAPES is a list of the escaped indices, in reverse
+;;; order.
 (defun casify-read-buffer (escapes)
   (let ((case (readtable-case *readtable*)))
     (cond
@@ -662,7 +668,7 @@
 				  (declare (fixnum esc))
 				  (cond ((< esc i) t)
 					(t
-					 (assert (= esc i))
+					 (aver (= esc i))
 					 (pop escapes)
 					 nil))))
 			(let ((ch (schar *read-buffer* i)))
@@ -688,15 +694,15 @@
 (defun read-token (stream firstchar)
   #!+sb-doc
   "This function is just an fsm that recognizes numbers and symbols."
-  ;; Check explicitly whether firstchar has entry for non-terminating
-  ;; in character-attribute-table and read-dot-number-symbol in CMT.
-  ;; Report an error if these are violated (if we called this, we want
-  ;; something that is a legitimate token!).
-  ;; Read in the longest possible string satisfying the bnf for
-  ;; "unqualified-token". Leave the result in the *READ-BUFFER*.
-  ;; Return next char after token (last char read).
+  ;; Check explicitly whether FIRSTCHAR has an entry for
+  ;; NON-TERMINATING in CHARACTER-ATTRIBUTE-TABLE and
+  ;; READ-DOT-NUMBER-SYMBOL in CMT. Report an error if these are
+  ;; violated. (If we called this, we want something that is a
+  ;; legitimate token!) Read in the longest possible string satisfying
+  ;; the Backus-Naur form for "unqualified-token". Leave the result in
+  ;; the *READ-BUFFER*. Return next char after token (last char read).
   (when *read-suppress*
-    (internal-read-extended-token stream firstchar)
+    (internal-read-extended-token stream firstchar nil)
     (return-from read-token nil))
   (let ((attribute-table (character-attribute-table *readtable*))
 	(package-designator nil)
@@ -707,180 +713,175 @@
     (reset-read-buffer)
     (prog ((char firstchar))
       (case (char-class3 char attribute-table)
-	(#.constituent-sign (go SIGN))
-	(#.constituent-digit (go LEFTDIGIT))
-	(#.constituent-dot (go FRONTDOT))
-	(#.escape (go ESCAPE))
-	(#.package-delimiter (go COLON))
-	(#.multiple-escape (go MULT-ESCAPE))
-	;;can't have eof, whitespace, or terminating macro as first char!
+	(#.+char-attr-constituent-sign+ (go SIGN))
+	(#.+char-attr-constituent-digit+ (go LEFTDIGIT))
+	(#.+char-attr-constituent-dot+ (go FRONTDOT))
+	(#.+char-attr-escape+ (go ESCAPE))
+	(#.+char-attr-package-delimiter+ (go COLON))
+	(#.+char-attr-multiple-escape+ (go MULT-ESCAPE))
+	;; can't have eof, whitespace, or terminating macro as first char!
 	(t (go SYMBOL)))
-     SIGN
-      ;;saw "sign"
+     SIGN ; saw "sign"
       (ouch-read-buffer char)
       (setq char (read-char stream nil nil))
       (unless char (go RETURN-SYMBOL))
       (setq possibly-rational t
 	    possibly-float t)
       (case (char-class3 char attribute-table)
-	(#.constituent-digit (go LEFTDIGIT))
-	(#.constituent-dot (go SIGNDOT))
-	(#.escape (go ESCAPE))
-	(#.package-delimiter (go COLON))
-	(#.multiple-escape (go MULT-ESCAPE))	
-	(#.delimiter (unread-char char stream) (go RETURN-SYMBOL))
+	(#.+char-attr-constituent-digit+ (go LEFTDIGIT))
+	(#.+char-attr-constituent-dot+ (go SIGNDOT))
+	(#.+char-attr-escape+ (go ESCAPE))
+	(#.+char-attr-package-delimiter+ (go COLON))
+	(#.+char-attr-multiple-escape+ (go MULT-ESCAPE))	
+	(#.+char-attr-delimiter+ (unread-char char stream) (go RETURN-SYMBOL))
 	(t (go SYMBOL)))
-     LEFTDIGIT
-      ;;saw "[sign] {digit}+"
+     LEFTDIGIT ; saw "[sign] {digit}+"
       (ouch-read-buffer char)
       (setq char (read-char stream nil nil))
       (unless char (return (make-integer)))
       (case (char-class3 char attribute-table)
-	(#.constituent-digit (go LEFTDIGIT))
-	(#.constituent-dot (if possibly-float
-			       (go MIDDLEDOT)
-			       (go SYMBOL)))
-	(#.constituent-expt (go EXPONENT))
-	(#.constituent-slash (if possibly-rational
-				 (go RATIO)
-				 (go SYMBOL)))
-	(#.delimiter (unread-char char stream) (return (make-integer)))
-	(#.escape (go ESCAPE))
-	(#.multiple-escape (go MULT-ESCAPE))
-	(#.package-delimiter (go COLON))
+	(#.+char-attr-constituent-digit+ (go LEFTDIGIT))
+	(#.+char-attr-constituent-dot+ (if possibly-float
+					   (go MIDDLEDOT)
+					   (go SYMBOL)))
+	(#.+char-attr-constituent-expt+ (go EXPONENT))
+	(#.+char-attr-constituent-slash+ (if possibly-rational
+					     (go RATIO)
+					     (go SYMBOL)))
+	(#.+char-attr-delimiter+ (unread-char char stream)
+				 (return (make-integer)))
+	(#.+char-attr-escape+ (go ESCAPE))
+	(#.+char-attr-multiple-escape+ (go MULT-ESCAPE))
+	(#.+char-attr-package-delimiter+ (go COLON))
 	(t (go SYMBOL)))
-     MIDDLEDOT
-      ;;saw "[sign] {digit}+ dot"
+     MIDDLEDOT ; saw "[sign] {digit}+ dot"
       (ouch-read-buffer char)
       (setq char (read-char stream nil nil))
       (unless char (return (let ((*read-base* 10))
 			     (make-integer))))
       (case (char-class char attribute-table)
-	(#.constituent-digit (go RIGHTDIGIT))
-	(#.constituent-expt (go EXPONENT))
-	(#.delimiter
+	(#.+char-attr-constituent-digit+ (go RIGHTDIGIT))
+	(#.+char-attr-constituent-expt+ (go EXPONENT))
+	(#.+char-attr-delimiter+
 	 (unread-char char stream)
 	 (return (let ((*read-base* 10))
 		   (make-integer))))
-	(#.escape (go ESCAPE))
-	(#.multiple-escape (go MULT-ESCAPE))
-	(#.package-delimiter (go COLON))
+	(#.+char-attr-escape+ (go ESCAPE))
+	(#.+char-attr-multiple-escape+ (go MULT-ESCAPE))
+	(#.+char-attr-package-delimiter+ (go COLON))
 	(t (go SYMBOL)))
-     RIGHTDIGIT
-      ;;saw "[sign] {digit}* dot {digit}+"
+     RIGHTDIGIT ; saw "[sign] {digit}* dot {digit}+"
       (ouch-read-buffer char)
       (setq char (read-char stream nil nil))
       (unless char (return (make-float)))
       (case (char-class char attribute-table)
-	(#.constituent-digit (go RIGHTDIGIT))
-	(#.constituent-expt (go EXPONENT))
-	(#.delimiter (unread-char char stream) (return (make-float)))
-	(#.escape (go ESCAPE))
-	(#.multiple-escape (go MULT-ESCAPE))
-	(#.package-delimiter (go COLON))
+	(#.+char-attr-constituent-digit+ (go RIGHTDIGIT))
+	(#.+char-attr-constituent-expt+ (go EXPONENT))
+	(#.+char-attr-delimiter+
+	 (unread-char char stream)
+	 (return (make-float)))
+	(#.+char-attr-escape+ (go ESCAPE))
+	(#.+char-attr-multiple-escape+ (go MULT-ESCAPE))
+	(#.+char-attr-package-delimiter+ (go COLON))
 	(t (go SYMBOL)))
-     SIGNDOT
-      ;;saw "[sign] dot"
+     SIGNDOT ; saw "[sign] dot"
       (ouch-read-buffer char)
       (setq char (read-char stream nil nil))
       (unless char (go RETURN-SYMBOL))
       (case (char-class char attribute-table)
-	(#.constituent-digit (go RIGHTDIGIT))
-	(#.delimiter (unread-char char stream) (go RETURN-SYMBOL))
-	(#.escape (go ESCAPE))
-	(#.multiple-escape (go MULT-ESCAPE))
+	(#.+char-attr-constituent-digit+ (go RIGHTDIGIT))
+	(#.+char-attr-delimiter+ (unread-char char stream) (go RETURN-SYMBOL))
+	(#.+char-attr-escape+ (go ESCAPE))
+	(#.+char-attr-multiple-escape+ (go MULT-ESCAPE))
 	(t (go SYMBOL)))
-     FRONTDOT
-      ;;saw "dot"
+     FRONTDOT ; saw "dot"
       (ouch-read-buffer char)
       (setq char (read-char stream nil nil))
       (unless char (%reader-error stream "dot context error"))
       (case (char-class char attribute-table)
-	(#.constituent-digit (go RIGHTDIGIT))
-	(#.constituent-dot (go DOTS))
-	(#.delimiter  (%reader-error stream "dot context error"))
-	(#.escape (go ESCAPE))
-	(#.multiple-escape (go MULT-ESCAPE))
-	(#.package-delimiter (go COLON))
+	(#.+char-attr-constituent-digit+ (go RIGHTDIGIT))
+	(#.+char-attr-constituent-dot+ (go DOTS))
+	(#.+char-attr-delimiter+  (%reader-error stream "dot context error"))
+	(#.+char-attr-escape+ (go ESCAPE))
+	(#.+char-attr-multiple-escape+ (go MULT-ESCAPE))
+	(#.+char-attr-package-delimiter+ (go COLON))
 	(t (go SYMBOL)))
      EXPONENT
       (ouch-read-buffer char)
       (setq char (read-char stream nil nil))
       (unless char (go RETURN-SYMBOL))
       (case (char-class char attribute-table)
-	(#.constituent-sign (go EXPTSIGN))
-	(#.constituent-digit (go EXPTDIGIT))
-	(#.delimiter (unread-char char stream) (go RETURN-SYMBOL))
-	(#.escape (go ESCAPE))
-	(#.multiple-escape (go MULT-ESCAPE))
-	(#.package-delimiter (go COLON))
+	(#.+char-attr-constituent-sign+ (go EXPTSIGN))
+	(#.+char-attr-constituent-digit+ (go EXPTDIGIT))
+	(#.+char-attr-delimiter+ (unread-char char stream) (go RETURN-SYMBOL))
+	(#.+char-attr-escape+ (go ESCAPE))
+	(#.+char-attr-multiple-escape+ (go MULT-ESCAPE))
+	(#.+char-attr-package-delimiter+ (go COLON))
 	(t (go SYMBOL)))
-     EXPTSIGN
-      ;;we got to EXPONENT, and saw a sign character.
+     EXPTSIGN ; got to EXPONENT, and saw a sign character
       (ouch-read-buffer char)
       (setq char (read-char stream nil nil))
       (unless char (go RETURN-SYMBOL))
       (case (char-class char attribute-table)
-	(#.constituent-digit (go EXPTDIGIT))
-	(#.delimiter (unread-char char stream) (go RETURN-SYMBOL))
-	(#.escape (go ESCAPE))
-	(#.multiple-escape (go MULT-ESCAPE))
-	(#.package-delimiter (go COLON))
+	(#.+char-attr-constituent-digit+ (go EXPTDIGIT))
+	(#.+char-attr-delimiter+ (unread-char char stream) (go RETURN-SYMBOL))
+	(#.+char-attr-escape+ (go ESCAPE))
+	(#.+char-attr-multiple-escape+ (go MULT-ESCAPE))
+	(#.+char-attr-package-delimiter+ (go COLON))
 	(t (go SYMBOL)))
-     EXPTDIGIT
-      ;;got to EXPONENT, saw "[sign] {digit}+"
+     EXPTDIGIT ; got to EXPONENT, saw "[sign] {digit}+"
       (ouch-read-buffer char)
       (setq char (read-char stream nil nil))
       (unless char (return (make-float)))
       (case (char-class char attribute-table)
-	(#.constituent-digit (go EXPTDIGIT))
-	(#.delimiter (unread-char char stream) (return (make-float)))
-	(#.escape (go ESCAPE))
-	(#.multiple-escape (go MULT-ESCAPE))
-	(#.package-delimiter (go COLON))
+	(#.+char-attr-constituent-digit+ (go EXPTDIGIT))
+	(#.+char-attr-delimiter+
+	 (unread-char char stream)
+	 (return (make-float)))
+	(#.+char-attr-escape+ (go ESCAPE))
+	(#.+char-attr-multiple-escape+ (go MULT-ESCAPE))
+	(#.+char-attr-package-delimiter+ (go COLON))
 	(t (go SYMBOL)))
-     RATIO
-      ;;saw "[sign] {digit}+ slash"
+     RATIO ; saw "[sign] {digit}+ slash"
       (ouch-read-buffer char)
       (setq char (read-char stream nil nil))
       (unless char (go RETURN-SYMBOL))
       (case (char-class2 char attribute-table)
-	(#.constituent-digit (go RATIODIGIT))
-	(#.delimiter (unread-char char stream) (go RETURN-SYMBOL))
-	(#.escape (go ESCAPE))
-	(#.multiple-escape (go MULT-ESCAPE))
-	(#.package-delimiter (go COLON))
+	(#.+char-attr-constituent-digit+ (go RATIODIGIT))
+	(#.+char-attr-delimiter+ (unread-char char stream) (go RETURN-SYMBOL))
+	(#.+char-attr-escape+ (go ESCAPE))
+	(#.+char-attr-multiple-escape+ (go MULT-ESCAPE))
+	(#.+char-attr-package-delimiter+ (go COLON))
 	(t (go SYMBOL)))
-     RATIODIGIT
-      ;;saw "[sign] {digit}+ slash {digit}+"
+     RATIODIGIT ; saw "[sign] {digit}+ slash {digit}+"
       (ouch-read-buffer char)
       (setq char (read-char stream nil nil))
       (unless char (return (make-ratio)))
       (case (char-class2 char attribute-table)
-	(#.constituent-digit (go RATIODIGIT))
-	(#.delimiter (unread-char char stream) (return (make-ratio)))
-	(#.escape (go ESCAPE))
-	(#.multiple-escape (go MULT-ESCAPE))
-	(#.package-delimiter (go COLON))
+	(#.+char-attr-constituent-digit+ (go RATIODIGIT))
+	(#.+char-attr-delimiter+
+	 (unread-char char stream)
+	 (return (make-ratio)))
+	(#.+char-attr-escape+ (go ESCAPE))
+	(#.+char-attr-multiple-escape+ (go MULT-ESCAPE))
+	(#.+char-attr-package-delimiter+ (go COLON))
 	(t (go SYMBOL)))
-     DOTS
-      ;; saw "dot {dot}+"
+     DOTS ; saw "dot {dot}+"
       (ouch-read-buffer char)
       (setq char (read-char stream nil nil))
       (unless char (%reader-error stream "too many dots"))
       (case (char-class char attribute-table)
-	(#.constituent-dot (go DOTS))
-	(#.delimiter
+	(#.+char-attr-constituent-dot+ (go DOTS))
+	(#.+char-attr-delimiter+
 	 (unread-char char stream)
 	 (%reader-error stream "too many dots"))
-	(#.escape (go ESCAPE))
-	(#.multiple-escape (go MULT-ESCAPE))
-	(#.package-delimiter (go COLON))
+	(#.+char-attr-escape+ (go ESCAPE))
+	(#.+char-attr-multiple-escape+ (go MULT-ESCAPE))
+	(#.+char-attr-package-delimiter+ (go COLON))
 	(t (go SYMBOL)))
-     SYMBOL
-      ;; not a dot, dots, or number
+     SYMBOL ; not a dot, dots, or number
       (let ((stream (in-synonym-of stream)))
-	(if (lisp-stream-p stream)
+	(if (ansi-stream-p stream)
 	    (prepare-for-fast-read-char stream
 	      (prog ()
 	       SYMBOL-LOOP
@@ -888,15 +889,15 @@
 	       (setq char (fast-read-char nil nil))
 	       (unless char (go RETURN-SYMBOL))
 	       (case (char-class char attribute-table)
-		 (#.escape (done-with-fast-read-char)
-			   (go ESCAPE))
-		 (#.delimiter (done-with-fast-read-char)
-			      (unread-char char stream)
-			      (go RETURN-SYMBOL))
-		 (#.multiple-escape (done-with-fast-read-char)
-				    (go MULT-ESCAPE))
-		 (#.package-delimiter (done-with-fast-read-char)
-				      (go COLON))
+		 (#.+char-attr-escape+ (done-with-fast-read-char)
+				       (go ESCAPE))
+		 (#.+char-attr-delimiter+ (done-with-fast-read-char)
+					  (unread-char char stream)
+					  (go RETURN-SYMBOL))
+		 (#.+char-attr-multiple-escape+ (done-with-fast-read-char)
+						(go MULT-ESCAPE))
+		 (#.+char-attr-package-delimiter+ (done-with-fast-read-char)
+						  (go COLON))
 		 (t (go SYMBOL-LOOP)))))
 	    ;; fundamental-stream
 	    (prog ()
@@ -905,16 +906,15 @@
 	     (setq char (stream-read-char stream))
 	     (when (eq char :eof) (go RETURN-SYMBOL))
 	     (case (char-class char attribute-table)
-	       (#.escape (go ESCAPE))
-	       (#.delimiter (stream-unread-char stream char)
+	       (#.+char-attr-escape+ (go ESCAPE))
+	       (#.+char-attr-delimiter+ (stream-unread-char stream char)
 			    (go RETURN-SYMBOL))
-	       (#.multiple-escape (go MULT-ESCAPE))
-	       (#.package-delimiter (go COLON))
+	       (#.+char-attr-multiple-escape+ (go MULT-ESCAPE))
+	       (#.+char-attr-package-delimiter+ (go COLON))
 	       (t (go SYMBOL-LOOP))))))
-     ESCAPE
-      ;;saw an escape.
-      ;;don't put the escape in the read buffer.
-      ;;read-next char, put in buffer (no case conversion).
+     ESCAPE ; saw an escape
+      ;; Don't put the escape in the read buffer.
+      ;; READ-NEXT CHAR, put in buffer (no case conversion).
       (let ((nextchar (read-char stream nil nil)))
 	(unless nextchar
 	  (reader-eof-error stream "after escape character"))
@@ -923,10 +923,10 @@
       (setq char (read-char stream nil nil))
       (unless char (go RETURN-SYMBOL))
       (case (char-class char attribute-table)
-	(#.delimiter (unread-char char stream) (go RETURN-SYMBOL))
-	(#.escape (go ESCAPE))
-	(#.multiple-escape (go MULT-ESCAPE))
-	(#.package-delimiter (go COLON))
+	(#.+char-attr-delimiter+ (unread-char char stream) (go RETURN-SYMBOL))
+	(#.+char-attr-escape+ (go ESCAPE))
+	(#.+char-attr-multiple-escape+ (go MULT-ESCAPE))
+	(#.+char-attr-package-delimiter+ (go COLON))
 	(t (go SYMBOL)))
       MULT-ESCAPE
       (do ((char (read-char stream t) (read-char stream t)))
@@ -937,10 +937,10 @@
       (setq char (read-char stream nil nil))
       (unless char (go RETURN-SYMBOL))
       (case (char-class char attribute-table)
-	(#.delimiter (unread-char char stream) (go RETURN-SYMBOL))
-	(#.escape (go ESCAPE))
-	(#.multiple-escape (go MULT-ESCAPE))
-	(#.package-delimiter (go COLON))
+	(#.+char-attr-delimiter+ (unread-char char stream) (go RETURN-SYMBOL))
+	(#.+char-attr-escape+ (go ESCAPE))
+	(#.+char-attr-multiple-escape+ (go MULT-ESCAPE))
+	(#.+char-attr-package-delimiter+ (go COLON))
 	(t (go SYMBOL)))
       COLON
       (casify-read-buffer escapes)
@@ -962,14 +962,14 @@
       (setq char (read-char stream nil nil))
       (unless char (reader-eof-error stream "after reading a colon"))
       (case (char-class char attribute-table)
-	(#.delimiter
+	(#.+char-attr-delimiter+
 	 (unread-char char stream)
 	 (%reader-error stream
 			"illegal terminating character after a colon: ~S"
 			char))
-	(#.escape (go ESCAPE))
-	(#.multiple-escape (go MULT-ESCAPE))
-	(#.package-delimiter (go INTERN))
+	(#.+char-attr-escape+ (go ESCAPE))
+	(#.+char-attr-multiple-escape+ (go MULT-ESCAPE))
+	(#.+char-attr-package-delimiter+ (go INTERN))
 	(t (go SYMBOL)))
       INTERN
       (setq colons 2)
@@ -977,14 +977,14 @@
       (unless char
 	(reader-eof-error stream "after reading a colon"))
       (case (char-class char attribute-table)
-	(#.delimiter
+	(#.+char-attr-delimiter+
 	 (unread-char char stream)
 	 (%reader-error stream
 			"illegal terminating character after a colon: ~S"
 			char))
-	(#.escape (go ESCAPE))
-	(#.multiple-escape (go MULT-ESCAPE))
-	(#.package-delimiter
+	(#.+char-attr-escape+ (go ESCAPE))
+	(#.+char-attr-multiple-escape+ (go MULT-ESCAPE))
+	(#.+char-attr-package-delimiter+
 	 (%reader-error stream
 			"too many colons after ~S name"
 			package-designator))
@@ -1014,26 +1014,40 @@
 			     "Symbol ~S not found in the ~A package.")))
 		(return (intern name found)))))))))
 
+;;; for semi-external use:
+;;;
+;;; For semi-external use: Return 3 values: the string for the token,
+;;; a flag for whether there was an escape char, and the position of
+;;; any package delimiter.
 (defun read-extended-token (stream &optional (*readtable* *readtable*))
-  #!+sb-doc
-  "For semi-external use: returns 3 values: the string for the token,
-   a flag for whether there was an escape char, and the position of any
-   package delimiter."
-  (let ((firstch (read-char stream nil nil t)))
-    (cond (firstch
+  (let ((first-char (read-char stream nil nil t)))
+    (cond (first-char
 	   (multiple-value-bind (escapes colon)
-	       (internal-read-extended-token stream firstch)
+               (internal-read-extended-token stream first-char nil)
 	     (casify-read-buffer escapes)
 	     (values (read-buffer-to-string) (not (null escapes)) colon)))
 	  (t
 	   (values "" nil nil)))))
+
+;;; for semi-external use:
+;;;
+;;; Read an extended token with the first character escaped. Return
+;;; the string for the token.
+(defun read-extended-token-escaped (stream &optional (*readtable* *readtable*))
+  (let ((first-char (read-char stream nil nil)))
+    (cond (first-char
+            (let ((escapes (internal-read-extended-token stream first-char t)))
+              (casify-read-buffer escapes)
+              (read-buffer-to-string)))
+          (t
+            (reader-eof-error stream "after escape")))))
 
 ;;;; number-reading functions
 
 (defmacro digit* nil
   `(do ((ch char (inch-read-buffer)))
        ((or (eofp ch) (not (digit-char-p ch))) (setq char ch))
-     ;;report if at least one digit is seen:
+     ;; Report if at least one digit is seen.
      (setq one-digit t)))
 
 (defmacro exponent-letterp (letter)
@@ -1158,7 +1172,7 @@
 		((not dig)
 		 (setq exponent (if negative-exponent (- exponent) exponent)))
 	     (setq exponent (+ (* exponent 10) dig)))
-	   ;; Generate and return the float, depending on float-char:
+	   ;; Generate and return the float, depending on FLOAT-CHAR:
 	   (let* ((float-format (case (char-upcase float-char)
 				  (#\E *read-default-float-format*)
 				  (#\S 'short-float)
@@ -1172,6 +1186,12 @@
 	     ;; appropriately. This should avoid any unnecessary
 	     ;; underflow or overflow problems.
 	     (multiple-value-bind (min-expo max-expo)
+		 ;; FIXME: These #. forms are broken w.r.t.
+		 ;; cross-compilation portability. Maybe expressions
+		 ;; like
+		 ;;   (LOG SB!XC:MOST-POSITIVE-SHORT-FLOAT 10s0)
+		 ;; could be used instead? Or perhaps some sort of
+		 ;; load-time-form magic?
 		 (case float-format
 		   (short-float
 		    (values
@@ -1199,15 +1219,17 @@
 		 (setf number (/ number (expt 10 correction)))
 		 (setq num (make-float-aux number divisor float-format))
 		 (setq num (* num (expt 10 exponent)))
-		 (return-from make-float (if negative-fraction (- num) num))))))
-	  ;; should never happen:	
-	  (t (error "internal error in floating point reader")))))
+		 (return-from make-float (if negative-fraction
+					     (- num)
+					     num))))))
+	  ;; should never happen
+	  (t (bug "bad fallthrough in floating point reader")))))
 
 (defun make-float-aux (number divisor float-format)
   (coerce (/ number divisor) float-format))
 
 (defun make-ratio ()
-  ;; Assume *read-buffer* contains a legal ratio. Build the number from
+  ;; Assume *READ-BUFFER* contains a legal ratio. Build the number from
   ;; the string.
   ;;
   ;; Look for optional "+" or "-".
@@ -1248,30 +1270,30 @@
 					   (non-terminating-p nil)
 					   (rt *readtable*))
   #!+sb-doc
-  "Causes char to become a dispatching macro character in readtable
-   (which defaults to the current readtable). If the non-terminating-p
-   flag is set to T, the char will be non-terminating. Make-dispatch-
-   macro-character returns T."
+  "Cause CHAR to become a dispatching macro character in readtable (which
+   defaults to the current readtable). If NON-TERMINATING-P, the char will
+   be non-terminating."
   (set-macro-character char #'read-dispatch-char non-terminating-p rt)
   (let* ((dalist (dispatch-tables rt))
 	 (dtable (cdr (find char dalist :test #'char= :key #'car))))
     (cond (dtable
-	   (error "Dispatch character already exists."))
+	   (error "The dispatch character ~S already exists." char))
 	  (t
 	   (setf (dispatch-tables rt)
-		 (push (cons char (make-char-dispatch-table)) dalist))))))
+		 (push (cons char (make-char-dispatch-table)) dalist)))))
+  t)
 
-(defun set-dispatch-macro-character
-       (disp-char sub-char function &optional (rt *readtable*))
+(defun set-dispatch-macro-character (disp-char sub-char function
+                                               &optional (rt *readtable*))
   #!+sb-doc
-  "Causes function to be called whenever the reader reads
-   disp-char followed by sub-char. Set-dispatch-macro-character
-   returns T."
+  "Cause FUNCTION to be called whenever the reader reads DISP-CHAR
+   followed by SUB-CHAR."
   ;; Get the dispatch char for macro (error if not there), diddle
   ;; entry for sub-char.
   (when (digit-char-p sub-char)
     (error "SUB-CHAR must not be a decimal digit: ~S" sub-char))
   (let* ((sub-char (char-upcase sub-char))
+         (rt (or rt *standard-readtable*))
 	 (dpair (find disp-char (dispatch-tables rt)
 		      :test #'char= :key #'car)))
     (if dpair
@@ -1280,19 +1302,25 @@
 	      (coerce function 'function))
 	(error "~S is not a dispatch char." disp-char))))
 
-(defun get-dispatch-macro-character (disp-char sub-char &optional rt)
+(defun get-dispatch-macro-character (disp-char sub-char
+                                     &optional (rt *readtable*))
   #!+sb-doc
-  "Returns the macro character function for sub-char under disp-char
-   or nil if there is no associated function."
-  (unless (digit-char-p sub-char)
-    (let* ((sub-char (char-upcase sub-char))
-	   (rt (or rt *readtable*))
-	   (dpair (find disp-char (dispatch-tables rt)
-			:test #'char= :key #'car)))
-      (if dpair
-	  (elt (the simple-vector (cdr dpair))
-	       (char-code sub-char))
-	  (error "~S is not a dispatch char." disp-char)))))
+  "Return the macro character function for SUB-CHAR under DISP-CHAR
+   or NIL if there is no associated function."
+  (let* ((sub-char (char-upcase sub-char))
+         (rt (or rt *standard-readtable*))
+         (dpair (find disp-char (dispatch-tables rt)
+                      :test #'char= :key #'car)))
+    (if dpair
+        (let ((dispatch-fun (elt (the simple-vector (cdr dpair))
+                                 (char-code sub-char))))
+	  ;; Digits are also initialized in a dispatch table to
+	  ;; #'dispatch-char-error; READ-DISPATCH-CHAR handles them
+	  ;; separately. - CSR, 2002-04-12
+          (if (eq dispatch-fun #'dispatch-char-error)
+              nil
+              dispatch-fun))
+        (error "~S is not a dispatch char." disp-char))))
 
 (defun read-dispatch-char (stream char)
   ;; Read some digits.