0.8.16.18:

	Introduce BASE-CHAR-CODE-LIMIT.  Also make various printer/reader
	structures scalable.

	This patch brought to you by character_branch

diff --git a/package-data-list.lisp-expr b/package-data-list.lisp-expr
index 8617574..303bdb7 100644 (file)
--- a/package-data-list.lisp-expr
+++ b/package-data-list.lisp-expr
@@ -63,6 +63,7 @@ of SBCL which maintained the CMU-CL-style split into two packages.)"
             "SAP-ALIEN" "SHORT" "SIGNED" "SLOT" "STRUCT"
             "UNSIGNED"
             "UNSIGNED-CHAR" "UNSIGNED-INT" "UNSIGNED-LONG" "UNSIGNED-SHORT"
+             "UTF8-STRING"
             "VOID"
             "WITH-ALIEN"))
 
@@ -910,7 +911,7 @@ retained, possibly temporariliy, because it might be used internally."
 
               ;; various internal defaults
               "DEFAULT-INIT-CHAR" "*DEFAULT-INIT-CHAR-FORM*"
-              "*LOAD-SOURCE-DEFAULT-TYPE*"
+              "*LOAD-SOURCE-DEFAULT-TYPE*" "BASE-CHAR-CODE-LIMIT"
 
               ;; hash caches
               "DEFINE-HASH-CACHE"

diff --git a/src/code/char.lisp b/src/code/char.lisp
index 07ea350..0a89c81 100644 (file)
--- a/src/code/char.lisp
+++ b/src/code/char.lisp
@@ -15,3 +15,5 @@
 (def!constant sb!xc:char-code-limit 256
   #!+sb-doc
   "the upper exclusive bound on values produced by CHAR-CODE")
+
+(def!constant base-char-code-limit 256)

diff --git a/src/code/print.lisp b/src/code/print.lisp
index 3bff3cd..057df86 100644 (file)
--- a/src/code/print.lisp
+++ b/src/code/print.lisp
@@ -615,10 +615,10 @@
 ;;; character has. At characters have at least one bit set, so we can
 ;;; search for any character with a positive test.
 (defvar *character-attributes*
-  (make-array char-code-limit
+  (make-array 160 ; FIXME
              :element-type '(unsigned-byte 16)
              :initial-element 0))
-(declaim (type (simple-array (unsigned-byte 16) (#.char-code-limit))
+(declaim (type (simple-array (unsigned-byte 16) (#.160)) ; FIXME
               *character-attributes*))
 
 ;;; constants which are a bit-mask for each interesting character attribute
@@ -672,17 +672,17 @@
   (set-bit #\/ slash-attribute)
 
   ;; Mark anything not explicitly allowed as funny.
-  (dotimes (i char-code-limit)
+  (dotimes (i 160) ; FIXME
     (when (zerop (aref *character-attributes* i))
       (setf (aref *character-attributes* i) funny-attribute))))
 
 ;;; For each character, the value of the corresponding element is the
 ;;; lowest base in which that character is a digit.
 (defvar *digit-bases*
-  (make-array char-code-limit
+  (make-array 128 ; FIXME
              :element-type '(unsigned-byte 8)
              :initial-element 36))
-(declaim (type (simple-array (unsigned-byte 8) (#.char-code-limit))
+(declaim (type (simple-array (unsigned-byte 8) (#.128)) ; FIXME
               *digit-bases*))
 (dotimes (i 36)
   (let ((char (digit-char i 36)))
@@ -698,7 +698,11 @@
                   ,(if at-end '(go TEST-SIGN) '(return nil)))
                 (setq current (schar name index)
                       code (char-code current)
-                      bits (aref attributes code))
+                      bits (cond ; FIXME
+                              ((< code 160) (aref attributes code))
+                              ((upper-case-p current) uppercase-attribute)
+                              ((lower-case-p current) lowercase-attribute)
+                              (t other-attribute)))
                 (incf index)
                 (go ,tag)))
             (test (&rest attributes)
@@ -713,7 +717,8 @@
                                        attributes))
                             bits)))))
             (digitp ()
-              `(< (the fixnum (aref bases code)) base)))
+               `(and (< code 128) ; FIXME
+                     (< (the fixnum (aref bases code)) base))))
 
     (prog ((len (length name))
           (attributes *character-attributes*)
@@ -740,7 +745,13 @@
                          letter-attribute)))
        (do ((i (1- index) (1+ i)))
            ((= i len) (return-from symbol-quotep nil))
-         (unless (zerop (logand (aref attributes (char-code (schar name i)))
+         (unless (zerop (logand (let* ((char (schar name i))
+                                       (code (char-code char)))
+                                  (cond 
+                                    ((< code 160) (aref attributes code))
+                                    ((upper-case-p char) uppercase-attribute)
+                                    ((lower-case-p char) lowercase-attribute)
+                                    (t other-attribute)))
                                 mask))
            (return-from symbol-quotep t))))
 

diff --git a/src/code/reader.lisp b/src/code/reader.lisp
index 7929c03..a8081ae 100644 (file)
--- 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 @@
 \f
 ;;;; 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)))
        ;; CLOS stream
-       (do ((attribute-table (character-attribute-table *readtable*))
+       (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)
@@ -299,7 +331,7 @@
     ;; 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))
@@ -622,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+
@@ -631,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+
@@ -645,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
@@ -735,7 +776,8 @@
   (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)
@@ -746,7 +788,7 @@
        (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+
@@ -765,7 +807,7 @@
       (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)
@@ -782,7 +824,7 @@
       (setq char (read-char stream nil nil))
       (unless char (return (make-integer)))
       (setq was-possibly-float possibly-float)
-      (case (char-class3 char attribute-table)
+      (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)
@@ -811,7 +853,7 @@
       (ouch-read-buffer char)
       (setq char (read-char stream nil nil))
       (unless char (return (make-integer)))
-      (case (char-class3 char attribute-table)
+      (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))
@@ -832,7 +874,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 LEFTDECIMALDIGIT))
        (#.+char-attr-constituent-dot+ (go MIDDLEDOT))
        (#.+char-attr-constituent-expt+ (go EXPONENT))
@@ -849,7 +891,7 @@
       (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+
@@ -864,7 +906,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 RIGHTDIGIT))
        (#.+char-attr-constituent-expt+ (go EXPONENT))
        (#.+char-attr-delimiter+
@@ -878,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))
@@ -888,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"))
@@ -901,7 +943,7 @@
       (setq char (read-char stream nil nil))
       (unless char (go RETURN-SYMBOL))
       (setq possibly-float t)
-      (case (char-class char attribute-table)
+      (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))
@@ -913,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))
@@ -924,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)
@@ -937,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))
@@ -948,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)
@@ -961,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)
@@ -979,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)
@@ -996,7 +1038,7 @@
             (ouch-read-buffer char)
             (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+ (unread-char char stream)
                            (go RETURN-SYMBOL))
