Changeset 5331

Timestamp:

Oct 9, 2006, 3:31:28 PM (18 years ago)

Author:

Gary Byers

Message:

:stream-encode/decode functions always write/read something, even if it's
a replacement character of some sort.

File:

• trunk/ccl/level-1/l1-unicode.lisp (modified) (14 diffs)

trunk/ccl/level-1/l1-unicode.lisp

@@ -39 +39 @@
   (max-units-per-char 1)                ;usually 1-4
 
-  ;; Returns NIL if the character can't be encoded, else writes it
-  ;; to the stream and returns the number of units written.
+  ;; Writes CHAR (or a replacement character if CHAR can't be encoded)
+  ;; to STREAM and returns the number of code-units written.
   stream-encode-function                ;(CHAR WRITE-FUNCTION STREAM)
   
-  ;; Returns a charcter or NIL, possibly calling a function to
-  ;; obtain the next unit from a stream-like argument
+  ;; Returns a charcter (possibly #\Replacement_Character) or :EOF.
   stream-decode-function                ;(1ST-UNIT NEXT-UNIT STREAM)
 
@@ -144 +143 @@
      (let* ((code (char-code char)))
        (declare (type (mod #x110000) code))
-       (when (< code 256)
-         (funcall write-function stream code)
-         1))))
+       (if (>= code 256)
+         (setq code (char-code #\Sub)))
+       (funcall write-function stream code)
+       1)))
   :stream-decode-function
   (nfunction
@@ -236 +236 @@
 
   :aliases '(:csASCII :cp637 :IBM637 :us :ISO646-US :ascii :ISO-ir-6)
-
   :stream-encode-function
   (nfunction
@@ -243 +242 @@
      (let* ((code (char-code char)))
        (declare (type (mod #x110000) code))
-       (when (< code 128)
-         (funcall write-function stream code)
-         1))))
+       (when (>= code 128)
+         (setq code (char-code #\Sub)))
+       (funcall write-function stream code)
+       1)))
   :stream-decode-function
   (nfunction
@@ -253 +253 @@
               (type (unsigned-byte 8) 1st-unit))
      (if (< 1st-unit 128)
-       (code-char 1st-unit))))
+       (code-char 1st-unit)
+       #\Replacement_Character)))
   :vector-encode-function
   (nfunction
@@ -434 +435 @@
                       
        (declare (type (mod #x110000) code))
-       (when c2
-         (funcall write-function stream code)
-         1))))
+       (funcall write-function stream (or c2 (char-code #\Sub)))
+       1)))
   :stream-decode-function
   (nfunction
@@ -637 +637 @@
                        (svref *unicode-2d8-2e0-to-iso8859-3*
                               (the fixnum (- code #x2d8)))))))
-                      
        (declare (type (mod #x110000) code))
-       (when c2
-         (funcall write-function stream code)
-         1))))
+       (funcall write-function stream (or c2 (char-code #\Sub)))
+       1)))
   :stream-decode-function
   (nfunction
@@ -852 +850 @@
                       
        (declare (type (mod #x110000) code))
-       (when c2
-         (funcall write-function stream code)
-         1))))
+       (funcall write-function stream (or c2 (char-code #\Sub)))
+       1)))
   :stream-decode-function
   (nfunction
@@ -1031 +1028 @@
                       (logior
                        (the fixnum (ash (the fixnum (logand #x1f 1st-unit)) 6))
-                       (the fixnum (logxor s1 #x80)))))
-                   (let* ((s2 (funcall next-unit-function stream)))                 
+                       (the fixnum (logxor s1 #x80))))
+                     #\Replacement_Character)
+                   (let* ((s2 (funcall next-unit-function stream)))
                      (if (eq s2 :eof)
                        s2
@@ -1051 +1049 @@
                                                        (ash (the fixnum (logand s1 #x3f))
                                                             6))
-                                                     (the fixnum (logand s2 #x3f))))))))
+                                                     (the fixnum (logand s2 #x3f)))))))
+                             #\Replacement_Character)
                            (if (< 1st-unit #xf8)
                              (let* ((s3 (funcall next-unit-function stream)))
@@ -1075 +1074 @@
                                           (the fixnum
                                             (ash (the fixnum (logxor s2 #x80)) 6))
-                                          (the fixnum (logxor s3 #x80)))))))))))))))))))))))
+                                          (the fixnum (logxor s3 #x80))))))
+                                     #\Replacement_Character))))
+                             #\Replacement_Character)))))))))))))
     :vector-encode-function
     (nfunction
@@ -1382 +1383 @@
                                                            (- 1st-unit #xd800))
                                                          10))
-                            (the (unsigned-byte 10) (- 2nd-unit #xdc00))))))))))))
+                            (the (unsigned-byte 10) (- 2nd-unit #xdc00)))))
+              #\Replacement_Character)))))))
 
 
@@ -1975 +1977 @@
   (let* ((code (char-code char)))
     (declare (type (mod #x110000) code))
-    (if (< code #x10000)
-      (progn
-        (funcall write-function stream code)
-        1))))
+    (if (>= code #x10000)
+      (setq code (char-code #\Replacement_Character)))
+    (funcall write-function stream code)
+    1))
 
 (defun ucs-2-stream-decode (1st-unit next-unit-function stream)
@@ -1984 +1986 @@
            (ignore next-unit-function stream))
   ;; CODE-CHAR returns NIL on either half of a surrogate pair.
-  (code-char 1st-unit))
+  (or (code-char 1st-unit)
+      #\Replacement_Character))