diff -urNb sbcl/package-data-list.lisp-expr sbcl.char/package-data-list.lisp-expr
--- sbcl/package-data-list.lisp-expr	2004-10-30 22:55:56.000000000 +0200
+++ sbcl.char/package-data-list.lisp-expr	2004-11-01 15:34:14.000000000 +0100
@@ -1123,13 +1123,14 @@
                "ARRAY-TYPE" "ARRAY-TYPE-COMPLEXP"
                "ARRAY-TYPE-DIMENSIONS" "ARRAY-TYPE-ELEMENT-TYPE"
                "ARRAY-TYPE-P" "ARRAY-TYPE-SPECIALIZED-ELEMENT-TYPE"
-               "ASH-INDEX" "ASSERT-ERROR" "BASE-STRING-P"
+               "ASH-INDEX" "ASSERT-ERROR" "BASE-CHAR-P" "BASE-STRING-P"
                "BINDING-STACK-POINTER-SAP" "BIT-BASH-COPY" "BIT-INDEX"
                "BOGUS-ARG-TO-VALUES-LIST-ERROR" "BOOLE-CODE"
                "BOUNDING-INDICES-BAD-ERROR" "BYTE-SPECIFIER" "%BYTE-BLT"
                "CALLABLE" "CASE-BODY-ERROR"
               "CHARACTER-SET" "CHARACTER-SET-TYPE"
               "CHARACTER-SET-TYPE-PAIRS"
+	       "CHARACTER-STRING-P"
               "CHARPOS"
                "CHECK-FOR-CIRCULARITY" "CHECK-TYPE-ERROR" "CLOSED-FLAME"
                "CODE-COMPONENT" "CODE-COMPONENT-P" "CODE-DEBUG-INFO"
@@ -1233,7 +1234,8 @@
                "NUMERIC-TYPE-HIGH" "NUMERIC-TYPE-LOW" "NUMERIC-TYPE-P"
                "OBJECT-NOT-ARRAY-ERROR" "OBJECT-NOT-CHARACTER-ERROR"
                "OBJECT-NOT-BASE-STRING-ERROR" "OBJECT-NOT-BIGNUM-ERROR"
-               "OBJECT-NOT-BIT-VECTOR-ERROR" "OBJECT-NOT-COMPLEX-ERROR"
+               "OBJECT-NOT-BIT-VECTOR-ERROR"
+	       "OBJECT-NOT-CHARACTER-STRING-ERROR" "OBJECT-NOT-COMPLEX-ERROR"
                "OBJECT-NOT-COMPLEX-FLOAT-ERROR"
                "OBJECT-NOT-COMPLEX-SINGLE-FLOAT-ERROR"
                #!+long-float "OBJECT-NOT-COMPLEX-LONG-FLOAT-ERROR"
@@ -1299,6 +1301,7 @@
                "OBJECT-NOT-SIMPLE-ARRAY-SIGNED-BYTE-8-ERROR"
                "OBJECT-NOT-SIMPLE-BIT-VECTOR-ERROR"
                "OBJECT-NOT-SIMPLE-BASE-STRING-ERROR"
+	       "OBJECT-NOT-SIMPLE-CHARACTER-STRING-ERROR"
                "OBJECT-NOT-SIMPLE-STRING-ERROR"
                "OBJECT-NOT-SIMPLE-VECTOR-ERROR"
                "OBJECT-NOT-SINGLE-FLOAT-ERROR" "OBJECT-NOT-STRING-ERROR"
@@ -1307,7 +1310,9 @@
                "OBJECT-NOT-UNSIGNED-BYTE-32-ERROR"
                ;; FIXME: 32/64-bit issues
                "OBJECT-NOT-UNSIGNED-BYTE-64-ERROR"
-               "OBJECT-NOT-VECTOR-ERROR" "OBJECT-NOT-WEAK-POINTER-ERROR"
+               "OBJECT-NOT-VECTOR-ERROR"
+	       "OBJECT-NOT-VECTOR-NIL-ERROR"
+	       "OBJECT-NOT-WEAK-POINTER-ERROR"
                "ODD-KEY-ARGS-ERROR" "OUTPUT-OBJECT" "OUTPUT-UGLY-OBJECT"
                "PACKAGE-DESIGNATOR" "PACKAGE-DOC-STRING"
                "PACKAGE-HASHTABLE-SIZE" "PACKAGE-HASHTABLE-FREE"
@@ -1354,6 +1359,7 @@
                "SIMPLE-ARRAY-SIGNED-BYTE-61-P"
                "SIMPLE-ARRAY-SIGNED-BYTE-64-P"
                "SIMPLE-ARRAY-SIGNED-BYTE-8-P" "SIMPLE-BASE-STRING-P"
+	       "SIMPLE-CHARACTER-STRING-P"
                "SIMPLE-PACKAGE-ERROR" "SIMPLE-UNBOXED-ARRAY"
                "SINGLE-FLOAT-BITS" "SINGLE-FLOAT-EXPONENT"
                "SINGLE-FLOAT-INT-EXPONENT" "SINGLE-FLOAT-SIGNIFICAND"
@@ -1998,7 +2004,8 @@
 	       "COMPLEX-SINGLE-FLOAT-IMAG-SLOT" "COMPLEX-SINGLE-FLOAT-REAL-SLOT"
 	       "COMPLEX-SINGLE-FLOAT-SIZE" "COMPLEX-SINGLE-FLOAT-WIDETAG"
 	       "COMPLEX-SINGLE-REG-SC-NUMBER" "COMPLEX-SINGLE-STACK-SC-NUMBER"
-	       "COMPLEX-SIZE" "COMPLEX-BASE-STRING-WIDETAG" "COMPLEX-WIDETAG"
+	       "COMPLEX-SIZE" "COMPLEX-BASE-STRING-WIDETAG"
+	       "COMPLEX-CHARACTER-STRING-WIDETAG" "COMPLEX-WIDETAG"
 	       "COMPLEX-VECTOR-NIL-WIDETAG"
 	       "COMPLEX-VECTOR-WIDETAG" "CONS-CAR-SLOT" "CONS-CDR-SLOT"
 	       "CONS-SIZE" "CONSTANT-SC-NUMBER"
@@ -2138,6 +2145,7 @@
 	       "SIMPLE-ARRAY-SIGNED-BYTE-8-WIDETAG"
 	       "SIMPLE-BIT-VECTOR-WIDETAG"
 	       "SIMPLE-BASE-STRING-WIDETAG"
+	       "SIMPLE-CHARACTER-STRING-WIDETAG"
 	       "SIMPLE-VECTOR-WIDETAG" "SINGLE-FLOAT-BIAS"
 	       "SINGLE-FLOAT-DIGITS" "SINGLE-FLOAT-EXPONENT-BYTE"
 	       "SINGLE-FLOAT-HIDDEN-BIT" "SINGLE-FLOAT-NORMAL-EXPONENT-MAX"
