[Sbcl-commits] CVS: sbcl/src/code/external-formats enc-basic.lisp, 1.2, 1.3 enc-cyr.lisp, 1.6, 1.7 enc-dos.lisp, 1.6, 1.7 enc-ebcdic.lisp, 1.2, 1.3 enc-iso.lisp, 1.8, 1.9 enc-win.lisp, 1.6, 1.7

[Christophe R. <cr...@us...>]

Update of /cvsroot/sbcl/sbcl/src/code/external-formats
In directory fdv4jf1.ch3.sourceforge.com:/tmp/cvs-serv32442/src/code/external-formats

Modified Files:
	enc-basic.lisp enc-cyr.lisp enc-dos.lisp enc-ebcdic.lisp 
	enc-iso.lisp enc-win.lisp 
Log Message:
1.0.32.21: compress most unibyte-external-format definitions

All the unibyte-mapper-based external-formats had huge amounts of
cut-and-pasted code, differing only in names of functions.  This is,
oddly enough, a clear case for abstracting away the repeated code into a
macro.

In the process, convert them to the multibyte apparatus, which has support
for the nice restarts, and remove the too-simple unibyte
DEFINE-EXTERNAL-FORMAT (and EXTERNAL-FORMAT-DECODING-ERROR) which are now
unused.

Include a far-from-comprehensive set of tests, which are mostly for
iso-8859-x formats


