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