From c6b078527eb68acc281dc79c91824c937f9447fe Mon Sep 17 00:00:00 2001
From: Alexey Dejneka <adejneka@comail.ru>
Date: Sat, 28 Jan 2006 08:52:35 +0000
Subject: [PATCH] 0.9.9.8:         * Merge a patch by Ivan Boldyrev fixing
 character code           conversions for OCTETS-TO-STRING
 and STRING-TO-OCTETS.

---
 NEWS                                   |    2 +
 src/code/external-formats/enc-cyr.lisp |   18 +++----
 src/code/external-formats/enc-dos.lisp |   84 ++++++++++++++++----------------
 src/code/external-formats/enc-iso.lisp |   72 +++++++++++++--------------
 src/code/external-formats/enc-win.lisp |   54 ++++++++++----------
 tests/external-format.impure.lisp      |   10 ++++
 version.lisp-expr                      |    2 +-
 7 files changed, 127 insertions(+), 115 deletions(-)

diff --git a/NEWS b/NEWS
index 27782b1..671462e 100644
--- a/NEWS
+++ b/NEWS
@@ -2,6 +2,8 @@
 changes in sbcl-0.9.10 relative to sbcl-0.9.9:
   * fixed bug #399: full call to DATA-VECTOR-REF in accesses to
     certain complicated string types.  (reported by Gary King)
+  * fixed bug: STRING-TO-OCTETS and OCTETS-TO-STRING did not convert
+    character codes.  (thanks to Yaroslav Kavenchuk and Ivan Boldyrev)
 
 changes in sbcl-0.9.9 relative to sbcl-0.9.8:
   * new platform: experimental support for the Windows operating
diff --git a/src/code/external-formats/enc-cyr.lisp b/src/code/external-formats/enc-cyr.lisp
index 0cfa0e3..660e38d 100644
--- a/src/code/external-formats/enc-cyr.lisp
+++ b/src/code/external-formats/enc-cyr.lisp
@@ -136,7 +136,7 @@
   (declare (optimize speed (safety 0))
            (type simple-string string)
            (type array-range pos end))
