diff --git a/code/char.lisp b/code/char.lisp
index b1bfccabde0e765e1832964c0265821683a7dbe0..12adb4aec94f14904060e85027d9f992c84ec6c0 100644
--- a/code/char.lisp
+++ b/code/char.lisp
@@ -22,39 +22,26 @@
 ;;;
 (in-package 'lisp)
 
-(export '(char-code-limit char-font-limit char-bits-limit standard-char-p
-	  graphic-char-p string-char-p alpha-char-p upper-case-p lower-case-p
-	  both-case-p digit-char-p alphanumericp char= char/= char< char>
-	  char<= char>= char-equal char-not-equal char-lessp char-greaterp
-	  char-not-greaterp char-not-lessp character char-code char-bits
-	  char-font code-char make-char char-upcase char-downcase
-	  digit-char char-int int-char char-name name-char char-control-bit
-	  char-meta-bit char-hyper-bit char-super-bit char-bit set-char-bit))
+(export '(char-code-limit standard-char-p graphic-char-p 
+	  alpha-char-p upper-case-p lower-case-p both-case-p digit-char-p
+	  alphanumericp char= char/= char< char> char<= char>= char-equal
+	  char-not-equal char-lessp char-greaterp char-not-greaterp
+	  char-not-lessp character char-code code-char char-upcase
+	  char-downcase digit-char char-int char-name name-char))
 
 
 ;;; Compile some trivial character operations via inline expansion:
 ;;;
-(proclaim '(inline standard-char-p
-		   graphic-char-p string-char-p alpha-char-p upper-case-p
-		   lower-case-p both-case-p alphanumericp char-bits
+(proclaim '(inline standard-char-p graphic-char-p alpha-char-p
+		   upper-case-p lower-case-p both-case-p alphanumericp
 		   char-int))
 
 
 (defconstant char-code-limit 256
   "The upper exclusive bound on values produced by CHAR-CODE.")
-(defconstant char-font-limit 1
-  "The upper exclusive bound on values produced by CHAR-FONT.")
-(defconstant char-bits-limit 256
-  "The upper exclusive bound on values produced by CHAR-BITS.")
 
