1.0.2.1: DATA-VECTOR-{REF,SET}-WITH-OFFSET for the x86
[sbcl.git] / 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