diff -urNb sbcl/src/code/array.lisp sbcl.char/src/code/array.lisp
--- sbcl/src/code/array.lisp	2004-10-27 18:39:58.000000000 +0200
+++ sbcl.char/src/code/array.lisp	2004-11-01 15:34:14.000000000 +0100
@@ -91,8 +91,10 @@
     ;; and for all in any reasonable user programs.)
     ((t)
      (values #.sb!vm:simple-vector-widetag #.sb!vm:n-word-bits))
-    ((base-char standard-char character)
+    ((base-char standard-char)
      (values #.sb!vm:simple-base-string-widetag #.sb!vm:n-byte-bits))
+    ((character)
+     (values #.sb!vm:simple-character-string-widetag #.sb!vm:n-word-bits))
     ((bit)
      (values #.sb!vm:simple-bit-vector-widetag 1))
     ;; OK, we have to wade into SUBTYPEPing after all.
@@ -110,8 +112,10 @@
     ;; Pick off some easy common cases.
     ((t)
      #.sb!vm:complex-vector-widetag)
-    ((base-char character)
+    ((base-char)
      #.sb!vm:complex-base-string-widetag)
+    ((character)
+     #.sb!vm:complex-character-string-widetag)
     ((nil)
      #.sb!vm:complex-vector-nil-widetag)
     ((bit)
@@ -120,7 +124,8 @@
     (t
      (pick-vector-type type
        (nil #.sb!vm:complex-vector-nil-widetag)
-       (character #.sb!vm:complex-base-string-widetag)
+       (base-char #.sb!vm:complex-base-string-widetag)
+       (character #.sb!vm:complex-character-string-widetag)
        (bit #.sb!vm:complex-bit-vector-widetag)
        (t #.sb!vm:complex-vector-widetag)))))
 
@@ -148,7 +153,8 @@
 		 (array (allocate-vector
 			 type
 			 length
-			 (ceiling (* (if (= type sb!vm:simple-base-string-widetag)
+			 (ceiling (* (if (or (= type sb!vm:simple-base-string-widetag)
+					     (= type sb!vm:simple-character-string-widetag))
 					 (1+ length)
 					 length)
 				     n-bits)
@@ -854,7 +860,8 @@
 	  ,@(map 'list
 		 (lambda (saetp)
 		   `((simple-array ,(sb!vm:saetp-specifier saetp) (*))
-		     ,(if (eq (sb!vm:saetp-specifier saetp) 'character)
+		     ,(if (or (eq (sb!vm:saetp-specifier saetp) 'character)
+			      (eq (sb!vm:saetp-specifier saetp) 'base-char))
 			  *default-init-char-form*
 			  (sb!vm:saetp-initial-element-default saetp))))
 		 (remove-if-not
diff -urNb sbcl/src/code/char.lisp sbcl.char/src/code/char.lisp
--- sbcl/src/code/char.lisp	2004-10-30 22:55:57.000000000 +0200
+++ sbcl.char/src/code/char.lisp	2004-11-01 15:34:14.000000000 +0100
@@ -12,8 +12,8 @@
 
 (in-package "SB!IMPL")
 
-(def!constant sb!xc:char-code-limit 256
+(def!constant sb!xc:char-code-limit #x110000
   #!+sb-doc
   "the upper exclusive bound on values produced by CHAR-CODE")
 
-(def!constant base-char-code-limit 256)
+(def!constant base-char-code-limit 128)
diff -urNb sbcl/src/code/class.lisp sbcl.char/src/code/class.lisp
--- sbcl/src/code/class.lisp	2004-10-27 23:36:45.000000000 +0200
+++ sbcl.char/src/code/class.lisp	2004-11-01 15:34:14.000000000 +0100
@@ -1243,6 +1243,19 @@
       :inherits (base-string simple-string string vector simple-array
 		 array sequence)
       :prototype-form (make-array 0 :element-type 'base-char))
+     (character-string
+      :translation (vector character)
+      :codes (#.sb!vm:complex-character-string-widetag)
+      :direct-superclasses (string)
+      :inherits (string vector array sequence)
+      :prototype-form (make-array 0 :element-type 'character :fill-pointer t))
+     (simple-character-string
+      :translation (simple-array character (*))
+      :codes (#.sb!vm:simple-character-string-widetag)
+      :direct-superclasses (character-string simple-string)
+      :inherits (character-string simple-string string vector simple-array
+		 array sequence)
+      :prototype-form (make-array 0 :element-type 'character))
      (list
       :translation (or cons (member nil))
       :inherits (sequence))
diff -urNb sbcl/src/code/fd-stream.lisp sbcl.char/src/code/fd-stream.lisp
--- sbcl/src/code/fd-stream.lisp	2004-10-29 11:00:38.000000000 +0200
+++ sbcl.char/src/code/fd-stream.lisp	2004-11-01 15:34:14.000000000 +0100
@@ -1112,6 +1112,37 @@
   (setf (sap-ref-8 sap tail) bits)
   (code-char byte))
 
+(let ((latin-9-table (let ((table (make-string 256)))
+                       (do ((i 0 (1+ i)))
+                           ((= i 256))
+                         (setf (aref table i) (code-char i)))
+                       (setf (aref table #xa4) (code-char #x20ac))
+                       (setf (aref table #xa6) (code-char #x0160))
+                       (setf (aref table #xa8) (code-char #x0161))
+                       (setf (aref table #xb4) (code-char #x017d))
+                       (setf (aref table #xb8) (code-char #x017e))
+                       (setf (aref table #xbc) (code-char #x0152))
+                       (setf (aref table #xbd) (code-char #x0153))
+                       (setf (aref table #xbe) (code-char #x0178))
+                       table))
+      (latin-9-reverse-1 (make-array 16
+                                     :element-type '(unsigned-byte 21)
+                                     :initial-contents '(#x0160 #x0161 #x0152 #x0153 0 0 0 0 #x0178 0 0 0 #x20ac #x017d #x017e 0)))
+      (latin-9-reverse-2 (make-array 16
+                                     :element-type '(unsigned-byte 8)
+                                     :initial-contents '(#xa6 #xa8 #xbc #xbd 0 0 0 0 #xbe 0 0 0 #xa4 #xb4 #xb8 0))))
+  (define-external-format (:latin-9 :latin9 :iso-8859-15)
+      1
+    (setf (sap-ref-8 sap tail)
+          (if (< bits 256)
+              (if (= bits (char-code (aref latin-9-table bits)))
+                  bits
+                  (error "cannot encode ~A in latin-9" bits))
+              (if (= (aref latin-9-reverse-1 (logand bits 15)) bits)
+                  (aref latin-9-reverse-2 (logand bits 15))
+                  (error "cannot encode ~A in latin-9" bits))))
+    (aref latin-9-table byte)))
+
 (define-external-format/variable-width (:utf-8 :utf8)
   (let ((bits (char-code byte)))
     (cond ((< bits #x80) 1)
@@ -1811,7 +1842,8 @@
 	(make-fd-stream 1 :name "standard output" :output t :buffering :line))
   (setf *stderr*
 	(make-fd-stream 2 :name "standard error" :output t :buffering :line))
-  (let ((tty (sb!unix:unix-open "/dev/tty" sb!unix:o_rdwr #o666)))
+  (let* ((ttyname #.(coerce "/dev/tty" 'simple-base-string))
+	 (tty (sb!unix:unix-open ttyname sb!unix:o_rdwr #o666)))
     (if tty
 	(setf *tty*
 	      (make-fd-stream tty
diff -urNb sbcl/src/code/fop.lisp sbcl.char/src/code/fop.lisp
--- sbcl/src/code/fop.lisp	2004-10-30 16:36:06.000000000 +0200
+++ sbcl.char/src/code/fop.lisp	2004-11-01 15:34:14.000000000 +0100
@@ -71,7 +71,8 @@
 ;;; of like READ-SEQUENCE specialized for files of (UNSIGNED-BYTE 8),
 ;;; with an automatic conversion from (UNSIGNED-BYTE 8) into CHARACTER
 ;;; for each element read
-(declaim (ftype (function (stream simple-string &optional index) (values)) read-string-as-bytes))
+(declaim (ftype (function (stream simple-string &optional index) (values))
+                read-string-as-bytes read-string-as-words))
 (defun read-string-as-bytes (stream string &optional (length (length string)))
   (dotimes (i length)
     (setf (aref string i)
@@ -83,6 +84,16 @@
   ;; significantly better than the portable version here. If it is, then use
   ;; it as an alternate definition, protected with #-SB-XC-HOST.
   (values))
+(defun read-string-as-words (stream string &optional (length (length string)))
+  #+sb-xc-host (bug "READ-STRING-AS-WORDS called")
+  (dotimes (i length)
+    (setf (aref string i)
+	  (sb!xc:code-char (logior
+                            (read-byte stream)
+                            (ash (read-byte stream) 8)
+                            (ash (read-byte stream) 16)
+                            (ash (read-byte stream) 24)))))
+  (values))
 
 ;;;; miscellaneous fops
 
@@ -123,11 +134,8 @@
   #-sb-xc-host
   (%primitive sb!c:make-other-immediate-type 0 sb!vm:unbound-marker-widetag))
 
-;;; CMU CL had FOP-CHARACTER as fop 68, but it's not needed in current
-;;; SBCL as we have no extended characters, only 1-byte characters.
-;;; (Ditto for CMU CL, actually: FOP-CHARACTER was speculative generality.)
-(define-fop (fop-short-character 69)
-  (code-char (read-byte-arg)))
+(define-cloned-fops (fop-character 68) (fop-short-character 69)
+  (code-char (clone-arg)))
 
 (define-cloned-fops (fop-struct 48) (fop-small-struct 49)
   (let* ((size (clone-arg))
@@ -183,9 +191,14 @@
 			      (make-string (* ,n-size 2))))
 		      (done-with-fast-read-byte)
 		      (let ((,n-buffer *fasl-symbol-buffer*))
+                        #+sb-xc-host
 			(read-string-as-bytes *fasl-input-stream*
 					      ,n-buffer
 					      ,n-size)
+                        #-sb-xc-host
+			(read-string-as-words *fasl-input-stream*
+					      ,n-buffer
+					      ,n-size)
 			(push-fop-table (without-package-locks
 					 (intern* ,n-buffer
 						  ,n-size
@@ -232,7 +245,7 @@
 		    (fop-uninterned-small-symbol-save 13)
   (let* ((arg (clone-arg))
 	 (res (make-string arg)))
-    (read-string-as-bytes *fasl-input-stream* res)
+    (read-string-as-words *fasl-input-stream* res)
     (push-fop-table (make-symbol res))))
 
 (define-fop (fop-package 14)
@@ -344,12 +357,23 @@
 
 ;;;; fops for loading arrays
 
-(define-cloned-fops (fop-string 37) (fop-small-string 38)
+(define-cloned-fops (fop-base-string 37) (fop-small-base-string 38)
   (let* ((arg (clone-arg))
-	 (res (make-string arg)))
+	 (res (make-string arg :element-type 'base-char)))
     (read-string-as-bytes *fasl-input-stream* res)
     res))
 
+#+sb-xc-host
+(define-cloned-fops (fop-character-string 161) (fop-small-character-string 162)
+  (bug "CHARACTER-STRING FOP encountered"))
+
+#-sb-xc-host
+(define-cloned-fops (fop-character-string 161) (fop-small-character-string 162)
+  (let* ((arg (clone-arg))
+	 (res (make-string arg)))
+    (read-string-as-words *fasl-input-stream* res)
+    res))
+
 (define-cloned-fops (fop-vector 39) (fop-small-vector 40)
   (let* ((size (clone-arg))
 	 (res (make-array size)))
@@ -639,7 +663,7 @@
   (let* ((kind (pop-stack))
 	 (code-object (pop-stack))
 	 (len (read-byte-arg))
-	 (sym (make-string len)))
+	 (sym (make-string len :element-type 'base-char)))
     (read-n-bytes *fasl-input-stream* sym 0 len)
     (sb!vm:fixup-code-object code-object
 			     (read-word-arg)
diff -urNb sbcl/src/code/interr.lisp sbcl.char/src/code/interr.lisp
--- sbcl/src/code/interr.lisp	2004-10-27 18:39:59.000000000 +0200
+++ sbcl.char/src/code/interr.lisp	2004-11-01 15:34:14.000000000 +0100
@@ -123,6 +123,16 @@
 	 :datum object
 	 :expected-type 'base-string))
 
+(deferr object-not-vector-nil-error (object)
+  (error 'type-error
+	 :datum object
+	 :expected-type '(vector nil)))
+
+(deferr object-not-character-string-error (object)
+  (error 'type-error
+	 :datum object
+	 :expected-type '(vector character)))
+
 (deferr object-not-bit-vector-error (object)
   (error 'type-error
 	 :datum object
diff -urNb sbcl/src/code/late-type.lisp sbcl.char/src/code/late-type.lisp
--- sbcl/src/code/late-type.lisp	2004-10-27 23:36:45.000000000 +0200
+++ sbcl.char/src/code/late-type.lisp	2004-11-01 15:34:14.000000000 +0100
@@ -2096,22 +2096,22 @@
 	       (if (eq (car dims) '*)
 		   (case eltype
 		     (bit 'bit-vector)
-		     ((base-char character) 'base-string)
+		     ((base-char) 'base-string)
 		     (* 'vector)
 		     (t `(vector ,eltype)))
 		   (case eltype
 		     (bit `(bit-vector ,(car dims)))
-		     ((base-char character) `(base-string ,(car dims)))
+		     ((base-char) `(base-string ,(car dims)))
 		     (t `(vector ,eltype ,(car dims)))))
 	       (if (eq (car dims) '*)
 		   (case eltype
 		     (bit 'simple-bit-vector)
-		     ((base-char character) 'simple-base-string)
+		     ((base-char) 'simple-base-string)
 		     ((t) 'simple-vector)
 		     (t `(simple-array ,eltype (*))))
 		   (case eltype
 		     (bit `(simple-bit-vector ,(car dims)))
-		     ((base-char character) `(simple-base-string ,(car dims)))
+		     ((base-char) `(simple-base-string ,(car dims)))
 		     ((t) `(simple-vector ,(car dims)))
 		     (t `(simple-array ,eltype ,dims))))))
 	  (t
diff -urNb sbcl/src/code/print.lisp sbcl.char/src/code/print.lisp
--- sbcl/src/code/print.lisp	2004-10-30 22:55:57.000000000 +0200
+++ sbcl.char/src/code/print.lisp	2004-11-01 15:34:14.000000000 +0100
@@ -1262,7 +1262,11 @@
 ;;; [CMUC]<steele>tradix.press. DO NOT EVEN THINK OF ATTEMPTING TO
 ;;; UNDERSTAND THIS CODE WITHOUT READING THE PAPER!
 
-(declaim (type (simple-array character (10)) *digits*))
+;;; and, to add to the confusion: this declaration may look wrong, but
+;;; in fact it's right.  FIXME: it should probably be local to
+;;; FLOAT-STRING, 'cause we're probably not ever going to print floats
+;;; in bases other than 10; then this declaration can go away.
+(declaim (type (simple-array base-char (10)) *digits*))
 (defvar *digits* "0123456789")
 
 (defun flonum-to-string (x &optional width fdigits scale fmin)
diff -urNb sbcl/src/code/room.lisp sbcl.char/src/code/room.lisp
--- sbcl/src/code/room.lisp	2004-09-29 21:34:40.000000000 +0200
+++ sbcl.char/src/code/room.lisp	2004-11-01 15:34:14.000000000 +0100
@@ -72,7 +72,8 @@
 			    :kind :fixed
 			    :length size))))))
 
-(dolist (code (list complex-base-string-widetag simple-array-widetag
+(dolist (code (list complex-character-string-widetag
+                    complex-base-string-widetag simple-array-widetag
 		    complex-bit-vector-widetag complex-vector-widetag
 		    complex-array-widetag complex-vector-nil-widetag))
   (setf (svref *meta-room-info* code)
@@ -122,6 +123,11 @@
 		      :kind :string
 		      :length 0))
 
+(setf (svref *meta-room-info* simple-character-string-widetag)
+      (make-room-info :name 'simple-character-string
+		      :kind :string
+		      :length 2))
+
 (setf (svref *meta-room-info* simple-array-nil-widetag)
       (make-room-info :name 'simple-array-nil
 		      :kind :fixed
@@ -467,6 +473,7 @@
 	     #.single-float-widetag
 	     #.double-float-widetag
 	     #.simple-base-string-widetag
+             #.simple-character-string-widetag
 	     #.simple-array-nil-widetag
 	     #.simple-bit-vector-widetag
 	     #.simple-array-unsigned-byte-2-widetag
diff -urNb sbcl/src/code/run-program.lisp sbcl.char/src/code/run-program.lisp
--- sbcl/src/code/run-program.lisp	2004-11-01 15:33:52.000000000 +0100
+++ sbcl.char/src/code/run-program.lisp	2004-11-01 15:34:14.000000000 +0100
@@ -289,12 +289,12 @@
 (defun find-a-pty ()
   (dolist (char '(#\p #\q))
     (dotimes (digit 16)
-      (let* ((master-name (format nil "/dev/pty~C~X" char digit))
+      (let* ((master-name (coerce (format nil "/dev/pty~C~X" char digit) 'base-string))
 	     (master-fd (sb-unix:unix-open master-name
 					   sb-unix:o_rdwr
 					   #o666)))
 	(when master-fd
-	  (let* ((slave-name (format nil "/dev/tty~C~X" char digit))
+	  (let* ((slave-name (coerce (format nil "/dev/tty~C~X" char digit) 'base-string))
 		 (slave-fd (sb-unix:unix-open slave-name
 					      sb-unix:o_rdwr
 					      #o666)))
diff -urNb sbcl/src/code/seq.lisp sbcl.char/src/code/seq.lisp
--- sbcl/src/code/seq.lisp	2004-09-30 22:20:27.000000000 +0200
+++ sbcl.char/src/code/seq.lisp	2004-11-01 15:34:14.000000000 +0100
@@ -569,6 +569,14 @@
   (when (null source-end) (setq source-end (length source-sequence)))
   (mumble-replace-from-mumble))
 
+(defun simple-character-string-replace-from-simple-character-string*
+    (target-sequence source-sequence
+     target-start target-end source-start source-end)
+  (declare (type (simple-array character (*)) target-sequence source-sequence))
+  (when (null target-end) (setq target-end (length target-sequence)))
+  (when (null source-end) (setq source-end (length source-sequence)))
+  (mumble-replace-from-mumble))
+
 (define-sequence-traverser replace
     (sequence1 sequence2 &key start1 end1 start2 end2)
   #!+sb-doc
diff -urNb sbcl/src/code/stream.lisp sbcl.char/src/code/stream.lisp
--- sbcl/src/code/stream.lisp	2004-11-01 15:33:52.000000000 +0100
+++ sbcl.char/src/code/stream.lisp	2004-11-01 15:34:14.000000000 +0100
@@ -433,14 +433,15 @@
 	   (funcall (ansi-stream-in stream) stream eof-error-p eof-value))
 	  (t
 	   (when (/= start +ansi-stream-in-buffer-extra+)
+	     ;; FIXME AARGH KLUDGE There's no sb!vm:n-character-bits.
 	     (bit-bash-copy ibuf (+ (* +ansi-stream-in-buffer-extra+
-				       sb!vm:n-byte-bits)
+				       sb!vm:n-byte-bits 4)
 				    (* sb!vm:vector-data-offset
 				       sb!vm:n-word-bits))
-			    ibuf (+ (the index (* start sb!vm:n-byte-bits))
+			    ibuf (+ (the index (* start sb!vm:n-byte-bits 4))
 				    (* sb!vm:vector-data-offset
 				       sb!vm:n-word-bits))
-			    (* count sb!vm:n-byte-bits)))
+			    (* count sb!vm:n-byte-bits 4)))
 	   (setf (ansi-stream-in-index stream) (1+ start))
 	   (aref ibuf start)))))
 
diff -urNb sbcl/src/code/target-load.lisp sbcl.char/src/code/target-load.lisp
--- sbcl/src/code/target-load.lisp	2004-10-29 11:00:39.000000000 +0200
+++ sbcl.char/src/code/target-load.lisp	2004-11-01 15:34:14.000000000 +0100
@@ -295,4 +295,9 @@
 (defun !loader-cold-init ()
   (/show0 "/!loader-cold-init")
   (dolist (routine *!initial-assembler-routines*)
-    (setf (gethash (car routine) *assembler-routines*) (cdr routine))))
+    (setf (gethash (car routine) *assembler-routines*) (cdr routine)))
+  (dolist (symbol *!initial-foreign-symbols*)
+    (setf (gethash (car symbol) *static-foreign-symbols*) (cdr symbol))))
+
+(declaim (ftype (function (string) (unsigned-byte #.sb!vm:n-machine-word-bits))
+		foreign-symbol-address-as-integer))
diff -urNb sbcl/src/compiler/dump.lisp sbcl.char/src/compiler/dump.lisp
--- sbcl/src/compiler/dump.lisp	2004-10-30 16:36:07.000000000 +0200
+++ sbcl.char/src/compiler/dump.lisp	2004-11-01 15:34:14.000000000 +0100
@@ -600,7 +600,14 @@
 	(t
 	 (unless *cold-load-dump*
 	   (dump-fop 'fop-normal-load file))
-	 (dump-simple-string (package-name pkg) file)
+         #+sb-xc-host
+         (dump-simple-base-string
+          (coerce (package-name pkg) 'simple-base-string)
+          file)
+         #-sb-xc-host
+	 (dump-simple-character-string
+	  (coerce (package-name pkg) '(simple-array character (*)))
+	  file)
 	 (dump-fop 'fop-package file)
 	 (unless *cold-load-dump*
 	   (dump-fop 'fop-maybe-cold-load file))
@@ -731,10 +738,21 @@
 					(*)))
 			    x)))
     (typecase simple-version
+      #+sb-xc-host
+      (simple-string
+       (unless (string-check-table x file)
+         (dump-simple-base-string simple-version file)
+         (string-save-object x file)))
+      #-sb-xc-host
       (simple-base-string
-       (unless (equal-check-table x file)
-	 (dump-simple-string simple-version file)
-	 (equal-save-object x file)))
+       (unless (string-check-table x file)
+	 (dump-simple-base-string simple-version file)
+	 (string-save-object x file)))
+      #-sb-xc-host
+      ((simple-array character (*))
+       (unless (string-check-table x file)
+	 (dump-simple-character-string simple-version file)
+	 (string-save-object x file)))
       (simple-vector
        (dump-simple-vector simple-version file)
        (eq-save-object x file))
@@ -903,23 +921,31 @@
 
 ;;; Dump characters and string-ish things.
 
-(defun dump-character (ch file)
+(defun dump-character (char file)
+  (let ((code (sb!xc:char-code char)))
+    (cond
+      ((< code 256)
   (dump-fop 'fop-short-character file)
-  (dump-byte (char-code ch) file))
+       (dump-byte code file))
+      (t
+       (dump-fop 'fop-character file)
+       (dump-word code file)))))
 
-;;; a helper function shared by DUMP-SIMPLE-STRING and DUMP-SYMBOL
-(defun dump-characters-of-string (s fasl-output)
-  (declare (type string s) (type fasl-output fasl-output))
+(defun dump-base-chars-of-string (s fasl-output)
+  (declare #+sb-xc-host (type simple-string s)
+           #-sb-xc-host (type simple-base-string s)
+           (type fasl-output fasl-output))
   (dovector (c s)
-    (dump-byte (char-code c) fasl-output))
+    (dump-byte (sb!xc:char-code c) fasl-output))
   (values))
 
+
 ;;; Dump a SIMPLE-BASE-STRING.
-;;; FIXME: should be called DUMP-SIMPLE-BASE-STRING then
-(defun dump-simple-string (s file)
-  (declare (type simple-base-string s))
-  (dump-fop* (length s) fop-small-string fop-string file)
-  (dump-characters-of-string s file)
+(defun dump-simple-base-string (s file)
+  #+sb-xc-host (declare (type simple-string s))
+  #-sb-xc-host (declare (type simple-base-string s))
+  (dump-fop* (length s) fop-small-base-string fop-base-string file)
+  (dump-base-chars-of-string s file)
   (values))
 
 ;;; If we get here, it is assumed that the symbol isn't in the table,
@@ -969,7 +995,8 @@
 		      file)
 	   (dump-word pname-length file)))
 
-    (dump-characters-of-string pname file)
+    #+sb-xc-host (dump-base-chars-of-string pname file)
+    #-sb-xc-host (dump-characters-of-string pname file)
 
     (unless *cold-load-dump*
       (setf (gethash s (fasl-output-eq-table file))
diff -urNb sbcl/src/compiler/generic/early-objdef.lisp sbcl.char/src/compiler/generic/early-objdef.lisp
--- sbcl/src/compiler/generic/early-objdef.lisp	2004-10-27 18:39:59.000000000 +0200
+++ sbcl.char/src/compiler/generic/early-objdef.lisp	2004-11-01 15:34:14.000000000 +0100
@@ -167,6 +167,7 @@
   simple-array-unsigned-byte-16     ; 10011110
   simple-array-nil                  ; 10100010
   simple-base-string                ; 10100110
+  simple-character-string
   simple-bit-vector                 ; 10101010
   simple-vector                     ; 10101110
   #!+#.(cl:if (cl:= 32 sb!vm:n-word-bits) '(and) '(or))
@@ -195,16 +196,19 @@
   simple-array                      ; 11011110
   complex-vector-nil                ; 11100010
   complex-base-string               ; 11100110
+  complex-character-string
   complex-bit-vector                ; 11101010
   complex-vector                    ; 11101110
   complex-array                     ; 11110010
 
   #!+#.(cl:if (cl:= 32 sb!vm:n-word-bits) '(and) '(or))
   unused12                          ; 11110110
+  #|
   #!+#.(cl:if (cl:= 32 sb!vm:n-word-bits) '(and) '(or))
   unused13                          ; 11111010
   #!+#.(cl:if (cl:= 32 sb!vm:n-word-bits) '(and) '(or))
   unused14                          ; 11111110
+  |#
 )
 
 ;;; the different vector subtypes
diff -urNb sbcl/src/compiler/generic/genesis.lisp sbcl.char/src/compiler/generic/genesis.lisp
--- sbcl/src/compiler/generic/genesis.lisp	2004-11-01 15:33:53.000000000 +0100
+++ sbcl.char/src/compiler/generic/genesis.lisp	2004-11-01 15:34:14.000000000 +0100
@@ -2099,13 +2099,17 @@
 
 ;;;; cold fops for loading vectors
 
-(clone-cold-fop (fop-string)
-		(fop-small-string)
+(clone-cold-fop (fop-base-string)
+		(fop-small-base-string)
   (let* ((len (clone-arg))
 	 (string (make-string len)))
     (read-string-as-bytes *fasl-input-stream* string)
     (base-string-to-core string)))
 
+(clone-cold-fop (fop-character-string)
+		(fop-small-character-string)
+  (bug "CHARACTER-STRING dumped by cross-compiler."))
+
 (clone-cold-fop (fop-vector)
 		(fop-small-vector)
   (let* ((size (clone-arg))
diff -urNb sbcl/src/compiler/generic/interr.lisp sbcl.char/src/compiler/generic/interr.lisp
--- sbcl/src/compiler/generic/interr.lisp	2004-10-27 18:39:59.000000000 +0200
+++ sbcl.char/src/compiler/generic/interr.lisp	2004-11-01 15:34:14.000000000 +0100
@@ -61,6 +61,10 @@
    "Object is not of type STRING.")
   (object-not-base-string
    "Object is not of type BASE-STRING.")
+  (object-not-vector-nil
+   "Object is not of type (VECTOR NIL).")
+  (object-not-character-string
+   "Object is not of type (VECTOR CHARACTER).")
   (object-not-bit-vector
    "Object is not of type BIT-VECTOR.")
   (object-not-array
diff -urNb sbcl/src/compiler/generic/late-type-vops.lisp sbcl.char/src/compiler/generic/late-type-vops.lisp
--- sbcl/src/compiler/generic/late-type-vops.lisp	2004-10-27 18:39:59.000000000 +0200
+++ sbcl.char/src/compiler/generic/late-type-vops.lisp	2004-11-01 15:34:14.000000000 +0100
@@ -66,7 +66,8 @@
 
 (!define-type-vops simple-string-p check-simple-string nil
     object-not-simple-string-error
-  (simple-base-string-widetag simple-array-nil-widetag))
+  (simple-character-string-widetag
+   simple-base-string-widetag simple-array-nil-widetag))
 
 (macrolet
     ((define-simple-array-type-vops ()
@@ -109,11 +110,14 @@
   (funcallable-instance-header-widetag))
 
 (!define-type-vops array-header-p nil nil nil
-  (simple-array-widetag complex-base-string-widetag complex-bit-vector-widetag
+  (simple-array-widetag
+   complex-character-string-widetag
+   complex-base-string-widetag complex-bit-vector-widetag
    complex-vector-widetag complex-array-widetag complex-vector-nil-widetag))
 
 (!define-type-vops stringp check-string nil object-not-string-error
-  (simple-base-string-widetag complex-base-string-widetag
+  (simple-character-string-widetag complex-character-string-widetag
+   simple-base-string-widetag complex-base-string-widetag
    simple-array-nil-widetag complex-vector-nil-widetag))
 
 (!define-type-vops base-string-p check-base-string nil object-not-base-string-error
@@ -127,6 +131,10 @@
     object-not-vector-nil-error
   (simple-array-nil-widetag complex-vector-nil-widetag))
 
+(!define-type-vops character-string-p check-character-string nil
+    object-not-character-string-error
+  (simple-character-string-widetag complex-character-string-widetag))
+
 (!define-type-vops vectorp check-vector nil object-not-vector-error
   (complex-vector-widetag .
    #.(append
diff -urNb sbcl/src/compiler/generic/vm-array.lisp sbcl.char/src/compiler/generic/vm-array.lisp
--- sbcl/src/compiler/generic/vm-array.lisp	2004-10-27 18:40:00.000000000 +0200
+++ sbcl.char/src/compiler/generic/vm-array.lisp	2004-11-01 15:34:14.000000000 +0100
@@ -64,13 +64,17 @@
 	 (nil #:mu 0 simple-array-nil
 	      :complex-typecode #.sb!vm:complex-vector-nil-widetag
 	      :importance 0)
-	 (character ,(code-char 0) 8 simple-base-string
+	 (base-char ,(code-char 0) 8 simple-base-string
 		    ;; (SIMPLE-BASE-STRINGs are stored with an extra
 		    ;; trailing #\NULL for convenience in calling out
 		    ;; to C.)
 		    :n-pad-elements 1
 	            :complex-typecode #.sb!vm:complex-base-string-widetag
 	            :importance 17)
+	 (character ,(code-char 0) 32 simple-character-string
+		    :n-pad-elements 1
+	            :complex-typecode #.sb!vm:complex-character-string-widetag
+	            :importance 17)
 	 (single-float 0.0f0 32 simple-array-single-float
 	  :importance 6)
 	 (double-float 0.0d0 64 simple-array-double-float
diff -urNb sbcl/src/compiler/generic/vm-fndb.lisp sbcl.char/src/compiler/generic/vm-fndb.lisp
--- sbcl/src/compiler/generic/vm-fndb.lisp	2004-08-10 17:38:13.000000000 +0200
+++ sbcl.char/src/compiler/generic/vm-fndb.lisp	2004-11-01 15:34:14.000000000 +0100
@@ -22,6 +22,7 @@
 	   complex-vector-p
 	   base-char-p %standard-char-p %instancep
 	   base-string-p simple-base-string-p
+	   character-string-p simple-character-string-p
 	   array-header-p
 	   simple-array-p simple-array-nil-p vector-nil-p
 	   simple-array-unsigned-byte-2-p
diff -urNb sbcl/src/compiler/generic/vm-tran.lisp sbcl.char/src/compiler/generic/vm-tran.lisp
--- sbcl/src/compiler/generic/vm-tran.lisp	2004-10-27 18:40:00.000000000 +0200
+++ sbcl.char/src/compiler/generic/vm-tran.lisp	2004-11-01 15:34:14.000000000 +0100
@@ -49,6 +49,7 @@
 	(give-up-ir1-transform)
 	`(etypecase string
 	  ((simple-array character (*)) (data-vector-ref string index))
+	  ((simple-array base-char (*)) (data-vector-ref string index))
 	  ((simple-array nil (*)) (data-vector-ref string index))))))
 
 (deftransform hairy-data-vector-ref ((array index) (array t) *)
@@ -99,6 +100,8 @@
 	`(etypecase string
 	  ((simple-array character (*))
 	   (data-vector-set string index new-value))
+	  ((simple-array base-char (*))
+	   (data-vector-set string index new-value))
 	  ((simple-array nil (*))
 	   (data-vector-set string index new-value))))))
 
diff -urNb sbcl/src/compiler/generic/vm-typetran.lisp sbcl.char/src/compiler/generic/vm-typetran.lisp
--- sbcl/src/compiler/generic/vm-typetran.lisp	2004-10-27 18:40:00.000000000 +0200
+++ sbcl.char/src/compiler/generic/vm-typetran.lisp	2004-11-01 15:34:14.000000000 +0100
@@ -19,6 +19,7 @@
 ;;; They shouldn't be used explicitly.
 (define-type-predicate base-string-p base-string)
 (define-type-predicate bignump bignum)
+(define-type-predicate character-string-p (vector character))
 (define-type-predicate complex-double-float-p (complex double-float))
 (define-type-predicate complex-single-float-p (complex single-float))
 #!+long-float
@@ -92,6 +93,7 @@
 (define-type-predicate simple-array-complex-long-float-p
 		       (simple-array (complex long-float) (*)))
 (define-type-predicate simple-base-string-p simple-base-string)
+(define-type-predicate simple-character-string-p (simple-array character (*)))
 (define-type-predicate system-area-pointer-p system-area-pointer)
 (define-type-predicate unsigned-byte-32-p (unsigned-byte 32))
 (define-type-predicate signed-byte-32-p (signed-byte 32))
diff -urNb sbcl/src/compiler/ppc/array.lisp sbcl.char/src/compiler/ppc/array.lisp
--- sbcl/src/compiler/ppc/array.lisp	2004-10-27 18:40:00.000000000 +0200
+++ sbcl.char/src/compiler/ppc/array.lisp	2004-11-01 15:34:14.000000000 +0100
@@ -111,9 +111,10 @@
        (:result-types ,element-type)))))
   (def-data-vector-frobs simple-base-string byte-index
     character character-reg)
+  (def-data-vector-frobs simple-character-string word-index
+    character character-reg)
   (def-data-vector-frobs simple-vector word-index
     * descriptor-reg any-reg)
-
   (def-data-vector-frobs simple-array-unsigned-byte-7 byte-index
     positive-fixnum unsigned-reg)
   (def-data-vector-frobs simple-array-unsigned-byte-8 byte-index
diff -urNb sbcl/src/compiler/seqtran.lisp sbcl.char/src/compiler/seqtran.lisp
--- sbcl/src/compiler/seqtran.lisp	2004-11-01 15:33:52.000000000 +0100
+++ sbcl.char/src/compiler/seqtran.lisp	2004-11-01 15:34:14.000000000 +0100
@@ -712,16 +712,32 @@
 			    sb!vm:n-byte-bits)))
      string1))
 
+;;; FIXME: OAOO (should be shared with above, and probably
+;;; automatically generated from SAETP).
+(deftransform replace ((string1 string2 &key (start1 0) (start2 0)
+				end1 end2)
+		       ((simple-array character (*))
+                        (simple-array character (*))
+                        &rest t)
+		       *
+		       ;; FIXME: consider replacing this policy test
+		       ;; with some tests for the STARTx and ENDx
+		       ;; indices being valid, conditional on high
+		       ;; SAFETY code.
+		       ;;
+		       ;; FIXME: It turns out that this transform is
+		       ;; critical for the performance of string
+		       ;; streams.  Make this more explicit.
+		       :policy (< (max safety space) 3))
+  `(sb!impl::simple-character-string-replace-from-simple-character-string*
+    string1 string2 start1 end1 start2 end2))
+
 ;;; FIXME: this would be a valid transform for certain excluded cases:
 ;;;   * :TEST 'CHAR= or :TEST #'CHAR=
 ;;;   * :TEST 'EQL   or :TEST #'EQL
 ;;;   * :FROM-END NIL (or :FROM-END non-NIL, with a little ingenuity)
-;;;
-;;; also, it should be noted that there's nothing much in this
-;;; transform (as opposed to the ones for REPLACE and CONCATENATE)
-;;; that particularly limits it to SIMPLE-BASE-STRINGs.
 (deftransform search ((pattern text &key (start1 0) (start2 0) end1 end2)
-		      (simple-base-string simple-base-string &rest t)
+		      (simple-string simple-string &rest t)
 		      *
 		      :policy (> speed (max space safety)))
   `(block search
@@ -747,7 +763,7 @@
 (deftransform concatenate ((rtype &rest sequences)
 			   (t &rest (or simple-base-string
 					(simple-array nil (*))))
-			   simple-base-string
+			   (simple-array base-string (*))
 			   :policy (< safety 3))
   (loop for rest-seqs on sequences
         for n-seq = (gensym "N-SEQ")
diff -urNb sbcl/src/compiler/target-dump.lisp sbcl.char/src/compiler/target-dump.lisp
--- sbcl/src/compiler/target-dump.lisp	2004-09-08 20:17:37.000000000 +0200
+++ sbcl.char/src/compiler/target-dump.lisp	2004-11-01 15:34:14.000000000 +0100
@@ -13,6 +13,21 @@
 
 (in-package "SB!FASL")
 
+;;; a helper function shared by DUMP-SIMPLE-CHARACTER-STRING and
+;;; DUMP-SYMBOL (in the target compiler: the cross-compiler uses the
+;;; portability knowledge and always dumps BASE-STRINGS).
+(defun dump-characters-of-string (s fasl-output)
+  (declare (type string s) (type fasl-output fasl-output))
+  (dovector (c s)
+    (dump-word (char-code c) fasl-output))
+  (values))
+
+(defun dump-simple-character-string (s file)
+  (declare (type (simple-array character (*)) s))
+  (dump-fop* (length s) fop-small-character-string fop-character-string file)
+  (dump-characters-of-string s file)
+  (values))
+
 ;;; Dump the first N bytes of VEC out to FILE. VEC is some sort of unboxed
 ;;; vector-like thing that we can BLT from.
 (defun dump-raw-bytes (vec n fasl-output)
diff -urNb sbcl/src/compiler/typetran.lisp sbcl.char/src/compiler/typetran.lisp
--- sbcl/src/compiler/typetran.lisp	2004-10-27 23:36:45.000000000 +0200
+++ sbcl.char/src/compiler/typetran.lisp	2004-11-01 15:34:14.000000000 +0100
@@ -115,7 +115,6 @@
 ;;; just expand all its operations into toplevel code?
 (defun !define-standard-type-predicates ()
   (define-type-predicate arrayp array)
-  ; (The ATOM predicate is handled separately as (NOT CONS).)
   (define-type-predicate bit-vector-p bit-vector)
   (define-type-predicate characterp character)
   (define-type-predicate compiled-function-p compiled-function)
@@ -142,12 +141,10 @@
   (define-type-predicate vectorp vector))
 (!define-standard-type-predicates)
 
-;;;; transforms for type predicates not implemented primitively
-;;;;
-;;;; See also VM dependent transforms.
-
 (define-source-transform atom (x)
   `(not (consp ,x)))
+(define-source-transform base-char-p (x)
+  `(typep ,x 'base-char))
 
 ;;;; TYPEP source transform
 
diff -urNb sbcl/src/compiler/x86/array.lisp sbcl.char/src/compiler/x86/array.lisp
--- sbcl/src/compiler/x86/array.lisp	2004-10-27 18:40:01.000000000 +0200
+++ sbcl.char/src/compiler/x86/array.lisp	2004-11-01 15:34:14.000000000 +0100
@@ -1248,7 +1248,7 @@
   (:results (value :scs (character-reg)))
   (:result-types character)
   (:generator 5
-    (inst mov value
+    (inst movzx value
 	  (make-ea :byte :base object :index index :scale 1
 		   :disp (- (* vector-data-offset n-word-bytes)
 			    other-pointer-lowtag)))))
@@ -1262,7 +1262,7 @@
   (:results (value :scs (character-reg)))
   (:result-types character)
   (:generator 4
-    (inst mov value
+    (inst movzx value
 	  (make-ea :byte :base object
 		   :disp (- (+ (* vector-data-offset n-word-bytes) index)
 			    other-pointer-lowtag)))))
@@ -1272,32 +1272,48 @@
   (:policy :fast-safe)
   (:args (object :scs (descriptor-reg) :to (:eval 0))
 	 (index :scs (unsigned-reg) :to (:eval 0))
-	 (value :scs (character-reg) :target result))
+	 (value :scs (character-reg) :target eax))
   (:arg-types simple-base-string positive-fixnum character)
+  (:temporary (:sc character-reg :offset eax-offset :target result
+                   :from (:argument 2) :to (:result 0))
+              eax)
   (:results (result :scs (character-reg)))
   (:result-types character)
   (:generator 5
+    (move eax value)
     (inst mov (make-ea :byte :base object :index index :scale 1
 		       :disp (- (* vector-data-offset n-word-bytes)
 				other-pointer-lowtag))
-	  value)
-    (move result value)))
+	  al-tn)
+    (move result eax)))
 
-(define-vop (data-vector-set/simple-base-string-c)
+(define-vop (data-vector-set-c/simple-base-string)
   (:translate data-vector-set)
   (:policy :fast-safe)
   (:args (object :scs (descriptor-reg) :to (:eval 0))
 	 (value :scs (character-reg)))
   (:info index)
   (:arg-types simple-base-string (:constant (signed-byte 30)) character)
+  (:temporary (:sc unsigned-reg :offset eax-offset :target result
+                   :from (:argument 1) :to (:result 0))
+              eax)
   (:results (result :scs (character-reg)))
   (:result-types character)
   (:generator 4
+    (move eax value)
    (inst mov (make-ea :byte :base object
 		      :disp (- (+ (* vector-data-offset n-word-bytes) index)
 			       other-pointer-lowtag))
-	 value)
-   (move result value)))
+          al-tn)
+    (move result eax)))
+
+(define-full-reffer data-vector-ref/simple-character-string
+    simple-character-string vector-data-offset other-pointer-lowtag
+    (character-reg) character data-vector-ref)
+
+(define-full-setter data-vector-ref/simple-character-string
+    simple-character-string vector-data-offset other-pointer-lowtag
+    (character-reg) character data-vector-set)
 
 ;;; signed-byte-8
 
diff -urNb sbcl/src/compiler/x86/char.lisp sbcl.char/src/compiler/x86/char.lisp
--- sbcl/src/compiler/x86/char.lisp	2004-10-27 18:40:01.000000000 +0200
+++ sbcl.char/src/compiler/x86/char.lisp	2004-11-01 15:34:14.000000000 +0100
@@ -15,36 +15,32 @@
 
 ;;; Move a tagged char to an untagged representation.
 (define-vop (move-to-character)
-  (:args (x :scs (any-reg control-stack) :target al))
-  (:temporary (:sc byte-reg :offset al-offset
-		   :from (:argument 0) :to (:eval 0)) al)
-  (:ignore al)
-  (:temporary (:sc byte-reg :offset ah-offset :target y
-		   :from (:argument 0) :to (:result 0)) ah)
-  (:results (y :scs (character-reg character-stack)))
+  (:args (x :scs (any-reg descriptor-reg) :target y
+            :load-if (not (location= x y))))
+  (:results (y :scs (character-reg)
+               :load-if (not (location= x y))))
   (:note "character untagging")
   (:generator 1
-    (move eax-tn x)
-    (move y ah)))
+    (move y x)
+    (inst shr y n-widetag-bits)))
 (define-move-vop move-to-character :move
-  (any-reg control-stack) (character-reg character-stack))
+  (any-reg) (character-reg))
 
 ;;; Move an untagged char to a tagged representation.
 (define-vop (move-from-character)
-  (:args (x :scs (character-reg character-stack) :target ah))
-  (:temporary (:sc byte-reg :offset al-offset :target y
-		   :from (:argument 0) :to (:result 0)) al)
-  (:temporary (:sc byte-reg :offset ah-offset
-		   :from (:argument 0) :to (:result 0)) ah)
-  (:results (y :scs (any-reg descriptor-reg control-stack)))
+  (:args (x :scs (character-reg)))
+  (:results (y :scs (any-reg descriptor-reg)))
   (:note "character tagging")
   (:generator 1
-    (move ah x)				; Maybe move char byte.
-    (inst mov al character-widetag)	; x86 to type bits
-    (inst and eax-tn #xffff)		; Remove any junk bits.
-    (move y eax-tn)))
+    ;; FIXME: is this inefficient?  Is there a better way of writing
+    ;; it?  (fixnum tagging is done with LEA).  We can't use SHL
+    ;; because we either scribble over the source register or briefly
+    ;; have a non-descriptor in a descriptor register, unless we
+    ;; introduce a temporary.
+    (inst imul y x (ash 1 n-widetag-bits))
+    (inst or y character-widetag)))
 (define-move-vop move-from-character :move
-  (character-reg character-stack) (any-reg descriptor-reg control-stack))
+  (character-reg) (any-reg descriptor-reg))
 
 ;;; Move untagged character values.
 (define-vop (character-move)
@@ -74,9 +70,10 @@
       (character-reg
        (move y x))
       (character-stack
-       (inst mov
-	     (make-ea :byte :base fp :disp (- (* (1+ (tn-offset y)) 4)))
-	     x)))))
+       ;; copied blindly.  No idea if it's right
+       (if (= (tn-offset fp) esp-offset)
+	   (storew x fp (tn-offset y))	; c-call
+	   (storew x fp (- (1+ (tn-offset y)))))))))
 (define-move-vop move-character-arg :move-arg
   (any-reg character-reg) (character-reg))
 
@@ -95,21 +92,17 @@
   (:results (res :scs (unsigned-reg)))
   (:result-types positive-fixnum)
   (:generator 1
-    (inst movzx res ch)))
+    (inst mov res ch)))
 
 (define-vop (code-char)
   (:translate code-char)
   (:policy :fast-safe)
-  (:args (code :scs (unsigned-reg unsigned-stack) :target eax))
+  (:args (code :scs (unsigned-reg unsigned-stack)))
   (:arg-types positive-fixnum)
-  (:temporary (:sc unsigned-reg :offset eax-offset :target res
-		   :from (:argument 0) :to (:result 0))
-	      eax)
   (:results (res :scs (character-reg)))
   (:result-types character)
   (:generator 1
-    (move eax code)
-    (move res al-tn)))
+    (inst mov res code)))
 
 ;;; comparison of CHARACTERs
 (define-vop (character-compare)
diff -urNb sbcl/src/compiler/x86/vm.lisp sbcl.char/src/compiler/x86/vm.lisp
--- sbcl/src/compiler/x86/vm.lisp	2004-11-01 15:33:53.000000000 +0100
+++ sbcl.char/src/compiler/x86/vm.lisp	2004-11-01 15:34:14.000000000 +0100
@@ -229,8 +229,8 @@
 
   ;; non-descriptor characters
   (character-reg registers
-		 :locations #.*byte-regs*
-		 :reserve-locations (#.ah-offset #.al-offset)
+		 :locations #.*dword-regs*
+;		 :reserve-locations (#.ah-offset #.al-offset)
 		 :constant-scs (immediate)
 		 :save-p t
 		 :alternate-scs (character-stack))
@@ -322,11 +322,12 @@
   (catch-block stack :element-size kludge-nondeterministic-catch-block-size))
 
 (eval-when (:compile-toplevel :load-toplevel :execute)
-(defparameter *byte-sc-names* '(character-reg byte-reg character-stack))
+(defparameter *byte-sc-names* '(byte-reg))
 (defparameter *word-sc-names* '(word-reg))
 (defparameter *dword-sc-names*
   '(any-reg descriptor-reg sap-reg signed-reg unsigned-reg control-stack
-    signed-stack unsigned-stack sap-stack single-stack constant))
+    signed-stack unsigned-stack sap-stack single-stack
+    character-reg character-stack constant))
 ;;; added by jrd. I guess the right thing to do is to treat floats
 ;;; as a separate size...
 ;;;
diff -urNb sbcl/version.lisp-expr sbcl.char/version.lisp-expr
--- sbcl/version.lisp-expr	2004-11-01 15:01:31.000000000 +0100
+++ sbcl.char/version.lisp-expr	2004-11-01 15:34:14.000000000 +0100
@@ -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.23"
+"0.8.16.character_branch"