-(defconstant char-control-bit 1
-  "This bit indicates a control character.")
-(defconstant char-meta-bit 2
-  "This bit indicates a meta character.")
-(defconstant char-super-bit 4
-  "This bit indicates a super character.")
-(defconstant char-hyper-bit 8
-  "This bit indicates a hyper character.")
+(deftype char-code ()
+  `(integer 0 (,char-code-limit)))
 
 
 (defparameter char-name-alist
@@ -63,11 +50,11 @@
 	  ("BACKSPACE" . ,(code-char 8)) ("BS" . ,(code-char 8))
 	  ("TAB" . ,(code-char 9))
 	  ("LINEFEED" . ,(code-char 10)) ("LF" . ,(code-char 10))
+	  ("NEWLINE" . ,(code-char 10)) ("NL" . ,(code-char 10))  
 	  ("VT" . ,(code-char 11))
 	  ("PAGE" . ,(code-char 12)) ("FORM" . ,(code-char 12))
 	  ("FORMFEED" . ,(code-char 12)) ("FF" . ,(code-char 12))
-	  ("RETURN" . ,(code-char 13)) ("NL" . ,(code-char 10))
-	  ("NEWLINE" . ,(code-char 10))  ("CR" . ,(code-char 13))
+	  ("RETURN" . ,(code-char 13)) ("CR" . ,(code-char 13))
 	  ("ALTMODE" . ,(code-char 27)) ("ALT" . ,(code-char 27))
 	  ("ESCAPE" . ,(code-char 27)) ("ESC" . ,(code-char 27))
 	  ("SPACE" . ,(code-char 32)) ("SP" . ,(code-char 32))
@@ -80,54 +67,21 @@
 ;;;; Accessor functions:
 
 (defun char-code (char)
-  "Given a character object argument, char-code returns the code attribute
-   of that object as a non-negative integer."
-  (ldb %character-code-byte (char-int char)))
+  "Returns the integer code of CHAR."
+  (etypecase char
+    (base-character (char-code (truly-the base-character char)))))
 
-(defun char-bits (char)
-  "Given a character object argument, char-code returns the bits attribute
-   of that object as a non-negative integer."
-  (ldb %character-control-byte (char-int char)))
-
-(defun char-font (char)
-  "Given a character object argument, char-code returns the font attribute
-   of that object as 0."
-  (declare (ignore char))
-  0)
 
 (defun char-int (char)
-  "The argument must be a character-object.  Returns the font, bits, and
-  code fields as a single non-negative integer.  Implementation dependent.
-  Used mostly for hashing."
-  (declare (character char))
-  (%primitive make-fixnum char))
-
-
-(defun int-char (n)
-  "Performs the inverse of char-int.  The argument must be a non-negative
-  integer of the appropriate size.  It is turned into a character object."
-  (declare (type unsigned-byte n))
-  (cond ((or (not (fixnump n))
-	     (not (<= 0 (the fixnum n) %character-int-mask)))
-	 nil)
-	((zerop (ldb %character-control-byte (the fixnum n)))
-	 (%primitive make-immediate-type n %string-char-type))
-	(t
-	 (%primitive make-immediate-type n %bitsy-char-type))))
-
-
-(defun code-char (code &optional (bits 0) (font 0))
-  "All three arguments, must be non-negative integers; the last two are 
-   optional with default values of 0 (for the bits and font attributes).
-   Returns a character object with the specified code, bits, and font,
-   or returns NIL if this is not possible."
-  (cond ((not (and (< -1 code char-code-limit) (zerop font))) nil)
-	((zerop bits) (code-char code))
-	((< -1 bits char-bits-limit)
-	 (%primitive make-immediate-type 
-		     (dpb bits %character-control-byte code)
-		     %bitsy-char-type))
-	(t nil)))
+  "Returns the integer code of CHAR.  This is the same as char-code, as
+   CMU Common Lisp does not implement character bits or fonts."
+  (char-code char))
+
+
+(defun code-char (code)
+  "Returns the character with the code CODE."
+  (declare (type char-code code))
+  (code-char code))
 
 
 (defun character (object)
@@ -135,25 +89,17 @@
   characters, strings and symbols of length 1, and integers."
   (typecase object
     (character object)
-    (integer (int-char object))
-    (string (if (= 1 (the fixnum (length (the string object))))
+    (char-code (code-char object))
+    (string (if (= 1 (length (the string object)))
 		(char object 0)
 		(error "String is not of length one: ~S" object)))
-    (symbol (if (= 1 (the fixnum (length (symbol-name object))))
+    (symbol (if (= 1 (length (symbol-name object)))
 		(schar (symbol-name object) 0)
 		(error "Symbol name is not of length one: ~S" object)))
     (t
      (error "~S cannot be coerced to a character."))))
 
 
-(defun make-char (char &optional (bits 0) (font 0))
-  "Replaces the bits and font attributes of the specified character with
-  those supplied by the user as fixnums.  Bits and font both default to 0."
-  (declare (character char))
-  (and (< -1 bits char-bits-limit)
-       (zerop font)
-       (int-char (dpb bits %character-control-byte (char-code char)))))
-
 
 (defun char-name (char)
   "Given a character object, char-name returns the name for that
@@ -167,32 +113,6 @@
   (cdr (assoc (string name) char-name-alist :test #'string-equal)))
 
 
-(defun char-bit (char name)
-  "Returns T if the named bit is set in character object CHAR.  Else,
-  returns NIL.  Legal names are :CONTROL, :META, :HYPER, and :SUPER."
-  (logtest (case name
-	     (:control char-control-bit)
-	     (:meta char-meta-bit)
-	     (:hyper char-hyper-bit)
-	     (:super char-super-bit))
-	   (char-bits char)))
-
-
-(defun set-char-bit (char name newvalue)
-  "Returns a character just like CHAR except that the named bit is
-  set or cleared, according to whether NEWVALUE is non-null or NIL.
-  Legal bit names are :CONTROL, :META, :HYPER, and :SUPER."
-  (let ((bit (case name
-	      (:control char-control-bit)
-	      (:meta char-meta-bit)
-	      (:hyper char-hyper-bit)
-	      (:super char-super-bit)
-	      (t 0))))
-    (code-char (char-code char)
-	       (if newvalue
-		   (logior bit (char-bits char))
-		   (logand (lognot bit) (char-bits char)))
-	       (char-font char))))
 
 
 ;;;; Predicates:
@@ -202,8 +122,8 @@
    argument is a standard character -- one of the 95 ASCII printing characters
    or <return>."
   (declare (character char))
-  (and (typep char 'string-char)
-       (let ((n (char-code (the string-char char))))
+  (and (typep char 'base-character)
+       (let ((n (char-code (the base-character char))))
 	 (or (< 31 n 127)
 	     (= n 13)
 	     (= n 10)))))
@@ -214,19 +134,12 @@
   argument is a printing character (space through ~ in ASCII), otherwise
   returns ()."
   (declare (character char))
-  (and (typep char 'string-char)
+  (and (typep char 'base-character)
        (< 31
-	  (char-code (the string-char char))
+	  (char-code (the base-character char))
 	  127)))
 
 
-(defun string-char-p (char)
-  "The argument must be a character object.  String-char-p returns T if the
-   argument can be stored in a string."
-  (declare (character char))
-  (typep char 'string-char))
-
-
 (defun alpha-char-p (char)
   "The argument must be a character object.  Alpha-char-p returns T if the
    argument is an alphabetic character, A-Z or a-z; otherwise ()."
@@ -433,34 +346,23 @@
 ;;;; Miscellaneous functions:
 
 (defun char-upcase (char)
-  "Returns a character with the same bits and font as the input character,
-  converted to upper-case if that is possible."
+  "Returns CHAR converted to upper-case if that is possible."
   (declare (character char))
-  (cond ((typep char 'string-char)
-	 (char-upcase (the string-char char)))
-	((lower-case-p char)
-	 (int-char (- (char-int char) 32)))
-	(t
-	 char)))
-
+  (if (lower-case-p char)
+      (code-char (- (char-code char) 32))
+      char))
 
 (defun char-downcase (char)
-  "Returns a character with the same bits and font as the input character,
-  converted to lower-case if that is possible."
+  "Returns CHAR converted to lower-case if that is possible."
   (declare (character char))
-  (cond ((typep char 'string-char)
-	 (char-downcase (the string-char char)))
-	((upper-case-p char)
-	 (int-char (+ (char-int char) 32)))
-	(t
-	 char)))
-
+  (if (upper-case-p char)
+      (code-char (+ (char-code char) 32))
+      char))
 
-(defun digit-char (weight &optional (radix 10) (font 0))
+(defun digit-char (weight &optional (radix 10))
   "All arguments must be integers.  Returns a character object that
   represents a digit of the given weight in the specified radix.  Returns
   NIL if no such character exists.  The character will have the specified
   font attributes."
   (and (>= weight 0) (< weight radix) (< weight 36)
-       (code-char (if (< weight 10) (+ 48 weight) (+ 55 weight))
-		  0 font)))
+       (code-char (if (< weight 10) (+ 48 weight) (+ 55 weight)))))
diff --git a/code/defmacro.lisp b/code/defmacro.lisp
index aae4551ce1625c04690e3725a86dcb17a54680d5..b13f4250f03b1d1c7a08364409eecc0f4f491fe6 100644
--- a/code/defmacro.lisp
+++ b/code/defmacro.lisp
@@ -389,10 +389,10 @@
   of the calling form containing keywords.  LEGAL is the list of legal
   keywords.  If the keyword :allow-other-keyws is present in KEYLIST,
   just return without complaining about anything."
-  (cond ((memq ':allow-other-keys keylist) nil)
+  (cond ((member ':allow-other-keys keylist :test #'eq) nil)
 	(t (do ((kl keylist (cddr kl)))
 	       ((atom kl) nil)
-	     (cond ((memq (car kl) legal))
+	     (cond ((member (car kl) legal :test #'eq))
 		   (t (cerror "Ignore it."
 			      "~S illegal or unknown keyword." (car kl))))))))
 
diff --git a/code/hash.lisp b/code/hash.lisp
index 7ecea07d1841032cab53f224f9f82d0678921c47..0457a326fb0fc3ccb9c0e7e24e8c8298fe235939 100644
--- a/code/hash.lisp
+++ b/code/hash.lisp
@@ -15,6 +15,12 @@
 	  gethash remhash maphash clrhash
 	  hash-table-count sxhash))
 
+;;; Vector subtype codes.
+
+(defconstant valid-hashing 2)
+(defconstant must-rehash 3)
+
+
 ;;; What a hash-table is:
 
 (defstruct (hash-table (:constructor make-hash-table-structure)
@@ -132,7 +138,7 @@
 		     (setf (hash-table-table structure) new-vector)))
 	      (if (not (eq (hash-table-kind structure) 'equal))
 		  (%primitive set-vector-subtype new-vector
-			      (+ 2 (%primitive newspace-bit)))))))
+			      valid-hashing)))))
     (declare (fixnum i size))
     (do ((bucket (aref hash-vector i) (cdr bucket)))
 	((null bucket))
@@ -178,8 +184,7 @@
 (defmacro eq-rehash-if-needed ()
   `(let ((subtype (%primitive get-vector-subtype vector)))
      (declare (fixnum subtype))
-     (cond ((or (= subtype 4)
-		(/= subtype (+ 2 (%primitive newspace-bit))))
+     (cond ((/= subtype valid-hashing)
 	    (rehash hash-table vector size)
 	    (setq vector (hash-table-table hash-table)))
 	   ((> (hash-table-number-entries hash-table)
@@ -200,8 +205,7 @@
 	 (size (length vector)))
      (declare (fixnum subtype size))
      (cond ((and (not (eq (hash-table-kind hash-table) 'equal))
-		 (or (= subtype 4)
-		     (/= subtype (the fixnum (+ 2 (the fixnum (%primitive newspace-bit)))))))
+		 (/= subtype valid-hashing))
 	    (rehash hash-table vector size)
 	    (setq vector (hash-table-table hash-table))
 	    (setq size (length vector)))
@@ -222,7 +226,7 @@
   (cond ((eq test #'eq) (setq test 'eq))
 	((eq test #'eql) (setq test 'eql))
 	((eq test #'equal) (setq test 'equal)))
-  (if (not (memq test '(eq eql equal)))
+  (if (not (member test '(eq eql equal) :test #'eq))
       (error "~S is an illegal :Test for hash tables." test))
   (setq size (if (<= size 37) 37 (almost-primify size)))
   (cond ((null rehash-threshold)
@@ -236,8 +240,8 @@
 			     (if (eq test 'equal)
 				 (make-array size)
 				 (%primitive set-vector-subtype
-				  (make-array size)
-				  (the fixnum (+ 2 (the fixnum (%primitive newspace-bit))))))
+					     (make-array size)
+					     valid-hashing))
 			     :kind test)))
 
 ;;; Manipulating hash tables:
@@ -362,7 +366,7 @@
   (let ((n-x (gensym)))
     `(let ((,n-x ,x))
        (declare (fixnum ,n-x))
-       (abs (logxor (the fixnum (%primitive lsh ,n-x ,num)) ,n-x)))))
+       (abs (logxor (the fixnum (ash ,n-x ,num)) ,n-x)))))
 
 (defmacro sxhash-simple-string (sequence)
   `(%primitive sxhash-simple-string ,sequence))
@@ -373,8 +377,7 @@
 	(end (gensym)))
     `(with-array-data ((,data ,sequence)
 		       (,start)
-		       (,end (%primitive header-ref ,sequence
-					 %array-fill-pointer-slot)))
+		       (,end))
        (if (zerop ,start)
 	   (%primitive sxhash-simple-substring ,data ,end)
 	   (sxhash-simple-string (coerce (the string ,sequence)
@@ -425,5 +428,6 @@
 			     (internal-sxhash (denominator s-expr) 0))))
        (complex (the fixnum (+ (internal-sxhash (realpart s-expr) 0)
 			       (internal-sxhash (imagpart s-expr) 0))))))
+    #+nil
     (compiled-function (%primitive header-length s-expr))
     (t (%primitive make-fixnum s-expr))))
diff --git a/code/string.lisp b/code/string.lisp
index c9c96088043a94515aa091df771fca5a583e0472..838d975096b24ccfec11a947b6b03c33d0af1f7b 100644
--- a/code/string.lisp
+++ b/code/string.lisp
@@ -59,18 +59,19 @@
 	(data-end (gensym))
 	(offset (gensym)))
     `(progn
-      (if (symbolp ,string) (setq ,string (symbol-name ,string)))
-      (if (array-header-p ,string)
-	  (with-array-data ((,data ,string :offset-var ,offset)
-			    (,data-start ,start)
-			    (,data-end (or ,end
-					   (%primitive header-ref ,string
-						       %array-fill-pointer-slot))))
-			   (psetq ,string ,data
-				  ,cum-offset ,offset
-				  ,start ,data-start
-				  ,end ,data-end))
-	  (if (not ,end) (setq ,end (length (the simple-string ,string)))))
+       (if (symbolp ,string)
+	   (setf ,string (symbol-name ,string)))
+       (if (array-header-p ,string)
+	   (with-array-data ((,data ,string :offset-var ,offset)
+			     (,data-start ,start)
+			     (,data-end (or ,end
+					    (length (the simple-string
+							 ,string)))))
+	     (psetq ,string ,data
+		    ,cum-offset ,offset
+		    ,start ,data-start
+		    ,end ,data-end))
+	   (if (not ,end) (setq ,end (length (the simple-string ,string)))))
       ,@forms)))
 
 )
@@ -86,8 +87,7 @@
      (if (array-header-p ,string)
 	 (with-array-data ((data ,string)
 			   (data-start start)
-			   (data-end (%primitive header-ref ,string
-						 %array-fill-pointer-slot)))
+			   (data-end (length (the simple-string ,string))))
 	   (psetq ,string data
 		  start data-start
 		  end data-end))
@@ -114,27 +114,28 @@
 	  (with-array-data ((,data ,string1 :offset-var ,offset)
 			    (,data-start ,start1)
 			    (,data-end (or ,end1
-					   (%primitive header-ref ,string1
-						       %array-fill-pointer-slot))))
-			   (psetq ,string1 ,data
-				  ,cum-offset-1 ,offset
-				  ,start1 ,data-start
-				  ,end1 ,data-end))
+					   (length (the simple-string
+							,string1)))))
+	    (psetq ,string1 ,data
+		   ,cum-offset-1 ,offset
+		   ,start1 ,data-start
+		   ,end1 ,data-end))
 	  (if (not ,end1) (setq ,end1 (length (the simple-string ,string1)))))
       (if (array-header-p ,string2)
 	  (with-array-data ((,data ,string2)
 			    (,data-start ,start2)
 			    (,data-end (or ,end2
-					   (%primitive header-ref ,string2
-						       %array-fill-pointer-slot))))
-			   (psetq ,string2 ,data
-				  ,start2 ,data-start
-				  ,end2 ,data-end))
+					   (length (the simple-string
+							,string2)))))
+	    (psetq ,string2 ,data
+		   ,start2 ,data-start
+		   ,end2 ,data-end))
 	  (if (not ,end2) (setq ,end2 (length (the simple-string ,string2)))))
       ,@forms)))
 
 )
 
