0.8.16.24:

	What I think are the final commonalities between the current tree
	and the soon-to-be-added #!+sb-unicode build option.

	This patch was brought to you by character_branch and much puzzling
	over diffs.

diff --git a/src/code/fd-stream.lisp b/src/code/fd-stream.lisp
index a6fdf1a..528bd52 100644 (file)
--- a/src/code/fd-stream.lisp
+++ b/src/code/fd-stream.lisp
@@ -1811,7 +1811,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 --git a/src/code/fop.lisp b/src/code/fop.lisp
index fab38c4..7f58e99 100644 (file)
--- a/src/code/fop.lisp
+++ b/src/code/fop.lisp
@@ -123,11 +123,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))
@@ -344,9 +341,9 @@
 \f
 ;;;; 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))
 
@@ -639,7 +636,7 @@ bug.~:@>")
   (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 --git a/src/code/run-program.lisp b/src/code/run-program.lisp
index cc5a595..408b050 100644 (file)
--- a/src/code/run-program.lisp
+++ b/src/code/run-program.lisp
@@ -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 --git a/src/compiler/dump.lisp b/src/compiler/dump.lisp
index 453daf4..a66ac81 100644 (file)
--- a/src/compiler/dump.lisp
+++ b/src/compiler/dump.lisp
@@ -600,7 +600,9 @@
        (t
         (unless *cold-load-dump*
           (dump-fop 'fop-normal-load file))
-        (dump-simple-string (package-name pkg) file)
+        (dump-simple-base-string
+          (coerce (package-name pkg) 'simple-base-string)
+          file)
         (dump-fop 'fop-package file)
         (unless *cold-load-dump*
           (dump-fop 'fop-maybe-cold-load file))
@@ -733,7 +735,7 @@
     (typecase simple-version
       (simple-base-string
        (unless (equal-check-table x file)
-        (dump-simple-string simple-version file)
+        (dump-simple-base-string simple-version file)
         (equal-save-object x file)))
       (simple-vector
        (dump-simple-vector simple-version file)
@@ -903,23 +905,31 @@
 \f
 ;;; 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 +979,7 @@
                      file)
           (dump-word pname-length file)))
 
-    (dump-characters-of-string pname file)
+    (dump-base-chars-of-string pname file)
 
     (unless *cold-load-dump*
       (setf (gethash s (fasl-output-eq-table file))

diff --git a/src/compiler/generic/genesis.lisp b/src/compiler/generic/genesis.lisp
index f9d6614..674db25 100644 (file)
--- a/src/compiler/generic/genesis.lisp
+++ b/src/compiler/generic/genesis.lisp
@@ -2099,8 +2099,8 @@ core and return a descriptor to it."
 \f
 ;;;; 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)

diff --git a/version.lisp-expr b/version.lisp-expr
index cfd340d..9678c2e 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.23"
+"0.8.16.24"