Change term translation to code conversion, then change
[bpt/emacs.git] / src / ccl.c
1 /* CCL (Code Conversion Language) interpreter.
2 Copyright (C) 1995, 1997 Electrotechnical Laboratory, JAPAN.
3 Licensed to the Free Software Foundation.
4
5 This file is part of GNU Emacs.
6
7 GNU Emacs is free software; you can redistribute it and/or modify
8 it under the terms of the GNU General Public License as published by
9 the Free Software Foundation; either version 2, or (at your option)
10 any later version.
11
12 GNU Emacs is distributed in the hope that it will be useful,
13 but WITHOUT ANY WARRANTY; without even the implied warranty of
14 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 GNU General Public License for more details.
16
17 You should have received a copy of the GNU General Public License
18 along with GNU Emacs; see the file COPYING. If not, write to
19 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
20 Boston, MA 02111-1307, USA. */
21
22 #include <stdio.h>
23
24 #ifdef emacs
25
26 #include <config.h>
27
28 #ifdef STDC_HEADERS
29 #include <stdlib.h>
30 #endif
31
32 #include "lisp.h"
33 #include "charset.h"
34 #include "ccl.h"
35 #include "coding.h"
36
37 #else /* not emacs */
38
39 #include "mulelib.h"
40
41 #endif /* not emacs */
42
43 /* This contains all code conversion map avairable to CCL. */
44 Lisp_Object Vcode_conversion_map_vector;
45
46 /* Alist of fontname patterns vs corresponding CCL program. */
47 Lisp_Object Vfont_ccl_encoder_alist;
48
49 /* This symbol is a property which assocates with ccl program vector.
50 Ex: (get 'ccl-big5-encoder 'ccl-program) returns ccl program vector. */
51 Lisp_Object Qccl_program;
52
53 /* These symbols are properties which associate with code conversion
54 map and their ID respectively. */
55 Lisp_Object Qcode_conversion_map;
56 Lisp_Object Qcode_conversion_map_id;
57
58 /* Symbols of ccl program have this property, a value of the property
59 is an index for Vccl_protram_table. */
60 Lisp_Object Qccl_program_idx;
61
62 /* Vector of CCL program names vs corresponding program data. */
63 Lisp_Object Vccl_program_table;
64
65 /* CCL (Code Conversion Language) is a simple language which has
66 operations on one input buffer, one output buffer, and 7 registers.
67 The syntax of CCL is described in `ccl.el'. Emacs Lisp function
68 `ccl-compile' compiles a CCL program and produces a CCL code which
69 is a vector of integers. The structure of this vector is as
70 follows: The 1st element: buffer-magnification, a factor for the
71 size of output buffer compared with the size of input buffer. The
72 2nd element: address of CCL code to be executed when encountered
73 with end of input stream. The 3rd and the remaining elements: CCL
74 codes. */
75
76 /* Header of CCL compiled code */
77 #define CCL_HEADER_BUF_MAG 0
78 #define CCL_HEADER_EOF 1
79 #define CCL_HEADER_MAIN 2
80
81 /* CCL code is a sequence of 28-bit non-negative integers (i.e. the
82 MSB is always 0), each contains CCL command and/or arguments in the
83 following format:
84
85 |----------------- integer (28-bit) ------------------|
86 |------- 17-bit ------|- 3-bit --|- 3-bit --|- 5-bit -|
87 |--constant argument--|-register-|-register-|-command-|
88 ccccccccccccccccc RRR rrr XXXXX
89 or
90 |------- relative address -------|-register-|-command-|
91 cccccccccccccccccccc rrr XXXXX
92 or
93 |------------- constant or other args ----------------|
94 cccccccccccccccccccccccccccc
95
96 where, `cc...c' is a non-negative integer indicating constant value
97 (the left most `c' is always 0) or an absolute jump address, `RRR'
98 and `rrr' are CCL register number, `XXXXX' is one of the following
99 CCL commands. */
100
101 /* CCL commands
102
103 Each comment fields shows one or more lines for command syntax and
104 the following lines for semantics of the command. In semantics, IC
105 stands for Instruction Counter. */
106
107 #define CCL_SetRegister 0x00 /* Set register a register value:
108 1:00000000000000000RRRrrrXXXXX
109 ------------------------------
110 reg[rrr] = reg[RRR];
111 */
112
113 #define CCL_SetShortConst 0x01 /* Set register a short constant value:
114 1:CCCCCCCCCCCCCCCCCCCCrrrXXXXX
115 ------------------------------
116 reg[rrr] = CCCCCCCCCCCCCCCCCCC;
117 */
118
119 #define CCL_SetConst 0x02 /* Set register a constant value:
120 1:00000000000000000000rrrXXXXX
121 2:CONSTANT
122 ------------------------------
123 reg[rrr] = CONSTANT;
124 IC++;
125 */
126
127 #define CCL_SetArray 0x03 /* Set register an element of array:
128 1:CCCCCCCCCCCCCCCCCRRRrrrXXXXX
129 2:ELEMENT[0]
130 3:ELEMENT[1]
131 ...
132 ------------------------------
133 if (0 <= reg[RRR] < CC..C)
134 reg[rrr] = ELEMENT[reg[RRR]];
135 IC += CC..C;
136 */
137
138 #define CCL_Jump 0x04 /* Jump:
139 1:A--D--D--R--E--S--S-000XXXXX
140 ------------------------------
141 IC += ADDRESS;
142 */
143
144 /* Note: If CC..C is greater than 0, the second code is omitted. */
145
146 #define CCL_JumpCond 0x05 /* Jump conditional:
147 1:A--D--D--R--E--S--S-rrrXXXXX
148 ------------------------------
149 if (!reg[rrr])
150 IC += ADDRESS;
151 */
152
153
154 #define CCL_WriteRegisterJump 0x06 /* Write register and jump:
155 1:A--D--D--R--E--S--S-rrrXXXXX
156 ------------------------------
157 write (reg[rrr]);
158 IC += ADDRESS;
159 */
160
161 #define CCL_WriteRegisterReadJump 0x07 /* Write register, read, and jump:
162 1:A--D--D--R--E--S--S-rrrXXXXX
163 2:A--D--D--R--E--S--S-rrrYYYYY
164 -----------------------------
165 write (reg[rrr]);
166 IC++;
167 read (reg[rrr]);
168 IC += ADDRESS;
169 */
170 /* Note: If read is suspended, the resumed execution starts from the
171 second code (YYYYY == CCL_ReadJump). */
172
173 #define CCL_WriteConstJump 0x08 /* Write constant and jump:
174 1:A--D--D--R--E--S--S-000XXXXX
175 2:CONST
176 ------------------------------
177 write (CONST);
178 IC += ADDRESS;
179 */
180
181 #define CCL_WriteConstReadJump 0x09 /* Write constant, read, and jump:
182 1:A--D--D--R--E--S--S-rrrXXXXX
183 2:CONST
184 3:A--D--D--R--E--S--S-rrrYYYYY
185 -----------------------------
186 write (CONST);
187 IC += 2;
188 read (reg[rrr]);
189 IC += ADDRESS;
190 */
191 /* Note: If read is suspended, the resumed execution starts from the
192 second code (YYYYY == CCL_ReadJump). */
193
194 #define CCL_WriteStringJump 0x0A /* Write string and jump:
195 1:A--D--D--R--E--S--S-000XXXXX
196 2:LENGTH
197 3:0000STRIN[0]STRIN[1]STRIN[2]
198 ...
199 ------------------------------
200 write_string (STRING, LENGTH);
201 IC += ADDRESS;
202 */
203
204 #define CCL_WriteArrayReadJump 0x0B /* Write an array element, read, and jump:
205 1:A--D--D--R--E--S--S-rrrXXXXX
206 2:LENGTH
207 3:ELEMENET[0]
208 4:ELEMENET[1]
209 ...
210 N:A--D--D--R--E--S--S-rrrYYYYY
211 ------------------------------
212 if (0 <= reg[rrr] < LENGTH)
213 write (ELEMENT[reg[rrr]]);
214 IC += LENGTH + 2; (... pointing at N+1)
215 read (reg[rrr]);
216 IC += ADDRESS;
217 */
218 /* Note: If read is suspended, the resumed execution starts from the
219 Nth code (YYYYY == CCL_ReadJump). */
220
221 #define CCL_ReadJump 0x0C /* Read and jump:
222 1:A--D--D--R--E--S--S-rrrYYYYY
223 -----------------------------
224 read (reg[rrr]);
225 IC += ADDRESS;
226 */
227
228 #define CCL_Branch 0x0D /* Jump by branch table:
229 1:CCCCCCCCCCCCCCCCCCCCrrrXXXXX
230 2:A--D--D--R--E-S-S[0]000XXXXX
231 3:A--D--D--R--E-S-S[1]000XXXXX
232 ...
233 ------------------------------
234 if (0 <= reg[rrr] < CC..C)
235 IC += ADDRESS[reg[rrr]];
236 else
237 IC += ADDRESS[CC..C];
238 */
239
240 #define CCL_ReadRegister 0x0E /* Read bytes into registers:
241 1:CCCCCCCCCCCCCCCCCCCCrrrXXXXX
242 2:CCCCCCCCCCCCCCCCCCCCrrrXXXXX
243 ...
244 ------------------------------
245 while (CCC--)
246 read (reg[rrr]);
247 */
248
249 #define CCL_WriteExprConst 0x0F /* write result of expression:
250 1:00000OPERATION000RRR000XXXXX
251 2:CONSTANT
252 ------------------------------
253 write (reg[RRR] OPERATION CONSTANT);
254 IC++;
255 */
256
257 /* Note: If the Nth read is suspended, the resumed execution starts
258 from the Nth code. */
259
260 #define CCL_ReadBranch 0x10 /* Read one byte into a register,
261 and jump by branch table:
262 1:CCCCCCCCCCCCCCCCCCCCrrrXXXXX
263 2:A--D--D--R--E-S-S[0]000XXXXX
264 3:A--D--D--R--E-S-S[1]000XXXXX
265 ...
266 ------------------------------
267 read (read[rrr]);
268 if (0 <= reg[rrr] < CC..C)
269 IC += ADDRESS[reg[rrr]];
270 else
271 IC += ADDRESS[CC..C];
272 */
273
274 #define CCL_WriteRegister 0x11 /* Write registers:
275 1:CCCCCCCCCCCCCCCCCCCrrrXXXXX
276 2:CCCCCCCCCCCCCCCCCCCrrrXXXXX
277 ...
278 ------------------------------
279 while (CCC--)
280 write (reg[rrr]);
281 ...
282 */
283
284 /* Note: If the Nth write is suspended, the resumed execution
285 starts from the Nth code. */
286
287 #define CCL_WriteExprRegister 0x12 /* Write result of expression
288 1:00000OPERATIONRrrRRR000XXXXX
289 ------------------------------
290 write (reg[RRR] OPERATION reg[Rrr]);
291 */
292
293 #define CCL_Call 0x13 /* Call the CCL program whose ID is
294 (CC..C).
295 1:CCCCCCCCCCCCCCCCCCCC000XXXXX
296 ------------------------------
297 call (CC..C)
298 */
299
300 #define CCL_WriteConstString 0x14 /* Write a constant or a string:
301 1:CCCCCCCCCCCCCCCCCCCCrrrXXXXX
302 [2:0000STRIN[0]STRIN[1]STRIN[2]]
303 [...]
304 -----------------------------
305 if (!rrr)
306 write (CC..C)
307 else
308 write_string (STRING, CC..C);
309 IC += (CC..C + 2) / 3;
310 */
311
312 #define CCL_WriteArray 0x15 /* Write an element of array:
313 1:CCCCCCCCCCCCCCCCCCCCrrrXXXXX
314 2:ELEMENT[0]
315 3:ELEMENT[1]
316 ...
317 ------------------------------
318 if (0 <= reg[rrr] < CC..C)
319 write (ELEMENT[reg[rrr]]);
320 IC += CC..C;
321 */
322
323 #define CCL_End 0x16 /* Terminate:
324 1:00000000000000000000000XXXXX
325 ------------------------------
326 terminate ();
327 */
328
329 /* The following two codes execute an assignment arithmetic/logical
330 operation. The form of the operation is like REG OP= OPERAND. */
331
332 #define CCL_ExprSelfConst 0x17 /* REG OP= constant:
333 1:00000OPERATION000000rrrXXXXX
334 2:CONSTANT
335 ------------------------------
336 reg[rrr] OPERATION= CONSTANT;
337 */
338
339 #define CCL_ExprSelfReg 0x18 /* REG1 OP= REG2:
340 1:00000OPERATION000RRRrrrXXXXX
341 ------------------------------
342 reg[rrr] OPERATION= reg[RRR];
343 */
344
345 /* The following codes execute an arithmetic/logical operation. The
346 form of the operation is like REG_X = REG_Y OP OPERAND2. */
347
348 #define CCL_SetExprConst 0x19 /* REG_X = REG_Y OP constant:
349 1:00000OPERATION000RRRrrrXXXXX
350 2:CONSTANT
351 ------------------------------
352 reg[rrr] = reg[RRR] OPERATION CONSTANT;
353 IC++;
354 */
355
356 #define CCL_SetExprReg 0x1A /* REG1 = REG2 OP REG3:
357 1:00000OPERATIONRrrRRRrrrXXXXX
358 ------------------------------
359 reg[rrr] = reg[RRR] OPERATION reg[Rrr];
360 */
361
362 #define CCL_JumpCondExprConst 0x1B /* Jump conditional according to
363 an operation on constant:
364 1:A--D--D--R--E--S--S-rrrXXXXX
365 2:OPERATION
366 3:CONSTANT
367 -----------------------------
368 reg[7] = reg[rrr] OPERATION CONSTANT;
369 if (!(reg[7]))
370 IC += ADDRESS;
371 else
372 IC += 2
373 */
374
375 #define CCL_JumpCondExprReg 0x1C /* Jump conditional according to
376 an operation on register:
377 1:A--D--D--R--E--S--S-rrrXXXXX
378 2:OPERATION
379 3:RRR
380 -----------------------------
381 reg[7] = reg[rrr] OPERATION reg[RRR];
382 if (!reg[7])
383 IC += ADDRESS;
384 else
385 IC += 2;
386 */
387
388 #define CCL_ReadJumpCondExprConst 0x1D /* Read and jump conditional according
389 to an operation on constant:
390 1:A--D--D--R--E--S--S-rrrXXXXX
391 2:OPERATION
392 3:CONSTANT
393 -----------------------------
394 read (reg[rrr]);
395 reg[7] = reg[rrr] OPERATION CONSTANT;
396 if (!reg[7])
397 IC += ADDRESS;
398 else
399 IC += 2;
400 */
401
402 #define CCL_ReadJumpCondExprReg 0x1E /* Read and jump conditional according
403 to an operation on register:
404 1:A--D--D--R--E--S--S-rrrXXXXX
405 2:OPERATION
406 3:RRR
407 -----------------------------
408 read (reg[rrr]);
409 reg[7] = reg[rrr] OPERATION reg[RRR];
410 if (!reg[7])
411 IC += ADDRESS;
412 else
413 IC += 2;
414 */
415
416 #define CCL_Extention 0x1F /* Extended CCL code
417 1:ExtendedCOMMNDRrrRRRrrrXXXXX
418 2:ARGUEMENT
419 3:...
420 ------------------------------
421 extended_command (rrr,RRR,Rrr,ARGS)
422 */
423
424 /*
425 Here after, Extended CCL Instructions.
426 Bit length of extended command is 14.
427 Therefore, the instruction code range is 0..16384(0x3fff).
428 */
429
430 /* Read a multibyte characeter.
431 A code point is stored into reg[rrr]. A charset ID is stored into
432 reg[RRR]. */
433
434 #define CCL_ReadMultibyteChar2 0x00 /* Read Multibyte Character
435 1:ExtendedCOMMNDRrrRRRrrrXXXXX */
436
437 /* Write a multibyte character.
438 Write a character whose code point is reg[rrr] and the charset ID
439 is reg[RRR]. */
440
441 #define CCL_WriteMultibyteChar2 0x01 /* Write Multibyte Character
442 1:ExtendedCOMMNDRrrRRRrrrXXXXX */
443
444 /* Translate a character whose code point is reg[rrr] and the charset
445 ID is reg[RRR] by a character translation table whose ID is
446 reg[Rrr].
447
448 A translated character is set in reg[rrr] (code point) and reg[RRR]
449 (charset ID). */
450
451 #define CCL_TranslateCharacter 0x02 /* Translate a multibyte character
452 1:ExtendedCOMMNDRrrRRRrrrXXXXX */
453
454 /* Translate a character whose code point is reg[rrr] and the charset
455 ID is reg[RRR] by a character translation table whose ID is
456 ARGUMENT.
457
458 A translated character is set in reg[rrr] (code point) and reg[RRR]
459 (charset ID). */
460
461 #define CCL_TranslateCharacterConstTbl 0x03 /* Translate a multibyte character
462 1:ExtendedCOMMNDRrrRRRrrrXXXXX
463 2:ARGUMENT(Translation Table ID)
464 */
465
466 /* Iterate looking up MAPs for reg[rrr] starting from the Nth (N =
467 reg[RRR]) MAP until some value is found.
468
469 Each MAP is a Lisp vector whose element is number, nil, t, or
470 lambda.
471 If the element is nil, ignore the map and proceed to the next map.
472 If the element is t or lambda, finish without changing reg[rrr].
473 If the element is a number, set reg[rrr] to the number and finish.
474
475 Detail of the map structure is descibed in the comment for
476 CCL_MapMultiple below. */
477
478 #define CCL_IterateMultipleMap 0x10 /* Iterate multiple maps
479 1:ExtendedCOMMNDXXXRRRrrrXXXXX
480 2:NUMBER of MAPs
481 3:MAP-ID1
482 4:MAP-ID2
483 ...
484 */
485
486 /* Map the code in reg[rrr] by MAPs starting from the Nth (N =
487 reg[RRR]) map.
488
489 MAPs are suppried in the succeeding CCL codes as follows:
490
491 When CCL program gives this nested structure of map to this command:
492 ((MAP-ID11
493 MAP-ID12
494 (MAP-ID121 MAP-ID122 MAP-ID123)
495 MAP-ID13)
496 (MAP-ID21
497 (MAP-ID211 (MAP-ID2111) MAP-ID212)
498 MAP-ID22)),
499 the compiled CCL codes has this sequence:
500 CCL_MapMultiple (CCL code of this command)
501 16 (total number of MAPs and SEPARATERs)
502 -7 (1st SEPARATER)
503 MAP-ID11
504 MAP-ID12
505 -3 (2nd SEPARATER)
506 MAP-ID121
507 MAP-ID122
508 MAP-ID123
509 MAP-ID13
510 -7 (3rd SEPARATER)
511 MAP-ID21
512 -4 (4th SEPARATER)
513 MAP-ID211
514 -1 (5th SEPARATER)
515 MAP_ID2111
516 MAP-ID212
517 MAP-ID22
518
519 A value of each SEPARATER follows this rule:
520 MAP-SET := SEPARATOR [(MAP-ID | MAP-SET)]+
521 SEPARATOR := -(number of MAP-IDs and SEPARATORs in the MAP-SET)
522
523 (*)....Nest level of MAP-SET must not be over than MAX_MAP_SET_LEVEL.
524
525 When some map fails to map (i.e. it doesn't have a value for
526 reg[rrr]), the mapping is treated as identity.
527
528 The mapping is iterated for all maps in each map set (set of maps
529 separators by a SEPARATOR) except the case that lambda is
530 encountered (see below).
531
532 Each map is a Lisp vector of the following format (a) or (b):
533 (a)......[STARTPOINT VAL1 VAL2 ...]
534 (b)......[t VAL STARTPOINT ENDPOINT],
535 where
536 STARTPOINT is an offset to be used for indexing a map,
537 ENDPOINT is a maxmum index number of a map,
538 VAL and VALn is a number, nil, t, or lambda.
539
540 Valid index range of a map of type (a) is:
541 STARTPOINT <= index < STARTPOINT + map_size - 1
542 Valid index range of a map of type (b) is:
543 STARTPOINT <= index < ENDPOINT
544
545 If VALn is nil, the map is ignored and mapping proceed to the next
546 map.
547 In VALn is t, reg[rrr] is reverted to the original value and
548 mapping proceed to the next map.
549 If VALn is lambda, mapping in the current MAP-SET finishes
550 and proceed to the upper level MAP-SET. */
551
552 #define CCL_MapMultiple 0x11 /* Mapping by multiple code conversion maps
553 1:ExtendedCOMMNDXXXRRRrrrXXXXX
554 2:N-2
555 3:SEPARATOR_1 (< 0)
556 4:MAP-ID_1
557 5:MAP-ID_2
558 ...
559 M:SEPARATOR_x (< 0)
560 M+1:MAP-ID_y
561 ...
562 N:SEPARATOR_z (< 0)
563 */
564
565 #define MAX_MAP_SET_LEVEL 20
566
567 typedef struct
568 {
569 int rest_length;
570 int orig_val;
571 } tr_stack;
572
573 static tr_stack mapping_stack[MAX_MAP_SET_LEVEL];
574 static tr_stack *mapping_stack_pointer;
575
576 #define PUSH_MAPPING_STACK(restlen, orig) \
577 { \
578 mapping_stack_pointer->rest_length = (restlen); \
579 mapping_stack_pointer->orig_val = (orig); \
580 mapping_stack_pointer++; \
581 }
582
583 #define POP_MAPPING_STACK(restlen, orig) \
584 { \
585 mapping_stack_pointer--; \
586 (restlen) = mapping_stack_pointer->rest_length; \
587 (orig) = mapping_stack_pointer->orig_val; \
588 } \
589
590 #define CCL_MapSingle 0x12 /* Map by single code conversion map
591 1:ExtendedCOMMNDXXXRRRrrrXXXXX
592 2:MAP-ID
593 ------------------------------
594 Map reg[rrr] by MAP-ID.
595 If some valid mapping is found,
596 set reg[rrr] to the result,
597 else
598 set reg[RRR] to -1.
599 */
600
601 /* CCL arithmetic/logical operators. */
602 #define CCL_PLUS 0x00 /* X = Y + Z */
603 #define CCL_MINUS 0x01 /* X = Y - Z */
604 #define CCL_MUL 0x02 /* X = Y * Z */
605 #define CCL_DIV 0x03 /* X = Y / Z */
606 #define CCL_MOD 0x04 /* X = Y % Z */
607 #define CCL_AND 0x05 /* X = Y & Z */
608 #define CCL_OR 0x06 /* X = Y | Z */
609 #define CCL_XOR 0x07 /* X = Y ^ Z */
610 #define CCL_LSH 0x08 /* X = Y << Z */
611 #define CCL_RSH 0x09 /* X = Y >> Z */
612 #define CCL_LSH8 0x0A /* X = (Y << 8) | Z */
613 #define CCL_RSH8 0x0B /* X = Y >> 8, r[7] = Y & 0xFF */
614 #define CCL_DIVMOD 0x0C /* X = Y / Z, r[7] = Y % Z */
615 #define CCL_LS 0x10 /* X = (X < Y) */
616 #define CCL_GT 0x11 /* X = (X > Y) */
617 #define CCL_EQ 0x12 /* X = (X == Y) */
618 #define CCL_LE 0x13 /* X = (X <= Y) */
619 #define CCL_GE 0x14 /* X = (X >= Y) */
620 #define CCL_NE 0x15 /* X = (X != Y) */
621
622 #define CCL_ENCODE_SJIS 0x16 /* X = HIGHER_BYTE (SJIS (Y, Z))
623 r[7] = LOWER_BYTE (SJIS (Y, Z) */
624 #define CCL_DECODE_SJIS 0x17 /* X = HIGHER_BYTE (DE-SJIS (Y, Z))
625 r[7] = LOWER_BYTE (DE-SJIS (Y, Z)) */
626
627 /* Terminate CCL program successfully. */
628 #define CCL_SUCCESS \
629 do { \
630 ccl->status = CCL_STAT_SUCCESS; \
631 ccl->ic = CCL_HEADER_MAIN; \
632 goto ccl_finish; \
633 } while (0)
634
635 /* Suspend CCL program because of reading from empty input buffer or
636 writing to full output buffer. When this program is resumed, the
637 same I/O command is executed. */
638 #define CCL_SUSPEND(stat) \
639 do { \
640 ic--; \
641 ccl->status = stat; \
642 goto ccl_finish; \
643 } while (0)
644
645 /* Terminate CCL program because of invalid command. Should not occur
646 in the normal case. */
647 #define CCL_INVALID_CMD \
648 do { \
649 ccl->status = CCL_STAT_INVALID_CMD; \
650 goto ccl_error_handler; \
651 } while (0)
652
653 /* Encode one character CH to multibyte form and write to the current
654 output buffer. If CH is less than 256, CH is written as is. */
655 #define CCL_WRITE_CHAR(ch) \
656 do { \
657 if (!dst) \
658 CCL_INVALID_CMD; \
659 else \
660 { \
661 unsigned char work[4], *str; \
662 int len = CHAR_STRING (ch, work, str); \
663 if (dst + len <= (dst_bytes ? dst_end : src)) \
664 { \
665 bcopy (str, dst, len); \
666 dst += len; \
667 } \
668 else \
669 CCL_SUSPEND (CCL_STAT_SUSPEND_BY_DST); \
670 } \
671 } while (0)
672
673 /* Write a string at ccl_prog[IC] of length LEN to the current output
674 buffer. */
675 #define CCL_WRITE_STRING(len) \
676 do { \
677 if (!dst) \
678 CCL_INVALID_CMD; \
679 else if (dst + len <= (dst_bytes ? dst_end : src)) \
680 for (i = 0; i < len; i++) \
681 *dst++ = ((XFASTINT (ccl_prog[ic + (i / 3)])) \
682 >> ((2 - (i % 3)) * 8)) & 0xFF; \
683 else \
684 CCL_SUSPEND (CCL_STAT_SUSPEND_BY_DST); \
685 } while (0)
686
687 /* Read one byte from the current input buffer into Rth register. */
688 #define CCL_READ_CHAR(r) \
689 do { \
690 if (!src) \
691 CCL_INVALID_CMD; \
692 else if (src < src_end) \
693 r = *src++; \
694 else if (ccl->last_block) \
695 { \
696 ic = ccl->eof_ic; \
697 goto ccl_finish; \
698 } \
699 else \
700 CCL_SUSPEND (CCL_STAT_SUSPEND_BY_SRC); \
701 } while (0)
702
703
704 /* Execute CCL code on SRC_BYTES length text at SOURCE. The resulting
705 text goes to a place pointed by DESTINATION, the length of which
706 should not exceed DST_BYTES. The bytes actually processed is
707 returned as *CONSUMED. The return value is the length of the
708 resulting text. As a side effect, the contents of CCL registers
709 are updated. If SOURCE or DESTINATION is NULL, only operations on
710 registers are permitted. */
711
712 #ifdef CCL_DEBUG
713 #define CCL_DEBUG_BACKTRACE_LEN 256
714 int ccl_backtrace_table[CCL_BACKTRACE_TABLE];
715 int ccl_backtrace_idx;
716 #endif
717
718 struct ccl_prog_stack
719 {
720 Lisp_Object *ccl_prog; /* Pointer to an array of CCL code. */
721 int ic; /* Instruction Counter. */
722 };
723
724 int
725 ccl_driver (ccl, source, destination, src_bytes, dst_bytes, consumed)
726 struct ccl_program *ccl;
727 unsigned char *source, *destination;
728 int src_bytes, dst_bytes;
729 int *consumed;
730 {
731 register int *reg = ccl->reg;
732 register int ic = ccl->ic;
733 register int code, field1, field2;
734 register Lisp_Object *ccl_prog = ccl->prog;
735 unsigned char *src = source, *src_end = src + src_bytes;
736 unsigned char *dst = destination, *dst_end = dst + dst_bytes;
737 int jump_address;
738 int i, j, op;
739 int stack_idx = 0;
740 /* For the moment, we only support depth 256 of stack. */
741 struct ccl_prog_stack ccl_prog_stack_struct[256];
742
743 if (ic >= ccl->eof_ic)
744 ic = CCL_HEADER_MAIN;
745
746 #ifdef CCL_DEBUG
747 ccl_backtrace_idx = 0;
748 #endif
749
750 for (;;)
751 {
752 #ifdef CCL_DEBUG
753 ccl_backtrace_table[ccl_backtrace_idx++] = ic;
754 if (ccl_backtrace_idx >= CCL_DEBUG_BACKTRACE_LEN)
755 ccl_backtrace_idx = 0;
756 ccl_backtrace_table[ccl_backtrace_idx] = 0;
757 #endif
758
759 if (!NILP (Vquit_flag) && NILP (Vinhibit_quit))
760 {
761 /* We can't just signal Qquit, instead break the loop as if
762 the whole data is processed. Don't reset Vquit_flag, it
763 must be handled later at a safer place. */
764 if (consumed)
765 src = source + src_bytes;
766 ccl->status = CCL_STAT_QUIT;
767 break;
768 }
769
770 code = XINT (ccl_prog[ic]); ic++;
771 field1 = code >> 8;
772 field2 = (code & 0xFF) >> 5;
773
774 #define rrr field2
775 #define RRR (field1 & 7)
776 #define Rrr ((field1 >> 3) & 7)
777 #define ADDR field1
778 #define EXCMD (field1 >> 6)
779
780 switch (code & 0x1F)
781 {
782 case CCL_SetRegister: /* 00000000000000000RRRrrrXXXXX */
783 reg[rrr] = reg[RRR];
784 break;
785
786 case CCL_SetShortConst: /* CCCCCCCCCCCCCCCCCCCCrrrXXXXX */
787 reg[rrr] = field1;
788 break;
789
790 case CCL_SetConst: /* 00000000000000000000rrrXXXXX */
791 reg[rrr] = XINT (ccl_prog[ic]);
792 ic++;
793 break;
794
795 case CCL_SetArray: /* CCCCCCCCCCCCCCCCCCCCRRRrrrXXXXX */
796 i = reg[RRR];
797 j = field1 >> 3;
798 if ((unsigned int) i < j)
799 reg[rrr] = XINT (ccl_prog[ic + i]);
800 ic += j;
801 break;
802
803 case CCL_Jump: /* A--D--D--R--E--S--S-000XXXXX */
804 ic += ADDR;
805 break;
806
807 case CCL_JumpCond: /* A--D--D--R--E--S--S-rrrXXXXX */
808 if (!reg[rrr])
809 ic += ADDR;
810 break;
811
812 case CCL_WriteRegisterJump: /* A--D--D--R--E--S--S-rrrXXXXX */
813 i = reg[rrr];
814 CCL_WRITE_CHAR (i);
815 ic += ADDR;
816 break;
817
818 case CCL_WriteRegisterReadJump: /* A--D--D--R--E--S--S-rrrXXXXX */
819 i = reg[rrr];
820 CCL_WRITE_CHAR (i);
821 ic++;
822 CCL_READ_CHAR (reg[rrr]);
823 ic += ADDR - 1;
824 break;
825
826 case CCL_WriteConstJump: /* A--D--D--R--E--S--S-000XXXXX */
827 i = XINT (ccl_prog[ic]);
828 CCL_WRITE_CHAR (i);
829 ic += ADDR;
830 break;
831
832 case CCL_WriteConstReadJump: /* A--D--D--R--E--S--S-rrrXXXXX */
833 i = XINT (ccl_prog[ic]);
834 CCL_WRITE_CHAR (i);
835 ic++;
836 CCL_READ_CHAR (reg[rrr]);
837 ic += ADDR - 1;
838 break;
839
840 case CCL_WriteStringJump: /* A--D--D--R--E--S--S-000XXXXX */
841 j = XINT (ccl_prog[ic]);
842 ic++;
843 CCL_WRITE_STRING (j);
844 ic += ADDR - 1;
845 break;
846
847 case CCL_WriteArrayReadJump: /* A--D--D--R--E--S--S-rrrXXXXX */
848 i = reg[rrr];
849 j = XINT (ccl_prog[ic]);
850 if ((unsigned int) i < j)
851 {
852 i = XINT (ccl_prog[ic + 1 + i]);
853 CCL_WRITE_CHAR (i);
854 }
855 ic += j + 2;
856 CCL_READ_CHAR (reg[rrr]);
857 ic += ADDR - (j + 2);
858 break;
859
860 case CCL_ReadJump: /* A--D--D--R--E--S--S-rrrYYYYY */
861 CCL_READ_CHAR (reg[rrr]);
862 ic += ADDR;
863 break;
864
865 case CCL_ReadBranch: /* CCCCCCCCCCCCCCCCCCCCrrrXXXXX */
866 CCL_READ_CHAR (reg[rrr]);
867 /* fall through ... */
868 case CCL_Branch: /* CCCCCCCCCCCCCCCCCCCCrrrXXXXX */
869 if ((unsigned int) reg[rrr] < field1)
870 ic += XINT (ccl_prog[ic + reg[rrr]]);
871 else
872 ic += XINT (ccl_prog[ic + field1]);
873 break;
874
875 case CCL_ReadRegister: /* CCCCCCCCCCCCCCCCCCCCrrXXXXX */
876 while (1)
877 {
878 CCL_READ_CHAR (reg[rrr]);
879 if (!field1) break;
880 code = XINT (ccl_prog[ic]); ic++;
881 field1 = code >> 8;
882 field2 = (code & 0xFF) >> 5;
883 }
884 break;
885
886 case CCL_WriteExprConst: /* 1:00000OPERATION000RRR000XXXXX */
887 rrr = 7;
888 i = reg[RRR];
889 j = XINT (ccl_prog[ic]);
890 op = field1 >> 6;
891 ic++;
892 goto ccl_set_expr;
893
894 case CCL_WriteRegister: /* CCCCCCCCCCCCCCCCCCCrrrXXXXX */
895 while (1)
896 {
897 i = reg[rrr];
898 CCL_WRITE_CHAR (i);
899 if (!field1) break;
900 code = XINT (ccl_prog[ic]); ic++;
901 field1 = code >> 8;
902 field2 = (code & 0xFF) >> 5;
903 }
904 break;
905
906 case CCL_WriteExprRegister: /* 1:00000OPERATIONRrrRRR000XXXXX */
907 rrr = 7;
908 i = reg[RRR];
909 j = reg[Rrr];
910 op = field1 >> 6;
911 goto ccl_set_expr;
912
913 case CCL_Call: /* CCCCCCCCCCCCCCCCCCCC000XXXXX */
914 {
915 Lisp_Object slot;
916
917 if (stack_idx >= 256
918 || field1 < 0
919 || field1 >= XVECTOR (Vccl_program_table)->size
920 || (slot = XVECTOR (Vccl_program_table)->contents[field1],
921 !CONSP (slot))
922 || !VECTORP (XCONS (slot)->cdr))
923 {
924 if (stack_idx > 0)
925 {
926 ccl_prog = ccl_prog_stack_struct[0].ccl_prog;
927 ic = ccl_prog_stack_struct[0].ic;
928 }
929 CCL_INVALID_CMD;
930 }
931
932 ccl_prog_stack_struct[stack_idx].ccl_prog = ccl_prog;
933 ccl_prog_stack_struct[stack_idx].ic = ic;
934 stack_idx++;
935 ccl_prog = XVECTOR (XCONS (slot)->cdr)->contents;
936 ic = CCL_HEADER_MAIN;
937 }
938 break;
939
940 case CCL_WriteConstString: /* CCCCCCCCCCCCCCCCCCCCrrrXXXXX */
941 if (!rrr)
942 CCL_WRITE_CHAR (field1);
943 else
944 {
945 CCL_WRITE_STRING (field1);
946 ic += (field1 + 2) / 3;
947 }
948 break;
949
950 case CCL_WriteArray: /* CCCCCCCCCCCCCCCCCCCCrrrXXXXX */
951 i = reg[rrr];
952 if ((unsigned int) i < field1)
953 {
954 j = XINT (ccl_prog[ic + i]);
955 CCL_WRITE_CHAR (j);
956 }
957 ic += field1;
958 break;
959
960 case CCL_End: /* 0000000000000000000000XXXXX */
961 if (stack_idx-- > 0)
962 {
963 ccl_prog = ccl_prog_stack_struct[stack_idx].ccl_prog;
964 ic = ccl_prog_stack_struct[stack_idx].ic;
965 break;
966 }
967 CCL_SUCCESS;
968
969 case CCL_ExprSelfConst: /* 00000OPERATION000000rrrXXXXX */
970 i = XINT (ccl_prog[ic]);
971 ic++;
972 op = field1 >> 6;
973 goto ccl_expr_self;
974
975 case CCL_ExprSelfReg: /* 00000OPERATION000RRRrrrXXXXX */
976 i = reg[RRR];
977 op = field1 >> 6;
978
979 ccl_expr_self:
980 switch (op)
981 {
982 case CCL_PLUS: reg[rrr] += i; break;
983 case CCL_MINUS: reg[rrr] -= i; break;
984 case CCL_MUL: reg[rrr] *= i; break;
985 case CCL_DIV: reg[rrr] /= i; break;
986 case CCL_MOD: reg[rrr] %= i; break;
987 case CCL_AND: reg[rrr] &= i; break;
988 case CCL_OR: reg[rrr] |= i; break;
989 case CCL_XOR: reg[rrr] ^= i; break;
990 case CCL_LSH: reg[rrr] <<= i; break;
991 case CCL_RSH: reg[rrr] >>= i; break;
992 case CCL_LSH8: reg[rrr] <<= 8; reg[rrr] |= i; break;
993 case CCL_RSH8: reg[7] = reg[rrr] & 0xFF; reg[rrr] >>= 8; break;
994 case CCL_DIVMOD: reg[7] = reg[rrr] % i; reg[rrr] /= i; break;
995 case CCL_LS: reg[rrr] = reg[rrr] < i; break;
996 case CCL_GT: reg[rrr] = reg[rrr] > i; break;
997 case CCL_EQ: reg[rrr] = reg[rrr] == i; break;
998 case CCL_LE: reg[rrr] = reg[rrr] <= i; break;
999 case CCL_GE: reg[rrr] = reg[rrr] >= i; break;
1000 case CCL_NE: reg[rrr] = reg[rrr] != i; break;
1001 default: CCL_INVALID_CMD;
1002 }
1003 break;
1004
1005 case CCL_SetExprConst: /* 00000OPERATION000RRRrrrXXXXX */
1006 i = reg[RRR];
1007 j = XINT (ccl_prog[ic]);
1008 op = field1 >> 6;
1009 jump_address = ++ic;
1010 goto ccl_set_expr;
1011
1012 case CCL_SetExprReg: /* 00000OPERATIONRrrRRRrrrXXXXX */
1013 i = reg[RRR];
1014 j = reg[Rrr];
1015 op = field1 >> 6;
1016 jump_address = ic;
1017 goto ccl_set_expr;
1018
1019 case CCL_ReadJumpCondExprConst: /* A--D--D--R--E--S--S-rrrXXXXX */
1020 CCL_READ_CHAR (reg[rrr]);
1021 case CCL_JumpCondExprConst: /* A--D--D--R--E--S--S-rrrXXXXX */
1022 i = reg[rrr];
1023 op = XINT (ccl_prog[ic]);
1024 jump_address = ic++ + ADDR;
1025 j = XINT (ccl_prog[ic]);
1026 ic++;
1027 rrr = 7;
1028 goto ccl_set_expr;
1029
1030 case CCL_ReadJumpCondExprReg: /* A--D--D--R--E--S--S-rrrXXXXX */
1031 CCL_READ_CHAR (reg[rrr]);
1032 case CCL_JumpCondExprReg:
1033 i = reg[rrr];
1034 op = XINT (ccl_prog[ic]);
1035 jump_address = ic++ + ADDR;
1036 j = reg[XINT (ccl_prog[ic])];
1037 ic++;
1038 rrr = 7;
1039
1040 ccl_set_expr:
1041 switch (op)
1042 {
1043 case CCL_PLUS: reg[rrr] = i + j; break;
1044 case CCL_MINUS: reg[rrr] = i - j; break;
1045 case CCL_MUL: reg[rrr] = i * j; break;
1046 case CCL_DIV: reg[rrr] = i / j; break;
1047 case CCL_MOD: reg[rrr] = i % j; break;
1048 case CCL_AND: reg[rrr] = i & j; break;
1049 case CCL_OR: reg[rrr] = i | j; break;
1050 case CCL_XOR: reg[rrr] = i ^ j;; break;
1051 case CCL_LSH: reg[rrr] = i << j; break;
1052 case CCL_RSH: reg[rrr] = i >> j; break;
1053 case CCL_LSH8: reg[rrr] = (i << 8) | j; break;
1054 case CCL_RSH8: reg[rrr] = i >> 8; reg[7] = i & 0xFF; break;
1055 case CCL_DIVMOD: reg[rrr] = i / j; reg[7] = i % j; break;
1056 case CCL_LS: reg[rrr] = i < j; break;
1057 case CCL_GT: reg[rrr] = i > j; break;
1058 case CCL_EQ: reg[rrr] = i == j; break;
1059 case CCL_LE: reg[rrr] = i <= j; break;
1060 case CCL_GE: reg[rrr] = i >= j; break;
1061 case CCL_NE: reg[rrr] = i != j; break;
1062 case CCL_ENCODE_SJIS: ENCODE_SJIS (i, j, reg[rrr], reg[7]); break;
1063 case CCL_DECODE_SJIS: DECODE_SJIS (i, j, reg[rrr], reg[7]); break;
1064 default: CCL_INVALID_CMD;
1065 }
1066 code &= 0x1F;
1067 if (code == CCL_WriteExprConst || code == CCL_WriteExprRegister)
1068 {
1069 i = reg[rrr];
1070 CCL_WRITE_CHAR (i);
1071 }
1072 else if (!reg[rrr])
1073 ic = jump_address;
1074 break;
1075
1076 case CCL_Extention:
1077 switch (EXCMD)
1078 {
1079 case CCL_ReadMultibyteChar2:
1080 if (!src)
1081 CCL_INVALID_CMD;
1082 do {
1083 if (src >= src_end)
1084 {
1085 src++;
1086 goto ccl_read_multibyte_character_suspend;
1087 }
1088
1089 i = *src++;
1090 if (i == LEADING_CODE_COMPOSITION)
1091 {
1092 if (src >= src_end)
1093 goto ccl_read_multibyte_character_suspend;
1094 if (*src == 0xFF)
1095 {
1096 ccl->private_state = COMPOSING_WITH_RULE_HEAD;
1097 src++;
1098 }
1099 else
1100 ccl->private_state = COMPOSING_NO_RULE_HEAD;
1101 }
1102 if (ccl->private_state != 0)
1103 {
1104 /* composite character */
1105 if (*src < 0xA0)
1106 ccl->private_state = 0;
1107 else
1108 {
1109 if (i == 0xA0)
1110 {
1111 if (src >= src_end)
1112 goto ccl_read_multibyte_character_suspend;
1113 i = *src++ & 0x7F;
1114 }
1115 else
1116 i -= 0x20;
1117
1118 if (COMPOSING_WITH_RULE_RULE == ccl->private_state)
1119 {
1120 ccl->private_state = COMPOSING_WITH_RULE_HEAD;
1121 continue;
1122 }
1123 else if (COMPOSING_WITH_RULE_HEAD == ccl->private_state)
1124 ccl->private_state = COMPOSING_WITH_RULE_RULE;
1125 }
1126 }
1127 if (i < 0x80)
1128 {
1129 /* ASCII */
1130 reg[rrr] = i;
1131 reg[RRR] = CHARSET_ASCII;
1132 }
1133 else if (i <= MAX_CHARSET_OFFICIAL_DIMENSION1)
1134 {
1135 if (src >= src_end)
1136 goto ccl_read_multibyte_character_suspend;
1137 reg[RRR] = i;
1138 reg[rrr] = (*src++ & 0x7F);
1139 }
1140 else if (i <= MAX_CHARSET_OFFICIAL_DIMENSION2)
1141 {
1142 if ((src + 1) >= src_end)
1143 goto ccl_read_multibyte_character_suspend;
1144 reg[RRR] = i;
1145 i = (*src++ & 0x7F);
1146 reg[rrr] = ((i << 7) | (*src & 0x7F));
1147 src++;
1148 }
1149 else if ((i == LEADING_CODE_PRIVATE_11)
1150 || (i == LEADING_CODE_PRIVATE_12))
1151 {
1152 if ((src + 1) >= src_end)
1153 goto ccl_read_multibyte_character_suspend;
1154 reg[RRR] = *src++;
1155 reg[rrr] = (*src++ & 0x7F);
1156 }
1157 else if ((i == LEADING_CODE_PRIVATE_21)
1158 || (i == LEADING_CODE_PRIVATE_22))
1159 {
1160 if ((src + 2) >= src_end)
1161 goto ccl_read_multibyte_character_suspend;
1162 reg[RRR] = *src++;
1163 i = (*src++ & 0x7F);
1164 reg[rrr] = ((i << 7) | (*src & 0x7F));
1165 src++;
1166 }
1167 else
1168 {
1169 /* INVALID CODE
1170 Returned charset is -1. */
1171 reg[RRR] = -1;
1172 }
1173 } while (0);
1174 break;
1175
1176 ccl_read_multibyte_character_suspend:
1177 src--;
1178 if (ccl->last_block)
1179 {
1180 ic = ccl->eof_ic;
1181 goto ccl_finish;
1182 }
1183 else
1184 CCL_SUSPEND (CCL_STAT_SUSPEND_BY_SRC);
1185
1186 break;
1187
1188 case CCL_WriteMultibyteChar2:
1189 i = reg[RRR]; /* charset */
1190 if (i == CHARSET_ASCII)
1191 i = reg[rrr] & 0x7F;
1192 else if (i == CHARSET_COMPOSITION)
1193 i = MAKE_COMPOSITE_CHAR (reg[rrr]);
1194 else if (CHARSET_DIMENSION (i) == 1)
1195 i = ((i - 0x70) << 7) | (reg[rrr] & 0x7F);
1196 else if (i < MIN_CHARSET_PRIVATE_DIMENSION2)
1197 i = ((i - 0x8F) << 14) | reg[rrr];
1198 else
1199 i = ((i - 0xE0) << 14) | reg[rrr];
1200
1201 CCL_WRITE_CHAR (i);
1202
1203 break;
1204
1205 case CCL_TranslateCharacter:
1206 i = reg[RRR]; /* charset */
1207 if (i == CHARSET_ASCII)
1208 i = reg[rrr] & 0x7F;
1209 else if (i == CHARSET_COMPOSITION)
1210 {
1211 reg[RRR] = -1;
1212 break;
1213 }
1214 else if (CHARSET_DIMENSION (i) == 1)
1215 i = ((i - 0x70) << 7) | (reg[rrr] & 0x7F);
1216 else if (i < MIN_CHARSET_PRIVATE_DIMENSION2)
1217 i = ((i - 0x8F) << 14) | (reg[rrr] & 0x3FFF);
1218 else
1219 i = ((i - 0xE0) << 14) | (reg[rrr] & 0x3FFF);
1220
1221 op = translate_char (GET_TRANSLATION_TABLE (reg[Rrr]),
1222 i, -1, 0, 0);
1223 SPLIT_CHAR (op, reg[RRR], i, j);
1224 if (j != -1)
1225 i = (i << 7) | j;
1226
1227 reg[rrr] = i;
1228 break;
1229
1230 case CCL_TranslateCharacterConstTbl:
1231 op = XINT (ccl_prog[ic]); /* table */
1232 ic++;
1233 i = reg[RRR]; /* charset */
1234 if (i == CHARSET_ASCII)
1235 i = reg[rrr] & 0x7F;
1236 else if (i == CHARSET_COMPOSITION)
1237 {
1238 reg[RRR] = -1;
1239 break;
1240 }
1241 else if (CHARSET_DIMENSION (i) == 1)
1242 i = ((i - 0x70) << 7) | (reg[rrr] & 0x7F);
1243 else if (i < MIN_CHARSET_PRIVATE_DIMENSION2)
1244 i = ((i - 0x8F) << 14) | (reg[rrr] & 0x3FFF);
1245 else
1246 i = ((i - 0xE0) << 14) | (reg[rrr] & 0x3FFF);
1247
1248 op = translate_char (GET_TRANSLATION_TABLE (op), i, -1, 0, 0);
1249 SPLIT_CHAR (op, reg[RRR], i, j);
1250 if (j != -1)
1251 i = (i << 7) | j;
1252
1253 reg[rrr] = i;
1254 break;
1255
1256 case CCL_IterateMultipleMap:
1257 {
1258 Lisp_Object map, content, attrib, value;
1259 int point, size, fin_ic;
1260
1261 j = XINT (ccl_prog[ic++]); /* number of maps. */
1262 fin_ic = ic + j;
1263 op = reg[rrr];
1264 if ((j > reg[RRR]) && (j >= 0))
1265 {
1266 ic += reg[RRR];
1267 i = reg[RRR];
1268 }
1269 else
1270 {
1271 reg[RRR] = -1;
1272 ic = fin_ic;
1273 break;
1274 }
1275
1276 for (;i < j;i++)
1277 {
1278
1279 size = XVECTOR (Vcode_conversion_map_vector)->size;
1280 point = XINT (ccl_prog[ic++]);
1281 if (point >= size) continue;
1282 map =
1283 XVECTOR (Vcode_conversion_map_vector)->contents[point];
1284
1285 /* Check map varidity. */
1286 if (!CONSP (map)) continue;
1287 map = XCONS(map)->cdr;
1288 if (!VECTORP (map)) continue;
1289 size = XVECTOR (map)->size;
1290 if (size <= 1) continue;
1291
1292 content = XVECTOR (map)->contents[0];
1293
1294 /* check map type,
1295 [STARTPOINT VAL1 VAL2 ...] or
1296 [t ELELMENT STARTPOINT ENDPOINT] */
1297 if (NUMBERP (content))
1298 {
1299 point = XUINT (content);
1300 point = op - point + 1;
1301 if (!((point >= 1) && (point < size))) continue;
1302 content = XVECTOR (map)->contents[point];
1303 }
1304 else if (EQ (content, Qt))
1305 {
1306 if (size != 4) continue;
1307 if ((op >= XUINT (XVECTOR (map)->contents[2]))
1308 && (op < XUINT (XVECTOR (map)->contents[3])))
1309 content = XVECTOR (map)->contents[1];
1310 else
1311 continue;
1312 }
1313 else
1314 continue;
1315
1316 if (NILP (content))
1317 continue;
1318 else if (NUMBERP (content))
1319 {
1320 reg[RRR] = i;
1321 reg[rrr] = XINT(content);
1322 break;
1323 }
1324 else if (EQ (content, Qt) || EQ (content, Qlambda))
1325 {
1326 reg[RRR] = i;
1327 break;
1328 }
1329 else if (CONSP (content))
1330 {
1331 attrib = XCONS (content)->car;
1332 value = XCONS (content)->cdr;
1333 if (!NUMBERP (attrib) || !NUMBERP (value))
1334 continue;
1335 reg[RRR] = i;
1336 reg[rrr] = XUINT (value);
1337 break;
1338 }
1339 }
1340 if (i == j)
1341 reg[RRR] = -1;
1342 ic = fin_ic;
1343 }
1344 break;
1345
1346 case CCL_MapMultiple:
1347 {
1348 Lisp_Object map, content, attrib, value;
1349 int point, size, map_vector_size;
1350 int map_set_rest_length, fin_ic;
1351
1352 map_set_rest_length =
1353 XINT (ccl_prog[ic++]); /* number of maps and separators. */
1354 fin_ic = ic + map_set_rest_length;
1355 if ((map_set_rest_length > reg[RRR]) && (reg[RRR] >= 0))
1356 {
1357 ic += reg[RRR];
1358 i = reg[RRR];
1359 map_set_rest_length -= i;
1360 }
1361 else
1362 {
1363 ic = fin_ic;
1364 reg[RRR] = -1;
1365 break;
1366 }
1367 mapping_stack_pointer = mapping_stack;
1368 op = reg[rrr];
1369 PUSH_MAPPING_STACK (0, op);
1370 reg[RRR] = -1;
1371 map_vector_size = XVECTOR (Vcode_conversion_map_vector)->size;
1372 for (;map_set_rest_length > 0;i++, map_set_rest_length--)
1373 {
1374 point = XINT(ccl_prog[ic++]);
1375 if (point < 0)
1376 {
1377 point = -point;
1378 if (mapping_stack_pointer
1379 >= &mapping_stack[MAX_MAP_SET_LEVEL])
1380 {
1381 CCL_INVALID_CMD;
1382 }
1383 PUSH_MAPPING_STACK (map_set_rest_length - point,
1384 reg[rrr]);
1385 map_set_rest_length = point + 1;
1386 reg[rrr] = op;
1387 continue;
1388 }
1389
1390 if (point >= map_vector_size) continue;
1391 map = (XVECTOR (Vcode_conversion_map_vector)
1392 ->contents[point]);
1393
1394 /* Check map varidity. */
1395 if (!CONSP (map)) continue;
1396 map = XCONS (map)->cdr;
1397 if (!VECTORP (map)) continue;
1398 size = XVECTOR (map)->size;
1399 if (size <= 1) continue;
1400
1401 content = XVECTOR (map)->contents[0];
1402
1403 /* check map type,
1404 [STARTPOINT VAL1 VAL2 ...] or
1405 [t ELEMENT STARTPOINT ENDPOINT] */
1406 if (NUMBERP (content))
1407 {
1408 point = XUINT (content);
1409 point = op - point + 1;
1410 if (!((point >= 1) && (point < size))) continue;
1411 content = XVECTOR (map)->contents[point];
1412 }
1413 else if (EQ (content, Qt))
1414 {
1415 if (size != 4) continue;
1416 if ((op >= XUINT (XVECTOR (map)->contents[2])) &&
1417 (op < XUINT (XVECTOR (map)->contents[3])))
1418 content = XVECTOR (map)->contents[1];
1419 else
1420 continue;
1421 }
1422 else
1423 continue;
1424
1425 if (NILP (content))
1426 continue;
1427 else if (NUMBERP (content))
1428 {
1429 op = XINT (content);
1430 reg[RRR] = i;
1431 i += map_set_rest_length;
1432 POP_MAPPING_STACK (map_set_rest_length, reg[rrr]);
1433 }
1434 else if (CONSP (content))
1435 {
1436 attrib = XCONS (content)->car;
1437 value = XCONS (content)->cdr;
1438 if (!NUMBERP (attrib) || !NUMBERP (value))
1439 continue;
1440 reg[RRR] = i;
1441 op = XUINT (value);
1442 i += map_set_rest_length;
1443 POP_MAPPING_STACK (map_set_rest_length, reg[rrr]);
1444 }
1445 else if (EQ (content, Qt))
1446 {
1447 reg[RRR] = i;
1448 op = reg[rrr];
1449 i += map_set_rest_length;
1450 POP_MAPPING_STACK (map_set_rest_length, reg[rrr]);
1451 }
1452 else if (EQ (content, Qlambda))
1453 {
1454 break;
1455 }
1456 else
1457 CCL_INVALID_CMD;
1458 }
1459 ic = fin_ic;
1460 }
1461 reg[rrr] = op;
1462 break;
1463
1464 case CCL_MapSingle:
1465 {
1466 Lisp_Object map, attrib, value, content;
1467 int size, point;
1468 j = XINT (ccl_prog[ic++]); /* map_id */
1469 op = reg[rrr];
1470 if (j >= XVECTOR (Vcode_conversion_map_vector)->size)
1471 {
1472 reg[RRR] = -1;
1473 break;
1474 }
1475 map = XVECTOR (Vcode_conversion_map_vector)->contents[j];
1476 if (!CONSP (map))
1477 {
1478 reg[RRR] = -1;
1479 break;
1480 }
1481 map = XCONS(map)->cdr;
1482 if (!VECTORP (map))
1483 {
1484 reg[RRR] = -1;
1485 break;
1486 }
1487 size = XVECTOR (map)->size;
1488 point = XUINT (XVECTOR (map)->contents[0]);
1489 point = op - point + 1;
1490 reg[RRR] = 0;
1491 if ((size <= 1) ||
1492 (!((point >= 1) && (point < size))))
1493 reg[RRR] = -1;
1494 else
1495 {
1496 content = XVECTOR (map)->contents[point];
1497 if (NILP (content))
1498 reg[RRR] = -1;
1499 else if (NUMBERP (content))
1500 reg[rrr] = XINT (content);
1501 else if (EQ (content, Qt))
1502 reg[RRR] = i;
1503 else if (CONSP (content))
1504 {
1505 attrib = XCONS (content)->car;
1506 value = XCONS (content)->cdr;
1507 if (!NUMBERP (attrib) || !NUMBERP (value))
1508 continue;
1509 reg[rrr] = XUINT(value);
1510 break;
1511 }
1512 else
1513 reg[RRR] = -1;
1514 }
1515 }
1516 break;
1517
1518 default:
1519 CCL_INVALID_CMD;
1520 }
1521 break;
1522
1523 default:
1524 CCL_INVALID_CMD;
1525 }
1526 }
1527
1528 ccl_error_handler:
1529 if (destination)
1530 {
1531 /* We can insert an error message only if DESTINATION is
1532 specified and we still have a room to store the message
1533 there. */
1534 char msg[256];
1535 int msglen;
1536
1537 switch (ccl->status)
1538 {
1539 case CCL_STAT_INVALID_CMD:
1540 sprintf(msg, "\nCCL: Invalid command %x (ccl_code = %x) at %d.",
1541 code & 0x1F, code, ic);
1542 #ifdef CCL_DEBUG
1543 {
1544 int i = ccl_backtrace_idx - 1;
1545 int j;
1546
1547 msglen = strlen (msg);
1548 if (dst + msglen <= dst_end)
1549 {
1550 bcopy (msg, dst, msglen);
1551 dst += msglen;
1552 }
1553
1554 for (j = 0; j < CCL_DEBUG_BACKTRACE_LEN; j++, i--)
1555 {
1556 if (i < 0) i = CCL_DEBUG_BACKTRACE_LEN - 1;
1557 if (ccl_backtrace_table[i] == 0)
1558 break;
1559 sprintf(msg, " %d", ccl_backtrace_table[i]);
1560 msglen = strlen (msg);
1561 if (dst + msglen > dst_end)
1562 break;
1563 bcopy (msg, dst, msglen);
1564 dst += msglen;
1565 }
1566 }
1567 #endif
1568 goto ccl_finish;
1569
1570 case CCL_STAT_QUIT:
1571 sprintf(msg, "\nCCL: Quited.");
1572 break;
1573
1574 default:
1575 sprintf(msg, "\nCCL: Unknown error type (%d).", ccl->status);
1576 }
1577
1578 msglen = strlen (msg);
1579 if (dst + msglen <= dst_end)
1580 {
1581 bcopy (msg, dst, msglen);
1582 dst += msglen;
1583 }
1584 }
1585
1586 ccl_finish:
1587 ccl->ic = ic;
1588 if (consumed) *consumed = src - source;
1589 return dst - destination;
1590 }
1591
1592 /* Setup fields of the structure pointed by CCL appropriately for the
1593 execution of compiled CCL code in VEC (vector of integer). */
1594 void
1595 setup_ccl_program (ccl, vec)
1596 struct ccl_program *ccl;
1597 Lisp_Object vec;
1598 {
1599 int i;
1600
1601 ccl->size = XVECTOR (vec)->size;
1602 ccl->prog = XVECTOR (vec)->contents;
1603 ccl->ic = CCL_HEADER_MAIN;
1604 ccl->eof_ic = XINT (XVECTOR (vec)->contents[CCL_HEADER_EOF]);
1605 ccl->buf_magnification = XINT (XVECTOR (vec)->contents[CCL_HEADER_BUF_MAG]);
1606 for (i = 0; i < 8; i++)
1607 ccl->reg[i] = 0;
1608 ccl->last_block = 0;
1609 ccl->private_state = 0;
1610 ccl->status = 0;
1611 }
1612
1613 /* Resolve symbols in the specified CCL code (Lisp vector). This
1614 function converts symbols of code conversion maps and character
1615 translation tables embeded in the CCL code into their ID numbers. */
1616
1617 Lisp_Object
1618 resolve_symbol_ccl_program (ccl)
1619 Lisp_Object ccl;
1620 {
1621 int i, veclen;
1622 Lisp_Object result, contents, prop;
1623
1624 result = ccl;
1625 veclen = XVECTOR (result)->size;
1626
1627 /* Set CCL program's table ID */
1628 for (i = 0; i < veclen; i++)
1629 {
1630 contents = XVECTOR (result)->contents[i];
1631 if (SYMBOLP (contents))
1632 {
1633 if (EQ(result, ccl))
1634 result = Fcopy_sequence (ccl);
1635
1636 prop = Fget (contents, Qcharacter_translation_table_id);
1637 if (NUMBERP (prop))
1638 {
1639 XVECTOR (result)->contents[i] = prop;
1640 continue;
1641 }
1642 prop = Fget (contents, Qcode_conversion_map_id);
1643 if (NUMBERP (prop))
1644 {
1645 XVECTOR (result)->contents[i] = prop;
1646 continue;
1647 }
1648 prop = Fget (contents, Qccl_program_idx);
1649 if (NUMBERP (prop))
1650 {
1651 XVECTOR (result)->contents[i] = prop;
1652 continue;
1653 }
1654 }
1655 }
1656
1657 return result;
1658 }
1659
1660
1661 #ifdef emacs
1662
1663 DEFUN ("ccl-execute", Fccl_execute, Sccl_execute, 2, 2, 0,
1664 "Execute CCL-PROGRAM with registers initialized by REGISTERS.\n\
1665 \n\
1666 CCL-PROGRAM is a symbol registered by register-ccl-program,\n\
1667 or a compiled code generated by `ccl-compile' (for backward compatibility,\n\
1668 in this case, the execution is slower).\n\
1669 No I/O commands should appear in CCL-PROGRAM.\n\
1670 \n\
1671 REGISTERS is a vector of [R0 R1 ... R7] where RN is an initial value\n\
1672 of Nth register.\n\
1673 \n\
1674 As side effect, each element of REGISTERS holds the value of\n\
1675 corresponding register after the execution.")
1676 (ccl_prog, reg)
1677 Lisp_Object ccl_prog, reg;
1678 {
1679 struct ccl_program ccl;
1680 int i;
1681 Lisp_Object ccl_id;
1682
1683 if ((SYMBOLP (ccl_prog)) &&
1684 (!NILP (ccl_id = Fget (ccl_prog, Qccl_program_idx))))
1685 {
1686 ccl_prog = XVECTOR (Vccl_program_table)->contents[XUINT (ccl_id)];
1687 CHECK_LIST (ccl_prog, 0);
1688 ccl_prog = XCONS (ccl_prog)->cdr;
1689 CHECK_VECTOR (ccl_prog, 1);
1690 }
1691 else
1692 {
1693 CHECK_VECTOR (ccl_prog, 1);
1694 ccl_prog = resolve_symbol_ccl_program (ccl_prog);
1695 }
1696
1697 CHECK_VECTOR (reg, 2);
1698 if (XVECTOR (reg)->size != 8)
1699 error ("Invalid length of vector REGISTERS");
1700
1701 setup_ccl_program (&ccl, ccl_prog);
1702 for (i = 0; i < 8; i++)
1703 ccl.reg[i] = (INTEGERP (XVECTOR (reg)->contents[i])
1704 ? XINT (XVECTOR (reg)->contents[i])
1705 : 0);
1706
1707 ccl_driver (&ccl, (char *)0, (char *)0, 0, 0, (int *)0);
1708 QUIT;
1709 if (ccl.status != CCL_STAT_SUCCESS)
1710 error ("Error in CCL program at %dth code", ccl.ic);
1711
1712 for (i = 0; i < 8; i++)
1713 XSETINT (XVECTOR (reg)->contents[i], ccl.reg[i]);
1714 return Qnil;
1715 }
1716
1717 DEFUN ("ccl-execute-on-string", Fccl_execute_on_string, Sccl_execute_on_string,
1718 3, 5, 0,
1719 "Execute CCL-PROGRAM with initial STATUS on STRING.\n\
1720 \n\
1721 CCL-PROGRAM is a symbol registered by register-ccl-program,\n\
1722 or a compiled code generated by `ccl-compile' (for backward compatibility,\n\
1723 in this case, the execution is slower).\n\
1724 \n\
1725 Read buffer is set to STRING, and write buffer is allocated automatically.\n\
1726 \n\
1727 STATUS is a vector of [R0 R1 ... R7 IC], where\n\
1728 R0..R7 are initial values of corresponding registers,\n\
1729 IC is the instruction counter specifying from where to start the program.\n\
1730 If R0..R7 are nil, they are initialized to 0.\n\
1731 If IC is nil, it is initialized to head of the CCL program.\n\
1732 \n\
1733 If optional 4th arg CONTINUE is non-nil, keep IC on read operation\n\
1734 when read buffer is exausted, else, IC is always set to the end of\n\
1735 CCL-PROGRAM on exit.\n\
1736 \n\
1737 It returns the contents of write buffer as a string,\n\
1738 and as side effect, STATUS is updated.\n\
1739 If the optional 5th arg UNIBYTE-P is non-nil, the returned string\n\
1740 is a unibyte string. By default it is a multibyte string.")
1741 (ccl_prog, status, str, contin, unibyte_p)
1742 Lisp_Object ccl_prog, status, str, contin, unibyte_p;
1743 {
1744 Lisp_Object val;
1745 struct ccl_program ccl;
1746 int i, produced;
1747 int outbufsize;
1748 char *outbuf;
1749 struct gcpro gcpro1, gcpro2, gcpro3;
1750 Lisp_Object ccl_id;
1751
1752 if ((SYMBOLP (ccl_prog)) &&
1753 (!NILP (ccl_id = Fget (ccl_prog, Qccl_program_idx))))
1754 {
1755 ccl_prog = XVECTOR (Vccl_program_table)->contents[XUINT (ccl_id)];
1756 CHECK_LIST (ccl_prog, 0);
1757 ccl_prog = XCONS (ccl_prog)->cdr;
1758 CHECK_VECTOR (ccl_prog, 1);
1759 }
1760 else
1761 {
1762 CHECK_VECTOR (ccl_prog, 1);
1763 ccl_prog = resolve_symbol_ccl_program (ccl_prog);
1764 }
1765
1766 CHECK_VECTOR (status, 1);
1767 if (XVECTOR (status)->size != 9)
1768 error ("Invalid length of vector STATUS");
1769 CHECK_STRING (str, 2);
1770 GCPRO3 (ccl_prog, status, str);
1771
1772 setup_ccl_program (&ccl, ccl_prog);
1773 for (i = 0; i < 8; i++)
1774 {
1775 if (NILP (XVECTOR (status)->contents[i]))
1776 XSETINT (XVECTOR (status)->contents[i], 0);
1777 if (INTEGERP (XVECTOR (status)->contents[i]))
1778 ccl.reg[i] = XINT (XVECTOR (status)->contents[i]);
1779 }
1780 if (INTEGERP (XVECTOR (status)->contents[i]))
1781 {
1782 i = XFASTINT (XVECTOR (status)->contents[8]);
1783 if (ccl.ic < i && i < ccl.size)
1784 ccl.ic = i;
1785 }
1786 outbufsize = STRING_BYTES (XSTRING (str)) * ccl.buf_magnification + 256;
1787 outbuf = (char *) xmalloc (outbufsize);
1788 if (!outbuf)
1789 error ("Not enough memory");
1790 ccl.last_block = NILP (contin);
1791 produced = ccl_driver (&ccl, XSTRING (str)->data, outbuf,
1792 STRING_BYTES (XSTRING (str)), outbufsize, (int *)0);
1793 for (i = 0; i < 8; i++)
1794 XSET (XVECTOR (status)->contents[i], Lisp_Int, ccl.reg[i]);
1795 XSETINT (XVECTOR (status)->contents[8], ccl.ic);
1796 UNGCPRO;
1797
1798 if (NILP (unibyte_p))
1799 val = make_string (outbuf, produced);
1800 else
1801 val = make_unibyte_string (outbuf, produced);
1802 free (outbuf);
1803 QUIT;
1804 if (ccl.status != CCL_STAT_SUCCESS
1805 && ccl.status != CCL_STAT_SUSPEND_BY_SRC
1806 && ccl.status != CCL_STAT_SUSPEND_BY_DST)
1807 error ("Error in CCL program at %dth code", ccl.ic);
1808
1809 return val;
1810 }
1811
1812 DEFUN ("register-ccl-program", Fregister_ccl_program, Sregister_ccl_program,
1813 2, 2, 0,
1814 "Register CCL program PROGRAM of NAME in `ccl-program-table'.\n\
1815 PROGRAM should be a compiled code of CCL program, or nil.\n\
1816 Return index number of the registered CCL program.")
1817 (name, ccl_prog)
1818 Lisp_Object name, ccl_prog;
1819 {
1820 int len = XVECTOR (Vccl_program_table)->size;
1821 int i;
1822
1823 CHECK_SYMBOL (name, 0);
1824 if (!NILP (ccl_prog))
1825 {
1826 CHECK_VECTOR (ccl_prog, 1);
1827 ccl_prog = resolve_symbol_ccl_program (ccl_prog);
1828 }
1829
1830 for (i = 0; i < len; i++)
1831 {
1832 Lisp_Object slot = XVECTOR (Vccl_program_table)->contents[i];
1833
1834 if (!CONSP (slot))
1835 break;
1836
1837 if (EQ (name, XCONS (slot)->car))
1838 {
1839 XCONS (slot)->cdr = ccl_prog;
1840 return make_number (i);
1841 }
1842 }
1843
1844 if (i == len)
1845 {
1846 Lisp_Object new_table = Fmake_vector (make_number (len * 2), Qnil);
1847 int j;
1848
1849 for (j = 0; j < len; j++)
1850 XVECTOR (new_table)->contents[j]
1851 = XVECTOR (Vccl_program_table)->contents[j];
1852 Vccl_program_table = new_table;
1853 }
1854
1855 XVECTOR (Vccl_program_table)->contents[i] = Fcons (name, ccl_prog);
1856 Fput (name, Qccl_program_idx, make_number (i));
1857 return make_number (i);
1858 }
1859
1860 /* Register code conversion map.
1861 A code conversion map consists of numbers, Qt, Qnil, and Qlambda.
1862 The first element is start code point.
1863 The rest elements are mapped numbers.
1864 Symbol t means to map to an original number before mapping.
1865 Symbol nil means that the corresponding element is empty.
1866 Symbol lambda menas to terminate mapping here.
1867 */
1868
1869 DEFUN ("register-code-conversion-map", Fregister_code_conversion_map,
1870 Sregister_code_conversion_map,
1871 2, 2, 0,
1872 "Register SYMBOL as code conversion map MAP.\n\
1873 Return index number of the registered map.")
1874 (symbol, map)
1875 Lisp_Object symbol, map;
1876 {
1877 int len = XVECTOR (Vcode_conversion_map_vector)->size;
1878 int i;
1879 Lisp_Object index;
1880
1881 CHECK_SYMBOL (symbol, 0);
1882 CHECK_VECTOR (map, 1);
1883
1884 for (i = 0; i < len; i++)
1885 {
1886 Lisp_Object slot = XVECTOR (Vcode_conversion_map_vector)->contents[i];
1887
1888 if (!CONSP (slot))
1889 break;
1890
1891 if (EQ (symbol, XCONS (slot)->car))
1892 {
1893 index = make_number (i);
1894 XCONS (slot)->cdr = map;
1895 Fput (symbol, Qcode_conversion_map, map);
1896 Fput (symbol, Qcode_conversion_map_id, index);
1897 return index;
1898 }
1899 }
1900
1901 if (i == len)
1902 {
1903 Lisp_Object new_vector = Fmake_vector (make_number (len * 2), Qnil);
1904 int j;
1905
1906 for (j = 0; j < len; j++)
1907 XVECTOR (new_vector)->contents[j]
1908 = XVECTOR (Vcode_conversion_map_vector)->contents[j];
1909 Vcode_conversion_map_vector = new_vector;
1910 }
1911
1912 index = make_number (i);
1913 Fput (symbol, Qcode_conversion_map, map);
1914 Fput (symbol, Qcode_conversion_map_id, index);
1915 XVECTOR (Vcode_conversion_map_vector)->contents[i] = Fcons (symbol, map);
1916 return index;
1917 }
1918
1919
1920 void
1921 syms_of_ccl ()
1922 {
1923 staticpro (&Vccl_program_table);
1924 Vccl_program_table = Fmake_vector (make_number (32), Qnil);
1925
1926 Qccl_program = intern ("ccl-program");
1927 staticpro (&Qccl_program);
1928
1929 Qccl_program_idx = intern ("ccl-program-idx");
1930 staticpro (&Qccl_program_idx);
1931
1932 Qcode_conversion_map = intern ("code-conversion-map");
1933 staticpro (&Qcode_conversion_map);
1934
1935 Qcode_conversion_map_id = intern ("code-conversion-map-id");
1936 staticpro (&Qcode_conversion_map_id);
1937
1938 DEFVAR_LISP ("code-conversion-map-vector", &Vcode_conversion_map_vector,
1939 "Vector of code conversion maps.");
1940 Vcode_conversion_map_vector = Fmake_vector (make_number (16), Qnil);
1941
1942 DEFVAR_LISP ("font-ccl-encoder-alist", &Vfont_ccl_encoder_alist,
1943 "Alist of fontname patterns vs corresponding CCL program.\n\
1944 Each element looks like (REGEXP . CCL-CODE),\n\
1945 where CCL-CODE is a compiled CCL program.\n\
1946 When a font whose name matches REGEXP is used for displaying a character,\n\
1947 CCL-CODE is executed to calculate the code point in the font\n\
1948 from the charset number and position code(s) of the character which are set\n\
1949 in CCL registers R0, R1, and R2 before the execution.\n\
1950 The code point in the font is set in CCL registers R1 and R2\n\
1951 when the execution terminated.\n\
1952 If the font is single-byte font, the register R2 is not used.");
1953 Vfont_ccl_encoder_alist = Qnil;
1954
1955 defsubr (&Sccl_execute);
1956 defsubr (&Sccl_execute_on_string);
1957 defsubr (&Sregister_ccl_program);
1958 defsubr (&Sregister_code_conversion_map);
1959 }
1960
1961 #endif /* emacs */