(eval-and-compile
(defconst utf-16-decode-ucs
`((if (r5 >= 0)
((r0 = (r1 < #xDC00))
(if ((r1 >= #xE000) | r0)
((r0 = r5)
(call ccl-mule-utf-untrans))
((r1 -= #xDC00)
(r1 += (((r5 - #xD800) << 10) + #x10000))))
(r5 = -1)))
(if (r1 < 128)
(r0 = ,(charset-id 'ascii))
((lookup-integer utf-subst-table-for-decode r1 r3)
(if r7 ((r0 = r1) (r1 = r3))
(if (r1 < 160)
(r0 = ,(charset-id 'eight-bit-control))
(if (r1 < 256)
((r0 = ,(charset-id 'latin-iso8859-1))
(r1 -= 128))
(if (r1 < #x2500)
((r0 = ,(charset-id 'mule-unicode-0100-24ff))
(r1 -= #x100)
(r2 = (((r1 / 96) + 32) << 7))
(r1 %= 96)
(r1 += (r2 + 32)))
(if (r1 < #x3400)
((r0 = ,(charset-id 'mule-unicode-2500-33ff))
(r1 -= #x2500)
(r2 = (((r1 / 96) + 32) << 7))
(r1 %= 96)
(r1 += (r2 + 32)))
(if (r1 < #xD800)
((r0 = r1)
(call ccl-mule-utf-untrans)
(r5 = -1)
(r0 = -1))
(if (r1 < #xDC00)
((r5 = r1)
(r0 = -1))
(if (r1 < #xE000)
((r0 = r1)
(call ccl-mule-utf-untrans)
(r5 = -1)
(r0 = -1))
(if (r1 < #x10000)
((r0 = ,(charset-id 'mule-unicode-e000-ffff))
(r1 -= #xE000)
(r2 = (((r1 / 96) + 32) << 7))
(r1 %= 96)
(r1 += (r2 + 32)))
((r0 = r1)
(call ccl-mule-utf-untrans)
(r5 = -1)
(r0 = -1)))))))))))))))
(defconst utf-16le-decode-loop
`((r5 = -1)
(loop
(r3 = -1)
(read r3 r4)
(r1 = (r4 <8 r3))
,@utf-16-decode-ucs
(if (r0 >= 0)
((translate-character utf-translation-table-for-decode r0 r1)
(write-multibyte-character r0 r1)))
(repeat))))
(defconst utf-16be-decode-loop
`((r5 = -1)
(loop
(r3 = -1)
(read r3 r4)
(r1 = (r3 <8 r4))
,@utf-16-decode-ucs
(if (r0 >= 0)
((translate-character utf-translation-table-for-decode r0 r1)
(write-multibyte-character r0 r1)))
(repeat))))
)
(define-ccl-program ccl-decode-mule-utf-16le
`(2 ,utf-16le-decode-loop
((if (r5 >= 0)
((r0 = r5)
(call ccl-mule-utf-untrans)))
(if (r3 < 0)
nil
((if (r3 < #xA0)
(r0 = ,(charset-id 'eight-bit-control))
(r0 = ,(charset-id 'eight-bit-graphic)))
(write-multibyte-character r0 r3)))))
"Decode UTF-16LE (little endian without signature bytes).
Basic decoding is done into the charsets ascii, latin-iso8859-1 and
mule-unicode-*. Un-representable Unicode characters are decoded as
U+fffd. The result is run through the translation-table named
`utf-translation-table-for-decode'.")
(define-ccl-program ccl-decode-mule-utf-16be
`(2 ,utf-16be-decode-loop
((if (r5 >= 0)
((r0 = r5)
(call ccl-mule-utf-untrans)))
(if (r3 >= 0)
((r0 = r3)
(call ccl-mule-utf-untrans)))))
"Decode UTF-16BE (big endian without signature bytes).
Basic decoding is done into the charsets ascii, latin-iso8859-1 and
mule-unicode-*. Un-representable Unicode characters are
decoded as U+fffd. The result is run through the translation-table of
name `utf-translation-table-for-decode'.")
(define-ccl-program ccl-decode-mule-utf-16le-with-signature
`(2
((r3 = -1)
(read r3 r4)
,@utf-16le-decode-loop)
(if (r3 >= 0)
((r0 = r3)
(call ccl-mule-utf-untrans))))
"Like ccl-decode-utf-16le but skip the first 2-byte BOM.")
(define-ccl-program ccl-decode-mule-utf-16be-with-signature
`(2
((r3 = -1)
(read r3 r4)
,@utf-16be-decode-loop)
(if (r3 >= 0)
((r0 = r3)
(call ccl-mule-utf-untrans))))
"Like ccl-decode-utf-16be but skip the first 2-byte BOM.")
(define-ccl-program ccl-decode-mule-utf-16
`(2
((r3 = -1)
(read r3 r4)
(r1 = (r3 <8 r4))
(r5 = -1)
(if (r1 == #xFFFE)
(,@utf-16-decode-ucs
(write-multibyte-character r0 r1)
,@utf-16le-decode-loop)
((if (r1 == #xFEFF)
((r1 = #xFFFF)
,@utf-16-decode-ucs
(write-multibyte-character r0 r1))
(,@utf-16-decode-ucs
(if (r0 >= 0)
((translate-character utf-translation-table-for-decode r0 r1)
(write-multibyte-character r0 r1)))))
,@utf-16be-decode-loop)))
(if (r3 >= 0)
((r0 = r3)
(call ccl-mule-utf-untrans))))
"Like ccl-decode-utf-16be/le but check the first BOM.")
(makunbound 'utf-16-decode-ucs) (makunbound 'utf-16le-decode-loop)
(makunbound 'utf-16be-decode-loop)
(define-ccl-program ccl-mule-utf-16-encode-untrans
`(0
((r2 = -1)
(read-multibyte-character r5 r6)
(r0 = (r5 != ,(charset-id 'eight-bit-control)))
(if ((r5 != ,(charset-id 'eight-bit-graphic)) & r0)
((r2 = r1)
(r3 = -1)
(r1 = -1)
(end)))
(r3 = -1)
(r2 = r6)
(if (r1 <= #xE0)
((r2 &= #x3F)
(r2 |= ((r1 & #x1F) << 6))
(r1 = -1)
(r5 = -1)
(end)))
(read-multibyte-character r5 r6)
(r0 = (r5 != ,(charset-id 'eight-bit-control)))
(if ((r5 != ,(charset-id 'eight-bit-graphic)) & r0)
((end)))
(if (r1 < #xF0) ((r1 = ((r1 & #x0F) << 12))
(r1 |= ((r2 & #x3F) << 6))
(r1 |= (r6 & #x3F))
(r2 = -1)
(r5 = -1)
(end)))
(r3 = r6)
(read-multibyte-character r5 r6)
(r0 = (r5 != ,(charset-id 'eight-bit-control)))
(if ((r5 != ,(charset-id 'eight-bit-graphic)) & r0)
(end))
(r1 = ((r1 & #x07) << 18))
(r1 |= ((r2 & #x3F) << 12))
(r1 |= ((r3 & #x3F) << 6))
(r1 |= (r6 & #x3F))
(r2 = -1)
(r5 = -1)
(end))
(if (r1 >= 0)
((write r1)
(if (r2 >= 0)
((write r2)
(if (r3 >= 0)
(write r3))))))))
(eval-and-compile
(defconst utf-16-decode-to-ucs
`((if (r5 < 0)
(read-multibyte-character r0 r1)
((r0 = r5)
(r1 = r6)
(r5 = -1)))
(lookup-character utf-subst-table-for-encode r0 r1)
(r2 = -1)
(if (r7 > 0)
(r1 = r0)
((translate-character utf-translation-table-for-encode r0 r1)
(if (r0 == ,(charset-id 'ascii))
nil
(if (r0 == ,(charset-id 'latin-iso8859-1))
(r1 += 128)
(if (r0 == ,(charset-id 'eight-bit-control))
nil
(if (r0 == ,(charset-id 'eight-bit-graphic))
(call ccl-mule-utf-16-encode-untrans)
((r2 = ((r1 & #x7f) - 32))
(r3 = ((((r1 >> 7) - 32) * 96) + r2))
(r2 = -1)
(r5 = -1)
(if (r0 == ,(charset-id 'mule-unicode-0100-24ff))
(r1 = (r3 + #x100))
(if (r0 == ,(charset-id 'mule-unicode-2500-33ff))
(r1 = (r3 + #x2500))
(if (r0 == ,(charset-id 'mule-unicode-e000-ffff))
(r1 = (r3 + #xe000))
(r1 = #xfffd)))))))))))))
(defconst utf-16le-encode-loop
`((r5 = -1)
(loop
,@utf-16-decode-to-ucs
(if (r1 >= #x10000)
((r1 -= #x10000)
(r0 = ((r1 >> 10) + #xD800))
(write (r0 & 255))
(write (r0 >> 8))
(r1 = ((r1 & #x3FF) + #xDC00))))
(if (r1 >= 0)
((write (r1 & 255))
(write (r1 >> 8))))
(if (r2 >= 0)
((write r2)
(if (r3 >= 0)
(write r3))))
(repeat))))
(defconst utf-16be-encode-loop
`((r5 = -1)
(loop
,@utf-16-decode-to-ucs
(if (r1 >= #x10000)
((r1 -= #x10000)
(r0 = ((r1 >> 10) + #xD800))
(write (r0 >> 8))
(write (r0 & 255))
(r1 = ((r1 & #x3FF) + #xDC00))))
(if (r1 >= 0)
((write (r1 >> 8))
(write (r1 & 255))))
(if (r2 >= 0)
((write r2)
(if (r3 >= 0)
(write r3))))
(repeat))))
)
(define-ccl-program ccl-encode-mule-utf-16le
`(2
,utf-16le-encode-loop)
"Encode to UTF-16LE (little endian without signature).
Characters from the charsets ascii, eight-bit-control,
eight-bit-graphic, latin-iso8859-1 and mule-unicode-* are encoded
after translation through the translation-table of name
`utf-translation-table-for-encode'.
Others are encoded as U+FFFD.")
(define-ccl-program ccl-encode-mule-utf-16be
`(2
,utf-16be-encode-loop)
"Encode to UTF-16BE (big endian without signature).
Characters from the charsets ascii, eight-bit-control,
eight-bit-graphic, latin-iso8859-1 and mule-unicode-* are encoded
after translation through the translation-table named
`utf-translation-table-for-encode'.
Others are encoded as U+FFFD.")
(define-ccl-program ccl-encode-mule-utf-16le-with-signature
`(2
((write #xFF)
(write #xFE)
,@utf-16le-encode-loop))
"Encode to UTF-16 (little endian with signature).
Characters from the charsets ascii, eight-bit-control,
eight-bit-graphic, latin-iso8859-1 and mule-unicode-* are encoded
after translation through the translation-table of name
`utf-translation-table-for-encode'.
Others are encoded as U+FFFD.")
(define-ccl-program ccl-encode-mule-utf-16be-with-signature
`(2
((write #xFE)
(write #xFF)
,@utf-16be-encode-loop))
"Encode to UTF-16 (big endian with signature).
Characters from the charsets ascii, eight-bit-control,
eight-bit-graphic, latin-iso8859-1 and mule-unicode-* are encoded
after translation through the translation-table named
`utf-translation-table-for-encode'.
Others are encoded as U+FFFD.")
(makunbound 'utf-16-decode-to-ucs)
(makunbound 'utf-16le-encode-loop)
(makunbound 'utf-16be-encode-loop)
(defun mule-utf-16-post-read-conversion (length)
(when (> length 0)
(setq length (utf-8-post-read-conversion length))
(let ((char (following-char)))
(cond ((= char (decode-char 'ucs #xFFFE))
(delete-char 1)
(setq last-coding-system-used
(coding-system-change-text-conversion
last-coding-system-used
'mule-utf-16le-with-signature))
(setq length (1- length)))
((= char (decode-char 'ucs #xFFFF))
(delete-char 1)
(setq last-coding-system-used
(coding-system-change-text-conversion
last-coding-system-used
'mule-utf-16be-with-signature))
(setq length (1- length)))
(t
(setq last-coding-system-used 'mule-utf-16be)))))
length)
(let ((doc "
It supports Unicode characters of these ranges:
U+0000..U+33FF, U+E000..U+FFFF.
They correspond to these Emacs character sets:
ascii, latin-iso8859-1, mule-unicode-0100-24ff,
mule-unicode-2500-33ff, mule-unicode-e000-ffff
On decoding (e.g. reading a file), Unicode characters not in the above
ranges are decoded as U+FFFD, effectively corrupting the data
if they are re-encoded.
On encoding (e.g. writing a file), Emacs characters not belonging to
any of the character sets listed above are encoded into the byte
sequence representing U+FFFD (REPLACEMENT CHARACTER).")
(props `((safe-charsets
ascii
eight-bit-control
eight-bit-graphic
latin-iso8859-1
mule-unicode-0100-24ff
mule-unicode-2500-33ff
mule-unicode-e000-ffff
,@(if utf-translate-cjk-mode
utf-translate-cjk-charsets))
(valid-codes (0 . 255))
(mime-text-unsuitable . t)
(pre-write-conversion . utf-8-pre-write-conversion)
(dependency unify-8859-on-encoding-mode
unify-8859-on-decoding-mode
utf-fragment-on-decoding
utf-translate-cjk-mode))))
(make-coding-system
'mule-utf-16le 4
?u (concat
"UTF-16LE encoding for Emacs-supported Unicode characters."
doc)
'(ccl-decode-mule-utf-16le . ccl-encode-mule-utf-16le)
`(,@props
(post-read-conversion . utf-8-post-read-conversion)
(ascii-incompatible . t)
(mime-charset . utf-16le)))
(make-coding-system
'mule-utf-16be 4 ?u
(concat
"UTF-16BE encoding for Emacs-supported Unicode characters."
doc)
'(ccl-decode-mule-utf-16be . ccl-encode-mule-utf-16be)
`(,@props
(post-read-conversion . utf-8-post-read-conversion)
(ascii-incompatible . t)
(mime-charset . utf-16be)))
(make-coding-system
'mule-utf-16le-with-signature 4 ?u
(concat
"Little endian UTF-16 (with BOM) for Emacs-supported Unicode characters."
doc)
'(ccl-decode-mule-utf-16le-with-signature
. ccl-encode-mule-utf-16le-with-signature)
`(,@props
(post-read-conversion . utf-8-post-read-conversion)
(coding-category . coding-category-utf-16-le)
(ascii-incompatible . t)
(mime-charset . utf-16)))
(make-coding-system
'mule-utf-16be-with-signature 4 ?u
(concat
"Big endian UTF-16 (with BOM) for Emacs-supported Unicode characters."
doc)
'(ccl-decode-mule-utf-16be-with-signature
. ccl-encode-mule-utf-16be-with-signature)
`(,@props
(post-read-conversion . utf-8-post-read-conversion)
(coding-category . coding-category-utf-16-be)
(ascii-incompatible . t)
(mime-charset . utf-16)))
(make-coding-system
'mule-utf-16 4 ?u
(concat
"UTF-16 (with or without BOM) for Emacs-supported Unicode characters."
doc)
'(ccl-decode-mule-utf-16 . ccl-encode-mule-utf-16be-with-signature)
`(,@props
(post-read-conversion . mule-utf-16-post-read-conversion)
(coding-category . coding-category-utf-16-be)
(ascii-incompatible . t)
(mime-charset . utf-16)))
)
(define-coding-system-alias 'utf-16le 'mule-utf-16le)
(define-coding-system-alias 'utf-16be 'mule-utf-16be)
(define-coding-system-alias 'utf-16le-with-signature
'mule-utf-16le-with-signature)
(define-coding-system-alias 'utf-16be-with-signature
'mule-utf-16be-with-signature)
(define-coding-system-alias 'utf-16 'mule-utf-16)
(define-coding-system-alias 'mule-utf-16-le 'mule-utf-16le-with-signature)
(define-coding-system-alias 'utf-16-le 'mule-utf-16le-with-signature)
(define-coding-system-alias 'mule-utf-16-be 'mule-utf-16be-with-signature)
(define-coding-system-alias 'utf-16-be 'mule-utf-16be-with-signature)