1 /* CCL (Code Conversion Language) interpreter.
2 Copyright (C) 1995, 1997 Electrotechnical Laboratory, JAPAN.
3 Licensed to the Free Software Foundation.
5 This file is part of SXEmacs
7 SXEmacs 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 3 of the License, or
10 (at your option) any later version.
12 SXEmacs 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.
17 You should have received a copy of the GNU General Public License
18 along with this program. If not, see <http://www.gnu.org/licenses/>. */
21 /* Synched up with : FSF Emacs 21.0.90 except TranslateCharacter */
33 #include "mule-charset.h"
35 #include "file-coding.h"
41 #endif /* not emacs */
43 /* This contains all code conversion map available to CCL. */
44 Lisp_Object Vcode_conversion_map_vector;
46 /* Alist of fontname patterns vs corresponding CCL program. */
47 Lisp_Object Vfont_ccl_encoder_alist;
49 /* This symbol is a property which associates with ccl program vector.
50 Ex: (get 'ccl-big5-encoder 'ccl-program) returns ccl program vector. */
51 Lisp_Object Qccl_program;
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;
58 /* Symbols of ccl program have this property, a value of the property
59 is an index for Vccl_program_table. */
60 Lisp_Object Qccl_program_idx;
62 /* Table of registered CCL programs. Each element is a vector of
63 NAME, CCL_PROG, and RESOLVEDP where NAME (symbol) is the name of
64 the program, CCL_PROG (vector) is the compiled code of the program,
65 RESOLVEDP (t or nil) is the flag to tell if symbols in CCL_PROG is
66 already resolved to index numbers or not. */
67 Lisp_Object Vccl_program_table;
69 /* CCL (Code Conversion Language) is a simple language which has
70 operations on one input buffer, one output buffer, and 7 registers.
71 The syntax of CCL is described in `ccl.el'. Emacs Lisp function
72 `ccl-compile' compiles a CCL program and produces a CCL code which
73 is a vector of integers. The structure of this vector is as
74 follows: The 1st element: buffer-magnification, a factor for the
75 size of output buffer compared with the size of input buffer. The
76 2nd element: address of CCL code to be executed when encountered
77 with end of input stream. The 3rd and the remaining elements: CCL
80 /* Header of CCL compiled code */
81 #define CCL_HEADER_BUF_MAG 0
82 #define CCL_HEADER_EOF 1
83 #define CCL_HEADER_MAIN 2
85 /* CCL code is a sequence of 28-bit non-negative integers (i.e. the
86 MSB is always 0), each contains CCL command and/or arguments in the
89 |----------------- integer (28-bit) ------------------|
90 |------- 17-bit ------|- 3-bit --|- 3-bit --|- 5-bit -|
91 |--constant argument--|-register-|-register-|-command-|
92 ccccccccccccccccc RRR rrr XXXXX
94 |------- relative address -------|-register-|-command-|
95 cccccccccccccccccccc rrr XXXXX
97 |------------- constant or other args ----------------|
98 cccccccccccccccccccccccccccc
100 where, `cc...c' is a non-negative integer indicating constant value
101 (the left most `c' is always 0) or an absolute jump address, `RRR'
102 and `rrr' are CCL register number, `XXXXX' is one of the following
107 Each comment fields shows one or more lines for command syntax and
108 the following lines for semantics of the command. In semantics, IC
109 stands for Instruction Counter. */
111 #define CCL_SetRegister 0x00 /* Set register a register value:
112 1:00000000000000000RRRrrrXXXXX
113 ------------------------------
117 #define CCL_SetShortConst 0x01 /* Set register a short constant value:
118 1:CCCCCCCCCCCCCCCCCCCCrrrXXXXX
119 ------------------------------
120 reg[rrr] = CCCCCCCCCCCCCCCCCCC;
123 #define CCL_SetConst 0x02 /* Set register a constant value:
124 1:00000000000000000000rrrXXXXX
126 ------------------------------
131 #define CCL_SetArray 0x03 /* Set register an element of array:
132 1:CCCCCCCCCCCCCCCCCRRRrrrXXXXX
136 ------------------------------
137 if (0 <= reg[RRR] < CC..C)
138 reg[rrr] = ELEMENT[reg[RRR]];
142 #define CCL_Jump 0x04 /* Jump:
143 1:A--D--D--R--E--S--S-000XXXXX
144 ------------------------------
148 /* Note: If CC..C is greater than 0, the second code is omitted. */
150 #define CCL_JumpCond 0x05 /* Jump conditional:
151 1:A--D--D--R--E--S--S-rrrXXXXX
152 ------------------------------
157 #define CCL_WriteRegisterJump 0x06 /* Write register and jump:
158 1:A--D--D--R--E--S--S-rrrXXXXX
159 ------------------------------
164 #define CCL_WriteRegisterReadJump 0x07 /* Write register, read, and jump:
165 1:A--D--D--R--E--S--S-rrrXXXXX
166 2:A--D--D--R--E--S--S-rrrYYYYY
167 -----------------------------
173 /* Note: If read is suspended, the resumed execution starts from the
174 second code (YYYYY == CCL_ReadJump). */
176 #define CCL_WriteConstJump 0x08 /* Write constant and jump:
177 1:A--D--D--R--E--S--S-000XXXXX
179 ------------------------------
184 #define CCL_WriteConstReadJump 0x09 /* Write constant, read, and jump:
185 1:A--D--D--R--E--S--S-rrrXXXXX
187 3:A--D--D--R--E--S--S-rrrYYYYY
188 -----------------------------
194 /* Note: If read is suspended, the resumed execution starts from the
195 second code (YYYYY == CCL_ReadJump). */
197 #define CCL_WriteStringJump 0x0A /* Write string and jump:
198 1:A--D--D--R--E--S--S-000XXXXX
200 3:0000STRIN[0]STRIN[1]STRIN[2]
202 ------------------------------
203 write_string (STRING, LENGTH);
207 #define CCL_WriteArrayReadJump 0x0B /* Write an array element, read, and jump:
208 1:A--D--D--R--E--S--S-rrrXXXXX
213 N:A--D--D--R--E--S--S-rrrYYYYY
214 ------------------------------
215 if (0 <= reg[rrr] < LENGTH)
216 write (ELEMENT[reg[rrr]]);
217 IC += LENGTH + 2; (... pointing at N+1)
221 /* Note: If read is suspended, the resumed execution starts from the
222 Nth code (YYYYY == CCL_ReadJump). */
224 #define CCL_ReadJump 0x0C /* Read and jump:
225 1:A--D--D--R--E--S--S-rrrYYYYY
226 -----------------------------
231 #define CCL_Branch 0x0D /* Jump by branch table:
232 1:CCCCCCCCCCCCCCCCCCCCrrrXXXXX
233 2:A--D--D--R--E-S-S[0]000XXXXX
234 3:A--D--D--R--E-S-S[1]000XXXXX
236 ------------------------------
237 if (0 <= reg[rrr] < CC..C)
238 IC += ADDRESS[reg[rrr]];
240 IC += ADDRESS[CC..C];
243 #define CCL_ReadRegister 0x0E /* Read bytes into registers:
244 1:CCCCCCCCCCCCCCCCCCCCrrrXXXXX
245 2:CCCCCCCCCCCCCCCCCCCCrrrXXXXX
247 ------------------------------
252 #define CCL_WriteExprConst 0x0F /* write result of expression:
253 1:00000OPERATION000RRR000XXXXX
255 ------------------------------
256 write (reg[RRR] OPERATION CONSTANT);
260 /* Note: If the Nth read is suspended, the resumed execution starts
261 from the Nth code. */
263 #define CCL_ReadBranch 0x10 /* Read one byte into a register,
264 and jump by branch table:
265 1:CCCCCCCCCCCCCCCCCCCCrrrXXXXX
266 2:A--D--D--R--E-S-S[0]000XXXXX
267 3:A--D--D--R--E-S-S[1]000XXXXX
269 ------------------------------
271 if (0 <= reg[rrr] < CC..C)
272 IC += ADDRESS[reg[rrr]];
274 IC += ADDRESS[CC..C];
277 #define CCL_WriteRegister 0x11 /* Write registers:
278 1:CCCCCCCCCCCCCCCCCCCrrrXXXXX
279 2:CCCCCCCCCCCCCCCCCCCrrrXXXXX
281 ------------------------------
287 /* Note: If the Nth write is suspended, the resumed execution
288 starts from the Nth code. */
290 #define CCL_WriteExprRegister 0x12 /* Write result of expression
291 1:00000OPERATIONRrrRRR000XXXXX
292 ------------------------------
293 write (reg[RRR] OPERATION reg[Rrr]);
296 #define CCL_Call 0x13 /* Call the CCL program whose ID is
298 1:CCCCCCCCCCCCCCCCCCCCFFFXXXXX
299 [2:00000000cccccccccccccccccccc]
300 ------------------------------
308 #define CCL_WriteConstString 0x14 /* Write a constant or a string:
309 1:CCCCCCCCCCCCCCCCCCCCrrrXXXXX
310 [2:0000STRIN[0]STRIN[1]STRIN[2]]
312 -----------------------------
316 write_string (STRING, CC..C);
317 IC += (CC..C + 2) / 3;
320 #define CCL_WriteArray 0x15 /* Write an element of array:
321 1:CCCCCCCCCCCCCCCCCCCCrrrXXXXX
325 ------------------------------
326 if (0 <= reg[rrr] < CC..C)
327 write (ELEMENT[reg[rrr]]);
331 #define CCL_End 0x16 /* Terminate:
332 1:00000000000000000000000XXXXX
333 ------------------------------
337 /* The following two codes execute an assignment arithmetic/logical
338 operation. The form of the operation is like REG OP= OPERAND. */
340 #define CCL_ExprSelfConst 0x17 /* REG OP= constant:
341 1:00000OPERATION000000rrrXXXXX
343 ------------------------------
344 reg[rrr] OPERATION= CONSTANT;
347 #define CCL_ExprSelfReg 0x18 /* REG1 OP= REG2:
348 1:00000OPERATION000RRRrrrXXXXX
349 ------------------------------
350 reg[rrr] OPERATION= reg[RRR];
353 /* The following codes execute an arithmetic/logical operation. The
354 form of the operation is like REG_X = REG_Y OP OPERAND2. */
356 #define CCL_SetExprConst 0x19 /* REG_X = REG_Y OP constant:
357 1:00000OPERATION000RRRrrrXXXXX
359 ------------------------------
360 reg[rrr] = reg[RRR] OPERATION CONSTANT;
364 #define CCL_SetExprReg 0x1A /* REG1 = REG2 OP REG3:
365 1:00000OPERATIONRrrRRRrrrXXXXX
366 ------------------------------
367 reg[rrr] = reg[RRR] OPERATION reg[Rrr];
370 #define CCL_JumpCondExprConst 0x1B /* Jump conditional according to
371 an operation on constant:
372 1:A--D--D--R--E--S--S-rrrXXXXX
375 -----------------------------
376 reg[7] = reg[rrr] OPERATION CONSTANT;
383 #define CCL_JumpCondExprReg 0x1C /* Jump conditional according to
384 an operation on register:
385 1:A--D--D--R--E--S--S-rrrXXXXX
388 -----------------------------
389 reg[7] = reg[rrr] OPERATION reg[RRR];
396 #define CCL_ReadJumpCondExprConst 0x1D /* Read and jump conditional according
397 to an operation on constant:
398 1:A--D--D--R--E--S--S-rrrXXXXX
401 -----------------------------
403 reg[7] = reg[rrr] OPERATION CONSTANT;
410 #define CCL_ReadJumpCondExprReg 0x1E /* Read and jump conditional according
411 to an operation on register:
412 1:A--D--D--R--E--S--S-rrrXXXXX
415 -----------------------------
417 reg[7] = reg[rrr] OPERATION reg[RRR];
424 #define CCL_Extension 0x1F /* Extended CCL code
425 1:ExtendedCOMMNDRrrRRRrrrXXXXX
428 ------------------------------
429 extended_command (rrr,RRR,Rrr,ARGS)
433 Here after, Extended CCL Instructions.
434 Bit length of extended command is 14.
435 Therefore, the instruction code range is 0..16384(0x3fff).
438 /* Read a multibyte characeter.
439 A code point is stored into reg[rrr]. A charset ID is stored into
442 #define CCL_ReadMultibyteChar2 0x00 /* Read Multibyte Character
443 1:ExtendedCOMMNDRrrRRRrrrXXXXX */
445 /* Write a multibyte character.
446 Write a character whose code point is reg[rrr] and the charset ID
449 #define CCL_WriteMultibyteChar2 0x01 /* Write Multibyte Character
450 1:ExtendedCOMMNDRrrRRRrrrXXXXX */
452 /* Translate a character whose code point is reg[rrr] and the charset
453 ID is reg[RRR] by a translation table whose ID is reg[Rrr].
455 A translated character is set in reg[rrr] (code point) and reg[RRR]
458 #define CCL_TranslateCharacter 0x02 /* Translate a multibyte character
459 1:ExtendedCOMMNDRrrRRRrrrXXXXX */
461 /* Translate a character whose code point is reg[rrr] and the charset
462 ID is reg[RRR] by a translation table whose ID is ARGUMENT.
464 A translated character is set in reg[rrr] (code point) and reg[RRR]
467 #define CCL_TranslateCharacterConstTbl 0x03 /* Translate a multibyte character
468 1:ExtendedCOMMNDRrrRRRrrrXXXXX
469 2:ARGUMENT(Translation Table ID)
472 /* Iterate looking up MAPs for reg[rrr] starting from the Nth (N =
473 reg[RRR]) MAP until some value is found.
475 Each MAP is a Lisp vector whose element is number, nil, t, or
477 If the element is nil, ignore the map and proceed to the next map.
478 If the element is t or lambda, finish without changing reg[rrr].
479 If the element is a number, set reg[rrr] to the number and finish.
481 Detail of the map structure is described in the comment for
482 CCL_MapMultiple below. */
484 #define CCL_IterateMultipleMap 0x10 /* Iterate multiple maps
485 1:ExtendedCOMMNDXXXRRRrrrXXXXX
492 /* Map the code in reg[rrr] by MAPs starting from the Nth (N =
495 MAPs are supplied in the succeeding CCL codes as follows:
497 When CCL program gives this nested structure of map to this command:
500 (MAP-ID121 MAP-ID122 MAP-ID123)
503 (MAP-ID211 (MAP-ID2111) MAP-ID212)
505 the compiled CCL code has this sequence:
506 CCL_MapMultiple (CCL code of this command)
507 16 (total number of MAPs and SEPARATORs)
525 A value of each SEPARATOR follows this rule:
526 MAP-SET := SEPARATOR [(MAP-ID | MAP-SET)]+
527 SEPARATOR := -(number of MAP-IDs and SEPARATORs in the MAP-SET)
529 (*)....Nest level of MAP-SET must not be over than MAX_MAP_SET_LEVEL.
531 When some map fails to map (i.e. it doesn't have a value for
532 reg[rrr]), the mapping is treated as identity.
534 The mapping is iterated for all maps in each map set (set of maps
535 separated by SEPARATOR) except in the case that lambda is
536 encountered. More precisely, the mapping proceeds as below:
538 At first, VAL0 is set to reg[rrr], and it is translated by the
539 first map to VAL1. Then, VAL1 is translated by the next map to
540 VAL2. This mapping is iterated until the last map is used. The
541 result of the mapping is the last value of VAL?. When the mapping
542 process reached to the end of the map set, it moves to the next
543 map set. If the next does not exit, the mapping process terminates,
544 and regard the last value as a result.
546 But, when VALm is mapped to VALn and VALn is not a number, the
547 mapping proceeds as follows:
549 If VALn is nil, the lastest map is ignored and the mapping of VALm
550 proceeds to the next map.
552 In VALn is t, VALm is reverted to reg[rrr] and the mapping of VALm
553 proceeds to the next map.
555 If VALn is lambda, move to the next map set like reaching to the
556 end of the current map set.
558 If VALn is a symbol, call the CCL program refered by it.
559 Then, use reg[rrr] as a mapped value except for -1, -2 and -3.
560 Such special values are regarded as nil, t, and lambda respectively.
562 Each map is a Lisp vector of the following format (a) or (b):
563 (a)......[STARTPOINT VAL1 VAL2 ...]
564 (b)......[t VAL STARTPOINT ENDPOINT],
566 STARTPOINT is an offset to be used for indexing a map,
567 ENDPOINT is a maximum index number of a map,
568 VAL and VALn is a number, nil, t, or lambda.
570 Valid index range of a map of type (a) is:
571 STARTPOINT <= index < STARTPOINT + map_size - 1
572 Valid index range of a map of type (b) is:
573 STARTPOINT <= index < ENDPOINT */
575 #define CCL_MapMultiple 0x11 /* Mapping by multiple code conversion maps
576 1:ExtendedCOMMNDXXXRRRrrrXXXXX
588 #define MAX_MAP_SET_LEVEL 30
595 static tr_stack mapping_stack[MAX_MAP_SET_LEVEL];
596 static tr_stack *mapping_stack_pointer;
598 /* If this variable is non-zero, it indicates the stack_idx
599 of immediately called by CCL_MapMultiple. */
600 static int stack_idx_of_map_multiple;
602 #define PUSH_MAPPING_STACK(restlen, orig) \
604 mapping_stack_pointer->rest_length = (restlen); \
605 mapping_stack_pointer->orig_val = (orig); \
606 mapping_stack_pointer++; \
609 #define POP_MAPPING_STACK(restlen, orig) \
611 mapping_stack_pointer--; \
612 (restlen) = mapping_stack_pointer->rest_length; \
613 (orig) = mapping_stack_pointer->orig_val; \
616 #define CCL_CALL_FOR_MAP_INSTRUCTION(symbol, ret_ic) \
618 struct ccl_program called_ccl; \
619 if (stack_idx >= 256 \
620 || (setup_ccl_program (&called_ccl, (symbol)) != 0)) \
624 ccl_prog = ccl_prog_stack_struct[0].ccl_prog; \
625 ic = ccl_prog_stack_struct[0].ic; \
629 ccl_prog_stack_struct[stack_idx].ccl_prog = ccl_prog; \
630 ccl_prog_stack_struct[stack_idx].ic = (ret_ic); \
632 ccl_prog = called_ccl.prog; \
633 ic = CCL_HEADER_MAIN; \
634 /* The "if (1)" prevents warning \
635 "end-of loop code not reached" */ \
636 if (1) goto ccl_repeat; \
639 #define CCL_MapSingle 0x12 /* Map by single code conversion map
640 1:ExtendedCOMMNDXXXRRRrrrXXXXX
642 ------------------------------
643 Map reg[rrr] by MAP-ID.
644 If some valid mapping is found,
645 set reg[rrr] to the result,
650 /* CCL arithmetic/logical operators. */
651 #define CCL_PLUS 0x00 /* X = Y + Z */
652 #define CCL_MINUS 0x01 /* X = Y - Z */
653 #define CCL_MUL 0x02 /* X = Y * Z */
654 #define CCL_DIV 0x03 /* X = Y / Z */
655 #define CCL_MOD 0x04 /* X = Y % Z */
656 #define CCL_AND 0x05 /* X = Y & Z */
657 #define CCL_OR 0x06 /* X = Y | Z */
658 #define CCL_XOR 0x07 /* X = Y ^ Z */
659 #define CCL_LSH 0x08 /* X = Y << Z */
660 #define CCL_RSH 0x09 /* X = Y >> Z */
661 #define CCL_LSH8 0x0A /* X = (Y << 8) | Z */
662 #define CCL_RSH8 0x0B /* X = Y >> 8, r[7] = Y & 0xFF */
663 #define CCL_DIVMOD 0x0C /* X = Y / Z, r[7] = Y % Z */
664 #define CCL_LS 0x10 /* X = (X < Y) */
665 #define CCL_GT 0x11 /* X = (X > Y) */
666 #define CCL_EQ 0x12 /* X = (X == Y) */
667 #define CCL_LE 0x13 /* X = (X <= Y) */
668 #define CCL_GE 0x14 /* X = (X >= Y) */
669 #define CCL_NE 0x15 /* X = (X != Y) */
671 #define CCL_DECODE_SJIS 0x16 /* X = HIGHER_BYTE (DE-SJIS (Y, Z))
672 r[7] = LOWER_BYTE (DE-SJIS (Y, Z)) */
673 #define CCL_ENCODE_SJIS 0x17 /* X = HIGHER_BYTE (SJIS (Y, Z))
674 r[7] = LOWER_BYTE (SJIS (Y, Z) */
676 /* Terminate CCL program successfully. */
677 #define CCL_SUCCESS \
679 ccl->status = CCL_STAT_SUCCESS; \
680 /* The "if (1)" inhibits the warning \
681 "end-of loop code not reached" */ \
682 if (1) goto ccl_finish; \
685 /* Suspend CCL program because of reading from empty input buffer or
686 writing to full output buffer. When this program is resumed, the
687 same I/O command is executed. */
688 #define CCL_SUSPEND(stat) \
691 ccl->status = (stat); \
692 /* The "if (1)" inhibits the warning \
693 "end-of loop code not reached" */ \
694 if (1) goto ccl_finish; \
697 /* Terminate CCL program because of invalid command. Should not occur
698 in the normal case. */
699 #define CCL_INVALID_CMD \
701 ccl->status = CCL_STAT_INVALID_CMD; \
702 /* The "if (1)" inhibits the warning \
703 "end-of loop code not reached" */ \
704 if (1) goto ccl_error_handler; \
707 /* Encode one character CH to multibyte form and write to the current
708 output buffer. At encoding time, if CH is less than 256, CH is
709 written as is. At decoding time, if CH cannot be regarded as an
710 ASCII character, write it in multibyte form. */
711 #define CCL_WRITE_CHAR(ch) \
715 if (conversion_mode == CCL_MODE_ENCODING) \
719 if (ccl->eol_type == CCL_CODING_EOL_CRLF) \
721 Dynarr_add (destination, '\r'); \
722 Dynarr_add (destination, '\n'); \
724 else if (ccl->eol_type == CCL_CODING_EOL_CR) \
725 Dynarr_add (destination, '\r'); \
727 Dynarr_add (destination, '\n'); \
729 else if ((ch) < 0x100) \
731 Dynarr_add (destination, ch); \
735 Bufbyte work[MAX_EMCHAR_LEN]; \
737 len = non_ascii_set_charptr_emchar (work, ch); \
738 Dynarr_add_many (destination, work, len); \
743 if (!CHAR_MULTIBYTE_P(ch)) \
745 Dynarr_add (destination, ch); \
749 Bufbyte work[MAX_EMCHAR_LEN]; \
751 len = non_ascii_set_charptr_emchar (work, ch); \
752 Dynarr_add_many (destination, work, len); \
757 /* Write a string at ccl_prog[IC] of length LEN to the current output
758 buffer. But this macro treat this string as a binary. Therefore,
759 cannot handle a multibyte string except for Control-1 characters. */
760 #define CCL_WRITE_STRING(len) \
762 Bufbyte work[MAX_EMCHAR_LEN]; \
766 else if (conversion_mode == CCL_MODE_ENCODING) \
768 for (i = 0; i < (len); i++) \
770 ch = ((XINT (ccl_prog[ic + (i / 3)])) \
771 >> ((2 - (i % 3)) * 8)) & 0xFF; \
774 if (ccl->eol_type == CCL_CODING_EOL_CRLF) \
776 Dynarr_add (destination, '\r'); \
777 Dynarr_add (destination, '\n'); \
779 else if (ccl->eol_type == CCL_CODING_EOL_CR) \
780 Dynarr_add (destination, '\r'); \
782 Dynarr_add (destination, '\n'); \
786 Dynarr_add (destination, ch); \
790 bytes = non_ascii_set_charptr_emchar (work, ch); \
791 Dynarr_add_many (destination, work, len); \
797 for (i = 0; i < (len); i++) \
799 ch = ((XINT (ccl_prog[ic + (i / 3)])) \
800 >> ((2 - (i % 3)) * 8)) & 0xFF; \
801 if (!CHAR_MULTIBYTE_P(ch)) \
803 Dynarr_add (destination, ch); \
807 bytes = non_ascii_set_charptr_emchar (work, ch); \
808 Dynarr_add_many (destination, work, len); \
812 SXE_SET_UNUSED(bytes); \
815 /* Read one byte from the current input buffer into Rth register. */
816 #define CCL_READ_CHAR(r) \
824 if (ccl->last_block) \
830 CCL_SUSPEND (CCL_STAT_SUSPEND_BY_SRC); \
834 /* Set C to the character code made from CHARSET and CODE. This is
835 like MAKE_CHAR but check the validity of CHARSET and CODE. If they
836 are not valid, set C to (CODE & 0xFF) because that is usually the
837 case that CCL_ReadMultibyteChar2 read an invalid code and it set
838 CODE to that invalid byte. */
840 /* On XEmacs, TranslateCharacter is not supported. Thus, this
841 macro is not used. */
843 #define CCL_MAKE_CHAR(charset, code, c) \
845 if ((charset) == CHARSET_ASCII) \
846 (c) = (code) & 0xFF; \
847 else if (CHARSET_DEFINED_P (charset) \
848 && ((code) & 0x7F) >= 32 \
849 && ((code) < 256 || ((code >> 7) & 0x7F) >= 32)) \
851 int c1 = (code) & 0x7F, c2 = 0; \
854 c2 = c1, c1 = ((code) >> 7) & 0x7F; \
855 (c) = MAKE_CHAR (charset, c1, c2); \
858 (c) = (code) & 0xFF; \
862 /* Execute CCL code on SRC_BYTES length text at SOURCE. The resulting
863 text goes to a place pointed by DESTINATION, the length of which
864 should not exceed DST_BYTES. The bytes actually processed is
865 returned as *CONSUMED. The return value is the length of the
866 resulting text. As a side effect, the contents of CCL registers
867 are updated. If SOURCE or DESTINATION is NULL, only operations on
868 registers are permitted. */
871 #define CCL_DEBUG_BACKTRACE_LEN 256
872 int ccl_backtrace_table[CCL_BACKTRACE_TABLE];
873 int ccl_backtrace_idx;
876 struct ccl_prog_stack {
877 Lisp_Object *ccl_prog; /* Pointer to an array of CCL code. */
878 int ic; /* Instruction Counter. */
881 /* For the moment, we only support depth 256 of stack. */
882 static struct ccl_prog_stack ccl_prog_stack_struct[256];
885 ccl_driver(struct ccl_program *ccl,
886 const unsigned char *source,
887 unsigned_char_dynarr * destination,
888 int src_bytes, int *consumed, int conversion_mode)
890 register int *reg = ccl->reg;
891 register int ic = ccl->ic;
892 register int code = -1;
893 register int field1, field2;
894 register Lisp_Object *ccl_prog = ccl->prog;
895 const unsigned char *src = source, *src_end = src + src_bytes;
898 int stack_idx = ccl->stack_idx;
899 /* Instruction counter of the current CCL code. */
902 if (ic >= ccl->eof_ic)
903 ic = CCL_HEADER_MAIN;
905 if (ccl->buf_magnification == 0) /* We can't produce any bytes. */
908 /* Set mapping stack pointer. */
909 mapping_stack_pointer = mapping_stack;
912 ccl_backtrace_idx = 0;
918 ccl_backtrace_table[ccl_backtrace_idx++] = ic;
919 if (ccl_backtrace_idx >= CCL_DEBUG_BACKTRACE_LEN)
920 ccl_backtrace_idx = 0;
921 ccl_backtrace_table[ccl_backtrace_idx] = 0;
924 if (!NILP(Vquit_flag) && NILP(Vinhibit_quit)) {
925 /* We can't just signal Qquit, instead break the loop as if
926 the whole data is processed. Don't reset Vquit_flag, it
927 must be handled later at a safer place. */
929 src = source + src_bytes;
930 ccl->status = CCL_STAT_QUIT;
935 code = XINT(ccl_prog[ic]);
938 field2 = (code & 0xFF) >> 5;
941 #define RRR (field1 & 7)
942 #define Rrr ((field1 >> 3) & 7)
944 #define EXCMD (field1 >> 6)
946 switch (code & 0x1F) {
947 case CCL_SetRegister: /* 00000000000000000RRRrrrXXXXX */
951 case CCL_SetShortConst: /* CCCCCCCCCCCCCCCCCCCCrrrXXXXX */
955 case CCL_SetConst: /* 00000000000000000000rrrXXXXX */
956 reg[rrr] = XINT(ccl_prog[ic]);
960 case CCL_SetArray: /* CCCCCCCCCCCCCCCCCCCCRRRrrrXXXXX */
964 reg[rrr] = XINT(ccl_prog[ic + i]);
968 case CCL_Jump: /* A--D--D--R--E--S--S-000XXXXX */
972 case CCL_JumpCond: /* A--D--D--R--E--S--S-rrrXXXXX */
977 case CCL_WriteRegisterJump: /* A--D--D--R--E--S--S-rrrXXXXX */
983 case CCL_WriteRegisterReadJump: /* A--D--D--R--E--S--S-rrrXXXXX */
987 CCL_READ_CHAR(reg[rrr]);
991 case CCL_WriteConstJump: /* A--D--D--R--E--S--S-000XXXXX */
992 i = XINT(ccl_prog[ic]);
997 case CCL_WriteConstReadJump: /* A--D--D--R--E--S--S-rrrXXXXX */
998 i = XINT(ccl_prog[ic]);
1001 CCL_READ_CHAR(reg[rrr]);
1005 case CCL_WriteStringJump: /* A--D--D--R--E--S--S-000XXXXX */
1006 j = XINT(ccl_prog[ic]);
1008 CCL_WRITE_STRING(j);
1012 case CCL_WriteArrayReadJump: /* A--D--D--R--E--S--S-rrrXXXXX */
1014 j = XINT(ccl_prog[ic]);
1016 i = XINT(ccl_prog[ic + 1 + i]);
1020 CCL_READ_CHAR(reg[rrr]);
1021 ic += ADDR - (j + 2);
1024 case CCL_ReadJump: /* A--D--D--R--E--S--S-rrrYYYYY */
1025 CCL_READ_CHAR(reg[rrr]);
1029 case CCL_ReadBranch: /* CCCCCCCCCCCCCCCCCCCCrrrXXXXX */
1030 CCL_READ_CHAR(reg[rrr]);
1031 /* fall through ... */
1032 case CCL_Branch: /* CCCCCCCCCCCCCCCCCCCCrrrXXXXX */
1033 if (reg[rrr] < field1)
1034 ic += XINT(ccl_prog[ic + reg[rrr]]);
1036 ic += XINT(ccl_prog[ic + field1]);
1039 case CCL_ReadRegister: /* CCCCCCCCCCCCCCCCCCCCrrXXXXX */
1041 CCL_READ_CHAR(reg[rrr]);
1044 code = XINT(ccl_prog[ic]);
1047 field2 = (code & 0xFF) >> 5;
1051 case CCL_WriteExprConst: /* 1:00000OPERATION000RRR000XXXXX */
1054 j = XINT(ccl_prog[ic]);
1056 jump_address = ic + 1;
1059 case CCL_WriteRegister: /* CCCCCCCCCCCCCCCCCCCrrrXXXXX */
1065 code = XINT(ccl_prog[ic]);
1068 field2 = (code & 0xFF) >> 5;
1072 case CCL_WriteExprRegister: /* 1:00000OPERATIONRrrRRR000XXXXX */
1080 case CCL_Call: /* 1:CCCCCCCCCCCCCCCCCCCCFFFXXXXX */
1085 /* If FFF is nonzero, the CCL program ID is in the
1088 prog_id = XINT(ccl_prog[ic]);
1093 if (stack_idx >= 256
1096 XVECTOR(Vccl_program_table)->size
1098 XVECTOR(Vccl_program_table)->
1099 contents[prog_id], !VECTORP(slot))
1100 || !VECTORP(XVECTOR(slot)->contents[1])) {
1101 if (stack_idx > 0) {
1103 ccl_prog_stack_struct[0].
1105 ic = ccl_prog_stack_struct[0].
1111 ccl_prog_stack_struct[stack_idx].ccl_prog =
1113 ccl_prog_stack_struct[stack_idx].ic = ic;
1116 XVECTOR(XVECTOR(slot)->contents[1])->
1118 ic = CCL_HEADER_MAIN;
1122 case CCL_WriteConstString: /* CCCCCCCCCCCCCCCCCCCCrrrXXXXX */
1124 CCL_WRITE_CHAR(field1);
1126 CCL_WRITE_STRING(field1);
1127 ic += (field1 + 2) / 3;
1131 case CCL_WriteArray: /* CCCCCCCCCCCCCCCCCCCCrrrXXXXX */
1134 j = XINT(ccl_prog[ic + i]);
1140 case CCL_End: /* 0000000000000000000000XXXXX */
1141 if (stack_idx > 0) {
1144 ccl_prog_stack_struct[stack_idx].ccl_prog;
1145 ic = ccl_prog_stack_struct[stack_idx].ic;
1150 /* ccl->ic should points to this command code again to
1151 suppress further processing. */
1155 case CCL_ExprSelfConst: /* 00000OPERATION000000rrrXXXXX */
1156 i = XINT(ccl_prog[ic]);
1161 case CCL_ExprSelfReg: /* 00000OPERATION000RRRrrrXXXXX */
1202 reg[7] = reg[rrr] & 0xFF;
1206 reg[7] = reg[rrr] % i;
1210 reg[rrr] = reg[rrr] < i;
1213 reg[rrr] = reg[rrr] > i;
1216 reg[rrr] = reg[rrr] == i;
1219 reg[rrr] = reg[rrr] <= i;
1222 reg[rrr] = reg[rrr] >= i;
1225 reg[rrr] = reg[rrr] != i;
1232 case CCL_SetExprConst: /* 00000OPERATION000RRRrrrXXXXX */
1234 j = XINT(ccl_prog[ic]);
1236 jump_address = ++ic;
1239 case CCL_SetExprReg: /* 00000OPERATIONRrrRRRrrrXXXXX */
1246 case CCL_ReadJumpCondExprConst: /* A--D--D--R--E--S--S-rrrXXXXX */
1247 CCL_READ_CHAR(reg[rrr]);
1248 case CCL_JumpCondExprConst: /* A--D--D--R--E--S--S-rrrXXXXX */
1250 op = XINT(ccl_prog[ic]);
1251 jump_address = ic++ + ADDR;
1252 j = XINT(ccl_prog[ic]);
1257 case CCL_ReadJumpCondExprReg: /* A--D--D--R--E--S--S-rrrXXXXX */
1258 CCL_READ_CHAR(reg[rrr]);
1259 case CCL_JumpCondExprReg:
1261 op = XINT(ccl_prog[ic]);
1262 jump_address = ic++ + ADDR;
1263 j = reg[XINT(ccl_prog[ic])];
1300 reg[rrr] = (i << 8) | j;
1328 case CCL_DECODE_SJIS:
1329 /* DECODE_SJIS set MSB for internal format
1330 as opposed to Emacs. */
1331 DECODE_SJIS(i, j, reg[rrr], reg[7]);
1335 case CCL_ENCODE_SJIS:
1336 /* ENCODE_SJIS assumes MSB of SJIS-char is set
1337 as opposed to Emacs. */
1338 ENCODE_SJIS(i | 0x80, j | 0x80, reg[rrr],
1345 if (code == CCL_WriteExprConst
1346 || code == CCL_WriteExprRegister) {
1350 } else if (!reg[rrr])
1356 case CCL_ReadMultibyteChar2:
1360 if (src >= src_end) {
1362 goto ccl_read_multibyte_character_suspend;
1369 reg[RRR] = LEADING_BYTE_ASCII;
1370 } else if (i <= MAX_LEADING_BYTE_OFFICIAL_1) {
1372 goto ccl_read_multibyte_character_suspend;
1374 reg[rrr] = (*src++ & 0x7F);
1375 } else if (i <= MAX_LEADING_BYTE_OFFICIAL_2) {
1376 if ((src + 1) >= src_end)
1377 goto ccl_read_multibyte_character_suspend;
1379 i = (*src++ & 0x7F);
1380 reg[rrr] = ((i << 7) | (*src & 0x7F));
1382 } else if (i == PRE_LEADING_BYTE_PRIVATE_1) {
1383 if ((src + 1) >= src_end)
1384 goto ccl_read_multibyte_character_suspend;
1386 reg[rrr] = (*src++ & 0x7F);
1387 } else if (i == PRE_LEADING_BYTE_PRIVATE_2) {
1388 if ((src + 2) >= src_end)
1389 goto ccl_read_multibyte_character_suspend;
1391 i = (*src++ & 0x7F);
1392 reg[rrr] = ((i << 7) | (*src & 0x7F));
1395 /* INVALID CODE. Return a single byte character. */
1396 reg[RRR] = LEADING_BYTE_ASCII;
1401 ccl_read_multibyte_character_suspend:
1403 if (ccl->last_block) {
1407 CCL_SUSPEND(CCL_STAT_SUSPEND_BY_SRC);
1411 case CCL_WriteMultibyteChar2: {
1416 tmp = CHARSET_BY_LEADING_BYTE(i);
1418 if (i == LEADING_BYTE_ASCII) {
1419 i = reg[rrr] & 0xFF;
1420 } else if (XCHARSET_DIMENSION(tmp) == 1) {
1422 FIELD2_TO_OFFICIAL_LEADING_BYTE)
1424 | (reg[rrr] & 0x7F));
1425 } else if (i < MAX_LEADING_BYTE_OFFICIAL_2) {
1427 FIELD1_TO_OFFICIAL_LEADING_BYTE)
1431 FIELD1_TO_PRIVATE_LEADING_BYTE) <<
1438 case CCL_TranslateCharacter:
1440 /* XEmacs does not have translate_char, and its
1441 equivalent nor. We do nothing on this operation. */
1442 CCL_MAKE_CHAR(reg[RRR], reg[rrr], i);
1443 op = translate_char(GET_TRANSLATION_TABLE
1444 (reg[Rrr]), i, -1, 0, 0);
1445 SPLIT_CHAR(op, reg[RRR], i, j);
1453 case CCL_TranslateCharacterConstTbl:
1455 /* XEmacs does not have translate_char, and its
1456 equivalent nor. We do nothing on this operation. */
1457 op = XINT(ccl_prog[ic]); /* table */
1459 CCL_MAKE_CHAR(reg[RRR], reg[rrr], i);
1460 op = translate_char(GET_TRANSLATION_TABLE(op),
1462 SPLIT_CHAR(op, reg[RRR], i, j);
1470 case CCL_IterateMultipleMap:
1472 Lisp_Object map, content, attrib, value;
1473 int point, size, fin_ic;
1475 j = XINT(ccl_prog[ic++]); /* number of maps. */
1478 if ((j > reg[RRR]) && (j >= 0)) {
1487 for (; i < j; i++) {
1491 (Vcode_conversion_map_vector)->
1493 point = XINT(ccl_prog[ic++]);
1498 (Vcode_conversion_map_vector)->
1501 /* Check map validity. */
1507 size = XVECTOR(map)->size;
1512 XVECTOR(map)->contents[0];
1515 [STARTPOINT VAL1 VAL2 ...] or
1516 [t ELEMENT STARTPOINT ENDPOINT] */
1517 if (INTP(content)) {
1518 point = XUINT(content);
1519 point = op - point + 1;
1527 } else if (EQ(content, Qt)) {
1550 else if (INTP(content)) {
1555 } else if (EQ(content, Qt)
1560 } else if (CONSP(content)) {
1561 attrib = XCAR(content);
1562 value = XCDR(content);
1567 reg[rrr] = XUINT(value);
1569 } else if (SYMBOLP(content))
1570 CCL_CALL_FOR_MAP_INSTRUCTION
1581 case CCL_MapMultiple:
1583 Lisp_Object map, content, attrib, value;
1584 int point, size, map_vector_size;
1585 int map_set_rest_length, fin_ic;
1586 int current_ic = this_ic;
1588 /* inhibit recursive call on MapMultiple. */
1589 if (stack_idx_of_map_multiple > 0) {
1590 if (stack_idx_of_map_multiple <=
1592 stack_idx_of_map_multiple
1594 mapping_stack_pointer =
1599 mapping_stack_pointer =
1601 stack_idx_of_map_multiple = 0;
1603 map_set_rest_length = XINT(ccl_prog[ic++]); /* number of maps and separators. */
1604 fin_ic = ic + map_set_rest_length;
1607 if ((map_set_rest_length > reg[RRR])
1608 && (reg[RRR] >= 0)) {
1611 map_set_rest_length -= i;
1615 mapping_stack_pointer =
1620 if (mapping_stack_pointer <=
1621 (mapping_stack + 1)) {
1622 /* Set up initial state. */
1623 mapping_stack_pointer =
1625 PUSH_MAPPING_STACK(0, op);
1628 /* Recover after calling other ccl program. */
1632 (map_set_rest_length,
1635 (map_set_rest_length,
1639 /* Regard it as Qnil. */
1643 map_set_rest_length--;
1646 /* Regard it as Qt. */
1650 map_set_rest_length--;
1653 /* Regard it as Qlambda. */
1655 i += map_set_rest_length;
1657 map_set_rest_length;
1658 map_set_rest_length = 0;
1661 /* Regard it as normal mapping. */
1662 i += map_set_rest_length;
1664 map_set_rest_length;
1666 (map_set_rest_length,
1673 (Vcode_conversion_map_vector)->size;
1676 for (; map_set_rest_length > 0;
1678 map_set_rest_length--) {
1682 /* +1 is for including separator. */
1685 if (mapping_stack_pointer >= mapping_stack + countof(mapping_stack))
1688 (map_set_rest_length
1702 (Vcode_conversion_map_vector)
1705 /* Check map validity. */
1721 [STARTPOINT VAL1 VAL2 ...] or
1722 [t ELEMENT STARTPOINT ENDPOINT] */
1723 if (INTP(content)) {
1742 if (EQ(content, Qt))
1773 if (INTP(content)) {
1776 i += map_set_rest_length - 1;
1781 (map_set_rest_length,
1783 map_set_rest_length++;
1801 i += map_set_rest_length - 1;
1806 (map_set_rest_length,
1808 map_set_rest_length++;
1810 if (EQ(content, Qt))
1817 i += map_set_rest_length;
1819 map_set_rest_length;
1824 if (mapping_stack_pointer >= mapping_stack + countof(mapping_stack))
1827 (map_set_rest_length,
1830 (map_set_rest_length,
1832 stack_idx_of_map_multiple
1836 CCL_CALL_FOR_MAP_INSTRUCTION
1842 if (mapping_stack_pointer <=
1843 (mapping_stack + 1))
1846 (map_set_rest_length,
1848 i += map_set_rest_length;
1849 ic += map_set_rest_length;
1851 (map_set_rest_length,
1862 Lisp_Object map, attrib, value, content;
1864 j = XINT(ccl_prog[ic++]); /* map_id */
1868 (Vcode_conversion_map_vector)->
1875 (Vcode_conversion_map_vector)->
1882 if (!VECTORP(map)) {
1886 size = XVECTOR(map)->size;
1888 XUINT(XVECTOR(map)->contents[0]);
1889 point = op - point + 1;
1892 (!((point >= 1) && (point < size))))
1901 else if (INTP(content))
1904 else if (EQ(content, Qt)) ;
1905 else if (CONSP(content)) {
1906 attrib = XCAR(content);
1907 value = XCDR(content);
1911 reg[rrr] = XUINT(value);
1913 } else if (SYMBOLP(content))
1914 CCL_CALL_FOR_MAP_INSTRUCTION
1934 /* We can insert an error message only if DESTINATION is
1935 specified and we still have a room to store the message
1939 switch (ccl->status) {
1940 case CCL_STAT_INVALID_CMD:
1941 sz = snprintf(msg, sizeof(msg),
1942 "\nCCL: Invalid command %x (ccl_code = %x) at %d.",
1943 code & 0x1F, code, this_ic);
1944 assert(sz >= 0 && sz < sizeof(msg));
1947 int i = ccl_backtrace_idx - 1;
1950 Dynarr_add_many(destination,
1951 (unsigned char *)msg,
1954 for (j = 0; j < CCL_DEBUG_BACKTRACE_LEN;
1957 i = CCL_DEBUG_BACKTRACE_LEN - 1;
1958 if (ccl_backtrace_table[i] == 0)
1960 sz = snprintf(msg, sizeof(msg), " %d",
1961 ccl_backtrace_table[i]);
1962 assert(sz >= 0 && sz < sizeof(msg));
1963 Dynarr_add_many(destination,
1964 (unsigned char *)msg,
1973 sz = snprintf(msg, sizeof(msg), "\nCCL: Exited.");
1974 assert(sz >= 0 && sz < sizeof(msg));
1978 sz = snprintf(msg, sizeof(msg), "\nCCL: Unknown error type (%d).",
1980 assert(sz >= 0 && sz < sizeof(msg));
1983 Dynarr_add_many(destination, (unsigned char *)msg, strlen(msg));
1988 ccl->stack_idx = stack_idx;
1989 ccl->prog = ccl_prog;
1991 *consumed = src - source;
1994 return Dynarr_length(destination);
1997 /* Resolve symbols in the specified CCL code (Lisp vector). This
1998 function converts symbols of code conversion maps and character
1999 translation tables embedded in the CCL code into their ID numbers.
2001 The return value is a vector (CCL itself or a new vector in which
2002 all symbols are resolved), Qt if resolving of some symbol failed,
2003 or nil if CCL contains invalid data. */
2005 static Lisp_Object resolve_symbol_ccl_program(Lisp_Object ccl)
2007 int i, veclen, unresolved = 0;
2008 Lisp_Object result, contents, val;
2011 veclen = XVECTOR(result)->size;
2013 for (i = 0; i < veclen; i++) {
2014 contents = XVECTOR(result)->contents[i];
2017 else if (CONSP(contents)
2018 && SYMBOLP(XCAR(contents))
2019 && SYMBOLP(XCDR(contents))) {
2020 /* This is the new style for embedding symbols. The form is
2021 (SYMBOL . PROPERTY). (get SYMBOL PROPERTY) should give
2024 if (EQ(result, ccl))
2025 result = Fcopy_sequence(ccl);
2027 val = Fget(XCAR(contents), XCDR(contents), Qnil);
2029 XVECTOR(result)->contents[i] = val;
2033 } else if (SYMBOLP(contents)) {
2034 /* This is the old style for embedding symbols. This style
2035 may lead to a bug if, for instance, a translation table
2036 and a code conversion map have the same name. */
2037 if (EQ(result, ccl))
2038 result = Fcopy_sequence(ccl);
2040 val = Fget(contents, Qcode_conversion_map_id, Qnil);
2042 XVECTOR(result)->contents[i] = val;
2044 val = Fget(contents, Qccl_program_idx, Qnil);
2046 XVECTOR(result)->contents[i] = val;
2055 return (unresolved ? Qt : result);
2058 /* Return the compiled code (vector) of CCL program CCL_PROG.
2059 CCL_PROG is a name (symbol) of the program or already compiled
2060 code. If necessary, resolve symbols in the compiled code to index
2061 numbers. If we failed to get the compiled code or to resolve
2062 symbols, return Qnil. */
2064 static Lisp_Object ccl_get_compiled_code(Lisp_Object ccl_prog)
2066 Lisp_Object val, slot;
2068 if (VECTORP(ccl_prog)) {
2069 val = resolve_symbol_ccl_program(ccl_prog);
2070 return (VECTORP(val) ? val : Qnil);
2072 if (!SYMBOLP(ccl_prog))
2075 val = Fget(ccl_prog, Qccl_program_idx, Qnil);
2077 || XINT(val) >= XVECTOR_LENGTH(Vccl_program_table))
2079 slot = XVECTOR_DATA(Vccl_program_table)[XINT(val)];
2081 || XVECTOR(slot)->size != 3 || !VECTORP(XVECTOR_DATA(slot)[1]))
2083 if (NILP(XVECTOR_DATA(slot)[2])) {
2084 val = resolve_symbol_ccl_program(XVECTOR_DATA(slot)[1]);
2087 XVECTOR_DATA(slot)[1] = val;
2088 XVECTOR_DATA(slot)[2] = Qt;
2090 return XVECTOR_DATA(slot)[1];
2093 /* Setup fields of the structure pointed by CCL appropriately for the
2094 execution of CCL program CCL_PROG. CCL_PROG is the name (symbol)
2095 of the CCL program or the already compiled code (vector).
2096 Return 0 if we succeed this setup, else return -1.
2098 If CCL_PROG is nil, we just reset the structure pointed by CCL. */
2099 int setup_ccl_program(struct ccl_program *ccl, Lisp_Object ccl_prog)
2103 if (!NILP(ccl_prog)) {
2104 ccl_prog = ccl_get_compiled_code(ccl_prog);
2105 if (!VECTORP(ccl_prog))
2107 ccl->size = XVECTOR_LENGTH(ccl_prog);
2108 ccl->prog = XVECTOR_DATA(ccl_prog);
2109 ccl->eof_ic = XINT(XVECTOR_DATA(ccl_prog)[CCL_HEADER_EOF]);
2110 ccl->buf_magnification =
2111 XINT(XVECTOR_DATA(ccl_prog)[CCL_HEADER_BUF_MAG]);
2113 ccl->ic = CCL_HEADER_MAIN;
2114 for (i = 0; i < 8; i++)
2116 ccl->last_block = 0;
2117 ccl->private_state = 0;
2120 ccl->eol_type = CCL_CODING_EOL_LF;
2126 DEFUN("ccl-program-p", Fccl_program_p, 1, 1, 0, /*
2127 Return t if OBJECT is a CCL program name or a compiled CCL program code.
2128 See the documentation of `define-ccl-program' for the detail of CCL program.
2134 if (VECTORP(object)) {
2135 val = resolve_symbol_ccl_program(object);
2136 return (VECTORP(val) ? Qt : Qnil);
2138 if (!SYMBOLP(object))
2141 val = Fget(object, Qccl_program_idx, Qnil);
2142 return ((!NATNUMP(val)
2143 || XINT(val) >= XVECTOR_LENGTH(Vccl_program_table))
2147 DEFUN("ccl-execute", Fccl_execute, 2, 2, 0, /*
2148 Execute CCL-PROGRAM with registers initialized by REGISTERS.
2150 CCL-PROGRAM is a CCL program name (symbol)
2151 or a compiled code generated by `ccl-compile' (for backward compatibility,
2152 in this case, the overhead of the execution is bigger than the former case).
2153 No I/O commands should appear in CCL-PROGRAM.
2155 REGISTERS is a vector of [R0 R1 ... R7] where RN is an initial value
2158 As side effect, each element of REGISTERS holds the value of
2159 corresponding register after the execution.
2161 See the documentation of `define-ccl-program' for the detail of CCL program.
2165 struct ccl_program ccl;
2168 if (setup_ccl_program(&ccl, ccl_prog) < 0)
2169 error("Invalid CCL program");
2172 if (XVECTOR_LENGTH(reg) != 8)
2173 error("Length of vector REGISTERS is not 8");
2175 for (i = 0; i < 8; i++)
2176 ccl.reg[i] = (INTP(XVECTOR_DATA(reg)[i])
2177 ? XINT(XVECTOR_DATA(reg)[i])
2180 ccl_driver(&ccl, (const unsigned char *)0,
2181 (unsigned_char_dynarr *) 0, 0, (int *)0, CCL_MODE_ENCODING);
2183 if (ccl.status != CCL_STAT_SUCCESS)
2184 error("Error in CCL program at %dth code", ccl.ic);
2186 for (i = 0; i < 8; i++)
2187 XSETINT(XVECTOR(reg)->contents[i], ccl.reg[i]);
2191 DEFUN("ccl-execute-on-string", Fccl_execute_on_string, 3, 4, 0, /*
2192 Execute CCL-PROGRAM with initial STATUS on STRING.
2194 CCL-PROGRAM is a symbol registered by register-ccl-program,
2195 or a compiled code generated by `ccl-compile' (for backward compatibility,
2196 in this case, the execution is slower).
2198 Read buffer is set to STRING, and write buffer is allocated automatically.
2200 STATUS is a vector of [R0 R1 ... R7 IC], where
2201 R0..R7 are initial values of corresponding registers,
2202 IC is the instruction counter specifying from where to start the program.
2203 If R0..R7 are nil, they are initialized to 0.
2204 If IC is nil, it is initialized to head of the CCL program.
2206 If optional 4th arg CONTINUE is non-nil, keep IC on read operation
2207 when read buffer is exhausted, else, IC is always set to the end of
2208 CCL-PROGRAM on exit.
2210 It returns the contents of write buffer as a string,
2211 and as side effect, STATUS is updated.
2213 See the documentation of `define-ccl-program' for the detail of CCL program.
2215 (ccl_prog, status, string, continue_))
2218 struct ccl_program ccl;
2220 unsigned_char_dynarr *outbuf;
2221 struct gcpro gcpro1, gcpro2;
2223 if (setup_ccl_program(&ccl, ccl_prog) < 0)
2224 error("Invalid CCL program");
2226 CHECK_VECTOR(status);
2227 if (XVECTOR(status)->size != 9)
2228 error("Length of vector STATUS is not 9");
2229 CHECK_STRING(string);
2231 GCPRO2(status, string);
2233 for (i = 0; i < 8; i++) {
2234 if (NILP(XVECTOR_DATA(status)[i]))
2235 XSETINT(XVECTOR_DATA(status)[i], 0);
2236 if (INTP(XVECTOR_DATA(status)[i]))
2237 ccl.reg[i] = XINT(XVECTOR_DATA(status)[i]);
2239 if (INTP(XVECTOR(status)->contents[i])) {
2240 i = XINT(XVECTOR_DATA(status)[8]);
2241 if (ccl.ic < i && i < ccl.size)
2244 outbuf = Dynarr_new(unsigned_char);
2245 ccl.last_block = NILP(continue_);
2246 produced = ccl_driver(&ccl, XSTRING_DATA(string), outbuf,
2247 XSTRING_LENGTH(string),
2248 (int *)0, CCL_MODE_DECODING);
2249 for (i = 0; i < 8; i++)
2250 XSETINT(XVECTOR_DATA(status)[i], ccl.reg[i]);
2251 XSETINT(XVECTOR_DATA(status)[8], ccl.ic);
2254 val = make_string(Dynarr_atp(outbuf, 0), produced);
2255 Dynarr_free(outbuf);
2257 if (ccl.status == CCL_STAT_SUSPEND_BY_DST)
2258 error("Output buffer for the CCL programs overflow");
2259 if (ccl.status != CCL_STAT_SUCCESS
2260 && ccl.status != CCL_STAT_SUSPEND_BY_SRC)
2261 error("Error in CCL program at %dth code", ccl.ic);
2266 DEFUN("register-ccl-program", Fregister_ccl_program, 2, 2, 0, /*
2267 Register CCL program CCL-PROG as NAME in `ccl-program-table'.
2268 CCL-PROG should be a compiled CCL program (vector), or nil.
2269 If it is nil, just reserve NAME as a CCL program name.
2270 Return index number of the registered CCL program.
2274 int len = XVECTOR_LENGTH(Vccl_program_table);
2276 Lisp_Object resolved;
2280 if (!NILP(ccl_prog)) {
2281 CHECK_VECTOR(ccl_prog);
2282 resolved = resolve_symbol_ccl_program(ccl_prog);
2283 if (!NILP(resolved)) {
2284 ccl_prog = resolved;
2289 for (idx = 0; idx < len; idx++) {
2292 slot = XVECTOR_DATA(Vccl_program_table)[idx];
2294 /* This is the first unused slot. Register NAME here. */
2297 if (EQ(name, XVECTOR_DATA(slot)[0])) {
2298 /* Update this slot. */
2299 XVECTOR_DATA(slot)[1] = ccl_prog;
2300 XVECTOR_DATA(slot)[2] = resolved;
2301 return make_int(idx);
2306 /* Extend the table. */
2307 Lisp_Object new_table;
2310 new_table = Fmake_vector(make_int(len * 2), Qnil);
2311 for (j = 0; j < len; j++)
2312 XVECTOR_DATA(new_table)[j]
2313 = XVECTOR_DATA(Vccl_program_table)[j];
2314 Vccl_program_table = new_table;
2320 elt = Fmake_vector(make_int(3), Qnil);
2321 XVECTOR_DATA(elt)[0] = name;
2322 XVECTOR_DATA(elt)[1] = ccl_prog;
2323 XVECTOR_DATA(elt)[2] = resolved;
2324 XVECTOR_DATA(Vccl_program_table)[idx] = elt;
2327 Fput(name, Qccl_program_idx, make_int(idx));
2328 return make_int(idx);
2331 /* Register code conversion map.
2332 A code conversion map consists of numbers, Qt, Qnil, and Qlambda.
2333 The first element is start code point.
2334 The rest elements are mapped numbers.
2335 Symbol t means to map to an original number before mapping.
2336 Symbol nil means that the corresponding element is empty.
2337 Symbol lambda means to terminate mapping here.
2340 DEFUN("register-code-conversion-map", Fregister_code_conversion_map, 2, 2, 0, /*
2341 Register SYMBOL as code conversion map MAP.
2342 Return index number of the registered map.
2346 int len = XVECTOR_LENGTH(Vcode_conversion_map_vector);
2350 CHECK_SYMBOL(symbol);
2353 for (i = 0; i < len; i++) {
2354 Lisp_Object slot = XVECTOR_DATA(Vcode_conversion_map_vector)[i];
2359 if (EQ(symbol, XCAR(slot))) {
2362 Fput(symbol, Qcode_conversion_map, map);
2363 Fput(symbol, Qcode_conversion_map_id, idx);
2369 Lisp_Object new_vector = Fmake_vector(make_int(len * 2), Qnil);
2372 for (j = 0; j < len; j++)
2373 XVECTOR_DATA(new_vector)[j]
2374 = XVECTOR_DATA(Vcode_conversion_map_vector)[j];
2375 Vcode_conversion_map_vector = new_vector;
2379 Fput(symbol, Qcode_conversion_map, map);
2380 Fput(symbol, Qcode_conversion_map_id, idx);
2381 XVECTOR_DATA(Vcode_conversion_map_vector)[i] = Fcons(symbol, map);
2385 void syms_of_mule_ccl(void)
2387 DEFSUBR(Fccl_program_p);
2388 DEFSUBR(Fccl_execute);
2389 DEFSUBR(Fccl_execute_on_string);
2390 DEFSUBR(Fregister_ccl_program);
2391 DEFSUBR(Fregister_code_conversion_map);
2394 void vars_of_mule_ccl(void)
2396 staticpro(&Vccl_program_table);
2397 Vccl_program_table = Fmake_vector(make_int(32), Qnil);
2399 defsymbol(&Qccl_program, "ccl-program");
2400 defsymbol(&Qccl_program_idx, "ccl-program-idx");
2401 defsymbol(&Qcode_conversion_map, "code-conversion-map");
2402 defsymbol(&Qcode_conversion_map_id, "code-conversion-map-id");
2404 DEFVAR_LISP("code-conversion-map-vector", &Vcode_conversion_map_vector /*
2405 Vector of code conversion maps.
2407 Vcode_conversion_map_vector = Fmake_vector(make_int(16), Qnil);
2409 DEFVAR_LISP("font-ccl-encoder-alist", &Vfont_ccl_encoder_alist /*
2410 Alist of fontname patterns vs corresponding CCL program.
2411 Each element looks like (REGEXP . CCL-CODE),
2412 where CCL-CODE is a compiled CCL program.
2413 When a font whose name matches REGEXP is used for displaying a character,
2414 CCL-CODE is executed to calculate the code point in the font
2415 from the charset number and position code(s) of the character which are set
2416 in CCL registers R0, R1, and R2 before the execution.
2417 The code point in the font is set in CCL registers R1 and R2
2418 when the execution terminated.
2419 If the font is single-byte font, the register R2 is not used.
2421 Vfont_ccl_encoder_alist = Qnil;
projects / sxemacs / blob