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

   1 (in-package "SB!IMPL")
   2
   3 (define-unibyte-mapper cp437->code-mapper code->cp437-mapper
   4   (#x80 #x00C7) ; LATIN CAPITAL LETTER C WITH CEDILLA
   5   (#x81 #x00FC) ; LATIN SMALL LETTER U WITH DIAERESIS
   6   (#x82 #x00E9) ; LATIN SMALL LETTER E WITH ACUTE
   7   (#x83 #x00E2) ; LATIN SMALL LETTER A WITH CIRCUMFLEX
   8   (#x84 #x00E4) ; LATIN SMALL LETTER A WITH DIAERESIS
   9   (#x85 #x00E0) ; LATIN SMALL LETTER A WITH GRAVE
  10   (#x86 #x00E5) ; LATIN SMALL LETTER A WITH RING ABOVE
  11   (#x87 #x00E7) ; LATIN SMALL LETTER C WITH CEDILLA
  12   (#x88 #x00EA) ; LATIN SMALL LETTER E WITH CIRCUMFLEX
  13   (#x89 #x00EB) ; LATIN SMALL LETTER E WITH DIAERESIS
  14   (#x8A #x00E8) ; LATIN SMALL LETTER E WITH GRAVE
  15   (#x8B #x00EF) ; LATIN SMALL LETTER I WITH DIAERESIS
  16   (#x8C #x00EE) ; LATIN SMALL LETTER I WITH CIRCUMFLEX
  17   (#x8D #x00EC) ; LATIN SMALL LETTER I WITH GRAVE
  18   (#x8E #x00C4) ; LATIN CAPITAL LETTER A WITH DIAERESIS
  19   (#x8F #x00C5) ; LATIN CAPITAL LETTER A WITH RING ABOVE
  20   (#x90 #x00C9) ; LATIN CAPITAL LETTER E WITH ACUTE
  21   (#x91 #x00E6) ; LATIN SMALL LIGATURE AE
  22   (#x92 #x00C6) ; LATIN CAPITAL LIGATURE AE
  23   (#x93 #x00F4) ; LATIN SMALL LETTER O WITH CIRCUMFLEX
  24   (#x94 #x00F6) ; LATIN SMALL LETTER O WITH DIAERESIS
  25   (#x95 #x00F2) ; LATIN SMALL LETTER O WITH GRAVE
  26   (#x96 #x00FB) ; LATIN SMALL LETTER U WITH CIRCUMFLEX
  27   (#x97 #x00F9) ; LATIN SMALL LETTER U WITH GRAVE
  28   (#x98 #x00FF) ; LATIN SMALL LETTER Y WITH DIAERESIS
  29   (#x99 #x00D6) ; LATIN CAPITAL LETTER O WITH DIAERESIS
  30   (#x9A #x00DC) ; LATIN CAPITAL LETTER U WITH DIAERESIS
  31   (#x9B #x00A2) ; CENT SIGN
  32   (#x9C #x00A3) ; POUND SIGN
  33   (#x9D #x00A5) ; YEN SIGN
  34   (#x9E #x20A7) ; PESETA SIGN
  35   (#x9F #x0192) ; LATIN SMALL LETTER F WITH HOOK
  36   (#xA0 #x00E1) ; LATIN SMALL LETTER A WITH ACUTE
  37   (#xA1 #x00ED) ; LATIN SMALL LETTER I WITH ACUTE
  38   (#xA2 #x00F3) ; LATIN SMALL LETTER O WITH ACUTE
  39   (#xA3 #x00FA) ; LATIN SMALL LETTER U WITH ACUTE
  40   (#xA4 #x00F1) ; LATIN SMALL LETTER N WITH TILDE
  41   (#xA5 #x00D1) ; LATIN CAPITAL LETTER N WITH TILDE
  42   (#xA6 #x00AA) ; FEMININE ORDINAL INDICATOR
  43   (#xA7 #x00BA) ; MASCULINE ORDINAL INDICATOR
  44   (#xA8 #x00BF) ; INVERTED QUESTION MARK
  45   (#xA9 #x2310) ; REVERSED NOT SIGN
  46   (#xAA #x00AC) ; NOT SIGN
  47   (#xAB #x00BD) ; VULGAR FRACTION ONE HALF
  48   (#xAC #x00BC) ; VULGAR FRACTION ONE QUARTER
  49   (#xAD #x00A1) ; INVERTED EXCLAMATION MARK
  50   (#xAE #x00AB) ; LEFT-POINTING DOUBLE ANGLE QUOTATION MARK
  51   (#xAF #x00BB) ; RIGHT-POINTING DOUBLE ANGLE QUOTATION MARK
  52   (#xB0 #x2591) ; LIGHT SHADE
  53   (#xB1 #x2592) ; MEDIUM SHADE
  54   (#xB2 #x2593) ; DARK SHADE
  55   (#xB3 #x2502) ; BOX DRAWINGS LIGHT VERTICAL
  56   (#xB4 #x2524) ; BOX DRAWINGS LIGHT VERTICAL AND LEFT
  57   (#xB5 #x2561) ; BOX DRAWINGS VERTICAL SINGLE AND LEFT DOUBLE
  58   (#xB6 #x2562) ; BOX DRAWINGS VERTICAL DOUBLE AND LEFT SINGLE
  59   (#xB7 #x2556) ; BOX DRAWINGS DOWN DOUBLE AND LEFT SINGLE
  60   (#xB8 #x2555) ; BOX DRAWINGS DOWN SINGLE AND LEFT DOUBLE
  61   (#xB9 #x2563) ; BOX DRAWINGS DOUBLE VERTICAL AND LEFT
  62   (#xBA #x2551) ; BOX DRAWINGS DOUBLE VERTICAL
  63   (#xBB #x2557) ; BOX DRAWINGS DOUBLE DOWN AND LEFT
  64   (#xBC #x255D) ; BOX DRAWINGS DOUBLE UP AND LEFT
  65   (#xBD #x255C) ; BOX DRAWINGS UP DOUBLE AND LEFT SINGLE
  66   (#xBE #x255B) ; BOX DRAWINGS UP SINGLE AND LEFT DOUBLE
  67   (#xBF #x2510) ; BOX DRAWINGS LIGHT DOWN AND LEFT
  68   (#xC0 #x2514) ; BOX DRAWINGS LIGHT UP AND RIGHT
  69   (#xC1 #x2534) ; BOX DRAWINGS LIGHT UP AND HORIZONTAL
  70   (#xC2 #x252C) ; BOX DRAWINGS LIGHT DOWN AND HORIZONTAL
  71   (#xC3 #x251C) ; BOX DRAWINGS LIGHT VERTICAL AND RIGHT
  72   (#xC4 #x2500) ; BOX DRAWINGS LIGHT HORIZONTAL
  73   (#xC5 #x253C) ; BOX DRAWINGS LIGHT VERTICAL AND HORIZONTAL
  74   (#xC6 #x255E) ; BOX DRAWINGS VERTICAL SINGLE AND RIGHT DOUBLE
  75   (#xC7 #x255F) ; BOX DRAWINGS VERTICAL DOUBLE AND RIGHT SINGLE
  76   (#xC8 #x255A) ; BOX DRAWINGS DOUBLE UP AND RIGHT
  77   (#xC9 #x2554) ; BOX DRAWINGS DOUBLE DOWN AND RIGHT
  78   (#xCA #x2569) ; BOX DRAWINGS DOUBLE UP AND HORIZONTAL
  79   (#xCB #x2566) ; BOX DRAWINGS DOUBLE DOWN AND HORIZONTAL
  80   (#xCC #x2560) ; BOX DRAWINGS DOUBLE VERTICAL AND RIGHT
  81   (#xCD #x2550) ; BOX DRAWINGS DOUBLE HORIZONTAL
  82   (#xCE #x256C) ; BOX DRAWINGS DOUBLE VERTICAL AND HORIZONTAL
  83   (#xCF #x2567) ; BOX DRAWINGS UP SINGLE AND HORIZONTAL DOUBLE
  84   (#xD0 #x2568) ; BOX DRAWINGS UP DOUBLE AND HORIZONTAL SINGLE
  85   (#xD1 #x2564) ; BOX DRAWINGS DOWN SINGLE AND HORIZONTAL DOUBLE
  86   (#xD2 #x2565) ; BOX DRAWINGS DOWN DOUBLE AND HORIZONTAL SINGLE
  87   (#xD3 #x2559) ; BOX DRAWINGS UP DOUBLE AND RIGHT SINGLE
  88   (#xD4 #x2558) ; BOX DRAWINGS UP SINGLE AND RIGHT DOUBLE
  89   (#xD5 #x2552) ; BOX DRAWINGS DOWN SINGLE AND RIGHT DOUBLE
  90   (#xD6 #x2553) ; BOX DRAWINGS DOWN DOUBLE AND RIGHT SINGLE
  91   (#xD7 #x256B) ; BOX DRAWINGS VERTICAL DOUBLE AND HORIZONTAL SINGLE
  92   (#xD8 #x256A) ; BOX DRAWINGS VERTICAL SINGLE AND HORIZONTAL DOUBLE
  93   (#xD9 #x2518) ; BOX DRAWINGS LIGHT UP AND LEFT
  94   (#xDA #x250C) ; BOX DRAWINGS LIGHT DOWN AND RIGHT
  95   (#xDB #x2588) ; FULL BLOCK
  96   (#xDC #x2584) ; LOWER HALF BLOCK
  97   (#xDD #x258C) ; LEFT HALF BLOCK
  98   (#xDE #x2590) ; RIGHT HALF BLOCK
  99   (#xDF #x2580) ; UPPER HALF BLOCK
 100   (#xE0 #x03B1) ; GREEK SMALL LETTER ALPHA
 101   (#xE1 #x00DF) ; LATIN SMALL LETTER SHARP S
 102   (#xE2 #x0393) ; GREEK CAPITAL LETTER GAMMA
 103   (#xE3 #x03C0) ; GREEK SMALL LETTER PI
 104   (#xE4 #x03A3) ; GREEK CAPITAL LETTER SIGMA
 105   (#xE5 #x03C3) ; GREEK SMALL LETTER SIGMA
 106   (#xE6 #x00B5) ; MICRO SIGN
 107   (#xE7 #x03C4) ; GREEK SMALL LETTER TAU
 108   (#xE8 #x03A6) ; GREEK CAPITAL LETTER PHI
 109   (#xE9 #x0398) ; GREEK CAPITAL LETTER THETA
 110   (#xEA #x03A9) ; GREEK CAPITAL LETTER OMEGA
 111   (#xEB #x03B4) ; GREEK SMALL LETTER DELTA
 112   (#xEC #x221E) ; INFINITY
 113   (#xED #x03C6) ; GREEK SMALL LETTER PHI
 114   (#xEE #x03B5) ; GREEK SMALL LETTER EPSILON
 115   (#xEF #x2229) ; INTERSECTION
 116   (#xF0 #x2261) ; IDENTICAL TO
 117   (#xF1 #x00B1) ; PLUS-MINUS SIGN
 118   (#xF2 #x2265) ; GREATER-THAN OR EQUAL TO
 119   (#xF3 #x2264) ; LESS-THAN OR EQUAL TO
 120   (#xF4 #x2320) ; TOP HALF INTEGRAL
 121   (#xF5 #x2321) ; BOTTOM HALF INTEGRAL
 122   (#xF6 #x00F7) ; DIVISION SIGN
 123   (#xF7 #x2248) ; ALMOST EQUAL TO
 124   (#xF8 #x00B0) ; DEGREE SIGN
 125   (#xF9 #x2219) ; BULLET OPERATOR
 126   (#xFA #x00B7) ; MIDDLE DOT
 127   (#xFB #x221A) ; SQUARE ROOT
 128   (#xFC #x207F) ; SUPERSCRIPT LATIN SMALL LETTER N
 129   (#xFD #x00B2) ; SUPERSCRIPT TWO
 130   (#xFE #x25A0) ; BLACK SQUARE
 131   (#xFF #x00A0) ; NO-BREAK SPACE
 132 )
 133
 134 (declaim (inline get-cp437-bytes))
 135 (defun get-cp437-bytes (string pos)
 136   (declare (optimize speed (safety 0))
 137            (type simple-string string)
 138            (type array-range pos))
 139   (get-latin-bytes #'code->cp437-mapper :cp437 string pos))
 140
 141 (defun string->cp437 (string sstart send null-padding)
 142   (declare (optimize speed (safety 0))
 143            (type simple-string string)
 144            (type array-range sstart send))
 145   (values (string->latin% string sstart send #'get-cp437-bytes null-padding)))
 146
 147 (defmacro define-cp437->string* (accessor type)
 148   (declare (ignore type))
 149   (let ((name (make-od-name 'cp437->string* accessor)))
 150     `(progn
 151       (defun ,name (string sstart send array astart aend)
 152         (,(make-od-name 'latin->string* accessor) string sstart send array astart aend #'cp437->code-mapper)))))
 153
 154 (instantiate-octets-definition define-cp437->string*)
 155
 156 (defmacro define-cp437->string (accessor type)
 157   (declare (ignore type))
 158   `(defun ,(make-od-name 'cp437->string accessor) (array astart aend)
 159     (,(make-od-name 'latin->string accessor) array astart aend #'cp437->code-mapper)))
 160
 161 (instantiate-octets-definition define-cp437->string)
 162
 163 (add-external-format-funs '(:cp437 :|cp437|)
 164                           '(cp437->string-aref string->cp437))
 165
 166 (define-external-format (:cp437 :|cp437|)
 167     1 t
 168     (let ((cp437-byte (code->cp437-mapper bits)))
 169       (if cp437-byte
 170           (setf (sap-ref-8 sap tail) cp437-byte)
 171           (external-format-encoding-error stream bits)))
 172     (let ((code (cp437->code-mapper byte)))
 173       (if code
 174           (code-char code)
 175           (external-format-decoding-error stream byte)))) ;; TODO -- error check
 176
 177 (define-unibyte-mapper cp850->code-mapper code->cp850-mapper
 178   (#x80 #x00C7) ; LATIN CAPITAL LETTER C WITH CEDILLA
 179   (#x81 #x00FC) ; LATIN SMALL LETTER U WITH DIAERESIS
 180   (#x82 #x00E9) ; LATIN SMALL LETTER E WITH ACUTE
 181   (#x83 #x00E2) ; LATIN SMALL LETTER A WITH CIRCUMFLEX
 182   (#x84 #x00E4) ; LATIN SMALL LETTER A WITH DIAERESIS
 183   (#x85 #x00E0) ; LATIN SMALL LETTER A WITH GRAVE
 184   (#x86 #x00E5) ; LATIN SMALL LETTER A WITH RING ABOVE
 185   (#x87 #x00E7) ; LATIN SMALL LETTER C WITH CEDILLA
 186   (#x88 #x00EA) ; LATIN SMALL LETTER E WITH CIRCUMFLEX
 187   (#x89 #x00EB) ; LATIN SMALL LETTER E WITH DIAERESIS
 188   (#x8A #x00E8) ; LATIN SMALL LETTER E WITH GRAVE
 189   (#x8B #x00EF) ; LATIN SMALL LETTER I WITH DIAERESIS
 190   (#x8C #x00EE) ; LATIN SMALL LETTER I WITH CIRCUMFLEX
 191   (#x8D #x00EC) ; LATIN SMALL LETTER I WITH GRAVE
 192   (#x8E #x00C4) ; LATIN CAPITAL LETTER A WITH DIAERESIS
 193   (#x8F #x00C5) ; LATIN CAPITAL LETTER A WITH RING ABOVE
 194   (#x90 #x00C9) ; LATIN CAPITAL LETTER E WITH ACUTE
 195   (#x91 #x00E6) ; LATIN SMALL LIGATURE AE
 196   (#x92 #x00C6) ; LATIN CAPITAL LIGATURE AE
 197   (#x93 #x00F4) ; LATIN SMALL LETTER O WITH CIRCUMFLEX
 198   (#x94 #x00F6) ; LATIN SMALL LETTER O WITH DIAERESIS
 199   (#x95 #x00F2) ; LATIN SMALL LETTER O WITH GRAVE
 200   (#x96 #x00FB) ; LATIN SMALL LETTER U WITH CIRCUMFLEX
 201   (#x97 #x00F9) ; LATIN SMALL LETTER U WITH GRAVE
 202   (#x98 #x00FF) ; LATIN SMALL LETTER Y WITH DIAERESIS
 203   (#x99 #x00D6) ; LATIN CAPITAL LETTER O WITH DIAERESIS
 204   (#x9A #x00DC) ; LATIN CAPITAL LETTER U WITH DIAERESIS
 205   (#x9B #x00F8) ; LATIN SMALL LETTER O WITH STROKE
 206   (#x9C #x00A3) ; POUND SIGN
 207   (#x9D #x00D8) ; LATIN CAPITAL LETTER O WITH STROKE
 208   (#x9E #x00D7) ; MULTIPLICATION SIGN
 209   (#x9F #x0192) ; LATIN SMALL LETTER F WITH HOOK
 210   (#xA0 #x00E1) ; LATIN SMALL LETTER A WITH ACUTE
 211   (#xA1 #x00ED) ; LATIN SMALL LETTER I WITH ACUTE
 212   (#xA2 #x00F3) ; LATIN SMALL LETTER O WITH ACUTE
 213   (#xA3 #x00FA) ; LATIN SMALL LETTER U WITH ACUTE
 214   (#xA4 #x00F1) ; LATIN SMALL LETTER N WITH TILDE
 215   (#xA5 #x00D1) ; LATIN CAPITAL LETTER N WITH TILDE
 216   (#xA6 #x00AA) ; FEMININE ORDINAL INDICATOR
 217   (#xA7 #x00BA) ; MASCULINE ORDINAL INDICATOR
 218   (#xA8 #x00BF) ; INVERTED QUESTION MARK
 219   (#xA9 #x00AE) ; REGISTERED SIGN
 220   (#xAA #x00AC) ; NOT SIGN
 221   (#xAB #x00BD) ; VULGAR FRACTION ONE HALF
 222   (#xAC #x00BC) ; VULGAR FRACTION ONE QUARTER
 223   (#xAD #x00A1) ; INVERTED EXCLAMATION MARK
 224   (#xAE #x00AB) ; LEFT-POINTING DOUBLE ANGLE QUOTATION MARK
 225   (#xAF #x00BB) ; RIGHT-POINTING DOUBLE ANGLE QUOTATION MARK
 226   (#xB0 #x2591) ; LIGHT SHADE
 227   (#xB1 #x2592) ; MEDIUM SHADE
 228   (#xB2 #x2593) ; DARK SHADE
 229   (#xB3 #x2502) ; BOX DRAWINGS LIGHT VERTICAL
 230   (#xB4 #x2524) ; BOX DRAWINGS LIGHT VERTICAL AND LEFT
 231   (#xB5 #x00C1) ; LATIN CAPITAL LETTER A WITH ACUTE
 232   (#xB6 #x00C2) ; LATIN CAPITAL LETTER A WITH CIRCUMFLEX
 233   (#xB7 #x00C0) ; LATIN CAPITAL LETTER A WITH GRAVE
 234   (#xB8 #x00A9) ; COPYRIGHT SIGN
 235   (#xB9 #x2563) ; BOX DRAWINGS DOUBLE VERTICAL AND LEFT
 236   (#xBA #x2551) ; BOX DRAWINGS DOUBLE VERTICAL
 237   (#xBB #x2557) ; BOX DRAWINGS DOUBLE DOWN AND LEFT
 238   (#xBC #x255D) ; BOX DRAWINGS DOUBLE UP AND LEFT
 239   (#xBD #x00A2) ; CENT SIGN
 240   (#xBE #x00A5) ; YEN SIGN
 241   (#xBF #x2510) ; BOX DRAWINGS LIGHT DOWN AND LEFT
 242   (#xC0 #x2514) ; BOX DRAWINGS LIGHT UP AND RIGHT
 243   (#xC1 #x2534) ; BOX DRAWINGS LIGHT UP AND HORIZONTAL
 244   (#xC2 #x252C) ; BOX DRAWINGS LIGHT DOWN AND HORIZONTAL
 245   (#xC3 #x251C) ; BOX DRAWINGS LIGHT VERTICAL AND RIGHT
 246   (#xC4 #x2500) ; BOX DRAWINGS LIGHT HORIZONTAL
 247   (#xC5 #x253C) ; BOX DRAWINGS LIGHT VERTICAL AND HORIZONTAL
 248   (#xC6 #x00E3) ; LATIN SMALL LETTER A WITH TILDE
 249   (#xC7 #x00C3) ; LATIN CAPITAL LETTER A WITH TILDE
 250   (#xC8 #x255A) ; BOX DRAWINGS DOUBLE UP AND RIGHT
 251   (#xC9 #x2554) ; BOX DRAWINGS DOUBLE DOWN AND RIGHT
 252   (#xCA #x2569) ; BOX DRAWINGS DOUBLE UP AND HORIZONTAL
 253   (#xCB #x2566) ; BOX DRAWINGS DOUBLE DOWN AND HORIZONTAL
 254   (#xCC #x2560) ; BOX DRAWINGS DOUBLE VERTICAL AND RIGHT
 255   (#xCD #x2550) ; BOX DRAWINGS DOUBLE HORIZONTAL
 256   (#xCE #x256C) ; BOX DRAWINGS DOUBLE VERTICAL AND HORIZONTAL
 257   (#xCF #x00A4) ; CURRENCY SIGN
 258   (#xD0 #x00F0) ; LATIN SMALL LETTER ETH
 259   (#xD1 #x00D0) ; LATIN CAPITAL LETTER ETH
 260   (#xD2 #x00CA) ; LATIN CAPITAL LETTER E WITH CIRCUMFLEX
 261   (#xD3 #x00CB) ; LATIN CAPITAL LETTER E WITH DIAERESIS
 262   (#xD4 #x00C8) ; LATIN CAPITAL LETTER E WITH GRAVE
 263   (#xD5 #x0131) ; LATIN SMALL LETTER DOTLESS I
 264   (#xD6 #x00CD) ; LATIN CAPITAL LETTER I WITH ACUTE
 265   (#xD7 #x00CE) ; LATIN CAPITAL LETTER I WITH CIRCUMFLEX
 266   (#xD8 #x00CF) ; LATIN CAPITAL LETTER I WITH DIAERESIS
 267   (#xD9 #x2518) ; BOX DRAWINGS LIGHT UP AND LEFT
 268   (#xDA #x250C) ; BOX DRAWINGS LIGHT DOWN AND RIGHT
 269   (#xDB #x2588) ; FULL BLOCK
 270   (#xDC #x2584) ; LOWER HALF BLOCK
 271   (#xDD #x00A6) ; BROKEN BAR
 272   (#xDE #x00CC) ; LATIN CAPITAL LETTER I WITH GRAVE
 273   (#xDF #x2580) ; UPPER HALF BLOCK
 274   (#xE0 #x00D3) ; LATIN CAPITAL LETTER O WITH ACUTE
 275   (#xE1 #x00DF) ; LATIN SMALL LETTER SHARP S
 276   (#xE2 #x00D4) ; LATIN CAPITAL LETTER O WITH CIRCUMFLEX
 277   (#xE3 #x00D2) ; LATIN CAPITAL LETTER O WITH GRAVE
 278   (#xE4 #x00F5) ; LATIN SMALL LETTER O WITH TILDE
 279   (#xE5 #x00D5) ; LATIN CAPITAL LETTER O WITH TILDE
 280   (#xE6 #x00B5) ; MICRO SIGN
 281   (#xE7 #x00FE) ; LATIN SMALL LETTER THORN
 282   (#xE8 #x00DE) ; LATIN CAPITAL LETTER THORN
 283   (#xE9 #x00DA) ; LATIN CAPITAL LETTER U WITH ACUTE
 284   (#xEA #x00DB) ; LATIN CAPITAL LETTER U WITH CIRCUMFLEX
 285   (#xEB #x00D9) ; LATIN CAPITAL LETTER U WITH GRAVE
 286   (#xEC #x00FD) ; LATIN SMALL LETTER Y WITH ACUTE
 287   (#xED #x00DD) ; LATIN CAPITAL LETTER Y WITH ACUTE
 288   (#xEE #x00AF) ; MACRON
 289   (#xEF #x00B4) ; ACUTE ACCENT
 290   (#xF0 #x00AD) ; SOFT HYPHEN
 291   (#xF1 #x00B1) ; PLUS-MINUS SIGN
 292   (#xF2 #x2017) ; DOUBLE LOW LINE
 293   (#xF3 #x00BE) ; VULGAR FRACTION THREE QUARTERS
 294   (#xF4 #x00B6) ; PILCROW SIGN
 295   (#xF5 #x00A7) ; SECTION SIGN
 296   (#xF6 #x00F7) ; DIVISION SIGN
 297   (#xF7 #x00B8) ; CEDILLA
 298   (#xF8 #x00B0) ; DEGREE SIGN
 299   (#xF9 #x00A8) ; DIAERESIS
 300   (#xFA #x00B7) ; MIDDLE DOT
 301   (#xFB #x00B9) ; SUPERSCRIPT ONE
 302   (#xFC #x00B3) ; SUPERSCRIPT THREE
 303   (#xFD #x00B2) ; SUPERSCRIPT TWO
 304   (#xFE #x25A0) ; BLACK SQUARE
 305   (#xFF #x00A0) ; NO-BREAK SPACE
 306 )
 307
 308 (declaim (inline get-cp850-bytes))
 309 (defun get-cp850-bytes (string pos)
 310   (declare (optimize speed (safety 0))
 311            (type simple-string string)
 312            (type array-range pos))
 313   (get-latin-bytes #'code->cp850-mapper :cp850 string pos))
 314
 315 (defun string->cp850 (string sstart send null-padding)
 316   (declare (optimize speed (safety 0))
 317            (type simple-string string)
 318            (type array-range sstart send))
 319   (values (string->latin% string sstart send #'get-cp850-bytes null-padding)))
 320
 321 (defmacro define-cp850->string* (accessor type)
 322   (declare (ignore type))
 323   (let ((name (make-od-name 'cp850->string* accessor)))
 324     `(progn
 325       (defun ,name (string sstart send array astart aend)
 326         (,(make-od-name 'latin->string* accessor) string sstart send array astart aend #'cp850->code-mapper)))))
 327
 328 (instantiate-octets-definition define-cp850->string*)
 329
 330 (defmacro define-cp850->string (accessor type)
 331   (declare (ignore type))
 332   `(defun ,(make-od-name 'cp850->string accessor) (array astart aend)
 333     (,(make-od-name 'latin->string accessor) array astart aend #'cp850->code-mapper)))
 334
 335 (instantiate-octets-definition define-cp850->string)
 336
 337 (add-external-format-funs '(:cp850 :|cp850|)
 338                           '(cp850->string-aref string->cp850))
 339
 340 (define-external-format (:cp850 :|cp850|)
 341     1 t
 342     (let ((cp850-byte (code->cp850-mapper bits)))
 343       (if cp850-byte
 344           (setf (sap-ref-8 sap tail) cp850-byte)
 345           (external-format-encoding-error stream bits)))
 346     (let ((code (cp850->code-mapper byte)))
 347       (if code
 348           (code-char code)
 349           (external-format-decoding-error stream byte)))) ;; TODO -- error check
 350
 351 (define-unibyte-mapper cp852->code-mapper code->cp852-mapper
 352   (#x80 #x00C7) ; LATIN CAPITAL LETTER C WITH CEDILLA
 353   (#x81 #x00FC) ; LATIN SMALL LETTER U WITH DIAERESIS
 354   (#x82 #x00E9) ; LATIN SMALL LETTER E WITH ACUTE
 355   (#x83 #x00E2) ; LATIN SMALL LETTER A WITH CIRCUMFLEX
 356   (#x84 #x00E4) ; LATIN SMALL LETTER A WITH DIAERESIS
 357   (#x85 #x016F) ; LATIN SMALL LETTER U WITH RING ABOVE
 358   (#x86 #x0107) ; LATIN SMALL LETTER C WITH ACUTE
 359   (#x87 #x00E7) ; LATIN SMALL LETTER C WITH CEDILLA
 360   (#x88 #x0142) ; LATIN SMALL LETTER L WITH STROKE
 361   (#x89 #x00EB) ; LATIN SMALL LETTER E WITH DIAERESIS
 362   (#x8A #x0150) ; LATIN CAPITAL LETTER O WITH DOUBLE ACUTE
 363   (#x8B #x0151) ; LATIN SMALL LETTER O WITH DOUBLE ACUTE
 364   (#x8C #x00EE) ; LATIN SMALL LETTER I WITH CIRCUMFLEX
 365   (#x8D #x0179) ; LATIN CAPITAL LETTER Z WITH ACUTE
 366   (#x8E #x00C4) ; LATIN CAPITAL LETTER A WITH DIAERESIS
 367   (#x8F #x0106) ; LATIN CAPITAL LETTER C WITH ACUTE
 368   (#x90 #x00C9) ; LATIN CAPITAL LETTER E WITH ACUTE
 369   (#x91 #x0139) ; LATIN CAPITAL LETTER L WITH ACUTE
 370   (#x92 #x013A) ; LATIN SMALL LETTER L WITH ACUTE
 371   (#x93 #x00F4) ; LATIN SMALL LETTER O WITH CIRCUMFLEX
 372   (#x94 #x00F6) ; LATIN SMALL LETTER O WITH DIAERESIS
 373   (#x95 #x013D) ; LATIN CAPITAL LETTER L WITH CARON
 374   (#x96 #x013E) ; LATIN SMALL LETTER L WITH CARON
 375   (#x97 #x015A) ; LATIN CAPITAL LETTER S WITH ACUTE
 376   (#x98 #x015B) ; LATIN SMALL LETTER S WITH ACUTE
 377   (#x99 #x00D6) ; LATIN CAPITAL LETTER O WITH DIAERESIS
 378   (#x9A #x00DC) ; LATIN CAPITAL LETTER U WITH DIAERESIS
 379   (#x9B #x0164) ; LATIN CAPITAL LETTER T WITH CARON
 380   (#x9C #x0165) ; LATIN SMALL LETTER T WITH CARON
 381   (#x9D #x0141) ; LATIN CAPITAL LETTER L WITH STROKE
 382   (#x9E #x00D7) ; MULTIPLICATION SIGN
 383   (#x9F #x010D) ; LATIN SMALL LETTER C WITH CARON
 384   (#xA0 #x00E1) ; LATIN SMALL LETTER A WITH ACUTE
 385   (#xA1 #x00ED) ; LATIN SMALL LETTER I WITH ACUTE
 386   (#xA2 #x00F3) ; LATIN SMALL LETTER O WITH ACUTE
 387   (#xA3 #x00FA) ; LATIN SMALL LETTER U WITH ACUTE
 388   (#xA4 #x0104) ; LATIN CAPITAL LETTER A WITH OGONEK
 389   (#xA5 #x0105) ; LATIN SMALL LETTER A WITH OGONEK
 390   (#xA6 #x017D) ; LATIN CAPITAL LETTER Z WITH CARON
 391   (#xA7 #x017E) ; LATIN SMALL LETTER Z WITH CARON
 392   (#xA8 #x0118) ; LATIN CAPITAL LETTER E WITH OGONEK
 393   (#xA9 #x0119) ; LATIN SMALL LETTER E WITH OGONEK
 394   (#xAA #x00AC) ; NOT SIGN
 395   (#xAB #x017A) ; LATIN SMALL LETTER Z WITH ACUTE
 396   (#xAC #x010C) ; LATIN CAPITAL LETTER C WITH CARON
 397   (#xAD #x015F) ; LATIN SMALL LETTER S WITH CEDILLA
 398   (#xAE #x00AB) ; LEFT-POINTING DOUBLE ANGLE QUOTATION MARK
 399   (#xAF #x00BB) ; RIGHT-POINTING DOUBLE ANGLE QUOTATION MARK
 400   (#xB0 #x2591) ; LIGHT SHADE
 401   (#xB1 #x2592) ; MEDIUM SHADE
 402   (#xB2 #x2593) ; DARK SHADE
 403   (#xB3 #x2502) ; BOX DRAWINGS LIGHT VERTICAL
 404   (#xB4 #x2524) ; BOX DRAWINGS LIGHT VERTICAL AND LEFT
 405   (#xB5 #x00C1) ; LATIN CAPITAL LETTER A WITH ACUTE
 406   (#xB6 #x00C2) ; LATIN CAPITAL LETTER A WITH CIRCUMFLEX
 407   (#xB7 #x011A) ; LATIN CAPITAL LETTER E WITH CARON
 408   (#xB8 #x015E) ; LATIN CAPITAL LETTER S WITH CEDILLA
 409   (#xB9 #x2563) ; BOX DRAWINGS DOUBLE VERTICAL AND LEFT
 410   (#xBA #x2551) ; BOX DRAWINGS DOUBLE VERTICAL
 411   (#xBB #x2557) ; BOX DRAWINGS DOUBLE DOWN AND LEFT
 412   (#xBC #x255D) ; BOX DRAWINGS DOUBLE UP AND LEFT
 413   (#xBD #x017B) ; LATIN CAPITAL LETTER Z WITH DOT ABOVE
 414   (#xBE #x017C) ; LATIN SMALL LETTER Z WITH DOT ABOVE
 415   (#xBF #x2510) ; BOX DRAWINGS LIGHT DOWN AND LEFT
 416   (#xC0 #x2514) ; BOX DRAWINGS LIGHT UP AND RIGHT
 417   (#xC1 #x2534) ; BOX DRAWINGS LIGHT UP AND HORIZONTAL
 418   (#xC2 #x252C) ; BOX DRAWINGS LIGHT DOWN AND HORIZONTAL
 419   (#xC3 #x251C) ; BOX DRAWINGS LIGHT VERTICAL AND RIGHT
 420   (#xC4 #x2500) ; BOX DRAWINGS LIGHT HORIZONTAL
 421   (#xC5 #x253C) ; BOX DRAWINGS LIGHT VERTICAL AND HORIZONTAL
 422   (#xC6 #x0102) ; LATIN CAPITAL LETTER A WITH BREVE
 423   (#xC7 #x0103) ; LATIN SMALL LETTER A WITH BREVE
 424   (#xC8 #x255A) ; BOX DRAWINGS DOUBLE UP AND RIGHT
 425   (#xC9 #x2554) ; BOX DRAWINGS DOUBLE DOWN AND RIGHT
 426   (#xCA #x2569) ; BOX DRAWINGS DOUBLE UP AND HORIZONTAL
 427   (#xCB #x2566) ; BOX DRAWINGS DOUBLE DOWN AND HORIZONTAL
 428   (#xCC #x2560) ; BOX DRAWINGS DOUBLE VERTICAL AND RIGHT
 429   (#xCD #x2550) ; BOX DRAWINGS DOUBLE HORIZONTAL
 430   (#xCE #x256C) ; BOX DRAWINGS DOUBLE VERTICAL AND HORIZONTAL
 431   (#xCF #x00A4) ; CURRENCY SIGN
 432   (#xD0 #x0111) ; LATIN SMALL LETTER D WITH STROKE
 433   (#xD1 #x0110) ; LATIN CAPITAL LETTER D WITH STROKE
 434   (#xD2 #x010E) ; LATIN CAPITAL LETTER D WITH CARON
 435   (#xD3 #x00CB) ; LATIN CAPITAL LETTER E WITH DIAERESIS
 436   (#xD4 #x010F) ; LATIN SMALL LETTER D WITH CARON
 437   (#xD5 #x0147) ; LATIN CAPITAL LETTER N WITH CARON
 438   (#xD6 #x00CD) ; LATIN CAPITAL LETTER I WITH ACUTE
 439   (#xD7 #x00CE) ; LATIN CAPITAL LETTER I WITH CIRCUMFLEX
 440   (#xD8 #x011B) ; LATIN SMALL LETTER E WITH CARON
 441   (#xD9 #x2518) ; BOX DRAWINGS LIGHT UP AND LEFT
 442   (#xDA #x250C) ; BOX DRAWINGS LIGHT DOWN AND RIGHT
 443   (#xDB #x2588) ; FULL BLOCK
 444   (#xDC #x2584) ; LOWER HALF BLOCK
 445   (#xDD #x0162) ; LATIN CAPITAL LETTER T WITH CEDILLA
 446   (#xDE #x016E) ; LATIN CAPITAL LETTER U WITH RING ABOVE
 447   (#xDF #x2580) ; UPPER HALF BLOCK
 448   (#xE0 #x00D3) ; LATIN CAPITAL LETTER O WITH ACUTE
 449   (#xE1 #x00DF) ; LATIN SMALL LETTER SHARP S
 450   (#xE2 #x00D4) ; LATIN CAPITAL LETTER O WITH CIRCUMFLEX
 451   (#xE3 #x0143) ; LATIN CAPITAL LETTER N WITH ACUTE
 452   (#xE4 #x0144) ; LATIN SMALL LETTER N WITH ACUTE
 453   (#xE5 #x0148) ; LATIN SMALL LETTER N WITH CARON
 454   (#xE6 #x0160) ; LATIN CAPITAL LETTER S WITH CARON
 455   (#xE7 #x0161) ; LATIN SMALL LETTER S WITH CARON
 456   (#xE8 #x0154) ; LATIN CAPITAL LETTER R WITH ACUTE
 457   (#xE9 #x00DA) ; LATIN CAPITAL LETTER U WITH ACUTE
 458   (#xEA #x0155) ; LATIN SMALL LETTER R WITH ACUTE
 459   (#xEB #x0170) ; LATIN CAPITAL LETTER U WITH DOUBLE ACUTE
 460   (#xEC #x00FD) ; LATIN SMALL LETTER Y WITH ACUTE
 461   (#xED #x00DD) ; LATIN CAPITAL LETTER Y WITH ACUTE
 462   (#xEE #x0163) ; LATIN SMALL LETTER T WITH CEDILLA
 463   (#xEF #x00B4) ; ACUTE ACCENT
 464   (#xF0 #x00AD) ; SOFT HYPHEN
 465   (#xF1 #x02DD) ; DOUBLE ACUTE ACCENT
 466   (#xF2 #x02DB) ; OGONEK
 467   (#xF3 #x02C7) ; CARON
 468   (#xF4 #x02D8) ; BREVE
 469   (#xF5 #x00A7) ; SECTION SIGN
 470   (#xF6 #x00F7) ; DIVISION SIGN
 471   (#xF7 #x00B8) ; CEDILLA
 472   (#xF8 #x00B0) ; DEGREE SIGN
 473   (#xF9 #x00A8) ; DIAERESIS
 474   (#xFA #x02D9) ; DOT ABOVE
 475   (#xFB #x0171) ; LATIN SMALL LETTER U WITH DOUBLE ACUTE
 476   (#xFC #x0158) ; LATIN CAPITAL LETTER R WITH CARON
 477   (#xFD #x0159) ; LATIN SMALL LETTER R WITH CARON
 478   (#xFE #x25A0) ; BLACK SQUARE
 479   (#xFF #x00A0) ; NO-BREAK SPACE
 480 )
 481
 482 (declaim (inline get-cp852-bytes))
 483 (defun get-cp852-bytes (string pos)
 484   (declare (optimize speed (safety 0))
 485            (type simple-string string)
 486            (type array-range pos))
 487   (get-latin-bytes #'code->cp852-mapper :cp852 string pos))
 488
 489 (defun string->cp852 (string sstart send null-padding)
 490   (declare (optimize speed (safety 0))
 491            (type simple-string string)
 492            (type array-range sstart send))
 493   (values (string->latin% string sstart send #'get-cp852-bytes null-padding)))
 494
 495 (defmacro define-cp852->string* (accessor type)
 496   (declare (ignore type))
 497   (let ((name (make-od-name 'cp852->string* accessor)))
 498     `(progn
 499       (defun ,name (string sstart send array astart aend)
 500         (,(make-od-name 'latin->string* accessor) string sstart send array astart aend #'cp852->code-mapper)))))
 501
 502 (instantiate-octets-definition define-cp852->string*)
 503
 504 (defmacro define-cp852->string (accessor type)
 505   (declare (ignore type))
 506   `(defun ,(make-od-name 'cp852->string accessor) (array astart aend)
 507     (,(make-od-name 'latin->string accessor) array astart aend #'cp852->code-mapper)))
 508
 509 (instantiate-octets-definition define-cp852->string)
 510
 511 (add-external-format-funs '(:cp852 :|cp852|)
 512                           '(cp852->string-aref string->cp852))
 513
 514 (define-external-format (:cp852 :|cp852|)
 515     1 t
 516     (let ((cp852-byte (code->cp852-mapper bits)))
 517       (if cp852-byte
 518           (setf (sap-ref-8 sap tail) cp852-byte)
 519           (external-format-encoding-error stream bits)))
 520     (let ((code (cp852->code-mapper byte)))
 521       (if code
 522           (code-char code)
 523           (external-format-decoding-error stream byte)))) ;; TODO -- error check
 524
 525 (define-unibyte-mapper cp855->code-mapper code->cp855-mapper
 526   (#x80 #x0452) ; CYRILLIC SMALL LETTER DJE
 527   (#x81 #x0402) ; CYRILLIC CAPITAL LETTER DJE
 528   (#x82 #x0453) ; CYRILLIC SMALL LETTER GJE
 529   (#x83 #x0403) ; CYRILLIC CAPITAL LETTER GJE
 530   (#x84 #x0451) ; CYRILLIC SMALL LETTER IO
 531   (#x85 #x0401) ; CYRILLIC CAPITAL LETTER IO
 532   (#x86 #x0454) ; CYRILLIC SMALL LETTER UKRAINIAN IE
 533   (#x87 #x0404) ; CYRILLIC CAPITAL LETTER UKRAINIAN IE
 534   (#x88 #x0455) ; CYRILLIC SMALL LETTER DZE
 535   (#x89 #x0405) ; CYRILLIC CAPITAL LETTER DZE
 536   (#x8A #x0456) ; CYRILLIC SMALL LETTER BYELORUSSIAN-UKRAINIAN I
 537   (#x8B #x0406) ; CYRILLIC CAPITAL LETTER BYELORUSSIAN-UKRAINIAN I
 538   (#x8C #x0457) ; CYRILLIC SMALL LETTER YI
 539   (#x8D #x0407) ; CYRILLIC CAPITAL LETTER YI
 540   (#x8E #x0458) ; CYRILLIC SMALL LETTER JE
 541   (#x8F #x0408) ; CYRILLIC CAPITAL LETTER JE
 542   (#x90 #x0459) ; CYRILLIC SMALL LETTER LJE
 543   (#x91 #x0409) ; CYRILLIC CAPITAL LETTER LJE
 544   (#x92 #x045A) ; CYRILLIC SMALL LETTER NJE
 545   (#x93 #x040A) ; CYRILLIC CAPITAL LETTER NJE
 546   (#x94 #x045B) ; CYRILLIC SMALL LETTER TSHE
 547   (#x95 #x040B) ; CYRILLIC CAPITAL LETTER TSHE
 548   (#x96 #x045C) ; CYRILLIC SMALL LETTER KJE
 549   (#x97 #x040C) ; CYRILLIC CAPITAL LETTER KJE
 550   (#x98 #x045E) ; CYRILLIC SMALL LETTER SHORT U
 551   (#x99 #x040E) ; CYRILLIC CAPITAL LETTER SHORT U
 552   (#x9A #x045F) ; CYRILLIC SMALL LETTER DZHE
 553   (#x9B #x040F) ; CYRILLIC CAPITAL LETTER DZHE
 554   (#x9C #x044E) ; CYRILLIC SMALL LETTER YU
 555   (#x9D #x042E) ; CYRILLIC CAPITAL LETTER YU
 556   (#x9E #x044A) ; CYRILLIC SMALL LETTER HARD SIGN
 557   (#x9F #x042A) ; CYRILLIC CAPITAL LETTER HARD SIGN
 558   (#xA0 #x0430) ; CYRILLIC SMALL LETTER A
 559   (#xA1 #x0410) ; CYRILLIC CAPITAL LETTER A
 560   (#xA2 #x0431) ; CYRILLIC SMALL LETTER BE
 561   (#xA3 #x0411) ; CYRILLIC CAPITAL LETTER BE
 562   (#xA4 #x0446) ; CYRILLIC SMALL LETTER TSE
 563   (#xA5 #x0426) ; CYRILLIC CAPITAL LETTER TSE
 564   (#xA6 #x0434) ; CYRILLIC SMALL LETTER DE
 565   (#xA7 #x0414) ; CYRILLIC CAPITAL LETTER DE
 566   (#xA8 #x0435) ; CYRILLIC SMALL LETTER IE
 567   (#xA9 #x0415) ; CYRILLIC CAPITAL LETTER IE
 568   (#xAA #x0444) ; CYRILLIC SMALL LETTER EF
 569   (#xAB #x0424) ; CYRILLIC CAPITAL LETTER EF
 570   (#xAC #x0433) ; CYRILLIC SMALL LETTER GHE
 571   (#xAD #x0413) ; CYRILLIC CAPITAL LETTER GHE
 572   (#xAE #x00AB) ; LEFT-POINTING DOUBLE ANGLE QUOTATION MARK
 573   (#xAF #x00BB) ; RIGHT-POINTING DOUBLE ANGLE QUOTATION MARK
 574   (#xB0 #x2591) ; LIGHT SHADE
 575   (#xB1 #x2592) ; MEDIUM SHADE
 576   (#xB2 #x2593) ; DARK SHADE
 577   (#xB3 #x2502) ; BOX DRAWINGS LIGHT VERTICAL
 578   (#xB4 #x2524) ; BOX DRAWINGS LIGHT VERTICAL AND LEFT
 579   (#xB5 #x0445) ; CYRILLIC SMALL LETTER HA
 580   (#xB6 #x0425) ; CYRILLIC CAPITAL LETTER HA
 581   (#xB7 #x0438) ; CYRILLIC SMALL LETTER I
 582   (#xB8 #x0418) ; CYRILLIC CAPITAL LETTER I
 583   (#xB9 #x2563) ; BOX DRAWINGS DOUBLE VERTICAL AND LEFT
 584   (#xBA #x2551) ; BOX DRAWINGS DOUBLE VERTICAL
 585   (#xBB #x2557) ; BOX DRAWINGS DOUBLE DOWN AND LEFT
 586   (#xBC #x255D) ; BOX DRAWINGS DOUBLE UP AND LEFT
 587   (#xBD #x0439) ; CYRILLIC SMALL LETTER SHORT I
 588   (#xBE #x0419) ; CYRILLIC CAPITAL LETTER SHORT I
 589   (#xBF #x2510) ; BOX DRAWINGS LIGHT DOWN AND LEFT
 590   (#xC0 #x2514) ; BOX DRAWINGS LIGHT UP AND RIGHT
 591   (#xC1 #x2534) ; BOX DRAWINGS LIGHT UP AND HORIZONTAL
 592   (#xC2 #x252C) ; BOX DRAWINGS LIGHT DOWN AND HORIZONTAL
 593   (#xC3 #x251C) ; BOX DRAWINGS LIGHT VERTICAL AND RIGHT
 594   (#xC4 #x2500) ; BOX DRAWINGS LIGHT HORIZONTAL
 595   (#xC5 #x253C) ; BOX DRAWINGS LIGHT VERTICAL AND HORIZONTAL
 596   (#xC6 #x043A) ; CYRILLIC SMALL LETTER KA
 597   (#xC7 #x041A) ; CYRILLIC CAPITAL LETTER KA
 598   (#xC8 #x255A) ; BOX DRAWINGS DOUBLE UP AND RIGHT
 599   (#xC9 #x2554) ; BOX DRAWINGS DOUBLE DOWN AND RIGHT
 600   (#xCA #x2569) ; BOX DRAWINGS DOUBLE UP AND HORIZONTAL
 601   (#xCB #x2566) ; BOX DRAWINGS DOUBLE DOWN AND HORIZONTAL
 602   (#xCC #x2560) ; BOX DRAWINGS DOUBLE VERTICAL AND RIGHT
 603   (#xCD #x2550) ; BOX DRAWINGS DOUBLE HORIZONTAL
 604   (#xCE #x256C) ; BOX DRAWINGS DOUBLE VERTICAL AND HORIZONTAL
 605   (#xCF #x00A4) ; CURRENCY SIGN
 606   (#xD0 #x043B) ; CYRILLIC SMALL LETTER EL
 607   (#xD1 #x041B) ; CYRILLIC CAPITAL LETTER EL
 608   (#xD2 #x043C) ; CYRILLIC SMALL LETTER EM
 609   (#xD3 #x041C) ; CYRILLIC CAPITAL LETTER EM
 610   (#xD4 #x043D) ; CYRILLIC SMALL LETTER EN
 611   (#xD5 #x041D) ; CYRILLIC CAPITAL LETTER EN
 612   (#xD6 #x043E) ; CYRILLIC SMALL LETTER O
 613   (#xD7 #x041E) ; CYRILLIC CAPITAL LETTER O
 614   (#xD8 #x043F) ; CYRILLIC SMALL LETTER PE
 615   (#xD9 #x2518) ; BOX DRAWINGS LIGHT UP AND LEFT
 616   (#xDA #x250C) ; BOX DRAWINGS LIGHT DOWN AND RIGHT
 617   (#xDB #x2588) ; FULL BLOCK
 618   (#xDC #x2584) ; LOWER HALF BLOCK
 619   (#xDD #x041F) ; CYRILLIC CAPITAL LETTER PE
 620   (#xDE #x044F) ; CYRILLIC SMALL LETTER YA
 621   (#xDF #x2580) ; UPPER HALF BLOCK
 622   (#xE0 #x042F) ; CYRILLIC CAPITAL LETTER YA
 623   (#xE1 #x0440) ; CYRILLIC SMALL LETTER ER
 624   (#xE2 #x0420) ; CYRILLIC CAPITAL LETTER ER
 625   (#xE3 #x0441) ; CYRILLIC SMALL LETTER ES
 626   (#xE4 #x0421) ; CYRILLIC CAPITAL LETTER ES
 627   (#xE5 #x0442) ; CYRILLIC SMALL LETTER TE
 628   (#xE6 #x0422) ; CYRILLIC CAPITAL LETTER TE
 629   (#xE7 #x0443) ; CYRILLIC SMALL LETTER U
 630   (#xE8 #x0423) ; CYRILLIC CAPITAL LETTER U
 631   (#xE9 #x0436) ; CYRILLIC SMALL LETTER ZHE
 632   (#xEA #x0416) ; CYRILLIC CAPITAL LETTER ZHE
 633   (#xEB #x0432) ; CYRILLIC SMALL LETTER VE
 634   (#xEC #x0412) ; CYRILLIC CAPITAL LETTER VE
 635   (#xED #x044C) ; CYRILLIC SMALL LETTER SOFT SIGN
 636   (#xEE #x042C) ; CYRILLIC CAPITAL LETTER SOFT SIGN
 637   (#xEF #x2116) ; NUMERO SIGN
 638   (#xF0 #x00AD) ; SOFT HYPHEN
 639   (#xF1 #x044B) ; CYRILLIC SMALL LETTER YERU
 640   (#xF2 #x042B) ; CYRILLIC CAPITAL LETTER YERU
 641   (#xF3 #x0437) ; CYRILLIC SMALL LETTER ZE
 642   (#xF4 #x0417) ; CYRILLIC CAPITAL LETTER ZE
 643   (#xF5 #x0448) ; CYRILLIC SMALL LETTER SHA
 644   (#xF6 #x0428) ; CYRILLIC CAPITAL LETTER SHA
 645   (#xF7 #x044D) ; CYRILLIC SMALL LETTER E
 646   (#xF8 #x042D) ; CYRILLIC CAPITAL LETTER E
 647   (#xF9 #x0449) ; CYRILLIC SMALL LETTER SHCHA
 648   (#xFA #x0429) ; CYRILLIC CAPITAL LETTER SHCHA
 649   (#xFB #x0447) ; CYRILLIC SMALL LETTER CHE
 650   (#xFC #x0427) ; CYRILLIC CAPITAL LETTER CHE
 651   (#xFD #x00A7) ; SECTION SIGN
 652   (#xFE #x25A0) ; BLACK SQUARE
 653   (#xFF #x00A0) ; NO-BREAK SPACE
 654 )
 655
 656 (declaim (inline get-cp855-bytes))
 657 (defun get-cp855-bytes (string pos)
 658   (declare (optimize speed (safety 0))
 659            (type simple-string string)
 660            (type array-range pos))
 661   (get-latin-bytes #'code->cp855-mapper :cp855 string pos))
 662
 663 (defun string->cp855 (string sstart send null-padding)
 664   (declare (optimize speed (safety 0))
 665            (type simple-string string)
 666            (type array-range sstart send))
 667   (values (string->latin% string sstart send #'get-cp855-bytes null-padding)))
 668
 669 (defmacro define-cp855->string* (accessor type)
 670   (declare (ignore type))
 671   (let ((name (make-od-name 'cp855->string* accessor)))
 672     `(progn
 673       (defun ,name (string sstart send array astart aend)
 674         (,(make-od-name 'latin->string* accessor) string sstart send array astart aend #'cp855->code-mapper)))))
 675
 676 (instantiate-octets-definition define-cp855->string*)
 677
 678 (defmacro define-cp855->string (accessor type)
 679   (declare (ignore type))
 680   `(defun ,(make-od-name 'cp855->string accessor) (array astart aend)
 681     (,(make-od-name 'latin->string accessor) array astart aend #'cp855->code-mapper)))
 682
 683 (instantiate-octets-definition define-cp855->string)
 684
 685 (add-external-format-funs '(:cp855 :|cp855|)
 686                           '(cp855->string-aref string->cp855))
 687
 688 (define-external-format (:cp855 :|cp855|)
 689     1 t
 690     (let ((cp855-byte (code->cp855-mapper bits)))
 691       (if cp855-byte
 692           (setf (sap-ref-8 sap tail) cp855-byte)
 693           (external-format-encoding-error stream bits)))
 694     (let ((code (cp855->code-mapper byte)))
 695       (if code
 696           (code-char code)
 697           (external-format-decoding-error stream byte)))) ;; TODO -- error check
 698
 699 (define-unibyte-mapper cp857->code-mapper code->cp857-mapper
 700   (#x80 #x00C7) ; LATIN CAPITAL LETTER C WITH CEDILLA
 701   (#x81 #x00FC) ; LATIN SMALL LETTER U WITH DIAERESIS
 702   (#x82 #x00E9) ; LATIN SMALL LETTER E WITH ACUTE
 703   (#x83 #x00E2) ; LATIN SMALL LETTER A WITH CIRCUMFLEX
 704   (#x84 #x00E4) ; LATIN SMALL LETTER A WITH DIAERESIS
 705   (#x85 #x00E0) ; LATIN SMALL LETTER A WITH GRAVE
 706   (#x86 #x00E5) ; LATIN SMALL LETTER A WITH RING ABOVE
 707   (#x87 #x00E7) ; LATIN SMALL LETTER C WITH CEDILLA
 708   (#x88 #x00EA) ; LATIN SMALL LETTER E WITH CIRCUMFLEX
 709   (#x89 #x00EB) ; LATIN SMALL LETTER E WITH DIAERESIS
 710   (#x8A #x00E8) ; LATIN SMALL LETTER E WITH GRAVE
 711   (#x8B #x00EF) ; LATIN SMALL LETTER I WITH DIAERESIS
 712   (#x8C #x00EE) ; LATIN SMALL LETTER I WITH CIRCUMFLEX
 713   (#x8D #x0131) ; LATIN SMALL LETTER DOTLESS I
 714   (#x8E #x00C4) ; LATIN CAPITAL LETTER A WITH DIAERESIS
 715   (#x8F #x00C5) ; LATIN CAPITAL LETTER A WITH RING ABOVE
 716   (#x90 #x00C9) ; LATIN CAPITAL LETTER E WITH ACUTE
 717   (#x91 #x00E6) ; LATIN SMALL LIGATURE AE
 718   (#x92 #x00C6) ; LATIN CAPITAL LIGATURE AE
 719   (#x93 #x00F4) ; LATIN SMALL LETTER O WITH CIRCUMFLEX
 720   (#x94 #x00F6) ; LATIN SMALL LETTER O WITH DIAERESIS
 721   (#x95 #x00F2) ; LATIN SMALL LETTER O WITH GRAVE
 722   (#x96 #x00FB) ; LATIN SMALL LETTER U WITH CIRCUMFLEX
 723   (#x97 #x00F9) ; LATIN SMALL LETTER U WITH GRAVE
 724   (#x98 #x0130) ; LATIN CAPITAL LETTER I WITH DOT ABOVE
 725   (#x99 #x00D6) ; LATIN CAPITAL LETTER O WITH DIAERESIS
 726   (#x9A #x00DC) ; LATIN CAPITAL LETTER U WITH DIAERESIS
 727   (#x9B #x00F8) ; LATIN SMALL LETTER O WITH STROKE
 728   (#x9C #x00A3) ; POUND SIGN
 729   (#x9D #x00D8) ; LATIN CAPITAL LETTER O WITH STROKE
 730   (#x9E #x015E) ; LATIN CAPITAL LETTER S WITH CEDILLA
 731   (#x9F #x015F) ; LATIN SMALL LETTER S WITH CEDILLA
 732   (#xA0 #x00E1) ; LATIN SMALL LETTER A WITH ACUTE
 733   (#xA1 #x00ED) ; LATIN SMALL LETTER I WITH ACUTE
 734   (#xA2 #x00F3) ; LATIN SMALL LETTER O WITH ACUTE
 735   (#xA3 #x00FA) ; LATIN SMALL LETTER U WITH ACUTE
 736   (#xA4 #x00F1) ; LATIN SMALL LETTER N WITH TILDE
 737   (#xA5 #x00D1) ; LATIN CAPITAL LETTER N WITH TILDE
 738   (#xA6 #x011E) ; LATIN CAPITAL LETTER G WITH BREVE
 739   (#xA7 #x011F) ; LATIN SMALL LETTER G WITH BREVE
 740   (#xA8 #x00BF) ; INVERTED QUESTION MARK
 741   (#xA9 #x00AE) ; REGISTERED SIGN
 742   (#xAA #x00AC) ; NOT SIGN
 743   (#xAB #x00BD) ; VULGAR FRACTION ONE HALF
 744   (#xAC #x00BC) ; VULGAR FRACTION ONE QUARTER
 745   (#xAD #x00A1) ; INVERTED EXCLAMATION MARK
 746   (#xAE #x00AB) ; LEFT-POINTING DOUBLE ANGLE QUOTATION MARK
 747   (#xAF #x00BB) ; RIGHT-POINTING DOUBLE ANGLE QUOTATION MARK
 748   (#xB0 #x2591) ; LIGHT SHADE
 749   (#xB1 #x2592) ; MEDIUM SHADE
 750   (#xB2 #x2593) ; DARK SHADE
 751   (#xB3 #x2502) ; BOX DRAWINGS LIGHT VERTICAL
 752   (#xB4 #x2524) ; BOX DRAWINGS LIGHT VERTICAL AND LEFT
 753   (#xB5 #x00C1) ; LATIN CAPITAL LETTER A WITH ACUTE
 754   (#xB6 #x00C2) ; LATIN CAPITAL LETTER A WITH CIRCUMFLEX
 755   (#xB7 #x00C0) ; LATIN CAPITAL LETTER A WITH GRAVE
 756   (#xB8 #x00A9) ; COPYRIGHT SIGN
 757   (#xB9 #x2563) ; BOX DRAWINGS DOUBLE VERTICAL AND LEFT
 758   (#xBA #x2551) ; BOX DRAWINGS DOUBLE VERTICAL
 759   (#xBB #x2557) ; BOX DRAWINGS DOUBLE DOWN AND LEFT
 760   (#xBC #x255D) ; BOX DRAWINGS DOUBLE UP AND LEFT
 761   (#xBD #x00A2) ; CENT SIGN
 762   (#xBE #x00A5) ; YEN SIGN
 763   (#xBF #x2510) ; BOX DRAWINGS LIGHT DOWN AND LEFT
 764   (#xC0 #x2514) ; BOX DRAWINGS LIGHT UP AND RIGHT
 765   (#xC1 #x2534) ; BOX DRAWINGS LIGHT UP AND HORIZONTAL
 766   (#xC2 #x252C) ; BOX DRAWINGS LIGHT DOWN AND HORIZONTAL
 767   (#xC3 #x251C) ; BOX DRAWINGS LIGHT VERTICAL AND RIGHT
 768   (#xC4 #x2500) ; BOX DRAWINGS LIGHT HORIZONTAL
 769   (#xC5 #x253C) ; BOX DRAWINGS LIGHT VERTICAL AND HORIZONTAL
 770   (#xC6 #x00E3) ; LATIN SMALL LETTER A WITH TILDE
 771   (#xC7 #x00C3) ; LATIN CAPITAL LETTER A WITH TILDE
 772   (#xC8 #x255A) ; BOX DRAWINGS DOUBLE UP AND RIGHT
 773   (#xC9 #x2554) ; BOX DRAWINGS DOUBLE DOWN AND RIGHT
 774   (#xCA #x2569) ; BOX DRAWINGS DOUBLE UP AND HORIZONTAL
 775   (#xCB #x2566) ; BOX DRAWINGS DOUBLE DOWN AND HORIZONTAL
 776   (#xCC #x2560) ; BOX DRAWINGS DOUBLE VERTICAL AND RIGHT
 777   (#xCD #x2550) ; BOX DRAWINGS DOUBLE HORIZONTAL
 778   (#xCE #x256C) ; BOX DRAWINGS DOUBLE VERTICAL AND HORIZONTAL
 779   (#xCF #x00A4) ; CURRENCY SIGN
 780   (#xD0 #x00BA) ; MASCULINE ORDINAL INDICATOR
 781   (#xD1 #x00AA) ; FEMININE ORDINAL INDICATOR
 782   (#xD2 #x00CA) ; LATIN CAPITAL LETTER E WITH CIRCUMFLEX
 783   (#xD3 #x00CB) ; LATIN CAPITAL LETTER E WITH DIAERESIS
 784   (#xD4 #x00C8) ; LATIN CAPITAL LETTER E WITH GRAVE
 785   (#xD5 nil)
 786   (#xD6 #x00CD) ; LATIN CAPITAL LETTER I WITH ACUTE
 787   (#xD7 #x00CE) ; LATIN CAPITAL LETTER I WITH CIRCUMFLEX
 788   (#xD8 #x00CF) ; LATIN CAPITAL LETTER I WITH DIAERESIS
 789   (#xD9 #x2518) ; BOX DRAWINGS LIGHT UP AND LEFT
 790   (#xDA #x250C) ; BOX DRAWINGS LIGHT DOWN AND RIGHT
 791   (#xDB #x2588) ; FULL BLOCK
 792   (#xDC #x2584) ; LOWER HALF BLOCK
 793   (#xDD #x00A6) ; BROKEN BAR
 794   (#xDE #x00CC) ; LATIN CAPITAL LETTER I WITH GRAVE
 795   (#xDF #x2580) ; UPPER HALF BLOCK
 796   (#xE0 #x00D3) ; LATIN CAPITAL LETTER O WITH ACUTE
 797   (#xE1 #x00DF) ; LATIN SMALL LETTER SHARP S
 798   (#xE2 #x00D4) ; LATIN CAPITAL LETTER O WITH CIRCUMFLEX
 799   (#xE3 #x00D2) ; LATIN CAPITAL LETTER O WITH GRAVE
 800   (#xE4 #x00F5) ; LATIN SMALL LETTER O WITH TILDE
 801   (#xE5 #x00D5) ; LATIN CAPITAL LETTER O WITH TILDE
 802   (#xE6 #x00B5) ; MICRO SIGN
 803   (#xE7 nil)
 804   (#xE8 #x00D7) ; MULTIPLICATION SIGN
 805   (#xE9 #x00DA) ; LATIN CAPITAL LETTER U WITH ACUTE
 806   (#xEA #x00DB) ; LATIN CAPITAL LETTER U WITH CIRCUMFLEX
 807   (#xEB #x00D9) ; LATIN CAPITAL LETTER U WITH GRAVE
 808   (#xED #x00FF) ; LATIN SMALL LETTER Y WITH DIAERESIS
 809   (#xEE #x00AF) ; MACRON
 810   (#xEF #x00B4) ; ACUTE ACCENT
 811   (#xF0 #x00AD) ; SOFT HYPHEN
 812   (#xF1 #x00B1) ; PLUS-MINUS SIGN
 813   (#xF2 nil)
 814   (#xF3 #x00BE) ; VULGAR FRACTION THREE QUARTERS
 815   (#xF4 #x00B6) ; PILCROW SIGN
 816   (#xF5 #x00A7) ; SECTION SIGN
 817   (#xF6 #x00F7) ; DIVISION SIGN
 818   (#xF7 #x00B8) ; CEDILLA
 819   (#xF8 #x00B0) ; DEGREE SIGN
 820   (#xF9 #x00A8) ; DIAERESIS
 821   (#xFA #x00B7) ; MIDDLE DOT
 822   (#xFB #x00B9) ; SUPERSCRIPT ONE
 823   (#xFC #x00B3) ; SUPERSCRIPT THREE
 824   (#xFD #x00B2) ; SUPERSCRIPT TWO
 825   (#xFE #x25A0) ; BLACK SQUARE
 826   (#xFF #x00A0) ; NO-BREAK SPACE
 827 )
 828
 829 (declaim (inline get-cp857-bytes))
 830 (defun get-cp857-bytes (string pos)
 831   (declare (optimize speed (safety 0))
 832            (type simple-string string)
 833            (type array-range pos))
 834   (get-latin-bytes #'code->cp857-mapper :cp857 string pos))
 835
 836 (defun string->cp857 (string sstart send null-padding)
 837   (declare (optimize speed (safety 0))
 838            (type simple-string string)
 839            (type array-range sstart send))
 840   (values (string->latin% string sstart send #'get-cp857-bytes null-padding)))
 841
 842 (defmacro define-cp857->string* (accessor type)
 843   (declare (ignore type))
 844   (let ((name (make-od-name 'cp857->string* accessor)))
 845     `(progn
 846       (defun ,name (string sstart send array astart aend)
 847         (,(make-od-name 'latin->string* accessor) string sstart send array astart aend #'cp857->code-mapper)))))
 848
 849 (instantiate-octets-definition define-cp857->string*)
 850
 851 (defmacro define-cp857->string (accessor type)
 852   (declare (ignore type))
 853   `(defun ,(make-od-name 'cp857->string accessor) (array astart aend)
 854     (,(make-od-name 'latin->string accessor) array astart aend #'cp857->code-mapper)))
 855
 856 (instantiate-octets-definition define-cp857->string)
 857
 858 (add-external-format-funs '(:cp857 :|cp857|)
 859                           '(cp857->string-aref string->cp857))
 860
 861 (define-external-format (:cp857 :|cp857|)
 862     1 t
 863     (let ((cp857-byte (code->cp857-mapper bits)))
 864       (if cp857-byte
 865           (setf (sap-ref-8 sap tail) cp857-byte)
 866           (external-format-encoding-error stream bits)))
 867     (let ((code (cp857->code-mapper byte)))
 868       (if code
 869           (code-char code)
 870           (external-format-decoding-error stream byte)))) ;; TODO -- error check
 871
 872 (define-unibyte-mapper cp860->code-mapper code->cp860-mapper
 873   (#x80 #x00C7) ; LATIN CAPITAL LETTER C WITH CEDILLA
 874   (#x81 #x00FC) ; LATIN SMALL LETTER U WITH DIAERESIS
 875   (#x82 #x00E9) ; LATIN SMALL LETTER E WITH ACUTE
 876   (#x83 #x00E2) ; LATIN SMALL LETTER A WITH CIRCUMFLEX
 877   (#x84 #x00E3) ; LATIN SMALL LETTER A WITH TILDE
 878   (#x85 #x00E0) ; LATIN SMALL LETTER A WITH GRAVE
 879   (#x86 #x00C1) ; LATIN CAPITAL LETTER A WITH ACUTE
 880   (#x87 #x00E7) ; LATIN SMALL LETTER C WITH CEDILLA
 881   (#x88 #x00EA) ; LATIN SMALL LETTER E WITH CIRCUMFLEX
 882   (#x89 #x00CA) ; LATIN CAPITAL LETTER E WITH CIRCUMFLEX
 883   (#x8A #x00E8) ; LATIN SMALL LETTER E WITH GRAVE
 884   (#x8B #x00CD) ; LATIN CAPITAL LETTER I WITH ACUTE
 885   (#x8C #x00D4) ; LATIN CAPITAL LETTER O WITH CIRCUMFLEX
 886   (#x8D #x00EC) ; LATIN SMALL LETTER I WITH GRAVE
 887   (#x8E #x00C3) ; LATIN CAPITAL LETTER A WITH TILDE
 888   (#x8F #x00C2) ; LATIN CAPITAL LETTER A WITH CIRCUMFLEX
 889   (#x90 #x00C9) ; LATIN CAPITAL LETTER E WITH ACUTE
 890   (#x91 #x00C0) ; LATIN CAPITAL LETTER A WITH GRAVE
 891   (#x92 #x00C8) ; LATIN CAPITAL LETTER E WITH GRAVE
 892   (#x93 #x00F4) ; LATIN SMALL LETTER O WITH CIRCUMFLEX
 893   (#x94 #x00F5) ; LATIN SMALL LETTER O WITH TILDE
 894   (#x95 #x00F2) ; LATIN SMALL LETTER O WITH GRAVE
 895   (#x96 #x00DA) ; LATIN CAPITAL LETTER U WITH ACUTE
 896   (#x97 #x00F9) ; LATIN SMALL LETTER U WITH GRAVE
 897   (#x98 #x00CC) ; LATIN CAPITAL LETTER I WITH GRAVE
 898   (#x99 #x00D5) ; LATIN CAPITAL LETTER O WITH TILDE
 899   (#x9A #x00DC) ; LATIN CAPITAL LETTER U WITH DIAERESIS
 900   (#x9B #x00A2) ; CENT SIGN
 901   (#x9C #x00A3) ; POUND SIGN
 902   (#x9D #x00D9) ; LATIN CAPITAL LETTER U WITH GRAVE
 903   (#x9E #x20A7) ; PESETA SIGN
 904   (#x9F #x00D3) ; LATIN CAPITAL LETTER O WITH ACUTE
 905   (#xA0 #x00E1) ; LATIN SMALL LETTER A WITH ACUTE
 906   (#xA1 #x00ED) ; LATIN SMALL LETTER I WITH ACUTE
 907   (#xA2 #x00F3) ; LATIN SMALL LETTER O WITH ACUTE
 908   (#xA3 #x00FA) ; LATIN SMALL LETTER U WITH ACUTE
 909   (#xA4 #x00F1) ; LATIN SMALL LETTER N WITH TILDE
 910   (#xA5 #x00D1) ; LATIN CAPITAL LETTER N WITH TILDE
 911   (#xA6 #x00AA) ; FEMININE ORDINAL INDICATOR
 912   (#xA7 #x00BA) ; MASCULINE ORDINAL INDICATOR
 913   (#xA8 #x00BF) ; INVERTED QUESTION MARK
 914   (#xA9 #x00D2) ; LATIN CAPITAL LETTER O WITH GRAVE
 915   (#xAA #x00AC) ; NOT SIGN
 916   (#xAB #x00BD) ; VULGAR FRACTION ONE HALF
 917   (#xAC #x00BC) ; VULGAR FRACTION ONE QUARTER
 918   (#xAD #x00A1) ; INVERTED EXCLAMATION MARK
 919   (#xAE #x00AB) ; LEFT-POINTING DOUBLE ANGLE QUOTATION MARK
 920   (#xAF #x00BB) ; RIGHT-POINTING DOUBLE ANGLE QUOTATION MARK
 921   (#xB0 #x2591) ; LIGHT SHADE
 922   (#xB1 #x2592) ; MEDIUM SHADE
 923   (#xB2 #x2593) ; DARK SHADE
 924   (#xB3 #x2502) ; BOX DRAWINGS LIGHT VERTICAL
 925   (#xB4 #x2524) ; BOX DRAWINGS LIGHT VERTICAL AND LEFT
 926   (#xB5 #x2561) ; BOX DRAWINGS VERTICAL SINGLE AND LEFT DOUBLE
 927   (#xB6 #x2562) ; BOX DRAWINGS VERTICAL DOUBLE AND LEFT SINGLE
 928   (#xB7 #x2556) ; BOX DRAWINGS DOWN DOUBLE AND LEFT SINGLE
 929   (#xB8 #x2555) ; BOX DRAWINGS DOWN SINGLE AND LEFT DOUBLE
 930   (#xB9 #x2563) ; BOX DRAWINGS DOUBLE VERTICAL AND LEFT
 931   (#xBA #x2551) ; BOX DRAWINGS DOUBLE VERTICAL
 932   (#xBB #x2557) ; BOX DRAWINGS DOUBLE DOWN AND LEFT
 933   (#xBC #x255D) ; BOX DRAWINGS DOUBLE UP AND LEFT
 934   (#xBD #x255C) ; BOX DRAWINGS UP DOUBLE AND LEFT SINGLE
 935   (#xBE #x255B) ; BOX DRAWINGS UP SINGLE AND LEFT DOUBLE
 936   (#xBF #x2510) ; BOX DRAWINGS LIGHT DOWN AND LEFT
 937   (#xC0 #x2514) ; BOX DRAWINGS LIGHT UP AND RIGHT
 938   (#xC1 #x2534) ; BOX DRAWINGS LIGHT UP AND HORIZONTAL
 939   (#xC2 #x252C) ; BOX DRAWINGS LIGHT DOWN AND HORIZONTAL
 940   (#xC3 #x251C) ; BOX DRAWINGS LIGHT VERTICAL AND RIGHT
 941   (#xC4 #x2500) ; BOX DRAWINGS LIGHT HORIZONTAL
 942   (#xC5 #x253C) ; BOX DRAWINGS LIGHT VERTICAL AND HORIZONTAL
 943   (#xC6 #x255E) ; BOX DRAWINGS VERTICAL SINGLE AND RIGHT DOUBLE
 944   (#xC7 #x255F) ; BOX DRAWINGS VERTICAL DOUBLE AND RIGHT SINGLE
 945   (#xC8 #x255A) ; BOX DRAWINGS DOUBLE UP AND RIGHT
 946   (#xC9 #x2554) ; BOX DRAWINGS DOUBLE DOWN AND RIGHT
 947   (#xCA #x2569) ; BOX DRAWINGS DOUBLE UP AND HORIZONTAL
 948   (#xCB #x2566) ; BOX DRAWINGS DOUBLE DOWN AND HORIZONTAL
 949   (#xCC #x2560) ; BOX DRAWINGS DOUBLE VERTICAL AND RIGHT
 950   (#xCD #x2550) ; BOX DRAWINGS DOUBLE HORIZONTAL
 951   (#xCE #x256C) ; BOX DRAWINGS DOUBLE VERTICAL AND HORIZONTAL
 952   (#xCF #x2567) ; BOX DRAWINGS UP SINGLE AND HORIZONTAL DOUBLE
 953   (#xD0 #x2568) ; BOX DRAWINGS UP DOUBLE AND HORIZONTAL SINGLE
 954   (#xD1 #x2564) ; BOX DRAWINGS DOWN SINGLE AND HORIZONTAL DOUBLE
 955   (#xD2 #x2565) ; BOX DRAWINGS DOWN DOUBLE AND HORIZONTAL SINGLE
 956   (#xD3 #x2559) ; BOX DRAWINGS UP DOUBLE AND RIGHT SINGLE
 957   (#xD4 #x2558) ; BOX DRAWINGS UP SINGLE AND RIGHT DOUBLE
 958   (#xD5 #x2552) ; BOX DRAWINGS DOWN SINGLE AND RIGHT DOUBLE
 959   (#xD6 #x2553) ; BOX DRAWINGS DOWN DOUBLE AND RIGHT SINGLE
 960   (#xD7 #x256B) ; BOX DRAWINGS VERTICAL DOUBLE AND HORIZONTAL SINGLE
 961   (#xD8 #x256A) ; BOX DRAWINGS VERTICAL SINGLE AND HORIZONTAL DOUBLE
 962   (#xD9 #x2518) ; BOX DRAWINGS LIGHT UP AND LEFT
 963   (#xDA #x250C) ; BOX DRAWINGS LIGHT DOWN AND RIGHT
 964   (#xDB #x2588) ; FULL BLOCK
 965   (#xDC #x2584) ; LOWER HALF BLOCK
 966   (#xDD #x258C) ; LEFT HALF BLOCK
 967   (#xDE #x2590) ; RIGHT HALF BLOCK
 968   (#xDF #x2580) ; UPPER HALF BLOCK
 969   (#xE0 #x03B1) ; GREEK SMALL LETTER ALPHA
 970   (#xE1 #x00DF) ; LATIN SMALL LETTER SHARP S
 971   (#xE2 #x0393) ; GREEK CAPITAL LETTER GAMMA
 972   (#xE3 #x03C0) ; GREEK SMALL LETTER PI
 973   (#xE4 #x03A3) ; GREEK CAPITAL LETTER SIGMA
 974   (#xE5 #x03C3) ; GREEK SMALL LETTER SIGMA
 975   (#xE6 #x00B5) ; MICRO SIGN
 976   (#xE7 #x03C4) ; GREEK SMALL LETTER TAU
 977   (#xE8 #x03A6) ; GREEK CAPITAL LETTER PHI
 978   (#xE9 #x0398) ; GREEK CAPITAL LETTER THETA
 979   (#xEA #x03A9) ; GREEK CAPITAL LETTER OMEGA
 980   (#xEB #x03B4) ; GREEK SMALL LETTER DELTA
 981   (#xEC #x221E) ; INFINITY
 982   (#xED #x03C6) ; GREEK SMALL LETTER PHI
 983   (#xEE #x03B5) ; GREEK SMALL LETTER EPSILON
 984   (#xEF #x2229) ; INTERSECTION
 985   (#xF0 #x2261) ; IDENTICAL TO
 986   (#xF1 #x00B1) ; PLUS-MINUS SIGN
 987   (#xF2 #x2265) ; GREATER-THAN OR EQUAL TO
 988   (#xF3 #x2264) ; LESS-THAN OR EQUAL TO
 989   (#xF4 #x2320) ; TOP HALF INTEGRAL
 990   (#xF5 #x2321) ; BOTTOM HALF INTEGRAL
 991   (#xF6 #x00F7) ; DIVISION SIGN
 992   (#xF7 #x2248) ; ALMOST EQUAL TO
 993   (#xF8 #x00B0) ; DEGREE SIGN
 994   (#xF9 #x2219) ; BULLET OPERATOR
 995   (#xFA #x00B7) ; MIDDLE DOT
 996   (#xFB #x221A) ; SQUARE ROOT
 997   (#xFC #x207F) ; SUPERSCRIPT LATIN SMALL LETTER N
 998   (#xFD #x00B2) ; SUPERSCRIPT TWO
 999   (#xFE #x25A0) ; BLACK SQUARE
1000   (#xFF #x00A0) ; NO-BREAK SPACE
1001 )
1002
1003 (declaim (inline get-cp860-bytes))
1004 (defun get-cp860-bytes (string pos)
1005   (declare (optimize speed (safety 0))
1006            (type simple-string string)
1007            (type array-range pos))
1008   (get-latin-bytes #'code->cp860-mapper :cp860 string pos))
1009
1010 (defun string->cp860 (string sstart send null-padding)
1011   (declare (optimize speed (safety 0))
1012            (type simple-string string)
1013            (type array-range sstart send))
1014   (values (string->latin% string sstart send #'get-cp860-bytes null-padding)))
1015
1016 (defmacro define-cp860->string* (accessor type)
1017   (declare (ignore type))
1018   (let ((name (make-od-name 'cp860->string* accessor)))
1019     `(progn
1020       (defun ,name (string sstart send array astart aend)
1021         (,(make-od-name 'latin->string* accessor) string sstart send array astart aend #'cp860->code-mapper)))))
1022
1023 (instantiate-octets-definition define-cp860->string*)
1024
1025 (defmacro define-cp860->string (accessor type)
1026   (declare (ignore type))
1027   `(defun ,(make-od-name 'cp860->string accessor) (array astart aend)
1028     (,(make-od-name 'latin->string accessor) array astart aend #'cp860->code-mapper)))
1029
1030 (instantiate-octets-definition define-cp860->string)
1031
1032 (add-external-format-funs '(:cp860 :|cp860|)
1033                           '(cp860->string-aref string->cp860))
1034
1035 (define-external-format (:cp860 :|cp860|)
1036     1 t
1037     (let ((cp860-byte (code->cp860-mapper bits)))
1038       (if cp860-byte
1039           (setf (sap-ref-8 sap tail) cp860-byte)
1040           (external-format-encoding-error stream bits)))
1041     (let ((code (cp860->code-mapper byte)))
1042       (if code
1043           (code-char code)
1044           (external-format-decoding-error stream byte)))) ;; TODO -- error check
1045
1046 (define-unibyte-mapper cp861->code-mapper code->cp861-mapper
1047   (#x80 #x00C7) ; LATIN CAPITAL LETTER C WITH CEDILLA
1048   (#x81 #x00FC) ; LATIN SMALL LETTER U WITH DIAERESIS
1049   (#x82 #x00E9) ; LATIN SMALL LETTER E WITH ACUTE
1050   (#x83 #x00E2) ; LATIN SMALL LETTER A WITH CIRCUMFLEX
1051   (#x84 #x00E4) ; LATIN SMALL LETTER A WITH DIAERESIS
1052   (#x85 #x00E0) ; LATIN SMALL LETTER A WITH GRAVE
1053   (#x86 #x00E5) ; LATIN SMALL LETTER A WITH RING ABOVE
1054   (#x87 #x00E7) ; LATIN SMALL LETTER C WITH CEDILLA
1055   (#x88 #x00EA) ; LATIN SMALL LETTER E WITH CIRCUMFLEX
1056   (#x89 #x00EB) ; LATIN SMALL LETTER E WITH DIAERESIS
1057   (#x8A #x00E8) ; LATIN SMALL LETTER E WITH GRAVE
1058   (#x8B #x00D0) ; LATIN CAPITAL LETTER ETH
1059   (#x8C #x00F0) ; LATIN SMALL LETTER ETH
1060   (#x8D #x00DE) ; LATIN CAPITAL LETTER THORN
1061   (#x8E #x00C4) ; LATIN CAPITAL LETTER A WITH DIAERESIS
1062   (#x8F #x00C5) ; LATIN CAPITAL LETTER A WITH RING ABOVE
1063   (#x90 #x00C9) ; LATIN CAPITAL LETTER E WITH ACUTE
1064   (#x91 #x00E6) ; LATIN SMALL LIGATURE AE
1065   (#x92 #x00C6) ; LATIN CAPITAL LIGATURE AE
1066   (#x93 #x00F4) ; LATIN SMALL LETTER O WITH CIRCUMFLEX
1067   (#x94 #x00F6) ; LATIN SMALL LETTER O WITH DIAERESIS
1068   (#x95 #x00FE) ; LATIN SMALL LETTER THORN
1069   (#x96 #x00FB) ; LATIN SMALL LETTER U WITH CIRCUMFLEX
1070   (#x97 #x00DD) ; LATIN CAPITAL LETTER Y WITH ACUTE
1071   (#x98 #x00FD) ; LATIN SMALL LETTER Y WITH ACUTE
1072   (#x99 #x00D6) ; LATIN CAPITAL LETTER O WITH DIAERESIS
1073   (#x9A #x00DC) ; LATIN CAPITAL LETTER U WITH DIAERESIS
1074   (#x9B #x00F8) ; LATIN SMALL LETTER O WITH STROKE
1075   (#x9C #x00A3) ; POUND SIGN
1076   (#x9D #x00D8) ; LATIN CAPITAL LETTER O WITH STROKE
1077   (#x9E #x20A7) ; PESETA SIGN
1078   (#x9F #x0192) ; LATIN SMALL LETTER F WITH HOOK
1079   (#xA0 #x00E1) ; LATIN SMALL LETTER A WITH ACUTE
1080   (#xA1 #x00ED) ; LATIN SMALL LETTER I WITH ACUTE
1081   (#xA2 #x00F3) ; LATIN SMALL LETTER O WITH ACUTE
1082   (#xA3 #x00FA) ; LATIN SMALL LETTER U WITH ACUTE
1083   (#xA4 #x00C1) ; LATIN CAPITAL LETTER A WITH ACUTE
1084   (#xA5 #x00CD) ; LATIN CAPITAL LETTER I WITH ACUTE
1085   (#xA6 #x00D3) ; LATIN CAPITAL LETTER O WITH ACUTE
1086   (#xA7 #x00DA) ; LATIN CAPITAL LETTER U WITH ACUTE
1087   (#xA8 #x00BF) ; INVERTED QUESTION MARK
1088   (#xA9 #x2310) ; REVERSED NOT SIGN
1089   (#xAA #x00AC) ; NOT SIGN
1090   (#xAB #x00BD) ; VULGAR FRACTION ONE HALF
1091   (#xAC #x00BC) ; VULGAR FRACTION ONE QUARTER
1092   (#xAD #x00A1) ; INVERTED EXCLAMATION MARK
1093   (#xAE #x00AB) ; LEFT-POINTING DOUBLE ANGLE QUOTATION MARK
1094   (#xAF #x00BB) ; RIGHT-POINTING DOUBLE ANGLE QUOTATION MARK
1095   (#xB0 #x2591) ; LIGHT SHADE
1096   (#xB1 #x2592) ; MEDIUM SHADE
1097   (#xB2 #x2593) ; DARK SHADE
1098   (#xB3 #x2502) ; BOX DRAWINGS LIGHT VERTICAL
1099   (#xB4 #x2524) ; BOX DRAWINGS LIGHT VERTICAL AND LEFT
1100   (#xB5 #x2561) ; BOX DRAWINGS VERTICAL SINGLE AND LEFT DOUBLE
1101   (#xB6 #x2562) ; BOX DRAWINGS VERTICAL DOUBLE AND LEFT SINGLE
1102   (#xB7 #x2556) ; BOX DRAWINGS DOWN DOUBLE AND LEFT SINGLE
1103   (#xB8 #x2555) ; BOX DRAWINGS DOWN SINGLE AND LEFT DOUBLE
1104   (#xB9 #x2563) ; BOX DRAWINGS DOUBLE VERTICAL AND LEFT
1105   (#xBA #x2551) ; BOX DRAWINGS DOUBLE VERTICAL
1106   (#xBB #x2557) ; BOX DRAWINGS DOUBLE DOWN AND LEFT
1107   (#xBC #x255D) ; BOX DRAWINGS DOUBLE UP AND LEFT
1108   (#xBD #x255C) ; BOX DRAWINGS UP DOUBLE AND LEFT SINGLE
1109   (#xBE #x255B) ; BOX DRAWINGS UP SINGLE AND LEFT DOUBLE
1110   (#xBF #x2510) ; BOX DRAWINGS LIGHT DOWN AND LEFT
1111   (#xC0 #x2514) ; BOX DRAWINGS LIGHT UP AND RIGHT
1112   (#xC1 #x2534) ; BOX DRAWINGS LIGHT UP AND HORIZONTAL
1113   (#xC2 #x252C) ; BOX DRAWINGS LIGHT DOWN AND HORIZONTAL
1114   (#xC3 #x251C) ; BOX DRAWINGS LIGHT VERTICAL AND RIGHT
1115   (#xC4 #x2500) ; BOX DRAWINGS LIGHT HORIZONTAL
1116   (#xC5 #x253C) ; BOX DRAWINGS LIGHT VERTICAL AND HORIZONTAL
1117   (#xC6 #x255E) ; BOX DRAWINGS VERTICAL SINGLE AND RIGHT DOUBLE
1118   (#xC7 #x255F) ; BOX DRAWINGS VERTICAL DOUBLE AND RIGHT SINGLE
1119   (#xC8 #x255A) ; BOX DRAWINGS DOUBLE UP AND RIGHT
1120   (#xC9 #x2554) ; BOX DRAWINGS DOUBLE DOWN AND RIGHT
1121   (#xCA #x2569) ; BOX DRAWINGS DOUBLE UP AND HORIZONTAL
1122   (#xCB #x2566) ; BOX DRAWINGS DOUBLE DOWN AND HORIZONTAL
1123   (#xCC #x2560) ; BOX DRAWINGS DOUBLE VERTICAL AND RIGHT
1124   (#xCD #x2550) ; BOX DRAWINGS DOUBLE HORIZONTAL
1125   (#xCE #x256C) ; BOX DRAWINGS DOUBLE VERTICAL AND HORIZONTAL
1126   (#xCF #x2567) ; BOX DRAWINGS UP SINGLE AND HORIZONTAL DOUBLE
1127   (#xD0 #x2568) ; BOX DRAWINGS UP DOUBLE AND HORIZONTAL SINGLE
1128   (#xD1 #x2564) ; BOX DRAWINGS DOWN SINGLE AND HORIZONTAL DOUBLE
1129   (#xD2 #x2565) ; BOX DRAWINGS DOWN DOUBLE AND HORIZONTAL SINGLE
1130   (#xD3 #x2559) ; BOX DRAWINGS UP DOUBLE AND RIGHT SINGLE
1131   (#xD4 #x2558) ; BOX DRAWINGS UP SINGLE AND RIGHT DOUBLE
1132   (#xD5 #x2552) ; BOX DRAWINGS DOWN SINGLE AND RIGHT DOUBLE
1133   (#xD6 #x2553) ; BOX DRAWINGS DOWN DOUBLE AND RIGHT SINGLE
1134   (#xD7 #x256B) ; BOX DRAWINGS VERTICAL DOUBLE AND HORIZONTAL SINGLE
1135   (#xD8 #x256A) ; BOX DRAWINGS VERTICAL SINGLE AND HORIZONTAL DOUBLE
1136   (#xD9 #x2518) ; BOX DRAWINGS LIGHT UP AND LEFT
1137   (#xDA #x250C) ; BOX DRAWINGS LIGHT DOWN AND RIGHT
1138   (#xDB #x2588) ; FULL BLOCK
1139   (#xDC #x2584) ; LOWER HALF BLOCK
1140   (#xDD #x258C) ; LEFT HALF BLOCK
1141   (#xDE #x2590) ; RIGHT HALF BLOCK
1142   (#xDF #x2580) ; UPPER HALF BLOCK
1143   (#xE0 #x03B1) ; GREEK SMALL LETTER ALPHA
1144   (#xE1 #x00DF) ; LATIN SMALL LETTER SHARP S
1145   (#xE2 #x0393) ; GREEK CAPITAL LETTER GAMMA
1146   (#xE3 #x03C0) ; GREEK SMALL LETTER PI
1147   (#xE4 #x03A3) ; GREEK CAPITAL LETTER SIGMA
1148   (#xE5 #x03C3) ; GREEK SMALL LETTER SIGMA
1149   (#xE6 #x00B5) ; MICRO SIGN
1150   (#xE7 #x03C4) ; GREEK SMALL LETTER TAU
1151   (#xE8 #x03A6) ; GREEK CAPITAL LETTER PHI
1152   (#xE9 #x0398) ; GREEK CAPITAL LETTER THETA
1153   (#xEA #x03A9) ; GREEK CAPITAL LETTER OMEGA
1154   (#xEB #x03B4) ; GREEK SMALL LETTER DELTA
1155   (#xEC #x221E) ; INFINITY
1156   (#xED #x03C6) ; GREEK SMALL LETTER PHI
1157   (#xEE #x03B5) ; GREEK SMALL LETTER EPSILON
1158   (#xEF #x2229) ; INTERSECTION
1159   (#xF0 #x2261) ; IDENTICAL TO
1160   (#xF1 #x00B1) ; PLUS-MINUS SIGN
1161   (#xF2 #x2265) ; GREATER-THAN OR EQUAL TO
1162   (#xF3 #x2264) ; LESS-THAN OR EQUAL TO
1163   (#xF4 #x2320) ; TOP HALF INTEGRAL
1164   (#xF5 #x2321) ; BOTTOM HALF INTEGRAL
1165   (#xF6 #x00F7) ; DIVISION SIGN
1166   (#xF7 #x2248) ; ALMOST EQUAL TO
1167   (#xF8 #x00B0) ; DEGREE SIGN
1168   (#xF9 #x2219) ; BULLET OPERATOR
1169   (#xFA #x00B7) ; MIDDLE DOT
1170   (#xFB #x221A) ; SQUARE ROOT
1171   (#xFC #x207F) ; SUPERSCRIPT LATIN SMALL LETTER N
1172   (#xFD #x00B2) ; SUPERSCRIPT TWO
1173   (#xFE #x25A0) ; BLACK SQUARE
1174   (#xFF #x00A0) ; NO-BREAK SPACE
1175 )
1176
1177 (declaim (inline get-cp861-bytes))
1178 (defun get-cp861-bytes (string pos)
1179   (declare (optimize speed (safety 0))
1180            (type simple-string string)
1181            (type array-range pos))
1182   (get-latin-bytes #'code->cp861-mapper :cp861 string pos))
1183
1184 (defun string->cp861 (string sstart send null-padding)
1185   (declare (optimize speed (safety 0))
1186            (type simple-string string)
1187            (type array-range sstart send))
1188   (values (string->latin% string sstart send #'get-cp861-bytes null-padding)))
1189
1190 (defmacro define-cp861->string* (accessor type)
1191   (declare (ignore type))
1192   (let ((name (make-od-name 'cp861->string* accessor)))
1193     `(progn
1194       (defun ,name (string sstart send array astart aend)
1195         (,(make-od-name 'latin->string* accessor) string sstart send array astart aend #'cp861->code-mapper)))))
1196
1197 (instantiate-octets-definition define-cp861->string*)
1198
1199 (defmacro define-cp861->string (accessor type)
1200   (declare (ignore type))
1201   `(defun ,(make-od-name 'cp861->string accessor) (array astart aend)
1202     (,(make-od-name 'latin->string accessor) array astart aend #'cp861->code-mapper)))
1203
1204 (instantiate-octets-definition define-cp861->string)
1205
1206 (add-external-format-funs '(:cp861 :|cp861|)
1207                           '(cp861->string-aref string->cp861))
1208
1209 (define-external-format (:cp861 :|cp861|)
1210     1 t
1211     (let ((cp861-byte (code->cp861-mapper bits)))
1212       (if cp861-byte
1213           (setf (sap-ref-8 sap tail) cp861-byte)
1214           (external-format-encoding-error stream bits)))
1215     (let ((code (cp861->code-mapper byte)))
1216       (if code
1217           (code-char code)
1218           (external-format-decoding-error stream byte)))) ;; TODO -- error check
1219
1220 (define-unibyte-mapper cp862->code-mapper code->cp862-mapper
1221   (#x80 #x05D0) ; HEBREW LETTER ALEF
1222   (#x81 #x05D1) ; HEBREW LETTER BET
1223   (#x82 #x05D2) ; HEBREW LETTER GIMEL
1224   (#x83 #x05D3) ; HEBREW LETTER DALET
1225   (#x84 #x05D4) ; HEBREW LETTER HE
1226   (#x85 #x05D5) ; HEBREW LETTER VAV
1227   (#x86 #x05D6) ; HEBREW LETTER ZAYIN
1228   (#x87 #x05D7) ; HEBREW LETTER HET
1229   (#x88 #x05D8) ; HEBREW LETTER TET
1230   (#x89 #x05D9) ; HEBREW LETTER YOD
1231   (#x8A #x05DA) ; HEBREW LETTER FINAL KAF
1232   (#x8B #x05DB) ; HEBREW LETTER KAF
1233   (#x8C #x05DC) ; HEBREW LETTER LAMED
1234   (#x8D #x05DD) ; HEBREW LETTER FINAL MEM
1235   (#x8E #x05DE) ; HEBREW LETTER MEM
1236   (#x8F #x05DF) ; HEBREW LETTER FINAL NUN
1237   (#x90 #x05E0) ; HEBREW LETTER NUN
1238   (#x91 #x05E1) ; HEBREW LETTER SAMEKH
1239   (#x92 #x05E2) ; HEBREW LETTER AYIN
1240   (#x93 #x05E3) ; HEBREW LETTER FINAL PE
1241   (#x94 #x05E4) ; HEBREW LETTER PE
1242   (#x95 #x05E5) ; HEBREW LETTER FINAL TSADI
1243   (#x96 #x05E6) ; HEBREW LETTER TSADI
1244   (#x97 #x05E7) ; HEBREW LETTER QOF
1245   (#x98 #x05E8) ; HEBREW LETTER RESH
1246   (#x99 #x05E9) ; HEBREW LETTER SHIN
1247   (#x9A #x05EA) ; HEBREW LETTER TAV
1248   (#x9B #x00A2) ; CENT SIGN
1249   (#x9C #x00A3) ; POUND SIGN
1250   (#x9D #x00A5) ; YEN SIGN
1251   (#x9E #x20A7) ; PESETA SIGN
1252   (#x9F #x0192) ; LATIN SMALL LETTER F WITH HOOK
1253   (#xA0 #x00E1) ; LATIN SMALL LETTER A WITH ACUTE
1254   (#xA1 #x00ED) ; LATIN SMALL LETTER I WITH ACUTE
1255   (#xA2 #x00F3) ; LATIN SMALL LETTER O WITH ACUTE
1256   (#xA3 #x00FA) ; LATIN SMALL LETTER U WITH ACUTE
1257   (#xA4 #x00F1) ; LATIN SMALL LETTER N WITH TILDE
1258   (#xA5 #x00D1) ; LATIN CAPITAL LETTER N WITH TILDE
1259   (#xA6 #x00AA) ; FEMININE ORDINAL INDICATOR
1260   (#xA7 #x00BA) ; MASCULINE ORDINAL INDICATOR
1261   (#xA8 #x00BF) ; INVERTED QUESTION MARK
1262   (#xA9 #x2310) ; REVERSED NOT SIGN
1263   (#xAA #x00AC) ; NOT SIGN
1264   (#xAB #x00BD) ; VULGAR FRACTION ONE HALF
1265   (#xAC #x00BC) ; VULGAR FRACTION ONE QUARTER
1266   (#xAD #x00A1) ; INVERTED EXCLAMATION MARK
1267   (#xAE #x00AB) ; LEFT-POINTING DOUBLE ANGLE QUOTATION MARK
1268   (#xAF #x00BB) ; RIGHT-POINTING DOUBLE ANGLE QUOTATION MARK
1269   (#xB0 #x2591) ; LIGHT SHADE
1270   (#xB1 #x2592) ; MEDIUM SHADE
1271   (#xB2 #x2593) ; DARK SHADE
1272   (#xB3 #x2502) ; BOX DRAWINGS LIGHT VERTICAL
1273   (#xB4 #x2524) ; BOX DRAWINGS LIGHT VERTICAL AND LEFT
1274   (#xB5 #x2561) ; BOX DRAWINGS VERTICAL SINGLE AND LEFT DOUBLE
1275   (#xB6 #x2562) ; BOX DRAWINGS VERTICAL DOUBLE AND LEFT SINGLE
1276   (#xB7 #x2556) ; BOX DRAWINGS DOWN DOUBLE AND LEFT SINGLE
1277   (#xB8 #x2555) ; BOX DRAWINGS DOWN SINGLE AND LEFT DOUBLE
1278   (#xB9 #x2563) ; BOX DRAWINGS DOUBLE VERTICAL AND LEFT
1279   (#xBA #x2551) ; BOX DRAWINGS DOUBLE VERTICAL
1280   (#xBB #x2557) ; BOX DRAWINGS DOUBLE DOWN AND LEFT
1281   (#xBC #x255D) ; BOX DRAWINGS DOUBLE UP AND LEFT
1282   (#xBD #x255C) ; BOX DRAWINGS UP DOUBLE AND LEFT SINGLE
1283   (#xBE #x255B) ; BOX DRAWINGS UP SINGLE AND LEFT DOUBLE
1284   (#xBF #x2510) ; BOX DRAWINGS LIGHT DOWN AND LEFT
1285   (#xC0 #x2514) ; BOX DRAWINGS LIGHT UP AND RIGHT
1286   (#xC1 #x2534) ; BOX DRAWINGS LIGHT UP AND HORIZONTAL
1287   (#xC2 #x252C) ; BOX DRAWINGS LIGHT DOWN AND HORIZONTAL
1288   (#xC3 #x251C) ; BOX DRAWINGS LIGHT VERTICAL AND RIGHT
1289   (#xC4 #x2500) ; BOX DRAWINGS LIGHT HORIZONTAL
1290   (#xC5 #x253C) ; BOX DRAWINGS LIGHT VERTICAL AND HORIZONTAL
1291   (#xC6 #x255E) ; BOX DRAWINGS VERTICAL SINGLE AND RIGHT DOUBLE
1292   (#xC7 #x255F) ; BOX DRAWINGS VERTICAL DOUBLE AND RIGHT SINGLE
1293   (#xC8 #x255A) ; BOX DRAWINGS DOUBLE UP AND RIGHT
1294   (#xC9 #x2554) ; BOX DRAWINGS DOUBLE DOWN AND RIGHT
1295   (#xCA #x2569) ; BOX DRAWINGS DOUBLE UP AND HORIZONTAL
1296   (#xCB #x2566) ; BOX DRAWINGS DOUBLE DOWN AND HORIZONTAL
1297   (#xCC #x2560) ; BOX DRAWINGS DOUBLE VERTICAL AND RIGHT
1298   (#xCD #x2550) ; BOX DRAWINGS DOUBLE HORIZONTAL
1299   (#xCE #x256C) ; BOX DRAWINGS DOUBLE VERTICAL AND HORIZONTAL
1300   (#xCF #x2567) ; BOX DRAWINGS UP SINGLE AND HORIZONTAL DOUBLE
1301   (#xD0 #x2568) ; BOX DRAWINGS UP DOUBLE AND HORIZONTAL SINGLE
1302   (#xD1 #x2564) ; BOX DRAWINGS DOWN SINGLE AND HORIZONTAL DOUBLE
1303   (#xD2 #x2565) ; BOX DRAWINGS DOWN DOUBLE AND HORIZONTAL SINGLE
1304   (#xD3 #x2559) ; BOX DRAWINGS UP DOUBLE AND RIGHT SINGLE
1305   (#xD4 #x2558) ; BOX DRAWINGS UP SINGLE AND RIGHT DOUBLE
1306   (#xD5 #x2552) ; BOX DRAWINGS DOWN SINGLE AND RIGHT DOUBLE
1307   (#xD6 #x2553) ; BOX DRAWINGS DOWN DOUBLE AND RIGHT SINGLE
1308   (#xD7 #x256B) ; BOX DRAWINGS VERTICAL DOUBLE AND HORIZONTAL SINGLE
1309   (#xD8 #x256A) ; BOX DRAWINGS VERTICAL SINGLE AND HORIZONTAL DOUBLE
1310   (#xD9 #x2518) ; BOX DRAWINGS LIGHT UP AND LEFT
1311   (#xDA #x250C) ; BOX DRAWINGS LIGHT DOWN AND RIGHT
1312   (#xDB #x2588) ; FULL BLOCK
1313   (#xDC #x2584) ; LOWER HALF BLOCK
1314   (#xDD #x258C) ; LEFT HALF BLOCK
1315   (#xDE #x2590) ; RIGHT HALF BLOCK
1316   (#xDF #x2580) ; UPPER HALF BLOCK
1317   (#xE0 #x03B1) ; GREEK SMALL LETTER ALPHA
1318   (#xE1 #x00DF) ; LATIN SMALL LETTER SHARP S (GERMAN)
1319   (#xE2 #x0393) ; GREEK CAPITAL LETTER GAMMA
1320   (#xE3 #x03C0) ; GREEK SMALL LETTER PI
1321   (#xE4 #x03A3) ; GREEK CAPITAL LETTER SIGMA
1322   (#xE5 #x03C3) ; GREEK SMALL LETTER SIGMA
1323   (#xE6 #x00B5) ; MICRO SIGN
1324   (#xE7 #x03C4) ; GREEK SMALL LETTER TAU
1325   (#xE8 #x03A6) ; GREEK CAPITAL LETTER PHI
1326   (#xE9 #x0398) ; GREEK CAPITAL LETTER THETA
1327   (#xEA #x03A9) ; GREEK CAPITAL LETTER OMEGA
1328   (#xEB #x03B4) ; GREEK SMALL LETTER DELTA
1329   (#xEC #x221E) ; INFINITY
1330   (#xED #x03C6) ; GREEK SMALL LETTER PHI
1331   (#xEE #x03B5) ; GREEK SMALL LETTER EPSILON
1332   (#xEF #x2229) ; INTERSECTION
1333   (#xF0 #x2261) ; IDENTICAL TO
1334   (#xF1 #x00B1) ; PLUS-MINUS SIGN
1335   (#xF2 #x2265) ; GREATER-THAN OR EQUAL TO
1336   (#xF3 #x2264) ; LESS-THAN OR EQUAL TO
1337   (#xF4 #x2320) ; TOP HALF INTEGRAL
1338   (#xF5 #x2321) ; BOTTOM HALF INTEGRAL
1339   (#xF6 #x00F7) ; DIVISION SIGN
1340   (#xF7 #x2248) ; ALMOST EQUAL TO
1341   (#xF8 #x00B0) ; DEGREE SIGN
1342   (#xF9 #x2219) ; BULLET OPERATOR
1343   (#xFA #x00B7) ; MIDDLE DOT
1344   (#xFB #x221A) ; SQUARE ROOT
1345   (#xFC #x207F) ; SUPERSCRIPT LATIN SMALL LETTER N
1346   (#xFD #x00B2) ; SUPERSCRIPT TWO
1347   (#xFE #x25A0) ; BLACK SQUARE
1348   (#xFF #x00A0) ; NO-BREAK SPACE
1349 )
1350
1351 (declaim (inline get-cp862-bytes))
1352 (defun get-cp862-bytes (string pos)
1353   (declare (optimize speed (safety 0))
1354            (type simple-string string)
1355            (type array-range pos))
1356   (get-latin-bytes #'code->cp862-mapper :cp862 string pos))
1357
1358 (defun string->cp862 (string sstart send null-padding)
1359   (declare (optimize speed (safety 0))
1360            (type simple-string string)
1361            (type array-range sstart send))
1362   (values (string->latin% string sstart send #'get-cp862-bytes null-padding)))
1363
1364 (defmacro define-cp862->string* (accessor type)
1365   (declare (ignore type))
1366   (let ((name (make-od-name 'cp862->string* accessor)))
1367     `(progn
1368       (defun ,name (string sstart send array astart aend)
1369         (,(make-od-name 'latin->string* accessor) string sstart send array astart aend #'cp862->code-mapper)))))
1370
1371 (instantiate-octets-definition define-cp862->string*)
1372
1373 (defmacro define-cp862->string (accessor type)
1374   (declare (ignore type))
1375   `(defun ,(make-od-name 'cp862->string accessor) (array astart aend)
1376     (,(make-od-name 'latin->string accessor) array astart aend #'cp862->code-mapper)))
1377
1378 (instantiate-octets-definition define-cp862->string)
1379
1380 (add-external-format-funs '(:cp862 :|cp862|)
1381                           '(cp862->string-aref string->cp862))
1382
1383 (define-external-format (:cp862 :|cp862|)
1384     1 t
1385     (let ((cp862-byte (code->cp862-mapper bits)))
1386       (if cp862-byte
1387           (setf (sap-ref-8 sap tail) cp862-byte)
1388           (external-format-encoding-error stream bits)))
1389     (let ((code (cp862->code-mapper byte)))
1390       (if code
1391           (code-char code)
1392           (external-format-decoding-error stream byte)))) ;; TODO -- error check
1393
1394 (define-unibyte-mapper cp863->code-mapper code->cp863-mapper
1395   (#x80 #x00C7) ; LATIN CAPITAL LETTER C WITH CEDILLA
1396   (#x81 #x00FC) ; LATIN SMALL LETTER U WITH DIAERESIS
1397   (#x82 #x00E9) ; LATIN SMALL LETTER E WITH ACUTE
1398   (#x83 #x00E2) ; LATIN SMALL LETTER A WITH CIRCUMFLEX
1399   (#x84 #x00C2) ; LATIN CAPITAL LETTER A WITH CIRCUMFLEX
1400   (#x85 #x00E0) ; LATIN SMALL LETTER A WITH GRAVE
1401   (#x86 #x00B6) ; PILCROW SIGN
1402   (#x87 #x00E7) ; LATIN SMALL LETTER C WITH CEDILLA
1403   (#x88 #x00EA) ; LATIN SMALL LETTER E WITH CIRCUMFLEX
1404   (#x89 #x00EB) ; LATIN SMALL LETTER E WITH DIAERESIS
1405   (#x8A #x00E8) ; LATIN SMALL LETTER E WITH GRAVE
1406   (#x8B #x00EF) ; LATIN SMALL LETTER I WITH DIAERESIS
1407   (#x8C #x00EE) ; LATIN SMALL LETTER I WITH CIRCUMFLEX
1408   (#x8D #x2017) ; DOUBLE LOW LINE
1409   (#x8E #x00C0) ; LATIN CAPITAL LETTER A WITH GRAVE
1410   (#x8F #x00A7) ; SECTION SIGN
1411   (#x90 #x00C9) ; LATIN CAPITAL LETTER E WITH ACUTE
1412   (#x91 #x00C8) ; LATIN CAPITAL LETTER E WITH GRAVE
1413   (#x92 #x00CA) ; LATIN CAPITAL LETTER E WITH CIRCUMFLEX
1414   (#x93 #x00F4) ; LATIN SMALL LETTER O WITH CIRCUMFLEX
1415   (#x94 #x00CB) ; LATIN CAPITAL LETTER E WITH DIAERESIS
1416   (#x95 #x00CF) ; LATIN CAPITAL LETTER I WITH DIAERESIS
1417   (#x96 #x00FB) ; LATIN SMALL LETTER U WITH CIRCUMFLEX
1418   (#x97 #x00F9) ; LATIN SMALL LETTER U WITH GRAVE
1419   (#x98 #x00A4) ; CURRENCY SIGN
1420   (#x99 #x00D4) ; LATIN CAPITAL LETTER O WITH CIRCUMFLEX
1421   (#x9A #x00DC) ; LATIN CAPITAL LETTER U WITH DIAERESIS
1422   (#x9B #x00A2) ; CENT SIGN
1423   (#x9C #x00A3) ; POUND SIGN
1424   (#x9D #x00D9) ; LATIN CAPITAL LETTER U WITH GRAVE
1425   (#x9E #x00DB) ; LATIN CAPITAL LETTER U WITH CIRCUMFLEX
1426   (#x9F #x0192) ; LATIN SMALL LETTER F WITH HOOK
1427   (#xA0 #x00A6) ; BROKEN BAR
1428   (#xA1 #x00B4) ; ACUTE ACCENT
1429   (#xA2 #x00F3) ; LATIN SMALL LETTER O WITH ACUTE
1430   (#xA3 #x00FA) ; LATIN SMALL LETTER U WITH ACUTE
1431   (#xA4 #x00A8) ; DIAERESIS
1432   (#xA5 #x00B8) ; CEDILLA
1433   (#xA6 #x00B3) ; SUPERSCRIPT THREE
1434   (#xA7 #x00AF) ; MACRON
1435   (#xA8 #x00CE) ; LATIN CAPITAL LETTER I WITH CIRCUMFLEX
1436   (#xA9 #x2310) ; REVERSED NOT SIGN
1437   (#xAA #x00AC) ; NOT SIGN
1438   (#xAB #x00BD) ; VULGAR FRACTION ONE HALF
1439   (#xAC #x00BC) ; VULGAR FRACTION ONE QUARTER
1440   (#xAD #x00BE) ; VULGAR FRACTION THREE QUARTERS
1441   (#xAE #x00AB) ; LEFT-POINTING DOUBLE ANGLE QUOTATION MARK
1442   (#xAF #x00BB) ; RIGHT-POINTING DOUBLE ANGLE QUOTATION MARK
1443   (#xB0 #x2591) ; LIGHT SHADE
1444   (#xB1 #x2592) ; MEDIUM SHADE
1445   (#xB2 #x2593) ; DARK SHADE
1446   (#xB3 #x2502) ; BOX DRAWINGS LIGHT VERTICAL
1447   (#xB4 #x2524) ; BOX DRAWINGS LIGHT VERTICAL AND LEFT
1448   (#xB5 #x2561) ; BOX DRAWINGS VERTICAL SINGLE AND LEFT DOUBLE
1449   (#xB6 #x2562) ; BOX DRAWINGS VERTICAL DOUBLE AND LEFT SINGLE
1450   (#xB7 #x2556) ; BOX DRAWINGS DOWN DOUBLE AND LEFT SINGLE
1451   (#xB8 #x2555) ; BOX DRAWINGS DOWN SINGLE AND LEFT DOUBLE
1452   (#xB9 #x2563) ; BOX DRAWINGS DOUBLE VERTICAL AND LEFT
1453   (#xBA #x2551) ; BOX DRAWINGS DOUBLE VERTICAL
1454   (#xBB #x2557) ; BOX DRAWINGS DOUBLE DOWN AND LEFT
1455   (#xBC #x255D) ; BOX DRAWINGS DOUBLE UP AND LEFT
1456   (#xBD #x255C) ; BOX DRAWINGS UP DOUBLE AND LEFT SINGLE
1457   (#xBE #x255B) ; BOX DRAWINGS UP SINGLE AND LEFT DOUBLE
1458   (#xBF #x2510) ; BOX DRAWINGS LIGHT DOWN AND LEFT
1459   (#xC0 #x2514) ; BOX DRAWINGS LIGHT UP AND RIGHT
1460   (#xC1 #x2534) ; BOX DRAWINGS LIGHT UP AND HORIZONTAL
1461   (#xC2 #x252C) ; BOX DRAWINGS LIGHT DOWN AND HORIZONTAL
1462   (#xC3 #x251C) ; BOX DRAWINGS LIGHT VERTICAL AND RIGHT
1463   (#xC4 #x2500) ; BOX DRAWINGS LIGHT HORIZONTAL
1464   (#xC5 #x253C) ; BOX DRAWINGS LIGHT VERTICAL AND HORIZONTAL
1465   (#xC6 #x255E) ; BOX DRAWINGS VERTICAL SINGLE AND RIGHT DOUBLE
1466   (#xC7 #x255F) ; BOX DRAWINGS VERTICAL DOUBLE AND RIGHT SINGLE
1467   (#xC8 #x255A) ; BOX DRAWINGS DOUBLE UP AND RIGHT
1468   (#xC9 #x2554) ; BOX DRAWINGS DOUBLE DOWN AND RIGHT
1469   (#xCA #x2569) ; BOX DRAWINGS DOUBLE UP AND HORIZONTAL
1470   (#xCB #x2566) ; BOX DRAWINGS DOUBLE DOWN AND HORIZONTAL
1471   (#xCC #x2560) ; BOX DRAWINGS DOUBLE VERTICAL AND RIGHT
1472   (#xCD #x2550) ; BOX DRAWINGS DOUBLE HORIZONTAL
1473   (#xCE #x256C) ; BOX DRAWINGS DOUBLE VERTICAL AND HORIZONTAL
1474   (#xCF #x2567) ; BOX DRAWINGS UP SINGLE AND HORIZONTAL DOUBLE
1475   (#xD0 #x2568) ; BOX DRAWINGS UP DOUBLE AND HORIZONTAL SINGLE
1476   (#xD1 #x2564) ; BOX DRAWINGS DOWN SINGLE AND HORIZONTAL DOUBLE
1477   (#xD2 #x2565) ; BOX DRAWINGS DOWN DOUBLE AND HORIZONTAL SINGLE
1478   (#xD3 #x2559) ; BOX DRAWINGS UP DOUBLE AND RIGHT SINGLE
1479   (#xD4 #x2558) ; BOX DRAWINGS UP SINGLE AND RIGHT DOUBLE
1480   (#xD5 #x2552) ; BOX DRAWINGS DOWN SINGLE AND RIGHT DOUBLE
1481   (#xD6 #x2553) ; BOX DRAWINGS DOWN DOUBLE AND RIGHT SINGLE
1482   (#xD7 #x256B) ; BOX DRAWINGS VERTICAL DOUBLE AND HORIZONTAL SINGLE
1483   (#xD8 #x256A) ; BOX DRAWINGS VERTICAL SINGLE AND HORIZONTAL DOUBLE
1484   (#xD9 #x2518) ; BOX DRAWINGS LIGHT UP AND LEFT
1485   (#xDA #x250C) ; BOX DRAWINGS LIGHT DOWN AND RIGHT
1486   (#xDB #x2588) ; FULL BLOCK
1487   (#xDC #x2584) ; LOWER HALF BLOCK
1488   (#xDD #x258C) ; LEFT HALF BLOCK
1489   (#xDE #x2590) ; RIGHT HALF BLOCK
1490   (#xDF #x2580) ; UPPER HALF BLOCK
1491   (#xE0 #x03B1) ; GREEK SMALL LETTER ALPHA
1492   (#xE1 #x00DF) ; LATIN SMALL LETTER SHARP S
1493   (#xE2 #x0393) ; GREEK CAPITAL LETTER GAMMA
1494   (#xE3 #x03C0) ; GREEK SMALL LETTER PI
1495   (#xE4 #x03A3) ; GREEK CAPITAL LETTER SIGMA
1496   (#xE5 #x03C3) ; GREEK SMALL LETTER SIGMA
1497   (#xE6 #x00B5) ; MICRO SIGN
1498   (#xE7 #x03C4) ; GREEK SMALL LETTER TAU
1499   (#xE8 #x03A6) ; GREEK CAPITAL LETTER PHI
1500   (#xE9 #x0398) ; GREEK CAPITAL LETTER THETA
1501   (#xEA #x03A9) ; GREEK CAPITAL LETTER OMEGA
1502   (#xEB #x03B4) ; GREEK SMALL LETTER DELTA
1503   (#xEC #x221E) ; INFINITY
1504   (#xED #x03C6) ; GREEK SMALL LETTER PHI
1505   (#xEE #x03B5) ; GREEK SMALL LETTER EPSILON
1506   (#xEF #x2229) ; INTERSECTION
1507   (#xF0 #x2261) ; IDENTICAL TO
1508   (#xF1 #x00B1) ; PLUS-MINUS SIGN
1509   (#xF2 #x2265) ; GREATER-THAN OR EQUAL TO
1510   (#xF3 #x2264) ; LESS-THAN OR EQUAL TO
1511   (#xF4 #x2320) ; TOP HALF INTEGRAL
1512   (#xF5 #x2321) ; BOTTOM HALF INTEGRAL
1513   (#xF6 #x00F7) ; DIVISION SIGN
1514   (#xF7 #x2248) ; ALMOST EQUAL TO
1515   (#xF8 #x00B0) ; DEGREE SIGN
1516   (#xF9 #x2219) ; BULLET OPERATOR
1517   (#xFA #x00B7) ; MIDDLE DOT
1518   (#xFB #x221A) ; SQUARE ROOT
1519   (#xFC #x207F) ; SUPERSCRIPT LATIN SMALL LETTER N
1520   (#xFD #x00B2) ; SUPERSCRIPT TWO
1521   (#xFE #x25A0) ; BLACK SQUARE
1522   (#xFF #x00A0) ; NO-BREAK SPACE
1523 )
1524
1525 (declaim (inline get-cp863-bytes))
1526 (defun get-cp863-bytes (string pos)
1527   (declare (optimize speed (safety 0))
1528            (type simple-string string)
1529            (type array-range pos))
1530   (get-latin-bytes #'code->cp863-mapper :cp863 string pos))
1531
1532 (defun string->cp863 (string sstart send null-padding)
1533   (declare (optimize speed (safety 0))
1534            (type simple-string string)
1535            (type array-range sstart send))
1536   (values (string->latin% string sstart send #'get-cp863-bytes null-padding)))
1537
1538 (defmacro define-cp863->string* (accessor type)
1539   (declare (ignore type))
1540   (let ((name (make-od-name 'cp863->string* accessor)))
1541     `(progn
1542       (defun ,name (string sstart send array astart aend)
1543         (,(make-od-name 'latin->string* accessor) string sstart send array astart aend #'cp863->code-mapper)))))
1544
1545 (instantiate-octets-definition define-cp863->string*)
1546
1547 (defmacro define-cp863->string (accessor type)
1548   (declare (ignore type))
1549   `(defun ,(make-od-name 'cp863->string accessor) (array astart aend)
1550     (,(make-od-name 'latin->string accessor) array astart aend #'cp863->code-mapper)))
1551
1552 (instantiate-octets-definition define-cp863->string)
1553
1554 (add-external-format-funs '(:cp863 :|cp863|)
1555                           '(cp863->string-aref string->cp863))
1556
1557 (define-external-format (:cp863 :|cp863|)
1558     1 t
1559     (let ((cp863-byte (code->cp863-mapper bits)))
1560       (if cp863-byte
1561           (setf (sap-ref-8 sap tail) cp863-byte)
1562           (external-format-encoding-error stream bits)))
1563     (let ((code (cp863->code-mapper byte)))
1564       (if code
1565           (code-char code)
1566           (external-format-decoding-error stream byte)))) ;; TODO -- error check
1567
1568 (define-unibyte-mapper cp864->code-mapper code->cp864-mapper
1569   (#x80 #x00B0) ; DEGREE SIGN
1570   (#x81 #x00B7) ; MIDDLE DOT
1571   (#x82 #x2219) ; BULLET OPERATOR
1572   (#x83 #x221A) ; SQUARE ROOT
1573   (#x84 #x2592) ; MEDIUM SHADE
1574   (#x85 #x2500) ; FORMS LIGHT HORIZONTAL
1575   (#x86 #x2502) ; FORMS LIGHT VERTICAL
1576   (#x87 #x253C) ; FORMS LIGHT VERTICAL AND HORIZONTAL
1577   (#x88 #x2524) ; FORMS LIGHT VERTICAL AND LEFT
1578   (#x89 #x252C) ; FORMS LIGHT DOWN AND HORIZONTAL
1579   (#x8A #x251C) ; FORMS LIGHT VERTICAL AND RIGHT
1580   (#x8B #x2534) ; FORMS LIGHT UP AND HORIZONTAL
1581   (#x8C #x2510) ; FORMS LIGHT DOWN AND LEFT
1582   (#x8D #x250C) ; FORMS LIGHT DOWN AND RIGHT
1583   (#x8E #x2514) ; FORMS LIGHT UP AND RIGHT
1584   (#x8F #x2518) ; FORMS LIGHT UP AND LEFT
1585   (#x90 #x03B2) ; GREEK SMALL BETA
1586   (#x91 #x221E) ; INFINITY
1587   (#x92 #x03C6) ; GREEK SMALL PHI
1588   (#x93 #x00B1) ; PLUS-OR-MINUS SIGN
1589   (#x94 #x00BD) ; FRACTION 1/2
1590   (#x95 #x00BC) ; FRACTION 1/4
1591   (#x96 #x2248) ; ALMOST EQUAL TO
1592   (#x97 #x00AB) ; LEFT POINTING GUILLEMET
1593   (#x98 #x00BB) ; RIGHT POINTING GUILLEMET
1594   (#x99 #xFEF7) ; ARABIC LIGATURE LAM WITH ALEF WITH HAMZA ABOVE ISOLATED FORM
1595   (#x9A #xFEF8) ; ARABIC LIGATURE LAM WITH ALEF WITH HAMZA ABOVE FINAL FORM
1596   (#x9B nil)
1597   (#x9C nil)
1598   (#x9D #xFEFB) ; ARABIC LIGATURE LAM WITH ALEF ISOLATED FORM
1599   (#x9E #xFEFC) ; ARABIC LIGATURE LAM WITH ALEF FINAL FORM
1600   (#x9F nil)
1601   (#xA1 #x00AD) ; SOFT HYPHEN
1602   (#xA2 #xFE82) ; ARABIC LETTER ALEF WITH MADDA ABOVE FINAL FORM
1603   (#xA5 #xFE84) ; ARABIC LETTER ALEF WITH HAMZA ABOVE FINAL FORM
1604   (#xA6 nil)
1605   (#xA7 nil)
1606   (#xA8 #xFE8E) ; ARABIC LETTER ALEF FINAL FORM
1607   (#xA9 #xFE8F) ; ARABIC LETTER BEH ISOLATED FORM
1608   (#xAA #xFE95) ; ARABIC LETTER TEH ISOLATED FORM
1609   (#xAB #xFE99) ; ARABIC LETTER THEH ISOLATED FORM
1610   (#xAC #x060C) ; ARABIC COMMA
1611   (#xAD #xFE9D) ; ARABIC LETTER JEEM ISOLATED FORM
1612   (#xAE #xFEA1) ; ARABIC LETTER HAH ISOLATED FORM
1613   (#xAF #xFEA5) ; ARABIC LETTER KHAH ISOLATED FORM
1614   (#xB0 #x0660) ; ARABIC-INDIC DIGIT ZERO
1615   (#xB1 #x0661) ; ARABIC-INDIC DIGIT ONE
1616   (#xB2 #x0662) ; ARABIC-INDIC DIGIT TWO
1617   (#xB3 #x0663) ; ARABIC-INDIC DIGIT THREE
1618   (#xB4 #x0664) ; ARABIC-INDIC DIGIT FOUR
1619   (#xB5 #x0665) ; ARABIC-INDIC DIGIT FIVE
1620   (#xB6 #x0666) ; ARABIC-INDIC DIGIT SIX
1621   (#xB7 #x0667) ; ARABIC-INDIC DIGIT SEVEN
1622   (#xB8 #x0668) ; ARABIC-INDIC DIGIT EIGHT
1623   (#xB9 #x0669) ; ARABIC-INDIC DIGIT NINE
1624   (#xBA #xFED1) ; ARABIC LETTER FEH ISOLATED FORM
1625   (#xBB #x061B) ; ARABIC SEMICOLON
1626   (#xBC #xFEB1) ; ARABIC LETTER SEEN ISOLATED FORM
1627   (#xBD #xFEB5) ; ARABIC LETTER SHEEN ISOLATED FORM
1628   (#xBE #xFEB9) ; ARABIC LETTER SAD ISOLATED FORM
1629   (#xBF #x061F) ; ARABIC QUESTION MARK
1630   (#xC0 #x00A2) ; CENT SIGN
1631   (#xC1 #xFE80) ; ARABIC LETTER HAMZA ISOLATED FORM
1632   (#xC2 #xFE81) ; ARABIC LETTER ALEF WITH MADDA ABOVE ISOLATED FORM
1633   (#xC3 #xFE83) ; ARABIC LETTER ALEF WITH HAMZA ABOVE ISOLATED FORM
1634   (#xC4 #xFE85) ; ARABIC LETTER WAW WITH HAMZA ABOVE ISOLATED FORM
1635   (#xC5 #xFECA) ; ARABIC LETTER AIN FINAL FORM
1636   (#xC6 #xFE8B) ; ARABIC LETTER YEH WITH HAMZA ABOVE INITIAL FORM
1637   (#xC7 #xFE8D) ; ARABIC LETTER ALEF ISOLATED FORM
1638   (#xC8 #xFE91) ; ARABIC LETTER BEH INITIAL FORM
1639   (#xC9 #xFE93) ; ARABIC LETTER TEH MARBUTA ISOLATED FORM
1640   (#xCA #xFE97) ; ARABIC LETTER TEH INITIAL FORM
1641   (#xCB #xFE9B) ; ARABIC LETTER THEH INITIAL FORM
1642   (#xCC #xFE9F) ; ARABIC LETTER JEEM INITIAL FORM
1643   (#xCD #xFEA3) ; ARABIC LETTER HAH INITIAL FORM
1644   (#xCE #xFEA7) ; ARABIC LETTER KHAH INITIAL FORM
1645   (#xCF #xFEA9) ; ARABIC LETTER DAL ISOLATED FORM
1646   (#xD0 #xFEAB) ; ARABIC LETTER THAL ISOLATED FORM
1647   (#xD1 #xFEAD) ; ARABIC LETTER REH ISOLATED FORM
1648   (#xD2 #xFEAF) ; ARABIC LETTER ZAIN ISOLATED FORM
1649   (#xD3 #xFEB3) ; ARABIC LETTER SEEN INITIAL FORM
1650   (#xD4 #xFEB7) ; ARABIC LETTER SHEEN INITIAL FORM
1651   (#xD5 #xFEBB) ; ARABIC LETTER SAD INITIAL FORM
1652   (#xD6 #xFEBF) ; ARABIC LETTER DAD INITIAL FORM
1653   (#xD7 #xFEC1) ; ARABIC LETTER TAH ISOLATED FORM
1654   (#xD8 #xFEC5) ; ARABIC LETTER ZAH ISOLATED FORM
1655   (#xD9 #xFECB) ; ARABIC LETTER AIN INITIAL FORM
1656   (#xDA #xFECF) ; ARABIC LETTER GHAIN INITIAL FORM
1657   (#xDB #x00A6) ; BROKEN VERTICAL BAR
1658   (#xDC #x00AC) ; NOT SIGN
1659   (#xDD #x00F7) ; DIVISION SIGN
1660   (#xDE #x00D7) ; MULTIPLICATION SIGN
1661   (#xDF #xFEC9) ; ARABIC LETTER AIN ISOLATED FORM
1662   (#xE0 #x0640) ; ARABIC TATWEEL
1663   (#xE1 #xFED3) ; ARABIC LETTER FEH INITIAL FORM
1664   (#xE2 #xFED7) ; ARABIC LETTER QAF INITIAL FORM
1665   (#xE3 #xFEDB) ; ARABIC LETTER KAF INITIAL FORM
1666   (#xE4 #xFEDF) ; ARABIC LETTER LAM INITIAL FORM
1667   (#xE5 #xFEE3) ; ARABIC LETTER MEEM INITIAL FORM
1668   (#xE6 #xFEE7) ; ARABIC LETTER NOON INITIAL FORM
1669   (#xE7 #xFEEB) ; ARABIC LETTER HEH INITIAL FORM
1670   (#xE8 #xFEED) ; ARABIC LETTER WAW ISOLATED FORM
1671   (#xE9 #xFEEF) ; ARABIC LETTER ALEF MAKSURA ISOLATED FORM
1672   (#xEA #xFEF3) ; ARABIC LETTER YEH INITIAL FORM
1673   (#xEB #xFEBD) ; ARABIC LETTER DAD ISOLATED FORM
1674   (#xEC #xFECC) ; ARABIC LETTER AIN MEDIAL FORM
1675   (#xED #xFECE) ; ARABIC LETTER GHAIN FINAL FORM
1676   (#xEE #xFECD) ; ARABIC LETTER GHAIN ISOLATED FORM
1677   (#xEF #xFEE1) ; ARABIC LETTER MEEM ISOLATED FORM
1678   (#xF0 #xFE7D) ; ARABIC SHADDA MEDIAL FORM
1679   (#xF1 #x0651) ; ARABIC SHADDAH
1680   (#xF2 #xFEE5) ; ARABIC LETTER NOON ISOLATED FORM
1681   (#xF3 #xFEE9) ; ARABIC LETTER HEH ISOLATED FORM
1682   (#xF4 #xFEEC) ; ARABIC LETTER HEH MEDIAL FORM
1683   (#xF5 #xFEF0) ; ARABIC LETTER ALEF MAKSURA FINAL FORM
1684   (#xF6 #xFEF2) ; ARABIC LETTER YEH FINAL FORM
1685   (#xF7 #xFED0) ; ARABIC LETTER GHAIN MEDIAL FORM
1686   (#xF8 #xFED5) ; ARABIC LETTER QAF ISOLATED FORM
1687   (#xF9 #xFEF5) ; ARABIC LIGATURE LAM WITH ALEF WITH MADDA ABOVE ISOLATED FORM
1688   (#xFA #xFEF6) ; ARABIC LIGATURE LAM WITH ALEF WITH MADDA ABOVE FINAL FORM
1689   (#xFB #xFEDD) ; ARABIC LETTER LAM ISOLATED FORM
1690   (#xFC #xFED9) ; ARABIC LETTER KAF ISOLATED FORM
1691   (#xFD #xFEF1) ; ARABIC LETTER YEH ISOLATED FORM
1692   (#xFE #x25A0) ; BLACK SQUARE
1693   (#xFF nil)
1694 )
1695
1696 (declaim (inline get-cp864-bytes))
1697 (defun get-cp864-bytes (string pos)
1698   (declare (optimize speed (safety 0))
1699            (type simple-string string)
1700            (type array-range pos))
1701   (get-latin-bytes #'code->cp864-mapper :cp864 string pos))
1702
1703 (defun string->cp864 (string sstart send null-padding)
1704   (declare (optimize speed (safety 0))
1705            (type simple-string string)
1706            (type array-range sstart send))
1707   (values (string->latin% string sstart send #'get-cp864-bytes null-padding)))
1708
1709 (defmacro define-cp864->string* (accessor type)
1710   (declare (ignore type))
1711   (let ((name (make-od-name 'cp864->string* accessor)))
1712     `(progn
1713       (defun ,name (string sstart send array astart aend)
1714         (,(make-od-name 'latin->string* accessor) string sstart send array astart aend #'cp864->code-mapper)))))
1715
1716 (instantiate-octets-definition define-cp864->string*)
1717
1718 (defmacro define-cp864->string (accessor type)
1719   (declare (ignore type))
1720   `(defun ,(make-od-name 'cp864->string accessor) (array astart aend)
1721     (,(make-od-name 'latin->string accessor) array astart aend #'cp864->code-mapper)))
1722
1723 (instantiate-octets-definition define-cp864->string)
1724
1725 (add-external-format-funs '(:cp864 :|cp864|)
1726                           '(cp864->string-aref string->cp864))
1727
1728 (define-external-format (:cp864 :|cp864|)
1729     1 t
1730     (let ((cp864-byte (code->cp864-mapper bits)))
1731       (if cp864-byte
1732           (setf (sap-ref-8 sap tail) cp864-byte)
1733           (external-format-encoding-error stream bits)))
1734     (let ((code (cp864->code-mapper byte)))
1735       (if code
1736           (code-char code)
1737           (external-format-decoding-error stream byte)))) ;; TODO -- error check
1738
1739 (define-unibyte-mapper cp865->code-mapper code->cp865-mapper
1740   (#x80 #x00C7) ; LATIN CAPITAL LETTER C WITH CEDILLA
1741   (#x81 #x00FC) ; LATIN SMALL LETTER U WITH DIAERESIS
1742   (#x82 #x00E9) ; LATIN SMALL LETTER E WITH ACUTE
1743   (#x83 #x00E2) ; LATIN SMALL LETTER A WITH CIRCUMFLEX
1744   (#x84 #x00E4) ; LATIN SMALL LETTER A WITH DIAERESIS
1745   (#x85 #x00E0) ; LATIN SMALL LETTER A WITH GRAVE
1746   (#x86 #x00E5) ; LATIN SMALL LETTER A WITH RING ABOVE
1747   (#x87 #x00E7) ; LATIN SMALL LETTER C WITH CEDILLA
1748   (#x88 #x00EA) ; LATIN SMALL LETTER E WITH CIRCUMFLEX
1749   (#x89 #x00EB) ; LATIN SMALL LETTER E WITH DIAERESIS
1750   (#x8A #x00E8) ; LATIN SMALL LETTER E WITH GRAVE
1751   (#x8B #x00EF) ; LATIN SMALL LETTER I WITH DIAERESIS
1752   (#x8C #x00EE) ; LATIN SMALL LETTER I WITH CIRCUMFLEX
1753   (#x8D #x00EC) ; LATIN SMALL LETTER I WITH GRAVE
1754   (#x8E #x00C4) ; LATIN CAPITAL LETTER A WITH DIAERESIS
1755   (#x8F #x00C5) ; LATIN CAPITAL LETTER A WITH RING ABOVE
1756   (#x90 #x00C9) ; LATIN CAPITAL LETTER E WITH ACUTE
1757   (#x91 #x00E6) ; LATIN SMALL LIGATURE AE
1758   (#x92 #x00C6) ; LATIN CAPITAL LIGATURE AE
1759   (#x93 #x00F4) ; LATIN SMALL LETTER O WITH CIRCUMFLEX
1760   (#x94 #x00F6) ; LATIN SMALL LETTER O WITH DIAERESIS
1761   (#x95 #x00F2) ; LATIN SMALL LETTER O WITH GRAVE
1762   (#x96 #x00FB) ; LATIN SMALL LETTER U WITH CIRCUMFLEX
1763   (#x97 #x00F9) ; LATIN SMALL LETTER U WITH GRAVE
1764   (#x98 #x00FF) ; LATIN SMALL LETTER Y WITH DIAERESIS
1765   (#x99 #x00D6) ; LATIN CAPITAL LETTER O WITH DIAERESIS
1766   (#x9A #x00DC) ; LATIN CAPITAL LETTER U WITH DIAERESIS
1767   (#x9B #x00F8) ; LATIN SMALL LETTER O WITH STROKE
1768   (#x9C #x00A3) ; POUND SIGN
1769   (#x9D #x00D8) ; LATIN CAPITAL LETTER O WITH STROKE
1770   (#x9E #x20A7) ; PESETA SIGN
1771   (#x9F #x0192) ; LATIN SMALL LETTER F WITH HOOK
1772   (#xA0 #x00E1) ; LATIN SMALL LETTER A WITH ACUTE
1773   (#xA1 #x00ED) ; LATIN SMALL LETTER I WITH ACUTE
1774   (#xA2 #x00F3) ; LATIN SMALL LETTER O WITH ACUTE
1775   (#xA3 #x00FA) ; LATIN SMALL LETTER U WITH ACUTE
1776   (#xA4 #x00F1) ; LATIN SMALL LETTER N WITH TILDE
1777   (#xA5 #x00D1) ; LATIN CAPITAL LETTER N WITH TILDE
1778   (#xA6 #x00AA) ; FEMININE ORDINAL INDICATOR
1779   (#xA7 #x00BA) ; MASCULINE ORDINAL INDICATOR
1780   (#xA8 #x00BF) ; INVERTED QUESTION MARK
1781   (#xA9 #x2310) ; REVERSED NOT SIGN
1782   (#xAA #x00AC) ; NOT SIGN
1783   (#xAB #x00BD) ; VULGAR FRACTION ONE HALF
1784   (#xAC #x00BC) ; VULGAR FRACTION ONE QUARTER
1785   (#xAD #x00A1) ; INVERTED EXCLAMATION MARK
1786   (#xAE #x00AB) ; LEFT-POINTING DOUBLE ANGLE QUOTATION MARK
1787   (#xAF #x00A4) ; CURRENCY SIGN
1788   (#xB0 #x2591) ; LIGHT SHADE
1789   (#xB1 #x2592) ; MEDIUM SHADE
1790   (#xB2 #x2593) ; DARK SHADE
1791   (#xB3 #x2502) ; BOX DRAWINGS LIGHT VERTICAL
1792   (#xB4 #x2524) ; BOX DRAWINGS LIGHT VERTICAL AND LEFT
1793   (#xB5 #x2561) ; BOX DRAWINGS VERTICAL SINGLE AND LEFT DOUBLE
1794   (#xB6 #x2562) ; BOX DRAWINGS VERTICAL DOUBLE AND LEFT SINGLE
1795   (#xB7 #x2556) ; BOX DRAWINGS DOWN DOUBLE AND LEFT SINGLE
1796   (#xB8 #x2555) ; BOX DRAWINGS DOWN SINGLE AND LEFT DOUBLE
1797   (#xB9 #x2563) ; BOX DRAWINGS DOUBLE VERTICAL AND LEFT
1798   (#xBA #x2551) ; BOX DRAWINGS DOUBLE VERTICAL
1799   (#xBB #x2557) ; BOX DRAWINGS DOUBLE DOWN AND LEFT
1800   (#xBC #x255D) ; BOX DRAWINGS DOUBLE UP AND LEFT
1801   (#xBD #x255C) ; BOX DRAWINGS UP DOUBLE AND LEFT SINGLE
1802   (#xBE #x255B) ; BOX DRAWINGS UP SINGLE AND LEFT DOUBLE
1803   (#xBF #x2510) ; BOX DRAWINGS LIGHT DOWN AND LEFT
1804   (#xC0 #x2514) ; BOX DRAWINGS LIGHT UP AND RIGHT
1805   (#xC1 #x2534) ; BOX DRAWINGS LIGHT UP AND HORIZONTAL
1806   (#xC2 #x252C) ; BOX DRAWINGS LIGHT DOWN AND HORIZONTAL
1807   (#xC3 #x251C) ; BOX DRAWINGS LIGHT VERTICAL AND RIGHT
1808   (#xC4 #x2500) ; BOX DRAWINGS LIGHT HORIZONTAL
1809   (#xC5 #x253C) ; BOX DRAWINGS LIGHT VERTICAL AND HORIZONTAL
1810   (#xC6 #x255E) ; BOX DRAWINGS VERTICAL SINGLE AND RIGHT DOUBLE
1811   (#xC7 #x255F) ; BOX DRAWINGS VERTICAL DOUBLE AND RIGHT SINGLE
1812   (#xC8 #x255A) ; BOX DRAWINGS DOUBLE UP AND RIGHT
1813   (#xC9 #x2554) ; BOX DRAWINGS DOUBLE DOWN AND RIGHT
1814   (#xCA #x2569) ; BOX DRAWINGS DOUBLE UP AND HORIZONTAL
1815   (#xCB #x2566) ; BOX DRAWINGS DOUBLE DOWN AND HORIZONTAL
1816   (#xCC #x2560) ; BOX DRAWINGS DOUBLE VERTICAL AND RIGHT
1817   (#xCD #x2550) ; BOX DRAWINGS DOUBLE HORIZONTAL
1818   (#xCE #x256C) ; BOX DRAWINGS DOUBLE VERTICAL AND HORIZONTAL
1819   (#xCF #x2567) ; BOX DRAWINGS UP SINGLE AND HORIZONTAL DOUBLE
1820   (#xD0 #x2568) ; BOX DRAWINGS UP DOUBLE AND HORIZONTAL SINGLE
1821   (#xD1 #x2564) ; BOX DRAWINGS DOWN SINGLE AND HORIZONTAL DOUBLE
1822   (#xD2 #x2565) ; BOX DRAWINGS DOWN DOUBLE AND HORIZONTAL SINGLE
1823   (#xD3 #x2559) ; BOX DRAWINGS UP DOUBLE AND RIGHT SINGLE
1824   (#xD4 #x2558) ; BOX DRAWINGS UP SINGLE AND RIGHT DOUBLE
1825   (#xD5 #x2552) ; BOX DRAWINGS DOWN SINGLE AND RIGHT DOUBLE
1826   (#xD6 #x2553) ; BOX DRAWINGS DOWN DOUBLE AND RIGHT SINGLE
1827   (#xD7 #x256B) ; BOX DRAWINGS VERTICAL DOUBLE AND HORIZONTAL SINGLE
1828   (#xD8 #x256A) ; BOX DRAWINGS VERTICAL SINGLE AND HORIZONTAL DOUBLE
1829   (#xD9 #x2518) ; BOX DRAWINGS LIGHT UP AND LEFT
1830   (#xDA #x250C) ; BOX DRAWINGS LIGHT DOWN AND RIGHT
1831   (#xDB #x2588) ; FULL BLOCK
1832   (#xDC #x2584) ; LOWER HALF BLOCK
1833   (#xDD #x258C) ; LEFT HALF BLOCK
1834   (#xDE #x2590) ; RIGHT HALF BLOCK
1835   (#xDF #x2580) ; UPPER HALF BLOCK
1836   (#xE0 #x03B1) ; GREEK SMALL LETTER ALPHA
1837   (#xE1 #x00DF) ; LATIN SMALL LETTER SHARP S
1838   (#xE2 #x0393) ; GREEK CAPITAL LETTER GAMMA
1839   (#xE3 #x03C0) ; GREEK SMALL LETTER PI
1840   (#xE4 #x03A3) ; GREEK CAPITAL LETTER SIGMA
1841   (#xE5 #x03C3) ; GREEK SMALL LETTER SIGMA
1842   (#xE6 #x00B5) ; MICRO SIGN
1843   (#xE7 #x03C4) ; GREEK SMALL LETTER TAU
1844   (#xE8 #x03A6) ; GREEK CAPITAL LETTER PHI
1845   (#xE9 #x0398) ; GREEK CAPITAL LETTER THETA
1846   (#xEA #x03A9) ; GREEK CAPITAL LETTER OMEGA
1847   (#xEB #x03B4) ; GREEK SMALL LETTER DELTA
1848   (#xEC #x221E) ; INFINITY
1849   (#xED #x03C6) ; GREEK SMALL LETTER PHI
1850   (#xEE #x03B5) ; GREEK SMALL LETTER EPSILON
1851   (#xEF #x2229) ; INTERSECTION
1852   (#xF0 #x2261) ; IDENTICAL TO
1853   (#xF1 #x00B1) ; PLUS-MINUS SIGN
1854   (#xF2 #x2265) ; GREATER-THAN OR EQUAL TO
1855   (#xF3 #x2264) ; LESS-THAN OR EQUAL TO
1856   (#xF4 #x2320) ; TOP HALF INTEGRAL
1857   (#xF5 #x2321) ; BOTTOM HALF INTEGRAL
1858   (#xF6 #x00F7) ; DIVISION SIGN
1859   (#xF7 #x2248) ; ALMOST EQUAL TO
1860   (#xF8 #x00B0) ; DEGREE SIGN
1861   (#xF9 #x2219) ; BULLET OPERATOR
1862   (#xFA #x00B7) ; MIDDLE DOT
1863   (#xFB #x221A) ; SQUARE ROOT
1864   (#xFC #x207F) ; SUPERSCRIPT LATIN SMALL LETTER N
1865   (#xFD #x00B2) ; SUPERSCRIPT TWO
1866   (#xFE #x25A0) ; BLACK SQUARE
1867   (#xFF #x00A0) ; NO-BREAK SPACE
1868 )
1869
1870 (declaim (inline get-cp865-bytes))
1871 (defun get-cp865-bytes (string pos)
1872   (declare (optimize speed (safety 0))
1873            (type simple-string string)
1874            (type array-range pos))
1875   (get-latin-bytes #'code->cp865-mapper :cp865 string pos))
1876
1877 (defun string->cp865 (string sstart send null-padding)
1878   (declare (optimize speed (safety 0))
1879            (type simple-string string)
1880            (type array-range sstart send))
1881   (values (string->latin% string sstart send #'get-cp865-bytes null-padding)))
1882
1883 (defmacro define-cp865->string* (accessor type)
1884   (declare (ignore type))
1885   (let ((name (make-od-name 'cp865->string* accessor)))
1886     `(progn
1887       (defun ,name (string sstart send array astart aend)
1888         (,(make-od-name 'latin->string* accessor) string sstart send array astart aend #'cp865->code-mapper)))))
1889
1890 (instantiate-octets-definition define-cp865->string*)
1891
1892 (defmacro define-cp865->string (accessor type)
1893   (declare (ignore type))
1894   `(defun ,(make-od-name 'cp865->string accessor) (array astart aend)
1895     (,(make-od-name 'latin->string accessor) array astart aend #'cp865->code-mapper)))
1896
1897 (instantiate-octets-definition define-cp865->string)
1898
1899 (add-external-format-funs '(:cp865 :|cp865|)
1900                           '(cp865->string-aref string->cp865))
1901
1902 (define-external-format (:cp865 :|cp865|)
1903     1 t
1904     (let ((cp865-byte (code->cp865-mapper bits)))
1905       (if cp865-byte
1906           (setf (sap-ref-8 sap tail) cp865-byte)
1907           (external-format-encoding-error stream bits)))
1908     (let ((code (cp865->code-mapper byte)))
1909       (if code
1910           (code-char code)
1911           (external-format-decoding-error stream byte)))) ;; TODO -- error check
1912
1913 (define-unibyte-mapper cp866->code-mapper code->cp866-mapper
1914   (#x80 #x0410) ; CYRILLIC CAPITAL LETTER A
1915   (#x81 #x0411) ; CYRILLIC CAPITAL LETTER BE
1916   (#x82 #x0412) ; CYRILLIC CAPITAL LETTER VE
1917   (#x83 #x0413) ; CYRILLIC CAPITAL LETTER GHE
1918   (#x84 #x0414) ; CYRILLIC CAPITAL LETTER DE
1919   (#x85 #x0415) ; CYRILLIC CAPITAL LETTER IE
1920   (#x86 #x0416) ; CYRILLIC CAPITAL LETTER ZHE
1921   (#x87 #x0417) ; CYRILLIC CAPITAL LETTER ZE
1922   (#x88 #x0418) ; CYRILLIC CAPITAL LETTER I
1923   (#x89 #x0419) ; CYRILLIC CAPITAL LETTER SHORT I
1924   (#x8A #x041A) ; CYRILLIC CAPITAL LETTER KA
1925   (#x8B #x041B) ; CYRILLIC CAPITAL LETTER EL
1926   (#x8C #x041C) ; CYRILLIC CAPITAL LETTER EM
1927   (#x8D #x041D) ; CYRILLIC CAPITAL LETTER EN
1928   (#x8E #x041E) ; CYRILLIC CAPITAL LETTER O
1929   (#x8F #x041F) ; CYRILLIC CAPITAL LETTER PE
1930   (#x90 #x0420) ; CYRILLIC CAPITAL LETTER ER
1931   (#x91 #x0421) ; CYRILLIC CAPITAL LETTER ES
1932   (#x92 #x0422) ; CYRILLIC CAPITAL LETTER TE
1933   (#x93 #x0423) ; CYRILLIC CAPITAL LETTER U
1934   (#x94 #x0424) ; CYRILLIC CAPITAL LETTER EF
1935   (#x95 #x0425) ; CYRILLIC CAPITAL LETTER HA
1936   (#x96 #x0426) ; CYRILLIC CAPITAL LETTER TSE
1937   (#x97 #x0427) ; CYRILLIC CAPITAL LETTER CHE
1938   (#x98 #x0428) ; CYRILLIC CAPITAL LETTER SHA
1939   (#x99 #x0429) ; CYRILLIC CAPITAL LETTER SHCHA
1940   (#x9A #x042A) ; CYRILLIC CAPITAL LETTER HARD SIGN
1941   (#x9B #x042B) ; CYRILLIC CAPITAL LETTER YERU
1942   (#x9C #x042C) ; CYRILLIC CAPITAL LETTER SOFT SIGN
1943   (#x9D #x042D) ; CYRILLIC CAPITAL LETTER E
1944   (#x9E #x042E) ; CYRILLIC CAPITAL LETTER YU
1945   (#x9F #x042F) ; CYRILLIC CAPITAL LETTER YA
1946   (#xA0 #x0430) ; CYRILLIC SMALL LETTER A
1947   (#xA1 #x0431) ; CYRILLIC SMALL LETTER BE
1948   (#xA2 #x0432) ; CYRILLIC SMALL LETTER VE
1949   (#xA3 #x0433) ; CYRILLIC SMALL LETTER GHE
1950   (#xA4 #x0434) ; CYRILLIC SMALL LETTER DE
1951   (#xA5 #x0435) ; CYRILLIC SMALL LETTER IE
1952   (#xA6 #x0436) ; CYRILLIC SMALL LETTER ZHE
1953   (#xA7 #x0437) ; CYRILLIC SMALL LETTER ZE
1954   (#xA8 #x0438) ; CYRILLIC SMALL LETTER I
1955   (#xA9 #x0439) ; CYRILLIC SMALL LETTER SHORT I
1956   (#xAA #x043A) ; CYRILLIC SMALL LETTER KA
1957   (#xAB #x043B) ; CYRILLIC SMALL LETTER EL
1958   (#xAC #x043C) ; CYRILLIC SMALL LETTER EM
1959   (#xAD #x043D) ; CYRILLIC SMALL LETTER EN
1960   (#xAE #x043E) ; CYRILLIC SMALL LETTER O
1961   (#xAF #x043F) ; CYRILLIC SMALL LETTER PE
1962   (#xB0 #x2591) ; LIGHT SHADE
1963   (#xB1 #x2592) ; MEDIUM SHADE
1964   (#xB2 #x2593) ; DARK SHADE
1965   (#xB3 #x2502) ; BOX DRAWINGS LIGHT VERTICAL
1966   (#xB4 #x2524) ; BOX DRAWINGS LIGHT VERTICAL AND LEFT
1967   (#xB5 #x2561) ; BOX DRAWINGS VERTICAL SINGLE AND LEFT DOUBLE
1968   (#xB6 #x2562) ; BOX DRAWINGS VERTICAL DOUBLE AND LEFT SINGLE
1969   (#xB7 #x2556) ; BOX DRAWINGS DOWN DOUBLE AND LEFT SINGLE
1970   (#xB8 #x2555) ; BOX DRAWINGS DOWN SINGLE AND LEFT DOUBLE
1971   (#xB9 #x2563) ; BOX DRAWINGS DOUBLE VERTICAL AND LEFT
1972   (#xBA #x2551) ; BOX DRAWINGS DOUBLE VERTICAL
1973   (#xBB #x2557) ; BOX DRAWINGS DOUBLE DOWN AND LEFT
1974   (#xBC #x255D) ; BOX DRAWINGS DOUBLE UP AND LEFT
1975   (#xBD #x255C) ; BOX DRAWINGS UP DOUBLE AND LEFT SINGLE
1976   (#xBE #x255B) ; BOX DRAWINGS UP SINGLE AND LEFT DOUBLE
1977   (#xBF #x2510) ; BOX DRAWINGS LIGHT DOWN AND LEFT
1978   (#xC0 #x2514) ; BOX DRAWINGS LIGHT UP AND RIGHT
1979   (#xC1 #x2534) ; BOX DRAWINGS LIGHT UP AND HORIZONTAL
1980   (#xC2 #x252C) ; BOX DRAWINGS LIGHT DOWN AND HORIZONTAL
1981   (#xC3 #x251C) ; BOX DRAWINGS LIGHT VERTICAL AND RIGHT
1982   (#xC4 #x2500) ; BOX DRAWINGS LIGHT HORIZONTAL
1983   (#xC5 #x253C) ; BOX DRAWINGS LIGHT VERTICAL AND HORIZONTAL
1984   (#xC6 #x255E) ; BOX DRAWINGS VERTICAL SINGLE AND RIGHT DOUBLE
1985   (#xC7 #x255F) ; BOX DRAWINGS VERTICAL DOUBLE AND RIGHT SINGLE
1986   (#xC8 #x255A) ; BOX DRAWINGS DOUBLE UP AND RIGHT
1987   (#xC9 #x2554) ; BOX DRAWINGS DOUBLE DOWN AND RIGHT
1988   (#xCA #x2569) ; BOX DRAWINGS DOUBLE UP AND HORIZONTAL
1989   (#xCB #x2566) ; BOX DRAWINGS DOUBLE DOWN AND HORIZONTAL
1990   (#xCC #x2560) ; BOX DRAWINGS DOUBLE VERTICAL AND RIGHT
1991   (#xCD #x2550) ; BOX DRAWINGS DOUBLE HORIZONTAL
1992   (#xCE #x256C) ; BOX DRAWINGS DOUBLE VERTICAL AND HORIZONTAL
1993   (#xCF #x2567) ; BOX DRAWINGS UP SINGLE AND HORIZONTAL DOUBLE
1994   (#xD0 #x2568) ; BOX DRAWINGS UP DOUBLE AND HORIZONTAL SINGLE
1995   (#xD1 #x2564) ; BOX DRAWINGS DOWN SINGLE AND HORIZONTAL DOUBLE
1996   (#xD2 #x2565) ; BOX DRAWINGS DOWN DOUBLE AND HORIZONTAL SINGLE
1997   (#xD3 #x2559) ; BOX DRAWINGS UP DOUBLE AND RIGHT SINGLE
1998   (#xD4 #x2558) ; BOX DRAWINGS UP SINGLE AND RIGHT DOUBLE
1999   (#xD5 #x2552) ; BOX DRAWINGS DOWN SINGLE AND RIGHT DOUBLE
2000   (#xD6 #x2553) ; BOX DRAWINGS DOWN DOUBLE AND RIGHT SINGLE
2001   (#xD7 #x256B) ; BOX DRAWINGS VERTICAL DOUBLE AND HORIZONTAL SINGLE
2002   (#xD8 #x256A) ; BOX DRAWINGS VERTICAL SINGLE AND HORIZONTAL DOUBLE
2003   (#xD9 #x2518) ; BOX DRAWINGS LIGHT UP AND LEFT
2004   (#xDA #x250C) ; BOX DRAWINGS LIGHT DOWN AND RIGHT
2005   (#xDB #x2588) ; FULL BLOCK
2006   (#xDC #x2584) ; LOWER HALF BLOCK
2007   (#xDD #x258C) ; LEFT HALF BLOCK
2008   (#xDE #x2590) ; RIGHT HALF BLOCK
2009   (#xDF #x2580) ; UPPER HALF BLOCK
2010   (#xE0 #x0440) ; CYRILLIC SMALL LETTER ER
2011   (#xE1 #x0441) ; CYRILLIC SMALL LETTER ES
2012   (#xE2 #x0442) ; CYRILLIC SMALL LETTER TE
2013   (#xE3 #x0443) ; CYRILLIC SMALL LETTER U
2014   (#xE4 #x0444) ; CYRILLIC SMALL LETTER EF
2015   (#xE5 #x0445) ; CYRILLIC SMALL LETTER HA
2016   (#xE6 #x0446) ; CYRILLIC SMALL LETTER TSE
2017   (#xE7 #x0447) ; CYRILLIC SMALL LETTER CHE
2018   (#xE8 #x0448) ; CYRILLIC SMALL LETTER SHA
2019   (#xE9 #x0449) ; CYRILLIC SMALL LETTER SHCHA
2020   (#xEA #x044A) ; CYRILLIC SMALL LETTER HARD SIGN
2021   (#xEB #x044B) ; CYRILLIC SMALL LETTER YERU
2022   (#xEC #x044C) ; CYRILLIC SMALL LETTER SOFT SIGN
2023   (#xED #x044D) ; CYRILLIC SMALL LETTER E
2024   (#xEE #x044E) ; CYRILLIC SMALL LETTER YU
2025   (#xEF #x044F) ; CYRILLIC SMALL LETTER YA
2026   (#xF0 #x0401) ; CYRILLIC CAPITAL LETTER IO
2027   (#xF1 #x0451) ; CYRILLIC SMALL LETTER IO
2028   (#xF2 #x0404) ; CYRILLIC CAPITAL LETTER UKRAINIAN IE
2029   (#xF3 #x0454) ; CYRILLIC SMALL LETTER UKRAINIAN IE
2030   (#xF4 #x0407) ; CYRILLIC CAPITAL LETTER YI
2031   (#xF5 #x0457) ; CYRILLIC SMALL LETTER YI
2032   (#xF6 #x040E) ; CYRILLIC CAPITAL LETTER SHORT U
2033   (#xF7 #x045E) ; CYRILLIC SMALL LETTER SHORT U
2034   (#xF8 #x00B0) ; DEGREE SIGN
2035   (#xF9 #x2219) ; BULLET OPERATOR
2036   (#xFA #x00B7) ; MIDDLE DOT
2037   (#xFB #x221A) ; SQUARE ROOT
2038   (#xFC #x2116) ; NUMERO SIGN
2039   (#xFD #x00A4) ; CURRENCY SIGN
2040   (#xFE #x25A0) ; BLACK SQUARE
2041   (#xFF #x00A0) ; NO-BREAK SPACE
2042 )
2043
2044 (declaim (inline get-cp866-bytes))
2045 (defun get-cp866-bytes (string pos)
2046   (declare (optimize speed (safety 0))
2047            (type simple-string string)
2048            (type array-range pos))
2049   (get-latin-bytes #'code->cp866-mapper :cp866 string pos))
2050
2051 (defun string->cp866 (string sstart send null-padding)
2052   (declare (optimize speed (safety 0))
2053            (type simple-string string)
2054            (type array-range sstart send))
2055   (values (string->latin% string sstart send #'get-cp866-bytes null-padding)))
2056
2057 (defmacro define-cp866->string* (accessor type)
2058   (declare (ignore type))
2059   (let ((name (make-od-name 'cp866->string* accessor)))
2060     `(progn
2061       (defun ,name (string sstart send array astart aend)
2062         (,(make-od-name 'latin->string* accessor) string sstart send array astart aend #'cp866->code-mapper)))))
2063
2064 (instantiate-octets-definition define-cp866->string*)
2065
2066 (defmacro define-cp866->string (accessor type)
2067   (declare (ignore type))
2068   `(defun ,(make-od-name 'cp866->string accessor) (array astart aend)
2069     (,(make-od-name 'latin->string accessor) array astart aend #'cp866->code-mapper)))
2070
2071 (instantiate-octets-definition define-cp866->string)
2072
2073 (add-external-format-funs '(:cp866 :|cp866|)
2074                           '(cp866->string-aref string->cp866))
2075
2076 (define-external-format (:cp866 :|cp866|)
2077     1 t
2078     (let ((cp866-byte (code->cp866-mapper bits)))
2079       (if cp866-byte
2080           (setf (sap-ref-8 sap tail) cp866-byte)
2081           (external-format-encoding-error stream bits)))
2082     (let ((code (cp866->code-mapper byte)))
2083       (if code
2084           (code-char code)
2085           (external-format-decoding-error stream byte)))) ;; TODO -- error check
2086
2087 (define-unibyte-mapper cp869->code-mapper code->cp869-mapper
2088   (#x80 nil)
2089   (#x81 nil)
2090   (#x82 nil)
2091   (#x83 nil)
2092   (#x84 nil)
2093   (#x85 nil)
2094   (#x86 #x0386) ; GREEK CAPITAL LETTER ALPHA WITH TONOS
2095   (#x87 nil)
2096   (#x88 #x00B7) ; MIDDLE DOT
2097   (#x89 #x00AC) ; NOT SIGN
2098   (#x8A #x00A6) ; BROKEN BAR
2099   (#x8B #x2018) ; LEFT SINGLE QUOTATION MARK
2100   (#x8C #x2019) ; RIGHT SINGLE QUOTATION MARK
2101   (#x8D #x0388) ; GREEK CAPITAL LETTER EPSILON WITH TONOS
2102   (#x8E #x2015) ; HORIZONTAL BAR
2103   (#x8F #x0389) ; GREEK CAPITAL LETTER ETA WITH TONOS
2104   (#x90 #x038A) ; GREEK CAPITAL LETTER IOTA WITH TONOS
2105   (#x91 #x03AA) ; GREEK CAPITAL LETTER IOTA WITH DIALYTIKA
2106   (#x92 #x038C) ; GREEK CAPITAL LETTER OMICRON WITH TONOS
2107   (#x93 nil)
2108   (#x94 nil)
2109   (#x95 #x038E) ; GREEK CAPITAL LETTER UPSILON WITH TONOS
2110   (#x96 #x03AB) ; GREEK CAPITAL LETTER UPSILON WITH DIALYTIKA
2111   (#x97 #x00A9) ; COPYRIGHT SIGN
2112   (#x98 #x038F) ; GREEK CAPITAL LETTER OMEGA WITH TONOS
2113   (#x99 #x00B2) ; SUPERSCRIPT TWO
2114   (#x9A #x00B3) ; SUPERSCRIPT THREE
2115   (#x9B #x03AC) ; GREEK SMALL LETTER ALPHA WITH TONOS
2116   (#x9C #x00A3) ; POUND SIGN
2117   (#x9D #x03AD) ; GREEK SMALL LETTER EPSILON WITH TONOS
2118   (#x9E #x03AE) ; GREEK SMALL LETTER ETA WITH TONOS
2119   (#x9F #x03AF) ; GREEK SMALL LETTER IOTA WITH TONOS
2120   (#xA0 #x03CA) ; GREEK SMALL LETTER IOTA WITH DIALYTIKA
2121   (#xA1 #x0390) ; GREEK SMALL LETTER IOTA WITH DIALYTIKA AND TONOS
2122   (#xA2 #x03CC) ; GREEK SMALL LETTER OMICRON WITH TONOS
2123   (#xA3 #x03CD) ; GREEK SMALL LETTER UPSILON WITH TONOS
2124   (#xA4 #x0391) ; GREEK CAPITAL LETTER ALPHA
2125   (#xA5 #x0392) ; GREEK CAPITAL LETTER BETA
2126   (#xA6 #x0393) ; GREEK CAPITAL LETTER GAMMA
2127   (#xA7 #x0394) ; GREEK CAPITAL LETTER DELTA
2128   (#xA8 #x0395) ; GREEK CAPITAL LETTER EPSILON
2129   (#xA9 #x0396) ; GREEK CAPITAL LETTER ZETA
2130   (#xAA #x0397) ; GREEK CAPITAL LETTER ETA
2131   (#xAB #x00BD) ; VULGAR FRACTION ONE HALF
2132   (#xAC #x0398) ; GREEK CAPITAL LETTER THETA
2133   (#xAD #x0399) ; GREEK CAPITAL LETTER IOTA
2134   (#xAE #x00AB) ; LEFT-POINTING DOUBLE ANGLE QUOTATION MARK
2135   (#xAF #x00BB) ; RIGHT-POINTING DOUBLE ANGLE QUOTATION MARK
2136   (#xB0 #x2591) ; LIGHT SHADE
2137   (#xB1 #x2592) ; MEDIUM SHADE
2138   (#xB2 #x2593) ; DARK SHADE
2139   (#xB3 #x2502) ; BOX DRAWINGS LIGHT VERTICAL
2140   (#xB4 #x2524) ; BOX DRAWINGS LIGHT VERTICAL AND LEFT
2141   (#xB5 #x039A) ; GREEK CAPITAL LETTER KAPPA
2142   (#xB6 #x039B) ; GREEK CAPITAL LETTER LAMDA
2143   (#xB7 #x039C) ; GREEK CAPITAL LETTER MU
2144   (#xB8 #x039D) ; GREEK CAPITAL LETTER NU
2145   (#xB9 #x2563) ; BOX DRAWINGS DOUBLE VERTICAL AND LEFT
2146   (#xBA #x2551) ; BOX DRAWINGS DOUBLE VERTICAL
2147   (#xBB #x2557) ; BOX DRAWINGS DOUBLE DOWN AND LEFT
2148   (#xBC #x255D) ; BOX DRAWINGS DOUBLE UP AND LEFT
2149   (#xBD #x039E) ; GREEK CAPITAL LETTER XI
2150   (#xBE #x039F) ; GREEK CAPITAL LETTER OMICRON
2151   (#xBF #x2510) ; BOX DRAWINGS LIGHT DOWN AND LEFT
2152   (#xC0 #x2514) ; BOX DRAWINGS LIGHT UP AND RIGHT
2153   (#xC1 #x2534) ; BOX DRAWINGS LIGHT UP AND HORIZONTAL
2154   (#xC2 #x252C) ; BOX DRAWINGS LIGHT DOWN AND HORIZONTAL
2155   (#xC3 #x251C) ; BOX DRAWINGS LIGHT VERTICAL AND RIGHT
2156   (#xC4 #x2500) ; BOX DRAWINGS LIGHT HORIZONTAL
2157   (#xC5 #x253C) ; BOX DRAWINGS LIGHT VERTICAL AND HORIZONTAL
2158   (#xC6 #x03A0) ; GREEK CAPITAL LETTER PI
2159   (#xC7 #x03A1) ; GREEK CAPITAL LETTER RHO
2160   (#xC8 #x255A) ; BOX DRAWINGS DOUBLE UP AND RIGHT
2161   (#xC9 #x2554) ; BOX DRAWINGS DOUBLE DOWN AND RIGHT
2162   (#xCA #x2569) ; BOX DRAWINGS DOUBLE UP AND HORIZONTAL
2163   (#xCB #x2566) ; BOX DRAWINGS DOUBLE DOWN AND HORIZONTAL
2164   (#xCC #x2560) ; BOX DRAWINGS DOUBLE VERTICAL AND RIGHT
2165   (#xCD #x2550) ; BOX DRAWINGS DOUBLE HORIZONTAL
2166   (#xCE #x256C) ; BOX DRAWINGS DOUBLE VERTICAL AND HORIZONTAL
2167   (#xCF #x03A3) ; GREEK CAPITAL LETTER SIGMA
2168   (#xD0 #x03A4) ; GREEK CAPITAL LETTER TAU
2169   (#xD1 #x03A5) ; GREEK CAPITAL LETTER UPSILON
2170   (#xD2 #x03A6) ; GREEK CAPITAL LETTER PHI
2171   (#xD3 #x03A7) ; GREEK CAPITAL LETTER CHI
2172   (#xD4 #x03A8) ; GREEK CAPITAL LETTER PSI
2173   (#xD5 #x03A9) ; GREEK CAPITAL LETTER OMEGA
2174   (#xD6 #x03B1) ; GREEK SMALL LETTER ALPHA
2175   (#xD7 #x03B2) ; GREEK SMALL LETTER BETA
2176   (#xD8 #x03B3) ; GREEK SMALL LETTER GAMMA
2177   (#xD9 #x2518) ; BOX DRAWINGS LIGHT UP AND LEFT
2178   (#xDA #x250C) ; BOX DRAWINGS LIGHT DOWN AND RIGHT
2179   (#xDB #x2588) ; FULL BLOCK
2180   (#xDC #x2584) ; LOWER HALF BLOCK
2181   (#xDD #x03B4) ; GREEK SMALL LETTER DELTA
2182   (#xDE #x03B5) ; GREEK SMALL LETTER EPSILON
2183   (#xDF #x2580) ; UPPER HALF BLOCK
2184   (#xE0 #x03B6) ; GREEK SMALL LETTER ZETA
2185   (#xE1 #x03B7) ; GREEK SMALL LETTER ETA
2186   (#xE2 #x03B8) ; GREEK SMALL LETTER THETA
2187   (#xE3 #x03B9) ; GREEK SMALL LETTER IOTA
2188   (#xE4 #x03BA) ; GREEK SMALL LETTER KAPPA
2189   (#xE5 #x03BB) ; GREEK SMALL LETTER LAMDA
2190   (#xE6 #x03BC) ; GREEK SMALL LETTER MU
2191   (#xE7 #x03BD) ; GREEK SMALL LETTER NU
2192   (#xE8 #x03BE) ; GREEK SMALL LETTER XI
2193   (#xE9 #x03BF) ; GREEK SMALL LETTER OMICRON
2194   (#xEA #x03C0) ; GREEK SMALL LETTER PI
2195   (#xEB #x03C1) ; GREEK SMALL LETTER RHO
2196   (#xEC #x03C3) ; GREEK SMALL LETTER SIGMA
2197   (#xED #x03C2) ; GREEK SMALL LETTER FINAL SIGMA
2198   (#xEE #x03C4) ; GREEK SMALL LETTER TAU
2199   (#xEF #x0384) ; GREEK TONOS
2200   (#xF0 #x00AD) ; SOFT HYPHEN
2201   (#xF1 #x00B1) ; PLUS-MINUS SIGN
2202   (#xF2 #x03C5) ; GREEK SMALL LETTER UPSILON
2203   (#xF3 #x03C6) ; GREEK SMALL LETTER PHI
2204   (#xF4 #x03C7) ; GREEK SMALL LETTER CHI
2205   (#xF5 #x00A7) ; SECTION SIGN
2206   (#xF6 #x03C8) ; GREEK SMALL LETTER PSI
2207   (#xF7 #x0385) ; GREEK DIALYTIKA TONOS
2208   (#xF8 #x00B0) ; DEGREE SIGN
2209   (#xF9 #x00A8) ; DIAERESIS
2210   (#xFA #x03C9) ; GREEK SMALL LETTER OMEGA
2211   (#xFB #x03CB) ; GREEK SMALL LETTER UPSILON WITH DIALYTIKA
2212   (#xFC #x03B0) ; GREEK SMALL LETTER UPSILON WITH DIALYTIKA AND TONOS
2213   (#xFD #x03CE) ; GREEK SMALL LETTER OMEGA WITH TONOS
2214   (#xFE #x25A0) ; BLACK SQUARE
2215   (#xFF #x00A0) ; NO-BREAK SPACE
2216 )
2217
2218 (declaim (inline get-cp869-bytes))
2219 (defun get-cp869-bytes (string pos)
2220   (declare (optimize speed (safety 0))
2221            (type simple-string string)
2222            (type array-range pos))
2223   (get-latin-bytes #'code->cp869-mapper :cp869 string pos))
2224
2225 (defun string->cp869 (string sstart send null-padding)
2226   (declare (optimize speed (safety 0))
2227            (type simple-string string)
2228            (type array-range sstart send))
2229   (values (string->latin% string sstart send #'get-cp869-bytes null-padding)))
2230
2231 (defmacro define-cp869->string* (accessor type)
2232   (declare (ignore type))
2233   (let ((name (make-od-name 'cp869->string* accessor)))
2234     `(progn
2235       (defun ,name (string sstart send array astart aend)
2236         (,(make-od-name 'latin->string* accessor) string sstart send array astart aend #'cp869->code-mapper)))))
2237
2238 (instantiate-octets-definition define-cp869->string*)
2239
2240 (defmacro define-cp869->string (accessor type)
2241   (declare (ignore type))
2242   `(defun ,(make-od-name 'cp869->string accessor) (array astart aend)
2243     (,(make-od-name 'latin->string accessor) array astart aend #'cp869->code-mapper)))
2244
2245 (instantiate-octets-definition define-cp869->string)
2246
2247 (add-external-format-funs '(:cp869 :|cp869|)
2248                           '(cp869->string-aref string->cp869))
2249
2250 (define-external-format (:cp869 :|cp869|)
2251     1 t
2252     (let ((cp869-byte (code->cp869-mapper bits)))
2253       (if cp869-byte
2254           (setf (sap-ref-8 sap tail) cp869-byte)
2255           (external-format-encoding-error stream bits)))
2256     (let ((code (cp869->code-mapper byte)))
2257       (if code
2258           (code-char code)
2259           (external-format-decoding-error stream byte)))) ;; TODO -- error check
2260
2261 (define-unibyte-mapper cp874->code-mapper code->cp874-mapper
2262   (#x80 #x20AC) ; EURO SIGN
2263   (#x81 nil)
2264   (#x82 nil)
2265   (#x83 nil)
2266   (#x84 nil)
2267   (#x85 #x2026) ; HORIZONTAL ELLIPSIS
2268   (#x86 nil)
2269   (#x87 nil)
2270   (#x88 nil)
2271   (#x89 nil)
2272   (#x8A nil)
2273   (#x8B nil)
2274   (#x8C nil)
2275   (#x8D nil)
2276   (#x8E nil)
2277   (#x8F nil)
2278   (#x90 nil)
2279   (#x91 #x2018) ; LEFT SINGLE QUOTATION MARK
2280   (#x92 #x2019) ; RIGHT SINGLE QUOTATION MARK
2281   (#x93 #x201C) ; LEFT DOUBLE QUOTATION MARK
2282   (#x94 #x201D) ; RIGHT DOUBLE QUOTATION MARK
2283   (#x95 #x2022) ; BULLET
2284   (#x96 #x2013) ; EN DASH
2285   (#x97 #x2014) ; EM DASH
2286   (#x98 nil)
2287   (#x99 nil)
2288   (#x9A nil)
2289   (#x9B nil)
2290   (#x9C nil)
2291   (#x9D nil)
2292   (#x9E nil)
2293   (#x9F nil)
2294   (#xA1 #x0E01) ; THAI CHARACTER KO KAI
2295   (#xA2 #x0E02) ; THAI CHARACTER KHO KHAI
2296   (#xA3 #x0E03) ; THAI CHARACTER KHO KHUAT
2297   (#xA4 #x0E04) ; THAI CHARACTER KHO KHWAI
2298   (#xA5 #x0E05) ; THAI CHARACTER KHO KHON
2299   (#xA6 #x0E06) ; THAI CHARACTER KHO RAKHANG
2300   (#xA7 #x0E07) ; THAI CHARACTER NGO NGU
2301   (#xA8 #x0E08) ; THAI CHARACTER CHO CHAN
2302   (#xA9 #x0E09) ; THAI CHARACTER CHO CHING
2303   (#xAA #x0E0A) ; THAI CHARACTER CHO CHANG
2304   (#xAB #x0E0B) ; THAI CHARACTER SO SO
2305   (#xAC #x0E0C) ; THAI CHARACTER CHO CHOE
2306   (#xAD #x0E0D) ; THAI CHARACTER YO YING
2307   (#xAE #x0E0E) ; THAI CHARACTER DO CHADA
2308   (#xAF #x0E0F) ; THAI CHARACTER TO PATAK
2309   (#xB0 #x0E10) ; THAI CHARACTER THO THAN
2310   (#xB1 #x0E11) ; THAI CHARACTER THO NANGMONTHO
2311   (#xB2 #x0E12) ; THAI CHARACTER THO PHUTHAO
2312   (#xB3 #x0E13) ; THAI CHARACTER NO NEN
2313   (#xB4 #x0E14) ; THAI CHARACTER DO DEK
2314   (#xB5 #x0E15) ; THAI CHARACTER TO TAO
2315   (#xB6 #x0E16) ; THAI CHARACTER THO THUNG
2316   (#xB7 #x0E17) ; THAI CHARACTER THO THAHAN
2317   (#xB8 #x0E18) ; THAI CHARACTER THO THONG
2318   (#xB9 #x0E19) ; THAI CHARACTER NO NU
2319   (#xBA #x0E1A) ; THAI CHARACTER BO BAIMAI
2320   (#xBB #x0E1B) ; THAI CHARACTER PO PLA
2321   (#xBC #x0E1C) ; THAI CHARACTER PHO PHUNG
2322   (#xBD #x0E1D) ; THAI CHARACTER FO FA
2323   (#xBE #x0E1E) ; THAI CHARACTER PHO PHAN
2324   (#xBF #x0E1F) ; THAI CHARACTER FO FAN
2325   (#xC0 #x0E20) ; THAI CHARACTER PHO SAMPHAO
2326   (#xC1 #x0E21) ; THAI CHARACTER MO MA
2327   (#xC2 #x0E22) ; THAI CHARACTER YO YAK
2328   (#xC3 #x0E23) ; THAI CHARACTER RO RUA
2329   (#xC4 #x0E24) ; THAI CHARACTER RU
2330   (#xC5 #x0E25) ; THAI CHARACTER LO LING
2331   (#xC6 #x0E26) ; THAI CHARACTER LU
2332   (#xC7 #x0E27) ; THAI CHARACTER WO WAEN
2333   (#xC8 #x0E28) ; THAI CHARACTER SO SALA
2334   (#xC9 #x0E29) ; THAI CHARACTER SO RUSI
2335   (#xCA #x0E2A) ; THAI CHARACTER SO SUA
2336   (#xCB #x0E2B) ; THAI CHARACTER HO HIP
2337   (#xCC #x0E2C) ; THAI CHARACTER LO CHULA
2338   (#xCD #x0E2D) ; THAI CHARACTER O ANG
2339   (#xCE #x0E2E) ; THAI CHARACTER HO NOKHUK
2340   (#xCF #x0E2F) ; THAI CHARACTER PAIYANNOI
2341   (#xD0 #x0E30) ; THAI CHARACTER SARA A
2342   (#xD1 #x0E31) ; THAI CHARACTER MAI HAN-AKAT
2343   (#xD2 #x0E32) ; THAI CHARACTER SARA AA
2344   (#xD3 #x0E33) ; THAI CHARACTER SARA AM
2345   (#xD4 #x0E34) ; THAI CHARACTER SARA I
2346   (#xD5 #x0E35) ; THAI CHARACTER SARA II
2347   (#xD6 #x0E36) ; THAI CHARACTER SARA UE
2348   (#xD7 #x0E37) ; THAI CHARACTER SARA UEE
2349   (#xD8 #x0E38) ; THAI CHARACTER SARA U
2350   (#xD9 #x0E39) ; THAI CHARACTER SARA UU
2351   (#xDA #x0E3A) ; THAI CHARACTER PHINTHU
2352   (#xDB nil)
2353   (#xDC nil)
2354   (#xDD nil)
2355   (#xDE nil)
2356   (#xDF #x0E3F) ; THAI CURRENCY SYMBOL BAHT
2357   (#xE0 #x0E40) ; THAI CHARACTER SARA E
2358   (#xE1 #x0E41) ; THAI CHARACTER SARA AE
2359   (#xE2 #x0E42) ; THAI CHARACTER SARA O
2360   (#xE3 #x0E43) ; THAI CHARACTER SARA AI MAIMUAN
2361   (#xE4 #x0E44) ; THAI CHARACTER SARA AI MAIMALAI
2362   (#xE5 #x0E45) ; THAI CHARACTER LAKKHANGYAO
2363   (#xE6 #x0E46) ; THAI CHARACTER MAIYAMOK
2364   (#xE7 #x0E47) ; THAI CHARACTER MAITAIKHU
2365   (#xE8 #x0E48) ; THAI CHARACTER MAI EK
2366   (#xE9 #x0E49) ; THAI CHARACTER MAI THO
2367   (#xEA #x0E4A) ; THAI CHARACTER MAI TRI
2368   (#xEB #x0E4B) ; THAI CHARACTER MAI CHATTAWA
2369   (#xEC #x0E4C) ; THAI CHARACTER THANTHAKHAT
2370   (#xED #x0E4D) ; THAI CHARACTER NIKHAHIT
2371   (#xEE #x0E4E) ; THAI CHARACTER YAMAKKAN
2372   (#xEF #x0E4F) ; THAI CHARACTER FONGMAN
2373   (#xF0 #x0E50) ; THAI DIGIT ZERO
2374   (#xF1 #x0E51) ; THAI DIGIT ONE
2375   (#xF2 #x0E52) ; THAI DIGIT TWO
2376   (#xF3 #x0E53) ; THAI DIGIT THREE
2377   (#xF4 #x0E54) ; THAI DIGIT FOUR
2378   (#xF5 #x0E55) ; THAI DIGIT FIVE
2379   (#xF6 #x0E56) ; THAI DIGIT SIX
2380   (#xF7 #x0E57) ; THAI DIGIT SEVEN
2381   (#xF8 #x0E58) ; THAI DIGIT EIGHT
2382   (#xF9 #x0E59) ; THAI DIGIT NINE
2383   (#xFA #x0E5A) ; THAI CHARACTER ANGKHANKHU
2384   (#xFB #x0E5B) ; THAI CHARACTER KHOMUT
2385   (#xFC nil)
2386   (#xFD nil)
2387   (#xFE nil)
2388   (#xFF nil)
2389 )
2390
2391 (declaim (inline get-cp874-bytes))
2392 (defun get-cp874-bytes (string pos)
2393   (declare (optimize speed (safety 0))
2394            (type simple-string string)
2395            (type array-range pos))
2396   (get-latin-bytes #'code->cp874-mapper :cp874 string pos))
2397
2398 (defun string->cp874 (string sstart send null-padding)
2399   (declare (optimize speed (safety 0))
2400            (type simple-string string)
2401            (type array-range sstart send))
2402   (values (string->latin% string sstart send #'get-cp874-bytes null-padding)))
2403
2404 (defmacro define-cp874->string* (accessor type)
2405   (declare (ignore type))
2406   (let ((name (make-od-name 'cp874->string* accessor)))
2407     `(progn
2408       (defun ,name (string sstart send array astart aend)
2409         (,(make-od-name 'latin->string* accessor) string sstart send array astart aend #'cp874->code-mapper)))))
2410
2411 (instantiate-octets-definition define-cp874->string*)
2412
2413 (defmacro define-cp874->string (accessor type)
2414   (declare (ignore type))
2415   `(defun ,(make-od-name 'cp874->string accessor) (array astart aend)
2416     (,(make-od-name 'latin->string accessor) array astart aend #'cp874->code-mapper)))
2417
2418 (instantiate-octets-definition define-cp874->string)
2419
2420 (add-external-format-funs '(:cp874 :|cp874|)
2421                           '(cp874->string-aref string->cp874))
2422
2423 (define-external-format (:cp874 :|cp874|)
2424     1 t
2425     (let ((cp874-byte (code->cp874-mapper bits)))
2426       (if cp874-byte
2427           (setf (sap-ref-8 sap tail) cp874-byte)
2428           (external-format-encoding-error stream bits)))
2429     (let ((code (cp874->code-mapper byte)))
2430       (if code
2431           (code-char code)
2432           (external-format-decoding-error stream byte)))) ;; TODO -- error check