X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Fexternal-formats%2Feucjp.lisp;h=584fa7fe50119d43cc63f8a072546ebf972702e1;hb=b16ab6d8df8b236728b4097a989eb626ad278eff;hp=e5e493aa6e854c822b4bd1fb87fe93bde738b331;hpb=42fcad110cd7e966c89bda8f5d3be96862ba1dbd;p=sbcl.git

diff --git a/src/code/external-formats/eucjp.lisp b/src/code/external-formats/eucjp.lisp
index e5e493a..584fa7f 100644
--- a/src/code/external-formats/eucjp.lisp
+++ b/src/code/external-formats/eucjp.lisp
@@ -1,7 +1,49 @@
 (in-package "SB!IMPL")
 
-(let ((ucs-to-eucjp-table (make-hash-table))
-      (eucjp-to-ucs-table (make-hash-table)))
+(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)))))
   (let ((ucs<->eucjp             ; bi-directional table UCS <-> EUC-JP
          ;; based on eucJP-ascii in
          ;; <http://www.opengroup.or.jp/jvc/cde/appendix.html>
@@ -13027,27 +13069,13 @@
            (#xFFE4 . #x8FA2C3)
            (#xFFE5 . #xA1EF))))
     (dotimes (i 128)
-      (setf (gethash i ucs-to-eucjp-table) i)
-      (setf (gethash i eucjp-to-ucs-table) i))
+      (set-ucs-to-eucjp i i)
+      (set-eucjp-to-ucs i i))
     (dolist (pair ucs<->eucjp)
-      (when (gethash (car pair) ucs-to-eucjp-table)
-        (error "duplicated ucs: ~X" (car pair)))
-      (when (gethash (cdr pair) eucjp-to-ucs-table)
-        (error "duplicated eucjp: ~X" (car pair)))
-      (setf (gethash (car pair) ucs-to-eucjp-table) (cdr pair))
-      (setf (gethash (cdr pair) eucjp-to-ucs-table) (car pair)))
+      (set-ucs-to-eucjp (car pair) (cdr pair))
+      (set-eucjp-to-ucs (cdr pair) (car pair)))
     (dolist (pair ucs->eucjp)
-      (when (gethash (car pair) ucs-to-eucjp-table)
-        (error "duplicated ucs: ~X" (car pair)))
-      (setf (gethash (car pair) ucs-to-eucjp-table) (cdr pair))))
-  (defun ucs-to-eucjp (code)
-    (declare (optimize speed (safety 0))
-             (type fixnum code))
-    (gethash code ucs-to-eucjp-table))
-  (defun eucjp-to-ucs (code)
-    (declare (optimize speed (safety 0))
-             (type fixnum code))
-    (gethash code eucjp-to-ucs-table)))
+      (set-ucs-to-eucjp (car pair) (cdr pair)))))
 
 ;;; for fd-stream.lisp
 (define-external-format/variable-width (:euc-jp :eucjp :|eucJP|) t