comparison lisp/international/utf-16.el @ 56038:b7fe21511efe

(utf-16-decode-ucs): Handle a surrogate pair correctly. Call ccl-mule-utf-untrans for untranslable chars. (utf-16le-decode-loop): Set r5 to -1 before loop. (utf-16be-decode-loop): Likewise. (ccl-decode-mule-utf-16le): Add EOF processing block. (ccl-decode-mule-utf-16be): Likewise. (ccl-decode-mule-utf-16le-with-signature): Likewise. (ccl-decode-mule-utf-16be-with-signature): Likewise. (ccl-decode-mule-utf-16): Likewise. Set r5 to -1 initially. (ccl-mule-utf-16-encode-untrans): New CCL. (utf-16-decode-to-ucs): Handle pre-read character. (utf-16le-encode-loop): Handle surrogate pair. (utf-16be-encode-loop): Likewise. (ccl-encode-mule-utf-16le-with-signature): Adjusted for the change of utf-16le-encode-loop. (ccl-encode-mule-utf-16be-with-signature): Adjusted for the change of utf-16be-encode-loop. (mule-utf-16-post-read-conversion): Call utf-8-post-read-conversion at first. (mule-utf-16[{le|be}], mule-utf-16{le|be}-with-signature): Include CJK charsets in safe-charsets if utf-translate-cjk-mode is on. Add post-read-conversion and pre-write-conversion.

56037:81dbb510a1db

;; We end up with trivially different -le and -be versions of most
;; things below, sometimes with commonality abstracted into a let
;; binding for maintenance convenience.

;; We'd need new charsets distinct from ascii and eight-bit-control to
;; deal with untranslated sequences, since we can't otherwise
;; distinguish the bytes, as we can with utf-8.

