(CCL_WRITE_CHAR): Don't use bcopy.
[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 available 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 translation table whose ID is reg[Rrr].
446
447 A translated character is set in reg[rrr] (code point) and reg[RRR]
448 (charset ID). */
449
450 #define CCL_TranslateCharacter 0x02 /* Translate a multibyte character
451 1:ExtendedCOMMNDRrrRRRrrrXXXXX */
452
453 /* Translate a character whose code point is reg[rrr] and the charset
454 ID is reg[RRR] by a translation table whose ID is ARGUMENT.
455
456 A translated character is set in reg[rrr] (code point) and reg[RRR]
457 (charset ID). */
458
459 #define CCL_TranslateCharacterConstTbl 0x03 /* Translate a multibyte character
460 1:ExtendedCOMMNDRrrRRRrrrXXXXX
461 2:ARGUMENT(Translation Table ID)
462 */
463
464 /* Iterate looking up MAPs for reg[rrr] starting from the Nth (N =
465 reg[RRR]) MAP until some value is found.
466
467 Each MAP is a Lisp vector whose element is number, nil, t, or
468 lambda.
469 If the element is nil, ignore the map and proceed to the next map.
470 If the element is t or lambda, finish without changing reg[rrr].
471 If the element is a number, set reg[rrr] to the number and finish.
472
473 Detail of the map structure is descibed in the comment for
474 CCL_MapMultiple below. */
475
476 #define CCL_IterateMultipleMap 0x10 /* Iterate multiple maps
477 1:ExtendedCOMMNDXXXRRRrrrXXXXX
478 2:NUMBER of MAPs
479 3:MAP-ID1
480 4:MAP-ID2
481 ...
482 */
483
484 /* Map the code in reg[rrr] by MAPs starting from the Nth (N =
485 reg[RRR]) map.
486
487 MAPs are supplied in the succeeding CCL codes as follows:
488
489 When CCL program gives this nested structure of map to this command:
490 ((MAP-ID11
491 MAP-ID12
492 (MAP-ID121 MAP-ID122 MAP-ID123)
493 MAP-ID13)
494 (MAP-ID21
495 (MAP-ID211 (MAP-ID2111) MAP-ID212)
496 MAP-ID22)),
497 the compiled CCL codes has this sequence:
498 CCL_MapMultiple (CCL code of this command)
499 16 (total number of MAPs and SEPARATORs)
500 -7 (1st SEPARATOR)
501 MAP-ID11
502 MAP-ID12
503 -3 (2nd SEPARATOR)
504 MAP-ID121
505 MAP-ID122
506 MAP-ID123
507 MAP-ID13
508 -7 (3rd SEPARATOR)
509 MAP-ID21
510 -4 (4th SEPARATOR)
511 MAP-ID211
512 -1 (5th SEPARATOR)
513 MAP_ID2111
514 MAP-ID212
515 MAP-ID22
516
517 A value of each SEPARATOR follows this rule:
518 MAP-SET := SEPARATOR [(MAP-ID | MAP-SET)]+
519 SEPARATOR := -(number of MAP-IDs and SEPARATORs in the MAP-SET)
520
521 (*)....Nest level of MAP-SET must not be over than MAX_MAP_SET_LEVEL.
522
523 When some map fails to map (i.e. it doesn't have a value for
524 reg[rrr]), the mapping is treated as identity.
525
526 The mapping is iterated for all maps in each map set (set of maps
527 separated by SEPARATOR) except in the case that lambda is
528 encountered. More precisely, the mapping proceeds as below:
529
530 At first, VAL0 is set to reg[rrr], and it is translated by the
531 first map to VAL1. Then, VAL1 is translated by the next map to
532 VAL2. This mapping is iterated until the last map is used. The
533 result of the mapping is the last value of VAL?.
534
535 But, when VALm is mapped to VALn and VALn is not a number, the
536 mapping proceed as below:
537
538 If VALn is nil, the lastest map is ignored and the mapping of VALm
539 proceed to the next map.
540
541 In VALn is t, VALm is reverted to reg[rrr] and the mapping of VALm
542 proceed to the next map.
543
544 If VALn is lambda, the whole mapping process terminates, and VALm
545 is the result of this mapping.
546
547 Each map is a Lisp vector of the following format (a) or (b):
548 (a)......[STARTPOINT VAL1 VAL2 ...]
549 (b)......[t VAL STARTPOINT ENDPOINT],
550 where
551 STARTPOINT is an offset to be used for indexing a map,
552 ENDPOINT is a maximum index number of a map,
553 VAL and VALn is a number, nil, t, or lambda.
554
555 Valid index range of a map of type (a) is:
556 STARTPOINT <= index < STARTPOINT + map_size - 1
557 Valid index range of a map of type (b) is:
558 STARTPOINT <= index < ENDPOINT */
559
560 #define CCL_MapMultiple 0x11 /* Mapping by multiple code conversion maps
561 1:ExtendedCOMMNDXXXRRRrrrXXXXX
562 2:N-2
563 3:SEPARATOR_1 (< 0)
564 4:MAP-ID_1
565 5:MAP-ID_2
566 ...
567 M:SEPARATOR_x (< 0)
568 M+1:MAP-ID_y
569 ...
570 N:SEPARATOR_z (< 0)
571 */
572
573 #define MAX_MAP_SET_LEVEL 20
574
575 typedef struct
576 {
577 int rest_length;
578 int orig_val;
579 } tr_stack;
580
581 static tr_stack mapping_stack[MAX_MAP_SET_LEVEL];
582 static tr_stack *mapping_stack_pointer;
583
584 #define PUSH_MAPPING_STACK(restlen, orig) \
585 { \
586 mapping_stack_pointer->rest_length = (restlen); \
587 mapping_stack_pointer->orig_val = (orig); \
588 mapping_stack_pointer++; \
589 }
590
591 #define POP_MAPPING_STACK(restlen, orig) \
592 { \
593 mapping_stack_pointer--; \
594 (restlen) = mapping_stack_pointer->rest_length; \
595 (orig) = mapping_stack_pointer->orig_val; \
596 } \
597
598 #define CCL_MapSingle 0x12 /* Map by single code conversion map
599 1:ExtendedCOMMNDXXXRRRrrrXXXXX
600 2:MAP-ID
601 ------------------------------
602 Map reg[rrr] by MAP-ID.
603 If some valid mapping is found,
604 set reg[rrr] to the result,
605 else
606 set reg[RRR] to -1.
607 */
608
609 /* CCL arithmetic/logical operators. */
610 #define CCL_PLUS 0x00 /* X = Y + Z */
611 #define CCL_MINUS 0x01 /* X = Y - Z */
612 #define CCL_MUL 0x02 /* X = Y * Z */
613 #define CCL_DIV 0x03 /* X = Y / Z */
614 #define CCL_MOD 0x04 /* X = Y % Z */
615 #define CCL_AND 0x05 /* X = Y & Z */
616 #define CCL_OR 0x06 /* X = Y | Z */
617 #define CCL_XOR 0x07 /* X = Y ^ Z */
618 #define CCL_LSH 0x08 /* X = Y << Z */
619 #define CCL_RSH 0x09 /* X = Y >> Z */
620 #define CCL_LSH8 0x0A /* X = (Y << 8) | Z */
621 #define CCL_RSH8 0x0B /* X = Y >> 8, r[7] = Y & 0xFF */
622 #define CCL_DIVMOD 0x0C /* X = Y / Z, r[7] = Y % Z */
623 #define CCL_LS 0x10 /* X = (X < Y) */
624 #define CCL_GT 0x11 /* X = (X > Y) */
625 #define CCL_EQ 0x12 /* X = (X == Y) */
626 #define CCL_LE 0x13 /* X = (X <= Y) */
627 #define CCL_GE 0x14 /* X = (X >= Y) */
628 #define CCL_NE 0x15 /* X = (X != Y) */
629
630 #define CCL_ENCODE_SJIS 0x16 /* X = HIGHER_BYTE (SJIS (Y, Z))
631 r[7] = LOWER_BYTE (SJIS (Y, Z) */
632 #define CCL_DECODE_SJIS 0x17 /* X = HIGHER_BYTE (DE-SJIS (Y, Z))
633 r[7] = LOWER_BYTE (DE-SJIS (Y, Z)) */
634
635 /* Terminate CCL program successfully. */
636 #define CCL_SUCCESS \
637 do { \
638 ccl->status = CCL_STAT_SUCCESS; \
639 ccl->ic = CCL_HEADER_MAIN; \
640 goto ccl_finish; \
641 } while (0)
642
643 /* Suspend CCL program because of reading from empty input buffer or
644 writing to full output buffer. When this program is resumed, the
645 same I/O command is executed. */
646 #define CCL_SUSPEND(stat) \
647 do { \
648 ic--; \
649 ccl->status = stat; \
650 goto ccl_finish; \
651 } while (0)
652
653 /* Terminate CCL program because of invalid command. Should not occur
654 in the normal case. */
655 #define CCL_INVALID_CMD \
656 do { \
657 ccl->status = CCL_STAT_INVALID_CMD; \
658 goto ccl_error_handler; \
659 } while (0)
660
661 /* Encode one character CH to multibyte form and write to the current
662 output buffer. If CH is less than 256, CH is written as is. */
663 #define CCL_WRITE_CHAR(ch) \
664 do { \
665 if (!dst) \
666 CCL_INVALID_CMD; \
667 else \
668 { \
669 unsigned char work[4], *str; \
670 int len = CHAR_STRING (ch, work, str); \
671 if (dst + len <= (dst_bytes ? dst_end : src)) \
672 { \
673 while (len--) *dst++ = *str++; \
674 } \
675 else \
676 CCL_SUSPEND (CCL_STAT_SUSPEND_BY_DST); \
677 } \
678 } while (0)
679
680 /* Write a string at ccl_prog[IC] of length LEN to the current output
681 buffer. */
682 #define CCL_WRITE_STRING(len) \
683 do { \
684 if (!dst) \
685 CCL_INVALID_CMD; \
686 else if (dst + len <= (dst_bytes ? dst_end : src)) \
687 for (i = 0; i < len; i++) \
688 *dst++ = ((XFASTINT (ccl_prog[ic + (i / 3)])) \
689 >> ((2 - (i % 3)) * 8)) & 0xFF; \
690 else \
691 CCL_SUSPEND (CCL_STAT_SUSPEND_BY_DST); \
692 } while (0)
693
694 /* Read one byte from the current input buffer into Rth register. */
695 #define CCL_READ_CHAR(r) \
696 do { \
697 if (!src) \
698 CCL_INVALID_CMD; \
699 else if (src < src_end) \
700 r = *src++; \
701 else if (ccl->last_block) \
702 { \
703 ic = ccl->eof_ic; \
704 goto ccl_repeat; \
705 } \
706 else \
707 CCL_SUSPEND (CCL_STAT_SUSPEND_BY_SRC); \
708 } while (0)
709
710
711 /* Execute CCL code on SRC_BYTES length text at SOURCE. The resulting
712 text goes to a place pointed by DESTINATION, the length of which
713 should not exceed DST_BYTES. The bytes actually processed is
714 returned as *CONSUMED. The return value is the length of the
715 resulting text. As a side effect, the contents of CCL registers
716 are updated. If SOURCE or DESTINATION is NULL, only operations on
717 registers are permitted. */
718
719 #ifdef CCL_DEBUG
720 #define CCL_DEBUG_BACKTRACE_LEN 256
721 int ccl_backtrace_table[CCL_BACKTRACE_TABLE];
722 int ccl_backtrace_idx;
723 #endif
724
725 struct ccl_prog_stack
726 {
727 Lisp_Object *ccl_prog; /* Pointer to an array of CCL code. */
728 int ic; /* Instruction Counter. */
729 };
730
731 int
732 ccl_driver (ccl, source, destination, src_bytes, dst_bytes, consumed)
733 struct ccl_program *ccl;
734 unsigned char *source, *destination;
735 int src_bytes, dst_bytes;
736 int *consumed;
737 {
738 register int *reg = ccl->reg;
739 register int ic = ccl->ic;
740 register int code, field1, field2;
741 register Lisp_Object *ccl_prog = ccl->prog;
742 unsigned char *src = source, *src_end = src + src_bytes;
743 unsigned char *dst = destination, *dst_end = dst + dst_bytes;
744 int jump_address;
745 int i, j, op;
746 int stack_idx = 0;
747 /* For the moment, we only support depth 256 of stack. */
748 struct ccl_prog_stack ccl_prog_stack_struct[256];
749
750 if (ic >= ccl->eof_ic)
751 ic = CCL_HEADER_MAIN;
752
753 if (ccl->buf_magnification ==0) /* We can't produce any bytes. */
754 dst = NULL;
755
756 #ifdef CCL_DEBUG
757 ccl_backtrace_idx = 0;
758 #endif
759
760 for (;;)
761 {
762 ccl_repeat:
763 #ifdef CCL_DEBUG
764 ccl_backtrace_table[ccl_backtrace_idx++] = ic;
765 if (ccl_backtrace_idx >= CCL_DEBUG_BACKTRACE_LEN)
766 ccl_backtrace_idx = 0;
767 ccl_backtrace_table[ccl_backtrace_idx] = 0;
768 #endif
769
770 if (!NILP (Vquit_flag) && NILP (Vinhibit_quit))
771 {
772 /* We can't just signal Qquit, instead break the loop as if
773 the whole data is processed. Don't reset Vquit_flag, it
774 must be handled later at a safer place. */
775 if (consumed)
776 src = source + src_bytes;
777 ccl->status = CCL_STAT_QUIT;
778 break;
779 }
780
781 code = XINT (ccl_prog[ic]); ic++;
782 field1 = code >> 8;
783 field2 = (code & 0xFF) >> 5;
784
785 #define rrr field2
786 #define RRR (field1 & 7)
787 #define Rrr ((field1 >> 3) & 7)
788 #define ADDR field1
789 #define EXCMD (field1 >> 6)
790
791 switch (code & 0x1F)
792 {
793 case CCL_SetRegister: /* 00000000000000000RRRrrrXXXXX */
794 reg[rrr] = reg[RRR];
795 break;
796
797 case CCL_SetShortConst: /* CCCCCCCCCCCCCCCCCCCCrrrXXXXX */
798 reg[rrr] = field1;
799 break;
800
801 case CCL_SetConst: /* 00000000000000000000rrrXXXXX */
802 reg[rrr] = XINT (ccl_prog[ic]);
803 ic++;
804 break;
805
806 case CCL_SetArray: /* CCCCCCCCCCCCCCCCCCCCRRRrrrXXXXX */
807 i = reg[RRR];
808 j = field1 >> 3;
809 if ((unsigned int) i < j)
810 reg[rrr] = XINT (ccl_prog[ic + i]);
811 ic += j;
812 break;
813
814 case CCL_Jump: /* A--D--D--R--E--S--S-000XXXXX */
815 ic += ADDR;
816 break;
817
818 case CCL_JumpCond: /* A--D--D--R--E--S--S-rrrXXXXX */
819 if (!reg[rrr])
820 ic += ADDR;
821 break;
822
823 case CCL_WriteRegisterJump: /* A--D--D--R--E--S--S-rrrXXXXX */
824 i = reg[rrr];
825 CCL_WRITE_CHAR (i);
826 ic += ADDR;
827 break;
828
829 case CCL_WriteRegisterReadJump: /* A--D--D--R--E--S--S-rrrXXXXX */
830 i = reg[rrr];
831 CCL_WRITE_CHAR (i);
832 ic++;
833 CCL_READ_CHAR (reg[rrr]);
834 ic += ADDR - 1;
835 break;
836
837 case CCL_WriteConstJump: /* A--D--D--R--E--S--S-000XXXXX */
838 i = XINT (ccl_prog[ic]);
839 CCL_WRITE_CHAR (i);
840 ic += ADDR;
841 break;
842
843 case CCL_WriteConstReadJump: /* A--D--D--R--E--S--S-rrrXXXXX */
844 i = XINT (ccl_prog[ic]);
845 CCL_WRITE_CHAR (i);
846 ic++;
847 CCL_READ_CHAR (reg[rrr]);
848 ic += ADDR - 1;
849 break;
850
851 case CCL_WriteStringJump: /* A--D--D--R--E--S--S-000XXXXX */
852 j = XINT (ccl_prog[ic]);
853 ic++;
854 CCL_WRITE_STRING (j);
855 ic += ADDR - 1;
856 break;
857
858 case CCL_WriteArrayReadJump: /* A--D--D--R--E--S--S-rrrXXXXX */
859 i = reg[rrr];
860 j = XINT (ccl_prog[ic]);
861 if ((unsigned int) i < j)
862 {
863 i = XINT (ccl_prog[ic + 1 + i]);
864 CCL_WRITE_CHAR (i);
865 }
866 ic += j + 2;
867 CCL_READ_CHAR (reg[rrr]);
868 ic += ADDR - (j + 2);
869 break;
870
871 case CCL_ReadJump: /* A--D--D--R--E--S--S-rrrYYYYY */
872 CCL_READ_CHAR (reg[rrr]);
873 ic += ADDR;
874 break;
875
876 case CCL_ReadBranch: /* CCCCCCCCCCCCCCCCCCCCrrrXXXXX */
877 CCL_READ_CHAR (reg[rrr]);
878 /* fall through ... */
879 case CCL_Branch: /* CCCCCCCCCCCCCCCCCCCCrrrXXXXX */
880 if ((unsigned int) reg[rrr] < field1)
881 ic += XINT (ccl_prog[ic + reg[rrr]]);
882 else
883 ic += XINT (ccl_prog[ic + field1]);
884 break;
885
886 case CCL_ReadRegister: /* CCCCCCCCCCCCCCCCCCCCrrXXXXX */
887 while (1)
888 {
889 CCL_READ_CHAR (reg[rrr]);
890 if (!field1) break;
891 code = XINT (ccl_prog[ic]); ic++;
892 field1 = code >> 8;
893 field2 = (code & 0xFF) >> 5;
894 }
895 break;
896
897 case CCL_WriteExprConst: /* 1:00000OPERATION000RRR000XXXXX */
898 rrr = 7;
899 i = reg[RRR];
900 j = XINT (ccl_prog[ic]);
901 op = field1 >> 6;
902 ic++;
903 goto ccl_set_expr;
904
905 case CCL_WriteRegister: /* CCCCCCCCCCCCCCCCCCCrrrXXXXX */
906 while (1)
907 {
908 i = reg[rrr];
909 CCL_WRITE_CHAR (i);
910 if (!field1) break;
911 code = XINT (ccl_prog[ic]); ic++;
912 field1 = code >> 8;
913 field2 = (code & 0xFF) >> 5;
914 }
915 break;
916
917 case CCL_WriteExprRegister: /* 1:00000OPERATIONRrrRRR000XXXXX */
918 rrr = 7;
919 i = reg[RRR];
920 j = reg[Rrr];
921 op = field1 >> 6;
922 goto ccl_set_expr;
923
924 case CCL_Call: /* CCCCCCCCCCCCCCCCCCCC000XXXXX */
925 {
926 Lisp_Object slot;
927
928 if (stack_idx >= 256
929 || field1 < 0
930 || field1 >= XVECTOR (Vccl_program_table)->size
931 || (slot = XVECTOR (Vccl_program_table)->contents[field1],
932 !CONSP (slot))
933 || !VECTORP (XCONS (slot)->cdr))
934 {
935 if (stack_idx > 0)
936 {
937 ccl_prog = ccl_prog_stack_struct[0].ccl_prog;
938 ic = ccl_prog_stack_struct[0].ic;
939 }
940 CCL_INVALID_CMD;
941 }
942
943 ccl_prog_stack_struct[stack_idx].ccl_prog = ccl_prog;
944 ccl_prog_stack_struct[stack_idx].ic = ic;
945 stack_idx++;
946 ccl_prog = XVECTOR (XCONS (slot)->cdr)->contents;
947 ic = CCL_HEADER_MAIN;
948 }
949 break;
950
951 case CCL_WriteConstString: /* CCCCCCCCCCCCCCCCCCCCrrrXXXXX */
952 if (!rrr)
953 CCL_WRITE_CHAR (field1);
954 else
955 {
956 CCL_WRITE_STRING (field1);
957 ic += (field1 + 2) / 3;
958 }
959 break;
960
961 case CCL_WriteArray: /* CCCCCCCCCCCCCCCCCCCCrrrXXXXX */
962 i = reg[rrr];
963 if ((unsigned int) i < field1)
964 {
965 j = XINT (ccl_prog[ic + i]);
966 CCL_WRITE_CHAR (j);
967 }
968 ic += field1;
969 break;
970
971 case CCL_End: /* 0000000000000000000000XXXXX */
972 if (stack_idx-- > 0)
973 {
974 ccl_prog = ccl_prog_stack_struct[stack_idx].ccl_prog;
975 ic = ccl_prog_stack_struct[stack_idx].ic;
976 break;
977 }
978 CCL_SUCCESS;
979
980 case CCL_ExprSelfConst: /* 00000OPERATION000000rrrXXXXX */
981 i = XINT (ccl_prog[ic]);
982 ic++;
983 op = field1 >> 6;
984 goto ccl_expr_self;
985
986 case CCL_ExprSelfReg: /* 00000OPERATION000RRRrrrXXXXX */
987 i = reg[RRR];
988 op = field1 >> 6;
989
990 ccl_expr_self:
991 switch (op)
992 {
993 case CCL_PLUS: reg[rrr] += i; break;
994 case CCL_MINUS: reg[rrr] -= i; break;
995 case CCL_MUL: reg[rrr] *= i; break;
996 case CCL_DIV: reg[rrr] /= i; break;
997 case CCL_MOD: reg[rrr] %= i; break;
998 case CCL_AND: reg[rrr] &= i; break;
999 case CCL_OR: reg[rrr] |= i; break;
1000 case CCL_XOR: reg[rrr] ^= i; break;
1001 case CCL_LSH: reg[rrr] <<= i; break;
1002 case CCL_RSH: reg[rrr] >>= i; break;
1003 case CCL_LSH8: reg[rrr] <<= 8; reg[rrr] |= i; break;
1004 case CCL_RSH8: reg[7] = reg[rrr] & 0xFF; reg[rrr] >>= 8; break;
1005 case CCL_DIVMOD: reg[7] = reg[rrr] % i; reg[rrr] /= i; break;
1006 case CCL_LS: reg[rrr] = reg[rrr] < i; break;
1007 case CCL_GT: reg[rrr] = reg[rrr] > i; break;
1008 case CCL_EQ: reg[rrr] = reg[rrr] == i; break;
1009 case CCL_LE: reg[rrr] = reg[rrr] <= i; break;
1010 case CCL_GE: reg[rrr] = reg[rrr] >= i; break;
1011 case CCL_NE: reg[rrr] = reg[rrr] != i; break;
1012 default: CCL_INVALID_CMD;
1013 }
1014 break;
1015
1016 case CCL_SetExprConst: /* 00000OPERATION000RRRrrrXXXXX */
1017 i = reg[RRR];
1018 j = XINT (ccl_prog[ic]);
1019 op = field1 >> 6;
1020 jump_address = ++ic;
1021 goto ccl_set_expr;
1022
1023 case CCL_SetExprReg: /* 00000OPERATIONRrrRRRrrrXXXXX */
1024 i = reg[RRR];
1025 j = reg[Rrr];
1026 op = field1 >> 6;
1027 jump_address = ic;
1028 goto ccl_set_expr;
1029
1030 case CCL_ReadJumpCondExprConst: /* A--D--D--R--E--S--S-rrrXXXXX */
1031 CCL_READ_CHAR (reg[rrr]);
1032 case CCL_JumpCondExprConst: /* A--D--D--R--E--S--S-rrrXXXXX */
1033 i = reg[rrr];
1034 op = XINT (ccl_prog[ic]);
1035 jump_address = ic++ + ADDR;
1036 j = XINT (ccl_prog[ic]);
1037 ic++;
1038 rrr = 7;
1039 goto ccl_set_expr;
1040
1041 case CCL_ReadJumpCondExprReg: /* A--D--D--R--E--S--S-rrrXXXXX */
1042 CCL_READ_CHAR (reg[rrr]);
1043 case CCL_JumpCondExprReg:
1044 i = reg[rrr];
1045 op = XINT (ccl_prog[ic]);
1046 jump_address = ic++ + ADDR;
1047 j = reg[XINT (ccl_prog[ic])];
1048 ic++;
1049 rrr = 7;
1050
1051 ccl_set_expr:
1052 switch (op)
1053 {
1054 case CCL_PLUS: reg[rrr] = i + j; break;
1055 case CCL_MINUS: reg[rrr] = i - j; break;
1056 case CCL_MUL: reg[rrr] = i * j; break;
1057 case CCL_DIV: reg[rrr] = i / j; break;
1058 case CCL_MOD: reg[rrr] = i % j; break;
1059 case CCL_AND: reg[rrr] = i & j; break;
1060 case CCL_OR: reg[rrr] = i | j; break;
1061 case CCL_XOR: reg[rrr] = i ^ j;; break;
1062 case CCL_LSH: reg[rrr] = i << j; break;
1063 case CCL_RSH: reg[rrr] = i >> j; break;
1064 case CCL_LSH8: reg[rrr] = (i << 8) | j; break;
1065 case CCL_RSH8: reg[rrr] = i >> 8; reg[7] = i & 0xFF; break;
1066 case CCL_DIVMOD: reg[rrr] = i / j; reg[7] = i % j; break;
1067 case CCL_LS: reg[rrr] = i < j; break;
1068 case CCL_GT: reg[rrr] = i > j; break;
1069 case CCL_EQ: reg[rrr] = i == j; break;
1070 case CCL_LE: reg[rrr] = i <= j; break;
1071 case CCL_GE: reg[rrr] = i >= j; break;
1072 case CCL_NE: reg[rrr] = i != j; break;
1073 case CCL_ENCODE_SJIS: ENCODE_SJIS (i, j, reg[rrr], reg[7]); break;
1074 case CCL_DECODE_SJIS: DECODE_SJIS (i, j, reg[rrr], reg[7]); break;
1075 default: CCL_INVALID_CMD;
1076 }
1077 code &= 0x1F;
1078 if (code == CCL_WriteExprConst || code == CCL_WriteExprRegister)
1079 {
1080 i = reg[rrr];
1081 CCL_WRITE_CHAR (i);
1082 }
1083 else if (!reg[rrr])
1084 ic = jump_address;
1085 break;
1086
1087 case CCL_Extention:
1088 switch (EXCMD)
1089 {
1090 case CCL_ReadMultibyteChar2:
1091 if (!src)
1092 CCL_INVALID_CMD;
1093 do {
1094 if (src >= src_end)
1095 {
1096 src++;
1097 goto ccl_read_multibyte_character_suspend;
1098 }
1099
1100 i = *src++;
1101 if (i == LEADING_CODE_COMPOSITION)
1102 {
1103 if (src >= src_end)
1104 goto ccl_read_multibyte_character_suspend;
1105 if (*src == 0xFF)
1106 {
1107 ccl->private_state = COMPOSING_WITH_RULE_HEAD;
1108 src++;
1109 }
1110 else
1111 ccl->private_state = COMPOSING_NO_RULE_HEAD;
1112 }
1113 if (ccl->private_state != 0)
1114 {
1115 /* composite character */
1116 if (*src < 0xA0)
1117 ccl->private_state = 0;
1118 else
1119 {
1120 if (i == 0xA0)
1121 {
1122 if (src >= src_end)
1123 goto ccl_read_multibyte_character_suspend;
1124 i = *src++ & 0x7F;
1125 }
1126 else
1127 i -= 0x20;
1128
1129 if (COMPOSING_WITH_RULE_RULE == ccl->private_state)
1130 {
1131 ccl->private_state = COMPOSING_WITH_RULE_HEAD;
1132 continue;
1133 }
1134 else if (COMPOSING_WITH_RULE_HEAD == ccl->private_state)
1135 ccl->private_state = COMPOSING_WITH_RULE_RULE;
1136 }
1137 }
1138 if (i < 0x80)
1139 {
1140 /* ASCII */
1141 reg[rrr] = i;
1142 reg[RRR] = CHARSET_ASCII;
1143 }
1144 else if (i <= MAX_CHARSET_OFFICIAL_DIMENSION1)
1145 {
1146 if (src >= src_end)
1147 goto ccl_read_multibyte_character_suspend;
1148 reg[RRR] = i;
1149 reg[rrr] = (*src++ & 0x7F);
1150 }
1151 else if (i <= MAX_CHARSET_OFFICIAL_DIMENSION2)
1152 {
1153 if ((src + 1) >= src_end)
1154 goto ccl_read_multibyte_character_suspend;
1155 reg[RRR] = i;
1156 i = (*src++ & 0x7F);
1157 reg[rrr] = ((i << 7) | (*src & 0x7F));
1158 src++;
1159 }
1160 else if ((i == LEADING_CODE_PRIVATE_11)
1161 || (i == LEADING_CODE_PRIVATE_12))
1162 {
1163 if ((src + 1) >= src_end)
1164 goto ccl_read_multibyte_character_suspend;
1165 reg[RRR] = *src++;
1166 reg[rrr] = (*src++ & 0x7F);
1167 }
1168 else if ((i == LEADING_CODE_PRIVATE_21)
1169 || (i == LEADING_CODE_PRIVATE_22))
1170 {
1171 if ((src + 2) >= src_end)
1172 goto ccl_read_multibyte_character_suspend;
1173 reg[RRR] = *src++;
1174 i = (*src++ & 0x7F);
1175 reg[rrr] = ((i << 7) | (*src & 0x7F));
1176 src++;
1177 }
1178 else
1179 {
1180 /* INVALID CODE
1181 Returned charset is -1. */
1182 reg[RRR] = -1;
1183 }
1184 } while (0);
1185 break;
1186
1187 ccl_read_multibyte_character_suspend:
1188 src--;
1189 if (ccl->last_block)
1190 {
1191 ic = ccl->eof_ic;
1192 goto ccl_repeat;
1193 }
1194 else
1195 CCL_SUSPEND (CCL_STAT_SUSPEND_BY_SRC);
1196
1197 break;
1198
1199 case CCL_WriteMultibyteChar2:
1200 i = reg[RRR]; /* charset */
1201 if (i == CHARSET_ASCII)
1202 i = reg[rrr] & 0x7F;
1203 else if (i == CHARSET_COMPOSITION)
1204 i = MAKE_COMPOSITE_CHAR (reg[rrr]);
1205 else if (CHARSET_DIMENSION (i) == 1)
1206 i = ((i - 0x70) << 7) | (reg[rrr] & 0x7F);
1207 else if (i < MIN_CHARSET_PRIVATE_DIMENSION2)
1208 i = ((i - 0x8F) << 14) | reg[rrr];
1209 else
1210 i = ((i - 0xE0) << 14) | reg[rrr];
1211
1212 CCL_WRITE_CHAR (i);
1213
1214 break;
1215
1216 case CCL_TranslateCharacter:
1217 i = reg[RRR]; /* charset */
1218 if (i == CHARSET_ASCII)
1219 i = reg[rrr] & 0x7F;
1220 else if (i == CHARSET_COMPOSITION)
1221 {
1222 reg[RRR] = -1;
1223 break;
1224 }
1225 else if (CHARSET_DIMENSION (i) == 1)
1226 i = ((i - 0x70) << 7) | (reg[rrr] & 0x7F);
1227 else if (i < MIN_CHARSET_PRIVATE_DIMENSION2)
1228 i = ((i - 0x8F) << 14) | (reg[rrr] & 0x3FFF);
1229 else
1230 i = ((i - 0xE0) << 14) | (reg[rrr] & 0x3FFF);
1231
1232 op = translate_char (GET_TRANSLATION_TABLE (reg[Rrr]),
1233 i, -1, 0, 0);
1234 SPLIT_CHAR (op, reg[RRR], i, j);
1235 if (j != -1)
1236 i = (i << 7) | j;
1237
1238 reg[rrr] = i;
1239 break;
1240
1241 case CCL_TranslateCharacterConstTbl:
1242 op = XINT (ccl_prog[ic]); /* table */
1243 ic++;
1244 i = reg[RRR]; /* charset */
1245 if (i == CHARSET_ASCII)
1246 i = reg[rrr] & 0x7F;
1247 else if (i == CHARSET_COMPOSITION)
1248 {
1249 reg[RRR] = -1;
1250 break;
1251 }
1252 else if (CHARSET_DIMENSION (i) == 1)
1253 i = ((i - 0x70) << 7) | (reg[rrr] & 0x7F);
1254 else if (i < MIN_CHARSET_PRIVATE_DIMENSION2)
1255 i = ((i - 0x8F) << 14) | (reg[rrr] & 0x3FFF);
1256 else
1257 i = ((i - 0xE0) << 14) | (reg[rrr] & 0x3FFF);
1258
1259 op = translate_char (GET_TRANSLATION_TABLE (op), i, -1, 0, 0);
1260 SPLIT_CHAR (op, reg[RRR], i, j);
1261 if (j != -1)
1262 i = (i << 7) | j;
1263
1264 reg[rrr] = i;
1265 break;
1266
1267 case CCL_IterateMultipleMap:
1268 {
1269 Lisp_Object map, content, attrib, value;
1270 int point, size, fin_ic;
1271
1272 j = XINT (ccl_prog[ic++]); /* number of maps. */
1273 fin_ic = ic + j;
1274 op = reg[rrr];
1275 if ((j > reg[RRR]) && (j >= 0))
1276 {
1277 ic += reg[RRR];
1278 i = reg[RRR];
1279 }
1280 else
1281 {
1282 reg[RRR] = -1;
1283 ic = fin_ic;
1284 break;
1285 }
1286
1287 for (;i < j;i++)
1288 {
1289
1290 size = XVECTOR (Vcode_conversion_map_vector)->size;
1291 point = XINT (ccl_prog[ic++]);
1292 if (point >= size) continue;
1293 map =
1294 XVECTOR (Vcode_conversion_map_vector)->contents[point];
1295
1296 /* Check map varidity. */
1297 if (!CONSP (map)) continue;
1298 map = XCONS(map)->cdr;
1299 if (!VECTORP (map)) continue;
1300 size = XVECTOR (map)->size;
1301 if (size <= 1) continue;
1302
1303 content = XVECTOR (map)->contents[0];
1304
1305 /* check map type,
1306 [STARTPOINT VAL1 VAL2 ...] or
1307 [t ELELMENT STARTPOINT ENDPOINT] */
1308 if (NUMBERP (content))
1309 {
1310 point = XUINT (content);
1311 point = op - point + 1;
1312 if (!((point >= 1) && (point < size))) continue;
1313 content = XVECTOR (map)->contents[point];
1314 }
1315 else if (EQ (content, Qt))
1316 {
1317 if (size != 4) continue;
1318 if ((op >= XUINT (XVECTOR (map)->contents[2]))
1319 && (op < XUINT (XVECTOR (map)->contents[3])))
1320 content = XVECTOR (map)->contents[1];
1321 else
1322 continue;
1323 }
1324 else
1325 continue;
1326
1327 if (NILP (content))
1328 continue;
1329 else if (NUMBERP (content))
1330 {
1331 reg[RRR] = i;
1332 reg[rrr] = XINT(content);
1333 break;
1334 }
1335 else if (EQ (content, Qt) || EQ (content, Qlambda))
1336 {
1337 reg[RRR] = i;
1338 break;
1339 }
1340 else if (CONSP (content))
1341 {
1342 attrib = XCONS (content)->car;
1343 value = XCONS (content)->cdr;
1344 if (!NUMBERP (attrib) || !NUMBERP (value))
1345 continue;
1346 reg[RRR] = i;
1347 reg[rrr] = XUINT (value);
1348 break;
1349 }
1350 }
1351 if (i == j)
1352 reg[RRR] = -1;
1353 ic = fin_ic;
1354 }
1355 break;
1356
1357 case CCL_MapMultiple:
1358 {
1359 Lisp_Object map, content, attrib, value;
1360 int point, size, map_vector_size;
1361 int map_set_rest_length, fin_ic;
1362
1363 map_set_rest_length =
1364 XINT (ccl_prog[ic++]); /* number of maps and separators. */
1365 fin_ic = ic + map_set_rest_length;
1366 if ((map_set_rest_length > reg[RRR]) && (reg[RRR] >= 0))
1367 {
1368 ic += reg[RRR];
1369 i = reg[RRR];
1370 map_set_rest_length -= i;
1371 }
1372 else
1373 {
1374 ic = fin_ic;
1375 reg[RRR] = -1;
1376 break;
1377 }
1378 mapping_stack_pointer = mapping_stack;
1379 op = reg[rrr];
1380 PUSH_MAPPING_STACK (0, op);
1381 reg[RRR] = -1;
1382 map_vector_size = XVECTOR (Vcode_conversion_map_vector)->size;
1383 for (;map_set_rest_length > 0;i++, map_set_rest_length--)
1384 {
1385 point = XINT(ccl_prog[ic++]);
1386 if (point < 0)
1387 {
1388 point = -point;
1389 if (mapping_stack_pointer
1390 >= &mapping_stack[MAX_MAP_SET_LEVEL])
1391 {
1392 CCL_INVALID_CMD;
1393 }
1394 PUSH_MAPPING_STACK (map_set_rest_length - point,
1395 reg[rrr]);
1396 map_set_rest_length = point + 1;
1397 reg[rrr] = op;
1398 continue;
1399 }
1400
1401 if (point >= map_vector_size) continue;
1402 map = (XVECTOR (Vcode_conversion_map_vector)
1403 ->contents[point]);
1404
1405 /* Check map varidity. */
1406 if (!CONSP (map)) continue;
1407 map = XCONS (map)->cdr;
1408 if (!VECTORP (map)) continue;
1409 size = XVECTOR (map)->size;
1410 if (size <= 1) continue;
1411
1412 content = XVECTOR (map)->contents[0];
1413
1414 /* check map type,
1415 [STARTPOINT VAL1 VAL2 ...] or
1416 [t ELEMENT STARTPOINT ENDPOINT] */
1417 if (NUMBERP (content))
1418 {
1419 point = XUINT (content);
1420 point = op - point + 1;
1421 if (!((point >= 1) && (point < size))) continue;
1422 content = XVECTOR (map)->contents[point];
1423 }
1424 else if (EQ (content, Qt))
1425 {
1426 if (size != 4) continue;
1427 if ((op >= XUINT (XVECTOR (map)->contents[2])) &&
1428 (op < XUINT (XVECTOR (map)->contents[3])))
1429 content = XVECTOR (map)->contents[1];
1430 else
1431 continue;
1432 }
1433 else
1434 continue;
1435
1436 if (NILP (content))
1437 continue;
1438 else if (NUMBERP (content))
1439 {
1440 op = XINT (content);
1441 reg[RRR] = i;
1442 i += map_set_rest_length;
1443 POP_MAPPING_STACK (map_set_rest_length, reg[rrr]);
1444 }
1445 else if (CONSP (content))
1446 {
1447 attrib = XCONS (content)->car;
1448 value = XCONS (content)->cdr;
1449 if (!NUMBERP (attrib) || !NUMBERP (value))
1450 continue;
1451 reg[RRR] = i;
1452 op = XUINT (value);
1453 i += map_set_rest_length;
1454 POP_MAPPING_STACK (map_set_rest_length, reg[rrr]);
1455 }
1456 else if (EQ (content, Qt))
1457 {
1458 reg[RRR] = i;
1459 op = reg[rrr];
1460 i += map_set_rest_length;
1461 POP_MAPPING_STACK (map_set_rest_length, reg[rrr]);
1462 }
1463 else if (EQ (content, Qlambda))
1464 {
1465 break;
1466 }
1467 else
1468 CCL_INVALID_CMD;
1469 }
1470 ic = fin_ic;
1471 }
1472 reg[rrr] = op;
1473 break;
1474
1475 case CCL_MapSingle:
1476 {
1477 Lisp_Object map, attrib, value, content;
1478 int size, point;
1479 j = XINT (ccl_prog[ic++]); /* map_id */
1480 op = reg[rrr];
1481 if (j >= XVECTOR (Vcode_conversion_map_vector)->size)
1482 {
1483 reg[RRR] = -1;
1484 break;
1485 }
1486 map = XVECTOR (Vcode_conversion_map_vector)->contents[j];
1487 if (!CONSP (map))
1488 {
1489 reg[RRR] = -1;
1490 break;
1491 }
1492 map = XCONS(map)->cdr;
1493 if (!VECTORP (map))
1494 {
1495 reg[RRR] = -1;
1496 break;
1497 }
1498 size = XVECTOR (map)->size;
1499 point = XUINT (XVECTOR (map)->contents[0]);
1500 point = op - point + 1;
1501 reg[RRR] = 0;
1502 if ((size <= 1) ||
1503 (!((point >= 1) && (point < size))))
1504 reg[RRR] = -1;
1505 else
1506 {
1507 content = XVECTOR (map)->contents[point];
1508 if (NILP (content))
1509 reg[RRR] = -1;
1510 else if (NUMBERP (content))
1511 reg[rrr] = XINT (content);
1512 else if (EQ (content, Qt))
1513 reg[RRR] = i;
1514 else if (CONSP (content))
1515 {
1516 attrib = XCONS (content)->car;
1517 value = XCONS (content)->cdr;
1518 if (!NUMBERP (attrib) || !NUMBERP (value))
1519 continue;
1520 reg[rrr] = XUINT(value);
1521 break;
1522 }
1523 else
1524 reg[RRR] = -1;
1525 }
1526 }
1527 break;
1528
1529 default:
1530 CCL_INVALID_CMD;
1531 }
1532 break;
1533
1534 default:
1535 CCL_INVALID_CMD;
1536 }
1537 }
1538
1539 ccl_error_handler:
1540 if (destination)
1541 {
1542 /* We can insert an error message only if DESTINATION is
1543 specified and we still have a room to store the message
1544 there. */
1545 char msg[256];
1546 int msglen;
1547
1548 if (!dst)
1549 dst = destination;
1550
1551 switch (ccl->status)
1552 {
1553 case CCL_STAT_INVALID_CMD:
1554 sprintf(msg, "\nCCL: Invalid command %x (ccl_code = %x) at %d.",
1555 code & 0x1F, code, ic);
1556 #ifdef CCL_DEBUG
1557 {
1558 int i = ccl_backtrace_idx - 1;
1559 int j;
1560
1561 msglen = strlen (msg);
1562 if (dst + msglen <= (dst_bytes ? dst_end : src))
1563 {
1564 bcopy (msg, dst, msglen);
1565 dst += msglen;
1566 }
1567
1568 for (j = 0; j < CCL_DEBUG_BACKTRACE_LEN; j++, i--)
1569 {
1570 if (i < 0) i = CCL_DEBUG_BACKTRACE_LEN - 1;
1571 if (ccl_backtrace_table[i] == 0)
1572 break;
1573 sprintf(msg, " %d", ccl_backtrace_table[i]);
1574 msglen = strlen (msg);
1575 if (dst + msglen > (dst_bytes ? dst_end : src))
1576 break;
1577 bcopy (msg, dst, msglen);
1578 dst += msglen;
1579 }
1580 goto ccl_finish;
1581 }
1582 #endif
1583 break;
1584
1585 case CCL_STAT_QUIT:
1586 sprintf(msg, "\nCCL: Quited.");
1587 break;
1588
1589 default:
1590 sprintf(msg, "\nCCL: Unknown error type (%d).", ccl->status);
1591 }
1592
1593 msglen = strlen (msg);
1594 if (dst + msglen <= (dst_bytes ? dst_end : src))
1595 {
1596 bcopy (msg, dst, msglen);
1597 dst += msglen;
1598 }
1599 }
1600
1601 ccl_finish:
1602 ccl->ic = ic;
1603 if (consumed) *consumed = src - source;
1604 return (dst ? dst - destination : 0);
1605 }
1606
1607 /* Setup fields of the structure pointed by CCL appropriately for the
1608 execution of compiled CCL code in VEC (vector of integer). */
1609 void
1610 setup_ccl_program (ccl, vec)
1611 struct ccl_program *ccl;
1612 Lisp_Object vec;
1613 {
1614 int i;
1615
1616 ccl->size = XVECTOR (vec)->size;
1617 ccl->prog = XVECTOR (vec)->contents;
1618 ccl->ic = CCL_HEADER_MAIN;
1619 ccl->eof_ic = XINT (XVECTOR (vec)->contents[CCL_HEADER_EOF]);
1620 ccl->buf_magnification = XINT (XVECTOR (vec)->contents[CCL_HEADER_BUF_MAG]);
1621 for (i = 0; i < 8; i++)
1622 ccl->reg[i] = 0;
1623 ccl->last_block = 0;
1624 ccl->private_state = 0;
1625 ccl->status = 0;
1626 }
1627
1628 /* Resolve symbols in the specified CCL code (Lisp vector). This
1629 function converts symbols of code conversion maps and character
1630 translation tables embeded in the CCL code into their ID numbers. */
1631
1632 Lisp_Object
1633 resolve_symbol_ccl_program (ccl)
1634 Lisp_Object ccl;
1635 {
1636 int i, veclen;
1637 Lisp_Object result, contents, prop;
1638
1639 result = ccl;
1640 veclen = XVECTOR (result)->size;
1641
1642 /* Set CCL program's table ID */
1643 for (i = 0; i < veclen; i++)
1644 {
1645 contents = XVECTOR (result)->contents[i];
1646 if (SYMBOLP (contents))
1647 {
1648 if (EQ(result, ccl))
1649 result = Fcopy_sequence (ccl);
1650
1651 prop = Fget (contents, Qtranslation_table_id);
1652 if (NUMBERP (prop))
1653 {
1654 XVECTOR (result)->contents[i] = prop;
1655 continue;
1656 }
1657 prop = Fget (contents, Qcode_conversion_map_id);
1658 if (NUMBERP (prop))
1659 {
1660 XVECTOR (result)->contents[i] = prop;
1661 continue;
1662 }
1663 prop = Fget (contents, Qccl_program_idx);
1664 if (NUMBERP (prop))
1665 {
1666 XVECTOR (result)->contents[i] = prop;
1667 continue;
1668 }
1669 }
1670 }
1671
1672 return result;
1673 }
1674
1675
1676 #ifdef emacs
1677
1678 DEFUN ("ccl-execute", Fccl_execute, Sccl_execute, 2, 2, 0,
1679 "Execute CCL-PROGRAM with registers initialized by REGISTERS.\n\
1680 \n\
1681 CCL-PROGRAM is a symbol registered by register-ccl-program,\n\
1682 or a compiled code generated by `ccl-compile' (for backward compatibility,\n\
1683 in this case, the execution is slower).\n\
1684 No I/O commands should appear in CCL-PROGRAM.\n\
1685 \n\
1686 REGISTERS is a vector of [R0 R1 ... R7] where RN is an initial value\n\
1687 of Nth register.\n\
1688 \n\
1689 As side effect, each element of REGISTERS holds the value of\n\
1690 corresponding register after the execution.")
1691 (ccl_prog, reg)
1692 Lisp_Object ccl_prog, reg;
1693 {
1694 struct ccl_program ccl;
1695 int i;
1696 Lisp_Object ccl_id;
1697
1698 if ((SYMBOLP (ccl_prog)) &&
1699 (!NILP (ccl_id = Fget (ccl_prog, Qccl_program_idx))))
1700 {
1701 ccl_prog = XVECTOR (Vccl_program_table)->contents[XUINT (ccl_id)];
1702 CHECK_LIST (ccl_prog, 0);
1703 ccl_prog = XCONS (ccl_prog)->cdr;
1704 CHECK_VECTOR (ccl_prog, 1);
1705 }
1706 else
1707 {
1708 CHECK_VECTOR (ccl_prog, 1);
1709 ccl_prog = resolve_symbol_ccl_program (ccl_prog);
1710 }
1711
1712 CHECK_VECTOR (reg, 2);
1713 if (XVECTOR (reg)->size != 8)
1714 error ("Invalid length of vector REGISTERS");
1715
1716 setup_ccl_program (&ccl, ccl_prog);
1717 for (i = 0; i < 8; i++)
1718 ccl.reg[i] = (INTEGERP (XVECTOR (reg)->contents[i])
1719 ? XINT (XVECTOR (reg)->contents[i])
1720 : 0);
1721
1722 ccl_driver (&ccl, (char *)0, (char *)0, 0, 0, (int *)0);
1723 QUIT;
1724 if (ccl.status != CCL_STAT_SUCCESS)
1725 error ("Error in CCL program at %dth code", ccl.ic);
1726
1727 for (i = 0; i < 8; i++)
1728 XSETINT (XVECTOR (reg)->contents[i], ccl.reg[i]);
1729 return Qnil;
1730 }
1731
1732 DEFUN ("ccl-execute-on-string", Fccl_execute_on_string, Sccl_execute_on_string,
1733 3, 5, 0,
1734 "Execute CCL-PROGRAM with initial STATUS on STRING.\n\
1735 \n\
1736 CCL-PROGRAM is a symbol registered by register-ccl-program,\n\
1737 or a compiled code generated by `ccl-compile' (for backward compatibility,\n\
1738 in this case, the execution is slower).\n\
1739 \n\
1740 Read buffer is set to STRING, and write buffer is allocated automatically.\n\
1741 \n\
1742 STATUS is a vector of [R0 R1 ... R7 IC], where\n\
1743 R0..R7 are initial values of corresponding registers,\n\
1744 IC is the instruction counter specifying from where to start the program.\n\
1745 If R0..R7 are nil, they are initialized to 0.\n\
1746 If IC is nil, it is initialized to head of the CCL program.\n\
1747 \n\
1748 If optional 4th arg CONTINUE is non-nil, keep IC on read operation\n\
1749 when read buffer is exausted, else, IC is always set to the end of\n\
1750 CCL-PROGRAM on exit.\n\
1751 \n\
1752 It returns the contents of write buffer as a string,\n\
1753 and as side effect, STATUS is updated.\n\
1754 If the optional 5th arg UNIBYTE-P is non-nil, the returned string\n\
1755 is a unibyte string. By default it is a multibyte string.")
1756 (ccl_prog, status, str, contin, unibyte_p)
1757 Lisp_Object ccl_prog, status, str, contin, unibyte_p;
1758 {
1759 Lisp_Object val;
1760 struct ccl_program ccl;
1761 int i, produced;
1762 int outbufsize;
1763 char *outbuf;
1764 struct gcpro gcpro1, gcpro2, gcpro3;
1765 Lisp_Object ccl_id;
1766
1767 if ((SYMBOLP (ccl_prog)) &&
1768 (!NILP (ccl_id = Fget (ccl_prog, Qccl_program_idx))))
1769 {
1770 ccl_prog = XVECTOR (Vccl_program_table)->contents[XUINT (ccl_id)];
1771 CHECK_LIST (ccl_prog, 0);
1772 ccl_prog = XCONS (ccl_prog)->cdr;
1773 CHECK_VECTOR (ccl_prog, 1);
1774 }
1775 else
1776 {
1777 CHECK_VECTOR (ccl_prog, 1);
1778 ccl_prog = resolve_symbol_ccl_program (ccl_prog);
1779 }
1780
1781 CHECK_VECTOR (status, 1);
1782 if (XVECTOR (status)->size != 9)
1783 error ("Invalid length of vector STATUS");
1784 CHECK_STRING (str, 2);
1785 GCPRO3 (ccl_prog, status, str);
1786
1787 setup_ccl_program (&ccl, ccl_prog);
1788 for (i = 0; i < 8; i++)
1789 {
1790 if (NILP (XVECTOR (status)->contents[i]))
1791 XSETINT (XVECTOR (status)->contents[i], 0);
1792 if (INTEGERP (XVECTOR (status)->contents[i]))
1793 ccl.reg[i] = XINT (XVECTOR (status)->contents[i]);
1794 }
1795 if (INTEGERP (XVECTOR (status)->contents[i]))
1796 {
1797 i = XFASTINT (XVECTOR (status)->contents[8]);
1798 if (ccl.ic < i && i < ccl.size)
1799 ccl.ic = i;
1800 }
1801 outbufsize = STRING_BYTES (XSTRING (str)) * ccl.buf_magnification + 256;
1802 outbuf = (char *) xmalloc (outbufsize);
1803 if (!outbuf)
1804 error ("Not enough memory");
1805 ccl.last_block = NILP (contin);
1806 produced = ccl_driver (&ccl, XSTRING (str)->data, outbuf,
1807 STRING_BYTES (XSTRING (str)), outbufsize, (int *)0);
1808 for (i = 0; i < 8; i++)
1809 XSET (XVECTOR (status)->contents[i], Lisp_Int, ccl.reg[i]);
1810 XSETINT (XVECTOR (status)->contents[8], ccl.ic);
1811 UNGCPRO;
1812
1813 if (NILP (unibyte_p))
1814 val = make_string (outbuf, produced);
1815 else
1816 val = make_unibyte_string (outbuf, produced);
1817 free (outbuf);
1818 QUIT;
1819 if (ccl.status != CCL_STAT_SUCCESS
1820 && ccl.status != CCL_STAT_SUSPEND_BY_SRC
1821 && ccl.status != CCL_STAT_SUSPEND_BY_DST)
1822 error ("Error in CCL program at %dth code", ccl.ic);
1823
1824 return val;
1825 }
1826
1827 DEFUN ("register-ccl-program", Fregister_ccl_program, Sregister_ccl_program,
1828 2, 2, 0,
1829 "Register CCL program PROGRAM of NAME in `ccl-program-table'.\n\
1830 PROGRAM should be a compiled code of CCL program, or nil.\n\
1831 Return index number of the registered CCL program.")
1832 (name, ccl_prog)
1833 Lisp_Object name, ccl_prog;
1834 {
1835 int len = XVECTOR (Vccl_program_table)->size;
1836 int i;
1837
1838 CHECK_SYMBOL (name, 0);
1839 if (!NILP (ccl_prog))
1840 {
1841 CHECK_VECTOR (ccl_prog, 1);
1842 ccl_prog = resolve_symbol_ccl_program (ccl_prog);
1843 }
1844
1845 for (i = 0; i < len; i++)
1846 {
1847 Lisp_Object slot = XVECTOR (Vccl_program_table)->contents[i];
1848
1849 if (!CONSP (slot))
1850 break;
1851
1852 if (EQ (name, XCONS (slot)->car))
1853 {
1854 XCONS (slot)->cdr = ccl_prog;
1855 return make_number (i);
1856 }
1857 }
1858
1859 if (i == len)
1860 {
1861 Lisp_Object new_table = Fmake_vector (make_number (len * 2), Qnil);
1862 int j;
1863
1864 for (j = 0; j < len; j++)
1865 XVECTOR (new_table)->contents[j]
1866 = XVECTOR (Vccl_program_table)->contents[j];
1867 Vccl_program_table = new_table;
1868 }
1869
1870 XVECTOR (Vccl_program_table)->contents[i] = Fcons (name, ccl_prog);
1871 Fput (name, Qccl_program_idx, make_number (i));
1872 return make_number (i);
1873 }
1874
1875 /* Register code conversion map.
1876 A code conversion map consists of numbers, Qt, Qnil, and Qlambda.
1877 The first element is start code point.
1878 The rest elements are mapped numbers.
1879 Symbol t means to map to an original number before mapping.
1880 Symbol nil means that the corresponding element is empty.
1881 Symbol lambda menas to terminate mapping here.
1882 */
1883
1884 DEFUN ("register-code-conversion-map", Fregister_code_conversion_map,
1885 Sregister_code_conversion_map,
1886 2, 2, 0,
1887 "Register SYMBOL as code conversion map MAP.\n\
1888 Return index number of the registered map.")
1889 (symbol, map)
1890 Lisp_Object symbol, map;
1891 {
1892 int len = XVECTOR (Vcode_conversion_map_vector)->size;
1893 int i;
1894 Lisp_Object index;
1895
1896 CHECK_SYMBOL (symbol, 0);
1897 CHECK_VECTOR (map, 1);
1898
1899 for (i = 0; i < len; i++)
1900 {
1901 Lisp_Object slot = XVECTOR (Vcode_conversion_map_vector)->contents[i];
1902
1903 if (!CONSP (slot))
1904 break;
1905
1906 if (EQ (symbol, XCONS (slot)->car))
1907 {
1908 index = make_number (i);
1909 XCONS (slot)->cdr = map;
1910 Fput (symbol, Qcode_conversion_map, map);
1911 Fput (symbol, Qcode_conversion_map_id, index);
1912 return index;
1913 }
1914 }
1915
1916 if (i == len)
1917 {
1918 Lisp_Object new_vector = Fmake_vector (make_number (len * 2), Qnil);
1919 int j;
1920
1921 for (j = 0; j < len; j++)
1922 XVECTOR (new_vector)->contents[j]
1923 = XVECTOR (Vcode_conversion_map_vector)->contents[j];
1924 Vcode_conversion_map_vector = new_vector;
1925 }
1926
1927 index = make_number (i);
1928 Fput (symbol, Qcode_conversion_map, map);
1929 Fput (symbol, Qcode_conversion_map_id, index);
1930 XVECTOR (Vcode_conversion_map_vector)->contents[i] = Fcons (symbol, map);
1931 return index;
1932 }
1933
1934
1935 void
1936 syms_of_ccl ()
1937 {
1938 staticpro (&Vccl_program_table);
1939 Vccl_program_table = Fmake_vector (make_number (32), Qnil);
1940
1941 Qccl_program = intern ("ccl-program");
1942 staticpro (&Qccl_program);
1943
1944 Qccl_program_idx = intern ("ccl-program-idx");
1945 staticpro (&Qccl_program_idx);
1946
1947 Qcode_conversion_map = intern ("code-conversion-map");
1948 staticpro (&Qcode_conversion_map);
1949
1950 Qcode_conversion_map_id = intern ("code-conversion-map-id");
1951 staticpro (&Qcode_conversion_map_id);
1952
1953 DEFVAR_LISP ("code-conversion-map-vector", &Vcode_conversion_map_vector,
1954 "Vector of code conversion maps.");
1955 Vcode_conversion_map_vector = Fmake_vector (make_number (16), Qnil);
1956
1957 DEFVAR_LISP ("font-ccl-encoder-alist", &Vfont_ccl_encoder_alist,
1958 "Alist of fontname patterns vs corresponding CCL program.\n\
1959 Each element looks like (REGEXP . CCL-CODE),\n\
1960 where CCL-CODE is a compiled CCL program.\n\
1961 When a font whose name matches REGEXP is used for displaying a character,\n\
1962 CCL-CODE is executed to calculate the code point in the font\n\
1963 from the charset number and position code(s) of the character which are set\n\
1964 in CCL registers R0, R1, and R2 before the execution.\n\
1965 The code point in the font is set in CCL registers R1 and R2\n\
1966 when the execution terminated.\n\
1967 If the font is single-byte font, the register R2 is not used.");
1968 Vfont_ccl_encoder_alist = Qnil;
1969
1970 defsubr (&Sccl_execute);
1971 defsubr (&Sccl_execute_on_string);
1972 defsubr (&Sregister_ccl_program);
1973 defsubr (&Sregister_code_conversion_map);
1974 }
1975
1976 #endif /* emacs */