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

   1 (in-package "SB!IMPL")
   2
   3 (define-unibyte-mapper koi8-r->code-mapper code->koi8-r-mapper
   4   (#x80 #x2500) ; BOX DRAWINGS LIGHT HORIZONTAL
   5   (#x81 #x2502) ; BOX DRAWINGS LIGHT VERTICAL
   6   (#x82 #x250C) ; BOX DRAWINGS LIGHT DOWN AND RIGHT
   7   (#x83 #x2510) ; BOX DRAWINGS LIGHT DOWN AND LEFT
   8   (#x84 #x2514) ; BOX DRAWINGS LIGHT UP AND RIGHT
   9   (#x85 #x2518) ; BOX DRAWINGS LIGHT UP AND LEFT
  10   (#x86 #x251C) ; BOX DRAWINGS LIGHT VERTICAL AND RIGHT
  11   (#x87 #x2524) ; BOX DRAWINGS LIGHT VERTICAL AND LEFT
  12   (#x88 #x252C) ; BOX DRAWINGS LIGHT DOWN AND HORIZONTAL
  13   (#x89 #x2534) ; BOX DRAWINGS LIGHT UP AND HORIZONTAL
  14   (#x8A #x253C) ; BOX DRAWINGS LIGHT VERTICAL AND HORIZONTAL
  15   (#x8B #x2580) ; UPPER HALF BLOCK
  16   (#x8C #x2584) ; LOWER HALF BLOCK
  17   (#x8D #x2588) ; FULL BLOCK
  18   (#x8E #x258C) ; LEFT HALF BLOCK
  19   (#x8F #x2590) ; RIGHT HALF BLOCK
  20   (#x90 #x2591) ; LIGHT SHADE
  21   (#x91 #x2592) ; MEDIUM SHADE
  22   (#x92 #x2593) ; DARK SHADE
  23   (#x93 #x2320) ; UPPER HALF OF INTEGRAL
  24   (#x94 #x25A0) ; BLACK SQUARE
  25   (#x95 #x2219) ; BULLET OPERATOR
  26   (#x96 #x221A) ; SQUARE ROOT
  27   (#x97 #x2248) ; ALMOST EQUAL TO
  28   (#x98 #x2264) ; LESS-THAN OR EQUAL TO
  29   (#x99 #x2265) ; GREATER-THAN OR EQUAL TO
  30   (#x9A #x00A0) ; NO-BREAK SPACE
  31   (#x9B #x2321) ; LOWER HALF OF INTEGRAL
  32   (#x9C #x00B0) ; DEGREE SIGN
  33   (#x9D #x00B2) ; SUPERSCRIPT TWO
  34   (#x9E #x00B7) ; MIDDLE DOT
  35   (#x9F #x00F7) ; DIVISION SIGN
  36   (#xA0 #x2550) ; BOX DRAWINGS DOUBLE HORIZONTAL
  37   (#xA1 #x2551) ; BOX DRAWINGS DOUBLE VERTICAL
  38   (#xA2 #x2552) ; BOX DRAWINGS DOWN SINGLE AND RIGHT DOUBLE
  39   (#xA3 #x0451) ; CYRILLIC SMALL LETTER IO
  40   (#xA4 #x2553) ; BOX DRAWINGS DOWN DOUBLE AND RIGHT SINGLE
  41   (#xA5 #x2554) ; BOX DRAWINGS DOUBLE DOWN AND RIGHT
  42   (#xA6 #x2555) ; BOX DRAWINGS DOWN SINGLE AND LEFT DOUBLE
  43   (#xA7 #x2556) ; BOX DRAWINGS DOWN DOUBLE AND LEFT SINGLE
  44   (#xA8 #x2557) ; BOX DRAWINGS DOUBLE DOWN AND LEFT
  45   (#xA9 #x2558) ; BOX DRAWINGS UP SINGLE AND RIGHT DOUBLE
  46   (#xAA #x2559) ; BOX DRAWINGS UP DOUBLE AND RIGHT SINGLE
  47   (#xAB #x255A) ; BOX DRAWINGS DOUBLE UP AND RIGHT
  48   (#xAC #x255B) ; BOX DRAWINGS UP SINGLE AND LEFT DOUBLE
  49   (#xAD #x255C) ; BOX DRAWINGS UP DOUBLE AND LEFT SINGLE
  50   (#xAE #x255D) ; BOX DRAWINGS DOUBLE UP AND LEFT
  51   (#xAF #x255E) ; BOX DRAWINGS VERTICAL SINGLE AND RIGHT DOUBLE
  52   (#xB0 #x255F) ; BOX DRAWINGS VERTICAL DOUBLE AND RIGHT SINGLE
  53   (#xB1 #x2560) ; BOX DRAWINGS DOUBLE VERTICAL AND RIGHT
  54   (#xB2 #x2561) ; BOX DRAWINGS VERTICAL SINGLE AND LEFT DOUBLE
  55   (#xB3 #x0401) ; CYRILLIC CAPITAL LETTER IO
  56   (#xB4 #x2562) ; BOX DRAWINGS VERTICAL DOUBLE AND LEFT SINGLE
  57   (#xB5 #x2563) ; BOX DRAWINGS DOUBLE VERTICAL AND LEFT
  58   (#xB6 #x2564) ; BOX DRAWINGS DOWN SINGLE AND HORIZONTAL DOUBLE
  59   (#xB7 #x2565) ; BOX DRAWINGS DOWN DOUBLE AND HORIZONTAL SINGLE
  60   (#xB8 #x2566) ; BOX DRAWINGS DOUBLE DOWN AND HORIZONTAL
  61   (#xB9 #x2567) ; BOX DRAWINGS UP SINGLE AND HORIZONTAL DOUBLE
  62   (#xBA #x2568) ; BOX DRAWINGS UP DOUBLE AND HORIZONTAL SINGLE
  63   (#xBB #x2569) ; BOX DRAWINGS DOUBLE UP AND HORIZONTAL
  64   (#xBC #x256A) ; BOX DRAWINGS VERTICAL SINGLE AND HORIZONTAL DOUBLE
  65   (#xBD #x256B) ; BOX DRAWINGS VERTICAL DOUBLE AND HORIZONTAL SINGLE
  66   (#xBE #x256C) ; BOX DRAWINGS DOUBLE VERTICAL AND HORIZONTAL
  67   (#xBF #x00A9) ; COPYRIGHT SIGN
  68   (#xC0 #x044E) ; CYRILLIC SMALL LETTER YU
  69   (#xC1 #x0430) ; CYRILLIC SMALL LETTER A
  70   (#xC2 #x0431) ; CYRILLIC SMALL LETTER BE
  71   (#xC3 #x0446) ; CYRILLIC SMALL LETTER TSE
  72   (#xC4 #x0434) ; CYRILLIC SMALL LETTER DE
  73   (#xC5 #x0435) ; CYRILLIC SMALL LETTER IE
  74   (#xC6 #x0444) ; CYRILLIC SMALL LETTER EF
  75   (#xC7 #x0433) ; CYRILLIC SMALL LETTER GHE
  76   (#xC8 #x0445) ; CYRILLIC SMALL LETTER HA
  77   (#xC9 #x0438) ; CYRILLIC SMALL LETTER I
  78   (#xCA #x0439) ; CYRILLIC SMALL LETTER SHORT I
  79   (#xCB #x043A) ; CYRILLIC SMALL LETTER KA
  80   (#xCC #x043B) ; CYRILLIC SMALL LETTER EL
  81   (#xCD #x043C) ; CYRILLIC SMALL LETTER EM
  82   (#xCE #x043D) ; CYRILLIC SMALL LETTER EN
  83   (#xCF #x043E) ; CYRILLIC SMALL LETTER O
  84   (#xD0 #x043F) ; CYRILLIC SMALL LETTER PE
  85   (#xD1 #x044F) ; CYRILLIC SMALL LETTER YA
  86   (#xD2 #x0440) ; CYRILLIC SMALL LETTER ER
  87   (#xD3 #x0441) ; CYRILLIC SMALL LETTER ES
  88   (#xD4 #x0442) ; CYRILLIC SMALL LETTER TE
  89   (#xD5 #x0443) ; CYRILLIC SMALL LETTER U
  90   (#xD6 #x0436) ; CYRILLIC SMALL LETTER ZHE
  91   (#xD7 #x0432) ; CYRILLIC SMALL LETTER VE
  92   (#xD8 #x044C) ; CYRILLIC SMALL LETTER SOFT SIGN
  93   (#xD9 #x044B) ; CYRILLIC SMALL LETTER YERU
  94   (#xDA #x0437) ; CYRILLIC SMALL LETTER ZE
  95   (#xDB #x0448) ; CYRILLIC SMALL LETTER SHA
  96   (#xDC #x044D) ; CYRILLIC SMALL LETTER E
  97   (#xDD #x0449) ; CYRILLIC SMALL LETTER SHCHA
  98   (#xDE #x0447) ; CYRILLIC SMALL LETTER CHE
  99   (#xDF #x044A) ; CYRILLIC SMALL LETTER HARD SIGN
 100   (#xE0 #x042E) ; CYRILLIC CAPITAL LETTER YU
 101   (#xE1 #x0410) ; CYRILLIC CAPITAL LETTER A
 102   (#xE2 #x0411) ; CYRILLIC CAPITAL LETTER BE
 103   (#xE3 #x0426) ; CYRILLIC CAPITAL LETTER TSE
 104   (#xE4 #x0414) ; CYRILLIC CAPITAL LETTER DE
 105   (#xE5 #x0415) ; CYRILLIC CAPITAL LETTER IE
 106   (#xE6 #x0424) ; CYRILLIC CAPITAL LETTER EF
 107   (#xE7 #x0413) ; CYRILLIC CAPITAL LETTER GHE
 108   (#xE8 #x0425) ; CYRILLIC CAPITAL LETTER HA
 109   (#xE9 #x0418) ; CYRILLIC CAPITAL LETTER I
 110   (#xEA #x0419) ; CYRILLIC CAPITAL LETTER SHORT I
 111   (#xEB #x041A) ; CYRILLIC CAPITAL LETTER KA
 112   (#xEC #x041B) ; CYRILLIC CAPITAL LETTER EL
 113   (#xED #x041C) ; CYRILLIC CAPITAL LETTER EM
 114   (#xEE #x041D) ; CYRILLIC CAPITAL LETTER EN
 115   (#xEF #x041E) ; CYRILLIC CAPITAL LETTER O
 116   (#xF0 #x041F) ; CYRILLIC CAPITAL LETTER PE
 117   (#xF1 #x042F) ; CYRILLIC CAPITAL LETTER YA
 118   (#xF2 #x0420) ; CYRILLIC CAPITAL LETTER ER
 119   (#xF3 #x0421) ; CYRILLIC CAPITAL LETTER ES
 120   (#xF4 #x0422) ; CYRILLIC CAPITAL LETTER TE
 121   (#xF5 #x0423) ; CYRILLIC CAPITAL LETTER U
 122   (#xF6 #x0416) ; CYRILLIC CAPITAL LETTER ZHE
 123   (#xF7 #x0412) ; CYRILLIC CAPITAL LETTER VE
 124   (#xF8 #x042C) ; CYRILLIC CAPITAL LETTER SOFT SIGN
 125   (#xF9 #x042B) ; CYRILLIC CAPITAL LETTER YERU
 126   (#xFA #x0417) ; CYRILLIC CAPITAL LETTER ZE
 127   (#xFB #x0428) ; CYRILLIC CAPITAL LETTER SHA
 128   (#xFC #x042D) ; CYRILLIC CAPITAL LETTER E
 129   (#xFD #x0429) ; CYRILLIC CAPITAL LETTER SHCHA
 130   (#xFE #x0427) ; CYRILLIC CAPITAL LETTER CHE
 131   (#xFF #x042A) ; CYRILLIC CAPITAL LETTER HARD SIGN
 132 )
 133
 134 (declaim (inline get-koi8-r-bytes))
 135 (defun get-koi8-r-bytes (string pos)
 136   (declare (optimize speed (safety 0))
 137            (type simple-string string)
 138            (type array-range pos))
 139   (get-latin-bytes #'code->koi8-r-mapper :koi8-r string pos))
 140
 141 (defun string->koi8-r (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-koi8-r-bytes null-padding)))
 146
 147 (defmacro define-koi8-r->string* (accessor type)
 148   (declare (ignore type))
 149   (let ((name (make-od-name 'koi8-r->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 #'koi8-r->code-mapper)))))
 153
 154 (instantiate-octets-definition define-koi8-r->string*)
 155
 156 (defmacro define-koi8-r->string (accessor type)
 157   (declare (ignore type))
 158   `(defun ,(make-od-name 'koi8-r->string accessor) (array astart aend)
 159     (,(make-od-name 'latin->string accessor) array astart aend #'koi8-r->code-mapper)))
 160
 161 (instantiate-octets-definition define-koi8-r->string)
 162
 163 (define-external-format (:koi8-r :|koi8-r|)
 164     1 t
 165     (let ((koi8-r-byte (code->koi8-r-mapper bits)))
 166       (if koi8-r-byte
 167           (setf (sap-ref-8 sap tail) koi8-r-byte)
 168           (external-format-encoding-error stream bits)))
 169     (let ((code (koi8-r->code-mapper byte)))
 170       (if code
 171           (code-char code)
 172           (external-format-decoding-error stream byte)))
 173     koi8-r->string-aref
 174     string->koi8-r) ;; TODO -- error check
 175
 176 (define-unibyte-mapper koi8-u->code-mapper code->koi8-u-mapper
 177   (#x80 #x2500) ; BOX DRAWINGS LIGHT HORIZONTAL
 178   (#x81 #x2502) ; BOX DRAWINGS LIGHT VERTICAL
 179   (#x82 #x250C) ; BOX DRAWINGS LIGHT DOWN AND RIGHT
 180   (#x83 #x2510) ; BOX DRAWINGS LIGHT DOWN AND LEFT
 181   (#x84 #x2514) ; BOX DRAWINGS LIGHT UP AND RIGHT
 182   (#x85 #x2518) ; BOX DRAWINGS LIGHT UP AND LEFT
 183   (#x86 #x251C) ; BOX DRAWINGS LIGHT VERTICAL AND RIGHT
 184   (#x87 #x2524) ; BOX DRAWINGS LIGHT VERTICAL AND LEFT
 185   (#x88 #x252C) ; BOX DRAWINGS LIGHT DOWN AND HORIZONTAL
 186   (#x89 #x2534) ; BOX DRAWINGS LIGHT UP AND HORIZONTAL
 187   (#x8A #x253C) ; BOX DRAWINGS LIGHT VERTICAL AND HORIZONTAL
 188   (#x8B #x2580) ; UPPER HALF BLOCK
 189   (#x8C #x2584) ; LOWER HALF BLOCK
 190   (#x8D #x2588) ; FULL BLOCK
 191   (#x8E #x258C) ; LEFT HALF BLOCK
 192   (#x8F #x2590) ; RIGHT HALF BLOCK
 193   (#x90 #x2591) ; LIGHT SHADE
 194   (#x91 #x2592) ; MEDIUM SHADE
 195   (#x92 #x2593) ; DARK SHADE
 196   (#x93 #x2320) ; TOP HALF INTEGRAL
 197   (#x94 #x25A0) ; BLACK SQUARE
 198   (#x95 #x2022) ; BULLET
 199   (#x96 #x221A) ; SQUARE ROOT
 200   (#x97 #x2248) ; ALMOST EQUAL TO
 201   (#x98 #x2264) ; LESS-THAN OR EQUAL TO
 202   (#x99 #x2265) ; GREATER-THAN OR EQUAL TO
 203   (#x9A #x00A0) ; NO-BREAK SPACE
 204   (#x9B #x2321) ; BOTTOM HALF INTEGRAL
 205   (#x9C #x00B0) ; DEGREE SIGN
 206   (#x9D #x00B2) ; SUPERSCRIPT TWO
 207   (#x9E #x00B7) ; MIDDLE DOT
 208   (#x9F #x00F7) ; DIVISION SIGN
 209   (#xA0 #x2550) ; BOX DRAWINGS DOUBLE HORIZONTAL
 210   (#xA1 #x2551) ; BOX DRAWINGS DOUBLE VERTICAL
 211   (#xA2 #x2552) ; BOX DRAWINGS DOWN SINGLE AND RIGHT DOUBLE
 212   (#xA3 #x0451) ; CYRILLIC SMALL LETTER IO
 213   (#xA4 #x0454) ; CYRILLIC SMALL LETTER UKRAINIAN IE
 214   (#xA5 #x2554) ; BOX DRAWINGS DOUBLE DOWN AND RIGHT
 215   (#xA6 #x0456) ; CYRILLIC SMALL LETTER BYELORUSSIAN-UKRAINIAN I
 216   (#xA7 #x0457) ; CYRILLIC SMALL LETTER YI
 217   (#xA8 #x2557) ; BOX DRAWINGS DOUBLE DOWN AND LEFT
 218   (#xA9 #x2558) ; BOX DRAWINGS UP SINGLE AND RIGHT DOUBLE
 219   (#xAA #x2559) ; BOX DRAWINGS UP DOUBLE AND RIGHT SINGLE
 220   (#xAB #x255A) ; BOX DRAWINGS DOUBLE UP AND RIGHT
 221   (#xAC #x255B) ; BOX DRAWINGS UP SINGLE AND LEFT DOUBLE
 222   (#xAD #x0491) ; CYRILLIC SMALL LETTER GHE WITH UPTURN
 223   (#xAE #x255D) ; BOX DRAWINGS DOUBLE UP AND LEFT
 224   (#xAF #x255E) ; BOX DRAWINGS VERTICAL SINGLE AND RIGHT DOUBLE
 225   (#xB0 #x255F) ; BOX DRAWINGS VERTICAL DOUBLE AND RIGHT SINGLE
 226   (#xB1 #x2560) ; BOX DRAWINGS DOUBLE VERTICAL AND RIGHT
 227   (#xB2 #x2561) ; BOX DRAWINGS VERTICAL SINGLE AND LEFT DOUBLE
 228   (#xB3 #x0401) ; CYRILLIC CAPITAL LETTER IO
 229   (#xB4 #x0404) ; CYRILLIC CAPITAL LETTER UKRAINIAN IE
 230   (#xB5 #x2563) ; BOX DRAWINGS DOUBLE VERTICAL AND LEFT
 231   (#xB6 #x0406) ; CYRILLIC CAPITAL LETTER BYELORUSSIAN-UKRAINIAN I
 232   (#xB7 #x0407) ; CYRILLIC CAPITAL LETTER YI
 233   (#xB8 #x2566) ; BOX DRAWINGS DOUBLE DOWN AND HORIZONTAL
 234   (#xB9 #x2567) ; BOX DRAWINGS UP SINGLE AND HORIZONTAL DOUBLE
 235   (#xBA #x2568) ; BOX DRAWINGS UP DOUBLE AND HORIZONTAL SINGLE
 236   (#xBB #x2569) ; BOX DRAWINGS DOUBLE UP AND HORIZONTAL
 237   (#xBC #x256A) ; BOX DRAWINGS VERTICAL SINGLE AND HORIZONTAL DOUBLE
 238   (#xBD #x0490) ; CYRILLIC CAPITAL LETTER GHE WITH UPTURN
 239   (#xBE #x256C) ; BOX DRAWINGS DOUBLE VERTICAL AND HORIZONTAL
 240   (#xBF #x00A9) ; COPYRIGHT SIGN
 241   (#xC0 #x044E) ; CYRILLIC SMALL LETTER YU
 242   (#xC1 #x0430) ; CYRILLIC SMALL LETTER A
 243   (#xC2 #x0431) ; CYRILLIC SMALL LETTER BE
 244   (#xC3 #x0446) ; CYRILLIC SMALL LETTER TSE
 245   (#xC4 #x0434) ; CYRILLIC SMALL LETTER DE
 246   (#xC5 #x0435) ; CYRILLIC SMALL LETTER IE
 247   (#xC6 #x0444) ; CYRILLIC SMALL LETTER EF
 248   (#xC7 #x0433) ; CYRILLIC SMALL LETTER GHE
 249   (#xC8 #x0445) ; CYRILLIC SMALL LETTER HA
 250   (#xC9 #x0438) ; CYRILLIC SMALL LETTER I
 251   (#xCA #x0439) ; CYRILLIC SMALL LETTER SHORT I
 252   (#xCB #x043A) ; CYRILLIC SMALL LETTER KA
 253   (#xCC #x043B) ; CYRILLIC SMALL LETTER EL
 254   (#xCD #x043C) ; CYRILLIC SMALL LETTER EM
 255   (#xCE #x043D) ; CYRILLIC SMALL LETTER EN
 256   (#xCF #x043E) ; CYRILLIC SMALL LETTER O
 257   (#xD0 #x043F) ; CYRILLIC SMALL LETTER PE
 258   (#xD1 #x044F) ; CYRILLIC SMALL LETTER YA
 259   (#xD2 #x0440) ; CYRILLIC SMALL LETTER ER
 260   (#xD3 #x0441) ; CYRILLIC SMALL LETTER ES
 261   (#xD4 #x0442) ; CYRILLIC SMALL LETTER TE
 262   (#xD5 #x0443) ; CYRILLIC SMALL LETTER U
 263   (#xD6 #x0436) ; CYRILLIC SMALL LETTER ZHE
 264   (#xD7 #x0432) ; CYRILLIC SMALL LETTER VE
 265   (#xD8 #x044C) ; CYRILLIC SMALL LETTER SOFT SIGN
 266   (#xD9 #x044B) ; CYRILLIC SMALL LETTER YERU
 267   (#xDA #x0437) ; CYRILLIC SMALL LETTER ZE
 268   (#xDB #x0448) ; CYRILLIC SMALL LETTER SHA
 269   (#xDC #x044D) ; CYRILLIC SMALL LETTER E
 270   (#xDD #x0449) ; CYRILLIC SMALL LETTER SHCHA
 271   (#xDE #x0447) ; CYRILLIC SMALL LETTER CHE
 272   (#xDF #x044A) ; CYRILLIC SMALL LETTER HARD SIGN
 273   (#xE0 #x042E) ; CYRILLIC CAPITAL LETTER YU
 274   (#xE1 #x0410) ; CYRILLIC CAPITAL LETTER A
 275   (#xE2 #x0411) ; CYRILLIC CAPITAL LETTER BE
 276   (#xE3 #x0426) ; CYRILLIC CAPITAL LETTER TSE
 277   (#xE4 #x0414) ; CYRILLIC CAPITAL LETTER DE
 278   (#xE5 #x0415) ; CYRILLIC CAPITAL LETTER IE
 279   (#xE6 #x0424) ; CYRILLIC CAPITAL LETTER EF
 280   (#xE7 #x0413) ; CYRILLIC CAPITAL LETTER GHE
 281   (#xE8 #x0425) ; CYRILLIC CAPITAL LETTER HA
 282   (#xE9 #x0418) ; CYRILLIC CAPITAL LETTER I
 283   (#xEA #x0419) ; CYRILLIC CAPITAL LETTER SHORT I
 284   (#xEB #x041A) ; CYRILLIC CAPITAL LETTER KA
 285   (#xEC #x041B) ; CYRILLIC CAPITAL LETTER EL
 286   (#xED #x041C) ; CYRILLIC CAPITAL LETTER EM
 287   (#xEE #x041D) ; CYRILLIC CAPITAL LETTER EN
 288   (#xEF #x041E) ; CYRILLIC CAPITAL LETTER O
 289   (#xF0 #x041F) ; CYRILLIC CAPITAL LETTER PE
 290   (#xF1 #x042F) ; CYRILLIC CAPITAL LETTER YA
 291   (#xF2 #x0420) ; CYRILLIC CAPITAL LETTER ER
 292   (#xF3 #x0421) ; CYRILLIC CAPITAL LETTER ES
 293   (#xF4 #x0422) ; CYRILLIC CAPITAL LETTER TE
 294   (#xF5 #x0423) ; CYRILLIC CAPITAL LETTER U
 295   (#xF6 #x0416) ; CYRILLIC CAPITAL LETTER ZHE
 296   (#xF7 #x0412) ; CYRILLIC CAPITAL LETTER VE
 297   (#xF8 #x042C) ; CYRILLIC CAPITAL LETTER SOFT SIGN
 298   (#xF9 #x042B) ; CYRILLIC CAPITAL LETTER YERU
 299   (#xFA #x0417) ; CYRILLIC CAPITAL LETTER ZE
 300   (#xFB #x0428) ; CYRILLIC CAPITAL LETTER SHA
 301   (#xFC #x042D) ; CYRILLIC CAPITAL LETTER E
 302   (#xFD #x0429) ; CYRILLIC CAPITAL LETTER SHCHA
 303   (#xFE #x0427) ; CYRILLIC CAPITAL LETTER CHE
 304   (#xFF #x042A) ; CYRILLIC CAPITAL LETTER HARD SIGN
 305 )
 306
 307 (declaim (inline get-koi8-u-bytes))
 308 (defun get-koi8-u-bytes (string pos)
 309   (declare (optimize speed (safety 0))
 310            (type simple-string string)
 311            (type array-range pos))
 312   (get-latin-bytes #'code->koi8-u-mapper :koi8-u string pos))
 313
 314 (defun string->koi8-u (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-koi8-u-bytes null-padding)))
 319
 320 (defmacro define-koi8-u->string* (accessor type)
 321   (declare (ignore type))
 322   (let ((name (make-od-name 'koi8-u->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 #'koi8-u->code-mapper)))))
 326
 327 (instantiate-octets-definition define-koi8-u->string*)
 328
 329 (defmacro define-koi8-u->string (accessor type)
 330   (declare (ignore type))
 331   `(defun ,(make-od-name 'koi8-u->string accessor) (array astart aend)
 332     (,(make-od-name 'latin->string accessor) array astart aend #'koi8-u->code-mapper)))
 333
 334 (instantiate-octets-definition define-koi8-u->string)
 335
 336 (define-external-format (:koi8-u :|koi8-u|)
 337     1 t
 338     (let ((koi8-u-byte (code->koi8-u-mapper bits)))
 339       (if koi8-u-byte
 340           (setf (sap-ref-8 sap tail) koi8-u-byte)
 341           (external-format-encoding-error stream bits)))
 342     (let ((code (koi8-u->code-mapper byte)))
 343       (if code
 344           (code-char code)
 345           (external-format-decoding-error stream byte)))
 346     koi8-u->string-aref
 347     string->koi8-u) ;; TODO -- error check
 348
 349 (define-unibyte-mapper x-mac-cyrillic->code-mapper code->x-mac-cyrillic-mapper
 350   (#x80 #x0410) ; CYRILLIC CAPITAL LETTER A
 351   (#x81 #x0411) ; CYRILLIC CAPITAL LETTER BE
 352   (#x82 #x0412) ; CYRILLIC CAPITAL LETTER VE
 353   (#x83 #x0413) ; CYRILLIC CAPITAL LETTER GHE
 354   (#x84 #x0414) ; CYRILLIC CAPITAL LETTER DE
 355   (#x85 #x0415) ; CYRILLIC CAPITAL LETTER IE
 356   (#x86 #x0416) ; CYRILLIC CAPITAL LETTER ZHE
 357   (#x87 #x0417) ; CYRILLIC CAPITAL LETTER ZE
 358   (#x88 #x0418) ; CYRILLIC CAPITAL LETTER I
 359   (#x89 #x0419) ; CYRILLIC CAPITAL LETTER SHORT I
 360   (#x8A #x041A) ; CYRILLIC CAPITAL LETTER KA
 361   (#x8B #x041B) ; CYRILLIC CAPITAL LETTER EL
 362   (#x8C #x041C) ; CYRILLIC CAPITAL LETTER EM
 363   (#x8D #x041D) ; CYRILLIC CAPITAL LETTER EN
 364   (#x8E #x041E) ; CYRILLIC CAPITAL LETTER O
 365   (#x8F #x041F) ; CYRILLIC CAPITAL LETTER PE
 366   (#x90 #x0420) ; CYRILLIC CAPITAL LETTER ER
 367   (#x91 #x0421) ; CYRILLIC CAPITAL LETTER ES
 368   (#x92 #x0422) ; CYRILLIC CAPITAL LETTER TE
 369   (#x93 #x0423) ; CYRILLIC CAPITAL LETTER U
 370   (#x94 #x0424) ; CYRILLIC CAPITAL LETTER EF
 371   (#x95 #x0425) ; CYRILLIC CAPITAL LETTER HA
 372   (#x96 #x0426) ; CYRILLIC CAPITAL LETTER TSE
 373   (#x97 #x0427) ; CYRILLIC CAPITAL LETTER CHE
 374   (#x98 #x0428) ; CYRILLIC CAPITAL LETTER SHA
 375   (#x99 #x0429) ; CYRILLIC CAPITAL LETTER SHCHA
 376   (#x9A #x042A) ; CYRILLIC CAPITAL LETTER HARD SIGN
 377   (#x9B #x042B) ; CYRILLIC CAPITAL LETTER YERU
 378   (#x9C #x042C) ; CYRILLIC CAPITAL LETTER SOFT SIGN
 379   (#x9D #x042D) ; CYRILLIC CAPITAL LETTER E
 380   (#x9E #x042E) ; CYRILLIC CAPITAL LETTER YU
 381   (#x9F #x042F) ; CYRILLIC CAPITAL LETTER YA
 382   (#xA0 #x2020) ; DAGGER
 383   (#xA1 #x00B0) ; DEGREE SIGN
 384   (#xA4 #x00A7) ; SECTION SIGN
 385   (#xA5 #x2022) ; BULLET
 386   (#xA6 #x00B6) ; PILCROW SIGN
 387   (#xA7 #x0406) ; CYRILLIC CAPITAL LETTER BYELORUSSIAN-UKRAINIAN I
 388   (#xA8 #x00AE) ; REGISTERED SIGN
 389   (#xAA #x2122) ; TRADE MARK SIGN
 390   (#xAB #x0402) ; CYRILLIC CAPITAL LETTER DJE
 391   (#xAC #x0452) ; CYRILLIC SMALL LETTER DJE
 392   (#xAD #x2260) ; NOT EQUAL TO
 393   (#xAE #x0403) ; CYRILLIC CAPITAL LETTER GJE
 394   (#xAF #x0453) ; CYRILLIC SMALL LETTER GJE
 395   (#xB0 #x221E) ; INFINITY
 396   (#xB2 #x2264) ; LESS-THAN OR EQUAL TO
 397   (#xB3 #x2265) ; GREATER-THAN OR EQUAL TO
 398   (#xB4 #x0456) ; CYRILLIC SMALL LETTER BYELORUSSIAN-UKRAINIAN I
 399   (#xB6 #x2202) ; PARTIAL DIFFERENTIAL
 400   (#xB7 #x0408) ; CYRILLIC CAPITAL LETTER JE
 401   (#xB8 #x0404) ; CYRILLIC CAPITAL LETTER UKRAINIAN IE
 402   (#xB9 #x0454) ; CYRILLIC SMALL LETTER UKRAINIAN IE
 403   (#xBA #x0407) ; CYRILLIC CAPITAL LETTER YI
 404   (#xBB #x0457) ; CYRILLIC SMALL LETTER YI
 405   (#xBC #x0409) ; CYRILLIC CAPITAL LETTER LJE
 406   (#xBD #x0459) ; CYRILLIC SMALL LETTER LJE
 407   (#xBE #x040A) ; CYRILLIC CAPITAL LETTER NJE
 408   (#xBF #x045A) ; CYRILLIC SMALL LETTER NJE
 409   (#xC0 #x0458) ; CYRILLIC SMALL LETTER JE
 410   (#xC1 #x0405) ; CYRILLIC CAPITAL LETTER DZE
 411   (#xC2 #x00AC) ; NOT SIGN
 412   (#xC3 #x221A) ; SQUARE ROOT
 413   (#xC4 #x0192) ; LATIN SMALL LETTER F WITH HOOK
 414   (#xC5 #x2248) ; ALMOST EQUAL TO
 415   (#xC6 #x2206) ; INCREMENT
 416   (#xC7 #x00AB) ; LEFT-POINTING DOUBLE ANGLE QUOTATION MARK
 417   (#xC8 #x00BB) ; RIGHT-POINTING DOUBLE ANGLE QUOTATION MARK
 418   (#xC9 #x2026) ; HORIZONTAL ELLIPSIS
 419   (#xCA #x00A0) ; NO-BREAK SPACE
 420   (#xCB #x040B) ; CYRILLIC CAPITAL LETTER TSHE
 421   (#xCC #x045B) ; CYRILLIC SMALL LETTER TSHE
 422   (#xCD #x040C) ; CYRILLIC CAPITAL LETTER KJE
 423   (#xCE #x045C) ; CYRILLIC SMALL LETTER KJE
 424   (#xCF #x0455) ; CYRILLIC SMALL LETTER DZE
 425   (#xD0 #x2013) ; EN DASH
 426   (#xD1 #x2014) ; EM DASH
 427   (#xD2 #x201C) ; LEFT DOUBLE QUOTATION MARK
 428   (#xD3 #x201D) ; RIGHT DOUBLE QUOTATION MARK
 429   (#xD4 #x2018) ; LEFT SINGLE QUOTATION MARK
 430   (#xD5 #x2019) ; RIGHT SINGLE QUOTATION MARK
 431   (#xD6 #x00F7) ; DIVISION SIGN
 432   (#xD7 #x201E) ; DOUBLE LOW-9 QUOTATION MARK
 433   (#xD8 #x040E) ; CYRILLIC CAPITAL LETTER SHORT U
 434   (#xD9 #x045E) ; CYRILLIC SMALL LETTER SHORT U
 435   (#xDA #x040F) ; CYRILLIC CAPITAL LETTER DZHE
 436   (#xDB #x045F) ; CYRILLIC SMALL LETTER DZHE
 437   (#xDC #x2116) ; NUMERO SIGN
 438   (#xDD #x0401) ; CYRILLIC CAPITAL LETTER IO
 439   (#xDE #x0451) ; CYRILLIC SMALL LETTER IO
 440   (#xDF #x044F) ; CYRILLIC SMALL LETTER YA
 441   (#xE0 #x0430) ; CYRILLIC SMALL LETTER A
 442   (#xE1 #x0431) ; CYRILLIC SMALL LETTER BE
 443   (#xE2 #x0432) ; CYRILLIC SMALL LETTER VE
 444   (#xE3 #x0433) ; CYRILLIC SMALL LETTER GHE
 445   (#xE4 #x0434) ; CYRILLIC SMALL LETTER DE
 446   (#xE5 #x0435) ; CYRILLIC SMALL LETTER IE
 447   (#xE6 #x0436) ; CYRILLIC SMALL LETTER ZHE
 448   (#xE7 #x0437) ; CYRILLIC SMALL LETTER ZE
 449   (#xE8 #x0438) ; CYRILLIC SMALL LETTER I
 450   (#xE9 #x0439) ; CYRILLIC SMALL LETTER SHORT I
 451   (#xEA #x043A) ; CYRILLIC SMALL LETTER KA
 452   (#xEB #x043B) ; CYRILLIC SMALL LETTER EL
 453   (#xEC #x043C) ; CYRILLIC SMALL LETTER EM
 454   (#xED #x043D) ; CYRILLIC SMALL LETTER EN
 455   (#xEE #x043E) ; CYRILLIC SMALL LETTER O
 456   (#xEF #x043F) ; CYRILLIC SMALL LETTER PE
 457   (#xF0 #x0440) ; CYRILLIC SMALL LETTER ER
 458   (#xF1 #x0441) ; CYRILLIC SMALL LETTER ES
 459   (#xF2 #x0442) ; CYRILLIC SMALL LETTER TE
 460   (#xF3 #x0443) ; CYRILLIC SMALL LETTER U
 461   (#xF4 #x0444) ; CYRILLIC SMALL LETTER EF
 462   (#xF5 #x0445) ; CYRILLIC SMALL LETTER HA
 463   (#xF6 #x0446) ; CYRILLIC SMALL LETTER TSE
 464   (#xF7 #x0447) ; CYRILLIC SMALL LETTER CHE
 465   (#xF8 #x0448) ; CYRILLIC SMALL LETTER SHA
 466   (#xF9 #x0449) ; CYRILLIC SMALL LETTER SHCHA
 467   (#xFA #x044A) ; CYRILLIC SMALL LETTER HARD SIGN
 468   (#xFB #x044B) ; CYRILLIC SMALL LETTER YERU
 469   (#xFC #x044C) ; CYRILLIC SMALL LETTER SOFT SIGN
 470   (#xFD #x044D) ; CYRILLIC SMALL LETTER E
 471   (#xFE #x044E) ; CYRILLIC SMALL LETTER YU
 472   (#xFF #x00A4) ; CURRENCY SIGN
 473 )
 474
 475 (declaim (inline get-x-mac-cyrillic-bytes))
 476 (defun get-x-mac-cyrillic-bytes (string pos)
 477   (declare (optimize speed (safety 0))
 478            (type simple-string string)
 479            (type array-range pos))
 480   (get-latin-bytes #'code->x-mac-cyrillic-mapper :x-mac-cyrillic string pos))
 481
 482 (defun string->x-mac-cyrillic (string sstart send null-padding)
 483   (declare (optimize speed (safety 0))
 484            (type simple-string string)
 485            (type array-range sstart send))
 486   (values (string->latin% string sstart send #'get-x-mac-cyrillic-bytes null-padding)))
 487
 488 (defmacro define-x-mac-cyrillic->string* (accessor type)
 489   (declare (ignore type))
 490   (let ((name (make-od-name 'x-mac-cyrillic->string* accessor)))
 491     `(progn
 492       (defun ,name (string sstart send array astart aend)
 493         (,(make-od-name 'latin->string* accessor) string sstart send array astart aend #'x-mac-cyrillic->code-mapper)))))
 494
 495 (instantiate-octets-definition define-x-mac-cyrillic->string*)
 496
 497 (defmacro define-x-mac-cyrillic->string (accessor type)
 498   (declare (ignore type))
 499   `(defun ,(make-od-name 'x-mac-cyrillic->string accessor) (array astart aend)
 500     (,(make-od-name 'latin->string accessor) array astart aend #'x-mac-cyrillic->code-mapper)))
 501
 502 (instantiate-octets-definition define-x-mac-cyrillic->string)
 503
 504 (define-external-format (:x-mac-cyrillic :|x-mac-cyrillic|)
 505     1 t
 506     (let ((x-mac-cyrillic-byte (code->x-mac-cyrillic-mapper bits)))
 507       (if x-mac-cyrillic-byte
 508           (setf (sap-ref-8 sap tail) x-mac-cyrillic-byte)
 509           (external-format-encoding-error stream bits)))
 510     (let ((code (x-mac-cyrillic->code-mapper byte)))
 511       (if code
 512           (code-char code)
 513           (external-format-decoding-error stream byte)))
 514     x-mac-cyrillic->string-aref
 515     string->x-mac-cyrillic) ;; TODO -- error check