Steel Bank Common Lisp

Update of /cvsroot/sbcl/sbcl/src/code/external-formats
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv24821/src/code/external-formats

Modified Files:
	enc-cyr.lisp enc-dos.lisp enc-iso.lisp enc-win.lisp 
Log Message:
0.9.9.8:
        * Merge a patch by Ivan Boldyrev fixing character code
          conversions for OCTETS-TO-STRING and STRING-TO-OCTETS.


Index: enc-cyr.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/code/external-formats/enc-cyr.lisp,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -d -r1.2 -r1.3
--- enc-cyr.lisp	31 Aug 2005 14:12:37 -0000	1.2
+++ enc-cyr.lisp	28 Jan 2006 08:52:35 -0000	1.3
@@ -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)
 

Index: enc-dos.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/code/external-formats/enc-dos.lisp,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -d -r1.2 -r1.3
--- enc-dos.lisp	31 Aug 2005 14:12:37 -0000	1.2
+++ enc-dos.lisp	28 Jan 2006 08:52:35 -0000	1.3
@@ -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)
 

Index: enc-iso.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/code/external-formats/enc-iso.lisp,v
retrieving revision 1.3
retrieving revision 1.4
diff -u -d -r1.3 -r1.4
--- enc-iso.lisp	19 Jan 2006 17:02:33 -0000	1.3
+++ enc-iso.lisp	28 Jan 2006 08:52:35 -0000	1.4
@@ -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)
 

Index: enc-win.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/code/external-formats/enc-win.lisp,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -d -r1.2 -r1.3
--- enc-win.lisp	31 Aug 2005 14:12:37 -0000	1.2
+++ enc-win.lisp	28 Jan 2006 08:52:35 -0000	1.3
@@ -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)