HCoop / bpt / emacs.git / blob
? search:
summary | shortlog | log | commit | commitdiff | tree
blame | history | raw | HEAD
(transpose-subr, transpose-subr-1): Rename variables
[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_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 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 /* 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 CCL_SUCCESS;
982
983 case CCL_ExprSelfConst: /* 00000OPERATION000000rrrXXXXX */
984 i = XINT (ccl_prog[ic]);
985 ic++;
986 op = field1 >> 6;
987 goto ccl_expr_self;
988
989 case CCL_ExprSelfReg: /* 00000OPERATION000RRRrrrXXXXX */
990 i = reg[RRR];
991 op = field1 >> 6;
992
993 ccl_expr_self:
994 switch (op)
995 {
996 case CCL_PLUS: reg[rrr] += i; break;
997 case CCL_MINUS: reg[rrr] -= i; break;
998 case CCL_MUL: reg[rrr] *= i; break;
999 case CCL_DIV: reg[rrr] /= i; break;
1000 case CCL_MOD: reg[rrr] %= i; break;
1001 case CCL_AND: reg[rrr] &= i; break;
1002 case CCL_OR: reg[rrr] |= i; break;
1003 case CCL_XOR: reg[rrr] ^= i; break;
1004 case CCL_LSH: reg[rrr] <<= i; break;
1005 case CCL_RSH: reg[rrr] >>= i; break;
1006 case CCL_LSH8: reg[rrr] <<= 8; reg[rrr] |= i; break;
1007 case CCL_RSH8: reg[7] = reg[rrr] & 0xFF; reg[rrr] >>= 8; break;
1008 case CCL_DIVMOD: reg[7] = reg[rrr] % i; reg[rrr] /= i; break;
1009 case CCL_LS: reg[rrr] = reg[rrr] < i; break;
1010 case CCL_GT: reg[rrr] = reg[rrr] > i; break;
1011 case CCL_EQ: reg[rrr] = reg[rrr] == i; break;
1012 case CCL_LE: reg[rrr] = reg[rrr] <= i; break;
1013 case CCL_GE: reg[rrr] = reg[rrr] >= i; break;
1014 case CCL_NE: reg[rrr] = reg[rrr] != i; break;
1015 default: CCL_INVALID_CMD;
1016 }
1017 break;
1018
1019 case CCL_SetExprConst: /* 00000OPERATION000RRRrrrXXXXX */
1020 i = reg[RRR];
1021 j = XINT (ccl_prog[ic]);
1022 op = field1 >> 6;
1023 jump_address = ++ic;
1024 goto ccl_set_expr;
1025
1026 case CCL_SetExprReg: /* 00000OPERATIONRrrRRRrrrXXXXX */
1027 i = reg[RRR];
1028 j = reg[Rrr];
1029 op = field1 >> 6;
1030 jump_address = ic;
1031 goto ccl_set_expr;
1032
1033 case CCL_ReadJumpCondExprConst: /* A--D--D--R--E--S--S-rrrXXXXX */
1034 CCL_READ_CHAR (reg[rrr]);
1035 case CCL_JumpCondExprConst: /* A--D--D--R--E--S--S-rrrXXXXX */
1036 i = reg[rrr];
1037 op = XINT (ccl_prog[ic]);
1038 jump_address = ic++ + ADDR;
1039 j = XINT (ccl_prog[ic]);
1040 ic++;
1041 rrr = 7;
1042 goto ccl_set_expr;
1043
1044 case CCL_ReadJumpCondExprReg: /* A--D--D--R--E--S--S-rrrXXXXX */
1045 CCL_READ_CHAR (reg[rrr]);
1046 case CCL_JumpCondExprReg:
1047 i = reg[rrr];
1048 op = XINT (ccl_prog[ic]);
1049 jump_address = ic++ + ADDR;
1050 j = reg[XINT (ccl_prog[ic])];
1051 ic++;
1052 rrr = 7;
1053
1054 ccl_set_expr:
1055 switch (op)
1056 {
1057 case CCL_PLUS: reg[rrr] = i + j; break;
1058 case CCL_MINUS: reg[rrr] = i - j; break;
1059 case CCL_MUL: reg[rrr] = i * j; break;
1060 case CCL_DIV: reg[rrr] = i / j; break;
1061 case CCL_MOD: reg[rrr] = i % j; break;
1062 case CCL_AND: reg[rrr] = i & j; break;
1063 case CCL_OR: reg[rrr] = i | j; break;
1064 case CCL_XOR: reg[rrr] = i ^ j;; break;
1065 case CCL_LSH: reg[rrr] = i << j; break;
1066 case CCL_RSH: reg[rrr] = i >> j; break;
1067 case CCL_LSH8: reg[rrr] = (i << 8) | j; break;
1068 case CCL_RSH8: reg[rrr] = i >> 8; reg[7] = i & 0xFF; break;
1069 case CCL_DIVMOD: reg[rrr] = i / j; reg[7] = i % j; break;
1070 case CCL_LS: reg[rrr] = i < j; break;
1071 case CCL_GT: reg[rrr] = i > j; break;
1072 case CCL_EQ: reg[rrr] = i == j; break;
1073 case CCL_LE: reg[rrr] = i <= j; break;
1074 case CCL_GE: reg[rrr] = i >= j; break;
1075 case CCL_NE: reg[rrr] = i != j; break;
1076 case CCL_DECODE_SJIS: DECODE_SJIS (i, j, reg[rrr], reg[7]); break;
1077 case CCL_ENCODE_SJIS: ENCODE_SJIS (i, j, reg[rrr], reg[7]); break;
1078 default: CCL_INVALID_CMD;
1079 }
1080 code &= 0x1F;
1081 if (code == CCL_WriteExprConst || code == CCL_WriteExprRegister)
1082 {
1083 i = reg[rrr];
1084 CCL_WRITE_CHAR (i);
1085 }
1086 else if (!reg[rrr])
1087 ic = jump_address;
1088 break;
1089
1090 case CCL_Extention:
1091 switch (EXCMD)
1092 {
1093 case CCL_ReadMultibyteChar2:
1094 if (!src)
1095 CCL_INVALID_CMD;
1096 do {
1097 if (src >= src_end)
1098 {
1099 src++;
1100 goto ccl_read_multibyte_character_suspend;
1101 }
1102
1103 i = *src++;
1104 if (i == LEADING_CODE_COMPOSITION)
1105 {
1106 if (src >= src_end)
1107 goto ccl_read_multibyte_character_suspend;
1108 if (*src == 0xFF)
1109 {
1110 ccl->private_state = COMPOSING_WITH_RULE_HEAD;
1111 src++;
1112 }
1113 else
1114 ccl->private_state = COMPOSING_NO_RULE_HEAD;
1115 }
1116 if (ccl->private_state != 0)
1117 {
1118 /* composite character */
1119 if (*src < 0xA0)
1120 ccl->private_state = 0;
1121 else
1122 {
1123 if (i == 0xA0)
1124 {
1125 if (src >= src_end)
1126 goto ccl_read_multibyte_character_suspend;
1127 i = *src++ & 0x7F;
1128 }
1129 else
1130 i -= 0x20;
1131
1132 if (COMPOSING_WITH_RULE_RULE == ccl->private_state)
1133 {
1134 ccl->private_state = COMPOSING_WITH_RULE_HEAD;
1135 continue;
1136 }
1137 else if (COMPOSING_WITH_RULE_HEAD == ccl->private_state)
1138 ccl->private_state = COMPOSING_WITH_RULE_RULE;
1139 }
1140 }
1141 if (i < 0x80)
1142 {
1143 /* ASCII */
1144 reg[rrr] = i;
1145 reg[RRR] = CHARSET_ASCII;
1146 }
1147 else if (i <= MAX_CHARSET_OFFICIAL_DIMENSION1)
1148 {
1149 if (src >= src_end)
1150 goto ccl_read_multibyte_character_suspend;
1151 reg[RRR] = i;
1152 reg[rrr] = (*src++ & 0x7F);
1153 }
1154 else if (i <= MAX_CHARSET_OFFICIAL_DIMENSION2)
1155 {
1156 if ((src + 1) >= src_end)
1157 goto ccl_read_multibyte_character_suspend;
1158 reg[RRR] = i;
1159 i = (*src++ & 0x7F);
1160 reg[rrr] = ((i << 7) | (*src & 0x7F));
1161 src++;
1162 }
1163 else if ((i == LEADING_CODE_PRIVATE_11)
1164 || (i == LEADING_CODE_PRIVATE_12))
1165 {
1166 if ((src + 1) >= src_end)
1167 goto ccl_read_multibyte_character_suspend;
1168 reg[RRR] = *src++;
1169 reg[rrr] = (*src++ & 0x7F);
1170 }
1171 else if ((i == LEADING_CODE_PRIVATE_21)
1172 || (i == LEADING_CODE_PRIVATE_22))
1173 {
1174 if ((src + 2) >= src_end)
1175 goto ccl_read_multibyte_character_suspend;
1176 reg[RRR] = *src++;
1177 i = (*src++ & 0x7F);
1178 reg[rrr] = ((i << 7) | (*src & 0x7F));
1179 src++;
1180 }
1181 else
1182 {
1183 /* INVALID CODE
1184 Returned charset is -1. */
1185 reg[RRR] = -1;
1186 }
1187 } while (0);
1188 break;
1189
1190 ccl_read_multibyte_character_suspend:
1191 src--;
1192 if (ccl->last_block)
1193 {
1194 ic = ccl->eof_ic;
1195 goto ccl_repeat;
1196 }
1197 else
1198 CCL_SUSPEND (CCL_STAT_SUSPEND_BY_SRC);
1199
1200 break;
1201
1202 case CCL_WriteMultibyteChar2:
1203 i = reg[RRR]; /* charset */
1204 if (i == CHARSET_ASCII)
1205 i = reg[rrr] & 0x7F;
1206 else if (i == CHARSET_COMPOSITION)
1207 i = MAKE_COMPOSITE_CHAR (reg[rrr]);
1208 else if (CHARSET_DIMENSION (i) == 1)
1209 i = ((i - 0x70) << 7) | (reg[rrr] & 0x7F);
1210 else if (i < MIN_CHARSET_PRIVATE_DIMENSION2)
1211 i = ((i - 0x8F) << 14) | reg[rrr];
1212 else
1213 i = ((i - 0xE0) << 14) | reg[rrr];
1214
1215 CCL_WRITE_CHAR (i);
1216
1217 break;
1218
1219 case CCL_TranslateCharacter:
1220 i = reg[RRR]; /* charset */
1221 if (i == CHARSET_ASCII)
1222 i = reg[rrr];
1223 else if (i == CHARSET_COMPOSITION)
1224 {
1225 reg[RRR] = -1;
1226 break;
1227 }
1228 else if (CHARSET_DIMENSION (i) == 1)
1229 i = ((i - 0x70) << 7) | (reg[rrr] & 0x7F);
1230 else if (i < MIN_CHARSET_PRIVATE_DIMENSION2)
1231 i = ((i - 0x8F) << 14) | (reg[rrr] & 0x3FFF);
1232 else
1233 i = ((i - 0xE0) << 14) | (reg[rrr] & 0x3FFF);
1234
1235 op = translate_char (GET_TRANSLATION_TABLE (reg[Rrr]),
1236 i, -1, 0, 0);
1237 SPLIT_CHAR (op, reg[RRR], i, j);
1238 if (j != -1)
1239 i = (i << 7) | j;
1240
1241 reg[rrr] = i;
1242 break;
1243
1244 case CCL_TranslateCharacterConstTbl:
1245 op = XINT (ccl_prog[ic]); /* table */
1246 ic++;
1247 i = reg[RRR]; /* charset */
1248 if (i == CHARSET_ASCII)
1249 i = reg[rrr];
1250 else if (i == CHARSET_COMPOSITION)
1251 {
1252 reg[RRR] = -1;
1253 break;
1254 }
1255 else if (CHARSET_DIMENSION (i) == 1)
1256 i = ((i - 0x70) << 7) | (reg[rrr] & 0x7F);
1257 else if (i < MIN_CHARSET_PRIVATE_DIMENSION2)
1258 i = ((i - 0x8F) << 14) | (reg[rrr] & 0x3FFF);
1259 else
1260 i = ((i - 0xE0) << 14) | (reg[rrr] & 0x3FFF);
1261
1262 op = translate_char (GET_TRANSLATION_TABLE (op), i, -1, 0, 0);
1263 SPLIT_CHAR (op, reg[RRR], i, j);
1264 if (j != -1)
1265 i = (i << 7) | j;
1266
1267 reg[rrr] = i;
1268 break;
1269
1270 case CCL_IterateMultipleMap:
1271 {
1272 Lisp_Object map, content, attrib, value;
1273 int point, size, fin_ic;
1274
1275 j = XINT (ccl_prog[ic++]); /* number of maps. */
1276 fin_ic = ic + j;
1277 op = reg[rrr];
1278 if ((j > reg[RRR]) && (j >= 0))
1279 {
1280 ic += reg[RRR];
1281 i = reg[RRR];
1282 }
1283 else
1284 {
1285 reg[RRR] = -1;
1286 ic = fin_ic;
1287 break;
1288 }
1289
1290 for (;i < j;i++)
1291 {
1292
1293 size = XVECTOR (Vcode_conversion_map_vector)->size;
1294 point = XINT (ccl_prog[ic++]);
1295 if (point >= size) continue;
1296 map =
1297 XVECTOR (Vcode_conversion_map_vector)->contents[point];
1298
1299 /* Check map varidity. */
1300 if (!CONSP (map)) continue;
1301 map = XCONS(map)->cdr;
1302 if (!VECTORP (map)) continue;
1303 size = XVECTOR (map)->size;
1304 if (size <= 1) continue;
1305
1306 content = XVECTOR (map)->contents[0];
1307
1308 /* check map type,
1309 [STARTPOINT VAL1 VAL2 ...] or
1310 [t ELELMENT STARTPOINT ENDPOINT] */
1311 if (NUMBERP (content))
1312 {
1313 point = XUINT (content);
1314 point = op - point + 1;
1315 if (!((point >= 1) && (point < size))) continue;
1316 content = XVECTOR (map)->contents[point];
1317 }
1318 else if (EQ (content, Qt))
1319 {
1320 if (size != 4) continue;
1321 if ((op >= XUINT (XVECTOR (map)->contents[2]))
1322 && (op < XUINT (XVECTOR (map)->contents[3])))
1323 content = XVECTOR (map)->contents[1];
1324 else
1325 continue;
1326 }
1327 else
1328 continue;
1329
1330 if (NILP (content))
1331 continue;
1332 else if (NUMBERP (content))
1333 {
1334 reg[RRR] = i;
1335 reg[rrr] = XINT(content);
1336 break;
1337 }
1338 else if (EQ (content, Qt) || EQ (content, Qlambda))
1339 {
1340 reg[RRR] = i;
1341 break;
1342 }
1343 else if (CONSP (content))
1344 {
1345 attrib = XCONS (content)->car;
1346 value = XCONS (content)->cdr;
1347 if (!NUMBERP (attrib) || !NUMBERP (value))
1348 continue;
1349 reg[RRR] = i;
1350 reg[rrr] = XUINT (value);
1351 break;
1352 }
1353 }
1354 if (i == j)
1355 reg[RRR] = -1;
1356 ic = fin_ic;
1357 }
1358 break;
1359
1360 case CCL_MapMultiple:
1361 {
1362 Lisp_Object map, content, attrib, value;
1363 int point, size, map_vector_size;
1364 int map_set_rest_length, fin_ic;
1365
1366 map_set_rest_length =
1367 XINT (ccl_prog[ic++]); /* number of maps and separators. */
1368 fin_ic = ic + map_set_rest_length;
1369 if ((map_set_rest_length > reg[RRR]) && (reg[RRR] >= 0))
1370 {
1371 ic += reg[RRR];
1372 i = reg[RRR];
1373 map_set_rest_length -= i;
1374 }
1375 else
1376 {
1377 ic = fin_ic;
1378 reg[RRR] = -1;
1379 break;
1380 }
1381 mapping_stack_pointer = mapping_stack;
1382 op = reg[rrr];
1383 PUSH_MAPPING_STACK (0, op);
1384 reg[RRR] = -1;
1385 map_vector_size = XVECTOR (Vcode_conversion_map_vector)->size;
1386 for (;map_set_rest_length > 0;i++, map_set_rest_length--)
1387 {
1388 point = XINT(ccl_prog[ic++]);
1389 if (point < 0)
1390 {
1391 point = -point;
1392 if (mapping_stack_pointer
1393 >= &mapping_stack[MAX_MAP_SET_LEVEL])
1394 {
1395 CCL_INVALID_CMD;
1396 }
1397 PUSH_MAPPING_STACK (map_set_rest_length - point,
1398 reg[rrr]);
1399 map_set_rest_length = point + 1;
1400 reg[rrr] = op;
1401 continue;
1402 }
1403
1404 if (point >= map_vector_size) continue;
1405 map = (XVECTOR (Vcode_conversion_map_vector)
1406 ->contents[point]);
1407
1408 /* Check map varidity. */
1409 if (!CONSP (map)) continue;
1410 map = XCONS (map)->cdr;
1411 if (!VECTORP (map)) continue;
1412 size = XVECTOR (map)->size;
1413 if (size <= 1) continue;
1414
1415 content = XVECTOR (map)->contents[0];
1416
1417 /* check map type,
1418 [STARTPOINT VAL1 VAL2 ...] or
1419 [t ELEMENT STARTPOINT ENDPOINT] */
1420 if (NUMBERP (content))
1421 {
1422 point = XUINT (content);
1423 point = op - point + 1;
1424 if (!((point >= 1) && (point < size))) continue;
1425 content = XVECTOR (map)->contents[point];
1426 }
1427 else if (EQ (content, Qt))
1428 {
1429 if (size != 4) continue;
1430 if ((op >= XUINT (XVECTOR (map)->contents[2])) &&
1431 (op < XUINT (XVECTOR (map)->contents[3])))
1432 content = XVECTOR (map)->contents[1];
1433 else
1434 continue;
1435 }
1436 else
1437 continue;
1438
1439 if (NILP (content))
1440 continue;
1441 else if (NUMBERP (content))
1442 {
1443 op = XINT (content);
1444 reg[RRR] = i;
1445 i += map_set_rest_length;
1446 POP_MAPPING_STACK (map_set_rest_length, reg[rrr]);
1447 }
1448 else if (CONSP (content))
1449 {
1450 attrib = XCONS (content)->car;
1451 value = XCONS (content)->cdr;
1452 if (!NUMBERP (attrib) || !NUMBERP (value))
1453 continue;
1454 reg[RRR] = i;
1455 op = XUINT (value);
1456 i += map_set_rest_length;
1457 POP_MAPPING_STACK (map_set_rest_length, reg[rrr]);
1458 }
1459 else if (EQ (content, Qt))
1460 {
1461 reg[RRR] = i;
1462 op = reg[rrr];
1463 i += map_set_rest_length;
1464 POP_MAPPING_STACK (map_set_rest_length, reg[rrr]);
1465 }
1466 else if (EQ (content, Qlambda))
1467 {
1468 break;
1469 }
1470 else
1471 CCL_INVALID_CMD;
1472 }
1473 ic = fin_ic;
1474 }
1475 reg[rrr] = op;
1476 break;
1477
1478 case CCL_MapSingle:
1479 {
1480 Lisp_Object map, attrib, value, content;
1481 int size, point;
1482 j = XINT (ccl_prog[ic++]); /* map_id */
1483 op = reg[rrr];
1484 if (j >= XVECTOR (Vcode_conversion_map_vector)->size)
1485 {
1486 reg[RRR] = -1;
1487 break;
1488 }
1489 map = XVECTOR (Vcode_conversion_map_vector)->contents[j];
1490 if (!CONSP (map))
1491 {
1492 reg[RRR] = -1;
1493 break;
1494 }
1495 map = XCONS(map)->cdr;
1496 if (!VECTORP (map))
1497 {
1498 reg[RRR] = -1;
1499 break;
1500 }
1501 size = XVECTOR (map)->size;
1502 point = XUINT (XVECTOR (map)->contents[0]);
1503 point = op - point + 1;
1504 reg[RRR] = 0;
1505 if ((size <= 1) ||
1506 (!((point >= 1) && (point < size))))
1507 reg[RRR] = -1;
1508 else
1509 {
1510 content = XVECTOR (map)->contents[point];
1511 if (NILP (content))
1512 reg[RRR] = -1;
1513 else if (NUMBERP (content))
1514 reg[rrr] = XINT (content);
1515 else if (EQ (content, Qt))
1516 reg[RRR] = i;
1517 else if (CONSP (content))
1518 {
1519 attrib = XCONS (content)->car;
1520 value = XCONS (content)->cdr;
1521 if (!NUMBERP (attrib) || !NUMBERP (value))
1522 continue;
1523 reg[rrr] = XUINT(value);
1524 break;
1525 }
1526 else
1527 reg[RRR] = -1;
1528 }
1529 }
1530 break;
1531
1532 default:
1533 CCL_INVALID_CMD;
1534 }
1535 break;
1536
1537 default:
1538 CCL_INVALID_CMD;
1539 }
1540 }
1541
1542 ccl_error_handler:
1543 if (destination)
1544 {
1545 /* We can insert an error message only if DESTINATION is
1546 specified and we still have a room to store the message
1547 there. */
1548 char msg[256];
1549 int msglen;
1550
1551 if (!dst)
1552 dst = destination;
1553
1554 switch (ccl->status)
1555 {
1556 case CCL_STAT_INVALID_CMD:
1557 sprintf(msg, "\nCCL: Invalid command %x (ccl_code = %x) at %d.",
1558 code & 0x1F, code, this_ic);
1559 #ifdef CCL_DEBUG
1560 {
1561 int i = ccl_backtrace_idx - 1;
1562 int j;
1563
1564 msglen = strlen (msg);
1565 if (dst + msglen <= (dst_bytes ? dst_end : src))
1566 {
1567 bcopy (msg, dst, msglen);
1568 dst += msglen;
1569 }
1570
1571 for (j = 0; j < CCL_DEBUG_BACKTRACE_LEN; j++, i--)
1572 {
1573 if (i < 0) i = CCL_DEBUG_BACKTRACE_LEN - 1;
1574 if (ccl_backtrace_table[i] == 0)
1575 break;
1576 sprintf(msg, " %d", ccl_backtrace_table[i]);
1577 msglen = strlen (msg);
1578 if (dst + msglen > (dst_bytes ? dst_end : src))
1579 break;
1580 bcopy (msg, dst, msglen);
1581 dst += msglen;
1582 }
1583 goto ccl_finish;
1584 }
1585 #endif
1586 break;
1587
1588 case CCL_STAT_QUIT:
1589 sprintf(msg, "\nCCL: Quited.");
1590 break;
1591
1592 default:
1593 sprintf(msg, "\nCCL: Unknown error type (%d).", ccl->status);
1594 }
1595
1596 msglen = strlen (msg);
1597 if (dst + msglen <= (dst_bytes ? dst_end : src))
1598 {
1599 bcopy (msg, dst, msglen);
1600 dst += msglen;
1601 }
1602 }
1603
1604 ccl_finish:
1605 ccl->ic = ic;
1606 if (consumed) *consumed = src - source;
1607 return (dst ? dst - destination : 0);
1608 }
1609
1610 /* Setup fields of the structure pointed by CCL appropriately for the
1611 execution of compiled CCL code in VEC (vector of integer). */
1612 void
1613 setup_ccl_program (ccl, vec)
1614 struct ccl_program *ccl;
1615 Lisp_Object vec;
1616 {
1617 int i;
1618
1619 ccl->size = XVECTOR (vec)->size;
1620 ccl->prog = XVECTOR (vec)->contents;
1621 ccl->ic = CCL_HEADER_MAIN;
1622 ccl->eof_ic = XINT (XVECTOR (vec)->contents[CCL_HEADER_EOF]);
1623 ccl->buf_magnification = XINT (XVECTOR (vec)->contents[CCL_HEADER_BUF_MAG]);
1624 for (i = 0; i < 8; i++)
1625 ccl->reg[i] = 0;
1626 ccl->last_block = 0;
1627 ccl->private_state = 0;
1628 ccl->status = 0;
1629 }
1630
1631 /* Resolve symbols in the specified CCL code (Lisp vector). This
1632 function converts symbols of code conversion maps and character
1633 translation tables embeded in the CCL code into their ID numbers. */
1634
1635 Lisp_Object
1636 resolve_symbol_ccl_program (ccl)
1637 Lisp_Object ccl;
1638 {
1639 int i, veclen;
1640 Lisp_Object result, contents, prop;
1641
1642 result = ccl;
1643 veclen = XVECTOR (result)->size;
1644
1645 /* Set CCL program's table ID */
1646 for (i = 0; i < veclen; i++)
1647 {
1648 contents = XVECTOR (result)->contents[i];
1649 if (SYMBOLP (contents))
1650 {
1651 if (EQ(result, ccl))
1652 result = Fcopy_sequence (ccl);
1653
1654 prop = Fget (contents, Qtranslation_table_id);
1655 if (NUMBERP (prop))
1656 {
1657 XVECTOR (result)->contents[i] = prop;
1658 continue;
1659 }
1660 prop = Fget (contents, Qcode_conversion_map_id);
1661 if (NUMBERP (prop))
1662 {
1663 XVECTOR (result)->contents[i] = prop;
1664 continue;
1665 }
1666 prop = Fget (contents, Qccl_program_idx);
1667 if (NUMBERP (prop))
1668 {
1669 XVECTOR (result)->contents[i] = prop;
1670 continue;
1671 }
1672 }
1673 }
1674
1675 return result;
1676 }
1677
1678
1679 #ifdef emacs
1680
1681 DEFUN ("ccl-execute", Fccl_execute, Sccl_execute, 2, 2, 0,
1682 "Execute CCL-PROGRAM with registers initialized by REGISTERS.\n\
1683 \n\
1684 CCL-PROGRAM is a symbol registered by register-ccl-program,\n\
1685 or a compiled code generated by `ccl-compile' (for backward compatibility,\n\
1686 in this case, the execution is slower).\n\
1687 No I/O commands should appear in CCL-PROGRAM.\n\
1688 \n\
1689 REGISTERS is a vector of [R0 R1 ... R7] where RN is an initial value\n\
1690 of Nth register.\n\
1691 \n\
1692 As side effect, each element of REGISTERS holds the value of\n\
1693 corresponding register after the execution.")
1694 (ccl_prog, reg)
1695 Lisp_Object ccl_prog, reg;
1696 {
1697 struct ccl_program ccl;
1698 int i;
1699 Lisp_Object ccl_id;
1700
1701 if ((SYMBOLP (ccl_prog)) &&
1702 (!NILP (ccl_id = Fget (ccl_prog, Qccl_program_idx))))
1703 {
1704 ccl_prog = XVECTOR (Vccl_program_table)->contents[XUINT (ccl_id)];
1705 CHECK_LIST (ccl_prog, 0);
1706 ccl_prog = XCONS (ccl_prog)->cdr;
1707 CHECK_VECTOR (ccl_prog, 1);
1708 }
1709 else
1710 {
1711 CHECK_VECTOR (ccl_prog, 1);
1712 ccl_prog = resolve_symbol_ccl_program (ccl_prog);
1713 }
1714
1715 CHECK_VECTOR (reg, 2);
1716 if (XVECTOR (reg)->size != 8)
1717 error ("Invalid length of vector REGISTERS");
1718
1719 setup_ccl_program (&ccl, ccl_prog);
1720 for (i = 0; i < 8; i++)
1721 ccl.reg[i] = (INTEGERP (XVECTOR (reg)->contents[i])
1722 ? XINT (XVECTOR (reg)->contents[i])
1723 : 0);
1724
1725 ccl_driver (&ccl, (char *)0, (char *)0, 0, 0, (int *)0);
1726 QUIT;
1727 if (ccl.status != CCL_STAT_SUCCESS)
1728 error ("Error in CCL program at %dth code", ccl.ic);
1729
1730 for (i = 0; i < 8; i++)
1731 XSETINT (XVECTOR (reg)->contents[i], ccl.reg[i]);
1732 return Qnil;
1733 }
1734
1735 DEFUN ("ccl-execute-on-string", Fccl_execute_on_string, Sccl_execute_on_string,
1736 3, 5, 0,
1737 "Execute CCL-PROGRAM with initial STATUS on STRING.\n\
1738 \n\
1739 CCL-PROGRAM is a symbol registered by register-ccl-program,\n\
1740 or a compiled code generated by `ccl-compile' (for backward compatibility,\n\
1741 in this case, the execution is slower).\n\
1742 \n\
1743 Read buffer is set to STRING, and write buffer is allocated automatically.\n\
1744 \n\
1745 STATUS is a vector of [R0 R1 ... R7 IC], where\n\
1746 R0..R7 are initial values of corresponding registers,\n\
1747 IC is the instruction counter specifying from where to start the program.\n\
1748 If R0..R7 are nil, they are initialized to 0.\n\
1749 If IC is nil, it is initialized to head of the CCL program.\n\
1750 \n\
1751 If optional 4th arg CONTINUE is non-nil, keep IC on read operation\n\
1752 when read buffer is exausted, else, IC is always set to the end of\n\
1753 CCL-PROGRAM on exit.\n\
1754 \n\
1755 It returns the contents of write buffer as a string,\n\
1756 and as side effect, STATUS is updated.\n\
1757 If the optional 5th arg UNIBYTE-P is non-nil, the returned string\n\
1758 is a unibyte string. By default it is a multibyte string.")
1759 (ccl_prog, status, str, contin, unibyte_p)
1760 Lisp_Object ccl_prog, status, str, contin, unibyte_p;
1761 {
1762 Lisp_Object val;
1763 struct ccl_program ccl;
1764 int i, produced;
1765 int outbufsize;
1766 char *outbuf;
1767 struct gcpro gcpro1, gcpro2, gcpro3;
1768 Lisp_Object ccl_id;
1769
1770 if ((SYMBOLP (ccl_prog)) &&
1771 (!NILP (ccl_id = Fget (ccl_prog, Qccl_program_idx))))
1772 {
1773 ccl_prog = XVECTOR (Vccl_program_table)->contents[XUINT (ccl_id)];
1774 CHECK_LIST (ccl_prog, 0);
1775 ccl_prog = XCONS (ccl_prog)->cdr;
1776 CHECK_VECTOR (ccl_prog, 1);
1777 }
1778 else
1779 {
1780 CHECK_VECTOR (ccl_prog, 1);
1781 ccl_prog = resolve_symbol_ccl_program (ccl_prog);
1782 }
1783
1784 CHECK_VECTOR (status, 1);
1785 if (XVECTOR (status)->size != 9)
1786 error ("Invalid length of vector STATUS");
1787 CHECK_STRING (str, 2);
1788 GCPRO3 (ccl_prog, status, str);
1789
1790 setup_ccl_program (&ccl, ccl_prog);
1791 for (i = 0; i < 8; i++)
1792 {
1793 if (NILP (XVECTOR (status)->contents[i]))
1794 XSETINT (XVECTOR (status)->contents[i], 0);
1795 if (INTEGERP (XVECTOR (status)->contents[i]))
1796 ccl.reg[i] = XINT (XVECTOR (status)->contents[i]);
1797 }
1798 if (INTEGERP (XVECTOR (status)->contents[i]))
1799 {
1800 i = XFASTINT (XVECTOR (status)->contents[8]);
1801 if (ccl.ic < i && i < ccl.size)
1802 ccl.ic = i;
1803 }
1804 outbufsize = STRING_BYTES (XSTRING (str)) * ccl.buf_magnification + 256;
1805 outbuf = (char *) xmalloc (outbufsize);
1806 if (!outbuf)
1807 error ("Not enough memory");
1808 ccl.last_block = NILP (contin);
1809 produced = ccl_driver (&ccl, XSTRING (str)->data, outbuf,
1810 STRING_BYTES (XSTRING (str)), outbufsize, (int *)0);
1811 for (i = 0; i < 8; i++)
1812 XSET (XVECTOR (status)->contents[i], Lisp_Int, ccl.reg[i]);
1813 XSETINT (XVECTOR (status)->contents[8], ccl.ic);
1814 UNGCPRO;
1815
1816 if (NILP (unibyte_p))
1817 val = make_string (outbuf, produced);
1818 else
1819 val = make_unibyte_string (outbuf, produced);
1820 free (outbuf);
1821 QUIT;
1822 if (ccl.status != CCL_STAT_SUCCESS
1823 && ccl.status != CCL_STAT_SUSPEND_BY_SRC
1824 && ccl.status != CCL_STAT_SUSPEND_BY_DST)
1825 error ("Error in CCL program at %dth code", ccl.ic);
1826
1827 return val;
1828 }
1829
1830 DEFUN ("register-ccl-program", Fregister_ccl_program, Sregister_ccl_program,
1831 2, 2, 0,
1832 "Register CCL program PROGRAM of NAME in `ccl-program-table'.\n\
1833 PROGRAM should be a compiled code of CCL program, or nil.\n\
1834 Return index number of the registered CCL program.")
1835 (name, ccl_prog)
1836 Lisp_Object name, ccl_prog;
1837 {
1838 int len = XVECTOR (Vccl_program_table)->size;
1839 int i;
1840
1841 CHECK_SYMBOL (name, 0);
1842 if (!NILP (ccl_prog))
1843 {
1844 CHECK_VECTOR (ccl_prog, 1);
1845 ccl_prog = resolve_symbol_ccl_program (ccl_prog);
1846 }
1847
1848 for (i = 0; i < len; i++)
1849 {
1850 Lisp_Object slot = XVECTOR (Vccl_program_table)->contents[i];
1851
1852 if (!CONSP (slot))
1853 break;
1854
1855 if (EQ (name, XCONS (slot)->car))
1856 {
1857 XCONS (slot)->cdr = ccl_prog;
1858 return make_number (i);
1859 }
1860 }
1861
1862 if (i == len)
1863 {
1864 Lisp_Object new_table = Fmake_vector (make_number (len * 2), Qnil);
1865 int j;
1866
1867 for (j = 0; j < len; j++)
1868 XVECTOR (new_table)->contents[j]
1869 = XVECTOR (Vccl_program_table)->contents[j];
1870 Vccl_program_table = new_table;
1871 }
1872
1873 XVECTOR (Vccl_program_table)->contents[i] = Fcons (name, ccl_prog);
1874 Fput (name, Qccl_program_idx, make_number (i));
1875 return make_number (i);
1876 }
1877
1878 /* Register code conversion map.
1879 A code conversion map consists of numbers, Qt, Qnil, and Qlambda.
1880 The first element is start code point.
1881 The rest elements are mapped numbers.
1882 Symbol t means to map to an original number before mapping.
1883 Symbol nil means that the corresponding element is empty.
1884 Symbol lambda menas to terminate mapping here.
1885 */
1886
1887 DEFUN ("register-code-conversion-map", Fregister_code_conversion_map,
1888 Sregister_code_conversion_map,
1889 2, 2, 0,
1890 "Register SYMBOL as code conversion map MAP.\n\
1891 Return index number of the registered map.")
1892 (symbol, map)
1893 Lisp_Object symbol, map;
1894 {
1895 int len = XVECTOR (Vcode_conversion_map_vector)->size;
1896 int i;
1897 Lisp_Object index;
1898
1899 CHECK_SYMBOL (symbol, 0);
1900 CHECK_VECTOR (map, 1);
1901
1902 for (i = 0; i < len; i++)
1903 {
1904 Lisp_Object slot = XVECTOR (Vcode_conversion_map_vector)->contents[i];
1905
1906 if (!CONSP (slot))
1907 break;
1908
1909 if (EQ (symbol, XCONS (slot)->car))
1910 {
1911 index = make_number (i);
1912 XCONS (slot)->cdr = map;
1913 Fput (symbol, Qcode_conversion_map, map);
1914 Fput (symbol, Qcode_conversion_map_id, index);
1915 return index;
1916 }
1917 }
1918
1919 if (i == len)
1920 {
1921 Lisp_Object new_vector = Fmake_vector (make_number (len * 2), Qnil);
1922 int j;
1923
1924 for (j = 0; j < len; j++)
1925 XVECTOR (new_vector)->contents[j]
1926 = XVECTOR (Vcode_conversion_map_vector)->contents[j];
1927 Vcode_conversion_map_vector = new_vector;
1928 }
1929
1930 index = make_number (i);
1931 Fput (symbol, Qcode_conversion_map, map);
1932 Fput (symbol, Qcode_conversion_map_id, index);
1933 XVECTOR (Vcode_conversion_map_vector)->contents[i] = Fcons (symbol, map);
1934 return index;
1935 }
1936
1937
1938 void
1939 syms_of_ccl ()
1940 {
1941 staticpro (&Vccl_program_table);
1942 Vccl_program_table = Fmake_vector (make_number (32), Qnil);
1943
1944 Qccl_program = intern ("ccl-program");
1945 staticpro (&Qccl_program);
1946
1947 Qccl_program_idx = intern ("ccl-program-idx");
1948 staticpro (&Qccl_program_idx);
1949
1950 Qcode_conversion_map = intern ("code-conversion-map");
1951 staticpro (&Qcode_conversion_map);
1952
1953 Qcode_conversion_map_id = intern ("code-conversion-map-id");
1954 staticpro (&Qcode_conversion_map_id);
1955
1956 DEFVAR_LISP ("code-conversion-map-vector", &Vcode_conversion_map_vector,
1957 "Vector of code conversion maps.");
1958 Vcode_conversion_map_vector = Fmake_vector (make_number (16), Qnil);
1959
1960 DEFVAR_LISP ("font-ccl-encoder-alist", &Vfont_ccl_encoder_alist,
1961 "Alist of fontname patterns vs corresponding CCL program.\n\
1962 Each element looks like (REGEXP . CCL-CODE),\n\
1963 where CCL-CODE is a compiled CCL program.\n\
1964 When a font whose name matches REGEXP is used for displaying a character,\n\
1965 CCL-CODE is executed to calculate the code point in the font\n\
1966 from the charset number and position code(s) of the character which are set\n\
1967 in CCL registers R0, R1, and R2 before the execution.\n\
1968 The code point in the font is set in CCL registers R1 and R2\n\
1969 when the execution terminated.\n\
1970 If the font is single-byte font, the register R2 is not used.");
1971 Vfont_ccl_encoder_alist = Qnil;
1972
1973 defsubr (&Sccl_execute);
1974 defsubr (&Sccl_execute_on_string);
1975 defsubr (&Sregister_ccl_program);
1976 defsubr (&Sregister_code_conversion_map);
1977 }
1978
1979 #endif /* emacs */
Unnamed repository; edit this file 'description' to name the repository.