src/code/external-formats/enc-iso.lisp

   1 (in-package #:sb!impl)
   2
   3 (define-unibyte-mapper iso-8859-2->code-mapper code->iso-8859-2-mapper
   4   (#xA1 #x0104) ; LATIN CAPITAL LETTER A WITH OGONEK
   5   (#xA2 #x02D8) ; BREVE
   6   (#xA3 #x0141) ; LATIN CAPITAL LETTER L WITH STROKE
   7   (#xA5 #x013D) ; LATIN CAPITAL LETTER L WITH CARON
   8   (#xA6 #x015A) ; LATIN CAPITAL LETTER S WITH ACUTE
   9   (#xA9 #x0160) ; LATIN CAPITAL LETTER S WITH CARON
  10   (#xAA #x015E) ; LATIN CAPITAL LETTER S WITH CEDILLA
  11   (#xAB #x0164) ; LATIN CAPITAL LETTER T WITH CARON
  12   (#xAC #x0179) ; LATIN CAPITAL LETTER Z WITH ACUTE
  13   (#xAE #x017D) ; LATIN CAPITAL LETTER Z WITH CARON
  14   (#xAF #x017B) ; LATIN CAPITAL LETTER Z WITH DOT ABOVE
  15   (#xB1 #x0105) ; LATIN SMALL LETTER A WITH OGONEK
  16   (#xB2 #x02DB) ; OGONEK
  17   (#xB3 #x0142) ; LATIN SMALL LETTER L WITH STROKE
  18   (#xB5 #x013E) ; LATIN SMALL LETTER L WITH CARON
  19   (#xB6 #x015B) ; LATIN SMALL LETTER S WITH ACUTE
  20   (#xB7 #x02C7) ; CARON
  21   (#xB9 #x0161) ; LATIN SMALL LETTER S WITH CARON
  22   (#xBA #x015F) ; LATIN SMALL LETTER S WITH CEDILLA
  23   (#xBB #x0165) ; LATIN SMALL LETTER T WITH CARON
  24   (#xBC #x017A) ; LATIN SMALL LETTER Z WITH ACUTE
  25   (#xBD #x02DD) ; DOUBLE ACUTE ACCENT
  26   (#xBE #x017E) ; LATIN SMALL LETTER Z WITH CARON
  27   (#xBF #x017C) ; LATIN SMALL LETTER Z WITH DOT ABOVE
  28   (#xC0 #x0154) ; LATIN CAPITAL LETTER R WITH ACUTE
  29   (#xC3 #x0102) ; LATIN CAPITAL LETTER A WITH BREVE
  30   (#xC5 #x0139) ; LATIN CAPITAL LETTER L WITH ACUTE
  31   (#xC6 #x0106) ; LATIN CAPITAL LETTER C WITH ACUTE
  32   (#xC8 #x010C) ; LATIN CAPITAL LETTER C WITH CARON
  33   (#xCA #x0118) ; LATIN CAPITAL LETTER E WITH OGONEK
  34   (#xCC #x011A) ; LATIN CAPITAL LETTER E WITH CARON
  35   (#xCF #x010E) ; LATIN CAPITAL LETTER D WITH CARON
  36   (#xD0 #x0110) ; LATIN CAPITAL LETTER D WITH STROKE
  37   (#xD1 #x0143) ; LATIN CAPITAL LETTER N WITH ACUTE
  38   (#xD2 #x0147) ; LATIN CAPITAL LETTER N WITH CARON
  39   (#xD5 #x0150) ; LATIN CAPITAL LETTER O WITH DOUBLE ACUTE
  40   (#xD8 #x0158) ; LATIN CAPITAL LETTER R WITH CARON
  41   (#xD9 #x016E) ; LATIN CAPITAL LETTER U WITH RING ABOVE
  42   (#xDB #x0170) ; LATIN CAPITAL LETTER U WITH DOUBLE ACUTE
  43   (#xDE #x0162) ; LATIN CAPITAL LETTER T WITH CEDILLA
  44   (#xE0 #x0155) ; LATIN SMALL LETTER R WITH ACUTE
  45   (#xE3 #x0103) ; LATIN SMALL LETTER A WITH BREVE
  46   (#xE5 #x013A) ; LATIN SMALL LETTER L WITH ACUTE
  47   (#xE6 #x0107) ; LATIN SMALL LETTER C WITH ACUTE
  48   (#xE8 #x010D) ; LATIN SMALL LETTER C WITH CARON
  49   (#xEA #x0119) ; LATIN SMALL LETTER E WITH OGONEK
  50   (#xEC #x011B) ; LATIN SMALL LETTER E WITH CARON
  51   (#xEF #x010F) ; LATIN SMALL LETTER D WITH CARON
  52   (#xF0 #x0111) ; LATIN SMALL LETTER D WITH STROKE
  53   (#xF1 #x0144) ; LATIN SMALL LETTER N WITH ACUTE
  54   (#xF2 #x0148) ; LATIN SMALL LETTER N WITH CARON
  55   (#xF5 #x0151) ; LATIN SMALL LETTER O WITH DOUBLE ACUTE
  56   (#xF8 #x0159) ; LATIN SMALL LETTER R WITH CARON
  57   (#xF9 #x016F) ; LATIN SMALL LETTER U WITH RING ABOVE
  58   (#xFB #x0171) ; LATIN SMALL LETTER U WITH DOUBLE ACUTE
  59   (#xFE #x0163) ; LATIN SMALL LETTER T WITH CEDILLA
  60   (#xFF #x02D9) ; DOT ABOVE
  61 )
  62
  63 (declaim (inline get-iso-8859-2-bytes))
  64 (defun get-iso-8859-2-bytes(string pos end)
  65   (declare (optimize speed (safety 0))
  66            (type simple-string string)
  67            (type array-range pos end))
  68   (get-latin-bytes #'identity :iso-8859-2 string pos end))
  69
  70 (defun string->iso-8859-2 (string sstart send null-padding)
  71   (declare (optimize speed (safety 0))
  72            (type simple-string string)
  73            (type array-range sstart send))
  74   (values (string->latin% string sstart send #'get-iso-8859-2-bytes null-padding)))
  75
  76 (defmacro define-iso-8859-2->string* (accessor type)
  77   (declare (ignore type))
  78   (let ((name (make-od-name 'iso-8859-2->string* accessor)))
  79     `(progn
  80       (defun ,name (string sstart send array astart aend)
  81         (,(make-od-name 'latin->string* accessor) string sstart send array astart aend #'identity)))))
  82
  83 (instantiate-octets-definition define-iso-8859-2->string*)
  84
  85 (defmacro define-iso-8859-2->string (accessor type)
  86   (declare (ignore type))
  87   `(defun ,(make-od-name 'iso-8859-2->string accessor) (array astart aend)
  88     (,(make-od-name 'latin->string accessor) array astart aend #'identity)))
  89
  90 (instantiate-octets-definition define-iso-8859-2->string)
  91
  92 (push '((:iso-8859-2 :|iso-8859-2|)
  93         iso-8859-2->string-aref string->iso-8859-2)
  94       *external-format-functions*)
  95
  96 (define-external-format (:iso-8859-2 :|iso-8859-2|)
  97     1 t
  98     (let ((iso-8859-2-byte (code->iso-8859-2-mapper bits)))
  99       (if iso-8859-2-byte
 100           (setf (sap-ref-8 sap tail) iso-8859-2-byte)
 101           (stream-encoding-error-and-handle stream bits)))
 102     (let ((code (iso-8859-2->code-mapper byte)))
 103       (if code
 104           (code-char code)
 105           (stream-decoding-error stream byte)))) ;; TODO -- error check
 106
 107 (define-unibyte-mapper iso-8859-3->code-mapper code->iso-8859-3-mapper
 108   (#xA1 #x0126) ; LATIN CAPITAL LETTER H WITH STROKE
 109   (#xA2 #x02D8) ; BREVE
 110   (#xA5 nil)
 111   (#xA6 #x0124) ; LATIN CAPITAL LETTER H WITH CIRCUMFLEX
 112   (#xA9 #x0130) ; LATIN CAPITAL LETTER I WITH DOT ABOVE
 113   (#xAA #x015E) ; LATIN CAPITAL LETTER S WITH CEDILLA
 114   (#xAB #x011E) ; LATIN CAPITAL LETTER G WITH BREVE
 115   (#xAC #x0134) ; LATIN CAPITAL LETTER J WITH CIRCUMFLEX
 116   (#xAE nil)
 117   (#xAF #x017B) ; LATIN CAPITAL LETTER Z WITH DOT ABOVE
 118   (#xB1 #x0127) ; LATIN SMALL LETTER H WITH STROKE
 119   (#xB6 #x0125) ; LATIN SMALL LETTER H WITH CIRCUMFLEX
 120   (#xB9 #x0131) ; LATIN SMALL LETTER DOTLESS I
 121   (#xBA #x015F) ; LATIN SMALL LETTER S WITH CEDILLA
 122   (#xBB #x011F) ; LATIN SMALL LETTER G WITH BREVE
 123   (#xBC #x0135) ; LATIN SMALL LETTER J WITH CIRCUMFLEX
 124   (#xBE nil)
 125   (#xBF #x017C) ; LATIN SMALL LETTER Z WITH DOT ABOVE
 126   (#xC3 nil)
 127   (#xC5 #x010A) ; LATIN CAPITAL LETTER C WITH DOT ABOVE
 128   (#xC6 #x0108) ; LATIN CAPITAL LETTER C WITH CIRCUMFLEX
 129   (#xD0 nil)
 130   (#xD5 #x0120) ; LATIN CAPITAL LETTER G WITH DOT ABOVE
 131   (#xD8 #x011C) ; LATIN CAPITAL LETTER G WITH CIRCUMFLEX
 132   (#xDD #x016C) ; LATIN CAPITAL LETTER U WITH BREVE
 133   (#xDE #x015C) ; LATIN CAPITAL LETTER S WITH CIRCUMFLEX
 134   (#xE3 nil)
 135   (#xE5 #x010B) ; LATIN SMALL LETTER C WITH DOT ABOVE
 136   (#xE6 #x0109) ; LATIN SMALL LETTER C WITH CIRCUMFLEX
 137   (#xF0 nil)
 138   (#xF5 #x0121) ; LATIN SMALL LETTER G WITH DOT ABOVE
 139   (#xF8 #x011D) ; LATIN SMALL LETTER G WITH CIRCUMFLEX
 140   (#xFD #x016D) ; LATIN SMALL LETTER U WITH BREVE
 141   (#xFE #x015D) ; LATIN SMALL LETTER S WITH CIRCUMFLEX
 142   (#xFF #x02D9) ; DOT ABOVE
 143 )
 144
 145 (declaim (inline get-iso-8859-3-bytes))
 146 (defun get-iso-8859-3-bytes(string pos end)
 147   (declare (optimize speed (safety 0))
 148            (type simple-string string)
 149            (type array-range pos end))
 150   (get-latin-bytes #'identity :iso-8859-3 string pos end))
 151
 152 (defun string->iso-8859-3 (string sstart send null-padding)
 153   (declare (optimize speed (safety 0))
 154            (type simple-string string)
 155            (type array-range sstart send))
 156   (values (string->latin% string sstart send #'get-iso-8859-3-bytes null-padding)))
 157
 158 (defmacro define-iso-8859-3->string* (accessor type)
 159   (declare (ignore type))
 160   (let ((name (make-od-name 'iso-8859-3->string* accessor)))
 161     `(progn
 162       (defun ,name (string sstart send array astart aend)
 163         (,(make-od-name 'latin->string* accessor) string sstart send array astart aend #'identity)))))
 164
 165 (instantiate-octets-definition define-iso-8859-3->string*)
 166
 167 (defmacro define-iso-8859-3->string (accessor type)
 168   (declare (ignore type))
 169   `(defun ,(make-od-name 'iso-8859-3->string accessor) (array astart aend)
 170     (,(make-od-name 'latin->string accessor) array astart aend #'identity)))
 171
 172 (instantiate-octets-definition define-iso-8859-3->string)
 173
 174 (push '((:iso-8859-3 :|iso-8859-3|)
 175         iso-8859-3->string-aref string->iso-8859-3)
 176       *external-format-functions*)
 177
 178 (define-external-format (:iso-8859-3 :|iso-8859-3|)
 179     1 t
 180     (let ((iso-8859-3-byte (code->iso-8859-3-mapper bits)))
 181       (if iso-8859-3-byte
 182           (setf (sap-ref-8 sap tail) iso-8859-3-byte)
 183           (stream-encoding-error-and-handle stream bits)))
 184     (let ((code (iso-8859-3->code-mapper byte)))
 185       (if code
 186           (code-char code)
 187           (stream-decoding-error stream byte)))) ;; TODO -- error check
 188
 189 (define-unibyte-mapper iso-8859-4->code-mapper code->iso-8859-4-mapper
 190   (#xA1 #x0104) ; LATIN CAPITAL LETTER A WITH OGONEK
 191   (#xA2 #x0138) ; LATIN SMALL LETTER KRA
 192   (#xA3 #x0156) ; LATIN CAPITAL LETTER R WITH CEDILLA
 193   (#xA5 #x0128) ; LATIN CAPITAL LETTER I WITH TILDE
 194   (#xA6 #x013B) ; LATIN CAPITAL LETTER L WITH CEDILLA
 195   (#xA9 #x0160) ; LATIN CAPITAL LETTER S WITH CARON
 196   (#xAA #x0112) ; LATIN CAPITAL LETTER E WITH MACRON
 197   (#xAB #x0122) ; LATIN CAPITAL LETTER G WITH CEDILLA
 198   (#xAC #x0166) ; LATIN CAPITAL LETTER T WITH STROKE
 199   (#xAE #x017D) ; LATIN CAPITAL LETTER Z WITH CARON
 200   (#xB1 #x0105) ; LATIN SMALL LETTER A WITH OGONEK
 201   (#xB2 #x02DB) ; OGONEK
 202   (#xB3 #x0157) ; LATIN SMALL LETTER R WITH CEDILLA
 203   (#xB5 #x0129) ; LATIN SMALL LETTER I WITH TILDE
 204   (#xB6 #x013C) ; LATIN SMALL LETTER L WITH CEDILLA
 205   (#xB7 #x02C7) ; CARON
 206   (#xB9 #x0161) ; LATIN SMALL LETTER S WITH CARON
 207   (#xBA #x0113) ; LATIN SMALL LETTER E WITH MACRON
 208   (#xBB #x0123) ; LATIN SMALL LETTER G WITH CEDILLA
 209   (#xBC #x0167) ; LATIN SMALL LETTER T WITH STROKE
 210   (#xBD #x014A) ; LATIN CAPITAL LETTER ENG
 211   (#xBE #x017E) ; LATIN SMALL LETTER Z WITH CARON
 212   (#xBF #x014B) ; LATIN SMALL LETTER ENG
 213   (#xC0 #x0100) ; LATIN CAPITAL LETTER A WITH MACRON
 214   (#xC7 #x012E) ; LATIN CAPITAL LETTER I WITH OGONEK
 215   (#xC8 #x010C) ; LATIN CAPITAL LETTER C WITH CARON
 216   (#xCA #x0118) ; LATIN CAPITAL LETTER E WITH OGONEK
 217   (#xCC #x0116) ; LATIN CAPITAL LETTER E WITH DOT ABOVE
 218   (#xCF #x012A) ; LATIN CAPITAL LETTER I WITH MACRON
 219   (#xD0 #x0110) ; LATIN CAPITAL LETTER D WITH STROKE
 220   (#xD1 #x0145) ; LATIN CAPITAL LETTER N WITH CEDILLA
 221   (#xD2 #x014C) ; LATIN CAPITAL LETTER O WITH MACRON
 222   (#xD3 #x0136) ; LATIN CAPITAL LETTER K WITH CEDILLA
 223   (#xD9 #x0172) ; LATIN CAPITAL LETTER U WITH OGONEK
 224   (#xDD #x0168) ; LATIN CAPITAL LETTER U WITH TILDE
 225   (#xDE #x016A) ; LATIN CAPITAL LETTER U WITH MACRON
 226   (#xE0 #x0101) ; LATIN SMALL LETTER A WITH MACRON
 227   (#xE7 #x012F) ; LATIN SMALL LETTER I WITH OGONEK
 228   (#xE8 #x010D) ; LATIN SMALL LETTER C WITH CARON
 229   (#xEA #x0119) ; LATIN SMALL LETTER E WITH OGONEK
 230   (#xEC #x0117) ; LATIN SMALL LETTER E WITH DOT ABOVE
 231   (#xEF #x012B) ; LATIN SMALL LETTER I WITH MACRON
 232   (#xF0 #x0111) ; LATIN SMALL LETTER D WITH STROKE
 233   (#xF1 #x0146) ; LATIN SMALL LETTER N WITH CEDILLA
 234   (#xF2 #x014D) ; LATIN SMALL LETTER O WITH MACRON
 235   (#xF3 #x0137) ; LATIN SMALL LETTER K WITH CEDILLA
 236   (#xF9 #x0173) ; LATIN SMALL LETTER U WITH OGONEK
 237   (#xFD #x0169) ; LATIN SMALL LETTER U WITH TILDE
 238   (#xFE #x016B) ; LATIN SMALL LETTER U WITH MACRON
 239   (#xFF #x02D9) ; DOT ABOVE
 240 )
 241
 242 (declaim (inline get-iso-8859-4-bytes))
 243 (defun get-iso-8859-4-bytes(string pos end)
 244   (declare (optimize speed (safety 0))
 245            (type simple-string string)
 246            (type array-range pos end))
 247   (get-latin-bytes #'identity :iso-8859-4 string pos end))
 248
 249 (defun string->iso-8859-4 (string sstart send null-padding)
 250   (declare (optimize speed (safety 0))
 251            (type simple-string string)
 252            (type array-range sstart send))
 253   (values (string->latin% string sstart send #'get-iso-8859-4-bytes null-padding)))
 254
 255 (defmacro define-iso-8859-4->string* (accessor type)
 256   (declare (ignore type))
 257   (let ((name (make-od-name 'iso-8859-4->string* accessor)))
 258     `(progn
 259       (defun ,name (string sstart send array astart aend)
 260         (,(make-od-name 'latin->string* accessor) string sstart send array astart aend #'identity)))))
 261
 262 (instantiate-octets-definition define-iso-8859-4->string*)
 263
 264 (defmacro define-iso-8859-4->string (accessor type)
 265   (declare (ignore type))
 266   `(defun ,(make-od-name 'iso-8859-4->string accessor) (array astart aend)
 267     (,(make-od-name 'latin->string accessor) array astart aend #'identity)))
 268
 269 (instantiate-octets-definition define-iso-8859-4->string)
 270
 271 (push '((:iso-8859-4 :|iso-8859-4|)
 272         iso-8859-4->string-aref string->iso-8859-4)
 273       *external-format-functions*)
 274
 275 (define-external-format (:iso-8859-4 :|iso-8859-4|)
 276     1 t
 277     (let ((iso-8859-4-byte (code->iso-8859-4-mapper bits)))
 278       (if iso-8859-4-byte
 279           (setf (sap-ref-8 sap tail) iso-8859-4-byte)
 280           (stream-encoding-error-and-handle stream bits)))
 281     (let ((code (iso-8859-4->code-mapper byte)))
 282       (if code
 283           (code-char code)
 284           (stream-decoding-error stream byte)))) ;; TODO -- error check
 285
 286 (define-unibyte-mapper iso-8859-5->code-mapper code->iso-8859-5-mapper
 287   (#xA1 #x0401) ; CYRILLIC CAPITAL LETTER IO
 288   (#xA2 #x0402) ; CYRILLIC CAPITAL LETTER DJE
 289   (#xA3 #x0403) ; CYRILLIC CAPITAL LETTER GJE
 290   (#xA4 #x0404) ; CYRILLIC CAPITAL LETTER UKRAINIAN IE
 291   (#xA5 #x0405) ; CYRILLIC CAPITAL LETTER DZE
 292   (#xA6 #x0406) ; CYRILLIC CAPITAL LETTER BYELORUSSIAN-UKRAINIAN I
 293   (#xA7 #x0407) ; CYRILLIC CAPITAL LETTER YI
 294   (#xA8 #x0408) ; CYRILLIC CAPITAL LETTER JE
 295   (#xA9 #x0409) ; CYRILLIC CAPITAL LETTER LJE
 296   (#xAA #x040A) ; CYRILLIC CAPITAL LETTER NJE
 297   (#xAB #x040B) ; CYRILLIC CAPITAL LETTER TSHE
 298   (#xAC #x040C) ; CYRILLIC CAPITAL LETTER KJE
 299   (#xAE #x040E) ; CYRILLIC CAPITAL LETTER SHORT U
 300   (#xAF #x040F) ; CYRILLIC CAPITAL LETTER DZHE
 301   (#xB0 #x0410) ; CYRILLIC CAPITAL LETTER A
 302   (#xB1 #x0411) ; CYRILLIC CAPITAL LETTER BE
 303   (#xB2 #x0412) ; CYRILLIC CAPITAL LETTER VE
 304   (#xB3 #x0413) ; CYRILLIC CAPITAL LETTER GHE
 305   (#xB4 #x0414) ; CYRILLIC CAPITAL LETTER DE
 306   (#xB5 #x0415) ; CYRILLIC CAPITAL LETTER IE
 307   (#xB6 #x0416) ; CYRILLIC CAPITAL LETTER ZHE
 308   (#xB7 #x0417) ; CYRILLIC CAPITAL LETTER ZE
 309   (#xB8 #x0418) ; CYRILLIC CAPITAL LETTER I
 310   (#xB9 #x0419) ; CYRILLIC CAPITAL LETTER SHORT I
 311   (#xBA #x041A) ; CYRILLIC CAPITAL LETTER KA
 312   (#xBB #x041B) ; CYRILLIC CAPITAL LETTER EL
 313   (#xBC #x041C) ; CYRILLIC CAPITAL LETTER EM
 314   (#xBD #x041D) ; CYRILLIC CAPITAL LETTER EN
 315   (#xBE #x041E) ; CYRILLIC CAPITAL LETTER O
 316   (#xBF #x041F) ; CYRILLIC CAPITAL LETTER PE
 317   (#xC0 #x0420) ; CYRILLIC CAPITAL LETTER ER
 318   (#xC1 #x0421) ; CYRILLIC CAPITAL LETTER ES
 319   (#xC2 #x0422) ; CYRILLIC CAPITAL LETTER TE
 320   (#xC3 #x0423) ; CYRILLIC CAPITAL LETTER U
 321   (#xC4 #x0424) ; CYRILLIC CAPITAL LETTER EF
 322   (#xC5 #x0425) ; CYRILLIC CAPITAL LETTER HA
 323   (#xC6 #x0426) ; CYRILLIC CAPITAL LETTER TSE
 324   (#xC7 #x0427) ; CYRILLIC CAPITAL LETTER CHE
 325   (#xC8 #x0428) ; CYRILLIC CAPITAL LETTER SHA
 326   (#xC9 #x0429) ; CYRILLIC CAPITAL LETTER SHCHA
 327   (#xCA #x042A) ; CYRILLIC CAPITAL LETTER HARD SIGN
 328   (#xCB #x042B) ; CYRILLIC CAPITAL LETTER YERU
 329   (#xCC #x042C) ; CYRILLIC CAPITAL LETTER SOFT SIGN
 330   (#xCD #x042D) ; CYRILLIC CAPITAL LETTER E
 331   (#xCE #x042E) ; CYRILLIC CAPITAL LETTER YU
 332   (#xCF #x042F) ; CYRILLIC CAPITAL LETTER YA
 333   (#xD0 #x0430) ; CYRILLIC SMALL LETTER A
 334   (#xD1 #x0431) ; CYRILLIC SMALL LETTER BE
 335   (#xD2 #x0432) ; CYRILLIC SMALL LETTER VE
 336   (#xD3 #x0433) ; CYRILLIC SMALL LETTER GHE
 337   (#xD4 #x0434) ; CYRILLIC SMALL LETTER DE
 338   (#xD5 #x0435) ; CYRILLIC SMALL LETTER IE
 339   (#xD6 #x0436) ; CYRILLIC SMALL LETTER ZHE
 340   (#xD7 #x0437) ; CYRILLIC SMALL LETTER ZE
 341   (#xD8 #x0438) ; CYRILLIC SMALL LETTER I
 342   (#xD9 #x0439) ; CYRILLIC SMALL LETTER SHORT I
 343   (#xDA #x043A) ; CYRILLIC SMALL LETTER KA
 344   (#xDB #x043B) ; CYRILLIC SMALL LETTER EL
 345   (#xDC #x043C) ; CYRILLIC SMALL LETTER EM
 346   (#xDD #x043D) ; CYRILLIC SMALL LETTER EN
 347   (#xDE #x043E) ; CYRILLIC SMALL LETTER O
 348   (#xDF #x043F) ; CYRILLIC SMALL LETTER PE
 349   (#xE0 #x0440) ; CYRILLIC SMALL LETTER ER
 350   (#xE1 #x0441) ; CYRILLIC SMALL LETTER ES
 351   (#xE2 #x0442) ; CYRILLIC SMALL LETTER TE
 352   (#xE3 #x0443) ; CYRILLIC SMALL LETTER U
 353   (#xE4 #x0444) ; CYRILLIC SMALL LETTER EF
 354   (#xE5 #x0445) ; CYRILLIC SMALL LETTER HA
 355   (#xE6 #x0446) ; CYRILLIC SMALL LETTER TSE
 356   (#xE7 #x0447) ; CYRILLIC SMALL LETTER CHE
 357   (#xE8 #x0448) ; CYRILLIC SMALL LETTER SHA
 358   (#xE9 #x0449) ; CYRILLIC SMALL LETTER SHCHA
 359   (#xEA #x044A) ; CYRILLIC SMALL LETTER HARD SIGN
 360   (#xEB #x044B) ; CYRILLIC SMALL LETTER YERU
 361   (#xEC #x044C) ; CYRILLIC SMALL LETTER SOFT SIGN
 362   (#xED #x044D) ; CYRILLIC SMALL LETTER E
 363   (#xEE #x044E) ; CYRILLIC SMALL LETTER YU
 364   (#xEF #x044F) ; CYRILLIC SMALL LETTER YA
 365   (#xF0 #x2116) ; NUMERO SIGN
 366   (#xF1 #x0451) ; CYRILLIC SMALL LETTER IO
 367   (#xF2 #x0452) ; CYRILLIC SMALL LETTER DJE
 368   (#xF3 #x0453) ; CYRILLIC SMALL LETTER GJE
 369   (#xF4 #x0454) ; CYRILLIC SMALL LETTER UKRAINIAN IE
 370   (#xF5 #x0455) ; CYRILLIC SMALL LETTER DZE
 371   (#xF6 #x0456) ; CYRILLIC SMALL LETTER BYELORUSSIAN-UKRAINIAN I
 372   (#xF7 #x0457) ; CYRILLIC SMALL LETTER YI
 373   (#xF8 #x0458) ; CYRILLIC SMALL LETTER JE
 374   (#xF9 #x0459) ; CYRILLIC SMALL LETTER LJE
 375   (#xFA #x045A) ; CYRILLIC SMALL LETTER NJE
 376   (#xFB #x045B) ; CYRILLIC SMALL LETTER TSHE
 377   (#xFC #x045C) ; CYRILLIC SMALL LETTER KJE
 378   (#xFD #x00A7) ; SECTION SIGN
 379   (#xFE #x045E) ; CYRILLIC SMALL LETTER SHORT U
 380   (#xFF #x045F) ; CYRILLIC SMALL LETTER DZHE
 381 )
 382
 383 (declaim (inline get-iso-8859-5-bytes))
 384 (defun get-iso-8859-5-bytes(string pos end)
 385   (declare (optimize speed (safety 0))
 386            (type simple-string string)
 387            (type array-range pos end))
 388   (get-latin-bytes #'identity :iso-8859-5 string pos end))
 389
 390 (defun string->iso-8859-5 (string sstart send null-padding)
 391   (declare (optimize speed (safety 0))
 392            (type simple-string string)
 393            (type array-range sstart send))
 394   (values (string->latin% string sstart send #'get-iso-8859-5-bytes null-padding)))
 395
 396 (defmacro define-iso-8859-5->string* (accessor type)
 397   (declare (ignore type))
 398   (let ((name (make-od-name 'iso-8859-5->string* accessor)))
 399     `(progn
 400       (defun ,name (string sstart send array astart aend)
 401         (,(make-od-name 'latin->string* accessor) string sstart send array astart aend #'identity)))))
 402
 403 (instantiate-octets-definition define-iso-8859-5->string*)
 404
 405 (defmacro define-iso-8859-5->string (accessor type)
 406   (declare (ignore type))
 407   `(defun ,(make-od-name 'iso-8859-5->string accessor) (array astart aend)
 408     (,(make-od-name 'latin->string accessor) array astart aend #'identity)))
 409
 410 (instantiate-octets-definition define-iso-8859-5->string)
 411
 412 (push '((:iso-8859-5 :|iso-8859-5|)
 413         iso-8859-5->string-aref string->iso-8859-5)
 414       *external-format-functions*)
 415
 416 (define-external-format (:iso-8859-5 :|iso-8859-5|)
 417     1 t
 418     (let ((iso-8859-5-byte (code->iso-8859-5-mapper bits)))
 419       (if iso-8859-5-byte
 420           (setf (sap-ref-8 sap tail) iso-8859-5-byte)
 421           (stream-encoding-error-and-handle stream bits)))
 422     (let ((code (iso-8859-5->code-mapper byte)))
 423       (if code
 424           (code-char code)
 425           (stream-decoding-error stream byte)))) ;; TODO -- error check
 426
 427 (define-unibyte-mapper iso-8859-6->code-mapper code->iso-8859-6-mapper
 428   (#xA1 nil)
 429   (#xA2 nil)
 430   (#xA3 nil)
 431   (#xA5 nil)
 432   (#xA6 nil)
 433   (#xA7 nil)
 434   (#xA8 nil)
 435   (#xA9 nil)
 436   (#xAA nil)
 437   (#xAB nil)
 438   (#xAC #x060C) ; ARABIC COMMA
 439   (#xAE nil)
 440   (#xAF nil)
 441   (#xB0 nil)
 442   (#xB1 nil)
 443   (#xB2 nil)
 444   (#xB3 nil)
 445   (#xB4 nil)
 446   (#xB5 nil)
 447   (#xB6 nil)
 448   (#xB7 nil)
 449   (#xB8 nil)
 450   (#xB9 nil)
 451   (#xBA nil)
 452   (#xBB #x061B) ; ARABIC SEMICOLON
 453   (#xBC nil)
 454   (#xBD nil)
 455   (#xBE nil)
 456   (#xBF #x061F) ; ARABIC QUESTION MARK
 457   (#xC0 nil)
 458   (#xC1 #x0621) ; ARABIC LETTER HAMZA
 459   (#xC2 #x0622) ; ARABIC LETTER ALEF WITH MADDA ABOVE
 460   (#xC3 #x0623) ; ARABIC LETTER ALEF WITH HAMZA ABOVE
 461   (#xC4 #x0624) ; ARABIC LETTER WAW WITH HAMZA ABOVE
 462   (#xC5 #x0625) ; ARABIC LETTER ALEF WITH HAMZA BELOW
 463   (#xC6 #x0626) ; ARABIC LETTER YEH WITH HAMZA ABOVE
 464   (#xC7 #x0627) ; ARABIC LETTER ALEF
 465   (#xC8 #x0628) ; ARABIC LETTER BEH
 466   (#xC9 #x0629) ; ARABIC LETTER TEH MARBUTA
 467   (#xCA #x062A) ; ARABIC LETTER TEH
 468   (#xCB #x062B) ; ARABIC LETTER THEH
 469   (#xCC #x062C) ; ARABIC LETTER JEEM
 470   (#xCD #x062D) ; ARABIC LETTER HAH
 471   (#xCE #x062E) ; ARABIC LETTER KHAH
 472   (#xCF #x062F) ; ARABIC LETTER DAL
 473   (#xD0 #x0630) ; ARABIC LETTER THAL
 474   (#xD1 #x0631) ; ARABIC LETTER REH
 475   (#xD2 #x0632) ; ARABIC LETTER ZAIN
 476   (#xD3 #x0633) ; ARABIC LETTER SEEN
 477   (#xD4 #x0634) ; ARABIC LETTER SHEEN
 478   (#xD5 #x0635) ; ARABIC LETTER SAD
 479   (#xD6 #x0636) ; ARABIC LETTER DAD
 480   (#xD7 #x0637) ; ARABIC LETTER TAH
 481   (#xD8 #x0638) ; ARABIC LETTER ZAH
 482   (#xD9 #x0639) ; ARABIC LETTER AIN
 483   (#xDA #x063A) ; ARABIC LETTER GHAIN
 484   (#xDB nil)
 485   (#xDC nil)
 486   (#xDD nil)
 487   (#xDE nil)
 488   (#xDF nil)
 489   (#xE0 #x0640) ; ARABIC TATWEEL
 490   (#xE1 #x0641) ; ARABIC LETTER FEH
 491   (#xE2 #x0642) ; ARABIC LETTER QAF
 492   (#xE3 #x0643) ; ARABIC LETTER KAF
 493   (#xE4 #x0644) ; ARABIC LETTER LAM
 494   (#xE5 #x0645) ; ARABIC LETTER MEEM
 495   (#xE6 #x0646) ; ARABIC LETTER NOON
 496   (#xE7 #x0647) ; ARABIC LETTER HEH
 497   (#xE8 #x0648) ; ARABIC LETTER WAW
 498   (#xE9 #x0649) ; ARABIC LETTER ALEF MAKSURA
 499   (#xEA #x064A) ; ARABIC LETTER YEH
 500   (#xEB #x064B) ; ARABIC FATHATAN
 501   (#xEC #x064C) ; ARABIC DAMMATAN
 502   (#xED #x064D) ; ARABIC KASRATAN
 503   (#xEE #x064E) ; ARABIC FATHA
 504   (#xEF #x064F) ; ARABIC DAMMA
 505   (#xF0 #x0650) ; ARABIC KASRA
 506   (#xF1 #x0651) ; ARABIC SHADDA
 507   (#xF2 #x0652) ; ARABIC SUKUN
 508   (#xF3 nil)
 509   (#xF4 nil)
 510   (#xF5 nil)
 511   (#xF6 nil)
 512   (#xF7 nil)
 513   (#xF8 nil)
 514   (#xF9 nil)
 515   (#xFA nil)
 516   (#xFB nil)
 517   (#xFC nil)
 518   (#xFD nil)
 519   (#xFE nil)
 520   (#xFF nil)
 521 )
 522
 523 (declaim (inline get-iso-8859-6-bytes))
 524 (defun get-iso-8859-6-bytes(string pos end)
 525   (declare (optimize speed (safety 0))
 526            (type simple-string string)
 527            (type array-range pos end))
 528   (get-latin-bytes #'identity :iso-8859-6 string pos end))
 529
 530 (defun string->iso-8859-6 (string sstart send null-padding)
 531   (declare (optimize speed (safety 0))
 532            (type simple-string string)
 533            (type array-range sstart send))
 534   (values (string->latin% string sstart send #'get-iso-8859-6-bytes null-padding)))
 535
 536 (defmacro define-iso-8859-6->string* (accessor type)
 537   (declare (ignore type))
 538   (let ((name (make-od-name 'iso-8859-6->string* accessor)))
 539     `(progn
 540       (defun ,name (string sstart send array astart aend)
 541         (,(make-od-name 'latin->string* accessor) string sstart send array astart aend #'identity)))))
 542
 543 (instantiate-octets-definition define-iso-8859-6->string*)
 544
 545 (defmacro define-iso-8859-6->string (accessor type)
 546   (declare (ignore type))
 547   `(defun ,(make-od-name 'iso-8859-6->string accessor) (array astart aend)
 548     (,(make-od-name 'latin->string accessor) array astart aend #'identity)))
 549
 550 (instantiate-octets-definition define-iso-8859-6->string)
 551
 552 (push '((:iso-8859-6 :|iso-8859-6|)
 553         iso-8859-6->string-aref string->iso-8859-6)
 554       *external-format-functions*)
 555
 556 (define-external-format (:iso-8859-6 :|iso-8859-6|)
 557     1 t
 558     (let ((iso-8859-6-byte (code->iso-8859-6-mapper bits)))
 559       (if iso-8859-6-byte
 560           (setf (sap-ref-8 sap tail) iso-8859-6-byte)
 561           (stream-encoding-error-and-handle stream bits)))
 562     (let ((code (iso-8859-6->code-mapper byte)))
 563       (if code
 564           (code-char code)
 565           (stream-decoding-error stream byte)))) ;; TODO -- error check
 566
 567 (define-unibyte-mapper iso-8859-7->code-mapper code->iso-8859-7-mapper
 568   (#xA1 #x02BD) ; MODIFIER LETTER REVERSED COMMA
 569   (#xA2 #x02BC) ; MODIFIER LETTER APOSTROPHE
 570   (#xA4 nil)
 571   (#xA5 nil)
 572   (#xAA nil)
 573   (#xAE nil)
 574   (#xAF #x2015) ; HORIZONTAL BAR
 575   (#xB4 #x0384) ; GREEK TONOS
 576   (#xB5 #x0385) ; GREEK DIALYTIKA TONOS
 577   (#xB6 #x0386) ; GREEK CAPITAL LETTER ALPHA WITH TONOS
 578   (#xB8 #x0388) ; GREEK CAPITAL LETTER EPSILON WITH TONOS
 579   (#xB9 #x0389) ; GREEK CAPITAL LETTER ETA WITH TONOS
 580   (#xBA #x038A) ; GREEK CAPITAL LETTER IOTA WITH TONOS
 581   (#xBC #x038C) ; GREEK CAPITAL LETTER OMICRON WITH TONOS
 582   (#xBE #x038E) ; GREEK CAPITAL LETTER UPSILON WITH TONOS
 583   (#xBF #x038F) ; GREEK CAPITAL LETTER OMEGA WITH TONOS
 584   (#xC0 #x0390) ; GREEK SMALL LETTER IOTA WITH DIALYTIKA AND TONOS
 585   (#xC1 #x0391) ; GREEK CAPITAL LETTER ALPHA
 586   (#xC2 #x0392) ; GREEK CAPITAL LETTER BETA
 587   (#xC3 #x0393) ; GREEK CAPITAL LETTER GAMMA
 588   (#xC4 #x0394) ; GREEK CAPITAL LETTER DELTA
 589   (#xC5 #x0395) ; GREEK CAPITAL LETTER EPSILON
 590   (#xC6 #x0396) ; GREEK CAPITAL LETTER ZETA
 591   (#xC7 #x0397) ; GREEK CAPITAL LETTER ETA
 592   (#xC8 #x0398) ; GREEK CAPITAL LETTER THETA
 593   (#xC9 #x0399) ; GREEK CAPITAL LETTER IOTA
 594   (#xCA #x039A) ; GREEK CAPITAL LETTER KAPPA
 595   (#xCB #x039B) ; GREEK CAPITAL LETTER LAMDA
 596   (#xCC #x039C) ; GREEK CAPITAL LETTER MU
 597   (#xCD #x039D) ; GREEK CAPITAL LETTER NU
 598   (#xCE #x039E) ; GREEK CAPITAL LETTER XI
 599   (#xCF #x039F) ; GREEK CAPITAL LETTER OMICRON
 600   (#xD0 #x03A0) ; GREEK CAPITAL LETTER PI
 601   (#xD1 #x03A1) ; GREEK CAPITAL LETTER RHO
 602   (#xD2 nil)
 603   (#xD3 #x03A3) ; GREEK CAPITAL LETTER SIGMA
 604   (#xD4 #x03A4) ; GREEK CAPITAL LETTER TAU
 605   (#xD5 #x03A5) ; GREEK CAPITAL LETTER UPSILON
 606   (#xD6 #x03A6) ; GREEK CAPITAL LETTER PHI
 607   (#xD7 #x03A7) ; GREEK CAPITAL LETTER CHI
 608   (#xD8 #x03A8) ; GREEK CAPITAL LETTER PSI
 609   (#xD9 #x03A9) ; GREEK CAPITAL LETTER OMEGA
 610   (#xDA #x03AA) ; GREEK CAPITAL LETTER IOTA WITH DIALYTIKA
 611   (#xDB #x03AB) ; GREEK CAPITAL LETTER UPSILON WITH DIALYTIKA
 612   (#xDC #x03AC) ; GREEK SMALL LETTER ALPHA WITH TONOS
 613   (#xDD #x03AD) ; GREEK SMALL LETTER EPSILON WITH TONOS
 614   (#xDE #x03AE) ; GREEK SMALL LETTER ETA WITH TONOS
 615   (#xDF #x03AF) ; GREEK SMALL LETTER IOTA WITH TONOS
 616   (#xE0 #x03B0) ; GREEK SMALL LETTER UPSILON WITH DIALYTIKA AND TONOS
 617   (#xE1 #x03B1) ; GREEK SMALL LETTER ALPHA
 618   (#xE2 #x03B2) ; GREEK SMALL LETTER BETA
 619   (#xE3 #x03B3) ; GREEK SMALL LETTER GAMMA
 620   (#xE4 #x03B4) ; GREEK SMALL LETTER DELTA
 621   (#xE5 #x03B5) ; GREEK SMALL LETTER EPSILON
 622   (#xE6 #x03B6) ; GREEK SMALL LETTER ZETA
 623   (#xE7 #x03B7) ; GREEK SMALL LETTER ETA
 624   (#xE8 #x03B8) ; GREEK SMALL LETTER THETA
 625   (#xE9 #x03B9) ; GREEK SMALL LETTER IOTA
 626   (#xEA #x03BA) ; GREEK SMALL LETTER KAPPA
 627   (#xEB #x03BB) ; GREEK SMALL LETTER LAMDA
 628   (#xEC #x03BC) ; GREEK SMALL LETTER MU
 629   (#xED #x03BD) ; GREEK SMALL LETTER NU
 630   (#xEE #x03BE) ; GREEK SMALL LETTER XI
 631   (#xEF #x03BF) ; GREEK SMALL LETTER OMICRON
 632   (#xF0 #x03C0) ; GREEK SMALL LETTER PI
 633   (#xF1 #x03C1) ; GREEK SMALL LETTER RHO
 634   (#xF2 #x03C2) ; GREEK SMALL LETTER FINAL SIGMA
 635   (#xF3 #x03C3) ; GREEK SMALL LETTER SIGMA
 636   (#xF4 #x03C4) ; GREEK SMALL LETTER TAU
 637   (#xF5 #x03C5) ; GREEK SMALL LETTER UPSILON
 638   (#xF6 #x03C6) ; GREEK SMALL LETTER PHI
 639   (#xF7 #x03C7) ; GREEK SMALL LETTER CHI
 640   (#xF8 #x03C8) ; GREEK SMALL LETTER PSI
 641   (#xF9 #x03C9) ; GREEK SMALL LETTER OMEGA
 642   (#xFA #x03CA) ; GREEK SMALL LETTER IOTA WITH DIALYTIKA
 643   (#xFB #x03CB) ; GREEK SMALL LETTER UPSILON WITH DIALYTIKA
 644   (#xFC #x03CC) ; GREEK SMALL LETTER OMICRON WITH TONOS
 645   (#xFD #x03CD) ; GREEK SMALL LETTER UPSILON WITH TONOS
 646   (#xFE #x03CE) ; GREEK SMALL LETTER OMEGA WITH TONOS
 647   (#xFF nil)
 648 )
 649
 650 (declaim (inline get-iso-8859-7-bytes))
 651 (defun get-iso-8859-7-bytes(string pos end)
 652   (declare (optimize speed (safety 0))
 653            (type simple-string string)
 654            (type array-range pos end))
 655   (get-latin-bytes #'identity :iso-8859-7 string pos end))
 656
 657 (defun string->iso-8859-7 (string sstart send null-padding)
 658   (declare (optimize speed (safety 0))
 659            (type simple-string string)
 660            (type array-range sstart send))
 661   (values (string->latin% string sstart send #'get-iso-8859-7-bytes null-padding)))
 662
 663 (defmacro define-iso-8859-7->string* (accessor type)
 664   (declare (ignore type))
 665   (let ((name (make-od-name 'iso-8859-7->string* accessor)))
 666     `(progn
 667       (defun ,name (string sstart send array astart aend)
 668         (,(make-od-name 'latin->string* accessor) string sstart send array astart aend #'identity)))))
 669
 670 (instantiate-octets-definition define-iso-8859-7->string*)
 671
 672 (defmacro define-iso-8859-7->string (accessor type)
 673   (declare (ignore type))
 674   `(defun ,(make-od-name 'iso-8859-7->string accessor) (array astart aend)
 675     (,(make-od-name 'latin->string accessor) array astart aend #'identity)))
 676
 677 (instantiate-octets-definition define-iso-8859-7->string)
 678
 679 (push '((:iso-8859-7 :|iso-8859-7|)
 680         iso-8859-7->string-aref string->iso-8859-7)
 681       *external-format-functions*)
 682
 683 (define-external-format (:iso-8859-7 :|iso-8859-7|)
 684     1 t
 685     (let ((iso-8859-7-byte (code->iso-8859-7-mapper bits)))
 686       (if iso-8859-7-byte
 687           (setf (sap-ref-8 sap tail) iso-8859-7-byte)
 688           (stream-encoding-error-and-handle stream bits)))
 689     (let ((code (iso-8859-7->code-mapper byte)))
 690       (if code
 691           (code-char code)
 692           (stream-decoding-error stream byte)))) ;; TODO -- error check
 693
 694 (define-unibyte-mapper iso-8859-8->code-mapper code->iso-8859-8-mapper
 695   (#xA1 nil)
 696   (#xAA #x00D7) ; MULTIPLICATION SIGN
 697   (#xAF #x203E) ; OVERLINE
 698   (#xBA #x00F7) ; DIVISION SIGN
 699   (#xBF nil)
 700   (#xC0 nil)
 701   (#xC1 nil)
 702   (#xC2 nil)
 703   (#xC3 nil)
 704   (#xC4 nil)
 705   (#xC5 nil)
 706   (#xC6 nil)
 707   (#xC7 nil)
 708   (#xC8 nil)
 709   (#xC9 nil)
 710   (#xCA nil)
 711   (#xCB nil)
 712   (#xCC nil)
 713   (#xCD nil)
 714   (#xCE nil)
 715   (#xCF nil)
 716   (#xD0 nil)
 717   (#xD1 nil)
 718   (#xD2 nil)
 719   (#xD3 nil)
 720   (#xD4 nil)
 721   (#xD5 nil)
 722   (#xD6 nil)
 723   (#xD7 nil)
 724   (#xD8 nil)
 725   (#xD9 nil)
 726   (#xDA nil)
 727   (#xDB nil)
 728   (#xDC nil)
 729   (#xDD nil)
 730   (#xDE nil)
 731   (#xDF #x2017) ; DOUBLE LOW LINE
 732   (#xE0 #x05D0) ; HEBREW LETTER ALEF
 733   (#xE1 #x05D1) ; HEBREW LETTER BET
 734   (#xE2 #x05D2) ; HEBREW LETTER GIMEL
 735   (#xE3 #x05D3) ; HEBREW LETTER DALET
 736   (#xE4 #x05D4) ; HEBREW LETTER HE
 737   (#xE5 #x05D5) ; HEBREW LETTER VAV
 738   (#xE6 #x05D6) ; HEBREW LETTER ZAYIN
 739   (#xE7 #x05D7) ; HEBREW LETTER HET
 740   (#xE8 #x05D8) ; HEBREW LETTER TET
 741   (#xE9 #x05D9) ; HEBREW LETTER YOD
 742   (#xEA #x05DA) ; HEBREW LETTER FINAL KAF
 743   (#xEB #x05DB) ; HEBREW LETTER KAF
 744   (#xEC #x05DC) ; HEBREW LETTER LAMED
 745   (#xED #x05DD) ; HEBREW LETTER FINAL MEM
 746   (#xEE #x05DE) ; HEBREW LETTER MEM
 747   (#xEF #x05DF) ; HEBREW LETTER FINAL NUN
 748   (#xF0 #x05E0) ; HEBREW LETTER NUN
 749   (#xF1 #x05E1) ; HEBREW LETTER SAMEKH
 750   (#xF2 #x05E2) ; HEBREW LETTER AYIN
 751   (#xF3 #x05E3) ; HEBREW LETTER FINAL PE
 752   (#xF4 #x05E4) ; HEBREW LETTER PE
 753   (#xF5 #x05E5) ; HEBREW LETTER FINAL TSADI
 754   (#xF6 #x05E6) ; HEBREW LETTER TSADI
 755   (#xF7 #x05E7) ; HEBREW LETTER QOF
 756   (#xF8 #x05E8) ; HEBREW LETTER RESH
 757   (#xF9 #x05E9) ; HEBREW LETTER SHIN
 758   (#xFA #x05EA) ; HEBREW LETTER TAV
 759   (#xFB nil)
 760   (#xFC nil)
 761   (#xFD nil)
 762   (#xFE nil)
 763   (#xFF nil)
 764 )
 765
 766 (declaim (inline get-iso-8859-8-bytes))
 767 (defun get-iso-8859-8-bytes(string pos end)
 768   (declare (optimize speed (safety 0))
 769            (type simple-string string)
 770            (type array-range pos end))
 771   (get-latin-bytes #'identity :iso-8859-8 string pos end))
 772
 773 (defun string->iso-8859-8 (string sstart send null-padding)
 774   (declare (optimize speed (safety 0))
 775            (type simple-string string)
 776            (type array-range sstart send))
 777   (values (string->latin% string sstart send #'get-iso-8859-8-bytes null-padding)))
 778
 779 (defmacro define-iso-8859-8->string* (accessor type)
 780   (declare (ignore type))
 781   (let ((name (make-od-name 'iso-8859-8->string* accessor)))
 782     `(progn
 783       (defun ,name (string sstart send array astart aend)
 784         (,(make-od-name 'latin->string* accessor) string sstart send array astart aend #'identity)))))
 785
 786 (instantiate-octets-definition define-iso-8859-8->string*)
 787
 788 (defmacro define-iso-8859-8->string (accessor type)
 789   (declare (ignore type))
 790   `(defun ,(make-od-name 'iso-8859-8->string accessor) (array astart aend)
 791     (,(make-od-name 'latin->string accessor) array astart aend #'identity)))
 792
 793 (instantiate-octets-definition define-iso-8859-8->string)
 794
 795 (push '((:iso-8859-8 :|iso-8859-8|)
 796         iso-8859-8->string-aref string->iso-8859-8)
 797       *external-format-functions*)
 798
 799 (define-external-format (:iso-8859-8 :|iso-8859-8|)
 800     1 t
 801     (let ((iso-8859-8-byte (code->iso-8859-8-mapper bits)))
 802       (if iso-8859-8-byte
 803           (setf (sap-ref-8 sap tail) iso-8859-8-byte)
 804           (stream-encoding-error-and-handle stream bits)))
 805     (let ((code (iso-8859-8->code-mapper byte)))
 806       (if code
 807           (code-char code)
 808           (stream-decoding-error stream byte)))) ;; TODO -- error check
 809
 810 (define-unibyte-mapper iso-8859-9->code-mapper code->iso-8859-9-mapper
 811   (#xD0 #x011E) ; LATIN CAPITAL LETTER G WITH BREVE
 812   (#xDD #x0130) ; LATIN CAPITAL LETTER I WITH DOT ABOVE
 813   (#xDE #x015E) ; LATIN CAPITAL LETTER S WITH CEDILLA
 814   (#xF0 #x011F) ; LATIN SMALL LETTER G WITH BREVE
 815   (#xFD #x0131) ; LATIN SMALL LETTER DOTLESS I
 816   (#xFE #x015F) ; LATIN SMALL LETTER S WITH CEDILLA
 817 )
 818
 819 (declaim (inline get-iso-8859-9-bytes))
 820 (defun get-iso-8859-9-bytes(string pos end)
 821   (declare (optimize speed (safety 0))
 822            (type simple-string string)
 823            (type array-range pos end))
 824   (get-latin-bytes #'identity :iso-8859-9 string pos end))
 825
 826 (defun string->iso-8859-9 (string sstart send null-padding)
 827   (declare (optimize speed (safety 0))
 828            (type simple-string string)
 829            (type array-range sstart send))
 830   (values (string->latin% string sstart send #'get-iso-8859-9-bytes null-padding)))
 831
 832 (defmacro define-iso-8859-9->string* (accessor type)
 833   (declare (ignore type))
 834   (let ((name (make-od-name 'iso-8859-9->string* accessor)))
 835     `(progn
 836       (defun ,name (string sstart send array astart aend)
 837         (,(make-od-name 'latin->string* accessor) string sstart send array astart aend #'identity)))))
 838
 839 (instantiate-octets-definition define-iso-8859-9->string*)
 840
 841 (defmacro define-iso-8859-9->string (accessor type)
 842   (declare (ignore type))
 843   `(defun ,(make-od-name 'iso-8859-9->string accessor) (array astart aend)
 844     (,(make-od-name 'latin->string accessor) array astart aend #'identity)))
 845
 846 (instantiate-octets-definition define-iso-8859-9->string)
 847
 848 (push '((:iso-8859-9 :|iso-8859-9|)
 849         iso-8859-9->string-aref string->iso-8859-9)
 850       *external-format-functions*)
 851
 852 (define-external-format (:iso-8859-9 :|iso-8859-9|)
 853     1 t
 854     (let ((iso-8859-9-byte (code->iso-8859-9-mapper bits)))
 855       (if iso-8859-9-byte
 856           (setf (sap-ref-8 sap tail) iso-8859-9-byte)
 857           (stream-encoding-error-and-handle stream bits)))
 858     (let ((code (iso-8859-9->code-mapper byte)))
 859       (if code
 860           (code-char code)
 861           (stream-decoding-error stream byte)))) ;; TODO -- error check
 862
 863 (define-unibyte-mapper iso-8859-10->code-mapper code->iso-8859-10-mapper
 864   (#xA1 #x0104) ; LATIN CAPITAL LETTER A WITH OGONEK
 865   (#xA2 #x0112) ; LATIN CAPITAL LETTER E WITH MACRON
 866   (#xA3 #x0122) ; LATIN CAPITAL LETTER G WITH CEDILLA
 867   (#xA4 #x012A) ; LATIN CAPITAL LETTER I WITH MACRON
 868   (#xA5 #x0128) ; LATIN CAPITAL LETTER I WITH TILDE
 869   (#xA6 #x0136) ; LATIN CAPITAL LETTER K WITH CEDILLA
 870   (#xA8 #x013B) ; LATIN CAPITAL LETTER L WITH CEDILLA
 871   (#xA9 #x0110) ; LATIN CAPITAL LETTER D WITH STROKE
 872   (#xAA #x0160) ; LATIN CAPITAL LETTER S WITH CARON
 873   (#xAB #x0166) ; LATIN CAPITAL LETTER T WITH STROKE
 874   (#xAC #x017D) ; LATIN CAPITAL LETTER Z WITH CARON
 875   (#xAE #x016A) ; LATIN CAPITAL LETTER U WITH MACRON
 876   (#xAF #x014A) ; LATIN CAPITAL LETTER ENG
 877   (#xB1 #x0105) ; LATIN SMALL LETTER A WITH OGONEK
 878   (#xB2 #x0113) ; LATIN SMALL LETTER E WITH MACRON
 879   (#xB3 #x0123) ; LATIN SMALL LETTER G WITH CEDILLA
 880   (#xB4 #x012B) ; LATIN SMALL LETTER I WITH MACRON
 881   (#xB5 #x0129) ; LATIN SMALL LETTER I WITH TILDE
 882   (#xB6 #x0137) ; LATIN SMALL LETTER K WITH CEDILLA
 883   (#xB8 #x013C) ; LATIN SMALL LETTER L WITH CEDILLA
 884   (#xB9 #x0111) ; LATIN SMALL LETTER D WITH STROKE
 885   (#xBA #x0161) ; LATIN SMALL LETTER S WITH CARON
 886   (#xBB #x0167) ; LATIN SMALL LETTER T WITH STROKE
 887   (#xBC #x017E) ; LATIN SMALL LETTER Z WITH CARON
 888   (#xBD #x2015) ; HORIZONTAL BAR
 889   (#xBE #x016B) ; LATIN SMALL LETTER U WITH MACRON
 890   (#xBF #x014B) ; LATIN SMALL LETTER ENG
 891   (#xC0 #x0100) ; LATIN CAPITAL LETTER A WITH MACRON
 892   (#xC7 #x012E) ; LATIN CAPITAL LETTER I WITH OGONEK
 893   (#xC8 #x010C) ; LATIN CAPITAL LETTER C WITH CARON
 894   (#xCA #x0118) ; LATIN CAPITAL LETTER E WITH OGONEK
 895   (#xCC #x0116) ; LATIN CAPITAL LETTER E WITH DOT ABOVE
 896   (#xD1 #x0145) ; LATIN CAPITAL LETTER N WITH CEDILLA
 897   (#xD2 #x014C) ; LATIN CAPITAL LETTER O WITH MACRON
 898   (#xD7 #x0168) ; LATIN CAPITAL LETTER U WITH TILDE
 899   (#xD9 #x0172) ; LATIN CAPITAL LETTER U WITH OGONEK
 900   (#xE0 #x0101) ; LATIN SMALL LETTER A WITH MACRON
 901   (#xE7 #x012F) ; LATIN SMALL LETTER I WITH OGONEK
 902   (#xE8 #x010D) ; LATIN SMALL LETTER C WITH CARON
 903   (#xEA #x0119) ; LATIN SMALL LETTER E WITH OGONEK
 904   (#xEC #x0117) ; LATIN SMALL LETTER E WITH DOT ABOVE
 905   (#xF1 #x0146) ; LATIN SMALL LETTER N WITH CEDILLA
 906   (#xF2 #x014D) ; LATIN SMALL LETTER O WITH MACRON
 907   (#xF7 #x0169) ; LATIN SMALL LETTER U WITH TILDE
 908   (#xF9 #x0173) ; LATIN SMALL LETTER U WITH OGONEK
 909   (#xFF #x0138) ; LATIN SMALL LETTER KRA
 910 )
 911
 912 (declaim (inline get-iso-8859-10-bytes))
 913 (defun get-iso-8859-10-bytes(string pos end)
 914   (declare (optimize speed (safety 0))
 915            (type simple-string string)
 916            (type array-range pos end))
 917   (get-latin-bytes #'identity :iso-8859-10 string pos end))
 918
 919 (defun string->iso-8859-10 (string sstart send null-padding)
 920   (declare (optimize speed (safety 0))
 921            (type simple-string string)
 922            (type array-range sstart send))
 923   (values (string->latin% string sstart send #'get-iso-8859-10-bytes null-padding)))
 924
 925 (defmacro define-iso-8859-10->string* (accessor type)
 926   (declare (ignore type))
 927   (let ((name (make-od-name 'iso-8859-10->string* accessor)))
 928     `(progn
 929       (defun ,name (string sstart send array astart aend)
 930         (,(make-od-name 'latin->string* accessor) string sstart send array astart aend #'identity)))))
 931
 932 (instantiate-octets-definition define-iso-8859-10->string*)
 933
 934 (defmacro define-iso-8859-10->string (accessor type)
 935   (declare (ignore type))
 936   `(defun ,(make-od-name 'iso-8859-10->string accessor) (array astart aend)
 937     (,(make-od-name 'latin->string accessor) array astart aend #'identity)))
 938
 939 (instantiate-octets-definition define-iso-8859-10->string)
 940
 941 (push '((:iso-8859-10 :|iso-8859-10|)
 942         iso-8859-10->string-aref string->iso-8859-10)
 943       *external-format-functions*)
 944
 945 (define-external-format (:iso-8859-10 :|iso-8859-10|)
 946     1 t
 947     (let ((iso-8859-10-byte (code->iso-8859-10-mapper bits)))
 948       (if iso-8859-10-byte
 949           (setf (sap-ref-8 sap tail) iso-8859-10-byte)
 950           (stream-encoding-error-and-handle stream bits)))
 951     (let ((code (iso-8859-10->code-mapper byte)))
 952       (if code
 953           (code-char code)
 954           (stream-decoding-error stream byte)))) ;; TODO -- error check
 955
 956 (define-unibyte-mapper iso-8859-11->code-mapper code->iso-8859-11-mapper
 957   (#xA1 #x0E01) ; THAI CHARACTER KO KAI
 958   (#xA2 #x0E02) ; THAI CHARACTER KHO KHAI
 959   (#xA3 #x0E03) ; THAI CHARACTER KHO KHUAT
 960   (#xA4 #x0E04) ; THAI CHARACTER KHO KHWAI
 961   (#xA5 #x0E05) ; THAI CHARACTER KHO KHON
 962   (#xA6 #x0E06) ; THAI CHARACTER KHO RAKHANG
 963   (#xA7 #x0E07) ; THAI CHARACTER NGO NGU
 964   (#xA8 #x0E08) ; THAI CHARACTER CHO CHAN
 965   (#xA9 #x0E09) ; THAI CHARACTER CHO CHING
 966   (#xAA #x0E0A) ; THAI CHARACTER CHO CHANG
 967   (#xAB #x0E0B) ; THAI CHARACTER SO SO
 968   (#xAC #x0E0C) ; THAI CHARACTER CHO CHOE
 969   (#xAD #x0E0D) ; THAI CHARACTER YO YING
 970   (#xAE #x0E0E) ; THAI CHARACTER DO CHADA
 971   (#xAF #x0E0F) ; THAI CHARACTER TO PATAK
 972   (#xB0 #x0E10) ; THAI CHARACTER THO THAN
 973   (#xB1 #x0E11) ; THAI CHARACTER THO NANGMONTHO
 974   (#xB2 #x0E12) ; THAI CHARACTER THO PHUTHAO
 975   (#xB3 #x0E13) ; THAI CHARACTER NO NEN
 976   (#xB4 #x0E14) ; THAI CHARACTER DO DEK
 977   (#xB5 #x0E15) ; THAI CHARACTER TO TAO
 978   (#xB6 #x0E16) ; THAI CHARACTER THO THUNG
 979   (#xB7 #x0E17) ; THAI CHARACTER THO THAHAN
 980   (#xB8 #x0E18) ; THAI CHARACTER THO THONG
 981   (#xB9 #x0E19) ; THAI CHARACTER NO NU
 982   (#xBA #x0E1A) ; THAI CHARACTER BO BAIMAI
 983   (#xBB #x0E1B) ; THAI CHARACTER PO PLA
 984   (#xBC #x0E1C) ; THAI CHARACTER PHO PHUNG
 985   (#xBD #x0E1D) ; THAI CHARACTER FO FA
 986   (#xBE #x0E1E) ; THAI CHARACTER PHO PHAN
 987   (#xBF #x0E1F) ; THAI CHARACTER FO FAN
 988   (#xC0 #x0E20) ; THAI CHARACTER PHO SAMPHAO
 989   (#xC1 #x0E21) ; THAI CHARACTER MO MA
 990   (#xC2 #x0E22) ; THAI CHARACTER YO YAK
 991   (#xC3 #x0E23) ; THAI CHARACTER RO RUA
 992   (#xC4 #x0E24) ; THAI CHARACTER RU
 993   (#xC5 #x0E25) ; THAI CHARACTER LO LING
 994   (#xC6 #x0E26) ; THAI CHARACTER LU
 995   (#xC7 #x0E27) ; THAI CHARACTER WO WAEN
 996   (#xC8 #x0E28) ; THAI CHARACTER SO SALA
 997   (#xC9 #x0E29) ; THAI CHARACTER SO RUSI
 998   (#xCA #x0E2A) ; THAI CHARACTER SO SUA
 999   (#xCB #x0E2B) ; THAI CHARACTER HO HIP
1000   (#xCC #x0E2C) ; THAI CHARACTER LO CHULA
1001   (#xCD #x0E2D) ; THAI CHARACTER O ANG
1002   (#xCE #x0E2E) ; THAI CHARACTER HO NOKHUK
1003   (#xCF #x0E2F) ; THAI CHARACTER PAIYANNOI
1004   (#xD0 #x0E30) ; THAI CHARACTER SARA A
1005   (#xD1 #x0E31) ; THAI CHARACTER MAI HAN-AKAT
1006   (#xD2 #x0E32) ; THAI CHARACTER SARA AA
1007   (#xD3 #x0E33) ; THAI CHARACTER SARA AM
1008   (#xD4 #x0E34) ; THAI CHARACTER SARA I
1009   (#xD5 #x0E35) ; THAI CHARACTER SARA II
1010   (#xD6 #x0E36) ; THAI CHARACTER SARA UE
1011   (#xD7 #x0E37) ; THAI CHARACTER SARA UEE
1012   (#xD8 #x0E38) ; THAI CHARACTER SARA U
1013   (#xD9 #x0E39) ; THAI CHARACTER SARA UU
1014   (#xDA #x0E3A) ; THAI CHARACTER PHINTHU
1015   (#xDB nil)
1016   (#xDC nil)
1017   (#xDD nil)
1018   (#xDE nil)
1019   (#xDF #x0E3F) ; THAI CURRENCY SYMBOL BAHT
1020   (#xE0 #x0E40) ; THAI CHARACTER SARA E
1021   (#xE1 #x0E41) ; THAI CHARACTER SARA AE
1022   (#xE2 #x0E42) ; THAI CHARACTER SARA O
1023   (#xE3 #x0E43) ; THAI CHARACTER SARA AI MAIMUAN
1024   (#xE4 #x0E44) ; THAI CHARACTER SARA AI MAIMALAI
1025   (#xE5 #x0E45) ; THAI CHARACTER LAKKHANGYAO
1026   (#xE6 #x0E46) ; THAI CHARACTER MAIYAMOK
1027   (#xE7 #x0E47) ; THAI CHARACTER MAITAIKHU
1028   (#xE8 #x0E48) ; THAI CHARACTER MAI EK
1029   (#xE9 #x0E49) ; THAI CHARACTER MAI THO
1030   (#xEA #x0E4A) ; THAI CHARACTER MAI TRI
1031   (#xEB #x0E4B) ; THAI CHARACTER MAI CHATTAWA
1032   (#xEC #x0E4C) ; THAI CHARACTER THANTHAKHAT
1033   (#xED #x0E4D) ; THAI CHARACTER NIKHAHIT
1034   (#xEE #x0E4E) ; THAI CHARACTER YAMAKKAN
1035   (#xEF #x0E4F) ; THAI CHARACTER FONGMAN
1036   (#xF0 #x0E50) ; THAI DIGIT ZERO
1037   (#xF1 #x0E51) ; THAI DIGIT ONE
1038   (#xF2 #x0E52) ; THAI DIGIT TWO
1039   (#xF3 #x0E53) ; THAI DIGIT THREE
1040   (#xF4 #x0E54) ; THAI DIGIT FOUR
1041   (#xF5 #x0E55) ; THAI DIGIT FIVE
1042   (#xF6 #x0E56) ; THAI DIGIT SIX
1043   (#xF7 #x0E57) ; THAI DIGIT SEVEN
1044   (#xF8 #x0E58) ; THAI DIGIT EIGHT
1045   (#xF9 #x0E59) ; THAI DIGIT NINE
1046   (#xFA #x0E5A) ; THAI CHARACTER ANGKHANKHU
1047   (#xFB #x0E5B) ; THAI CHARACTER KHOMUT
1048   (#xFC nil)
1049   (#xFD nil)
1050   (#xFE nil)
1051   (#xFF nil)
1052 )
1053
1054 (declaim (inline get-iso-8859-11-bytes))
1055 (defun get-iso-8859-11-bytes(string pos end)
1056   (declare (optimize speed (safety 0))
1057            (type simple-string string)
1058            (type array-range pos end))
1059   (get-latin-bytes #'identity :iso-8859-11 string pos end))
1060
1061 (defun string->iso-8859-11 (string sstart send null-padding)
1062   (declare (optimize speed (safety 0))
1063            (type simple-string string)
1064            (type array-range sstart send))
1065   (values (string->latin% string sstart send #'get-iso-8859-11-bytes null-padding)))
1066
1067 (defmacro define-iso-8859-11->string* (accessor type)
1068   (declare (ignore type))
1069   (let ((name (make-od-name 'iso-8859-11->string* accessor)))
1070     `(progn
1071       (defun ,name (string sstart send array astart aend)
1072         (,(make-od-name 'latin->string* accessor) string sstart send array astart aend #'identity)))))
1073
1074 (instantiate-octets-definition define-iso-8859-11->string*)
1075
1076 (defmacro define-iso-8859-11->string (accessor type)
1077   (declare (ignore type))
1078   `(defun ,(make-od-name 'iso-8859-11->string accessor) (array astart aend)
1079     (,(make-od-name 'latin->string accessor) array astart aend #'identity)))
1080
1081 (instantiate-octets-definition define-iso-8859-11->string)
1082
1083 (push '((:iso-8859-11 :|iso-8859-11|)
1084         iso-8859-11->string-aref string->iso-8859-11)
1085       *external-format-functions*)
1086
1087 (define-external-format (:iso-8859-11 :|iso-8859-11|)
1088     1 t
1089     (let ((iso-8859-11-byte (code->iso-8859-11-mapper bits)))
1090       (if iso-8859-11-byte
1091           (setf (sap-ref-8 sap tail) iso-8859-11-byte)
1092           (stream-encoding-error-and-handle stream bits)))
1093     (let ((code (iso-8859-11->code-mapper byte)))
1094       (if code
1095           (code-char code)
1096           (stream-decoding-error stream byte)))) ;; TODO -- error check
1097
1098 (define-unibyte-mapper iso-8859-13->code-mapper code->iso-8859-13-mapper
1099   (#xA1 #x201D) ; RIGHT DOUBLE QUOTATION MARK
1100   (#xA5 #x201E) ; DOUBLE LOW-9 QUOTATION MARK
1101   (#xA8 #x00D8) ; LATIN CAPITAL LETTER O WITH STROKE
1102   (#xAA #x0156) ; LATIN CAPITAL LETTER R WITH CEDILLA
1103   (#xAF #x00C6) ; LATIN CAPITAL LETTER AE
1104   (#xB4 #x201C) ; LEFT DOUBLE QUOTATION MARK
1105   (#xB8 #x00F8) ; LATIN SMALL LETTER O WITH STROKE
1106   (#xBA #x0157) ; LATIN SMALL LETTER R WITH CEDILLA
1107   (#xBF #x00E6) ; LATIN SMALL LETTER AE
1108   (#xC0 #x0104) ; LATIN CAPITAL LETTER A WITH OGONEK
1109   (#xC1 #x012E) ; LATIN CAPITAL LETTER I WITH OGONEK
1110   (#xC2 #x0100) ; LATIN CAPITAL LETTER A WITH MACRON
1111   (#xC3 #x0106) ; LATIN CAPITAL LETTER C WITH ACUTE
1112   (#xC6 #x0118) ; LATIN CAPITAL LETTER E WITH OGONEK
1113   (#xC7 #x0112) ; LATIN CAPITAL LETTER E WITH MACRON
1114   (#xC8 #x010C) ; LATIN CAPITAL LETTER C WITH CARON
1115   (#xCA #x0179) ; LATIN CAPITAL LETTER Z WITH ACUTE
1116   (#xCB #x0116) ; LATIN CAPITAL LETTER E WITH DOT ABOVE
1117   (#xCC #x0122) ; LATIN CAPITAL LETTER G WITH CEDILLA
1118   (#xCD #x0136) ; LATIN CAPITAL LETTER K WITH CEDILLA
1119   (#xCE #x012A) ; LATIN CAPITAL LETTER I WITH MACRON
1120   (#xCF #x013B) ; LATIN CAPITAL LETTER L WITH CEDILLA
1121   (#xD0 #x0160) ; LATIN CAPITAL LETTER S WITH CARON
1122   (#xD1 #x0143) ; LATIN CAPITAL LETTER N WITH ACUTE
1123   (#xD2 #x0145) ; LATIN CAPITAL LETTER N WITH CEDILLA
1124   (#xD4 #x014C) ; LATIN CAPITAL LETTER O WITH MACRON
1125   (#xD8 #x0172) ; LATIN CAPITAL LETTER U WITH OGONEK
1126   (#xD9 #x0141) ; LATIN CAPITAL LETTER L WITH STROKE
1127   (#xDA #x015A) ; LATIN CAPITAL LETTER S WITH ACUTE
1128   (#xDB #x016A) ; LATIN CAPITAL LETTER U WITH MACRON
1129   (#xDD #x017B) ; LATIN CAPITAL LETTER Z WITH DOT ABOVE
1130   (#xDE #x017D) ; LATIN CAPITAL LETTER Z WITH CARON
1131   (#xE0 #x0105) ; LATIN SMALL LETTER A WITH OGONEK
1132   (#xE1 #x012F) ; LATIN SMALL LETTER I WITH OGONEK
1133   (#xE2 #x0101) ; LATIN SMALL LETTER A WITH MACRON
1134   (#xE3 #x0107) ; LATIN SMALL LETTER C WITH ACUTE
1135   (#xE6 #x0119) ; LATIN SMALL LETTER E WITH OGONEK
1136   (#xE7 #x0113) ; LATIN SMALL LETTER E WITH MACRON
1137   (#xE8 #x010D) ; LATIN SMALL LETTER C WITH CARON
1138   (#xEA #x017A) ; LATIN SMALL LETTER Z WITH ACUTE
1139   (#xEB #x0117) ; LATIN SMALL LETTER E WITH DOT ABOVE
1140   (#xEC #x0123) ; LATIN SMALL LETTER G WITH CEDILLA
1141   (#xED #x0137) ; LATIN SMALL LETTER K WITH CEDILLA
1142   (#xEE #x012B) ; LATIN SMALL LETTER I WITH MACRON
1143   (#xEF #x013C) ; LATIN SMALL LETTER L WITH CEDILLA
1144   (#xF0 #x0161) ; LATIN SMALL LETTER S WITH CARON
1145   (#xF1 #x0144) ; LATIN SMALL LETTER N WITH ACUTE
1146   (#xF2 #x0146) ; LATIN SMALL LETTER N WITH CEDILLA
1147   (#xF4 #x014D) ; LATIN SMALL LETTER O WITH MACRON
1148   (#xF8 #x0173) ; LATIN SMALL LETTER U WITH OGONEK
1149   (#xF9 #x0142) ; LATIN SMALL LETTER L WITH STROKE
1150   (#xFA #x015B) ; LATIN SMALL LETTER S WITH ACUTE
1151   (#xFB #x016B) ; LATIN SMALL LETTER U WITH MACRON
1152   (#xFD #x017C) ; LATIN SMALL LETTER Z WITH DOT ABOVE
1153   (#xFE #x017E) ; LATIN SMALL LETTER Z WITH CARON
1154   (#xFF #x2019) ; RIGHT SINGLE QUOTATION MARK
1155 )
1156
1157 (declaim (inline get-iso-8859-13-bytes))
1158 (defun get-iso-8859-13-bytes(string pos end)
1159   (declare (optimize speed (safety 0))
1160            (type simple-string string)
1161            (type array-range pos end))
1162   (get-latin-bytes #'identity :iso-8859-13 string pos end))
1163
1164 (defun string->iso-8859-13 (string sstart send null-padding)
1165   (declare (optimize speed (safety 0))
1166            (type simple-string string)
1167            (type array-range sstart send))
1168   (values (string->latin% string sstart send #'get-iso-8859-13-bytes null-padding)))
1169
1170 (defmacro define-iso-8859-13->string* (accessor type)
1171   (declare (ignore type))
1172   (let ((name (make-od-name 'iso-8859-13->string* accessor)))
1173     `(progn
1174       (defun ,name (string sstart send array astart aend)
1175         (,(make-od-name 'latin->string* accessor) string sstart send array astart aend #'identity)))))
1176
1177 (instantiate-octets-definition define-iso-8859-13->string*)
1178
1179 (defmacro define-iso-8859-13->string (accessor type)
1180   (declare (ignore type))
1181   `(defun ,(make-od-name 'iso-8859-13->string accessor) (array astart aend)
1182     (,(make-od-name 'latin->string accessor) array astart aend #'identity)))
1183
1184 (instantiate-octets-definition define-iso-8859-13->string)
1185
1186 (push '((:iso-8859-13 :|iso-8859-13|)
1187         iso-8859-13->string-aref string->iso-8859-13)
1188       *external-format-functions*)
1189
1190 (define-external-format (:iso-8859-13 :|iso-8859-13|)
1191     1 t
1192     (let ((iso-8859-13-byte (code->iso-8859-13-mapper bits)))
1193       (if iso-8859-13-byte
1194           (setf (sap-ref-8 sap tail) iso-8859-13-byte)
1195           (stream-encoding-error-and-handle stream bits)))
1196     (let ((code (iso-8859-13->code-mapper byte)))
1197       (if code
1198           (code-char code)
1199           (stream-decoding-error stream byte)))) ;; TODO -- error check
1200
1201 (define-unibyte-mapper iso-8859-14->code-mapper code->iso-8859-14-mapper
1202   (#xA1 #x1E02) ; LATIN CAPITAL LETTER B WITH DOT ABOVE
1203   (#xA2 #x1E03) ; LATIN SMALL LETTER B WITH DOT ABOVE
1204   (#xA4 #x010A) ; LATIN CAPITAL LETTER C WITH DOT ABOVE
1205   (#xA5 #x010B) ; LATIN SMALL LETTER C WITH DOT ABOVE
1206   (#xA6 #x1E0A) ; LATIN CAPITAL LETTER D WITH DOT ABOVE
1207   (#xA8 #x1E80) ; LATIN CAPITAL LETTER W WITH GRAVE
1208   (#xAA #x1E82) ; LATIN CAPITAL LETTER W WITH ACUTE
1209   (#xAB #x1E0B) ; LATIN SMALL LETTER D WITH DOT ABOVE
1210   (#xAC #x1EF2) ; LATIN CAPITAL LETTER Y WITH GRAVE
1211   (#xAF #x0178) ; LATIN CAPITAL LETTER Y WITH DIAERESIS
1212   (#xB0 #x1E1E) ; LATIN CAPITAL LETTER F WITH DOT ABOVE
1213   (#xB1 #x1E1F) ; LATIN SMALL LETTER F WITH DOT ABOVE
1214   (#xB2 #x0120) ; LATIN CAPITAL LETTER G WITH DOT ABOVE
1215   (#xB3 #x0121) ; LATIN SMALL LETTER G WITH DOT ABOVE
1216   (#xB4 #x1E40) ; LATIN CAPITAL LETTER M WITH DOT ABOVE
1217   (#xB5 #x1E41) ; LATIN SMALL LETTER M WITH DOT ABOVE
1218   (#xB7 #x1E56) ; LATIN CAPITAL LETTER P WITH DOT ABOVE
1219   (#xB8 #x1E81) ; LATIN SMALL LETTER W WITH GRAVE
1220   (#xB9 #x1E57) ; LATIN SMALL LETTER P WITH DOT ABOVE
1221   (#xBA #x1E83) ; LATIN SMALL LETTER W WITH ACUTE
1222   (#xBB #x1E60) ; LATIN CAPITAL LETTER S WITH DOT ABOVE
1223   (#xBC #x1EF3) ; LATIN SMALL LETTER Y WITH GRAVE
1224   (#xBD #x1E84) ; LATIN CAPITAL LETTER W WITH DIAERESIS
1225   (#xBE #x1E85) ; LATIN SMALL LETTER W WITH DIAERESIS
1226   (#xBF #x1E61) ; LATIN SMALL LETTER S WITH DOT ABOVE
1227   (#xD0 #x0174) ; LATIN CAPITAL LETTER W WITH CIRCUMFLEX
1228   (#xD7 #x1E6A) ; LATIN CAPITAL LETTER T WITH DOT ABOVE
1229   (#xDE #x0176) ; LATIN CAPITAL LETTER Y WITH CIRCUMFLEX
1230   (#xF0 #x0175) ; LATIN SMALL LETTER W WITH CIRCUMFLEX
1231   (#xF7 #x1E6B) ; LATIN SMALL LETTER T WITH DOT ABOVE
1232   (#xFE #x0177) ; LATIN SMALL LETTER Y WITH CIRCUMFLEX
1233 )
1234
1235 (declaim (inline get-iso-8859-14-bytes))
1236 (defun get-iso-8859-14-bytes(string pos end)
1237   (declare (optimize speed (safety 0))
1238            (type simple-string string)
1239            (type array-range pos end))
1240   (get-latin-bytes #'identity :iso-8859-14 string pos end))
1241
1242 (defun string->iso-8859-14 (string sstart send null-padding)
1243   (declare (optimize speed (safety 0))
1244            (type simple-string string)
1245            (type array-range sstart send))
1246   (values (string->latin% string sstart send #'get-iso-8859-14-bytes null-padding)))
1247
1248 (defmacro define-iso-8859-14->string* (accessor type)
1249   (declare (ignore type))
1250   (let ((name (make-od-name 'iso-8859-14->string* accessor)))
1251     `(progn
1252       (defun ,name (string sstart send array astart aend)
1253         (,(make-od-name 'latin->string* accessor) string sstart send array astart aend #'identity)))))
1254
1255 (instantiate-octets-definition define-iso-8859-14->string*)
1256
1257 (defmacro define-iso-8859-14->string (accessor type)
1258   (declare (ignore type))
1259   `(defun ,(make-od-name 'iso-8859-14->string accessor) (array astart aend)
1260     (,(make-od-name 'latin->string accessor) array astart aend #'identity)))
1261
1262 (instantiate-octets-definition define-iso-8859-14->string)
1263
1264 (push '((:iso-8859-14 :|iso-8859-14|)
1265         iso-8859-14->string-aref string->iso-8859-14)
1266       *external-format-functions*)
1267
1268 (define-external-format (:iso-8859-14 :|iso-8859-14|)
1269     1 t
1270     (let ((iso-8859-14-byte (code->iso-8859-14-mapper bits)))
1271       (if iso-8859-14-byte
1272           (setf (sap-ref-8 sap tail) iso-8859-14-byte)
1273           (stream-encoding-error-and-handle stream bits)))
1274     (let ((code (iso-8859-14->code-mapper byte)))
1275       (if code
1276           (code-char code)
1277           (stream-decoding-error stream byte)))) ;; TODO -- error check