+(let ((ucs-to-eucjp-table (make-array #xFFFF
+ :element-type '(unsigned-byte 16)
+ :initial-element #xFFFF))
+ (eucjp-to-ucs-table (make-array #xFFFF
+ :element-type '(unsigned-byte 16)
+ :initial-element #xFFFF)))
+ (labels ((eucjp-to-internal (code)
+ (declare (optimize speed (safety 0))
+ (type fixnum code))
+ (if (<= #x8F0000 code #x8FFFFF)
+ (logand code #xFF7F)
+ code))
+ (internal-to-eucjp (code)
+ (declare (optimize speed (safety 0))
+ (type fixnum code))
+ (if (= (logand code #x8080) #x8000)
+ (logior code #x8F8080)
+ code)))
+ (declare (inline eucjp-to-internal internal-to-eucjp))
+ (defun ucs-to-eucjp (code)
+ (declare (optimize speed (safety 0))
+ (type fixnum code))
+ (if (<= 0 code (length ucs-to-eucjp-table))
+ (let ((x (aref ucs-to-eucjp-table code)))
+ (unless (= x #xFFFF)
+ (internal-to-eucjp x)))))
+ (defun eucjp-to-ucs (code)
+ (declare (optimize speed (safety 0))
+ (type fixnum code))
+ (let ((code (eucjp-to-internal code)))
+ (if (<= 0 code (length eucjp-to-ucs-table))
+ (let ((x (aref eucjp-to-ucs-table code)))
+ (unless (= x #xFFFF)
+ x)))))
+ (defun set-ucs-to-eucjp (ucs eucjp)
+ (let ((eucjp (eucjp-to-internal eucjp)))
+ (if (= (aref ucs-to-eucjp-table ucs) #xFFFF)
+ (setf (aref ucs-to-eucjp-table ucs) eucjp)
+ (error "duplicated ucs: ~X" ucs))))
+ (defun set-eucjp-to-ucs (eucjp ucs)
+ (let ((eucjp (eucjp-to-internal eucjp)))
+ (if (= (aref eucjp-to-ucs-table eucjp) #xFFFF)
+ (setf (aref eucjp-to-ucs-table eucjp) ucs)
+ (error "duplicated eucjp: ~X" eucjp)))))