+
 (defun char (string index)
   "Given a string and a non-negative integer index less than the length of
   the string, returns the character object representing the character at
diff --git a/code/symbol.lisp b/code/symbol.lisp
index 50f0598a22d901c9f359196c4f6062545adc516f..59d0a026afe95793f129c0d0b694ff956d35039a 100644
--- a/code/symbol.lisp
+++ b/code/symbol.lisp
@@ -82,19 +82,17 @@
 (defun %put (symbol indicator value)
   "The VALUE is added as a property of SYMBOL under the specified INDICATOR.
   Returns VALUE."
-  (%primitive put symbol indicator value)
-#|  (do ((pl (symbol-plist symbol) (cddr pl)))
-      ((atom pl)
+  (do ((pl (symbol-plist symbol) (cddr pl)))
+      ((endp pl)
        (setf (symbol-plist symbol)
 	     (list* indicator value (symbol-plist symbol)))
        value)
-    (cond ((atom (cdr pl))
+    (cond ((endp (cdr pl))
 	   (error "~S has an odd number of items in its property list."
 		  symbol))
 	  ((eq (car pl) indicator)
 	   (rplaca (cdr pl) value)
-	   (return value))))|#
-  )
+	   (return value)))))
 
 (defun remprop (symbol indicator)
   "Look on property list of SYMBOL for property with specified
diff --git a/code/type-boot.lisp b/code/type-boot.lisp
index c9d6019c79e869eb8fd361f8767fbc76d81e8101..622cf8a96bcb8c3c4f65311f7d67e8fe900c0174 100644
--- a/code/type-boot.lisp
+++ b/code/type-boot.lisp
@@ -24,7 +24,7 @@
 ;;;
 (defun pathnamep (x)
   (and (structurep x)
-       (eq (%primitive header-ref x %g-vector-structure-name-slot)
+       (eq (%primitive structure-ref x 0)
 	   'pathname)))
 
 ;;; Define so that we can test for VOLATILE-INFO-ENVs from the beginning of
@@ -32,7 +32,7 @@
 ;;;
 (defun volatile-info-env-p (x)
   (and (structurep x)
-       (eq (%primitive header-ref x %g-vector-structure-name-slot)
+       (eq (%primitive structure-ref x 0)
 	   'volatile-info-env)))