Utility predicates for packing: UNBOUNDED-SC-P and UNBOUNDED-TN-P

[sbcl.git] / src / code / external-formats / mb-util.lisp

diff --git a/src/code/external-formats/mb-util.lisp b/src/code/external-formats/mb-util.lisp
index 0cb711d..5569a9f 100644 (file)
--- a/src/code/external-formats/mb-util.lisp
+++ b/src/code/external-formats/mb-util.lisp
@@ -150,7 +150,12 @@
                      (declare (type (or null string) invalid))
                      (cond
                        ((null invalid)
-                        (vector-push-extend (,simple-get-mb-char array pos bytes) string))
+                        (let ((thing (,simple-get-mb-char array pos bytes)))
+                          (typecase thing
+                            (character (vector-push-extend thing string))
+                            (string
+                               (dotimes (i (length thing))
+                                 (vector-push-extend (char thing i) string))))))
                        (t
                         (dotimes (i (length invalid))
                           (vector-push-extend (char invalid i) string))))
@@ -243,7 +248,15 @@
 
        ;; for fd-stream.lisp
        (define-external-format/variable-width ,aliases t
-         (mb-char-len (or (,ucs-to-mb (char-code byte)) -1))
+         ;; KLUDGE: it so happens that at present (2009-10-22) none of
+         ;; the external formats defined with
+         ;; define-multibyte-encoding can encode the unicode
+         ;; replacement character, so we hardcode the preferred
+         ;; replacement here.
+         #\?
+         (block size
+           (mb-char-len (or (,ucs-to-mb (char-code byte))
+                            (return-from size 0))))
          (let ((mb (,ucs-to-mb bits)))
            (if (null mb)
                (external-format-encoding-error stream byte)
@@ -254,7 +267,7 @@
                  (3 (setf (sap-ref-8 sap tail) (ldb (byte 8 16) mb)
                           (sap-ref-8 sap (1+ tail)) (ldb (byte 8 8) mb)
                           (sap-ref-8 sap (+ 2 tail)) (ldb (byte 8 0) mb))))))
-         (,mb-len byte)
+         (1 (,mb-len byte))
          (let* ((mb (ecase size
                       (1 byte)
                       (2 (let ((byte2 (sap-ref-8 sap (1+ head))))