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

   1 (in-package #:sb!impl)
   2
   3 (define-unibyte-mapper cp1250->code-mapper code->cp1250-mapper
   4   (#x80 #x20AC) ; EURO SIGN
   5   (#x81 nil)
   6   (#x82 #x201A) ; SINGLE LOW-9 QUOTATION MARK
   7   (#x83 nil)
   8   (#x84 #x201E) ; DOUBLE LOW-9 QUOTATION MARK
   9   (#x85 #x2026) ; HORIZONTAL ELLIPSIS
  10   (#x86 #x2020) ; DAGGER
  11   (#x87 #x2021) ; DOUBLE DAGGER
  12   (#x88 nil)
  13   (#x89 #x2030) ; PER MILLE SIGN
  14   (#x8A #x0160) ; LATIN CAPITAL LETTER S WITH CARON
  15   (#x8B #x2039) ; SINGLE LEFT-POINTING ANGLE QUOTATION MARK
  16   (#x8C #x015A) ; LATIN CAPITAL LETTER S WITH ACUTE
  17   (#x8D #x0164) ; LATIN CAPITAL LETTER T WITH CARON
  18   (#x8E #x017D) ; LATIN CAPITAL LETTER Z WITH CARON
  19   (#x8F #x0179) ; LATIN CAPITAL LETTER Z WITH ACUTE
  20   (#x90 nil)
  21   (#x91 #x2018) ; LEFT SINGLE QUOTATION MARK
  22   (#x92 #x2019) ; RIGHT SINGLE QUOTATION MARK
  23   (#x93 #x201C) ; LEFT DOUBLE QUOTATION MARK
  24   (#x94 #x201D) ; RIGHT DOUBLE QUOTATION MARK
  25   (#x95 #x2022) ; BULLET
  26   (#x96 #x2013) ; EN DASH
  27   (#x97 #x2014) ; EM DASH
  28   (#x98 nil)
  29   (#x99 #x2122) ; TRADE MARK SIGN
  30   (#x9A #x0161) ; LATIN SMALL LETTER S WITH CARON
  31   (#x9B #x203A) ; SINGLE RIGHT-POINTING ANGLE QUOTATION MARK
  32   (#x9C #x015B) ; LATIN SMALL LETTER S WITH ACUTE
  33   (#x9D #x0165) ; LATIN SMALL LETTER T WITH CARON
  34   (#x9E #x017E) ; LATIN SMALL LETTER Z WITH CARON
  35   (#x9F #x017A) ; LATIN SMALL LETTER Z WITH ACUTE
  36   (#xA1 #x02C7) ; CARON
  37   (#xA2 #x02D8) ; BREVE
  38   (#xA3 #x0141) ; LATIN CAPITAL LETTER L WITH STROKE
  39   (#xA5 #x0104) ; LATIN CAPITAL LETTER A WITH OGONEK
  40   (#xAA #x015E) ; LATIN CAPITAL LETTER S WITH CEDILLA
  41   (#xAF #x017B) ; LATIN CAPITAL LETTER Z WITH DOT ABOVE
  42   (#xB2 #x02DB) ; OGONEK
  43   (#xB3 #x0142) ; LATIN SMALL LETTER L WITH STROKE
  44   (#xB9 #x0105) ; LATIN SMALL LETTER A WITH OGONEK
  45   (#xBA #x015F) ; LATIN SMALL LETTER S WITH CEDILLA
  46   (#xBC #x013D) ; LATIN CAPITAL LETTER L WITH CARON
  47   (#xBD #x02DD) ; DOUBLE ACUTE ACCENT
  48   (#xBE #x013E) ; LATIN SMALL LETTER L WITH CARON
  49   (#xBF #x017C) ; LATIN SMALL LETTER Z WITH DOT ABOVE
  50   (#xC0 #x0154) ; LATIN CAPITAL LETTER R WITH ACUTE
  51   (#xC3 #x0102) ; LATIN CAPITAL LETTER A WITH BREVE
  52   (#xC5 #x0139) ; LATIN CAPITAL LETTER L WITH ACUTE
  53   (#xC6 #x0106) ; LATIN CAPITAL LETTER C WITH ACUTE
  54   (#xC8 #x010C) ; LATIN CAPITAL LETTER C WITH CARON
  55   (#xCA #x0118) ; LATIN CAPITAL LETTER E WITH OGONEK
  56   (#xCC #x011A) ; LATIN CAPITAL LETTER E WITH CARON
  57   (#xCF #x010E) ; LATIN CAPITAL LETTER D WITH CARON
  58   (#xD0 #x0110) ; LATIN CAPITAL LETTER D WITH STROKE
  59   (#xD1 #x0143) ; LATIN CAPITAL LETTER N WITH ACUTE
  60   (#xD2 #x0147) ; LATIN CAPITAL LETTER N WITH CARON
  61   (#xD5 #x0150) ; LATIN CAPITAL LETTER O WITH DOUBLE ACUTE
  62   (#xD8 #x0158) ; LATIN CAPITAL LETTER R WITH CARON
  63   (#xD9 #x016E) ; LATIN CAPITAL LETTER U WITH RING ABOVE
  64   (#xDB #x0170) ; LATIN CAPITAL LETTER U WITH DOUBLE ACUTE
  65   (#xDE #x0162) ; LATIN CAPITAL LETTER T WITH CEDILLA
  66   (#xE0 #x0155) ; LATIN SMALL LETTER R WITH ACUTE
  67   (#xE3 #x0103) ; LATIN SMALL LETTER A WITH BREVE
  68   (#xE5 #x013A) ; LATIN SMALL LETTER L WITH ACUTE
  69   (#xE6 #x0107) ; LATIN SMALL LETTER C WITH ACUTE
  70   (#xE8 #x010D) ; LATIN SMALL LETTER C WITH CARON
  71   (#xEA #x0119) ; LATIN SMALL LETTER E WITH OGONEK
  72   (#xEC #x011B) ; LATIN SMALL LETTER E WITH CARON
  73   (#xEF #x010F) ; LATIN SMALL LETTER D WITH CARON
  74   (#xF0 #x0111) ; LATIN SMALL LETTER D WITH STROKE
  75   (#xF1 #x0144) ; LATIN SMALL LETTER N WITH ACUTE
  76   (#xF2 #x0148) ; LATIN SMALL LETTER N WITH CARON
  77   (#xF5 #x0151) ; LATIN SMALL LETTER O WITH DOUBLE ACUTE
  78   (#xF8 #x0159) ; LATIN SMALL LETTER R WITH CARON
  79   (#xF9 #x016F) ; LATIN SMALL LETTER U WITH RING ABOVE
  80   (#xFB #x0171) ; LATIN SMALL LETTER U WITH DOUBLE ACUTE
  81   (#xFE #x0163) ; LATIN SMALL LETTER T WITH CEDILLA
  82   (#xFF #x02D9) ; DOT ABOVE
  83 )
  84
  85 (declaim (inline get-cp1250-bytes))
  86 (defun get-cp1250-bytes(string pos end)
  87   (declare (optimize speed (safety 0))
  88            (type simple-string string)
  89            (type array-range pos end))
  90   (get-latin-bytes #'code->cp1250-mapper :cp1250 string pos end))
  91
  92 (defun string->cp1250 (string sstart send null-padding)
  93   (declare (optimize speed (safety 0))
  94            (type simple-string string)
  95            (type array-range sstart send))
  96   (values (string->latin% string sstart send #'get-cp1250-bytes null-padding)))
  97
  98 (defmacro define-cp1250->string* (accessor type)
  99   (declare (ignore type))
 100   (let ((name (make-od-name 'cp1250->string* accessor)))
 101     `(progn
 102       (defun ,name (string sstart send array astart aend)
 103         (,(make-od-name 'latin->string* accessor) string sstart send array astart aend #'cp1250->code-mapper)))))
 104
 105 (instantiate-octets-definition define-cp1250->string*)
 106
 107 (defmacro define-cp1250->string (accessor type)
 108   (declare (ignore type))
 109   `(defun ,(make-od-name 'cp1250->string accessor) (array astart aend)
 110     (,(make-od-name 'latin->string accessor) array astart aend #'cp1250->code-mapper)))
 111
 112 (instantiate-octets-definition define-cp1250->string)
 113
 114 (push '((:cp1250 :|cp1250| :windows-1250 :|windows-1250|)
 115         cp1250->string-aref string->cp1250)
 116       *external-format-functions*)
 117
 118 (define-external-format (:cp1250 :|cp1250| :windows-1250 :|windows-1250|)
 119     1 t
 120     (let ((cp1250-byte (code->cp1250-mapper bits)))
 121       (if cp1250-byte
 122           (setf (sap-ref-8 sap tail) cp1250-byte)
 123           (stream-encoding-error-and-handle stream bits)))
 124     (let ((code (cp1250->code-mapper byte)))
 125       (if code
 126           (code-char code)
 127           (stream-decoding-error stream byte)))) ;; TODO -- error check
 128
 129 (define-unibyte-mapper cp1251->code-mapper code->cp1251-mapper
 130   (#x80 #x0402) ; CYRILLIC CAPITAL LETTER DJE
 131   (#x81 #x0403) ; CYRILLIC CAPITAL LETTER GJE
 132   (#x82 #x201A) ; SINGLE LOW-9 QUOTATION MARK
 133   (#x83 #x0453) ; CYRILLIC SMALL LETTER GJE
 134   (#x84 #x201E) ; DOUBLE LOW-9 QUOTATION MARK
 135   (#x85 #x2026) ; HORIZONTAL ELLIPSIS
 136   (#x86 #x2020) ; DAGGER
 137   (#x87 #x2021) ; DOUBLE DAGGER
 138   (#x88 nil)
 139   (#x89 #x2030) ; PER MILLE SIGN
 140   (#x8A #x0409) ; CYRILLIC CAPITAL LETTER LJE
 141   (#x8B #x2039) ; SINGLE LEFT-POINTING ANGLE QUOTATION MARK
 142   (#x8C #x040A) ; CYRILLIC CAPITAL LETTER NJE
 143   (#x8D #x040C) ; CYRILLIC CAPITAL LETTER KJE
 144   (#x8E #x040B) ; CYRILLIC CAPITAL LETTER TSHE
 145   (#x8F #x040F) ; CYRILLIC CAPITAL LETTER DZHE
 146   (#x90 #x0452) ; CYRILLIC SMALL LETTER DJE
 147   (#x91 #x2018) ; LEFT SINGLE QUOTATION MARK
 148   (#x92 #x2019) ; RIGHT SINGLE QUOTATION MARK
 149   (#x93 #x201C) ; LEFT DOUBLE QUOTATION MARK
 150   (#x94 #x201D) ; RIGHT DOUBLE QUOTATION MARK
 151   (#x95 #x2022) ; BULLET
 152   (#x96 #x2013) ; EN DASH
 153   (#x97 #x2014) ; EM DASH
 154   (#x98 nil)
 155   (#x99 #x2122) ; TRADE MARK SIGN
 156   (#x9A #x0459) ; CYRILLIC SMALL LETTER LJE
 157   (#x9B #x203A) ; SINGLE RIGHT-POINTING ANGLE QUOTATION MARK
 158   (#x9C #x045A) ; CYRILLIC SMALL LETTER NJE
 159   (#x9D #x045C) ; CYRILLIC SMALL LETTER KJE
 160   (#x9E #x045B) ; CYRILLIC SMALL LETTER TSHE
 161   (#x9F #x045F) ; CYRILLIC SMALL LETTER DZHE
 162   (#xA1 #x040E) ; CYRILLIC CAPITAL LETTER SHORT U
 163   (#xA2 #x045E) ; CYRILLIC SMALL LETTER SHORT U
 164   (#xA3 #x0408) ; CYRILLIC CAPITAL LETTER JE
 165   (#xA5 #x0490) ; CYRILLIC CAPITAL LETTER GHE WITH UPTURN
 166   (#xA8 #x0401) ; CYRILLIC CAPITAL LETTER IO
 167   (#xAA #x0404) ; CYRILLIC CAPITAL LETTER UKRAINIAN IE
 168   (#xAF #x0407) ; CYRILLIC CAPITAL LETTER YI
 169   (#xB2 #x0406) ; CYRILLIC CAPITAL LETTER BYELORUSSIAN-UKRAINIAN I
 170   (#xB3 #x0456) ; CYRILLIC SMALL LETTER BYELORUSSIAN-UKRAINIAN I
 171   (#xB4 #x0491) ; CYRILLIC SMALL LETTER GHE WITH UPTURN
 172   (#xB8 #x0451) ; CYRILLIC SMALL LETTER IO
 173   (#xB9 #x2116) ; NUMERO SIGN
 174   (#xBA #x0454) ; CYRILLIC SMALL LETTER UKRAINIAN IE
 175   (#xBC #x0458) ; CYRILLIC SMALL LETTER JE
 176   (#xBD #x0405) ; CYRILLIC CAPITAL LETTER DZE
 177   (#xBE #x0455) ; CYRILLIC SMALL LETTER DZE
 178   (#xBF #x0457) ; CYRILLIC SMALL LETTER YI
 179   (#xC0 #x0410) ; CYRILLIC CAPITAL LETTER A
 180   (#xC1 #x0411) ; CYRILLIC CAPITAL LETTER BE
 181   (#xC2 #x0412) ; CYRILLIC CAPITAL LETTER VE
 182   (#xC3 #x0413) ; CYRILLIC CAPITAL LETTER GHE
 183   (#xC4 #x0414) ; CYRILLIC CAPITAL LETTER DE
 184   (#xC5 #x0415) ; CYRILLIC CAPITAL LETTER IE
 185   (#xC6 #x0416) ; CYRILLIC CAPITAL LETTER ZHE
 186   (#xC7 #x0417) ; CYRILLIC CAPITAL LETTER ZE
 187   (#xC8 #x0418) ; CYRILLIC CAPITAL LETTER I
 188   (#xC9 #x0419) ; CYRILLIC CAPITAL LETTER SHORT I
 189   (#xCA #x041A) ; CYRILLIC CAPITAL LETTER KA
 190   (#xCB #x041B) ; CYRILLIC CAPITAL LETTER EL
 191   (#xCC #x041C) ; CYRILLIC CAPITAL LETTER EM
 192   (#xCD #x041D) ; CYRILLIC CAPITAL LETTER EN
 193   (#xCE #x041E) ; CYRILLIC CAPITAL LETTER O
 194   (#xCF #x041F) ; CYRILLIC CAPITAL LETTER PE
 195   (#xD0 #x0420) ; CYRILLIC CAPITAL LETTER ER
 196   (#xD1 #x0421) ; CYRILLIC CAPITAL LETTER ES
 197   (#xD2 #x0422) ; CYRILLIC CAPITAL LETTER TE
 198   (#xD3 #x0423) ; CYRILLIC CAPITAL LETTER U
 199   (#xD4 #x0424) ; CYRILLIC CAPITAL LETTER EF
 200   (#xD5 #x0425) ; CYRILLIC CAPITAL LETTER HA
 201   (#xD6 #x0426) ; CYRILLIC CAPITAL LETTER TSE
 202   (#xD7 #x0427) ; CYRILLIC CAPITAL LETTER CHE
 203   (#xD8 #x0428) ; CYRILLIC CAPITAL LETTER SHA
 204   (#xD9 #x0429) ; CYRILLIC CAPITAL LETTER SHCHA
 205   (#xDA #x042A) ; CYRILLIC CAPITAL LETTER HARD SIGN
 206   (#xDB #x042B) ; CYRILLIC CAPITAL LETTER YERU
 207   (#xDC #x042C) ; CYRILLIC CAPITAL LETTER SOFT SIGN
 208   (#xDD #x042D) ; CYRILLIC CAPITAL LETTER E
 209   (#xDE #x042E) ; CYRILLIC CAPITAL LETTER YU
 210   (#xDF #x042F) ; CYRILLIC CAPITAL LETTER YA
 211   (#xE0 #x0430) ; CYRILLIC SMALL LETTER A
 212   (#xE1 #x0431) ; CYRILLIC SMALL LETTER BE
 213   (#xE2 #x0432) ; CYRILLIC SMALL LETTER VE
 214   (#xE3 #x0433) ; CYRILLIC SMALL LETTER GHE
 215   (#xE4 #x0434) ; CYRILLIC SMALL LETTER DE
 216   (#xE5 #x0435) ; CYRILLIC SMALL LETTER IE
 217   (#xE6 #x0436) ; CYRILLIC SMALL LETTER ZHE
 218   (#xE7 #x0437) ; CYRILLIC SMALL LETTER ZE
 219   (#xE8 #x0438) ; CYRILLIC SMALL LETTER I
 220   (#xE9 #x0439) ; CYRILLIC SMALL LETTER SHORT I
 221   (#xEA #x043A) ; CYRILLIC SMALL LETTER KA
 222   (#xEB #x043B) ; CYRILLIC SMALL LETTER EL
 223   (#xEC #x043C) ; CYRILLIC SMALL LETTER EM
 224   (#xED #x043D) ; CYRILLIC SMALL LETTER EN
 225   (#xEE #x043E) ; CYRILLIC SMALL LETTER O
 226   (#xEF #x043F) ; CYRILLIC SMALL LETTER PE
 227   (#xF0 #x0440) ; CYRILLIC SMALL LETTER ER
 228   (#xF1 #x0441) ; CYRILLIC SMALL LETTER ES
 229   (#xF2 #x0442) ; CYRILLIC SMALL LETTER TE
 230   (#xF3 #x0443) ; CYRILLIC SMALL LETTER U
 231   (#xF4 #x0444) ; CYRILLIC SMALL LETTER EF
 232   (#xF5 #x0445) ; CYRILLIC SMALL LETTER HA
 233   (#xF6 #x0446) ; CYRILLIC SMALL LETTER TSE
 234   (#xF7 #x0447) ; CYRILLIC SMALL LETTER CHE
 235   (#xF8 #x0448) ; CYRILLIC SMALL LETTER SHA
 236   (#xF9 #x0449) ; CYRILLIC SMALL LETTER SHCHA
 237   (#xFA #x044A) ; CYRILLIC SMALL LETTER HARD SIGN
 238   (#xFB #x044B) ; CYRILLIC SMALL LETTER YERU
 239   (#xFC #x044C) ; CYRILLIC SMALL LETTER SOFT SIGN
 240   (#xFD #x044D) ; CYRILLIC SMALL LETTER E
 241   (#xFE #x044E) ; CYRILLIC SMALL LETTER YU
 242   (#xFF #x044F) ; CYRILLIC SMALL LETTER YA
 243 )
 244
 245 (declaim (inline get-cp1251-bytes))
 246 (defun get-cp1251-bytes(string pos end)
 247   (declare (optimize speed (safety 0))
 248            (type simple-string string)
 249            (type array-range pos end))
 250   (get-latin-bytes #'code->cp1251-mapper :cp1251 string pos end))
 251
 252 (defun string->cp1251 (string sstart send null-padding)
 253   (declare (optimize speed (safety 0))
 254            (type simple-string string)
 255            (type array-range sstart send))
 256   (values (string->latin% string sstart send #'get-cp1251-bytes null-padding)))
 257
 258 (defmacro define-cp1251->string* (accessor type)
 259   (declare (ignore type))
 260   (let ((name (make-od-name 'cp1251->string* accessor)))
 261     `(progn
 262       (defun ,name (string sstart send array astart aend)
 263         (,(make-od-name 'latin->string* accessor) string sstart send array astart aend #'cp1251->code-mapper)))))
 264
 265 (instantiate-octets-definition define-cp1251->string*)
 266
 267 (defmacro define-cp1251->string (accessor type)
 268   (declare (ignore type))
 269   `(defun ,(make-od-name 'cp1251->string accessor) (array astart aend)
 270     (,(make-od-name 'latin->string accessor) array astart aend #'cp1251->code-mapper)))
 271
 272 (instantiate-octets-definition define-cp1251->string)
 273
 274 (push '((:cp1251 :|cp1251|  :windows-1251 :|windows-1251|)
 275         cp1251->string-aref string->cp1251)
 276       *external-format-functions*)
 277
 278 (define-external-format (:cp1251 :|cp1251| :windows-1251 :|windows-1251|)
 279     1 t
 280     (let ((cp1251-byte (code->cp1251-mapper bits)))
 281       (if cp1251-byte
 282           (setf (sap-ref-8 sap tail) cp1251-byte)
 283           (stream-encoding-error-and-handle stream bits)))
 284     (let ((code (cp1251->code-mapper byte)))
 285       (if code
 286           (code-char code)
 287           (stream-decoding-error stream byte)))) ;; TODO -- error check
 288
 289 (define-unibyte-mapper cp1252->code-mapper code->cp1252-mapper
 290   (#x80 #x20AC) ; EURO SIGN
 291   (#x81 nil)
 292   (#x82 #x201A) ; SINGLE LOW-9 QUOTATION MARK
 293   (#x83 #x0192) ; LATIN SMALL LETTER F WITH HOOK
 294   (#x84 #x201E) ; DOUBLE LOW-9 QUOTATION MARK
 295   (#x85 #x2026) ; HORIZONTAL ELLIPSIS
 296   (#x86 #x2020) ; DAGGER
 297   (#x87 #x2021) ; DOUBLE DAGGER
 298   (#x88 #x02C6) ; MODIFIER LETTER CIRCUMFLEX ACCENT
 299   (#x89 #x2030) ; PER MILLE SIGN
 300   (#x8A #x0160) ; LATIN CAPITAL LETTER S WITH CARON
 301   (#x8B #x2039) ; SINGLE LEFT-POINTING ANGLE QUOTATION MARK
 302   (#x8C #x0152) ; LATIN CAPITAL LIGATURE OE
 303   (#x8D nil)
 304   (#x8E #x017D) ; LATIN CAPITAL LETTER Z WITH CARON
 305   (#x8F nil)
 306   (#x90 nil)
 307   (#x91 #x2018) ; LEFT SINGLE QUOTATION MARK
 308   (#x92 #x2019) ; RIGHT SINGLE QUOTATION MARK
 309   (#x93 #x201C) ; LEFT DOUBLE QUOTATION MARK
 310   (#x94 #x201D) ; RIGHT DOUBLE QUOTATION MARK
 311   (#x95 #x2022) ; BULLET
 312   (#x96 #x2013) ; EN DASH
 313   (#x97 #x2014) ; EM DASH
 314   (#x98 #x02DC) ; SMALL TILDE
 315   (#x99 #x2122) ; TRADE MARK SIGN
 316   (#x9A #x0161) ; LATIN SMALL LETTER S WITH CARON
 317   (#x9B #x203A) ; SINGLE RIGHT-POINTING ANGLE QUOTATION MARK
 318   (#x9C #x0153) ; LATIN SMALL LIGATURE OE
 319   (#x9D nil)
 320   (#x9E #x017E) ; LATIN SMALL LETTER Z WITH CARON
 321   (#x9F #x0178) ; LATIN CAPITAL LETTER Y WITH DIAERESIS
 322 )
 323
 324 (declaim (inline get-cp1252-bytes))
 325 (defun get-cp1252-bytes(string pos end)
 326   (declare (optimize speed (safety 0))
 327            (type simple-string string)
 328            (type array-range pos end))
 329   (get-latin-bytes #'code->cp1252-mapper :cp1252 string pos end))
 330
 331 (defun string->cp1252 (string sstart send null-padding)
 332   (declare (optimize speed (safety 0))
 333            (type simple-string string)
 334            (type array-range sstart send))
 335   (values (string->latin% string sstart send #'get-cp1252-bytes null-padding)))
 336
 337 (defmacro define-cp1252->string* (accessor type)
 338   (declare (ignore type))
 339   (let ((name (make-od-name 'cp1252->string* accessor)))
 340     `(progn
 341       (defun ,name (string sstart send array astart aend)
 342         (,(make-od-name 'latin->string* accessor) string sstart send array astart aend #'cp1252->code-mapper)))))
 343
 344 (instantiate-octets-definition define-cp1252->string*)
 345
 346 (defmacro define-cp1252->string (accessor type)
 347   (declare (ignore type))
 348   `(defun ,(make-od-name 'cp1252->string accessor) (array astart aend)
 349     (,(make-od-name 'latin->string accessor) array astart aend #'cp1252->code-mapper)))
 350
 351 (instantiate-octets-definition define-cp1252->string)
 352
 353 (push '((:cp1252 :|cp1252| :windows-1252 :|windows-1252|)
 354         cp1252->string-aref string->cp1252)
 355       *external-format-functions*)
 356
 357 (define-external-format (:cp1252 :|cp1252| :windows-1252 :|windows-1252|)
 358     1 t
 359     (let ((cp1252-byte (code->cp1252-mapper bits)))
 360       (if cp1252-byte
 361           (setf (sap-ref-8 sap tail) cp1252-byte)
 362           (stream-encoding-error-and-handle stream bits)))
 363     (let ((code (cp1252->code-mapper byte)))
 364       (if code
 365           (code-char code)
 366           (stream-decoding-error stream byte)))) ;; TODO -- error check
 367
 368 (define-unibyte-mapper cp1253->code-mapper code->cp1253-mapper
 369   (#x80 #x20AC) ; EURO SIGN
 370   (#x81 nil)
 371   (#x82 #x201A) ; SINGLE LOW-9 QUOTATION MARK
 372   (#x83 #x0192) ; LATIN SMALL LETTER F WITH HOOK
 373   (#x84 #x201E) ; DOUBLE LOW-9 QUOTATION MARK
 374   (#x85 #x2026) ; HORIZONTAL ELLIPSIS
 375   (#x86 #x2020) ; DAGGER
 376   (#x87 #x2021) ; DOUBLE DAGGER
 377   (#x88 nil)
 378   (#x89 #x2030) ; PER MILLE SIGN
 379   (#x8A nil)
 380   (#x8B #x2039) ; SINGLE LEFT-POINTING ANGLE QUOTATION MARK
 381   (#x8C nil)
 382   (#x8D nil)
 383   (#x8E nil)
 384   (#x8F nil)
 385   (#x90 nil)
 386   (#x91 #x2018) ; LEFT SINGLE QUOTATION MARK
 387   (#x92 #x2019) ; RIGHT SINGLE QUOTATION MARK
 388   (#x93 #x201C) ; LEFT DOUBLE QUOTATION MARK
 389   (#x94 #x201D) ; RIGHT DOUBLE QUOTATION MARK
 390   (#x95 #x2022) ; BULLET
 391   (#x96 #x2013) ; EN DASH
 392   (#x97 #x2014) ; EM DASH
 393   (#x98 nil)
 394   (#x99 #x2122) ; TRADE MARK SIGN
 395   (#x9A nil)
 396   (#x9B #x203A) ; SINGLE RIGHT-POINTING ANGLE QUOTATION MARK
 397   (#x9C nil)
 398   (#x9D nil)
 399   (#x9E nil)
 400   (#x9F nil)
 401   (#xA1 #x0385) ; GREEK DIALYTIKA TONOS
 402   (#xA2 #x0386) ; GREEK CAPITAL LETTER ALPHA WITH TONOS
 403   (#xAA nil)
 404   (#xAF #x2015) ; HORIZONTAL BAR
 405   (#xB4 #x0384) ; GREEK TONOS
 406   (#xB8 #x0388) ; GREEK CAPITAL LETTER EPSILON WITH TONOS
 407   (#xB9 #x0389) ; GREEK CAPITAL LETTER ETA WITH TONOS
 408   (#xBA #x038A) ; GREEK CAPITAL LETTER IOTA WITH TONOS
 409   (#xBC #x038C) ; GREEK CAPITAL LETTER OMICRON WITH TONOS
 410   (#xBE #x038E) ; GREEK CAPITAL LETTER UPSILON WITH TONOS
 411   (#xBF #x038F) ; GREEK CAPITAL LETTER OMEGA WITH TONOS
 412   (#xC0 #x0390) ; GREEK SMALL LETTER IOTA WITH DIALYTIKA AND TONOS
 413   (#xC1 #x0391) ; GREEK CAPITAL LETTER ALPHA
 414   (#xC2 #x0392) ; GREEK CAPITAL LETTER BETA
 415   (#xC3 #x0393) ; GREEK CAPITAL LETTER GAMMA
 416   (#xC4 #x0394) ; GREEK CAPITAL LETTER DELTA
 417   (#xC5 #x0395) ; GREEK CAPITAL LETTER EPSILON
 418   (#xC6 #x0396) ; GREEK CAPITAL LETTER ZETA
 419   (#xC7 #x0397) ; GREEK CAPITAL LETTER ETA
 420   (#xC8 #x0398) ; GREEK CAPITAL LETTER THETA
 421   (#xC9 #x0399) ; GREEK CAPITAL LETTER IOTA
 422   (#xCA #x039A) ; GREEK CAPITAL LETTER KAPPA
 423   (#xCB #x039B) ; GREEK CAPITAL LETTER LAMDA
 424   (#xCC #x039C) ; GREEK CAPITAL LETTER MU
 425   (#xCD #x039D) ; GREEK CAPITAL LETTER NU
 426   (#xCE #x039E) ; GREEK CAPITAL LETTER XI
 427   (#xCF #x039F) ; GREEK CAPITAL LETTER OMICRON
 428   (#xD0 #x03A0) ; GREEK CAPITAL LETTER PI
 429   (#xD1 #x03A1) ; GREEK CAPITAL LETTER RHO
 430   (#xD2 nil)
 431   (#xD3 #x03A3) ; GREEK CAPITAL LETTER SIGMA
 432   (#xD4 #x03A4) ; GREEK CAPITAL LETTER TAU
 433   (#xD5 #x03A5) ; GREEK CAPITAL LETTER UPSILON
 434   (#xD6 #x03A6) ; GREEK CAPITAL LETTER PHI
 435   (#xD7 #x03A7) ; GREEK CAPITAL LETTER CHI
 436   (#xD8 #x03A8) ; GREEK CAPITAL LETTER PSI
 437   (#xD9 #x03A9) ; GREEK CAPITAL LETTER OMEGA
 438   (#xDA #x03AA) ; GREEK CAPITAL LETTER IOTA WITH DIALYTIKA
 439   (#xDB #x03AB) ; GREEK CAPITAL LETTER UPSILON WITH DIALYTIKA
 440   (#xDC #x03AC) ; GREEK SMALL LETTER ALPHA WITH TONOS
 441   (#xDD #x03AD) ; GREEK SMALL LETTER EPSILON WITH TONOS
 442   (#xDE #x03AE) ; GREEK SMALL LETTER ETA WITH TONOS
 443   (#xDF #x03AF) ; GREEK SMALL LETTER IOTA WITH TONOS
 444   (#xE0 #x03B0) ; GREEK SMALL LETTER UPSILON WITH DIALYTIKA AND TONOS
 445   (#xE1 #x03B1) ; GREEK SMALL LETTER ALPHA
 446   (#xE2 #x03B2) ; GREEK SMALL LETTER BETA
 447   (#xE3 #x03B3) ; GREEK SMALL LETTER GAMMA
 448   (#xE4 #x03B4) ; GREEK SMALL LETTER DELTA
 449   (#xE5 #x03B5) ; GREEK SMALL LETTER EPSILON
 450   (#xE6 #x03B6) ; GREEK SMALL LETTER ZETA
 451   (#xE7 #x03B7) ; GREEK SMALL LETTER ETA
 452   (#xE8 #x03B8) ; GREEK SMALL LETTER THETA
 453   (#xE9 #x03B9) ; GREEK SMALL LETTER IOTA
 454   (#xEA #x03BA) ; GREEK SMALL LETTER KAPPA
 455   (#xEB #x03BB) ; GREEK SMALL LETTER LAMDA
 456   (#xEC #x03BC) ; GREEK SMALL LETTER MU
 457   (#xED #x03BD) ; GREEK SMALL LETTER NU
 458   (#xEE #x03BE) ; GREEK SMALL LETTER XI
 459   (#xEF #x03BF) ; GREEK SMALL LETTER OMICRON
 460   (#xF0 #x03C0) ; GREEK SMALL LETTER PI
 461   (#xF1 #x03C1) ; GREEK SMALL LETTER RHO
 462   (#xF2 #x03C2) ; GREEK SMALL LETTER FINAL SIGMA
 463   (#xF3 #x03C3) ; GREEK SMALL LETTER SIGMA
 464   (#xF4 #x03C4) ; GREEK SMALL LETTER TAU
 465   (#xF5 #x03C5) ; GREEK SMALL LETTER UPSILON
 466   (#xF6 #x03C6) ; GREEK SMALL LETTER PHI
 467   (#xF7 #x03C7) ; GREEK SMALL LETTER CHI
 468   (#xF8 #x03C8) ; GREEK SMALL LETTER PSI
 469   (#xF9 #x03C9) ; GREEK SMALL LETTER OMEGA
 470   (#xFA #x03CA) ; GREEK SMALL LETTER IOTA WITH DIALYTIKA
 471   (#xFB #x03CB) ; GREEK SMALL LETTER UPSILON WITH DIALYTIKA
 472   (#xFC #x03CC) ; GREEK SMALL LETTER OMICRON WITH TONOS
 473   (#xFD #x03CD) ; GREEK SMALL LETTER UPSILON WITH TONOS
 474   (#xFE #x03CE) ; GREEK SMALL LETTER OMEGA WITH TONOS
 475   (#xFF nil)
 476 )
 477
 478 (declaim (inline get-cp1253-bytes))
 479 (defun get-cp1253-bytes(string pos end)
 480   (declare (optimize speed (safety 0))
 481            (type simple-string string)
 482            (type array-range pos end))
 483   (get-latin-bytes #'code->cp1253-mapper :cp1253 string pos end))
 484
 485 (defun string->cp1253 (string sstart send null-padding)
 486   (declare (optimize speed (safety 0))
 487            (type simple-string string)
 488            (type array-range sstart send))
 489   (values (string->latin% string sstart send #'get-cp1253-bytes null-padding)))
 490
 491 (defmacro define-cp1253->string* (accessor type)
 492   (declare (ignore type))
 493   (let ((name (make-od-name 'cp1253->string* accessor)))
 494     `(progn
 495       (defun ,name (string sstart send array astart aend)
 496         (,(make-od-name 'latin->string* accessor) string sstart send array astart aend #'cp1253->code-mapper)))))
 497
 498 (instantiate-octets-definition define-cp1253->string*)
 499
 500 (defmacro define-cp1253->string (accessor type)
 501   (declare (ignore type))
 502   `(defun ,(make-od-name 'cp1253->string accessor) (array astart aend)
 503     (,(make-od-name 'latin->string accessor) array astart aend #'cp1253->code-mapper)))
 504
 505 (instantiate-octets-definition define-cp1253->string)
 506
 507 (push '((:cp1253 :|cp1253| :windows-1253 :|windows-1253|)
 508         cp1253->string-aref string->cp1253)
 509       *external-format-functions*)
 510
 511 (define-external-format (:cp1253 :|cp1253| :windows-1253 :|windows-1253|)
 512     1 t
 513     (let ((cp1253-byte (code->cp1253-mapper bits)))
 514       (if cp1253-byte
 515           (setf (sap-ref-8 sap tail) cp1253-byte)
 516           (stream-encoding-error-and-handle stream bits)))
 517     (let ((code (cp1253->code-mapper byte)))
 518       (if code
 519           (code-char code)
 520           (stream-decoding-error stream byte)))) ;; TODO -- error check
 521
 522 (define-unibyte-mapper cp1254->code-mapper code->cp1254-mapper
 523   (#x80 #x20AC) ; EURO SIGN
 524   (#x81 nil)
 525   (#x82 #x201A) ; SINGLE LOW-9 QUOTATION MARK
 526   (#x83 #x0192) ; LATIN SMALL LETTER F WITH HOOK
 527   (#x84 #x201E) ; DOUBLE LOW-9 QUOTATION MARK
 528   (#x85 #x2026) ; HORIZONTAL ELLIPSIS
 529   (#x86 #x2020) ; DAGGER
 530   (#x87 #x2021) ; DOUBLE DAGGER
 531   (#x88 #x02C6) ; MODIFIER LETTER CIRCUMFLEX ACCENT
 532   (#x89 #x2030) ; PER MILLE SIGN
 533   (#x8A #x0160) ; LATIN CAPITAL LETTER S WITH CARON
 534   (#x8B #x2039) ; SINGLE LEFT-POINTING ANGLE QUOTATION MARK
 535   (#x8C #x0152) ; LATIN CAPITAL LIGATURE OE
 536   (#x8D nil)
 537   (#x8E nil)
 538   (#x8F nil)
 539   (#x90 nil)
 540   (#x91 #x2018) ; LEFT SINGLE QUOTATION MARK
 541   (#x92 #x2019) ; RIGHT SINGLE QUOTATION MARK
 542   (#x93 #x201C) ; LEFT DOUBLE QUOTATION MARK
 543   (#x94 #x201D) ; RIGHT DOUBLE QUOTATION MARK
 544   (#x95 #x2022) ; BULLET
 545   (#x96 #x2013) ; EN DASH
 546   (#x97 #x2014) ; EM DASH
 547   (#x98 #x02DC) ; SMALL TILDE
 548   (#x99 #x2122) ; TRADE MARK SIGN
 549   (#x9A #x0161) ; LATIN SMALL LETTER S WITH CARON
 550   (#x9B #x203A) ; SINGLE RIGHT-POINTING ANGLE QUOTATION MARK
 551   (#x9C #x0153) ; LATIN SMALL LIGATURE OE
 552   (#x9D nil)
 553   (#x9E nil)
 554   (#x9F #x0178) ; LATIN CAPITAL LETTER Y WITH DIAERESIS
 555   (#xD0 #x011E) ; LATIN CAPITAL LETTER G WITH BREVE
 556   (#xDD #x0130) ; LATIN CAPITAL LETTER I WITH DOT ABOVE
 557   (#xDE #x015E) ; LATIN CAPITAL LETTER S WITH CEDILLA
 558   (#xF0 #x011F) ; LATIN SMALL LETTER G WITH BREVE
 559   (#xFD #x0131) ; LATIN SMALL LETTER DOTLESS I
 560   (#xFE #x015F) ; LATIN SMALL LETTER S WITH CEDILLA
 561 )
 562
 563 (declaim (inline get-cp1254-bytes))
 564 (defun get-cp1254-bytes(string pos end)
 565   (declare (optimize speed (safety 0))
 566            (type simple-string string)
 567            (type array-range pos end))
 568   (get-latin-bytes #'code->cp1254-mapper :cp1254 string pos end))
 569
 570 (defun string->cp1254 (string sstart send null-padding)
 571   (declare (optimize speed (safety 0))
 572            (type simple-string string)
 573            (type array-range sstart send))
 574   (values (string->latin% string sstart send #'get-cp1254-bytes null-padding)))
 575
 576 (defmacro define-cp1254->string* (accessor type)
 577   (declare (ignore type))
 578   (let ((name (make-od-name 'cp1254->string* accessor)))
 579     `(progn
 580       (defun ,name (string sstart send array astart aend)
 581         (,(make-od-name 'latin->string* accessor) string sstart send array astart aend #'cp1254->code-mapper)))))
 582
 583 (instantiate-octets-definition define-cp1254->string*)
 584
 585 (defmacro define-cp1254->string (accessor type)
 586   (declare (ignore type))
 587   `(defun ,(make-od-name 'cp1254->string accessor) (array astart aend)
 588     (,(make-od-name 'latin->string accessor) array astart aend #'cp1254->code-mapper)))
 589
 590 (instantiate-octets-definition define-cp1254->string)
 591
 592 (push '((:cp1254 :|cp1254| :windows-1254 :|windows-1254|)
 593         cp1254->string-aref string->cp1254)
 594       *external-format-functions*)
 595
 596 (define-external-format (:cp1254 :|cp1254|)
 597     1 t
 598     (let ((cp1254-byte (code->cp1254-mapper bits)))
 599       (if cp1254-byte
 600           (setf (sap-ref-8 sap tail) cp1254-byte)
 601           (stream-encoding-error-and-handle stream bits)))
 602     (let ((code (cp1254->code-mapper byte)))
 603       (if code
 604           (code-char code)
 605           (stream-decoding-error stream byte)))) ;; TODO -- error check
 606
 607 (define-unibyte-mapper cp1255->code-mapper code->cp1255-mapper
 608   (#x80 #x20AC) ; EURO SIGN
 609   (#x81 nil)
 610   (#x82 #x201A) ; SINGLE LOW-9 QUOTATION MARK
 611   (#x83 #x0192) ; LATIN SMALL LETTER F WITH HOOK
 612   (#x84 #x201E) ; DOUBLE LOW-9 QUOTATION MARK
 613   (#x85 #x2026) ; HORIZONTAL ELLIPSIS
 614   (#x86 #x2020) ; DAGGER
 615   (#x87 #x2021) ; DOUBLE DAGGER
 616   (#x88 #x02C6) ; MODIFIER LETTER CIRCUMFLEX ACCENT
 617   (#x89 #x2030) ; PER MILLE SIGN
 618   (#x8A nil)
 619   (#x8B #x2039) ; SINGLE LEFT-POINTING ANGLE QUOTATION MARK
 620   (#x8C nil)
 621   (#x8D nil)
 622   (#x8E nil)
 623   (#x8F nil)
 624   (#x90 nil)
 625   (#x91 #x2018) ; LEFT SINGLE QUOTATION MARK
 626   (#x92 #x2019) ; RIGHT SINGLE QUOTATION MARK
 627   (#x93 #x201C) ; LEFT DOUBLE QUOTATION MARK
 628   (#x94 #x201D) ; RIGHT DOUBLE QUOTATION MARK
 629   (#x95 #x2022) ; BULLET
 630   (#x96 #x2013) ; EN DASH
 631   (#x97 #x2014) ; EM DASH
 632   (#x98 #x02DC) ; SMALL TILDE
 633   (#x99 #x2122) ; TRADE MARK SIGN
 634   (#x9A nil)
 635   (#x9B #x203A) ; SINGLE RIGHT-POINTING ANGLE QUOTATION MARK
 636   (#x9C nil)
 637   (#x9D nil)
 638   (#x9E nil)
 639   (#x9F nil)
 640   (#xA4 #x20AA) ; NEW SHEQEL SIGN
 641   (#xAA #x00D7) ; MULTIPLICATION SIGN
 642   (#xBA #x00F7) ; DIVISION SIGN
 643   (#xC0 #x05B0) ; HEBREW POINT SHEVA
 644   (#xC1 #x05B1) ; HEBREW POINT HATAF SEGOL
 645   (#xC2 #x05B2) ; HEBREW POINT HATAF PATAH
 646   (#xC3 #x05B3) ; HEBREW POINT HATAF QAMATS
 647   (#xC4 #x05B4) ; HEBREW POINT HIRIQ
 648   (#xC5 #x05B5) ; HEBREW POINT TSERE
 649   (#xC6 #x05B6) ; HEBREW POINT SEGOL
 650   (#xC7 #x05B7) ; HEBREW POINT PATAH
 651   (#xC8 #x05B8) ; HEBREW POINT QAMATS
 652   (#xC9 #x05B9) ; HEBREW POINT HOLAM
 653   (#xCA nil)
 654   (#xCB #x05BB) ; HEBREW POINT QUBUTS
 655   (#xCC #x05BC) ; HEBREW POINT DAGESH OR MAPIQ
 656   (#xCD #x05BD) ; HEBREW POINT METEG
 657   (#xCE #x05BE) ; HEBREW PUNCTUATION MAQAF
 658   (#xCF #x05BF) ; HEBREW POINT RAFE
 659   (#xD0 #x05C0) ; HEBREW PUNCTUATION PASEQ
 660   (#xD1 #x05C1) ; HEBREW POINT SHIN DOT
 661   (#xD2 #x05C2) ; HEBREW POINT SIN DOT
 662   (#xD3 #x05C3) ; HEBREW PUNCTUATION SOF PASUQ
 663   (#xD4 #x05F0) ; HEBREW LIGATURE YIDDISH DOUBLE VAV
 664   (#xD5 #x05F1) ; HEBREW LIGATURE YIDDISH VAV YOD
 665   (#xD6 #x05F2) ; HEBREW LIGATURE YIDDISH DOUBLE YOD
 666   (#xD7 #x05F3) ; HEBREW PUNCTUATION GERESH
 667   (#xD8 #x05F4) ; HEBREW PUNCTUATION GERSHAYIM
 668   (#xD9 nil)
 669   (#xDA nil)
 670   (#xDB nil)
 671   (#xDC nil)
 672   (#xDD nil)
 673   (#xDE nil)
 674   (#xDF nil)
 675   (#xE0 #x05D0) ; HEBREW LETTER ALEF
 676   (#xE1 #x05D1) ; HEBREW LETTER BET
 677   (#xE2 #x05D2) ; HEBREW LETTER GIMEL
 678   (#xE3 #x05D3) ; HEBREW LETTER DALET
 679   (#xE4 #x05D4) ; HEBREW LETTER HE
 680   (#xE5 #x05D5) ; HEBREW LETTER VAV
 681   (#xE6 #x05D6) ; HEBREW LETTER ZAYIN
 682   (#xE7 #x05D7) ; HEBREW LETTER HET
 683   (#xE8 #x05D8) ; HEBREW LETTER TET
 684   (#xE9 #x05D9) ; HEBREW LETTER YOD
 685   (#xEA #x05DA) ; HEBREW LETTER FINAL KAF
 686   (#xEB #x05DB) ; HEBREW LETTER KAF
 687   (#xEC #x05DC) ; HEBREW LETTER LAMED
 688   (#xED #x05DD) ; HEBREW LETTER FINAL MEM
 689   (#xEE #x05DE) ; HEBREW LETTER MEM
 690   (#xEF #x05DF) ; HEBREW LETTER FINAL NUN
 691   (#xF0 #x05E0) ; HEBREW LETTER NUN
 692   (#xF1 #x05E1) ; HEBREW LETTER SAMEKH
 693   (#xF2 #x05E2) ; HEBREW LETTER AYIN
 694   (#xF3 #x05E3) ; HEBREW LETTER FINAL PE
 695   (#xF4 #x05E4) ; HEBREW LETTER PE
 696   (#xF5 #x05E5) ; HEBREW LETTER FINAL TSADI
 697   (#xF6 #x05E6) ; HEBREW LETTER TSADI
 698   (#xF7 #x05E7) ; HEBREW LETTER QOF
 699   (#xF8 #x05E8) ; HEBREW LETTER RESH
 700   (#xF9 #x05E9) ; HEBREW LETTER SHIN
 701   (#xFA #x05EA) ; HEBREW LETTER TAV
 702   (#xFB nil)
 703   (#xFC nil)
 704   (#xFD #x200E) ; LEFT-TO-RIGHT MARK
 705   (#xFE #x200F) ; RIGHT-TO-LEFT MARK
 706   (#xFF nil)
 707 )
 708
 709 (declaim (inline get-cp1255-bytes))
 710 (defun get-cp1255-bytes(string pos end)
 711   (declare (optimize speed (safety 0))
 712            (type simple-string string)
 713            (type array-range pos end))
 714   (get-latin-bytes #'code->cp1255-mapper :cp1255 string pos end))
 715
 716 (defun string->cp1255 (string sstart send null-padding)
 717   (declare (optimize speed (safety 0))
 718            (type simple-string string)
 719            (type array-range sstart send))
 720   (values (string->latin% string sstart send #'get-cp1255-bytes null-padding)))
 721
 722 (defmacro define-cp1255->string* (accessor type)
 723   (declare (ignore type))
 724   (let ((name (make-od-name 'cp1255->string* accessor)))
 725     `(progn
 726       (defun ,name (string sstart send array astart aend)
 727         (,(make-od-name 'latin->string* accessor) string sstart send array astart aend #'cp1255->code-mapper)))))
 728
 729 (instantiate-octets-definition define-cp1255->string*)
 730
 731 (defmacro define-cp1255->string (accessor type)
 732   (declare (ignore type))
 733   `(defun ,(make-od-name 'cp1255->string accessor) (array astart aend)
 734     (,(make-od-name 'latin->string accessor) array astart aend #'cp1255->code-mapper)))
 735
 736 (instantiate-octets-definition define-cp1255->string)
 737
 738 (push '((:cp1255 :|cp1255| :windows-1255 :|windows-1255|)
 739         cp1255->string-aref string->cp1255)
 740       *external-format-functions*)
 741
 742 (define-external-format (:cp1255 :|cp1255| :windows-1255 :|windows-1255|)
 743     1 t
 744     (let ((cp1255-byte (code->cp1255-mapper bits)))
 745       (if cp1255-byte
 746           (setf (sap-ref-8 sap tail) cp1255-byte)
 747           (stream-encoding-error-and-handle stream bits)))
 748     (let ((code (cp1255->code-mapper byte)))
 749       (if code
 750           (code-char code)
 751           (stream-decoding-error stream byte)))) ;; TODO -- error check
 752
 753 (define-unibyte-mapper cp1256->code-mapper code->cp1256-mapper
 754   (#x80 #x20AC) ; EURO SIGN
 755   (#x81 #x067E) ; ARABIC LETTER PEH
 756   (#x82 #x201A) ; SINGLE LOW-9 QUOTATION MARK
 757   (#x83 #x0192) ; LATIN SMALL LETTER F WITH HOOK
 758   (#x84 #x201E) ; DOUBLE LOW-9 QUOTATION MARK
 759   (#x85 #x2026) ; HORIZONTAL ELLIPSIS
 760   (#x86 #x2020) ; DAGGER
 761   (#x87 #x2021) ; DOUBLE DAGGER
 762   (#x88 #x02C6) ; MODIFIER LETTER CIRCUMFLEX ACCENT
 763   (#x89 #x2030) ; PER MILLE SIGN
 764   (#x8A nil)
 765   (#x8B #x2039) ; SINGLE LEFT-POINTING ANGLE QUOTATION MARK
 766   (#x8C #x0152) ; LATIN CAPITAL LIGATURE OE
 767   (#x8D #x0686) ; ARABIC LETTER TCHEH
 768   (#x8E #x0698) ; ARABIC LETTER JEH
 769   (#x8F nil)
 770   (#x90 #x06AF) ; ARABIC LETTER GAF
 771   (#x91 #x2018) ; LEFT SINGLE QUOTATION MARK
 772   (#x92 #x2019) ; RIGHT SINGLE QUOTATION MARK
 773   (#x93 #x201C) ; LEFT DOUBLE QUOTATION MARK
 774   (#x94 #x201D) ; RIGHT DOUBLE QUOTATION MARK
 775   (#x95 #x2022) ; BULLET
 776   (#x96 #x2013) ; EN DASH
 777   (#x97 #x2014) ; EM DASH
 778   (#x98 nil)
 779   (#x99 #x2122) ; TRADE MARK SIGN
 780   (#x9A nil)
 781   (#x9B #x203A) ; SINGLE RIGHT-POINTING ANGLE QUOTATION MARK
 782   (#x9C #x0153) ; LATIN SMALL LIGATURE OE
 783   (#x9D #x200C) ; ZERO WIDTH NON-JOINER
 784   (#x9E #x200D) ; ZERO WIDTH JOINER
 785   (#x9F nil)
 786   (#xA1 #x060C) ; ARABIC COMMA
 787   (#xAA nil)
 788   (#xBA #x061B) ; ARABIC SEMICOLON
 789   (#xBF #x061F) ; ARABIC QUESTION MARK
 790   (#xC0 nil)
 791   (#xC1 #x0621) ; ARABIC LETTER HAMZA
 792   (#xC2 #x0622) ; ARABIC LETTER ALEF WITH MADDA ABOVE
 793   (#xC3 #x0623) ; ARABIC LETTER ALEF WITH HAMZA ABOVE
 794   (#xC4 #x0624) ; ARABIC LETTER WAW WITH HAMZA ABOVE
 795   (#xC5 #x0625) ; ARABIC LETTER ALEF WITH HAMZA BELOW
 796   (#xC6 #x0626) ; ARABIC LETTER YEH WITH HAMZA ABOVE
 797   (#xC7 #x0627) ; ARABIC LETTER ALEF
 798   (#xC8 #x0628) ; ARABIC LETTER BEH
 799   (#xC9 #x0629) ; ARABIC LETTER TEH MARBUTA
 800   (#xCA #x062A) ; ARABIC LETTER TEH
 801   (#xCB #x062B) ; ARABIC LETTER THEH
 802   (#xCC #x062C) ; ARABIC LETTER JEEM
 803   (#xCD #x062D) ; ARABIC LETTER HAH
 804   (#xCE #x062E) ; ARABIC LETTER KHAH
 805   (#xCF #x062F) ; ARABIC LETTER DAL
 806   (#xD0 #x0630) ; ARABIC LETTER THAL
 807   (#xD1 #x0631) ; ARABIC LETTER REH
 808   (#xD2 #x0632) ; ARABIC LETTER ZAIN
 809   (#xD3 #x0633) ; ARABIC LETTER SEEN
 810   (#xD4 #x0634) ; ARABIC LETTER SHEEN
 811   (#xD5 #x0635) ; ARABIC LETTER SAD
 812   (#xD6 #x0636) ; ARABIC LETTER DAD
 813   (#xD8 #x0637) ; ARABIC LETTER TAH
 814   (#xD9 #x0638) ; ARABIC LETTER ZAH
 815   (#xDA #x0639) ; ARABIC LETTER AIN
 816   (#xDB #x063A) ; ARABIC LETTER GHAIN
 817   (#xDC #x0640) ; ARABIC TATWEEL
 818   (#xDD #x0641) ; ARABIC LETTER FEH
 819   (#xDE #x0642) ; ARABIC LETTER QAF
 820   (#xDF #x0643) ; ARABIC LETTER KAF
 821   (#xE1 #x0644) ; ARABIC LETTER LAM
 822   (#xE3 #x0645) ; ARABIC LETTER MEEM
 823   (#xE4 #x0646) ; ARABIC LETTER NOON
 824   (#xE5 #x0647) ; ARABIC LETTER HEH
 825   (#xE6 #x0648) ; ARABIC LETTER WAW
 826   (#xEC #x0649) ; ARABIC LETTER ALEF MAKSURA
 827   (#xED #x064A) ; ARABIC LETTER YEH
 828   (#xF0 #x064B) ; ARABIC FATHATAN
 829   (#xF1 #x064C) ; ARABIC DAMMATAN
 830   (#xF2 #x064D) ; ARABIC KASRATAN
 831   (#xF3 #x064E) ; ARABIC FATHA
 832   (#xF5 #x064F) ; ARABIC DAMMA
 833   (#xF6 #x0650) ; ARABIC KASRA
 834   (#xF8 #x0651) ; ARABIC SHADDA
 835   (#xFA #x0652) ; ARABIC SUKUN
 836   (#xFD #x200E) ; LEFT-TO-RIGHT MARK
 837   (#xFE #x200F) ; RIGHT-TO-LEFT MARK
 838   (#xFF nil)
 839 )
 840
 841 (declaim (inline get-cp1256-bytes))
 842 (defun get-cp1256-bytes(string pos end)
 843   (declare (optimize speed (safety 0))
 844            (type simple-string string)
 845            (type array-range pos end))
 846   (get-latin-bytes #'code->cp1256-mapper :cp1256 string pos end))
 847
 848 (defun string->cp1256 (string sstart send null-padding)
 849   (declare (optimize speed (safety 0))
 850            (type simple-string string)
 851            (type array-range sstart send))
 852   (values (string->latin% string sstart send #'get-cp1256-bytes null-padding)))
 853
 854 (defmacro define-cp1256->string* (accessor type)
 855   (declare (ignore type))
 856   (let ((name (make-od-name 'cp1256->string* accessor)))
 857     `(progn
 858       (defun ,name (string sstart send array astart aend)
 859         (,(make-od-name 'latin->string* accessor) string sstart send array astart aend #'cp1256->code-mapper)))))
 860
 861 (instantiate-octets-definition define-cp1256->string*)
 862
 863 (defmacro define-cp1256->string (accessor type)
 864   (declare (ignore type))
 865   `(defun ,(make-od-name 'cp1256->string accessor) (array astart aend)
 866     (,(make-od-name 'latin->string accessor) array astart aend #'cp1256->code-mapper)))
 867
 868 (instantiate-octets-definition define-cp1256->string)
 869
 870 (push '((:cp1256 :|cp1256| :windows-1256 :|windows-1256|)
 871         cp1256->string-aref string->cp1256)
 872       *external-format-functions*)
 873
 874 (define-external-format (:cp1256 :|cp1256|)
 875     1 t
 876     (let ((cp1256-byte (code->cp1256-mapper bits)))
 877       (if cp1256-byte
 878           (setf (sap-ref-8 sap tail) cp1256-byte)
 879           (stream-encoding-error-and-handle stream bits)))
 880     (let ((code (cp1256->code-mapper byte)))
 881       (if code
 882           (code-char code)
 883           (stream-decoding-error stream byte)))) ;; TODO -- error check
 884
 885 (define-unibyte-mapper cp1257->code-mapper code->cp1257-mapper
 886   (#x80 #x20AC) ; EURO SIGN
 887   (#x81 nil)
 888   (#x82 #x201A) ; SINGLE LOW-9 QUOTATION MARK
 889   (#x83 nil)
 890   (#x84 #x201E) ; DOUBLE LOW-9 QUOTATION MARK
 891   (#x85 #x2026) ; HORIZONTAL ELLIPSIS
 892   (#x86 #x2020) ; DAGGER
 893   (#x87 #x2021) ; DOUBLE DAGGER
 894   (#x88 nil)
 895   (#x89 #x2030) ; PER MILLE SIGN
 896   (#x8A nil)
 897   (#x8B #x2039) ; SINGLE LEFT-POINTING ANGLE QUOTATION MARK
 898   (#x8C nil)
 899   (#x8D #x00A8) ; DIAERESIS
 900   (#x8E #x02C7) ; CARON
 901   (#x8F #x00B8) ; CEDILLA
 902   (#x90 nil)
 903   (#x91 #x2018) ; LEFT SINGLE QUOTATION MARK
 904   (#x92 #x2019) ; RIGHT SINGLE QUOTATION MARK
 905   (#x93 #x201C) ; LEFT DOUBLE QUOTATION MARK
 906   (#x94 #x201D) ; RIGHT DOUBLE QUOTATION MARK
 907   (#x95 #x2022) ; BULLET
 908   (#x96 #x2013) ; EN DASH
 909   (#x97 #x2014) ; EM DASH
 910   (#x98 nil)
 911   (#x99 #x2122) ; TRADE MARK SIGN
 912   (#x9A nil)
 913   (#x9B #x203A) ; SINGLE RIGHT-POINTING ANGLE QUOTATION MARK
 914   (#x9C nil)
 915   (#x9D #x00AF) ; MACRON
 916   (#x9E #x02DB) ; OGONEK
 917   (#x9F nil)
 918   (#xA1 nil)
 919   (#xA5 nil)
 920   (#xA8 #x00D8) ; LATIN CAPITAL LETTER O WITH STROKE
 921   (#xAA #x0156) ; LATIN CAPITAL LETTER R WITH CEDILLA
 922   (#xAF #x00C6) ; LATIN CAPITAL LETTER AE
 923   (#xB8 #x00F8) ; LATIN SMALL LETTER O WITH STROKE
 924   (#xBA #x0157) ; LATIN SMALL LETTER R WITH CEDILLA
 925   (#xBF #x00E6) ; LATIN SMALL LETTER AE
 926   (#xC0 #x0104) ; LATIN CAPITAL LETTER A WITH OGONEK
 927   (#xC1 #x012E) ; LATIN CAPITAL LETTER I WITH OGONEK
 928   (#xC2 #x0100) ; LATIN CAPITAL LETTER A WITH MACRON
 929   (#xC3 #x0106) ; LATIN CAPITAL LETTER C WITH ACUTE
 930   (#xC6 #x0118) ; LATIN CAPITAL LETTER E WITH OGONEK
 931   (#xC7 #x0112) ; LATIN CAPITAL LETTER E WITH MACRON
 932   (#xC8 #x010C) ; LATIN CAPITAL LETTER C WITH CARON
 933   (#xCA #x0179) ; LATIN CAPITAL LETTER Z WITH ACUTE
 934   (#xCB #x0116) ; LATIN CAPITAL LETTER E WITH DOT ABOVE
 935   (#xCC #x0122) ; LATIN CAPITAL LETTER G WITH CEDILLA
 936   (#xCD #x0136) ; LATIN CAPITAL LETTER K WITH CEDILLA
 937   (#xCE #x012A) ; LATIN CAPITAL LETTER I WITH MACRON
 938   (#xCF #x013B) ; LATIN CAPITAL LETTER L WITH CEDILLA
 939   (#xD0 #x0160) ; LATIN CAPITAL LETTER S WITH CARON
 940   (#xD1 #x0143) ; LATIN CAPITAL LETTER N WITH ACUTE
 941   (#xD2 #x0145) ; LATIN CAPITAL LETTER N WITH CEDILLA
 942   (#xD4 #x014C) ; LATIN CAPITAL LETTER O WITH MACRON
 943   (#xD8 #x0172) ; LATIN CAPITAL LETTER U WITH OGONEK
 944   (#xD9 #x0141) ; LATIN CAPITAL LETTER L WITH STROKE
 945   (#xDA #x015A) ; LATIN CAPITAL LETTER S WITH ACUTE
 946   (#xDB #x016A) ; LATIN CAPITAL LETTER U WITH MACRON
 947   (#xDD #x017B) ; LATIN CAPITAL LETTER Z WITH DOT ABOVE
 948   (#xDE #x017D) ; LATIN CAPITAL LETTER Z WITH CARON
 949   (#xE0 #x0105) ; LATIN SMALL LETTER A WITH OGONEK
 950   (#xE1 #x012F) ; LATIN SMALL LETTER I WITH OGONEK
 951   (#xE2 #x0101) ; LATIN SMALL LETTER A WITH MACRON
 952   (#xE3 #x0107) ; LATIN SMALL LETTER C WITH ACUTE
 953   (#xE6 #x0119) ; LATIN SMALL LETTER E WITH OGONEK
 954   (#xE7 #x0113) ; LATIN SMALL LETTER E WITH MACRON
 955   (#xE8 #x010D) ; LATIN SMALL LETTER C WITH CARON
 956   (#xEA #x017A) ; LATIN SMALL LETTER Z WITH ACUTE
 957   (#xEB #x0117) ; LATIN SMALL LETTER E WITH DOT ABOVE
 958   (#xEC #x0123) ; LATIN SMALL LETTER G WITH CEDILLA
 959   (#xED #x0137) ; LATIN SMALL LETTER K WITH CEDILLA
 960   (#xEE #x012B) ; LATIN SMALL LETTER I WITH MACRON
 961   (#xEF #x013C) ; LATIN SMALL LETTER L WITH CEDILLA
 962   (#xF0 #x0161) ; LATIN SMALL LETTER S WITH CARON
 963   (#xF1 #x0144) ; LATIN SMALL LETTER N WITH ACUTE
 964   (#xF2 #x0146) ; LATIN SMALL LETTER N WITH CEDILLA
 965   (#xF4 #x014D) ; LATIN SMALL LETTER O WITH MACRON
 966   (#xF8 #x0173) ; LATIN SMALL LETTER U WITH OGONEK
 967   (#xF9 #x0142) ; LATIN SMALL LETTER L WITH STROKE
 968   (#xFA #x015B) ; LATIN SMALL LETTER S WITH ACUTE
 969   (#xFB #x016B) ; LATIN SMALL LETTER U WITH MACRON
 970   (#xFD #x017C) ; LATIN SMALL LETTER Z WITH DOT ABOVE
 971   (#xFE #x017E) ; LATIN SMALL LETTER Z WITH CARON
 972   (#xFF #x02D9) ; DOT ABOVE
 973 )
 974
 975 (declaim (inline get-cp1257-bytes))
 976 (defun get-cp1257-bytes(string pos end)
 977   (declare (optimize speed (safety 0))
 978            (type simple-string string)
 979            (type array-range pos end))
 980   (get-latin-bytes #'code->cp1257-mapper :cp1257 string pos end))
 981
 982 (defun string->cp1257 (string sstart send null-padding)
 983   (declare (optimize speed (safety 0))
 984            (type simple-string string)
 985            (type array-range sstart send))
 986   (values (string->latin% string sstart send #'get-cp1257-bytes null-padding)))
 987
 988 (defmacro define-cp1257->string* (accessor type)
 989   (declare (ignore type))
 990   (let ((name (make-od-name 'cp1257->string* accessor)))
 991     `(progn
 992       (defun ,name (string sstart send array astart aend)
 993         (,(make-od-name 'latin->string* accessor) string sstart send array astart aend #'cp1257->code-mapper)))))
 994
 995 (instantiate-octets-definition define-cp1257->string*)
 996
 997 (defmacro define-cp1257->string (accessor type)
 998   (declare (ignore type))
 999   `(defun ,(make-od-name 'cp1257->string accessor) (array astart aend)
1000     (,(make-od-name 'latin->string accessor) array astart aend #'cp1257->code-mapper)))
1001
1002 (instantiate-octets-definition define-cp1257->string)
1003
1004 (push '((:cp1257 :|cp1257| :windows-1257 :|windows-1257|)
1005         cp1257->string-aref string->cp1257)
1006       *external-format-functions*)
1007
1008 (define-external-format (:cp1257 :|cp1257| :windows-1257 :|windows-1257|)
1009     1 t
1010     (let ((cp1257-byte (code->cp1257-mapper bits)))
1011       (if cp1257-byte
1012           (setf (sap-ref-8 sap tail) cp1257-byte)
1013           (stream-encoding-error-and-handle stream bits)))
1014     (let ((code (cp1257->code-mapper byte)))
1015       (if code
1016           (code-char code)
1017           (stream-decoding-error stream byte)))) ;; TODO -- error check
1018
1019 (define-unibyte-mapper cp1258->code-mapper code->cp1258-mapper
1020   (#x80 #x20AC) ; EURO SIGN
1021   (#x81 nil)
1022   (#x82 #x201A) ; SINGLE LOW-9 QUOTATION MARK
1023   (#x83 #x0192) ; LATIN SMALL LETTER F WITH HOOK
1024   (#x84 #x201E) ; DOUBLE LOW-9 QUOTATION MARK
1025   (#x85 #x2026) ; HORIZONTAL ELLIPSIS
1026   (#x86 #x2020) ; DAGGER
1027   (#x87 #x2021) ; DOUBLE DAGGER
1028   (#x88 #x02C6) ; MODIFIER LETTER CIRCUMFLEX ACCENT
1029   (#x89 #x2030) ; PER MILLE SIGN
1030   (#x8A nil)
1031   (#x8B #x2039) ; SINGLE LEFT-POINTING ANGLE QUOTATION MARK
1032   (#x8C #x0152) ; LATIN CAPITAL LIGATURE OE
1033   (#x8D nil)
1034   (#x8E nil)
1035   (#x8F nil)
1036   (#x90 nil)
1037   (#x91 #x2018) ; LEFT SINGLE QUOTATION MARK
1038   (#x92 #x2019) ; RIGHT SINGLE QUOTATION MARK
1039   (#x93 #x201C) ; LEFT DOUBLE QUOTATION MARK
1040   (#x94 #x201D) ; RIGHT DOUBLE QUOTATION MARK
1041   (#x95 #x2022) ; BULLET
1042   (#x96 #x2013) ; EN DASH
1043   (#x97 #x2014) ; EM DASH
1044   (#x98 #x02DC) ; SMALL TILDE
1045   (#x99 #x2122) ; TRADE MARK SIGN
1046   (#x9A nil)
1047   (#x9B #x203A) ; SINGLE RIGHT-POINTING ANGLE QUOTATION MARK
1048   (#x9C #x0153) ; LATIN SMALL LIGATURE OE
1049   (#x9D nil)
1050   (#x9E nil)
1051   (#x9F #x0178) ; LATIN CAPITAL LETTER Y WITH DIAERESIS
1052   (#xC3 #x0102) ; LATIN CAPITAL LETTER A WITH BREVE
1053   (#xCC #x0300) ; COMBINING GRAVE ACCENT
1054   (#xD0 #x0110) ; LATIN CAPITAL LETTER D WITH STROKE
1055   (#xD2 #x0309) ; COMBINING HOOK ABOVE
1056   (#xD5 #x01A0) ; LATIN CAPITAL LETTER O WITH HORN
1057   (#xDD #x01AF) ; LATIN CAPITAL LETTER U WITH HORN
1058   (#xDE #x0303) ; COMBINING TILDE
1059   (#xE3 #x0103) ; LATIN SMALL LETTER A WITH BREVE
1060   (#xEC #x0301) ; COMBINING ACUTE ACCENT
1061   (#xF0 #x0111) ; LATIN SMALL LETTER D WITH STROKE
1062   (#xF2 #x0323) ; COMBINING DOT BELOW
1063   (#xF5 #x01A1) ; LATIN SMALL LETTER O WITH HORN
1064   (#xFD #x01B0) ; LATIN SMALL LETTER U WITH HORN
1065   (#xFE #x20AB) ; DONG SIGN
1066 )
1067
1068 (declaim (inline get-cp1258-bytes))
1069 (defun get-cp1258-bytes(string pos end)
1070   (declare (optimize speed (safety 0))
1071            (type simple-string string)
1072            (type array-range pos end))
1073   (get-latin-bytes #'code->cp1258-mapper :cp1258 string pos end))
1074
1075 (defun string->cp1258 (string sstart send null-padding)
1076   (declare (optimize speed (safety 0))
1077            (type simple-string string)
1078            (type array-range sstart send))
1079   (values (string->latin% string sstart send #'get-cp1258-bytes null-padding)))
1080
1081 (defmacro define-cp1258->string* (accessor type)
1082   (declare (ignore type))
1083   (let ((name (make-od-name 'cp1258->string* accessor)))
1084     `(progn
1085       (defun ,name (string sstart send array astart aend)
1086         (,(make-od-name 'latin->string* accessor) string sstart send array astart aend #'cp1258->code-mapper)))))
1087
1088 (instantiate-octets-definition define-cp1258->string*)
1089
1090 (defmacro define-cp1258->string (accessor type)
1091   (declare (ignore type))
1092   `(defun ,(make-od-name 'cp1258->string accessor) (array astart aend)
1093     (,(make-od-name 'latin->string accessor) array astart aend #'cp1258->code-mapper)))
1094
1095 (instantiate-octets-definition define-cp1258->string)
1096
1097 (push '((:cp1258 :|cp1258| :windows-1258 :|windows-1258|)
1098         cp1258->string-aref string->cp1258)
1099       *external-format-functions*)
1100
1101 (define-external-format (:cp1258 :|cp1258| :windows-1258 :|windows-1258|)
1102     1 t
1103     (let ((cp1258-byte (code->cp1258-mapper bits)))
1104       (if cp1258-byte
1105           (setf (sap-ref-8 sap tail) cp1258-byte)
1106           (stream-encoding-error-and-handle stream bits)))
1107     (let ((code (cp1258->code-mapper byte)))
1108       (if code
1109           (code-char code)
1110           (stream-decoding-error stream byte)))) ;; TODO -- error check