From 3dd525cd0ec9f3900ff1df269a50399451516063 Mon Sep 17 00:00:00 2001
From: Kenichi Handa <handa@m17n.org>
Date: Thu, 2 Mar 2006 01:47:27 +0000
Subject: [PATCH] (ccl-embed-string): Check string length. Set special flag for
 multibyte character sequence. (ccl-compile-write-string): Don't make str
 unibyte. (ccl-compile-write-repeat): Likewise. (ccl-compile-write): If the
 character code doesn't fit in 22-bit (ccl-dump-write-const-string): Check
 special flag for multibyte character sequence.

---
 lisp/international/ccl.el | 47 +++++++++++++++++++++++----------------
 1 file changed, 28 insertions(+), 19 deletions(-)

diff --git a/lisp/international/ccl.el b/lisp/international/ccl.el
index 9078d29d942..0ee5999efbc 100644
--- a/lisp/international/ccl.el
+++ b/lisp/international/ccl.el
@@ -209,16 +209,21 @@
 ;; Embed string STR of length LEN in `ccl-program-vector' at
 ;; `ccl-current-ic'.
 (defun ccl-embed-string (len str)
-  (let ((i 0))
-    (while (< i len)
-      (ccl-embed-data (logior (ash (aref str i) 16)
-			       (if (< (1+ i) len)
-				   (ash (aref str (1+ i)) 8)
-				 0)
-			       (if (< (+ i 2) len)
-				   (aref str (+ i 2))
-				 0)))
-      (setq i (+ i 3)))))
+  (if (> len #xFFFFF)
+      (error "CCL: String too long: %d" len))
+  (if (> (string-bytes str) len)
+      (dotimes (i len)
+	(ccl-embed-data (logior #x1000000 (aref str i))))
+    (let ((i 0))
+      (while (< i len)
+	(ccl-embed-data (logior (ash (aref str i) 16)
+				(if (< (1+ i) len)
+				    (ash (aref str (1+ i)) 8)
+				  0)
+				(if (< (+ i 2) len)
+				    (aref str (+ i 2))
+				  0)))
+	(setq i (+ i 3))))))
 
 ;; Embed a relative jump address to `ccl-current-ic' in
 ;; `ccl-program-vector' at IC without altering the other bit field.
@@ -461,7 +466,6 @@
 
 ;; Compile WRITE statement with string argument.
 (defun ccl-compile-write-string (str)
-  (setq str (string-as-unibyte str))
   (let ((len (length str)))
     (ccl-embed-code 'write-const-string 1 len)
     (ccl-embed-string len str))
@@ -673,7 +677,6 @@
 	   (ccl-embed-code 'write-const-jump 0 ccl-loop-head)
 	   (ccl-embed-data arg))
 	  ((stringp arg)
-	   (setq arg (string-as-unibyte arg))
 	   (let ((len (length arg))
 		 (i 0))
 	     (ccl-embed-code 'write-string-jump 0 ccl-loop-head)
@@ -731,7 +734,9 @@
       (error "CCL: Invalid number of arguments: %s" cmd))
   (let ((rrr (nth 1 cmd)))
     (cond ((integerp rrr)
-	   (ccl-embed-code 'write-const-string 0 rrr))
+	   (if (> rrr #xFFFFF)
+	       (ccl-compile-write-string (string rrr))
+	     (ccl-embed-code 'write-const-string 0 rrr)))
 	  ((stringp rrr)
 	   (ccl-compile-write-string rrr))
 	  ((and (symbolp rrr) (vectorp (nth 2 cmd)))
@@ -1135,12 +1140,16 @@
       (insert "write \"")
       (while (< i len)
 	(let ((code (ccl-get-next-code)))
-	  (insert (format "%c" (lsh code -16)))
-	  (if (< (1+ i) len)
-	      (insert (format "%c" (logand (lsh code -8) 255))))
-	  (if (< (+ i 2) len)
-	      (insert (format "%c" (logand code 255))))
-	  (setq i (+ i 3))))
+	  (if (logand code #x1000000)
+	      (progn
+		(insert (logand code #xFFFFFF))
+		(setq i (1+ i)))
+	    (insert (format "%c" (lsh code -16)))
+	    (if (< (1+ i) len)
+		(insert (format "%c" (logand (lsh code -8) 255))))
+	    (if (< (+ i 2) len)
+		(insert (format "%c" (logand code 255))))
+	    (setq i (+ i 3)))))
       (insert "\"\n"))))
 
 (defun ccl-dump-write-array (rrr cc)