;; ;; Do a multibyte write for bytes in r3 and r4.
;; ;; Intended for untranslatable utf-16 sequences.
;; (define-ccl-program ccl-mule-utf-16-untrans
;;   `(0
;;      (if (r3 < 128)
;; 	 (r0 = ,(charset-id 'ascii))
;;        (if (r3 < 160)
;; 	   (r0 = ,(charset-id 'eight-bit-control))
;; 	 (r0 = ,(charset-id 'eight-bit-graphic))))
;;      (if (r4 < 128)
;; 	 (r0 = ,(charset-id 'ascii))
;;        (if (r4 < 160)
;; 	   (r0 = ,(charset-id 'eight-bit-control))
;; 	 (r0 = ,(charset-id 'eight-bit-graphic))))
;;      (r1 = r4)))
;;   "Do a multibyte write for bytes in r3 and r4.
;; First swap them if we're big endian, indicated by r5==0.
;; Intended for untranslatable utf-16 sequences.")

;; Needed in macro expansion, so can't be let-bound.  Zapped after use.
(eval-and-compile
(defconst utf-16-decode-ucs
  ;; We have the unicode in r1.  Output is charset ID in r0, code
  ;; point in r1.
  `((lookup-integer utf-subst-table-for-decode r1 r3)
    (if r7				; got a translation
	((r0 = r1) (r1 = r3))
      (if (r1 < 128)
	  (r0 = ,(charset-id 'ascii))
	(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)	; 2 untranslated bytes
		    ;;		 ;; Assume this is rare, so don't worry about the
		    ;; 		 ;; overhead of the call.
		    ;; 		 (call mule-utf-16-untrans)
		    ((r0 = ,(charset-id 'mule-unicode-e000-ffff))
		     (r1 = 15037))	; U+fffd
		  (if (r1 < #xe000)	; surrogate
		      ;; 			((call mule-utf-16-untrans)
		      ;; 			 (write-multibyte-character r0 r1)
		      ;; 			 (read r3 r4)
		      ;; 			 (call mule-utf-16-untrans))
		      ((read r3 r4)
		       (r0 = ,(charset-id 'mule-unicode-e000-ffff))
		       (r1 = 15037))
		    ((r0 = ,(charset-id 'mule-unicode-e000-ffff))
		     (r1 -= #xe000)
		     (r2 = (((r1 / 96) + 32) << 7))
		     (r1 %= 96)
		     (r1 += (r2 + 32)))))))))))))

(defconst utf-16le-decode-loop
  `(loop
    (read r3 r4)
    (r1 = (r4 <8 r3))
    ,utf-16-decode-ucs
    (translate-character utf-translation-table-for-decode r0 r1)
    (write-multibyte-character r0 r1)
    (repeat)))

(defconst utf-16be-decode-loop
  `(loop
    (read r3 r4)
    (r1 = (r3 <8 r4))
    ,@utf-16-decode-ucs
    (translate-character utf-translation-table-for-decode r0 r1)
    (write-multibyte-character r0 r1)
    (repeat)))

)

(define-ccl-program ccl-decode-mule-utf-16le
  `(2					; 2 bytes -> 1 to 4 bytes
    ,utf-16le-decode-loop)
  "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					; 2 bytes -> 1 to 4 bytes
    ,utf-16be-decode-loop)
  "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
    ((read r3 r4)
     ,utf-16le-decode-loop))
  "Like ccl-decode-utf-16le but skip the first 2-byte BOM.")

(define-ccl-program ccl-decode-mule-utf-16be-with-signature
  `(2
    ((read r3 r4)
     ,utf-16be-decode-loop))
  "Like ccl-decode-utf-16be but skip the first 2-byte BOM.")

(define-ccl-program ccl-decode-mule-utf-16
  `(2
    ((read r3 r4)
     (r1 = (r3 <8 r4))
     (if (r1 == #xFFFE)
	 ;; R1 is a BOM for little endian.  We keep this character as
	 ;; is temporarily.  It is removed by post-read-conversion
	 ;; function.
	 (,@utf-16-decode-ucs
	  (write-multibyte-character r0 r1)
	  ,utf-16le-decode-loop)
       ((if (r1 == #xFEFF)
	    ;; R1 is a BOM for big endian, but we can't keep that
	    ;; character in the output because it can't be
	    ;; distinguished with the normal U+FEFF.  So, we keep
	    ;; #xFFFF instead.
	    ((r1 = #xFFFF)
	     ,@utf-16-decode-ucs)
	  ;; R1 a normal Unicode character.
	  (,@utf-16-decode-ucs
	   (translate-character utf-translation-table-for-decode r0 r1)))
	(write-multibyte-character r0 r1)
	,utf-16be-decode-loop))))
  "Like ccl-decode-utf-16be/le but check the first BOM.")

(makunbound 'utf-16-decode-ucs)		; done with it
(makunbound 'utf-16le-decode-loop)
(makunbound 'utf-16be-decode-loop)

(eval-and-compile
(defconst utf-16-decode-to-ucs
  ;; CCL which, given the result of a multibyte read in r0 and r1,
  ;; sets r0 to the character's Unicode if the charset is one of the
  ;; basic utf-8 coding system ones.  Otherwise set to U+fffd.
  `(if (r0 == ,(charset-id 'ascii))
       (r0 = r1)
     (if (r0 == ,(charset-id 'latin-iso8859-1))
	 (r0 = (r1 + 128))
       (if (r0 == ,(charset-id 'eight-bit-control))
	   (r0 = r1)
	 (if (r0 == ,(charset-id 'eight-bit-graphic))
	     (r0 = r1)
	   ((r2 = (r1 & #x7f))
	    (r1 >>= 7)
	    (r3 = ((r1 - 32) * 96))
	    (r3 += (r2 - 32))
	    (if (r0 == ,(charset-id 'mule-unicode-0100-24ff))
		(r0 = (r3 + #x100))
	      (if (r0 == ,(charset-id 'mule-unicode-2500-33ff))
		  (r0 = (r3 + #x2500))
		(if (r0 == ,(charset-id 'mule-unicode-e000-ffff))
		    (r0 = (r3 + #xe000))
		  (r0 = #xfffd))))))))))

(defconst utf-16le-encode-loop
  `(loop
    (read-multibyte-character r0 r1)
    (lookup-character utf-subst-table-for-encode r0 r1)
    (if (r7 == 0)
	((translate-character utf-translation-table-for-encode r0 r1)
	 ,utf-16-decode-to-ucs))
    (write (r0 & 255))
    (write (r0 >> 8))
    (repeat)))

(defconst utf-16be-encode-loop
  `(loop
    (read-multibyte-character r0 r1)
    (lookup-character utf-subst-table-for-encode r0 r1)
    (if (r7 == 0)
	((translate-character utf-translation-table-for-encode r0 r1)
	 ,utf-16-decode-to-ucs))
    (write (r0 >> 8))
    (write (r0 & 255))
    (repeat)))
)


(define-ccl-program ccl-encode-mule-utf-16le
  `(1

(define-ccl-program ccl-encode-mule-utf-16le-with-signature
  `(1
    ((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'.

(define-ccl-program ccl-encode-mule-utf-16be-with-signature
  `(1
    ((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'.

(makunbound 'utf-16le-encode-loop)
(makunbound 'utf-16be-encode-loop)

(defun mule-utf-16-post-read-conversion (length)
  (when (> length 0)
    (let ((char (following-char)))
      (cond ((= char (decode-char 'ucs #xFFFE))
	     (delete-char 1)
	     (setq last-coding-system-used
		   (coding-system-change-text-conversion

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)."))
  (make-coding-system
   'mule-utf-16le 4
   ?u	      ; Mule-UCS uses ?U, but code-pages uses that for koi8-u.
   (concat
    "UTF-16LE encoding for Emacs-supported Unicode characters."
    doc)

   '(ccl-decode-mule-utf-16le . ccl-encode-mule-utf-16le)
   '((safe-charsets
      ascii
      eight-bit-control
      latin-iso8859-1
      mule-unicode-0100-24ff
      mule-unicode-2500-33ff
      mule-unicode-e000-ffff)
     (mime-charset . utf-16le)
     (mime-text-unsuitable . t)
     (valid-codes (0 . 255))
     (dependency unify-8859-on-encoding-mode
		 unify-8859-on-decoding-mode
		 utf-fragment-on-decoding
		 utf-translate-cjk-mode)))

  (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)
   '((safe-charsets
      ascii
      eight-bit-control
      latin-iso8859-1
      mule-unicode-0100-24ff
      mule-unicode-2500-33ff
      mule-unicode-e000-ffff)
     (mime-charset . utf-16be)
     (valid-codes (0 . 255))
     (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-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)
   '((safe-charsets
      ascii
      eight-bit-control
      latin-iso8859-1
      mule-unicode-0100-24ff
      mule-unicode-2500-33ff
      mule-unicode-e000-ffff)
     (coding-category . coding-category-utf-16-le)
     (mime-charset . utf-16)
     (mime-text-unsuitable . t)
     (valid-codes (0 . 255))
     (dependency unify-8859-on-encoding-mode
		 unify-8859-on-decoding-mode
		 utf-fragment-on-decoding
		 utf-translate-cjk-mode)))

  (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)
   '((safe-charsets
      ascii
      eight-bit-control
      latin-iso8859-1
      mule-unicode-0100-24ff
      mule-unicode-2500-33ff
      mule-unicode-e000-ffff)
     (coding-category . coding-category-utf-16-be)
     (mime-charset . utf-16)
     (valid-codes (0 . 255))
     (dependency unify-8859-on-encoding-mode
		 unify-8859-on-decoding-mode
		 utf-fragment-on-decoding
		 utf-translate-cjk-mode)))

  (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)
   '((safe-charsets
      ascii
      eight-bit-control
      latin-iso8859-1
      mule-unicode-0100-24ff
      mule-unicode-2500-33ff
      mule-unicode-e000-ffff)
     (coding-category . coding-category-utf-16-be)
     (mime-charset . utf-16)
     (mime-text-unsuitable . t)
     (valid-codes (0 . 255))
     (dependency unify-8859-on-encoding-mode
		 unify-8859-on-decoding-mode
		 utf-fragment-on-decoding
		 utf-translate-cjk-mode)
     (post-read-conversion . mule-utf-16-post-read-conversion)))
)

(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

56038:b7fe21511efe

;; We end up with trivially different -le and -be versions of most
;; things below, sometimes with commonality abstracted into a let
;; binding for maintenance convenience.

;; Needed in macro expansion, so can't be let-bound.  Zapped after use.
(eval-and-compile
(defconst utf-16-decode-ucs
  ;; If r5 is negative, r1 is a Unicode chacter code.  Otherise, r5 is
  ;; the first of a surrogate pair and r1 is the second of the pair.
  ;; Output is charset ID in r0, code point in r1.  R0 may be set to
  ;; -1 in which case a caller should not write out r1.
  `((if (r5 >= 0)
	((r0 = (r1 < #xDC00))
	 (if ((r1 >= #xE000) | r0)
	     ;; Invalid second code of surrogate pair.
	     ((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				; got a translation
	   ((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)
		     ;; We can't have this character.
		     ((r0 = r1)
		      (call ccl-mule-utf-untrans)
		      (r5 = -1)
		      (r0 = -1))
		   (if (r1 < #xDC00)
		       ;; The first code of a surrogate pair.
		       ((r5 = r1)
			(r0 = -1))
		     (if (r1 < #xE000)
			 ;; The second code of a surrogate pair, invalid.
			 ((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)))
			 ;; We can't have this character.
			 ((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					; 2 bytes -> 1 to 4 bytes
    ,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					; 2 bytes -> 1 to 4 bytes
    ,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)
	 ;; R1 is a BOM for little endian.  We keep this character as
	 ;; is temporarily.  It is removed by post-read-conversion
	 ;; function.
	 (,@utf-16-decode-ucs
	  (write-multibyte-character r0 r1)
	  ,@utf-16le-decode-loop)
       ((if (r1 == #xFEFF)
	    ;; R1 is a BOM for big endian, but we can't keep that
	    ;; character in the output because it can't be
	    ;; distinguished with the normal U+FEFF.  So, we keep
	    ;; #xFFFF instead.
	    ((r1 = #xFFFF)
	     ,@utf-16-decode-ucs
	     (write-multibyte-character r0 r1))
	  ;; R1 is a normal Unicode character.
	  (,@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)		; done with it
(makunbound 'utf-16le-decode-loop)
(makunbound 'utf-16be-decode-loop)

;; UTF-16 decoder generates an UTF-8 sequence represented by a
;; sequence eight-bit-control/graphic chars for an invalid byte (the
;; last byte of an odd length source) and an untranslatable character
;; (including an invalid surrogate-pair code-point).
;;
;; This CCL parses that sequence (the first byte is already in r1),
;; and if the sequence represents an untranslatable character, it sets
;; r1 to the original invalid code or untranslated Unicode character
;; code, sets r2 to -1 (to prevent r2 and r3 are written), set2 r5 to
;; -1 (to tell the caller that there's no pre-read character).
;;
;; If the sequence represents an invalid byte, it sets r1 to -1, r2 to
;; the byte, sets r3 and r5 to -1.
;;
;; Otherwise, don't change r1, set r2 and r3 to already read
;; eight-bit-control/graphic characters (if any), set r5 and r6 to the
;; last character that invalidates the UTF-8 form.
;;
;; Note: For UTF-8 validation, we only check if a character is
;; eight-bit-control/graphic or not.  It may result in incorrect
;; handling of random binary data, but such a data can't be encoded by
;; UTF-16 anyway.  At least, UTF-16 decoder doesn't generate such a
;; sequence even if a source contains invalid byte-sequence.

(define-ccl-program ccl-mule-utf-16-encode-untrans
  `(0
    ((r2 = -1)
     ;; Read the 2nd byte.
     (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)))			; invalid UTF-8

     (r3 = -1)
     (r2 = r6)
     (if (r1 <= #xE0)
	 ;; 2-byte UTF-8, i.e. originally an invalid byte.
	 ((r2 &= #x3F)
	  (r2 |= ((r1 & #x1F) << 6))
	  (r1 = -1)
	  (r5 = -1)
	  (end)))
	 
     ;; Read the 3rd byte.
     (read-multibyte-character r5 r6)
     (r0 = (r5 != ,(charset-id 'eight-bit-control)))	       
     (if ((r5 != ,(charset-id 'eight-bit-graphic)) & r0)
	 ((end)))			; invalid UTF-8

     (if (r1 < #xF0)		; valid 3-byte UTF-8
	 ((r1 = ((r1 & #x0F) << 12))
	  (r1 |= ((r2 & #x3F) << 6))
	  (r1 |= (r6 & #x3F))
	  (r2 = -1)
	  (r5 = -1)
	  (end)))

     (r3 = r6)
     ;; Read the 4th byte.
     (read-multibyte-character r5 r6)
     (r0 = (r5 != ,(charset-id 'eight-bit-control)))	       
     (if ((r5 != ,(charset-id 'eight-bit-graphic)) & r0)
	 (end))			    ; livalid UTF-8

     ;; valid 4-byte UTF-8
     (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
  ;; Read a character and set r1 to the corresponding Unicode code.
  ;; If r5 is not negative, it means that we have already read a
  ;; character into r5 and r6.
  ;; If an invalid eight-bit-control/graphic sequence is found, r2 and
  ;; r3 may contain a byte to written out, r5 and r6 may contain a
  ;; pre-read character.  Usually they are set to -1.
  `((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
  `(1

(define-ccl-program ccl-encode-mule-utf-16le-with-signature
  `(1
    ((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'.

(define-ccl-program ccl-encode-mule-utf-16be-with-signature
  `(1
    ((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'.

(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

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	      ; Mule-UCS uses ?U, but code-pages uses that for koi8-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)
     (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)
     (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)
     (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)
     (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)
     (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