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:
parent
cf2f4bcfa7
commit
3dd525cd0e
@ -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)
|
||||
|
Loading…
Reference in New Issue
Block a user