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