1
0
mirror of https://git.savannah.gnu.org/git/emacs.git synced 2024-12-16 09:50:25 +00:00

(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.
This commit is contained in:
Kenichi Handa 2006-03-02 01:47:27 +00:00
parent cf2f4bcfa7
commit 3dd525cd0e

View File

@ -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)