anchor.diff:  the absence of such a character on input, input data is assumed
   to be in big-endian order.  Output is written in native byte
   order with a leading byte-order mark."
  +  :aliases '(:ucs-4)
     :max-units-per-char 1
     :code-unit-size 32
     :native-endianness t ; not necessarily true when decoding
  
positive.code:   :nul-encoding #(0 0 0 0)
    :ambiguous #+little-endian t #+big-endian nil)
  
  (define-code-point-counter :utf-32 (getter type)
    `(named-lambda utf-32-code-point-counter (seq start end max)
       (declare (type ,type seq) (fixnum start end max))
       ;; check for bom
       (when (and (/= start end)
                  (case (,getter seq 0 4)
                    ((#.+byte-order-mark-code+
                      #.+swapped-byte-order-mark-code-32+) t)))
         (incf start 4))
       (multiple-value-bind (count rem)
           (floor (- end start) 4)
         (cond
           ((and (plusp max) (> count max))
            (values max (the fixnum (+ start (* 4 max)))))
           (t
            ;; check for incomplete last character
            (unless (zerop rem)
              (let ((vector (make-array 4 :fill-pointer 0)))
                (dotimes (i rem)
                  (vector-push (,getter seq (+ i (- end rem))) vector))
                (decoding-error vector :utf-32 seq (the fixnum (- end rem)) nil
                                'end-of-input-in-character)
                (decf end rem)))
            (values count end))))))
  
  (define-encoder :utf-32 (getter src-type setter dest-type)
    `(named-lambda utf-32-encoder (src start end dest d-start)
       (declare (type ,src-type src)
                (type ,dest-type dest)
                (fixnum start end d-start))
       (loop for i fixnum from start below end
             for di fixnum from d-start by 4 do
             (,setter (,getter src i) dest di 4)
             finally (return (the fixnum (- di d-start))))))
  
  (define-decoder :utf-32 (getter src-type setter dest-type)
    `(named-lambda utf-32-decoder (src start end dest d-start)
       (declare (type ,src-type src)
                (type ,dest-type dest)
                (fixnum start end d-start))
       (let ((reverse #+big-endian nil #+little-endian t))
         (when (not (zerop (- end start)))
           (case (,getter src 0 4)
             (#.+byte-order-mark-code+
                (incf start 4)
                #+little-endian (setq reverse nil))
             (#.+swapped-byte-order-mark-code-32+
                (incf start 4)
                #+big-endian (setq reverse t))))
         (loop for i fixnum from start below end by 4
               for di from d-start
               do (,setter (let ((unit (if reverse
                                           (,getter src i 4 :re)
                                           (,getter src i 4))))
                             (if (>= unit #x110000)
                                 (decoding-error (vector (,getter src i)
                                                         (,getter src (+ i 1))
                                                         (,getter src (+ i 2))
                                                         (,getter src (+ i 3)))
                                                 :utf-32 src i +repl+
                                                 'character-out-of-range)
                                 unit))
                           dest di)
               finally (return (the fixnum (- di d-start)))))))
  
negative.code:   :default-replacement #xfffd
    :ambiguous #+little-endian t #+big-endian nil)
  
  (define-utf-16 :utf-16)
  
  (define-character-encoding :utf-16le
      "A 16-bit, variable-length encoding in which characters with
  code points less than #x10000 can be encoded in a single 16-bit
  word and characters with larger codes can be encoded in a pair of
  16-bit words.  The data is assumed to be in little-endian order.  Output is
  written in little-endian byte-order without a leading byte-order mark."
    :aliases '(:utf-16/le)
    :max-units-per-char 2
    :code-unit-size 16
    :native-endianness #+little-endian t #+big-endian nil
    :decode-literal-code-unit-limit #xd800
    :encode-literal-code-unit-limit #x10000
    :nul-encoding #(0 0)
    :default-replacement #xfffd)
  
  (define-utf-16 :utf-16le :le)
  
  (define-character-encoding :utf-16be
      "A 16-bit, variable-length encoding in which characters with
  code points less than #x10000 can be encoded in a single 16-bit
  word and characters with larger codes can be encoded in a pair of
  16-bit words.  The data is assumed to be in big-endian order.  Output is
  written in big-endian byte-order without a leading byte-order mark."
    :aliases '(:utf-16/be)
    :max-units-per-char 2
    :code-unit-size 16
    :native-endianness #+little-endian nil #+big-endian t
    :decode-literal-code-unit-limit #xd800
    :encode-literal-code-unit-limit #x10000
    :nul-encoding #(0 0)
    :default-replacement #xfffd)
  
  (define-utf-16 :utf-16be :be)
  
  (defmacro define-ucs (name bytes &optional endianness (limit #x110000))
    (check-type name keyword)
    (check-type bytes (or (eql 2) (eql 4)))
    (check-type endianness (or null (eql :le) (eql :be)))
    (let ((swap-var (gensym "SWAP"))
          (code-point-counter-name
            (intern (format nil "~a-CODE-POINT-COUNTER" name)))
          (encoder-name
            (intern (format nil "~a-ENCODER" name)))
          (decoder-name
            (intern (format nil "~a-DECODER" name))))
      (labels ((make-bom-check-form (end start getter src)
                 (if (null endianness)
                   ``(when (not (zerop (- ,,end ,,start)))
                       (case (,,getter ,,src 0 ,',bytes :ne)
                         (#.+byte-order-mark-code+
                           (incf ,,start ,',bytes) nil)
                         (#.+swapped-byte-order-mark-code-32+
                          (incf ,,start ,',bytes) T)
                         (T #+little-endian T)))
                   '()))
               (make-setter-form (setter code dest di)
                 ``(,,setter ,,code ,,dest ,,di ,',bytes
                             ,',(or endianness :ne)))
               (make-getter-form (getter src i)
                 (if (null endianness)
                   ``(if ,',swap-var
                       (,,getter ,,src ,,i ,',bytes :re)
                       (,,getter ,,src ,,i ,',bytes :ne))
                   ``(,,getter ,,src ,,i ,',bytes ,',endianness))))
        `(progn
           (define-code-point-counter ,name (getter type)
             `(named-lambda ,',code-point-counter-name (seq start end max)
                (declare (type ,type seq) (fixnum start end max))
                ;; check for bom
                ,,(make-bom-check-form ''end ''start 'getter ''seq)
                (multiple-value-bind (count rem)
                    (floor (- end start) ,',bytes)
                  (cond
                    ((and (plusp max) (> count max))
                     (values max (the fixnum (+ start (* ,',bytes max)))))
                    (t
                      ;; check for incomplete last character
                      (unless (zerop rem)
                        (let ((vector (make-array ,',bytes :fill-pointer 0)))
                          (dotimes (i rem)
                            (vector-push (,getter seq (+ i (- end rem))) vector))
                          (decoding-error vector ,',name seq (the fixnum (- end rem)) nil
                                          'end-of-input-in-character)
                          (decf end rem)))
                      (values count end))))))
           (define-encoder ,name (getter src-type setter dest-type)
             `(named-lambda ,',encoder-name (src start end dest d-start)
                (declare (type ,src-type src)
                         (type ,dest-type dest)
                         (fixnum start end d-start))
                (loop for i fixnum from start below end
                  for di fixnum from d-start by ,',bytes
                  for code of-type code-point = (,getter src i) do
                  (if (>= code ,',limit)
                    (encoding-error code ,',name src i +repl+)
                    ,,(make-setter-form 'setter ''code ''dest ''di))
                  finally (return (the fixnum (- di d-start))))))
           (define-decoder ,name (getter src-type setter dest-type)
             `(named-lambda ,',decoder-name (src start end dest d-start)
                (declare (type ,src-type src)
                         (type ,dest-type dest)
                         (fixnum start end d-start))
                (let ((,',swap-var ,,(make-bom-check-form ''end ''start 'getter ''src)))
                  (declare (ignorable ,',swap-var))
                  (loop for i fixnum from start below end by ,',bytes
                    for di from d-start
                    do (,setter (let ((unit ,,(make-getter-form 'getter ''src ''i)))
                                  (if (>= unit ,',limit)
                                    (decoding-error
                                      (vector (,getter src i)
                                              (,getter src (+ i 1))
                                              ,@,(if (= bytes 4)
                                                   ``((,getter src (+ i 2))
                                                      (,getter src (+ i 3)))))
                                      ,',name src i +repl+
                                      'character-out-of-range)
                                    unit))
                                dest di)
                    finally (return (the fixnum (- di d-start)))))))
           ',name))))
  
  ;;;; UTF-32
  
  