@@ -1013,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))
@@ -1028,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))
@@ -1055,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
@@ -1070,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
@@ -1323,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))
@@ -1362,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
@@ -1377,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)
@@ -1408,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")))))
 \f

diff --git a/src/code/readtable.lisp b/src/code/readtable.lisp
index 597d8ce..250381e 100644 (file)
--- a/src/code/readtable.lisp
+++ b/src/code/readtable.lisp
@@ -12,7 +12,7 @@
 (in-package "SB!IMPL")
 
 (sb!xc:deftype attribute-table ()
-  '(simple-array (unsigned-byte 8) (#.sb!xc:char-code-limit)))
+  '(simple-array (unsigned-byte 8) (#.base-char-code-limit)))
 
 ;;; constants for readtable character attributes. These are all as in
 ;;; the manual.
@@ -58,20 +58,22 @@
   ;; In order to make READ-TOKEN fast, all this information is stored
   ;; in the character attribute table by having different varieties of
   ;; constituents.
-  (character-attribute-table
-   (make-array sb!xc:char-code-limit
+  (character-attribute-array
+   (make-array base-char-code-limit
               :element-type '(unsigned-byte 8)
               :initial-element +char-attr-constituent+)
    :type attribute-table)
+  (character-attribute-hash-table (make-hash-table) :type hash-table)
   ;; The CHARACTER-MACRO-TABLE is a vector of CHAR-CODE-LIMIT
   ;; functions. One of these functions called with appropriate
   ;; arguments whenever any non-WHITESPACE character is encountered
   ;; inside READ-PRESERVING-WHITESPACE. These functions are used to
   ;; implement user-defined read-macros, system read-macros, and the
   ;; number-symbol reader.
-  (character-macro-table
-   (make-array sb!xc:char-code-limit :initial-element #'undefined-macro-char)
-   :type (simple-vector #.sb!xc:char-code-limit))
+  (character-macro-array
+   (make-array base-char-code-limit :initial-element #'undefined-macro-char)
+   :type (simple-vector #.base-char-code-limit))
+  (character-macro-hash-table (make-hash-table) :type hash-table)
   ;; an alist from dispatch characters to vectors of CHAR-CODE-LIMIT
   ;; functions, for use in defining dispatching macros (like #-macro)
   (dispatch-tables () :type list)

diff --git a/version.lisp-expr b/version.lisp-expr
index d7cd333..9ce3a00 100644 (file)
--- a/version.lisp-expr
+++ b/version.lisp-expr
@@ -17,4 +17,4 @@
 ;;; checkins which aren't released. (And occasionally for internal
 ;;; versions, especially for internal versions off the main CVS
 ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
-"0.8.16.17"
+"0.8.16.18"