X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Freader.lisp;h=f4352e68945f50cdd298bc5b72c6178d69166dc0;hb=584a5ce8c0dfa22afe480df3e860060f95e53bc3;hp=afb69097eccf74acd00905ec7259c63b2bad1ee6;hpb=b4831dc945c0754b3ba77881e67c8ea4d0a3d905;p=sbcl.git

diff --git a/src/code/reader.lisp b/src/code/reader.lisp
index afb6909..f4352e6 100644
--- a/src/code/reader.lisp
+++ b/src/code/reader.lisp
@@ -61,21 +61,28 @@
 (defmacro get-cat-entry (char rt)
   ;; KLUDGE: Only give this side-effect-free args.
   ;; FIXME: should probably become inline function
-  `(elt (character-attribute-table ,rt)
-	(char-code ,char)))
+  `(if (typep ,char 'base-char)
+       (elt (character-attribute-array ,rt) (char-code ,char))
+       (gethash ,char (character-attribute-hash-table ,rt) +char-attr-constituent+)))
 
 (defun set-cat-entry (char newvalue &optional (rt *readtable*))
-  (setf (elt (character-attribute-table rt)
-	     (char-code char))
-	newvalue))
+  (if (typep char 'base-char)
+      (setf (elt (character-attribute-array rt) (char-code char)) newvalue)
+      ;; FIXME: could REMHASH if we're setting to
+      ;; +CHAR-ATTR-CONSTITUENT+
+      (setf (gethash char (character-attribute-hash-table rt)) newvalue)))
 
 ;;; the value actually stored in the character macro table. As per
 ;;; ANSI #'GET-MACRO-CHARACTER and #'SET-MACRO-CHARACTER, this can
 ;;; be either a function or NIL.
 (eval-when (:compile-toplevel :execute)
   (sb!xc:defmacro get-raw-cmt-entry (char readtable)
-    `(svref (character-macro-table ,readtable)
-	    (char-code ,char))))
+    `(if (typep ,char 'base-char)
+         (svref (character-macro-array ,readtable) (char-code ,char))
+         ;; Note: DEFAULT here is NIL, not #'UNDEFINED-MACRO-CHAR, so
+         ;; that everything above the base-char range is a non-macro
+         ;; constituent by default.
+         (gethash ,char (character-macro-hash-table ,readtable) nil))))
 
 ;;; the value represented by whatever is stored in the character macro
 ;;; table. As per ANSI #'GET-MACRO-CHARACTER and #'SET-MACRO-CHARACTER,
@@ -87,10 +94,13 @@
 	#'read-token)))
 
 (defun set-cmt-entry (char new-value-designator &optional (rt *readtable*))
-  (setf (svref (character-macro-table rt)
-	       (char-code char))
+  (if (typep char 'base-char)
+      (setf (svref (character-macro-array rt) (char-code char))
+            (and new-value-designator
+                 (%coerce-callable-to-fun new-value-designator)))
+      (setf (gethash char (character-macro-hash-table rt))
 	(and new-value-designator
-	     (%coerce-callable-to-fun new-value-designator))))
+                 (%coerce-callable-to-fun new-value-designator)))))
 
 (defun undefined-macro-char (stream char)
   (unless *read-suppress*
@@ -137,7 +147,7 @@
 
 (defun !cold-init-secondary-attribute-table ()
   (setq *secondary-attribute-table*
-	(make-array char-code-limit :element-type '(unsigned-byte 8)
+	(make-array base-char-code-limit :element-type '(unsigned-byte 8)
 		    :initial-element +char-attr-constituent+))
   (!set-secondary-attribute #\: +char-attr-package-delimiter+)
   (!set-secondary-attribute #\| +char-attr-multiple-escape+) ; |) [for EMACS]
@@ -165,17 +175,29 @@
 
 ;;;; readtable operations
 
+(defun shallow-replace/eql-hash-table (to from)
+  (maphash (lambda (k v) (setf (gethash k to) v)) from))
+
 (defun copy-readtable (&optional (from-readtable *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 really-to-readtable)
-	     (character-macro-table really-from-readtable))
+    (replace (character-attribute-array really-to-readtable)
+	     (character-attribute-array really-from-readtable))
+    (shallow-replace/eql-hash-table
+     (character-attribute-hash-table really-to-readtable)
+     (character-attribute-hash-table really-from-readtable))
+    (replace (character-macro-array really-to-readtable)
+	     (character-macro-array really-from-readtable))
+    (shallow-replace/eql-hash-table
+     (character-macro-hash-table really-to-readtable)
+     (character-macro-hash-table really-from-readtable))
     (setf (dispatch-tables really-to-readtable)
-	  (mapcar (lambda (pair) (cons (car pair)
-				       (copy-seq (cdr pair))))
+	  (mapcar (lambda (pair)
+                    (cons (car pair)
+                          (let ((table (make-hash-table)))
+                            (shallow-replace/eql-hash-table table (cdr pair))
+                            table)))
 		  (dispatch-tables really-from-readtable)))
     (setf (readtable-case really-to-readtable)
 	  (readtable-case really-from-readtable))
@@ -250,17 +272,27 @@
   (let ((stream (in-synonym-of stream)))
     (if (ansi-stream-p stream)
 	(prepare-for-fast-read-char stream
-	  (do ((attribute-table (character-attribute-table *readtable*))
+	  (do ((attribute-array (character-attribute-array *readtable*))
+               (attribute-hash-table
+                (character-attribute-hash-table *readtable*))
 	       (char (fast-read-char t) (fast-read-char t)))
-	      ((/= (the fixnum (aref attribute-table (char-code char)))
+	      ((/= (the fixnum
+                     (if (typep char 'base-char)
+                         (aref attribute-array (char-code char))
+                         (gethash char attribute-hash-table +char-attr-constituent+)))
 		   +char-attr-whitespace+)
 	       (done-with-fast-read-char)
 	       char)))
-	;; fundamental-stream
-	(do ((attribute-table (character-attribute-table *readtable*))
-	     (char (stream-read-char stream) (stream-read-char stream)))
+	;; CLOS stream
+	(do ((attribute-array (character-attribute-array *readtable*))
+             (attribute-hash-table
+              (character-attribute-hash-table *readtable*))
+	     (char (read-char stream nil :eof) (read-char stream nil :eof)))
 	    ((or (eq char :eof)
-		 (/= (the fixnum (aref attribute-table (char-code char)))
+		 (/= (the fixnum
+                       (if (typep char 'base-char)
+                           (aref attribute-array (char-code char))
+                           (gethash char attribute-hash-table +char-attr-constituent+)))
 		     +char-attr-whitespace+))
 	     (if (eq char :eof)
 		 (error 'end-of-file :stream stream)
@@ -276,6 +308,7 @@
   (let ((*readtable* *standard-readtable*))
 
     (flet ((whitespaceify (char)
+	     (set-cmt-entry char nil)
 	     (set-cat-entry char +char-attr-whitespace+)))
       (whitespaceify (code-char tab-char-code))
       (whitespaceify #\linefeed)
@@ -284,7 +317,7 @@
       (whitespaceify (code-char return-char-code)))
 
     (set-cat-entry #\\ +char-attr-escape+)
-    (set-cmt-entry #\\ #'read-token)
+    (set-cmt-entry #\\ nil)
 
     ;; Easy macro-character definitions are in this source file.
     (set-macro-character #\" #'read-string)
@@ -298,11 +331,11 @@
     ;; all constituents
     (do ((ichar 0 (1+ ichar))
 	 (char))
-	((= ichar #O200))
+	((= ichar base-char-code-limit))
       (setq char (code-char ichar))
       (when (constituentp char *standard-readtable*)
-	    (set-cat-entry char (get-secondary-attribute char))
-	    (set-cmt-entry char nil)))))
+	(set-cat-entry char (get-secondary-attribute char))
+	(set-cmt-entry char nil)))))
 
 ;;;; implementation of the read buffer
 
@@ -406,18 +439,19 @@
   "Read from STREAM and return the value read, preserving any whitespace
    that followed the object."
   (if recursivep
-    ;; a loop for repeating when a macro returns nothing
-    (loop
-      (let ((char (read-char stream eof-error-p *eof-object*)))
-	(cond ((eofp char) (return eof-value))
-	      ((whitespacep char))
-	      (t
-	       (let* ((macrofun (get-coerced-cmt-entry char *readtable*))
-		      (result (multiple-value-list
-			       (funcall macrofun stream char))))
-		 ;; Repeat if macro returned nothing.
-		  (if result (return (car result))))))))
-    (let ((*sharp-equal-alist* nil))
+      ;; a loop for repeating when a macro returns nothing
+      (loop
+       (let ((char (read-char stream eof-error-p *eof-object*)))
+         (cond ((eofp char) (return eof-value))
+               ((whitespacep char))
+               (t
+                (let* ((macrofun (get-coerced-cmt-entry char *readtable*))
+                       (result (multiple-value-list
+                                (funcall macrofun stream char))))
+                  ;; Repeat if macro returned nothing.
+		  (when result 
+                    (return (unless *read-suppress* (car result)))))))))
+      (let ((*sharp-equal-alist* nil))
 	(read-preserving-whitespace stream eof-error-p eof-value t))))
 
 ;;; Return NIL or a list with one thing, depending.
@@ -441,9 +475,9 @@
 					    eof-error-p
 					    eof-value
 					    recursivep)))
-    ;; (This function generally discards trailing whitespace. If you
+    ;; This function generally discards trailing whitespace. If you
     ;; don't want to discard trailing whitespace, call
-    ;; CL:READ-PRESERVING-WHITESPACE instead.)
+    ;; 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)
@@ -462,7 +496,7 @@
   (do ((char (flush-whitespace input-stream)
 	     (flush-whitespace input-stream))
        (retlist ()))
-      ((char= char endchar) (nreverse retlist))
+      ((char= char endchar) (unless *read-suppress* (nreverse retlist)))
     (setq retlist (nconc (read-maybe-nothing input-stream char) retlist))))
 
 ;;;; basic readmacro definitions
@@ -483,8 +517,8 @@
 		     (fast-read-char nil nil)))
 	      ((or (not char) (char= char #\newline))
 	       (done-with-fast-read-char))))
-	;; FUNDAMENTAL-STREAM
-	(do ((char (stream-read-char stream) (stream-read-char stream)))
+	;; CLOS stream
+	(do ((char (read-char stream nil :eof) (read-char stream nil :eof)))
 	    ((or (eq char :eof) (char= char #\newline))))))
   ;; Don't return anything.
   (values))
@@ -547,13 +581,13 @@
 	       (done-with-fast-read-char))
 	    (if (escapep char) (setq char (fast-read-char t)))
 	    (ouch-read-buffer char)))
-	;; FUNDAMENTAL-STREAM
-	(do ((char (stream-read-char stream) (stream-read-char stream)))
+	;; CLOS stream
+	(do ((char (read-char stream nil :eof) (read-char stream nil :eof)))
 	    ((or (eq char :eof) (char= char closech))
 	     (if (eq char :eof)
 		 (error 'end-of-file :stream stream)))
 	  (when (escapep char)
-	    (setq char (stream-read-char stream))
+	    (setq char (read-char stream nil :eof))
 	    (if (eq char :eof)
 		(error 'end-of-file :stream stream)))
 	  (ouch-read-buffer char))))
@@ -620,8 +654,13 @@
 ;;;; character classes
 
 ;;; Return the character class for CHAR.
-(defmacro char-class (char attable)
-  `(let ((att (aref ,attable (char-code ,char))))
+;;;
+;;; FIXME: why aren't these ATT-getting forms using GET-CAT-ENTRY?
+;;; Because we've cached the readtable tables?
+(defmacro char-class (char attarray atthash)
+  `(let ((att (if (typep ,char 'base-char)
+                  (aref ,attarray (char-code ,char))
+                  (gethash ,char ,atthash +char-attr-constituent+))))
      (declare (fixnum att))
      (if (<= att +char-attr-terminating-macro+)
 	 +char-attr-delimiter+
@@ -629,8 +668,10 @@
 
 ;;; 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))))
+(defmacro char-class2 (char attarray atthash)
+  `(let ((att (if (typep ,char 'base-char)
+                  (aref ,attarray (char-code ,char))
+                  (gethash ,char ,atthash +char-attr-constituent+))))
      (declare (fixnum att))
      (if (<= att +char-attr-terminating-macro+)
 	 +char-attr-delimiter+
@@ -643,8 +684,10 @@
 ;;; 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))))
+(defmacro char-class3 (char attarray atthash)
+  `(let ((att (if (typep ,char 'base-char)
+                  (aref ,attarray (char-code ,char))
+                  (gethash ,char ,atthash +char-attr-constituent+))))
      (declare (fixnum att))
      (if possibly-rational
 	 (setq possibly-rational
@@ -658,8 +701,10 @@
 	 +char-attr-delimiter+
 	 (if (digit-char-p ,char (max *read-base* 10))
 	     (if (digit-char-p ,char *read-base*)
-		 +char-attr-constituent-digit+
-		 +char-attr-constituent+)
+		 (if (= att +char-attr-constituent-expt+)
+		     +char-attr-constituent-digit-or-expt+
+		     +char-attr-constituent-digit+)
+		 +char-attr-constituent-decimal-digit+)
 	     att))))
 
 ;;;; token fetching
@@ -731,18 +776,25 @@
   (when *read-suppress*
     (internal-read-extended-token stream firstchar nil)
     (return-from read-token nil))
-  (let ((attribute-table (character-attribute-table *readtable*))
+  (let ((attribute-array (character-attribute-array *readtable*))
+        (attribute-hash-table (character-attribute-hash-table *readtable*))
 	(package-designator nil)
 	(colons 0)
 	(possibly-rational t)
+	(seen-digit-or-expt nil)
 	(possibly-float t)
+	(was-possibly-float nil)
 	(escapes ())
 	(seen-multiple-escapes nil))
     (reset-read-buffer)
     (prog ((char firstchar))
-      (case (char-class3 char attribute-table)
+      (case (char-class3 char attribute-array attribute-hash-table)
 	(#.+char-attr-constituent-sign+ (go SIGN))
 	(#.+char-attr-constituent-digit+ (go LEFTDIGIT))
+	(#.+char-attr-constituent-digit-or-expt+
+	 (setq seen-digit-or-expt t)
+	 (go LEFTDIGIT))
+	(#.+char-attr-constituent-decimal-digit+ (go LEFTDECIMALDIGIT))
 	(#.+char-attr-constituent-dot+ (go FRONTDOT))
 	(#.+char-attr-escape+ (go ESCAPE))
 	(#.+char-attr-package-delimiter+ (go COLON))
@@ -755,8 +807,12 @@
       (unless char (go RETURN-SYMBOL))
       (setq possibly-rational t
 	    possibly-float t)
-      (case (char-class3 char attribute-table)
+      (case (char-class3 char attribute-array attribute-hash-table)
 	(#.+char-attr-constituent-digit+ (go LEFTDIGIT))
+	(#.+char-attr-constituent-digit-or-expt+
+	 (setq seen-digit-or-expt t)
+	 (go LEFTDIGIT))
+	(#.+char-attr-constituent-decimal-digit+ (go LEFTDECIMALDIGIT))
 	(#.+char-attr-constituent-dot+ (go SIGNDOT))
 	(#.+char-attr-escape+ (go ESCAPE))
 	(#.+char-attr-package-delimiter+ (go COLON))
@@ -767,12 +823,43 @@
       (ouch-read-buffer char)
       (setq char (read-char stream nil nil))
       (unless char (return (make-integer)))
-      (case (char-class3 char attribute-table)
+      (setq was-possibly-float possibly-float)
+      (case (char-class3 char attribute-array attribute-hash-table)
 	(#.+char-attr-constituent-digit+ (go LEFTDIGIT))
+	(#.+char-attr-constituent-decimal-digit+ (if possibly-float
+						     (go LEFTDECIMALDIGIT)
+						     (go SYMBOL)))
 	(#.+char-attr-constituent-dot+ (if possibly-float
 					   (go MIDDLEDOT)
 					   (go SYMBOL)))
-	(#.+char-attr-constituent-expt+ (go EXPONENT))
+	(#.+char-attr-constituent-digit-or-expt+
+	 (if (or seen-digit-or-expt (not was-possibly-float))
+	     (progn (setq seen-digit-or-expt t) (go LEFTDIGIT))
+	     (progn (setq seen-digit-or-expt t) (go LEFTDIGIT-OR-EXPT))))
+	(#.+char-attr-constituent-expt+
+	 (if was-possibly-float
+	     (go EXPONENT)
+	     (go SYMBOL)))
+	(#.+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)))
+     LEFTDIGIT-OR-EXPT
+      (ouch-read-buffer char)
+      (setq char (read-char stream nil nil))
+      (unless char (return (make-integer)))
+      (case (char-class3 char attribute-array attribute-hash-table)
+	(#.+char-attr-constituent-digit+ (go LEFTDIGIT))
+	(#.+char-attr-constituent-decimal-digit+ (bug "impossible!"))
+	(#.+char-attr-constituent-dot+ (go SYMBOL))
+	(#.+char-attr-constituent-digit-or-expt+ (go LEFTDIGIT))
+	(#.+char-attr-constituent-expt+ (go SYMBOL))
+	(#.+char-attr-constituent-sign+ (go EXPTSIGN))
 	(#.+char-attr-constituent-slash+ (if possibly-rational
 					     (go RATIO)
 					     (go SYMBOL)))
@@ -782,12 +869,29 @@
 	(#.+char-attr-multiple-escape+ (go MULT-ESCAPE))
 	(#.+char-attr-package-delimiter+ (go COLON))
 	(t (go SYMBOL)))
+     LEFTDECIMALDIGIT ; saw "[sign] {decimal-digit}+"
+      (aver possibly-float)
+      (ouch-read-buffer char)
+      (setq char (read-char stream nil nil))
+      (unless char (go RETURN-SYMBOL))
+      (case (char-class char attribute-array attribute-hash-table)
+	(#.+char-attr-constituent-digit+ (go LEFTDECIMALDIGIT))
+	(#.+char-attr-constituent-dot+ (go MIDDLEDOT))
+	(#.+char-attr-constituent-expt+ (go EXPONENT))
+	(#.+char-attr-constituent-slash+ (aver (not possibly-rational))
+					 (go SYMBOL))
+	(#.+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)))
      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)
+      (case (char-class char attribute-array attribute-hash-table)
 	(#.+char-attr-constituent-digit+ (go RIGHTDIGIT))
 	(#.+char-attr-constituent-expt+ (go EXPONENT))
 	(#.+char-attr-delimiter+
@@ -798,11 +902,11 @@
 	(#.+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] {decimal-digit}* dot {digit}+"
       (ouch-read-buffer char)
       (setq char (read-char stream nil nil))
       (unless char (return (make-float stream)))
-      (case (char-class char attribute-table)
+      (case (char-class char attribute-array attribute-hash-table)
 	(#.+char-attr-constituent-digit+ (go RIGHTDIGIT))
 	(#.+char-attr-constituent-expt+ (go EXPONENT))
 	(#.+char-attr-delimiter+
@@ -816,7 +920,7 @@
       (ouch-read-buffer char)
       (setq char (read-char stream nil nil))
       (unless char (go RETURN-SYMBOL))
-      (case (char-class char attribute-table)
+      (case (char-class char attribute-array attribute-hash-table)
 	(#.+char-attr-constituent-digit+ (go RIGHTDIGIT))
 	(#.+char-attr-delimiter+ (unread-char char stream) (go RETURN-SYMBOL))
 	(#.+char-attr-escape+ (go ESCAPE))
@@ -826,7 +930,7 @@
       (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)
+      (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"))
@@ -838,7 +942,8 @@
       (ouch-read-buffer char)
       (setq char (read-char stream nil nil))
       (unless char (go RETURN-SYMBOL))
-      (case (char-class char attribute-table)
+      (setq possibly-float t)
+      (case (char-class char attribute-array attribute-hash-table)
 	(#.+char-attr-constituent-sign+ (go EXPTSIGN))
 	(#.+char-attr-constituent-digit+ (go EXPTDIGIT))
 	(#.+char-attr-delimiter+ (unread-char char stream) (go RETURN-SYMBOL))
@@ -850,7 +955,7 @@
       (ouch-read-buffer char)
       (setq char (read-char stream nil nil))
       (unless char (go RETURN-SYMBOL))
-      (case (char-class char attribute-table)
+      (case (char-class char attribute-array attribute-hash-table)
 	(#.+char-attr-constituent-digit+ (go EXPTDIGIT))
 	(#.+char-attr-delimiter+ (unread-char char stream) (go RETURN-SYMBOL))
 	(#.+char-attr-escape+ (go ESCAPE))
@@ -861,7 +966,7 @@
       (ouch-read-buffer char)
       (setq char (read-char stream nil nil))
       (unless char (return (make-float stream)))
-      (case (char-class char attribute-table)
+      (case (char-class char attribute-array attribute-hash-table)
 	(#.+char-attr-constituent-digit+ (go EXPTDIGIT))
 	(#.+char-attr-delimiter+
 	 (unread-char char stream)
@@ -874,7 +979,7 @@
       (ouch-read-buffer char)
       (setq char (read-char stream nil nil))
       (unless char (go RETURN-SYMBOL))
-      (case (char-class2 char attribute-table)
+      (case (char-class2 char attribute-array attribute-hash-table)
 	(#.+char-attr-constituent-digit+ (go RATIODIGIT))
 	(#.+char-attr-delimiter+ (unread-char char stream) (go RETURN-SYMBOL))
 	(#.+char-attr-escape+ (go ESCAPE))
@@ -885,7 +990,7 @@
       (ouch-read-buffer char)
       (setq char (read-char stream nil nil))
       (unless char (return (make-ratio stream)))
-      (case (char-class2 char attribute-table)
+      (case (char-class2 char attribute-array attribute-hash-table)
 	(#.+char-attr-constituent-digit+ (go RATIODIGIT))
 	(#.+char-attr-delimiter+
 	 (unread-char char stream)
@@ -898,7 +1003,7 @@
       (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)
+      (case (char-class char attribute-array attribute-hash-table)
 	(#.+char-attr-constituent-dot+ (go DOTS))
 	(#.+char-attr-delimiter+
 	 (unread-char char stream)
@@ -916,7 +1021,7 @@
 	       (ouch-read-buffer char)
 	       (setq char (fast-read-char nil nil))
 	       (unless char (go RETURN-SYMBOL))
-	       (case (char-class char attribute-table)
+	       (case (char-class char attribute-array attribute-hash-table)
 		 (#.+char-attr-escape+ (done-with-fast-read-char)
 				       (go ESCAPE))
 		 (#.+char-attr-delimiter+ (done-with-fast-read-char)
@@ -927,15 +1032,15 @@
 		 (#.+char-attr-package-delimiter+ (done-with-fast-read-char)
 						  (go COLON))
 		 (t (go SYMBOL-LOOP)))))
-	    ;; fundamental-stream
+	    ;; CLOS stream
 	    (prog ()
 	     SYMBOL-LOOP
 	     (ouch-read-buffer char)
-	     (setq char (stream-read-char stream))
+	     (setq char (read-char stream nil :eof))
 	     (when (eq char :eof) (go RETURN-SYMBOL))
-	     (case (char-class char attribute-table)
+	     (case (char-class char attribute-array attribute-hash-table)
 	       (#.+char-attr-escape+ (go ESCAPE))
-	       (#.+char-attr-delimiter+ (stream-unread-char stream char)
+	       (#.+char-attr-delimiter+ (unread-char char stream)
 			    (go RETURN-SYMBOL))
 	       (#.+char-attr-multiple-escape+ (go MULT-ESCAPE))
 	       (#.+char-attr-package-delimiter+ (go COLON))
@@ -950,7 +1055,7 @@
 	(ouch-read-buffer nextchar))
       (setq char (read-char stream nil nil))
       (unless char (go RETURN-SYMBOL))
-      (case (char-class char attribute-table)
+      (case (char-class char attribute-array attribute-hash-table)
 	(#.+char-attr-delimiter+ (unread-char char stream) (go RETURN-SYMBOL))
 	(#.+char-attr-escape+ (go ESCAPE))
 	(#.+char-attr-multiple-escape+ (go MULT-ESCAPE))
@@ -965,7 +1070,7 @@
 	(ouch-read-buffer char))
       (setq char (read-char stream nil nil))
       (unless char (go RETURN-SYMBOL))
-      (case (char-class char attribute-table)
+      (case (char-class char attribute-array attribute-hash-table)
 	(#.+char-attr-delimiter+ (unread-char char stream) (go RETURN-SYMBOL))
 	(#.+char-attr-escape+ (go ESCAPE))
 	(#.+char-attr-multiple-escape+ (go MULT-ESCAPE))
@@ -992,7 +1097,7 @@
       (setq escapes ())
       (setq char (read-char stream nil nil))
       (unless char (reader-eof-error stream "after reading a colon"))
-      (case (char-class char attribute-table)
+      (case (char-class char attribute-array attribute-hash-table)
 	(#.+char-attr-delimiter+
 	 (unread-char char stream)
 	 (%reader-error stream
@@ -1007,7 +1112,7 @@
       (setq char (read-char stream nil nil))
       (unless char
 	(reader-eof-error stream "after reading a colon"))
-      (case (char-class char attribute-table)
+      (case (char-class char attribute-array attribute-hash-table)
 	(#.+char-attr-delimiter+
 	 (unread-char char stream)
 	 (%reader-error stream
@@ -1211,46 +1316,10 @@
 				  (#\F 'single-float)
 				  (#\D 'double-float)
 				  (#\L 'long-float)))
-		  num)
-	     ;; Raymond Toy writes: We need to watch out if the
-	     ;; exponent is too small or too large. We add enough to
-	     ;; EXPONENT to make it within range and scale NUMBER
-	     ;; 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, as the
-		 ;; cross-compiler will call the host's LOG function
-		 ;; while attempting to constant-fold. Maybe some sort
-		 ;; of load-time-form magic could be used instead?
-		 (case float-format
-		   ((short-float single-float)
-		    (values
-		     (log sb!xc:least-positive-normalized-single-float 10f0)
-		     (log sb!xc:most-positive-single-float 10f0)))
-		   ((double-float #!-long-float long-float)
-		    (values
-		     (log sb!xc:least-positive-normalized-double-float 10d0)
-		     (log sb!xc:most-positive-double-float 10d0)))
-		   #!+long-float
-		   (long-float
-		    (values
-		     (log sb!xc:least-positive-normalized-long-float 10l0)
-		     (log sb!xc:most-positive-long-float 10l0))))
-	       (let ((correction (cond ((<= exponent min-expo)
-					(ceiling (- min-expo exponent)))
-				       ((>= exponent max-expo)
-					(floor (- max-expo exponent)))
-				       (t
-					0))))
-		 (incf exponent correction)
-		 (setf number (/ number (expt 10 correction)))
-		 (setq num (make-float-aux number divisor float-format stream))
-		 (setq num (* num (expt 10 exponent)))
-		 (return-from make-float (if negative-fraction
-					     (- num)
-					     num))))))
-	  ;; should never happen
+		  (result (make-float-aux (* (expt 10 exponent) number)
+					  divisor float-format stream)))
+	     (return-from make-float
+	       (if negative-fraction (- result) result))))
 	  (t (bug "bad fallthrough in floating point reader")))))
 
 (defun make-float-aux (number divisor float-format stream)
@@ -1296,7 +1365,7 @@
 ;;;; cruft for dispatch macros
 
 (defun make-char-dispatch-table ()
-  (make-array char-code-limit :initial-element #'dispatch-char-error))
+  (make-hash-table))
 
 (defun dispatch-char-error (stream sub-char ignore)
   (declare (ignore ignore))
@@ -1335,9 +1404,7 @@
 	 (dpair (find disp-char (dispatch-tables rt)
 		      :test #'char= :key #'car)))
     (if dpair
-	(setf (elt (the simple-vector (cdr dpair))
-		   (char-code sub-char))
-	      (coerce function 'function))
+	(setf (gethash sub-char (cdr dpair)) (coerce function 'function))
 	(error "~S is not a dispatch char." disp-char))))
 
 (defun get-dispatch-macro-character (disp-char sub-char
@@ -1350,14 +1417,7 @@
          (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))
+        (values (gethash sub-char (cdr dpair)))
         (error "~S is not a dispatch char." disp-char))))
 
 (defun read-dispatch-char (stream char)
@@ -1381,8 +1441,7 @@
 		       :test #'char= :key #'car)))
       (if dpair
 	  (funcall (the function
-			(elt (the simple-vector (cdr dpair))
-			     (char-code sub-char)))
+                     (gethash sub-char (cdr dpair) #'dispatch-char-error))
 		   stream sub-char (if numargp numarg nil))
 	  (%reader-error stream "no dispatch table for dispatch char")))))
 
@@ -1393,7 +1452,7 @@
   #!+sb-doc
   "A resource of string streams for Read-From-String.")
 
-(defun read-from-string (string &optional eof-error-p eof-value
+(defun read-from-string (string &optional (eof-error-p t) eof-value
 				&key (start 0) end
 				preserve-whitespace)
   #!+sb-doc
@@ -1406,10 +1465,10 @@
 		    (start start)
 		    (end (%check-vector-sequence-bounds string start end)))
     (unless *read-from-string-spares*
-      (push (internal-make-string-input-stream "" 0 0)
-	    *read-from-string-spares*))
+      (push (make-string-input-stream "" 0 0) *read-from-string-spares*))
     (let ((stream (pop *read-from-string-spares*)))
-      (setf (string-input-stream-string stream) string)
+      (setf (string-input-stream-string stream)
+	    (coerce string '(simple-array character (*))))
       (setf (string-input-stream-current stream) start)
       (setf (string-input-stream-end stream) end)
       (unwind-protect
@@ -1431,7 +1490,7 @@
 	       `(error 'simple-parse-error
 		       :format-control ,format-control
 		       :format-arguments (list string))))
-    (with-array-data ((string string)
+    (with-array-data ((string string :offset-var offset)
 		      (start start)
 		      (end (%check-vector-sequence-bounds string start end)))
       (let ((index (do ((i start (1+ i)))
@@ -1460,10 +1519,10 @@
 			found-digit t))
 		 (junk-allowed (return nil))
 		 ((whitespacep char)
-		  (do ((jndex (1+ index) (1+ jndex)))
-		      ((= jndex end))
-		    (declare (fixnum jndex))
-		    (unless (whitespacep (char string jndex))
+                  (loop
+                   (incf index)
+                   (when (= index end) (return))
+                   (unless (whitespacep (char string index))
 		      (parse-error "junk in string ~S")))
 		  (return nil))
 		 (t
@@ -1475,7 +1534,7 @@
 	     (if junk-allowed
 		 nil
 		 (parse-error "no digits in string ~S")))
-	 index)))))
+	 (- index offset))))))
 
 ;;;; reader initialization code