Index: enc-basic.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/code/external-formats/enc-basic.lisp,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -d -r1.2 -r1.3
--- enc-basic.lisp	11 Nov 2009 13:52:19 -0000	1.2
+++ enc-basic.lisp	11 Nov 2009 17:34:09 -0000	1.3
@@ -59,13 +59,14 @@
                 finally (return (coerce string 'simple-string))))))))
 (instantiate-octets-definition define-ascii->string)
 
-(define-external-format (:ascii :us-ascii :ansi_x3.4-1968
-                         :iso-646 :iso-646-us :|646|)
-    1 t
+(define-unibyte-external-format :ascii
+    (:us-ascii :ansi_x3.4-1968 :iso-646 :iso-646-us :|646|)
   (if (>= bits 128)
       (external-format-encoding-error stream bits)
       (setf (sap-ref-8 sap tail) bits))
-  (code-char byte)
+  (if (>= byte 128)
+      (return-from decode-break-reason 1)
+      (code-char byte))
   ascii->string-aref
   string->ascii)
 
@@ -101,8 +102,7 @@
 ;;; Multiple names for the :ISO{,-}8859-* families are needed because on
 ;;; FreeBSD (and maybe other BSD systems), nl_langinfo("LATIN-1") will
 ;;; return "ISO8859-1" instead of "ISO-8859-1".
-(define-external-format (:latin-1 :latin1 :iso-8859-1 :iso8859-1)
-    1 t
+(define-unibyte-external-format :latin-1 (:latin1 :iso-8859-1 :iso8859-1)
   (if (>= bits 256)
       (external-format-encoding-error stream bits)
       (setf (sap-ref-8 sap tail) bits))

Index: enc-cyr.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/code/external-formats/enc-cyr.lisp,v
retrieving revision 1.6
retrieving revision 1.7
diff -u -d -r1.6 -r1.7
--- enc-cyr.lisp	29 Sep 2009 01:02:20 -0000	1.6
+++ enc-cyr.lisp	11 Nov 2009 17:34:09 -0000	1.7
@@ -1,6 +1,6 @@
 (in-package "SB!IMPL")
 
-(define-unibyte-mapper koi8-r->code-mapper code->koi8-r-mapper
+(define-unibyte-mapping-external-format :koi8-r (:|koi8-r|)
   (#x80 #x2500) ; BOX DRAWINGS LIGHT HORIZONTAL
   (#x81 #x2502) ; BOX DRAWINGS LIGHT VERTICAL
   (#x82 #x250C) ; BOX DRAWINGS LIGHT DOWN AND RIGHT
@@ -131,49 +131,7 @@
   (#xFF #x042A) ; CYRILLIC CAPITAL LETTER HARD SIGN
 )
 
-(declaim (inline get-koi8-r-bytes))
-(defun get-koi8-r-bytes (string pos)
-  (declare (optimize speed (safety 0))
-           (type simple-string string)
-           (type array-range pos))
-  (get-latin-bytes #'code->koi8-r-mapper :koi8-r string pos))
-
-(defun string->koi8-r (string sstart send null-padding)
-  (declare (optimize speed (safety 0))
-           (type simple-string string)
-           (type array-range sstart send))
-  (values (string->latin% string sstart send #'get-koi8-r-bytes null-padding)))
-
-(defmacro define-koi8-r->string* (accessor type)
-  (declare (ignore type))
-  (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 #'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 #'koi8-r->code-mapper)))
-
-(instantiate-octets-definition define-koi8-r->string)
-
-(define-external-format (:koi8-r :|koi8-r|)
-    1 t
-    (let ((koi8-r-byte (code->koi8-r-mapper bits)))
-      (if koi8-r-byte
-          (setf (sap-ref-8 sap tail) koi8-r-byte)
-          (external-format-encoding-error stream bits)))
-    (let ((code (koi8-r->code-mapper byte)))
-      (if code
-          (code-char code)
-          (external-format-decoding-error stream byte)))
-    koi8-r->string-aref
-    string->koi8-r) ;; TODO -- error check
-
-(define-unibyte-mapper koi8-u->code-mapper code->koi8-u-mapper
+(define-unibyte-mapping-external-format :koi8-u (:|koi8-u|)
   (#x80 #x2500) ; BOX DRAWINGS LIGHT HORIZONTAL
   (#x81 #x2502) ; BOX DRAWINGS LIGHT VERTICAL
   (#x82 #x250C) ; BOX DRAWINGS LIGHT DOWN AND RIGHT
@@ -304,49 +262,7 @@
   (#xFF #x042A) ; CYRILLIC CAPITAL LETTER HARD SIGN
 )
 
-(declaim (inline get-koi8-u-bytes))
-(defun get-koi8-u-bytes (string pos)
-  (declare (optimize speed (safety 0))
-           (type simple-string string)
-           (type array-range pos))
-  (get-latin-bytes #'code->koi8-u-mapper :koi8-u string pos))
-
-(defun string->koi8-u (string sstart send null-padding)
-  (declare (optimize speed (safety 0))
-           (type simple-string string)
-           (type array-range sstart send))
-  (values (string->latin% string sstart send #'get-koi8-u-bytes null-padding)))
-
-(defmacro define-koi8-u->string* (accessor type)
-  (declare (ignore type))
-  (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 #'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 #'koi8-u->code-mapper)))
-
-(instantiate-octets-definition define-koi8-u->string)
-
-(define-external-format (:koi8-u :|koi8-u|)
-    1 t
-    (let ((koi8-u-byte (code->koi8-u-mapper bits)))
-      (if koi8-u-byte
-          (setf (sap-ref-8 sap tail) koi8-u-byte)
-          (external-format-encoding-error stream bits)))
-    (let ((code (koi8-u->code-mapper byte)))
-      (if code
-          (code-char code)
-          (external-format-decoding-error stream byte)))
-    koi8-u->string-aref
-    string->koi8-u) ;; TODO -- error check
-
-(define-unibyte-mapper x-mac-cyrillic->code-mapper code->x-mac-cyrillic-mapper
+(define-unibyte-mapping-external-format :x-mac-cyrillic (:|x-mac-cyrillic|)
   (#x80 #x0410) ; CYRILLIC CAPITAL LETTER A
   (#x81 #x0411) ; CYRILLIC CAPITAL LETTER BE
   (#x82 #x0412) ; CYRILLIC CAPITAL LETTER VE
@@ -471,45 +387,3 @@
   (#xFE #x044E) ; CYRILLIC SMALL LETTER YU
   (#xFF #x00A4) ; CURRENCY SIGN
 )
-
-(declaim (inline get-x-mac-cyrillic-bytes))
-(defun get-x-mac-cyrillic-bytes (string pos)
-  (declare (optimize speed (safety 0))
-           (type simple-string string)
-           (type array-range pos))
-  (get-latin-bytes #'code->x-mac-cyrillic-mapper :x-mac-cyrillic string pos))
-
-(defun string->x-mac-cyrillic (string sstart send null-padding)
-  (declare (optimize speed (safety 0))
-           (type simple-string string)
-           (type array-range sstart send))
-  (values (string->latin% string sstart send #'get-x-mac-cyrillic-bytes null-padding)))
-
-(defmacro define-x-mac-cyrillic->string* (accessor type)
-  (declare (ignore type))
-  (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 #'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 #'x-mac-cyrillic->code-mapper)))
-
-(instantiate-octets-definition define-x-mac-cyrillic->string)
-
-(define-external-format (:x-mac-cyrillic :|x-mac-cyrillic|)
-    1 t
-    (let ((x-mac-cyrillic-byte (code->x-mac-cyrillic-mapper bits)))
-      (if x-mac-cyrillic-byte
-          (setf (sap-ref-8 sap tail) x-mac-cyrillic-byte)
-          (external-format-encoding-error stream bits)))
-    (let ((code (x-mac-cyrillic->code-mapper byte)))
-      (if code
-          (code-char code)
-          (external-format-decoding-error stream byte)))
-    x-mac-cyrillic->string-aref
-    string->x-mac-cyrillic) ;; TODO -- error check

Index: enc-dos.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/code/external-formats/enc-dos.lisp,v
retrieving revision 1.6
retrieving revision 1.7
diff -u -d -r1.6 -r1.7
--- enc-dos.lisp	29 Sep 2009 01:02:20 -0000	1.6
+++ enc-dos.lisp	11 Nov 2009 17:34:09 -0000	1.7
@@ -1,6 +1,6 @@
 (in-package "SB!IMPL")
 
-(define-unibyte-mapper cp437->code-mapper code->cp437-mapper
+(define-unibyte-mapping-external-format :cp437 (:|cp437|)
   (#x80 #x00C7) ; LATIN CAPITAL LETTER C WITH CEDILLA
   (#x81 #x00FC) ; LATIN SMALL LETTER U WITH DIAERESIS
   (#x82 #x00E9) ; LATIN SMALL LETTER E WITH ACUTE
@@ -131,49 +131,7 @@
   (#xFF #x00A0) ; NO-BREAK SPACE
 )
 
-(declaim (inline get-cp437-bytes))
-(defun get-cp437-bytes (string pos)
-  (declare (optimize speed (safety 0))
-           (type simple-string string)
-           (type array-range pos))
-  (get-latin-bytes #'code->cp437-mapper :cp437 string pos))
-
-(defun string->cp437 (string sstart send null-padding)
-  (declare (optimize speed (safety 0))
-           (type simple-string string)
-           (type array-range sstart send))
-  (values (string->latin% string sstart send #'get-cp437-bytes null-padding)))
-
-(defmacro define-cp437->string* (accessor type)
-  (declare (ignore type))
-  (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 #'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 #'cp437->code-mapper)))
-
-(instantiate-octets-definition define-cp437->string)
-
-(define-external-format (:cp437 :|cp437|)
-    1 t
-    (let ((cp437-byte (code->cp437-mapper bits)))
-      (if cp437-byte
-          (setf (sap-ref-8 sap tail) cp437-byte)
-          (external-format-encoding-error stream bits)))
-    (let ((code (cp437->code-mapper byte)))
-      (if code
-          (code-char code)
-          (external-format-decoding-error stream byte)))
-    cp437->string-aref
-    string->cp437) ;; TODO -- error check
-
-(define-unibyte-mapper cp850->code-mapper code->cp850-mapper
+(define-unibyte-mapping-external-format :cp850 (:|cp850|)
   (#x80 #x00C7) ; LATIN CAPITAL LETTER C WITH CEDILLA
   (#x81 #x00FC) ; LATIN SMALL LETTER U WITH DIAERESIS
   (#x82 #x00E9) ; LATIN SMALL LETTER E WITH ACUTE
@@ -304,49 +262,7 @@
   (#xFF #x00A0) ; NO-BREAK SPACE
 )
 
-(declaim (inline get-cp850-bytes))
-(defun get-cp850-bytes (string pos)
-  (declare (optimize speed (safety 0))
-           (type simple-string string)
-           (type array-range pos))
-  (get-latin-bytes #'code->cp850-mapper :cp850 string pos))
-
-(defun string->cp850 (string sstart send null-padding)
-  (declare (optimize speed (safety 0))
-           (type simple-string string)
-           (type array-range sstart send))
-  (values (string->latin% string sstart send #'get-cp850-bytes null-padding)))
-
-(defmacro define-cp850->string* (accessor type)
-  (declare (ignore type))
-  (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 #'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 #'cp850->code-mapper)))
-
-(instantiate-octets-definition define-cp850->string)
-
-(define-external-format (:cp850 :|cp850|)
-    1 t
-    (let ((cp850-byte (code->cp850-mapper bits)))
-      (if cp850-byte
-          (setf (sap-ref-8 sap tail) cp850-byte)
-          (external-format-encoding-error stream bits)))
-    (let ((code (cp850->code-mapper byte)))
-      (if code
-          (code-char code)
-          (external-format-decoding-error stream byte)))
-    cp850->string-aref
-    string->cp850) ;; TODO -- error check
-
-(define-unibyte-mapper cp852->code-mapper code->cp852-mapper
+(define-unibyte-mapping-external-format :cp852 (:|cp852|)
   (#x80 #x00C7) ; LATIN CAPITAL LETTER C WITH CEDILLA
   (#x81 #x00FC) ; LATIN SMALL LETTER U WITH DIAERESIS
   (#x82 #x00E9) ; LATIN SMALL LETTER E WITH ACUTE
@@ -477,49 +393,7 @@
   (#xFF #x00A0) ; NO-BREAK SPACE
 )
 
-(declaim (inline get-cp852-bytes))
-(defun get-cp852-bytes (string pos)
-  (declare (optimize speed (safety 0))
-           (type simple-string string)
-           (type array-range pos))
-  (get-latin-bytes #'code->cp852-mapper :cp852 string pos))
-
-(defun string->cp852 (string sstart send null-padding)
-  (declare (optimize speed (safety 0))
-           (type simple-string string)
-           (type array-range sstart send))
-  (values (string->latin% string sstart send #'get-cp852-bytes null-padding)))
-
-(defmacro define-cp852->string* (accessor type)
-  (declare (ignore type))
-  (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 #'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 #'cp852->code-mapper)))
-
-(instantiate-octets-definition define-cp852->string)
-
-(define-external-format (:cp852 :|cp852|)
-    1 t
-    (let ((cp852-byte (code->cp852-mapper bits)))
-      (if cp852-byte
-          (setf (sap-ref-8 sap tail) cp852-byte)
-          (external-format-encoding-error stream bits)))
-    (let ((code (cp852->code-mapper byte)))
-      (if code
-          (code-char code)
-          (external-format-decoding-error stream byte)))
-    cp852->string-aref
-    string->cp852) ;; TODO -- error check
-
-(define-unibyte-mapper cp855->code-mapper code->cp855-mapper
+(define-unibyte-mapping-external-format :cp855 (:|cp855|)
   (#x80 #x0452) ; CYRILLIC SMALL LETTER DJE
   (#x81 #x0402) ; CYRILLIC CAPITAL LETTER DJE
   (#x82 #x0453) ; CYRILLIC SMALL LETTER GJE
@@ -650,49 +524,7 @@
   (#xFF #x00A0) ; NO-BREAK SPACE
 )
 
-(declaim (inline get-cp855-bytes))
-(defun get-cp855-bytes (string pos)
-  (declare (optimize speed (safety 0))
-           (type simple-string string)
-           (type array-range pos))
-  (get-latin-bytes #'code->cp855-mapper :cp855 string pos))
-
-(defun string->cp855 (string sstart send null-padding)
-  (declare (optimize speed (safety 0))
-           (type simple-string string)
-           (type array-range sstart send))
-  (values (string->latin% string sstart send #'get-cp855-bytes null-padding)))
-
-(defmacro define-cp855->string* (accessor type)
-  (declare (ignore type))
-  (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 #'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 #'cp855->code-mapper)))
-
-(instantiate-octets-definition define-cp855->string)
-
-(define-external-format (:cp855 :|cp855|)
-    1 t
-    (let ((cp855-byte (code->cp855-mapper bits)))
-      (if cp855-byte
-          (setf (sap-ref-8 sap tail) cp855-byte)
-          (external-format-encoding-error stream bits)))
-    (let ((code (cp855->code-mapper byte)))
-      (if code
-          (code-char code)
-          (external-format-decoding-error stream byte)))
-    cp855->string-aref
-    string->cp855) ;; TODO -- error check
-
-(define-unibyte-mapper cp857->code-mapper code->cp857-mapper
+(define-unibyte-mapping-external-format :cp857 (:|cp857|)
   (#x80 #x00C7) ; LATIN CAPITAL LETTER C WITH CEDILLA
   (#x81 #x00FC) ; LATIN SMALL LETTER U WITH DIAERESIS
   (#x82 #x00E9) ; LATIN SMALL LETTER E WITH ACUTE
@@ -822,49 +654,7 @@
   (#xFF #x00A0) ; NO-BREAK SPACE
 )
 
-(declaim (inline get-cp857-bytes))
-(defun get-cp857-bytes (string pos)
-  (declare (optimize speed (safety 0))
-           (type simple-string string)
-           (type array-range pos))
-  (get-latin-bytes #'code->cp857-mapper :cp857 string pos))
-
-(defun string->cp857 (string sstart send null-padding)
-  (declare (optimize speed (safety 0))
-           (type simple-string string)
-           (type array-range sstart send))
-  (values (string->latin% string sstart send #'get-cp857-bytes null-padding)))
-
-(defmacro define-cp857->string* (accessor type)
-  (declare (ignore type))
-  (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 #'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 #'cp857->code-mapper)))
-
-(instantiate-octets-definition define-cp857->string)
-
-(define-external-format (:cp857 :|cp857|)
-    1 t
-    (let ((cp857-byte (code->cp857-mapper bits)))
-      (if cp857-byte
-          (setf (sap-ref-8 sap tail) cp857-byte)
-          (external-format-encoding-error stream bits)))
-    (let ((code (cp857->code-mapper byte)))
-      (if code
-          (code-char code)
-          (external-format-decoding-error stream byte)))
-    cp857->string-aref
-    string->cp857) ;; TODO -- error check
-
-(define-unibyte-mapper cp860->code-mapper code->cp860-mapper
+(define-unibyte-mapping-external-format :cp860 (:|cp860|)
   (#x80 #x00C7) ; LATIN CAPITAL LETTER C WITH CEDILLA
   (#x81 #x00FC) ; LATIN SMALL LETTER U WITH DIAERESIS
   (#x82 #x00E9) ; LATIN SMALL LETTER E WITH ACUTE
@@ -995,49 +785,7 @@
   (#xFF #x00A0) ; NO-BREAK SPACE
 )
 
-(declaim (inline get-cp860-bytes))
-(defun get-cp860-bytes (string pos)
-  (declare (optimize speed (safety 0))
-           (type simple-string string)
-           (type array-range pos))
-  (get-latin-bytes #'code->cp860-mapper :cp860 string pos))
-
-(defun string->cp860 (string sstart send null-padding)
-  (declare (optimize speed (safety 0))
-           (type simple-string string)
-           (type array-range sstart send))
-  (values (string->latin% string sstart send #'get-cp860-bytes null-padding)))
-
-(defmacro define-cp860->string* (accessor type)
-  (declare (ignore type))
-  (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 #'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 #'cp860->code-mapper)))
-
-(instantiate-octets-definition define-cp860->string)
-
-(define-external-format (:cp860 :|cp860|)
-    1 t
-    (let ((cp860-byte (code->cp860-mapper bits)))
-      (if cp860-byte
-          (setf (sap-ref-8 sap tail) cp860-byte)
-          (external-format-encoding-error stream bits)))
-    (let ((code (cp860->code-mapper byte)))
-      (if code
-          (code-char code)
-          (external-format-decoding-error stream byte)))
-    cp860->string-aref
-    string->cp860) ;; TODO -- error check
-
-(define-unibyte-mapper cp861->code-mapper code->cp861-mapper
+(define-unibyte-mapping-external-format :cp861 (:|cp861|)
   (#x80 #x00C7) ; LATIN CAPITAL LETTER C WITH CEDILLA
   (#x81 #x00FC) ; LATIN SMALL LETTER U WITH DIAERESIS
   (#x82 #x00E9) ; LATIN SMALL LETTER E WITH ACUTE
@@ -1168,49 +916,7 @@
   (#xFF #x00A0) ; NO-BREAK SPACE
 )
 
-(declaim (inline get-cp861-bytes))
-(defun get-cp861-bytes (string pos)
-  (declare (optimize speed (safety 0))
-           (type simple-string string)
-           (type array-range pos))
-  (get-latin-bytes #'code->cp861-mapper :cp861 string pos))
-
-(defun string->cp861 (string sstart send null-padding)
-  (declare (optimize speed (safety 0))
-           (type simple-string string)
-           (type array-range sstart send))
-  (values (string->latin% string sstart send #'get-cp861-bytes null-padding)))
-
-(defmacro define-cp861->string* (accessor type)
-  (declare (ignore type))
-  (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 #'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 #'cp861->code-mapper)))
-
-(instantiate-octets-definition define-cp861->string)
-
-(define-external-format (:cp861 :|cp861|)
-    1 t
-    (let ((cp861-byte (code->cp861-mapper bits)))
-      (if cp861-byte
-          (setf (sap-ref-8 sap tail) cp861-byte)
-          (external-format-encoding-error stream bits)))
-    (let ((code (cp861->code-mapper byte)))
-      (if code
-          (code-char code)
-          (external-format-decoding-error stream byte)))
-    cp861->string-aref
-    string->cp861) ;; TODO -- error check
-
-(define-unibyte-mapper cp862->code-mapper code->cp862-mapper
+(define-unibyte-mapping-external-format :cp862 (:|cp862|)
   (#x80 #x05D0) ; HEBREW LETTER ALEF
   (#x81 #x05D1) ; HEBREW LETTER BET
   (#x82 #x05D2) ; HEBREW LETTER GIMEL
@@ -1341,49 +1047,7 @@
   (#xFF #x00A0) ; NO-BREAK SPACE
 )
 
-(declaim (inline get-cp862-bytes))
-(defun get-cp862-bytes (string pos)
-  (declare (optimize speed (safety 0))
-           (type simple-string string)
-           (type array-range pos))
-  (get-latin-bytes #'code->cp862-mapper :cp862 string pos))
-
-(defun string->cp862 (string sstart send null-padding)
-  (declare (optimize speed (safety 0))
-           (type simple-string string)
-           (type array-range sstart send))
-  (values (string->latin% string sstart send #'get-cp862-bytes null-padding)))
-
-(defmacro define-cp862->string* (accessor type)
-  (declare (ignore type))
-  (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 #'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 #'cp862->code-mapper)))
-
-(instantiate-octets-definition define-cp862->string)
-
-(define-external-format (:cp862 :|cp862|)
-    1 t
-    (let ((cp862-byte (code->cp862-mapper bits)))
-      (if cp862-byte
-          (setf (sap-ref-8 sap tail) cp862-byte)
-          (external-format-encoding-error stream bits)))
-    (let ((code (cp862->code-mapper byte)))
-      (if code
-          (code-char code)
-          (external-format-decoding-error stream byte)))
-    cp862->string-aref
-    string->cp862) ;; TODO -- error check
-
-(define-unibyte-mapper cp863->code-mapper code->cp863-mapper
+(define-unibyte-mapping-external-format :cp863 (:|cp863|)
   (#x80 #x00C7) ; LATIN CAPITAL LETTER C WITH CEDILLA
   (#x81 #x00FC) ; LATIN SMALL LETTER U WITH DIAERESIS
   (#x82 #x00E9) ; LATIN SMALL LETTER E WITH ACUTE
@@ -1514,49 +1178,7 @@
   (#xFF #x00A0) ; NO-BREAK SPACE
 )
 
-(declaim (inline get-cp863-bytes))
-(defun get-cp863-bytes (string pos)
-  (declare (optimize speed (safety 0))
-           (type simple-string string)
-           (type array-range pos))
-  (get-latin-bytes #'code->cp863-mapper :cp863 string pos))
-
-(defun string->cp863 (string sstart send null-padding)
-  (declare (optimize speed (safety 0))
-           (type simple-string string)
-           (type array-range sstart send))
-  (values (string->latin% string sstart send #'get-cp863-bytes null-padding)))
-
-(defmacro define-cp863->string* (accessor type)
-  (declare (ignore type))
-  (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 #'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 #'cp863->code-mapper)))
-
-(instantiate-octets-definition define-cp863->string)
-
-(define-external-format (:cp863 :|cp863|)
-    1 t
-    (let ((cp863-byte (code->cp863-mapper bits)))
-      (if cp863-byte
-          (setf (sap-ref-8 sap tail) cp863-byte)
-          (external-format-encoding-error stream bits)))
-    (let ((code (cp863->code-mapper byte)))
-      (if code
-          (code-char code)
-          (external-format-decoding-error stream byte)))
-    cp863->string-aref
-    string->cp863) ;; TODO -- error check
-
-(define-unibyte-mapper cp864->code-mapper code->cp864-mapper
+(define-unibyte-mapping-external-format :cp864 (:|cp864|)
   (#x80 #x00B0) ; DEGREE SIGN
   (#x81 #x00B7) ; MIDDLE DOT
   (#x82 #x2219) ; BULLET OPERATOR
@@ -1684,49 +1306,7 @@
   (#xFF nil)
 )
 
-(declaim (inline get-cp864-bytes))
-(defun get-cp864-bytes (string pos)
-  (declare (optimize speed (safety 0))
-           (type simple-string string)
-           (type array-range pos))
-  (get-latin-bytes #'code->cp864-mapper :cp864 string pos))
-
-(defun string->cp864 (string sstart send null-padding)
-  (declare (optimize speed (safety 0))
-           (type simple-string string)
-           (type array-range sstart send))
-  (values (string->latin% string sstart send #'get-cp864-bytes null-padding)))
-
-(defmacro define-cp864->string* (accessor type)
-  (declare (ignore type))
-  (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 #'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 #'cp864->code-mapper)))
-
-(instantiate-octets-definition define-cp864->string)
-
-(define-external-format (:cp864 :|cp864|)
-    1 t
-    (let ((cp864-byte (code->cp864-mapper bits)))
-      (if cp864-byte
-          (setf (sap-ref-8 sap tail) cp864-byte)
-          (external-format-encoding-error stream bits)))
-    (let ((code (cp864->code-mapper byte)))
-      (if code
-          (code-char code)
-          (external-format-decoding-error stream byte)))
-    cp864->string-aref
-    string->cp864) ;; TODO -- error check
-
-(define-unibyte-mapper cp865->code-mapper code->cp865-mapper
+(define-unibyte-mapping-external-format :cp865 (:|cp865|)
   (#x80 #x00C7) ; LATIN CAPITAL LETTER C WITH CEDILLA
   (#x81 #x00FC) ; LATIN SMALL LETTER U WITH DIAERESIS
   (#x82 #x00E9) ; LATIN SMALL LETTER E WITH ACUTE
@@ -1857,49 +1437,7 @@
   (#xFF #x00A0) ; NO-BREAK SPACE
 )
 
-(declaim (inline get-cp865-bytes))
-(defun get-cp865-bytes (string pos)
-  (declare (optimize speed (safety 0))
-           (type simple-string string)
-           (type array-range pos))
-  (get-latin-bytes #'code->cp865-mapper :cp865 string pos))
-
-(defun string->cp865 (string sstart send null-padding)
-  (declare (optimize speed (safety 0))
-           (type simple-string string)
-           (type array-range sstart send))
-  (values (string->latin% string sstart send #'get-cp865-bytes null-padding)))
-
-(defmacro define-cp865->string* (accessor type)
-  (declare (ignore type))
-  (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 #'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 #'cp865->code-mapper)))
-
-(instantiate-octets-definition define-cp865->string)
-
-(define-external-format (:cp865 :|cp865|)
-    1 t
-    (let ((cp865-byte (code->cp865-mapper bits)))
-      (if cp865-byte
-          (setf (sap-ref-8 sap tail) cp865-byte)
-          (external-format-encoding-error stream bits)))
-    (let ((code (cp865->code-mapper byte)))
-      (if code
-          (code-char code)
-          (external-format-decoding-error stream byte)))
-    cp865->string-aref
-    string->cp865) ;; TODO -- error check
-
-(define-unibyte-mapper cp866->code-mapper code->cp866-mapper
+(define-unibyte-mapping-external-format :cp866 (:|cp866|)
   (#x80 #x0410) ; CYRILLIC CAPITAL LETTER A
   (#x81 #x0411) ; CYRILLIC CAPITAL LETTER BE
   (#x82 #x0412) ; CYRILLIC CAPITAL LETTER VE
@@ -2030,49 +1568,7 @@
   (#xFF #x00A0) ; NO-BREAK SPACE
 )
 
-(declaim (inline get-cp866-bytes))
-(defun get-cp866-bytes (string pos)
-  (declare (optimize speed (safety 0))
-           (type simple-string string)
-           (type array-range pos))
-  (get-latin-bytes #'code->cp866-mapper :cp866 string pos))
-
-(defun string->cp866 (string sstart send null-padding)
-  (declare (optimize speed (safety 0))
-           (type simple-string string)
-           (type array-range sstart send))
-  (values (string->latin% string sstart send #'get-cp866-bytes null-padding)))
-
-(defmacro define-cp866->string* (accessor type)
-  (declare (ignore type))
-  (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 #'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 #'cp866->code-mapper)))
-
-(instantiate-octets-definition define-cp866->string)
-
-(define-external-format (:cp866 :|cp866|)
-    1 t
-    (let ((cp866-byte (code->cp866-mapper bits)))
-      (if cp866-byte
-          (setf (sap-ref-8 sap tail) cp866-byte)
-          (external-format-encoding-error stream bits)))
-    (let ((code (cp866->code-mapper byte)))
-      (if code
-          (code-char code)
-          (external-format-decoding-error stream byte)))
-    cp866->string-aref
-    string->cp866) ;; TODO -- error check
-
-(define-unibyte-mapper cp869->code-mapper code->cp869-mapper
+(define-unibyte-mapping-external-format :cp869 (:|cp869|)
   (#x80 nil)
   (#x81 nil)
   (#x82 nil)
@@ -2203,49 +1699,7 @@
   (#xFF #x00A0) ; NO-BREAK SPACE
 )
 
-(declaim (inline get-cp869-bytes))
-(defun get-cp869-bytes (string pos)
-  (declare (optimize speed (safety 0))
-           (type simple-string string)
-           (type array-range pos))
-  (get-latin-bytes #'code->cp869-mapper :cp869 string pos))
-
-(defun string->cp869 (string sstart send null-padding)
-  (declare (optimize speed (safety 0))
-           (type simple-string string)
-           (type array-range sstart send))
-  (values (string->latin% string sstart send #'get-cp869-bytes null-padding)))
-
-(defmacro define-cp869->string* (accessor type)
-  (declare (ignore type))
-  (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 #'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 #'cp869->code-mapper)))
-
-(instantiate-octets-definition define-cp869->string)
-
-(define-external-format (:cp869 :|cp869|)
-    1 t
-    (let ((cp869-byte (code->cp869-mapper bits)))
-      (if cp869-byte
-          (setf (sap-ref-8 sap tail) cp869-byte)
-          (external-format-encoding-error stream bits)))
-    (let ((code (cp869->code-mapper byte)))
-      (if code
-          (code-char code)
-          (external-format-decoding-error stream byte)))
-    cp869->string-aref
-    string->cp869) ;; TODO -- error check
-
-(define-unibyte-mapper cp874->code-mapper code->cp874-mapper
+(define-unibyte-mapping-external-format :cp874 (:|cp874|)
   (#x80 #x20AC) ; EURO SIGN
   (#x81 nil)
   (#x82 nil)
@@ -2374,45 +1828,3 @@
   (#xFE nil)
   (#xFF nil)
 )
-
-(declaim (inline get-cp874-bytes))
-(defun get-cp874-bytes (string pos)
-  (declare (optimize speed (safety 0))
-           (type simple-string string)
-           (type array-range pos))
-  (get-latin-bytes #'code->cp874-mapper :cp874 string pos))
-
-(defun string->cp874 (string sstart send null-padding)
-  (declare (optimize speed (safety 0))
-           (type simple-string string)
-           (type array-range sstart send))
-  (values (string->latin% string sstart send #'get-cp874-bytes null-padding)))
-
-(defmacro define-cp874->string* (accessor type)
-  (declare (ignore type))
-  (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 #'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 #'cp874->code-mapper)))
-
-(instantiate-octets-definition define-cp874->string)
-
-(define-external-format (:cp874 :|cp874|)
-    1 t
-    (let ((cp874-byte (code->cp874-mapper bits)))
-      (if cp874-byte
-          (setf (sap-ref-8 sap tail) cp874-byte)
-          (external-format-encoding-error stream bits)))
-    (let ((code (cp874->code-mapper byte)))
-      (if code
-          (code-char code)
-          (external-format-decoding-error stream byte)))
-    cp874->string-aref
-    string->cp874) ;; TODO -- error check

Index: enc-ebcdic.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/code/external-formats/enc-ebcdic.lisp,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -d -r1.2 -r1.3
--- enc-ebcdic.lisp	29 Sep 2009 01:02:20 -0000	1.2
+++ enc-ebcdic.lisp	11 Nov 2009 17:34:09 -0000	1.3
@@ -61,12 +61,11 @@
      (,(make-od-name 'latin->string accessor) array astart aend #'ebcdic-us->code-mapper)))
 (instantiate-octets-definition define-ebcdic-us->string)
 
-(define-external-format (:ebcdic-us :cp037 :|cp037| :ibm-037 :ibm037)
-    1 t
-    (let ((ebcdic-us-byte (code->ebcdic-us-mapper bits)))
-      (if ebcdic-us-byte
-          (setf (sap-ref-8 sap tail) ebcdic-us-byte)
-          (external-format-encoding-error stream bits)))
-    (code-char (ebcdic-us->code-mapper byte))
-    ebcdic-us->string-aref
-    string->ebcdic-us)
+(define-unibyte-external-format :ebcdic-us (:cp037 :|cp037| :ibm-037 :ibm037)
+  (let ((ebcdic-us-byte (code->ebcdic-us-mapper bits)))
+    (if ebcdic-us-byte
+        (setf (sap-ref-8 sap tail) ebcdic-us-byte)
+        (external-format-encoding-error stream bits)))
+  (code-char (ebcdic-us->code-mapper byte))
+  ebcdic-us->string-aref
+  string->ebcdic-us)

Index: enc-iso.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/code/external-formats/enc-iso.lisp,v
retrieving revision 1.8
retrieving revision 1.9
diff -u -d -r1.8 -r1.9
--- enc-iso.lisp	3 Nov 2009 10:42:18 -0000	1.8
+++ enc-iso.lisp	11 Nov 2009 17:34:09 -0000	1.9
@@ -1,6 +1,7 @@
 (in-package "SB!IMPL")
 
-(define-unibyte-mapper iso-8859-2->code-mapper code->iso-8859-2-mapper
+(define-unibyte-mapping-external-format :iso-8859-2
+    (:|iso-8859-2| :latin-2 :|latin-2|)
   (#xA1 #x0104) ; LATIN CAPITAL LETTER A WITH OGONEK
   (#xA2 #x02D8) ; BREVE
   (#xA3 #x0141) ; LATIN CAPITAL LETTER L WITH STROKE
@@ -60,49 +61,8 @@
   (#xFF #x02D9) ; DOT ABOVE
 )
 
-(declaim (inline get-iso-8859-2-bytes))
-(defun get-iso-8859-2-bytes (string pos)
-  (declare (optimize speed (safety 0))
-           (type simple-string string)
-           (type array-range pos))
-  (get-latin-bytes #'code->iso-8859-2-mapper :iso-8859-2 string pos))
-
-(defun string->iso-8859-2 (string sstart send null-padding)
-  (declare (optimize speed (safety 0))
-           (type simple-string string)
-           (type array-range sstart send))
-  (values (string->latin% string sstart send #'get-iso-8859-2-bytes null-padding)))
-
-(defmacro define-iso-8859-2->string* (accessor type)
-  (declare (ignore type))
-  (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 #'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 #'iso-8859-2->code-mapper)))
-
-(instantiate-octets-definition define-iso-8859-2->string)
-
-(define-external-format (:iso-8859-2 :|iso-8859-2| :latin-2 :|latin-2|)
-    1 t
-    (let ((iso-8859-2-byte (code->iso-8859-2-mapper bits)))
-      (if iso-8859-2-byte
-          (setf (sap-ref-8 sap tail) iso-8859-2-byte)
-          (external-format-encoding-error stream bits)))
-    (let ((code (iso-8859-2->code-mapper byte)))
-      (if code
-          (code-char code)
-          (external-format-decoding-error stream byte)))
-    iso-8859-2->string-aref
-    string->iso-8859-2) ;; TODO -- error check
-
-(define-unibyte-mapper iso-8859-3->code-mapper code->iso-8859-3-mapper
+(define-unibyte-mapping-external-format :iso-8859-3
+    (:|iso-8859-3| :latin-3 :|latin-3|)
   (#xA1 #x0126) ; LATIN CAPITAL LETTER H WITH STROKE
   (#xA2 #x02D8) ; BREVE
   (#xA5 nil)
@@ -140,49 +100,8 @@
   (#xFF #x02D9) ; DOT ABOVE
 )
 
-(declaim (inline get-iso-8859-3-bytes))
-(defun get-iso-8859-3-bytes (string pos)
-  (declare (optimize speed (safety 0))
-           (type simple-string string)
-           (type array-range pos))
-  (get-latin-bytes #'code->iso-8859-3-mapper :iso-8859-3 string pos))
-
-(defun string->iso-8859-3 (string sstart send null-padding)
-  (declare (optimize speed (safety 0))
-           (type simple-string string)
-           (type array-range sstart send))
-  (values (string->latin% string sstart send #'get-iso-8859-3-bytes null-padding)))
-
-(defmacro define-iso-8859-3->string* (accessor type)
-  (declare (ignore type))
-  (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 #'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 #'iso-8859-3->code-mapper)))
-
-(instantiate-octets-definition define-iso-8859-3->string)
-
-(define-external-format (:iso-8859-3 :|iso-8859-3| :latin-3 :|latin-3|)
-    1 t
-    (let ((iso-8859-3-byte (code->iso-8859-3-mapper bits)))
-      (if iso-8859-3-byte
-          (setf (sap-ref-8 sap tail) iso-8859-3-byte)
-          (external-format-encoding-error stream bits)))
-    (let ((code (iso-8859-3->code-mapper byte)))
-      (if code
-          (code-char code)
-          (external-format-decoding-error stream byte)))
-    iso-8859-3->string-aref
-    string->iso-8859-3) ;; TODO -- error check
-
-(define-unibyte-mapper iso-8859-4->code-mapper code->iso-8859-4-mapper
+(define-unibyte-mapping-external-format :iso-8859-4
+    (:|iso-8859-4| :latin-4 :|latin-4|)
   (#xA1 #x0104) ; LATIN CAPITAL LETTER A WITH OGONEK
   (#xA2 #x0138) ; LATIN SMALL LETTER KRA
   (#xA3 #x0156) ; LATIN CAPITAL LETTER R WITH CEDILLA
@@ -235,49 +154,7 @@
   (#xFF #x02D9) ; DOT ABOVE
 )
 
-(declaim (inline get-iso-8859-4-bytes))
-(defun get-iso-8859-4-bytes (string pos)
-  (declare (optimize speed (safety 0))
-           (type simple-string string)
-           (type array-range pos))
-  (get-latin-bytes #'code->iso-8859-4-mapper :iso-8859-4 string pos))
-
-(defun string->iso-8859-4 (string sstart send null-padding)
-  (declare (optimize speed (safety 0))
-           (type simple-string string)
-           (type array-range sstart send))
-  (values (string->latin% string sstart send #'get-iso-8859-4-bytes null-padding)))
-
-(defmacro define-iso-8859-4->string* (accessor type)
-  (declare (ignore type))
-  (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 #'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 #'iso-8859-4->code-mapper)))
-
-(instantiate-octets-definition define-iso-8859-4->string)
-
-(define-external-format (:iso-8859-4 :|iso-8859-4| :latin-4 :|latin-4|)
-    1 t
-    (let ((iso-8859-4-byte (code->iso-8859-4-mapper bits)))
-      (if iso-8859-4-byte
-          (setf (sap-ref-8 sap tail) iso-8859-4-byte)
-          (external-format-encoding-error stream bits)))
-    (let ((code (iso-8859-4->code-mapper byte)))
-      (if code
-          (code-char code)
-          (external-format-decoding-error stream byte)))
-    iso-8859-4->string-aref
-    string->iso-8859-4) ;; TODO -- error check
-
-(define-unibyte-mapper iso-8859-5->code-mapper code->iso-8859-5-mapper
+(define-unibyte-mapping-external-format :iso-8859-5 (:|iso-8859-5|)
   (#xA1 #x0401) ; CYRILLIC CAPITAL LETTER IO
   (#xA2 #x0402) ; CYRILLIC CAPITAL LETTER DJE
   (#xA3 #x0403) ; CYRILLIC CAPITAL LETTER GJE
@@ -374,49 +251,7 @@
   (#xFF #x045F) ; CYRILLIC SMALL LETTER DZHE
 )
 
-(declaim (inline get-iso-8859-5-bytes))
-(defun get-iso-8859-5-bytes (string pos)
-  (declare (optimize speed (safety 0))
-           (type simple-string string)
-           (type array-range pos))
-  (get-latin-bytes #'code->iso-8859-5-mapper :iso-8859-5 string pos))
-
-(defun string->iso-8859-5 (string sstart send null-padding)
-  (declare (optimize speed (safety 0))
-           (type simple-string string)
-           (type array-range sstart send))
-  (values (string->latin% string sstart send #'get-iso-8859-5-bytes null-padding)))
-
-(defmacro define-iso-8859-5->string* (accessor type)
-  (declare (ignore type))
-  (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 #'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 #'iso-8859-5->code-mapper)))
-
-(instantiate-octets-definition define-iso-8859-5->string)
-
-(define-external-format (:iso-8859-5 :|iso-8859-5|)
-    1 t
-    (let ((iso-8859-5-byte (code->iso-8859-5-mapper bits)))
-      (if iso-8859-5-byte
-          (setf (sap-ref-8 sap tail) iso-8859-5-byte)
-          (external-format-encoding-error stream bits)))
-    (let ((code (iso-8859-5->code-mapper byte)))
-      (if code
-          (code-char code)
-          (external-format-decoding-error stream byte)))
-    iso-8859-5->string-aref
-    string->iso-8859-5) ;; TODO -- error check
-
-(define-unibyte-mapper iso-8859-6->code-mapper code->iso-8859-6-mapper
+(define-unibyte-mapping-external-format :iso-8859-6 (:|iso-8859-6|)
   (#xA1 nil)
   (#xA2 nil)
   (#xA3 nil)
@@ -512,49 +347,7 @@
   (#xFF nil)
 )
 
-(declaim (inline get-iso-8859-6-bytes))
-(defun get-iso-8859-6-bytes (string pos)
-  (declare (optimize speed (safety 0))
-           (type simple-string string)
-           (type array-range pos))
-  (get-latin-bytes #'code->iso-8859-6-mapper :iso-8859-6 string pos))
-
-(defun string->iso-8859-6 (string sstart send null-padding)
-  (declare (optimize speed (safety 0))
-           (type simple-string string)
-           (type array-range sstart send))
-  (values (string->latin% string sstart send #'get-iso-8859-6-bytes null-padding)))
-
-(defmacro define-iso-8859-6->string* (accessor type)
-  (declare (ignore type))
-  (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 #'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 #'iso-8859-6->code-mapper)))
-
-(instantiate-octets-definition define-iso-8859-6->string)
-
-(define-external-format (:iso-8859-6 :|iso-8859-6|)
-    1 t
-    (let ((iso-8859-6-byte (code->iso-8859-6-mapper bits)))
-      (if iso-8859-6-byte
-          (setf (sap-ref-8 sap tail) iso-8859-6-byte)
-          (external-format-encoding-error stream bits)))
-    (let ((code (iso-8859-6->code-mapper byte)))
-      (if code
-          (code-char code)
-          (external-format-decoding-error stream byte)))
-    iso-8859-6->string-aref
-    string->iso-8859-6) ;; TODO -- error check
-
-(define-unibyte-mapper iso-8859-7->code-mapper code->iso-8859-7-mapper
+(define-unibyte-mapping-external-format :iso-8859-7 (:|iso-8859-7|)
   (#xA1 #x02BD) ; MODIFIER LETTER REVERSED COMMA
   (#xA2 #x02BC) ; MODIFIER LETTER APOSTROPHE
   (#xA4 nil)
@@ -637,49 +430,7 @@
   (#xFF nil)
 )
 
-(declaim (inline get-iso-8859-7-bytes))
-(defun get-iso-8859-7-bytes (string pos)
-  (declare (optimize speed (safety 0))
-           (type simple-string string)
-           (type array-range pos))
-  (get-latin-bytes #'code->iso-8859-7-mapper :iso-8859-7 string pos))
-
-(defun string->iso-8859-7 (string sstart send null-padding)
-  (declare (optimize speed (safety 0))
-           (type simple-string string)
-           (type array-range sstart send))
-  (values (string->latin% string sstart send #'get-iso-8859-7-bytes null-padding)))
-
-(defmacro define-iso-8859-7->string* (accessor type)
-  (declare (ignore type))
-  (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 #'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 #'iso-8859-7->code-mapper)))
-
-(instantiate-octets-definition define-iso-8859-7->string)
-
-(define-external-format (:iso-8859-7 :|iso-8859-7|)
-    1 t
-    (let ((iso-8859-7-byte (code->iso-8859-7-mapper bits)))
-      (if iso-8859-7-byte
-          (setf (sap-ref-8 sap tail) iso-8859-7-byte)
-          (external-format-encoding-error stream bits)))
-    (let ((code (iso-8859-7->code-mapper byte)))
-      (if code
-          (code-char code)
-          (external-format-decoding-error stream byte)))
-    iso-8859-7->string-aref
-    string->iso-8859-7) ;; TODO -- error check
-
-(define-unibyte-mapper iso-8859-8->code-mapper code->iso-8859-8-mapper
+(define-unibyte-mapping-external-format :iso-8859-8 (:|iso-8859-8|)
   (#xA1 nil)
   (#xAA #x00D7) ; MULTIPLICATION SIGN
   (#xAF #x203E) ; OVERLINE
@@ -751,49 +502,8 @@
   (#xFF nil)
 )
 
-(declaim (inline get-iso-8859-8-bytes))
-(defun get-iso-8859-8-bytes (string pos)
-  (declare (optimize speed (safety 0))
-           (type simple-string string)
-           (type array-range pos))
-  (get-latin-bytes #'code->iso-8859-8-mapper :iso-8859-8 string pos))
-
-(defun string->iso-8859-8 (string sstart send null-padding)
-  (declare (optimize speed (safety 0))
-           (type simple-string string)
-           (type array-range sstart send))
-  (values (string->latin% string sstart send #'get-iso-8859-8-bytes null-padding)))
-
-(defmacro define-iso-8859-8->string* (accessor type)
-  (declare (ignore type))
-  (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 #'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 #'iso-8859-8->code-mapper)))
-
-(instantiate-octets-definition define-iso-8859-8->string)
-
-(define-external-format (:iso-8859-8 :|iso-8859-8|)
-    1 t
-    (let ((iso-8859-8-byte (code->iso-8859-8-mapper bits)))
-      (if iso-8859-8-byte
-          (setf (sap-ref-8 sap tail) iso-8859-8-byte)
-          (external-format-encoding-error stream bits)))
-    (let ((code (iso-8859-8->code-mapper byte)))
-      (if code
-          (code-char code)
-          (external-format-decoding-error stream byte)))
-    iso-8859-8->string-aref
-    string->iso-8859-8) ;; TODO -- error check
-
-(define-unibyte-mapper iso-8859-9->code-mapper code->iso-8859-9-mapper
+(define-unibyte-mapping-external-format :iso-8859-9
+    (:|iso-8859-9| :latin-5 :|latin-5|)
   (#xD0 #x011E) ; LATIN CAPITAL LETTER G WITH BREVE
   (#xDD #x0130) ; LATIN CAPITAL LETTER I WITH DOT ABOVE
   (#xDE #x015E) ; LATIN CAPITAL LETTER S WITH CEDILLA
@@ -802,49 +512,8 @@
   (#xFE #x015F) ; LATIN SMALL LETTER S WITH CEDILLA
 )
 
-(declaim (inline get-iso-8859-9-bytes))
-(defun get-iso-8859-9-bytes (string pos)
-  (declare (optimize speed (safety 0))
-           (type simple-string string)
-           (type array-range pos))
-  (get-latin-bytes #'code->iso-8859-9-mapper :iso-8859-9 string pos))
-
-(defun string->iso-8859-9 (string sstart send null-padding)
-  (declare (optimize speed (safety 0))
-           (type simple-string string)
-           (type array-range sstart send))
-  (values (string->latin% string sstart send #'get-iso-8859-9-bytes null-padding)))
-
-(defmacro define-iso-8859-9->string* (accessor type)
-  (declare (ignore type))
-  (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 #'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 #'iso-8859-9->code-mapper)))
-
-(instantiate-octets-definition define-iso-8859-9->string)
-
-(define-external-format (:iso-8859-9 :|iso-8859-9| :latin-5 :|latin-5|)
-    1 t
-    (let ((iso-8859-9-byte (code->iso-8859-9-mapper bits)))
-      (if iso-8859-9-byte
-          (setf (sap-ref-8 sap tail) iso-8859-9-byte)
-          (external-format-encoding-error stream bits)))
-    (let ((code (iso-8859-9->code-mapper byte)))
-      (if code
-          (code-char code)
-          (external-format-decoding-error stream byte)))
-    iso-8859-9->string-aref
-    string->iso-8859-9) ;; TODO -- error check
-
-(define-unibyte-mapper iso-8859-10->code-mapper code->iso-8859-10-mapper
+(define-unibyte-mapping-external-format :iso-8859-10
+    (:|iso-8859-10| :latin-6 :|latin-6|)
   (#xA1 #x0104) ; LATIN CAPITAL LETTER A WITH OGONEK
   (#xA2 #x0112) ; LATIN CAPITAL LETTER E WITH MACRON
   (#xA3 #x0122) ; LATIN CAPITAL LETTER G WITH CEDILLA
@@ -893,49 +562,7 @@
   (#xFF #x0138) ; LATIN SMALL LETTER KRA
 )
 
-(declaim (inline get-iso-8859-10-bytes))
-(defun get-iso-8859-10-bytes (string pos)
-  (declare (optimize speed (safety 0))
-           (type simple-string string)
-           (type array-range pos))
-  (get-latin-bytes #'code->iso-8859-10-mapper :iso-8859-10 string pos))
-
-(defun string->iso-8859-10 (string sstart send null-padding)
-  (declare (optimize speed (safety 0))
-           (type simple-string string)
-           (type array-range sstart send))
-  (values (string->latin% string sstart send #'get-iso-8859-10-bytes null-padding)))
-
-(defmacro define-iso-8859-10->string* (accessor type)
-  (declare (ignore type))
-  (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 #'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 #'iso-8859-10->code-mapper)))
-
-(instantiate-octets-definition define-iso-8859-10->string)
-
-(define-external-format (:iso-8859-10 :|iso-8859-10| :latin-6 :|latin-6|)
-    1 t
-    (let ((iso-8859-10-byte (code->iso-8859-10-mapper bits)))
-      (if iso-8859-10-byte
-          (setf (sap-ref-8 sap tail) iso-8859-10-byte)
-          (external-format-encoding-error stream bits)))
-    (let ((code (iso-8859-10->code-mapper byte)))
-      (if code
-          (code-char code)
-          (external-format-decoding-error stream byte)))
-    iso-8859-10->string-aref
-    string->iso-8859-10) ;; TODO -- error check
-
-(define-unibyte-mapper iso-8859-11->code-mapper code->iso-8859-11-mapper
+(define-unibyte-mapping-external-format :iso-8859-11 (:|iso-8859-11|)
   (#xA1 #x0E01) ; THAI CHARACTER KO KAI
   (#xA2 #x0E02) ; THAI CHARACTER KHO KHAI
   (#xA3 #x0E03) ; THAI CHARACTER KHO KHUAT
@@ -1033,49 +660,8 @@
   (#xFF nil)
 )
 
-(declaim (inline get-iso-8859-11-bytes))
-(defun get-iso-8859-11-bytes (string pos)
-  (declare (optimize speed (safety 0))
-           (type simple-string string)
-           (type array-range pos))
-  (get-latin-bytes #'code->iso-8859-11-mapper :iso-8859-11 string pos))
-
-(defun string->iso-8859-11 (string sstart send null-padding)
-  (declare (optimize speed (safety 0))
-           (type simple-string string)
-           (type array-range sstart send))
-  (values (string->latin% string sstart send #'get-iso-8859-11-bytes null-padding)))
-
-(defmacro define-iso-8859-11->string* (accessor type)
-  (declare (ignore type))
-  (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 #'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 #'iso-8859-11->code-mapper)))
-
-(instantiate-octets-definition define-iso-8859-11->string)
-
-(define-external-format (:iso-8859-11 :|iso-8859-11|)
-    1 t
-    (let ((iso-8859-11-byte (code->iso-8859-11-mapper bits)))
-      (if iso-8859-11-byte
-          (setf (sap-ref-8 sap tail) iso-8859-11-byte)
-          (external-format-encoding-error stream bits)))
-    (let ((code (iso-8859-11->code-mapper byte)))
-      (if code
-          (code-char code)
-          (external-format-decoding-error stream byte)))
-    iso-8859-11->string-aref
-    string->iso-8859-11) ;; TODO -- error check
-
-(define-unibyte-mapper iso-8859-13->code-mapper code->iso-8859-13-mapper
+(define-unibyte-mapping-external-format :iso-8859-13
+    (:|iso-8859-13| :latin-7 :|latin-7|)
   (#xA1 #x201D) ; RIGHT DOUBLE QUOTATION MARK
   (#xA5 #x201E) ; DOUBLE LOW-9 QUOTATION MARK
   (#xA8 #x00D8) ; LATIN CAPITAL LETTER O WITH STROKE
@@ -1134,49 +720,8 @@
   (#xFF #x2019) ; RIGHT SINGLE QUOTATION MARK
 )
 
-(declaim (inline get-iso-8859-13-bytes))
-(defun get-iso-8859-13-bytes (string pos)
-  (declare (optimize speed (safety 0))
-           (type simple-string string)
-           (type array-range pos))
-  (get-latin-bytes #'code->iso-8859-13-mapper :iso-8859-13 string pos))
-
-(defun string->iso-8859-13 (string sstart send null-padding)
-  (declare (optimize speed (safety 0))
-           (type simple-string string)
-           (type array-range sstart send))
-  (values (string->latin% string sstart send #'get-iso-8859-13-bytes null-padding)))
-
-(defmacro define-iso-8859-13->string* (accessor type)
-  (declare (ignore type))
-  (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 #'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 #'iso-8859-13->code-mapper)))
-
-(instantiate-octets-definition define-iso-8859-13->stri...
 
[truncated message content]