-  (get-latin-bytes #'identity :koi8-r string pos end))
+  (get-latin-bytes #'code->koi8-r-mapper :koi8-r string pos end))
 
 (defun string->koi8-r (string sstart send null-padding)
   (declare (optimize speed (safety 0))
@@ -149,14 +149,14 @@
   (let ((name (make-od-name 'koi8-r->string* accessor)))
     `(progn
       (defun ,name (string sstart send array astart aend)
-        (,(make-od-name 'latin->string* accessor) string sstart send array astart aend #'identity)))))
+        (,(make-od-name 'latin->string* accessor) string sstart send array astart aend #'koi8-r->code-mapper)))))
 
 (instantiate-octets-definition define-koi8-r->string*)
 
 (defmacro define-koi8-r->string (accessor type)
   (declare (ignore type))
   `(defun ,(make-od-name 'koi8-r->string accessor) (array astart aend)
-    (,(make-od-name 'latin->string accessor) array astart aend #'identity)))
+    (,(make-od-name 'latin->string accessor) array astart aend #'koi8-r->code-mapper)))
 
 (instantiate-octets-definition define-koi8-r->string)
 
@@ -311,7 +311,7 @@
   (declare (optimize speed (safety 0))
            (type simple-string string)
            (type array-range pos end))
-  (get-latin-bytes #'identity :koi8-u string pos end))
+  (get-latin-bytes #'code->koi8-u-mapper :koi8-u string pos end))
 
 (defun string->koi8-u (string sstart send null-padding)
   (declare (optimize speed (safety 0))
@@ -324,14 +324,14 @@
   (let ((name (make-od-name 'koi8-u->string* accessor)))
     `(progn
       (defun ,name (string sstart send array astart aend)
-        (,(make-od-name 'latin->string* accessor) string sstart send array astart aend #'identity)))))
+        (,(make-od-name 'latin->string* accessor) string sstart send array astart aend #'koi8-u->code-mapper)))))
 
 (instantiate-octets-definition define-koi8-u->string*)
 
 (defmacro define-koi8-u->string (accessor type)
   (declare (ignore type))
   `(defun ,(make-od-name 'koi8-u->string accessor) (array astart aend)
-    (,(make-od-name 'latin->string accessor) array astart aend #'identity)))
+    (,(make-od-name 'latin->string accessor) array astart aend #'koi8-u->code-mapper)))
 
 (instantiate-octets-definition define-koi8-u->string)
 
@@ -481,7 +481,7 @@
   (declare (optimize speed (safety 0))
            (type simple-string string)
            (type array-range pos end))
-  (get-latin-bytes #'identity :x-mac-cyrillic string pos end))
+  (get-latin-bytes #'code->x-mac-cyrillic-mapper :x-mac-cyrillic string pos end))
 
 (defun string->x-mac-cyrillic (string sstart send null-padding)
   (declare (optimize speed (safety 0))
@@ -494,14 +494,14 @@
   (let ((name (make-od-name 'x-mac-cyrillic->string* accessor)))
     `(progn
       (defun ,name (string sstart send array astart aend)
-        (,(make-od-name 'latin->string* accessor) string sstart send array astart aend #'identity)))))
+        (,(make-od-name 'latin->string* accessor) string sstart send array astart aend #'x-mac-cyrillic->code-mapper)))))
 
 (instantiate-octets-definition define-x-mac-cyrillic->string*)
 
 (defmacro define-x-mac-cyrillic->string (accessor type)
   (declare (ignore type))
   `(defun ,(make-od-name 'x-mac-cyrillic->string accessor) (array astart aend)
-    (,(make-od-name 'latin->string accessor) array astart aend #'identity)))
+    (,(make-od-name 'latin->string accessor) array astart aend #'x-mac-cyrillic->code-mapper)))
 
 (instantiate-octets-definition define-x-mac-cyrillic->string)
 
diff --git a/src/code/external-formats/enc-dos.lisp b/src/code/external-formats/enc-dos.lisp
index 7ca0963..74d8761 100644
--- a/src/code/external-formats/enc-dos.lisp
+++ b/src/code/external-formats/enc-dos.lisp
@@ -136,7 +136,7 @@
   (declare (optimize speed (safety 0))
            (type simple-string string)
            (type array-range pos end))
-  (get-latin-bytes #'identity :cp437 string pos end))
+  (get-latin-bytes #'code->cp437-mapper :cp437 string pos end))
 
 (defun string->cp437 (string sstart send null-padding)
   (declare (optimize speed (safety 0))
@@ -149,14 +149,14 @@
   (let ((name (make-od-name 'cp437->string* accessor)))
     `(progn
       (defun ,name (string sstart send array astart aend)
-        (,(make-od-name 'latin->string* accessor) string sstart send array astart aend #'identity)))))
+        (,(make-od-name 'latin->string* accessor) string sstart send array astart aend #'cp437->code-mapper)))))
 
 (instantiate-octets-definition define-cp437->string*)
 
 (defmacro define-cp437->string (accessor type)
   (declare (ignore type))
   `(defun ,(make-od-name 'cp437->string accessor) (array astart aend)
-    (,(make-od-name 'latin->string accessor) array astart aend #'identity)))
+    (,(make-od-name 'latin->string accessor) array astart aend #'cp437->code-mapper)))
 
 (instantiate-octets-definition define-cp437->string)
 
@@ -311,7 +311,7 @@
   (declare (optimize speed (safety 0))
            (type simple-string string)
            (type array-range pos end))
-  (get-latin-bytes #'identity :cp850 string pos end))
+  (get-latin-bytes #'code->cp850-mapper :cp850 string pos end))
 
 (defun string->cp850 (string sstart send null-padding)
   (declare (optimize speed (safety 0))
@@ -324,14 +324,14 @@
   (let ((name (make-od-name 'cp850->string* accessor)))
     `(progn
       (defun ,name (string sstart send array astart aend)
-        (,(make-od-name 'latin->string* accessor) string sstart send array astart aend #'identity)))))
+        (,(make-od-name 'latin->string* accessor) string sstart send array astart aend #'cp850->code-mapper)))))
 
 (instantiate-octets-definition define-cp850->string*)
 
 (defmacro define-cp850->string (accessor type)
   (declare (ignore type))
   `(defun ,(make-od-name 'cp850->string accessor) (array astart aend)
-    (,(make-od-name 'latin->string accessor) array astart aend #'identity)))
+    (,(make-od-name 'latin->string accessor) array astart aend #'cp850->code-mapper)))
 
 (instantiate-octets-definition define-cp850->string)
 
@@ -486,7 +486,7 @@
   (declare (optimize speed (safety 0))
            (type simple-string string)
            (type array-range pos end))
-  (get-latin-bytes #'identity :cp852 string pos end))
+  (get-latin-bytes #'code->cp852-mapper :cp852 string pos end))
 
 (defun string->cp852 (string sstart send null-padding)
   (declare (optimize speed (safety 0))
@@ -499,14 +499,14 @@
   (let ((name (make-od-name 'cp852->string* accessor)))
     `(progn
       (defun ,name (string sstart send array astart aend)
-        (,(make-od-name 'latin->string* accessor) string sstart send array astart aend #'identity)))))
+        (,(make-od-name 'latin->string* accessor) string sstart send array astart aend #'cp852->code-mapper)))))
 
 (instantiate-octets-definition define-cp852->string*)
 
 (defmacro define-cp852->string (accessor type)
   (declare (ignore type))
   `(defun ,(make-od-name 'cp852->string accessor) (array astart aend)
-    (,(make-od-name 'latin->string accessor) array astart aend #'identity)))
+    (,(make-od-name 'latin->string accessor) array astart aend #'cp852->code-mapper)))
 
 (instantiate-octets-definition define-cp852->string)
 
@@ -661,7 +661,7 @@
   (declare (optimize speed (safety 0))
            (type simple-string string)
            (type array-range pos end))
-  (get-latin-bytes #'identity :cp855 string pos end))
+  (get-latin-bytes #'code->cp855-mapper :cp855 string pos end))
 
 (defun string->cp855 (string sstart send null-padding)
   (declare (optimize speed (safety 0))
@@ -674,14 +674,14 @@
   (let ((name (make-od-name 'cp855->string* accessor)))
     `(progn
       (defun ,name (string sstart send array astart aend)
-        (,(make-od-name 'latin->string* accessor) string sstart send array astart aend #'identity)))))
+        (,(make-od-name 'latin->string* accessor) string sstart send array astart aend #'cp855->code-mapper)))))
 
 (instantiate-octets-definition define-cp855->string*)
 
 (defmacro define-cp855->string (accessor type)
   (declare (ignore type))
   `(defun ,(make-od-name 'cp855->string accessor) (array astart aend)
-    (,(make-od-name 'latin->string accessor) array astart aend #'identity)))
+    (,(make-od-name 'latin->string accessor) array astart aend #'cp855->code-mapper)))
 
 (instantiate-octets-definition define-cp855->string)
 
@@ -835,7 +835,7 @@
   (declare (optimize speed (safety 0))
            (type simple-string string)
            (type array-range pos end))
-  (get-latin-bytes #'identity :cp857 string pos end))
+  (get-latin-bytes #'code->cp857-mapper :cp857 string pos end))
 
 (defun string->cp857 (string sstart send null-padding)
   (declare (optimize speed (safety 0))
@@ -848,14 +848,14 @@
   (let ((name (make-od-name 'cp857->string* accessor)))
     `(progn
       (defun ,name (string sstart send array astart aend)
-        (,(make-od-name 'latin->string* accessor) string sstart send array astart aend #'identity)))))
+        (,(make-od-name 'latin->string* accessor) string sstart send array astart aend #'cp857->code-mapper)))))
 
 (instantiate-octets-definition define-cp857->string*)
 
 (defmacro define-cp857->string (accessor type)
   (declare (ignore type))
   `(defun ,(make-od-name 'cp857->string accessor) (array astart aend)
-    (,(make-od-name 'latin->string accessor) array astart aend #'identity)))
+    (,(make-od-name 'latin->string accessor) array astart aend #'cp857->code-mapper)))
 
 (instantiate-octets-definition define-cp857->string)
 
@@ -1010,7 +1010,7 @@
   (declare (optimize speed (safety 0))
            (type simple-string string)
            (type array-range pos end))
-  (get-latin-bytes #'identity :cp860 string pos end))
+  (get-latin-bytes #'code->cp860-mapper :cp860 string pos end))
 
 (defun string->cp860 (string sstart send null-padding)
   (declare (optimize speed (safety 0))
@@ -1023,14 +1023,14 @@
   (let ((name (make-od-name 'cp860->string* accessor)))
     `(progn
       (defun ,name (string sstart send array astart aend)
-        (,(make-od-name 'latin->string* accessor) string sstart send array astart aend #'identity)))))
+        (,(make-od-name 'latin->string* accessor) string sstart send array astart aend #'cp860->code-mapper)))))
 
 (instantiate-octets-definition define-cp860->string*)
 
 (defmacro define-cp860->string (accessor type)
   (declare (ignore type))
   `(defun ,(make-od-name 'cp860->string accessor) (array astart aend)
-    (,(make-od-name 'latin->string accessor) array astart aend #'identity)))
+    (,(make-od-name 'latin->string accessor) array astart aend #'cp860->code-mapper)))
 
 (instantiate-octets-definition define-cp860->string)
 
@@ -1185,7 +1185,7 @@
   (declare (optimize speed (safety 0))
            (type simple-string string)
            (type array-range pos end))
-  (get-latin-bytes #'identity :cp861 string pos end))
+  (get-latin-bytes #'code->cp861-mapper :cp861 string pos end))
 
 (defun string->cp861 (string sstart send null-padding)
   (declare (optimize speed (safety 0))
@@ -1198,14 +1198,14 @@
   (let ((name (make-od-name 'cp861->string* accessor)))
     `(progn
       (defun ,name (string sstart send array astart aend)
-        (,(make-od-name 'latin->string* accessor) string sstart send array astart aend #'identity)))))
+        (,(make-od-name 'latin->string* accessor) string sstart send array astart aend #'cp861->code-mapper)))))
 
 (instantiate-octets-definition define-cp861->string*)
 
 (defmacro define-cp861->string (accessor type)
   (declare (ignore type))
   `(defun ,(make-od-name 'cp861->string accessor) (array astart aend)
-    (,(make-od-name 'latin->string accessor) array astart aend #'identity)))
+    (,(make-od-name 'latin->string accessor) array astart aend #'cp861->code-mapper)))
 
 (instantiate-octets-definition define-cp861->string)
 
@@ -1360,7 +1360,7 @@
   (declare (optimize speed (safety 0))
            (type simple-string string)
            (type array-range pos end))
-  (get-latin-bytes #'identity :cp862 string pos end))
+  (get-latin-bytes #'code->cp862-mapper :cp862 string pos end))
 
 (defun string->cp862 (string sstart send null-padding)
   (declare (optimize speed (safety 0))
@@ -1373,14 +1373,14 @@
   (let ((name (make-od-name 'cp862->string* accessor)))
     `(progn
       (defun ,name (string sstart send array astart aend)
-        (,(make-od-name 'latin->string* accessor) string sstart send array astart aend #'identity)))))
+        (,(make-od-name 'latin->string* accessor) string sstart send array astart aend #'cp862->code-mapper)))))
 
 (instantiate-octets-definition define-cp862->string*)
 
 (defmacro define-cp862->string (accessor type)
   (declare (ignore type))
   `(defun ,(make-od-name 'cp862->string accessor) (array astart aend)
-    (,(make-od-name 'latin->string accessor) array astart aend #'identity)))
+    (,(make-od-name 'latin->string accessor) array astart aend #'cp862->code-mapper)))
 
 (instantiate-octets-definition define-cp862->string)
 
@@ -1535,7 +1535,7 @@
   (declare (optimize speed (safety 0))
            (type simple-string string)
            (type array-range pos end))
-  (get-latin-bytes #'identity :cp863 string pos end))
+  (get-latin-bytes #'code->cp863-mapper :cp863 string pos end))
 
 (defun string->cp863 (string sstart send null-padding)
   (declare (optimize speed (safety 0))
@@ -1548,14 +1548,14 @@
   (let ((name (make-od-name 'cp863->string* accessor)))
     `(progn
       (defun ,name (string sstart send array astart aend)
-        (,(make-od-name 'latin->string* accessor) string sstart send array astart aend #'identity)))))
+        (,(make-od-name 'latin->string* accessor) string sstart send array astart aend #'cp863->code-mapper)))))
 
 (instantiate-octets-definition define-cp863->string*)
 
 (defmacro define-cp863->string (accessor type)
   (declare (ignore type))
   `(defun ,(make-od-name 'cp863->string accessor) (array astart aend)
-    (,(make-od-name 'latin->string accessor) array astart aend #'identity)))
+    (,(make-od-name 'latin->string accessor) array astart aend #'cp863->code-mapper)))
 
 (instantiate-octets-definition define-cp863->string)
 
@@ -1707,7 +1707,7 @@
   (declare (optimize speed (safety 0))
            (type simple-string string)
            (type array-range pos end))
-  (get-latin-bytes #'identity :cp864 string pos end))
+  (get-latin-bytes #'code->cp864-mapper :cp864 string pos end))
 
 (defun string->cp864 (string sstart send null-padding)
   (declare (optimize speed (safety 0))
@@ -1720,14 +1720,14 @@
   (let ((name (make-od-name 'cp864->string* accessor)))
     `(progn
       (defun ,name (string sstart send array astart aend)
-        (,(make-od-name 'latin->string* accessor) string sstart send array astart aend #'identity)))))
+        (,(make-od-name 'latin->string* accessor) string sstart send array astart aend #'cp864->code-mapper)))))
 
 (instantiate-octets-definition define-cp864->string*)
 
 (defmacro define-cp864->string (accessor type)
   (declare (ignore type))
   `(defun ,(make-od-name 'cp864->string accessor) (array astart aend)
-    (,(make-od-name 'latin->string accessor) array astart aend #'identity)))
+    (,(make-od-name 'latin->string accessor) array astart aend #'cp864->code-mapper)))
 
 (instantiate-octets-definition define-cp864->string)
 
@@ -1882,7 +1882,7 @@
   (declare (optimize speed (safety 0))
            (type simple-string string)
            (type array-range pos end))
-  (get-latin-bytes #'identity :cp865 string pos end))
+  (get-latin-bytes #'code->cp865-mapper :cp865 string pos end))
 
 (defun string->cp865 (string sstart send null-padding)
   (declare (optimize speed (safety 0))
@@ -1895,14 +1895,14 @@
   (let ((name (make-od-name 'cp865->string* accessor)))
     `(progn
       (defun ,name (string sstart send array astart aend)
-        (,(make-od-name 'latin->string* accessor) string sstart send array astart aend #'identity)))))
+        (,(make-od-name 'latin->string* accessor) string sstart send array astart aend #'cp865->code-mapper)))))
 
 (instantiate-octets-definition define-cp865->string*)
 
 (defmacro define-cp865->string (accessor type)
   (declare (ignore type))
   `(defun ,(make-od-name 'cp865->string accessor) (array astart aend)
-    (,(make-od-name 'latin->string accessor) array astart aend #'identity)))
+    (,(make-od-name 'latin->string accessor) array astart aend #'cp865->code-mapper)))
 
 (instantiate-octets-definition define-cp865->string)
 
@@ -2057,7 +2057,7 @@
   (declare (optimize speed (safety 0))
            (type simple-string string)
            (type array-range pos end))
-  (get-latin-bytes #'identity :cp866 string pos end))
+  (get-latin-bytes #'code->cp866-mapper :cp866 string pos end))
 
 (defun string->cp866 (string sstart send null-padding)
   (declare (optimize speed (safety 0))
@@ -2070,14 +2070,14 @@
   (let ((name (make-od-name 'cp866->string* accessor)))
     `(progn
       (defun ,name (string sstart send array astart aend)
-        (,(make-od-name 'latin->string* accessor) string sstart send array astart aend #'identity)))))
+        (,(make-od-name 'latin->string* accessor) string sstart send array astart aend #'cp866->code-mapper)))))
 
 (instantiate-octets-definition define-cp866->string*)
 
 (defmacro define-cp866->string (accessor type)
   (declare (ignore type))
   `(defun ,(make-od-name 'cp866->string accessor) (array astart aend)
-    (,(make-od-name 'latin->string accessor) array astart aend #'identity)))
+    (,(make-od-name 'latin->string accessor) array astart aend #'cp866->code-mapper)))
 
 (instantiate-octets-definition define-cp866->string)
 
@@ -2232,7 +2232,7 @@
   (declare (optimize speed (safety 0))
            (type simple-string string)
            (type array-range pos end))
-  (get-latin-bytes #'identity :cp869 string pos end))
+  (get-latin-bytes #'code->cp869-mapper :cp869 string pos end))
 
 (defun string->cp869 (string sstart send null-padding)
   (declare (optimize speed (safety 0))
@@ -2245,14 +2245,14 @@
   (let ((name (make-od-name 'cp869->string* accessor)))
     `(progn
       (defun ,name (string sstart send array astart aend)
-        (,(make-od-name 'latin->string* accessor) string sstart send array astart aend #'identity)))))
+        (,(make-od-name 'latin->string* accessor) string sstart send array astart aend #'cp869->code-mapper)))))
 
 (instantiate-octets-definition define-cp869->string*)
 
 (defmacro define-cp869->string (accessor type)
   (declare (ignore type))
   `(defun ,(make-od-name 'cp869->string accessor) (array astart aend)
-    (,(make-od-name 'latin->string accessor) array astart aend #'identity)))
+    (,(make-od-name 'latin->string accessor) array astart aend #'cp869->code-mapper)))
 
 (instantiate-octets-definition define-cp869->string)
 
@@ -2406,7 +2406,7 @@
   (declare (optimize speed (safety 0))
            (type simple-string string)
            (type array-range pos end))
-  (get-latin-bytes #'identity :cp874 string pos end))
+  (get-latin-bytes #'code->cp874-mapper :cp874 string pos end))
 
 (defun string->cp874 (string sstart send null-padding)
   (declare (optimize speed (safety 0))
@@ -2419,14 +2419,14 @@
   (let ((name (make-od-name 'cp874->string* accessor)))
     `(progn
       (defun ,name (string sstart send array astart aend)
-        (,(make-od-name 'latin->string* accessor) string sstart send array astart aend #'identity)))))
+        (,(make-od-name 'latin->string* accessor) string sstart send array astart aend #'cp874->code-mapper)))))
 
 (instantiate-octets-definition define-cp874->string*)
 
 (defmacro define-cp874->string (accessor type)
   (declare (ignore type))
   `(defun ,(make-od-name 'cp874->string accessor) (array astart aend)
-    (,(make-od-name 'latin->string accessor) array astart aend #'identity)))
+    (,(make-od-name 'latin->string accessor) array astart aend #'cp874->code-mapper)))
 
 (instantiate-octets-definition define-cp874->string)
 
diff --git a/src/code/external-formats/enc-iso.lisp b/src/code/external-formats/enc-iso.lisp
index f246aee..dba365b 100644
--- a/src/code/external-formats/enc-iso.lisp
+++ b/src/code/external-formats/enc-iso.lisp
@@ -65,7 +65,7 @@
   (declare (optimize speed (safety 0))
            (type simple-string string)
            (type array-range pos end))
-  (get-latin-bytes #'identity :iso-8859-2 string pos end))
+  (get-latin-bytes #'code->iso-8859-2-mapper :iso-8859-2 string pos end))
 
 (defun string->iso-8859-2 (string sstart send null-padding)
   (declare (optimize speed (safety 0))
@@ -78,14 +78,14 @@
   (let ((name (make-od-name 'iso-8859-2->string* accessor)))
     `(progn
       (defun ,name (string sstart send array astart aend)
-        (,(make-od-name 'latin->string* accessor) string sstart send array astart aend #'identity)))))
+        (,(make-od-name 'latin->string* accessor) string sstart send array astart aend #'iso-8859-2->code-mapper)))))
 
 (instantiate-octets-definition define-iso-8859-2->string*)
 
 (defmacro define-iso-8859-2->string (accessor type)
   (declare (ignore type))
   `(defun ,(make-od-name 'iso-8859-2->string accessor) (array astart aend)
-    (,(make-od-name 'latin->string accessor) array astart aend #'identity)))
+    (,(make-od-name 'latin->string accessor) array astart aend #'iso-8859-2->code-mapper)))
 
 (instantiate-octets-definition define-iso-8859-2->string)
 
@@ -147,7 +147,7 @@
   (declare (optimize speed (safety 0))
            (type simple-string string)
            (type array-range pos end))
-  (get-latin-bytes #'identity :iso-8859-3 string pos end))
+  (get-latin-bytes #'code->iso-8859-3-mapper :iso-8859-3 string pos end))
 
 (defun string->iso-8859-3 (string sstart send null-padding)
   (declare (optimize speed (safety 0))
@@ -160,14 +160,14 @@
   (let ((name (make-od-name 'iso-8859-3->string* accessor)))
     `(progn
       (defun ,name (string sstart send array astart aend)
-        (,(make-od-name 'latin->string* accessor) string sstart send array astart aend #'identity)))))
+        (,(make-od-name 'latin->string* accessor) string sstart send array astart aend #'iso-8859-3->code-mapper)))))
 
 (instantiate-octets-definition define-iso-8859-3->string*)
 
 (defmacro define-iso-8859-3->string (accessor type)
   (declare (ignore type))
   `(defun ,(make-od-name 'iso-8859-3->string accessor) (array astart aend)
-    (,(make-od-name 'latin->string accessor) array astart aend #'identity)))
+    (,(make-od-name 'latin->string accessor) array astart aend #'iso-8859-3->code-mapper)))
 
 (instantiate-octets-definition define-iso-8859-3->string)
 
@@ -244,7 +244,7 @@
   (declare (optimize speed (safety 0))
            (type simple-string string)
            (type array-range pos end))
-  (get-latin-bytes #'identity :iso-8859-4 string pos end))
+  (get-latin-bytes #'code->iso-8859-4-mapper :iso-8859-4 string pos end))
 
 (defun string->iso-8859-4 (string sstart send null-padding)
   (declare (optimize speed (safety 0))
@@ -257,14 +257,14 @@
   (let ((name (make-od-name 'iso-8859-4->string* accessor)))
     `(progn
       (defun ,name (string sstart send array astart aend)
-        (,(make-od-name 'latin->string* accessor) string sstart send array astart aend #'identity)))))
+        (,(make-od-name 'latin->string* accessor) string sstart send array astart aend #'iso-8859-4->code-mapper)))))
 
 (instantiate-octets-definition define-iso-8859-4->string*)
 
 (defmacro define-iso-8859-4->string (accessor type)
   (declare (ignore type))
   `(defun ,(make-od-name 'iso-8859-4->string accessor) (array astart aend)
-    (,(make-od-name 'latin->string accessor) array astart aend #'identity)))
+    (,(make-od-name 'latin->string accessor) array astart aend #'iso-8859-4->code-mapper)))
 
 (instantiate-octets-definition define-iso-8859-4->string)
 
@@ -385,7 +385,7 @@
   (declare (optimize speed (safety 0))
            (type simple-string string)
            (type array-range pos end))
-  (get-latin-bytes #'identity :iso-8859-5 string pos end))
+  (get-latin-bytes #'code->iso-8859-5-mapper :iso-8859-5 string pos end))
 
 (defun string->iso-8859-5 (string sstart send null-padding)
   (declare (optimize speed (safety 0))
@@ -398,14 +398,14 @@
   (let ((name (make-od-name 'iso-8859-5->string* accessor)))
     `(progn
       (defun ,name (string sstart send array astart aend)
-        (,(make-od-name 'latin->string* accessor) string sstart send array astart aend #'identity)))))
+        (,(make-od-name 'latin->string* accessor) string sstart send array astart aend #'iso-8859-5->code-mapper)))))
 
 (instantiate-octets-definition define-iso-8859-5->string*)
 
 (defmacro define-iso-8859-5->string (accessor type)
   (declare (ignore type))
   `(defun ,(make-od-name 'iso-8859-5->string accessor) (array astart aend)
-    (,(make-od-name 'latin->string accessor) array astart aend #'identity)))
+    (,(make-od-name 'latin->string accessor) array astart aend #'iso-8859-5->code-mapper)))
 
 (instantiate-octets-definition define-iso-8859-5->string)
 
@@ -525,7 +525,7 @@
   (declare (optimize speed (safety 0))
            (type simple-string string)
            (type array-range pos end))
-  (get-latin-bytes #'identity :iso-8859-6 string pos end))
+  (get-latin-bytes #'code->iso-8859-6-mapper :iso-8859-6 string pos end))
 
 (defun string->iso-8859-6 (string sstart send null-padding)
   (declare (optimize speed (safety 0))
@@ -538,14 +538,14 @@
   (let ((name (make-od-name 'iso-8859-6->string* accessor)))
     `(progn
       (defun ,name (string sstart send array astart aend)
-        (,(make-od-name 'latin->string* accessor) string sstart send array astart aend #'identity)))))
+        (,(make-od-name 'latin->string* accessor) string sstart send array astart aend #'iso-8859-6->code-mapper)))))
 
 (instantiate-octets-definition define-iso-8859-6->string*)
 
 (defmacro define-iso-8859-6->string (accessor type)
   (declare (ignore type))
   `(defun ,(make-od-name 'iso-8859-6->string accessor) (array astart aend)
-    (,(make-od-name 'latin->string accessor) array astart aend #'identity)))
+    (,(make-od-name 'latin->string accessor) array astart aend #'iso-8859-6->code-mapper)))
 
 (instantiate-octets-definition define-iso-8859-6->string)
 
@@ -652,7 +652,7 @@
   (declare (optimize speed (safety 0))
            (type simple-string string)
            (type array-range pos end))
-  (get-latin-bytes #'identity :iso-8859-7 string pos end))
+  (get-latin-bytes #'code->iso-8859-7-mapper :iso-8859-7 string pos end))
 
 (defun string->iso-8859-7 (string sstart send null-padding)
   (declare (optimize speed (safety 0))
@@ -665,14 +665,14 @@
   (let ((name (make-od-name 'iso-8859-7->string* accessor)))
     `(progn
       (defun ,name (string sstart send array astart aend)
-        (,(make-od-name 'latin->string* accessor) string sstart send array astart aend #'identity)))))
+        (,(make-od-name 'latin->string* accessor) string sstart send array astart aend #'iso-8859-7->code-mapper)))))
 
 (instantiate-octets-definition define-iso-8859-7->string*)
 
 (defmacro define-iso-8859-7->string (accessor type)
   (declare (ignore type))
   `(defun ,(make-od-name 'iso-8859-7->string accessor) (array astart aend)
-    (,(make-od-name 'latin->string accessor) array astart aend #'identity)))
+    (,(make-od-name 'latin->string accessor) array astart aend #'iso-8859-7->code-mapper)))
 
 (instantiate-octets-definition define-iso-8859-7->string)
 
@@ -768,7 +768,7 @@
   (declare (optimize speed (safety 0))
            (type simple-string string)
            (type array-range pos end))
-  (get-latin-bytes #'identity :iso-8859-8 string pos end))
+  (get-latin-bytes #'code->iso-8859-8-mapper :iso-8859-8 string pos end))
 
 (defun string->iso-8859-8 (string sstart send null-padding)
   (declare (optimize speed (safety 0))
@@ -781,14 +781,14 @@
   (let ((name (make-od-name 'iso-8859-8->string* accessor)))
     `(progn
       (defun ,name (string sstart send array astart aend)
-        (,(make-od-name 'latin->string* accessor) string sstart send array astart aend #'identity)))))
+        (,(make-od-name 'latin->string* accessor) string sstart send array astart aend #'iso-8859-8->code-mapper)))))
 
 (instantiate-octets-definition define-iso-8859-8->string*)
 
 (defmacro define-iso-8859-8->string (accessor type)
   (declare (ignore type))
   `(defun ,(make-od-name 'iso-8859-8->string accessor) (array astart aend)
-    (,(make-od-name 'latin->string accessor) array astart aend #'identity)))
+    (,(make-od-name 'latin->string accessor) array astart aend #'iso-8859-8->code-mapper)))
 
 (instantiate-octets-definition define-iso-8859-8->string)
 
@@ -821,7 +821,7 @@
   (declare (optimize speed (safety 0))
            (type simple-string string)
            (type array-range pos end))
-  (get-latin-bytes #'identity :iso-8859-9 string pos end))
+  (get-latin-bytes #'code->iso-8859-9-mapper :iso-8859-9 string pos end))
 
 (defun string->iso-8859-9 (string sstart send null-padding)
   (declare (optimize speed (safety 0))
@@ -834,14 +834,14 @@
   (let ((name (make-od-name 'iso-8859-9->string* accessor)))
     `(progn
       (defun ,name (string sstart send array astart aend)
-        (,(make-od-name 'latin->string* accessor) string sstart send array astart aend #'identity)))))
+        (,(make-od-name 'latin->string* accessor) string sstart send array astart aend #'iso-8859-9->code-mapper)))))
 
 (instantiate-octets-definition define-iso-8859-9->string*)
 
 (defmacro define-iso-8859-9->string (accessor type)
   (declare (ignore type))
   `(defun ,(make-od-name 'iso-8859-9->string accessor) (array astart aend)
-    (,(make-od-name 'latin->string accessor) array astart aend #'identity)))
+    (,(make-od-name 'latin->string accessor) array astart aend #'iso-8859-9->code-mapper)))
 
 (instantiate-octets-definition define-iso-8859-9->string)
 
@@ -914,7 +914,7 @@
   (declare (optimize speed (safety 0))
            (type simple-string string)
            (type array-range pos end))
-  (get-latin-bytes #'identity :iso-8859-10 string pos end))
+  (get-latin-bytes #'code->iso-8859-10-mapper :iso-8859-10 string pos end))
 
 (defun string->iso-8859-10 (string sstart send null-padding)
   (declare (optimize speed (safety 0))
@@ -927,14 +927,14 @@
   (let ((name (make-od-name 'iso-8859-10->string* accessor)))
     `(progn
       (defun ,name (string sstart send array astart aend)
-        (,(make-od-name 'latin->string* accessor) string sstart send array astart aend #'identity)))))
+        (,(make-od-name 'latin->string* accessor) string sstart send array astart aend #'iso-8859-10->code-mapper)))))
 
 (instantiate-octets-definition define-iso-8859-10->string*)
 
 (defmacro define-iso-8859-10->string (accessor type)
   (declare (ignore type))
   `(defun ,(make-od-name 'iso-8859-10->string accessor) (array astart aend)
-    (,(make-od-name 'latin->string accessor) array astart aend #'identity)))
+    (,(make-od-name 'latin->string accessor) array astart aend #'iso-8859-10->code-mapper)))
 
 (instantiate-octets-definition define-iso-8859-10->string)
 
@@ -1056,7 +1056,7 @@
   (declare (optimize speed (safety 0))
            (type simple-string string)
            (type array-range pos end))
-  (get-latin-bytes #'identity :iso-8859-11 string pos end))
+  (get-latin-bytes #'code->iso-8859-11-mapper :iso-8859-11 string pos end))
 
 (defun string->iso-8859-11 (string sstart send null-padding)
   (declare (optimize speed (safety 0))
@@ -1069,14 +1069,14 @@
   (let ((name (make-od-name 'iso-8859-11->string* accessor)))
     `(progn
       (defun ,name (string sstart send array astart aend)
-        (,(make-od-name 'latin->string* accessor) string sstart send array astart aend #'identity)))))
+        (,(make-od-name 'latin->string* accessor) string sstart send array astart aend #'iso-8859-11->code-mapper)))))
 
 (instantiate-octets-definition define-iso-8859-11->string*)
 
 (defmacro define-iso-8859-11->string (accessor type)
   (declare (ignore type))
   `(defun ,(make-od-name 'iso-8859-11->string accessor) (array astart aend)
-    (,(make-od-name 'latin->string accessor) array astart aend #'identity)))
+    (,(make-od-name 'latin->string accessor) array astart aend #'iso-8859-11->code-mapper)))
 
 (instantiate-octets-definition define-iso-8859-11->string)
 
@@ -1159,7 +1159,7 @@
   (declare (optimize speed (safety 0))
            (type simple-string string)
            (type array-range pos end))
-  (get-latin-bytes #'identity :iso-8859-13 string pos end))
+  (get-latin-bytes #'code->iso-8859-13-mapper :iso-8859-13 string pos end))
 
 (defun string->iso-8859-13 (string sstart send null-padding)
   (declare (optimize speed (safety 0))
@@ -1172,14 +1172,14 @@
   (let ((name (make-od-name 'iso-8859-13->string* accessor)))
     `(progn
       (defun ,name (string sstart send array astart aend)
-        (,(make-od-name 'latin->string* accessor) string sstart send array astart aend #'identity)))))
+        (,(make-od-name 'latin->string* accessor) string sstart send array astart aend #'iso-8859-13->code-mapper)))))
 
 (instantiate-octets-definition define-iso-8859-13->string*)
 
 (defmacro define-iso-8859-13->string (accessor type)
   (declare (ignore type))
   `(defun ,(make-od-name 'iso-8859-13->string accessor) (array astart aend)
-    (,(make-od-name 'latin->string accessor) array astart aend #'identity)))
+    (,(make-od-name 'latin->string accessor) array astart aend #'iso-8859-13->code-mapper)))
 
 (instantiate-octets-definition define-iso-8859-13->string)
 
@@ -1237,7 +1237,7 @@
   (declare (optimize speed (safety 0))
            (type simple-string string)
            (type array-range pos end))
-  (get-latin-bytes #'identity :iso-8859-14 string pos end))
+  (get-latin-bytes #'code->iso-8859-14-mapper :iso-8859-14 string pos end))
 
 (defun string->iso-8859-14 (string sstart send null-padding)
   (declare (optimize speed (safety 0))
@@ -1250,14 +1250,14 @@
   (let ((name (make-od-name 'iso-8859-14->string* accessor)))
     `(progn
       (defun ,name (string sstart send array astart aend)
-        (,(make-od-name 'latin->string* accessor) string sstart send array astart aend #'identity)))))
+        (,(make-od-name 'latin->string* accessor) string sstart send array astart aend #'iso-8859-14->code-mapper)))))
 
 (instantiate-octets-definition define-iso-8859-14->string*)
 
 (defmacro define-iso-8859-14->string (accessor type)
   (declare (ignore type))
   `(defun ,(make-od-name 'iso-8859-14->string accessor) (array astart aend)
-    (,(make-od-name 'latin->string accessor) array astart aend #'identity)))
+    (,(make-od-name 'latin->string accessor) array astart aend #'iso-8859-14->code-mapper)))
 
 (instantiate-octets-definition define-iso-8859-14->string)
 
diff --git a/src/code/external-formats/enc-win.lisp b/src/code/external-formats/enc-win.lisp
index b223f01..3053734 100644
--- a/src/code/external-formats/enc-win.lisp
+++ b/src/code/external-formats/enc-win.lisp
@@ -87,7 +87,7 @@
   (declare (optimize speed (safety 0))
            (type simple-string string)
            (type array-range pos end))
-  (get-latin-bytes #'identity :cp1250 string pos end))
+  (get-latin-bytes #'code->cp1250-mapper :cp1250 string pos end))
 
 (defun string->cp1250 (string sstart send null-padding)
   (declare (optimize speed (safety 0))
@@ -100,14 +100,14 @@
   (let ((name (make-od-name 'cp1250->string* accessor)))
     `(progn
       (defun ,name (string sstart send array astart aend)
-        (,(make-od-name 'latin->string* accessor) string sstart send array astart aend #'identity)))))
+        (,(make-od-name 'latin->string* accessor) string sstart send array astart aend #'cp1250->code-mapper)))))
 
 (instantiate-octets-definition define-cp1250->string*)
 
 (defmacro define-cp1250->string (accessor type)
   (declare (ignore type))
   `(defun ,(make-od-name 'cp1250->string accessor) (array astart aend)
-    (,(make-od-name 'latin->string accessor) array astart aend #'identity)))
+    (,(make-od-name 'latin->string accessor) array astart aend #'cp1250->code-mapper)))
 
 (instantiate-octets-definition define-cp1250->string)
 
@@ -247,7 +247,7 @@
   (declare (optimize speed (safety 0))
            (type simple-string string)
            (type array-range pos end))
-  (get-latin-bytes #'identity :cp1251 string pos end))
+  (get-latin-bytes #'code->cp1251-mapper :cp1251 string pos end))
 
 (defun string->cp1251 (string sstart send null-padding)
   (declare (optimize speed (safety 0))
@@ -260,14 +260,14 @@
   (let ((name (make-od-name 'cp1251->string* accessor)))
     `(progn
       (defun ,name (string sstart send array astart aend)
-        (,(make-od-name 'latin->string* accessor) string sstart send array astart aend #'identity)))))
+        (,(make-od-name 'latin->string* accessor) string sstart send array astart aend #'cp1251->code-mapper)))))
 
 (instantiate-octets-definition define-cp1251->string*)
 
 (defmacro define-cp1251->string (accessor type)
   (declare (ignore type))
   `(defun ,(make-od-name 'cp1251->string accessor) (array astart aend)
-    (,(make-od-name 'latin->string accessor) array astart aend #'identity)))
+    (,(make-od-name 'latin->string accessor) array astart aend #'cp1251->code-mapper)))
 
 (instantiate-octets-definition define-cp1251->string)
 
@@ -326,7 +326,7 @@
   (declare (optimize speed (safety 0))
            (type simple-string string)
            (type array-range pos end))
-  (get-latin-bytes #'identity :cp1252 string pos end))
+  (get-latin-bytes #'code->cp1252-mapper :cp1252 string pos end))
 
 (defun string->cp1252 (string sstart send null-padding)
   (declare (optimize speed (safety 0))
@@ -339,14 +339,14 @@
   (let ((name (make-od-name 'cp1252->string* accessor)))
     `(progn
       (defun ,name (string sstart send array astart aend)
-        (,(make-od-name 'latin->string* accessor) string sstart send array astart aend #'identity)))))
+        (,(make-od-name 'latin->string* accessor) string sstart send array astart aend #'cp1252->code-mapper)))))
 
 (instantiate-octets-definition define-cp1252->string*)
 
 (defmacro define-cp1252->string (accessor type)
   (declare (ignore type))
   `(defun ,(make-od-name 'cp1252->string accessor) (array astart aend)
-    (,(make-od-name 'latin->string accessor) array astart aend #'identity)))
+    (,(make-od-name 'latin->string accessor) array astart aend #'cp1252->code-mapper)))
 
 (instantiate-octets-definition define-cp1252->string)
 
@@ -480,7 +480,7 @@
   (declare (optimize speed (safety 0))
            (type simple-string string)
            (type array-range pos end))
-  (get-latin-bytes #'identity :cp1253 string pos end))
+  (get-latin-bytes #'code->cp1253-mapper :cp1253 string pos end))
 
 (defun string->cp1253 (string sstart send null-padding)
   (declare (optimize speed (safety 0))
@@ -493,14 +493,14 @@
   (let ((name (make-od-name 'cp1253->string* accessor)))
     `(progn
       (defun ,name (string sstart send array astart aend)
-        (,(make-od-name 'latin->string* accessor) string sstart send array astart aend #'identity)))))
+        (,(make-od-name 'latin->string* accessor) string sstart send array astart aend #'cp1253->code-mapper)))))
 
 (instantiate-octets-definition define-cp1253->string*)
 
 (defmacro define-cp1253->string (accessor type)
   (declare (ignore type))
   `(defun ,(make-od-name 'cp1253->string accessor) (array astart aend)
-    (,(make-od-name 'latin->string accessor) array astart aend #'identity)))
+    (,(make-od-name 'latin->string accessor) array astart aend #'cp1253->code-mapper)))
 
 (instantiate-octets-definition define-cp1253->string)
 
@@ -565,7 +565,7 @@
   (declare (optimize speed (safety 0))
            (type simple-string string)
            (type array-range pos end))
-  (get-latin-bytes #'identity :cp1254 string pos end))
+  (get-latin-bytes #'code->cp1254-mapper :cp1254 string pos end))
 
 (defun string->cp1254 (string sstart send null-padding)
   (declare (optimize speed (safety 0))
@@ -578,14 +578,14 @@
   (let ((name (make-od-name 'cp1254->string* accessor)))
     `(progn
       (defun ,name (string sstart send array astart aend)
-        (,(make-od-name 'latin->string* accessor) string sstart send array astart aend #'identity)))))
+        (,(make-od-name 'latin->string* accessor) string sstart send array astart aend #'cp1254->code-mapper)))))
 
 (instantiate-octets-definition define-cp1254->string*)
 
 (defmacro define-cp1254->string (accessor type)
   (declare (ignore type))
   `(defun ,(make-od-name 'cp1254->string accessor) (array astart aend)
-    (,(make-od-name 'latin->string accessor) array astart aend #'identity)))
+    (,(make-od-name 'latin->string accessor) array astart aend #'cp1254->code-mapper)))
 
 (instantiate-octets-definition define-cp1254->string)
 
@@ -711,7 +711,7 @@
   (declare (optimize speed (safety 0))
            (type simple-string string)
            (type array-range pos end))
-  (get-latin-bytes #'identity :cp1255 string pos end))
+  (get-latin-bytes #'code->cp1255-mapper :cp1255 string pos end))
 
 (defun string->cp1255 (string sstart send null-padding)
   (declare (optimize speed (safety 0))
@@ -724,14 +724,14 @@
   (let ((name (make-od-name 'cp1255->string* accessor)))
     `(progn
       (defun ,name (string sstart send array astart aend)
-        (,(make-od-name 'latin->string* accessor) string sstart send array astart aend #'identity)))))
+        (,(make-od-name 'latin->string* accessor) string sstart send array astart aend #'cp1255->code-mapper)))))
 
 (instantiate-octets-definition define-cp1255->string*)
 
 (defmacro define-cp1255->string (accessor type)
   (declare (ignore type))
   `(defun ,(make-od-name 'cp1255->string accessor) (array astart aend)
-    (,(make-od-name 'latin->string accessor) array astart aend #'identity)))
+    (,(make-od-name 'latin->string accessor) array astart aend #'cp1255->code-mapper)))
 
 (instantiate-octets-definition define-cp1255->string)
 
@@ -843,7 +843,7 @@
   (declare (optimize speed (safety 0))
            (type simple-string string)
            (type array-range pos end))
-  (get-latin-bytes #'identity :cp1256 string pos end))
+  (get-latin-bytes #'code->cp1256-mapper :cp1256 string pos end))
 
 (defun string->cp1256 (string sstart send null-padding)
   (declare (optimize speed (safety 0))
@@ -856,14 +856,14 @@
   (let ((name (make-od-name 'cp1256->string* accessor)))
     `(progn
       (defun ,name (string sstart send array astart aend)
-        (,(make-od-name 'latin->string* accessor) string sstart send array astart aend #'identity)))))
+        (,(make-od-name 'latin->string* accessor) string sstart send array astart aend #'cp1256->code-mapper)))))
 
 (instantiate-octets-definition define-cp1256->string*)
 
 (defmacro define-cp1256->string (accessor type)
   (declare (ignore type))
   `(defun ,(make-od-name 'cp1256->string accessor) (array astart aend)
-    (,(make-od-name 'latin->string accessor) array astart aend #'identity)))
+    (,(make-od-name 'latin->string accessor) array astart aend #'cp1256->code-mapper)))
 
 (instantiate-octets-definition define-cp1256->string)
 
@@ -977,7 +977,7 @@
   (declare (optimize speed (safety 0))
            (type simple-string string)
            (type array-range pos end))
-  (get-latin-bytes #'identity :cp1257 string pos end))
+  (get-latin-bytes #'code->cp1257-mapper :cp1257 string pos end))
 
 (defun string->cp1257 (string sstart send null-padding)
   (declare (optimize speed (safety 0))
@@ -990,14 +990,14 @@
   (let ((name (make-od-name 'cp1257->string* accessor)))
     `(progn
       (defun ,name (string sstart send array astart aend)
-        (,(make-od-name 'latin->string* accessor) string sstart send array astart aend #'identity)))))
+        (,(make-od-name 'latin->string* accessor) string sstart send array astart aend #'cp1257->code-mapper)))))
 
 (instantiate-octets-definition define-cp1257->string*)
 
 (defmacro define-cp1257->string (accessor type)
   (declare (ignore type))
   `(defun ,(make-od-name 'cp1257->string accessor) (array astart aend)
-    (,(make-od-name 'latin->string accessor) array astart aend #'identity)))
+    (,(make-od-name 'latin->string accessor) array astart aend #'cp1257->code-mapper)))
 
 (instantiate-octets-definition define-cp1257->string)
 
@@ -1070,7 +1070,7 @@
   (declare (optimize speed (safety 0))
            (type simple-string string)
            (type array-range pos end))
-  (get-latin-bytes #'identity :cp1258 string pos end))
+  (get-latin-bytes #'code->cp1258-mapper :cp1258 string pos end))
 
 (defun string->cp1258 (string sstart send null-padding)
   (declare (optimize speed (safety 0))
@@ -1083,14 +1083,14 @@
   (let ((name (make-od-name 'cp1258->string* accessor)))
     `(progn
       (defun ,name (string sstart send array astart aend)
-        (,(make-od-name 'latin->string* accessor) string sstart send array astart aend #'identity)))))
+        (,(make-od-name 'latin->string* accessor) string sstart send array astart aend #'cp1258->code-mapper)))))
 
 (instantiate-octets-definition define-cp1258->string*)
 
 (defmacro define-cp1258->string (accessor type)
   (declare (ignore type))
   `(defun ,(make-od-name 'cp1258->string accessor) (array astart aend)
-    (,(make-od-name 'latin->string accessor) array astart aend #'identity)))
+    (,(make-od-name 'latin->string accessor) array astart aend #'cp1258->code-mapper)))
 
 (instantiate-octets-definition define-cp1258->string)
 
diff --git a/tests/external-format.impure.lisp b/tests/external-format.impure.lisp
index 09953f3..a642770 100644
--- a/tests/external-format.impure.lisp
+++ b/tests/external-format.impure.lisp
@@ -211,6 +211,16 @@
   (let ((char (read-char s)))
     (assert (= (char-code (eval char)) #xB0))))
 (delete-file "external-format-test.txt")
+
+(let* ((koi8-r-codes (coerce '(240 210 201 215 197 212 33) '(vector (unsigned-byte 8))))
+       (uni-codes #(1055 1088 1080 1074 1077 1090 33))
+
+       (string (octets-to-string koi8-r-codes :external-format :koi8-r))
+       (uni-decoded (map 'vector #'char-code string)))
+  (assert (equalp (map 'vector #'char-code (octets-to-string koi8-r-codes :external-format :koi8-r))
+                  uni-codes))
+  (assert (equalp (string-to-octets (map 'string #'code-char uni-codes) :external-format :koi8-r)
+                  koi8-r-codes)))
 
 ;;; tests of FILE-STRING-LENGTH
 (let ((standard-characters "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789!$\"'(),_-./:;?+<=>#%&*@[\\]{|}`^~"))
diff --git a/version.lisp-expr b/version.lisp-expr
index e93c3b4..a3f3b13 100644
--- a/version.lisp-expr
+++ b/version.lisp-expr
@@ -17,4 +17,4 @@
 ;;; checkins which aren't released. (And occasionally for internal
 ;;; versions, especially for internal versions off the main CVS
 ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
-"0.9.9.7"
+"0.9.9.8"
-- 
1.7.10.4