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