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 GNU Emacs.
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)
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.
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. */
39 #endif /* not emacs */
41 /* This contains all code conversion map available to CCL. */
42 Lisp_Object Vcode_conversion_map_vector
;
44 /* Alist of fontname patterns vs corresponding CCL program. */
45 Lisp_Object Vfont_ccl_encoder_alist
;
47 /* This symbol is a property which assocates with ccl program vector.
48 Ex: (get 'ccl-big5-encoder 'ccl-program) returns ccl program vector. */
49 Lisp_Object Qccl_program
;
51 /* These symbols are properties which associate with code conversion
52 map and their ID respectively. */
53 Lisp_Object Qcode_conversion_map
;
54 Lisp_Object Qcode_conversion_map_id
;
56 /* Symbols of ccl program have this property, a value of the property
57 is an index for Vccl_protram_table. */
58 Lisp_Object Qccl_program_idx
;
60 /* Table of registered CCL programs. Each element is a vector of
61 NAME, CCL_PROG, and RESOLVEDP where NAME (symbol) is the name of
62 the program, CCL_PROG (vector) is the compiled code of the program,
63 RESOLVEDP (t or nil) is the flag to tell if symbols in CCL_PROG is
64 already resolved to index numbers or not. */
65 Lisp_Object Vccl_program_table
;
67 /* CCL (Code Conversion Language) is a simple language which has
68 operations on one input buffer, one output buffer, and 7 registers.
69 The syntax of CCL is described in `ccl.el'. Emacs Lisp function
70 `ccl-compile' compiles a CCL program and produces a CCL code which
71 is a vector of integers. The structure of this vector is as
72 follows: The 1st element: buffer-magnification, a factor for the
73 size of output buffer compared with the size of input buffer. The
74 2nd element: address of CCL code to be executed when encountered
75 with end of input stream. The 3rd and the remaining elements: CCL
78 /* Header of CCL compiled code */
79 #define CCL_HEADER_BUF_MAG 0
80 #define CCL_HEADER_EOF 1
81 #define CCL_HEADER_MAIN 2
83 /* CCL code is a sequence of 28-bit non-negative integers (i.e. the
84 MSB is always 0), each contains CCL command and/or arguments in the
87 |----------------- integer (28-bit) ------------------|
88 |------- 17-bit ------|- 3-bit --|- 3-bit --|- 5-bit -|
89 |--constant argument--|-register-|-register-|-command-|
90 ccccccccccccccccc RRR rrr XXXXX
92 |------- relative address -------|-register-|-command-|
93 cccccccccccccccccccc rrr XXXXX
95 |------------- constant or other args ----------------|
96 cccccccccccccccccccccccccccc
98 where, `cc...c' is a non-negative integer indicating constant value
99 (the left most `c' is always 0) or an absolute jump address, `RRR'
100 and `rrr' are CCL register number, `XXXXX' is one of the following
105 Each comment fields shows one or more lines for command syntax and
106 the following lines for semantics of the command. In semantics, IC
107 stands for Instruction Counter. */
109 #define CCL_SetRegister 0x00 /* Set register a register value:
110 1:00000000000000000RRRrrrXXXXX
111 ------------------------------
115 #define CCL_SetShortConst 0x01 /* Set register a short constant value:
116 1:CCCCCCCCCCCCCCCCCCCCrrrXXXXX
117 ------------------------------
118 reg[rrr] = CCCCCCCCCCCCCCCCCCC;
121 #define CCL_SetConst 0x02 /* Set register a constant value:
122 1:00000000000000000000rrrXXXXX
124 ------------------------------
129 #define CCL_SetArray 0x03 /* Set register an element of array:
130 1:CCCCCCCCCCCCCCCCCRRRrrrXXXXX
134 ------------------------------
135 if (0 <= reg[RRR] < CC..C)
136 reg[rrr] = ELEMENT[reg[RRR]];
140 #define CCL_Jump 0x04 /* Jump:
141 1:A--D--D--R--E--S--S-000XXXXX
142 ------------------------------
146 /* Note: If CC..C is greater than 0, the second code is omitted. */
148 #define CCL_JumpCond 0x05 /* Jump conditional:
149 1:A--D--D--R--E--S--S-rrrXXXXX
150 ------------------------------
156 #define CCL_WriteRegisterJump 0x06 /* Write register and jump:
157 1:A--D--D--R--E--S--S-rrrXXXXX
158 ------------------------------
163 #define CCL_WriteRegisterReadJump 0x07 /* Write register, read, and jump:
164 1:A--D--D--R--E--S--S-rrrXXXXX
165 2:A--D--D--R--E--S--S-rrrYYYYY
166 -----------------------------
172 /* Note: If read is suspended, the resumed execution starts from the
173 second code (YYYYY == CCL_ReadJump). */
175 #define CCL_WriteConstJump 0x08 /* Write constant and jump:
176 1:A--D--D--R--E--S--S-000XXXXX
178 ------------------------------
183 #define CCL_WriteConstReadJump 0x09 /* Write constant, read, and jump:
184 1:A--D--D--R--E--S--S-rrrXXXXX
186 3:A--D--D--R--E--S--S-rrrYYYYY
187 -----------------------------
193 /* Note: If read is suspended, the resumed execution starts from the
194 second code (YYYYY == CCL_ReadJump). */
196 #define CCL_WriteStringJump 0x0A /* Write string and jump:
197 1:A--D--D--R--E--S--S-000XXXXX
199 3:0000STRIN[0]STRIN[1]STRIN[2]
201 ------------------------------
202 write_string (STRING, LENGTH);
206 #define CCL_WriteArrayReadJump 0x0B /* Write an array element, read, and jump:
207 1:A--D--D--R--E--S--S-rrrXXXXX
212 N:A--D--D--R--E--S--S-rrrYYYYY
213 ------------------------------
214 if (0 <= reg[rrr] < LENGTH)
215 write (ELEMENT[reg[rrr]]);
216 IC += LENGTH + 2; (... pointing at N+1)
220 /* Note: If read is suspended, the resumed execution starts from the
221 Nth code (YYYYY == CCL_ReadJump). */
223 #define CCL_ReadJump 0x0C /* Read and jump:
224 1:A--D--D--R--E--S--S-rrrYYYYY
225 -----------------------------
230 #define CCL_Branch 0x0D /* Jump by branch table:
231 1:CCCCCCCCCCCCCCCCCCCCrrrXXXXX
232 2:A--D--D--R--E-S-S[0]000XXXXX
233 3:A--D--D--R--E-S-S[1]000XXXXX
235 ------------------------------
236 if (0 <= reg[rrr] < CC..C)
237 IC += ADDRESS[reg[rrr]];
239 IC += ADDRESS[CC..C];
242 #define CCL_ReadRegister 0x0E /* Read bytes into registers:
243 1:CCCCCCCCCCCCCCCCCCCCrrrXXXXX
244 2:CCCCCCCCCCCCCCCCCCCCrrrXXXXX
246 ------------------------------
251 #define CCL_WriteExprConst 0x0F /* write result of expression:
252 1:00000OPERATION000RRR000XXXXX
254 ------------------------------
255 write (reg[RRR] OPERATION CONSTANT);
259 /* Note: If the Nth read is suspended, the resumed execution starts
260 from the Nth code. */
262 #define CCL_ReadBranch 0x10 /* Read one byte into a register,
263 and jump by branch table:
264 1:CCCCCCCCCCCCCCCCCCCCrrrXXXXX
265 2:A--D--D--R--E-S-S[0]000XXXXX
266 3:A--D--D--R--E-S-S[1]000XXXXX
268 ------------------------------
270 if (0 <= reg[rrr] < CC..C)
271 IC += ADDRESS[reg[rrr]];
273 IC += ADDRESS[CC..C];
276 #define CCL_WriteRegister 0x11 /* Write registers:
277 1:CCCCCCCCCCCCCCCCCCCrrrXXXXX
278 2:CCCCCCCCCCCCCCCCCCCrrrXXXXX
280 ------------------------------
286 /* Note: If the Nth write is suspended, the resumed execution
287 starts from the Nth code. */
289 #define CCL_WriteExprRegister 0x12 /* Write result of expression
290 1:00000OPERATIONRrrRRR000XXXXX
291 ------------------------------
292 write (reg[RRR] OPERATION reg[Rrr]);
295 #define CCL_Call 0x13 /* Call the CCL program whose ID is
297 1:CCCCCCCCCCCCCCCCCCCCFFFXXXXX
298 [2:00000000cccccccccccccccccccc]
299 ------------------------------
307 #define CCL_WriteConstString 0x14 /* Write a constant or a string:
308 1:CCCCCCCCCCCCCCCCCCCCrrrXXXXX
309 [2:0000STRIN[0]STRIN[1]STRIN[2]]
311 -----------------------------
315 write_string (STRING, CC..C);
316 IC += (CC..C + 2) / 3;
319 #define CCL_WriteArray 0x15 /* Write an element of array:
320 1:CCCCCCCCCCCCCCCCCCCCrrrXXXXX
324 ------------------------------
325 if (0 <= reg[rrr] < CC..C)
326 write (ELEMENT[reg[rrr]]);
330 #define CCL_End 0x16 /* Terminate:
331 1:00000000000000000000000XXXXX
332 ------------------------------
336 /* The following two codes execute an assignment arithmetic/logical
337 operation. The form of the operation is like REG OP= OPERAND. */
339 #define CCL_ExprSelfConst 0x17 /* REG OP= constant:
340 1:00000OPERATION000000rrrXXXXX
342 ------------------------------
343 reg[rrr] OPERATION= CONSTANT;
346 #define CCL_ExprSelfReg 0x18 /* REG1 OP= REG2:
347 1:00000OPERATION000RRRrrrXXXXX
348 ------------------------------
349 reg[rrr] OPERATION= reg[RRR];
352 /* The following codes execute an arithmetic/logical operation. The
353 form of the operation is like REG_X = REG_Y OP OPERAND2. */
355 #define CCL_SetExprConst 0x19 /* REG_X = REG_Y OP constant:
356 1:00000OPERATION000RRRrrrXXXXX
358 ------------------------------
359 reg[rrr] = reg[RRR] OPERATION CONSTANT;
363 #define CCL_SetExprReg 0x1A /* REG1 = REG2 OP REG3:
364 1:00000OPERATIONRrrRRRrrrXXXXX
365 ------------------------------
366 reg[rrr] = reg[RRR] OPERATION reg[Rrr];
369 #define CCL_JumpCondExprConst 0x1B /* Jump conditional according to
370 an operation on constant:
371 1:A--D--D--R--E--S--S-rrrXXXXX
374 -----------------------------
375 reg[7] = reg[rrr] OPERATION CONSTANT;
382 #define CCL_JumpCondExprReg 0x1C /* Jump conditional according to
383 an operation on register:
384 1:A--D--D--R--E--S--S-rrrXXXXX
387 -----------------------------
388 reg[7] = reg[rrr] OPERATION reg[RRR];
395 #define CCL_ReadJumpCondExprConst 0x1D /* Read and jump conditional according
396 to an operation on constant:
397 1:A--D--D--R--E--S--S-rrrXXXXX
400 -----------------------------
402 reg[7] = reg[rrr] OPERATION CONSTANT;
409 #define CCL_ReadJumpCondExprReg 0x1E /* Read and jump conditional according
410 to an operation on register:
411 1:A--D--D--R--E--S--S-rrrXXXXX
414 -----------------------------
416 reg[7] = reg[rrr] OPERATION reg[RRR];
423 #define CCL_Extension 0x1F /* Extended CCL code
424 1:ExtendedCOMMNDRrrRRRrrrXXXXX
427 ------------------------------
428 extended_command (rrr,RRR,Rrr,ARGS)
432 Here after, Extended CCL Instructions.
433 Bit length of extended command is 14.
434 Therefore, the instruction code range is 0..16384(0x3fff).
437 /* Read a multibyte characeter.
438 A code point is stored into reg[rrr]. A charset ID is stored into
441 #define CCL_ReadMultibyteChar2 0x00 /* Read Multibyte Character
442 1:ExtendedCOMMNDRrrRRRrrrXXXXX */
444 /* Write a multibyte character.
445 Write a character whose code point is reg[rrr] and the charset ID
448 #define CCL_WriteMultibyteChar2 0x01 /* Write Multibyte Character
449 1:ExtendedCOMMNDRrrRRRrrrXXXXX */
451 /* Translate a character whose code point is reg[rrr] and the charset
452 ID is reg[RRR] by a translation table whose ID is reg[Rrr].
454 A translated character is set in reg[rrr] (code point) and reg[RRR]
457 #define CCL_TranslateCharacter 0x02 /* Translate a multibyte character
458 1:ExtendedCOMMNDRrrRRRrrrXXXXX */
460 /* Translate a character whose code point is reg[rrr] and the charset
461 ID is reg[RRR] by a translation table whose ID is ARGUMENT.
463 A translated character is set in reg[rrr] (code point) and reg[RRR]
466 #define CCL_TranslateCharacterConstTbl 0x03 /* Translate a multibyte character
467 1:ExtendedCOMMNDRrrRRRrrrXXXXX
468 2:ARGUMENT(Translation Table ID)
471 /* Iterate looking up MAPs for reg[rrr] starting from the Nth (N =
472 reg[RRR]) MAP until some value is found.
474 Each MAP is a Lisp vector whose element is number, nil, t, or
476 If the element is nil, ignore the map and proceed to the next map.
477 If the element is t or lambda, finish without changing reg[rrr].
478 If the element is a number, set reg[rrr] to the number and finish.
480 Detail of the map structure is descibed in the comment for
481 CCL_MapMultiple below. */
483 #define CCL_IterateMultipleMap 0x10 /* Iterate multiple maps
484 1:ExtendedCOMMNDXXXRRRrrrXXXXX
491 /* Map the code in reg[rrr] by MAPs starting from the Nth (N =
494 MAPs are supplied in the succeeding CCL codes as follows:
496 When CCL program gives this nested structure of map to this command:
499 (MAP-ID121 MAP-ID122 MAP-ID123)
502 (MAP-ID211 (MAP-ID2111) MAP-ID212)
504 the compiled CCL codes has this sequence:
505 CCL_MapMultiple (CCL code of this command)
506 16 (total number of MAPs and SEPARATORs)
524 A value of each SEPARATOR follows this rule:
525 MAP-SET := SEPARATOR [(MAP-ID | MAP-SET)]+
526 SEPARATOR := -(number of MAP-IDs and SEPARATORs in the MAP-SET)
528 (*)....Nest level of MAP-SET must not be over than MAX_MAP_SET_LEVEL.
530 When some map fails to map (i.e. it doesn't have a value for
531 reg[rrr]), the mapping is treated as identity.
533 The mapping is iterated for all maps in each map set (set of maps
534 separated by SEPARATOR) except in the case that lambda is
535 encountered. More precisely, the mapping proceeds as below:
537 At first, VAL0 is set to reg[rrr], and it is translated by the
538 first map to VAL1. Then, VAL1 is translated by the next map to
539 VAL2. This mapping is iterated until the last map is used. The
540 result of the mapping is the last value of VAL?. When the mapping
541 process reached to the end of the map set, it moves to the next
542 map set. If the next does not exit, the mapping process terminates,
543 and regard the last value as a result.
545 But, when VALm is mapped to VALn and VALn is not a number, the
546 mapping proceed as below:
548 If VALn is nil, the lastest map is ignored and the mapping of VALm
549 proceed to the next map.
551 In VALn is t, VALm is reverted to reg[rrr] and the mapping of VALm
552 proceed to the next map.
554 If VALn is lambda, move to the next map set like reaching to the
555 end of the current map set.
557 If VALn is a symbol, call the CCL program refered by it.
558 Then, use reg[rrr] as a mapped value except for -1, -2 and -3.
559 Such special values are regarded as nil, t, and lambda respectively.
561 Each map is a Lisp vector of the following format (a) or (b):
562 (a)......[STARTPOINT VAL1 VAL2 ...]
563 (b)......[t VAL STARTPOINT ENDPOINT],
565 STARTPOINT is an offset to be used for indexing a map,
566 ENDPOINT is a maximum index number of a map,
567 VAL and VALn is a number, nil, t, or lambda.
569 Valid index range of a map of type (a) is:
570 STARTPOINT <= index < STARTPOINT + map_size - 1
571 Valid index range of a map of type (b) is:
572 STARTPOINT <= index < ENDPOINT */
574 #define CCL_MapMultiple 0x11 /* Mapping by multiple code conversion maps
575 1:ExtendedCOMMNDXXXRRRrrrXXXXX
587 #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) \
619 struct ccl_program called_ccl; \
620 if (stack_idx >= 256 \
621 || (setup_ccl_program (&called_ccl, (symbol)) != 0)) \
625 ccl_prog = ccl_prog_stack_struct[0].ccl_prog; \
626 ic = ccl_prog_stack_struct[0].ic; \
630 ccl_prog_stack_struct[stack_idx].ccl_prog = ccl_prog; \
631 ccl_prog_stack_struct[stack_idx].ic = (ret_ic); \
633 ccl_prog = called_ccl.prog; \
634 ic = CCL_HEADER_MAIN; \
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 \
680 ccl->status = CCL_STAT_SUCCESS; \
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) \
692 ccl->status = stat; \
697 /* Terminate CCL program because of invalid command. Should not occur
698 in the normal case. */
699 #define CCL_INVALID_CMD \
702 ccl->status = CCL_STAT_INVALID_CMD; \
703 goto ccl_error_handler; \
707 /* Encode one character CH to multibyte form and write to the current
708 output buffer. If CH is less than 256, CH is written as is. */
709 #define CCL_WRITE_CHAR(ch) \
711 int bytes = SINGLE_BYTE_CHAR_P (ch) ? 1: CHAR_BYTES (ch); \
714 else if (dst + bytes + extra_bytes < (dst_bytes ? dst_end : src)) \
719 if ((ch) >= 0x80 && (ch) < 0xA0) \
720 /* We may have to convert this eight-bit char to \
721 multibyte form later. */ \
724 else if (CHAR_VALID_P (ch, 0)) \
725 dst += CHAR_STRING (ch, dst); \
730 CCL_SUSPEND (CCL_STAT_SUSPEND_BY_DST); \
733 /* Write a string at ccl_prog[IC] of length LEN to the current output
735 #define CCL_WRITE_STRING(len) \
739 else if (dst + len <= (dst_bytes ? dst_end : src)) \
740 for (i = 0; i < len; i++) \
741 *dst++ = ((XFASTINT (ccl_prog[ic + (i / 3)])) \
742 >> ((2 - (i % 3)) * 8)) & 0xFF; \
744 CCL_SUSPEND (CCL_STAT_SUSPEND_BY_DST); \
747 /* Read one byte from the current input buffer into REGth register. */
748 #define CCL_READ_CHAR(REG) \
752 else if (src < src_end) \
756 && ccl->eol_type != CODING_EOL_LF) \
758 /* We are encoding. */ \
759 if (ccl->eol_type == CODING_EOL_CRLF) \
761 if (ccl->cr_consumed) \
762 ccl->cr_consumed = 0; \
765 ccl->cr_consumed = 1; \
773 if (REG == LEADING_CODE_8_BIT_CONTROL \
775 REG = *src++ - 0x20; \
777 else if (ccl->last_block) \
783 CCL_SUSPEND (CCL_STAT_SUSPEND_BY_SRC); \
787 /* Set C to the character code made from CHARSET and CODE. This is
788 like MAKE_CHAR but check the validity of CHARSET and CODE. If they
789 are not valid, set C to (CODE & 0xFF) because that is usually the
790 case that CCL_ReadMultibyteChar2 read an invalid code and it set
791 CODE to that invalid byte. */
793 #define CCL_MAKE_CHAR(charset, code, c) \
795 if (charset == CHARSET_ASCII) \
797 else if (CHARSET_DEFINED_P (charset) \
798 && (code & 0x7F) >= 32 \
799 && (code < 256 || ((code >> 7) & 0x7F) >= 32)) \
801 int c1 = code & 0x7F, c2 = 0; \
804 c2 = c1, c1 = (code >> 7) & 0x7F; \
805 c = MAKE_CHAR (charset, c1, c2); \
812 /* Execute CCL code on SRC_BYTES length text at SOURCE. The resulting
813 text goes to a place pointed by DESTINATION, the length of which
814 should not exceed DST_BYTES. The bytes actually processed is
815 returned as *CONSUMED. The return value is the length of the
816 resulting text. As a side effect, the contents of CCL registers
817 are updated. If SOURCE or DESTINATION is NULL, only operations on
818 registers are permitted. */
821 #define CCL_DEBUG_BACKTRACE_LEN 256
822 int ccl_backtrace_table
[CCL_BACKTRACE_TABLE
];
823 int ccl_backtrace_idx
;
826 struct ccl_prog_stack
828 Lisp_Object
*ccl_prog
; /* Pointer to an array of CCL code. */
829 int ic
; /* Instruction Counter. */
832 /* For the moment, we only support depth 256 of stack. */
833 static struct ccl_prog_stack ccl_prog_stack_struct
[256];
836 ccl_driver (ccl
, source
, destination
, src_bytes
, dst_bytes
, consumed
)
837 struct ccl_program
*ccl
;
838 unsigned char *source
, *destination
;
839 int src_bytes
, dst_bytes
;
842 register int *reg
= ccl
->reg
;
843 register int ic
= ccl
->ic
;
844 register int code
, field1
, field2
;
845 register Lisp_Object
*ccl_prog
= ccl
->prog
;
846 unsigned char *src
= source
, *src_end
= src
+ src_bytes
;
847 unsigned char *dst
= destination
, *dst_end
= dst
+ dst_bytes
;
850 int stack_idx
= ccl
->stack_idx
;
851 /* Instruction counter of the current CCL code. */
853 /* CCL_WRITE_CHAR will produce 8-bit code of range 0x80..0x9F. But,
854 each of them will be converted to multibyte form of 2-byte
855 sequence. For that conversion, we remember how many more bytes
856 we must keep in DESTINATION in this variable. */
859 if (ic
>= ccl
->eof_ic
)
860 ic
= CCL_HEADER_MAIN
;
862 if (ccl
->buf_magnification
==0) /* We can't produce any bytes. */
865 /* Set mapping stack pointer. */
866 mapping_stack_pointer
= mapping_stack
;
869 ccl_backtrace_idx
= 0;
876 ccl_backtrace_table
[ccl_backtrace_idx
++] = ic
;
877 if (ccl_backtrace_idx
>= CCL_DEBUG_BACKTRACE_LEN
)
878 ccl_backtrace_idx
= 0;
879 ccl_backtrace_table
[ccl_backtrace_idx
] = 0;
882 if (!NILP (Vquit_flag
) && NILP (Vinhibit_quit
))
884 /* We can't just signal Qquit, instead break the loop as if
885 the whole data is processed. Don't reset Vquit_flag, it
886 must be handled later at a safer place. */
888 src
= source
+ src_bytes
;
889 ccl
->status
= CCL_STAT_QUIT
;
894 code
= XINT (ccl_prog
[ic
]); ic
++;
896 field2
= (code
& 0xFF) >> 5;
899 #define RRR (field1 & 7)
900 #define Rrr ((field1 >> 3) & 7)
902 #define EXCMD (field1 >> 6)
906 case CCL_SetRegister
: /* 00000000000000000RRRrrrXXXXX */
910 case CCL_SetShortConst
: /* CCCCCCCCCCCCCCCCCCCCrrrXXXXX */
914 case CCL_SetConst
: /* 00000000000000000000rrrXXXXX */
915 reg
[rrr
] = XINT (ccl_prog
[ic
]);
919 case CCL_SetArray
: /* CCCCCCCCCCCCCCCCCCCCRRRrrrXXXXX */
922 if ((unsigned int) i
< j
)
923 reg
[rrr
] = XINT (ccl_prog
[ic
+ i
]);
927 case CCL_Jump
: /* A--D--D--R--E--S--S-000XXXXX */
931 case CCL_JumpCond
: /* A--D--D--R--E--S--S-rrrXXXXX */
936 case CCL_WriteRegisterJump
: /* A--D--D--R--E--S--S-rrrXXXXX */
942 case CCL_WriteRegisterReadJump
: /* A--D--D--R--E--S--S-rrrXXXXX */
946 CCL_READ_CHAR (reg
[rrr
]);
950 case CCL_WriteConstJump
: /* A--D--D--R--E--S--S-000XXXXX */
951 i
= XINT (ccl_prog
[ic
]);
956 case CCL_WriteConstReadJump
: /* A--D--D--R--E--S--S-rrrXXXXX */
957 i
= XINT (ccl_prog
[ic
]);
960 CCL_READ_CHAR (reg
[rrr
]);
964 case CCL_WriteStringJump
: /* A--D--D--R--E--S--S-000XXXXX */
965 j
= XINT (ccl_prog
[ic
]);
967 CCL_WRITE_STRING (j
);
971 case CCL_WriteArrayReadJump
: /* A--D--D--R--E--S--S-rrrXXXXX */
973 j
= XINT (ccl_prog
[ic
]);
974 if ((unsigned int) i
< j
)
976 i
= XINT (ccl_prog
[ic
+ 1 + i
]);
980 CCL_READ_CHAR (reg
[rrr
]);
981 ic
+= ADDR
- (j
+ 2);
984 case CCL_ReadJump
: /* A--D--D--R--E--S--S-rrrYYYYY */
985 CCL_READ_CHAR (reg
[rrr
]);
989 case CCL_ReadBranch
: /* CCCCCCCCCCCCCCCCCCCCrrrXXXXX */
990 CCL_READ_CHAR (reg
[rrr
]);
991 /* fall through ... */
992 case CCL_Branch
: /* CCCCCCCCCCCCCCCCCCCCrrrXXXXX */
993 if ((unsigned int) reg
[rrr
] < field1
)
994 ic
+= XINT (ccl_prog
[ic
+ reg
[rrr
]]);
996 ic
+= XINT (ccl_prog
[ic
+ field1
]);
999 case CCL_ReadRegister
: /* CCCCCCCCCCCCCCCCCCCCrrXXXXX */
1002 CCL_READ_CHAR (reg
[rrr
]);
1004 code
= XINT (ccl_prog
[ic
]); ic
++;
1006 field2
= (code
& 0xFF) >> 5;
1010 case CCL_WriteExprConst
: /* 1:00000OPERATION000RRR000XXXXX */
1013 j
= XINT (ccl_prog
[ic
]);
1015 jump_address
= ic
+ 1;
1018 case CCL_WriteRegister
: /* CCCCCCCCCCCCCCCCCCCrrrXXXXX */
1024 code
= XINT (ccl_prog
[ic
]); ic
++;
1026 field2
= (code
& 0xFF) >> 5;
1030 case CCL_WriteExprRegister
: /* 1:00000OPERATIONRrrRRR000XXXXX */
1038 case CCL_Call
: /* 1:CCCCCCCCCCCCCCCCCCCCFFFXXXXX */
1043 /* If FFF is nonzero, the CCL program ID is in the
1047 prog_id
= XINT (ccl_prog
[ic
]);
1053 if (stack_idx
>= 256
1055 || prog_id
>= XVECTOR (Vccl_program_table
)->size
1056 || (slot
= XVECTOR (Vccl_program_table
)->contents
[prog_id
],
1058 || !VECTORP (XVECTOR (slot
)->contents
[1]))
1062 ccl_prog
= ccl_prog_stack_struct
[0].ccl_prog
;
1063 ic
= ccl_prog_stack_struct
[0].ic
;
1068 ccl_prog_stack_struct
[stack_idx
].ccl_prog
= ccl_prog
;
1069 ccl_prog_stack_struct
[stack_idx
].ic
= ic
;
1071 ccl_prog
= XVECTOR (XVECTOR (slot
)->contents
[1])->contents
;
1072 ic
= CCL_HEADER_MAIN
;
1076 case CCL_WriteConstString
: /* CCCCCCCCCCCCCCCCCCCCrrrXXXXX */
1078 CCL_WRITE_CHAR (field1
);
1081 CCL_WRITE_STRING (field1
);
1082 ic
+= (field1
+ 2) / 3;
1086 case CCL_WriteArray
: /* CCCCCCCCCCCCCCCCCCCCrrrXXXXX */
1088 if ((unsigned int) i
< field1
)
1090 j
= XINT (ccl_prog
[ic
+ i
]);
1096 case CCL_End
: /* 0000000000000000000000XXXXX */
1100 ccl_prog
= ccl_prog_stack_struct
[stack_idx
].ccl_prog
;
1101 ic
= ccl_prog_stack_struct
[stack_idx
].ic
;
1106 /* ccl->ic should points to this command code again to
1107 suppress further processing. */
1111 case CCL_ExprSelfConst
: /* 00000OPERATION000000rrrXXXXX */
1112 i
= XINT (ccl_prog
[ic
]);
1117 case CCL_ExprSelfReg
: /* 00000OPERATION000RRRrrrXXXXX */
1124 case CCL_PLUS
: reg
[rrr
] += i
; break;
1125 case CCL_MINUS
: reg
[rrr
] -= i
; break;
1126 case CCL_MUL
: reg
[rrr
] *= i
; break;
1127 case CCL_DIV
: reg
[rrr
] /= i
; break;
1128 case CCL_MOD
: reg
[rrr
] %= i
; break;
1129 case CCL_AND
: reg
[rrr
] &= i
; break;
1130 case CCL_OR
: reg
[rrr
] |= i
; break;
1131 case CCL_XOR
: reg
[rrr
] ^= i
; break;
1132 case CCL_LSH
: reg
[rrr
] <<= i
; break;
1133 case CCL_RSH
: reg
[rrr
] >>= i
; break;
1134 case CCL_LSH8
: reg
[rrr
] <<= 8; reg
[rrr
] |= i
; break;
1135 case CCL_RSH8
: reg
[7] = reg
[rrr
] & 0xFF; reg
[rrr
] >>= 8; break;
1136 case CCL_DIVMOD
: reg
[7] = reg
[rrr
] % i
; reg
[rrr
] /= i
; break;
1137 case CCL_LS
: reg
[rrr
] = reg
[rrr
] < i
; break;
1138 case CCL_GT
: reg
[rrr
] = reg
[rrr
] > i
; break;
1139 case CCL_EQ
: reg
[rrr
] = reg
[rrr
] == i
; break;
1140 case CCL_LE
: reg
[rrr
] = reg
[rrr
] <= i
; break;
1141 case CCL_GE
: reg
[rrr
] = reg
[rrr
] >= i
; break;
1142 case CCL_NE
: reg
[rrr
] = reg
[rrr
] != i
; break;
1143 default: CCL_INVALID_CMD
;
1147 case CCL_SetExprConst
: /* 00000OPERATION000RRRrrrXXXXX */
1149 j
= XINT (ccl_prog
[ic
]);
1151 jump_address
= ++ic
;
1154 case CCL_SetExprReg
: /* 00000OPERATIONRrrRRRrrrXXXXX */
1161 case CCL_ReadJumpCondExprConst
: /* A--D--D--R--E--S--S-rrrXXXXX */
1162 CCL_READ_CHAR (reg
[rrr
]);
1163 case CCL_JumpCondExprConst
: /* A--D--D--R--E--S--S-rrrXXXXX */
1165 op
= XINT (ccl_prog
[ic
]);
1166 jump_address
= ic
++ + ADDR
;
1167 j
= XINT (ccl_prog
[ic
]);
1172 case CCL_ReadJumpCondExprReg
: /* A--D--D--R--E--S--S-rrrXXXXX */
1173 CCL_READ_CHAR (reg
[rrr
]);
1174 case CCL_JumpCondExprReg
:
1176 op
= XINT (ccl_prog
[ic
]);
1177 jump_address
= ic
++ + ADDR
;
1178 j
= reg
[XINT (ccl_prog
[ic
])];
1185 case CCL_PLUS
: reg
[rrr
] = i
+ j
; break;
1186 case CCL_MINUS
: reg
[rrr
] = i
- j
; break;
1187 case CCL_MUL
: reg
[rrr
] = i
* j
; break;
1188 case CCL_DIV
: reg
[rrr
] = i
/ j
; break;
1189 case CCL_MOD
: reg
[rrr
] = i
% j
; break;
1190 case CCL_AND
: reg
[rrr
] = i
& j
; break;
1191 case CCL_OR
: reg
[rrr
] = i
| j
; break;
1192 case CCL_XOR
: reg
[rrr
] = i
^ j
;; break;
1193 case CCL_LSH
: reg
[rrr
] = i
<< j
; break;
1194 case CCL_RSH
: reg
[rrr
] = i
>> j
; break;
1195 case CCL_LSH8
: reg
[rrr
] = (i
<< 8) | j
; break;
1196 case CCL_RSH8
: reg
[rrr
] = i
>> 8; reg
[7] = i
& 0xFF; break;
1197 case CCL_DIVMOD
: reg
[rrr
] = i
/ j
; reg
[7] = i
% j
; break;
1198 case CCL_LS
: reg
[rrr
] = i
< j
; break;
1199 case CCL_GT
: reg
[rrr
] = i
> j
; break;
1200 case CCL_EQ
: reg
[rrr
] = i
== j
; break;
1201 case CCL_LE
: reg
[rrr
] = i
<= j
; break;
1202 case CCL_GE
: reg
[rrr
] = i
>= j
; break;
1203 case CCL_NE
: reg
[rrr
] = i
!= j
; break;
1204 case CCL_DECODE_SJIS
: DECODE_SJIS (i
, j
, reg
[rrr
], reg
[7]); break;
1205 case CCL_ENCODE_SJIS
: ENCODE_SJIS (i
, j
, reg
[rrr
], reg
[7]); break;
1206 default: CCL_INVALID_CMD
;
1209 if (code
== CCL_WriteExprConst
|| code
== CCL_WriteExprRegister
)
1222 case CCL_ReadMultibyteChar2
:
1229 goto ccl_read_multibyte_character_suspend
;
1233 if (i
== '\n' && ccl
->eol_type
!= CODING_EOL_LF
)
1235 /* We are encoding. */
1236 if (ccl
->eol_type
== CODING_EOL_CRLF
)
1238 if (ccl
->cr_consumed
)
1239 ccl
->cr_consumed
= 0;
1242 ccl
->cr_consumed
= 1;
1250 reg
[RRR
] = CHARSET_ASCII
;
1256 reg
[RRR
] = CHARSET_ASCII
;
1258 else if (i
<= MAX_CHARSET_OFFICIAL_DIMENSION1
)
1261 goto ccl_read_multibyte_character_suspend
;
1263 reg
[rrr
] = (*src
++ & 0x7F);
1265 else if (i
<= MAX_CHARSET_OFFICIAL_DIMENSION2
)
1267 if ((src
+ 1) >= src_end
)
1268 goto ccl_read_multibyte_character_suspend
;
1270 i
= (*src
++ & 0x7F);
1271 reg
[rrr
] = ((i
<< 7) | (*src
& 0x7F));
1274 else if ((i
== LEADING_CODE_PRIVATE_11
)
1275 || (i
== LEADING_CODE_PRIVATE_12
))
1277 if ((src
+ 1) >= src_end
)
1278 goto ccl_read_multibyte_character_suspend
;
1280 reg
[rrr
] = (*src
++ & 0x7F);
1282 else if ((i
== LEADING_CODE_PRIVATE_21
)
1283 || (i
== LEADING_CODE_PRIVATE_22
))
1285 if ((src
+ 2) >= src_end
)
1286 goto ccl_read_multibyte_character_suspend
;
1288 i
= (*src
++ & 0x7F);
1289 reg
[rrr
] = ((i
<< 7) | (*src
& 0x7F));
1292 else if (i
== LEADING_CODE_8_BIT_CONTROL
)
1295 goto ccl_read_multibyte_character_suspend
;
1296 reg
[RRR
] = CHARSET_8_BIT_CONTROL
;
1297 reg
[rrr
] = (*src
++ - 0x20);
1301 reg
[RRR
] = CHARSET_8_BIT_GRAPHIC
;
1306 /* INVALID CODE. Return a single byte character. */
1307 reg
[RRR
] = CHARSET_ASCII
;
1312 ccl_read_multibyte_character_suspend
:
1314 if (ccl
->last_block
)
1320 CCL_SUSPEND (CCL_STAT_SUSPEND_BY_SRC
);
1324 case CCL_WriteMultibyteChar2
:
1325 i
= reg
[RRR
]; /* charset */
1326 if (i
== CHARSET_ASCII
1327 || i
== CHARSET_8_BIT_CONTROL
1328 || i
== CHARSET_8_BIT_GRAPHIC
)
1329 i
= reg
[rrr
] & 0xFF;
1330 else if (CHARSET_DIMENSION (i
) == 1)
1331 i
= ((i
- 0x70) << 7) | (reg
[rrr
] & 0x7F);
1332 else if (i
< MIN_CHARSET_PRIVATE_DIMENSION2
)
1333 i
= ((i
- 0x8F) << 14) | reg
[rrr
];
1335 i
= ((i
- 0xE0) << 14) | reg
[rrr
];
1341 case CCL_TranslateCharacter
:
1342 CCL_MAKE_CHAR (reg
[RRR
], reg
[rrr
], i
);
1343 op
= translate_char (GET_TRANSLATION_TABLE (reg
[Rrr
]),
1345 SPLIT_CHAR (op
, reg
[RRR
], i
, j
);
1352 case CCL_TranslateCharacterConstTbl
:
1353 op
= XINT (ccl_prog
[ic
]); /* table */
1355 CCL_MAKE_CHAR (reg
[RRR
], reg
[rrr
], i
);
1356 op
= translate_char (GET_TRANSLATION_TABLE (op
), i
, -1, 0, 0);
1357 SPLIT_CHAR (op
, reg
[RRR
], i
, j
);
1364 case CCL_IterateMultipleMap
:
1366 Lisp_Object map
, content
, attrib
, value
;
1367 int point
, size
, fin_ic
;
1369 j
= XINT (ccl_prog
[ic
++]); /* number of maps. */
1372 if ((j
> reg
[RRR
]) && (j
>= 0))
1387 size
= XVECTOR (Vcode_conversion_map_vector
)->size
;
1388 point
= XINT (ccl_prog
[ic
++]);
1389 if (point
>= size
) continue;
1391 XVECTOR (Vcode_conversion_map_vector
)->contents
[point
];
1393 /* Check map varidity. */
1394 if (!CONSP (map
)) continue;
1396 if (!VECTORP (map
)) continue;
1397 size
= XVECTOR (map
)->size
;
1398 if (size
<= 1) continue;
1400 content
= XVECTOR (map
)->contents
[0];
1403 [STARTPOINT VAL1 VAL2 ...] or
1404 [t ELELMENT STARTPOINT ENDPOINT] */
1405 if (NUMBERP (content
))
1407 point
= XUINT (content
);
1408 point
= op
- point
+ 1;
1409 if (!((point
>= 1) && (point
< size
))) continue;
1410 content
= XVECTOR (map
)->contents
[point
];
1412 else if (EQ (content
, Qt
))
1414 if (size
!= 4) continue;
1415 if ((op
>= XUINT (XVECTOR (map
)->contents
[2]))
1416 && (op
< XUINT (XVECTOR (map
)->contents
[3])))
1417 content
= XVECTOR (map
)->contents
[1];
1426 else if (NUMBERP (content
))
1429 reg
[rrr
] = XINT(content
);
1432 else if (EQ (content
, Qt
) || EQ (content
, Qlambda
))
1437 else if (CONSP (content
))
1439 attrib
= XCAR (content
);
1440 value
= XCDR (content
);
1441 if (!NUMBERP (attrib
) || !NUMBERP (value
))
1444 reg
[rrr
] = XUINT (value
);
1447 else if (SYMBOLP (content
))
1448 CCL_CALL_FOR_MAP_INSTRUCTION (content
, fin_ic
);
1458 case CCL_MapMultiple
:
1460 Lisp_Object map
, content
, attrib
, value
;
1461 int point
, size
, map_vector_size
;
1462 int map_set_rest_length
, fin_ic
;
1463 int current_ic
= this_ic
;
1465 /* inhibit recursive call on MapMultiple. */
1466 if (stack_idx_of_map_multiple
> 0)
1468 if (stack_idx_of_map_multiple
<= stack_idx
)
1470 stack_idx_of_map_multiple
= 0;
1471 mapping_stack_pointer
= mapping_stack
;
1476 mapping_stack_pointer
= mapping_stack
;
1477 stack_idx_of_map_multiple
= 0;
1479 map_set_rest_length
=
1480 XINT (ccl_prog
[ic
++]); /* number of maps and separators. */
1481 fin_ic
= ic
+ map_set_rest_length
;
1484 if ((map_set_rest_length
> reg
[RRR
]) && (reg
[RRR
] >= 0))
1488 map_set_rest_length
-= i
;
1494 mapping_stack_pointer
= mapping_stack
;
1498 if (mapping_stack_pointer
<= (mapping_stack
+ 1))
1500 /* Set up initial state. */
1501 mapping_stack_pointer
= mapping_stack
;
1502 PUSH_MAPPING_STACK (0, op
);
1507 /* Recover after calling other ccl program. */
1510 POP_MAPPING_STACK (map_set_rest_length
, orig_op
);
1511 POP_MAPPING_STACK (map_set_rest_length
, reg
[rrr
]);
1515 /* Regard it as Qnil. */
1519 map_set_rest_length
--;
1522 /* Regard it as Qt. */
1526 map_set_rest_length
--;
1529 /* Regard it as Qlambda. */
1531 i
+= map_set_rest_length
;
1532 ic
+= map_set_rest_length
;
1533 map_set_rest_length
= 0;
1536 /* Regard it as normal mapping. */
1537 i
+= map_set_rest_length
;
1538 ic
+= map_set_rest_length
;
1539 POP_MAPPING_STACK (map_set_rest_length
, reg
[rrr
]);
1543 map_vector_size
= XVECTOR (Vcode_conversion_map_vector
)->size
;
1546 for (;map_set_rest_length
> 0;i
++, ic
++, map_set_rest_length
--)
1548 point
= XINT(ccl_prog
[ic
]);
1551 /* +1 is for including separator. */
1553 if (mapping_stack_pointer
1554 >= &mapping_stack
[MAX_MAP_SET_LEVEL
])
1556 PUSH_MAPPING_STACK (map_set_rest_length
- point
,
1558 map_set_rest_length
= point
;
1563 if (point
>= map_vector_size
) continue;
1564 map
= (XVECTOR (Vcode_conversion_map_vector
)
1567 /* Check map varidity. */
1568 if (!CONSP (map
)) continue;
1570 if (!VECTORP (map
)) continue;
1571 size
= XVECTOR (map
)->size
;
1572 if (size
<= 1) continue;
1574 content
= XVECTOR (map
)->contents
[0];
1577 [STARTPOINT VAL1 VAL2 ...] or
1578 [t ELEMENT STARTPOINT ENDPOINT] */
1579 if (NUMBERP (content
))
1581 point
= XUINT (content
);
1582 point
= op
- point
+ 1;
1583 if (!((point
>= 1) && (point
< size
))) continue;
1584 content
= XVECTOR (map
)->contents
[point
];
1586 else if (EQ (content
, Qt
))
1588 if (size
!= 4) continue;
1589 if ((op
>= XUINT (XVECTOR (map
)->contents
[2])) &&
1590 (op
< XUINT (XVECTOR (map
)->contents
[3])))
1591 content
= XVECTOR (map
)->contents
[1];
1602 if (NUMBERP (content
))
1604 op
= XINT (content
);
1605 i
+= map_set_rest_length
- 1;
1606 ic
+= map_set_rest_length
- 1;
1607 POP_MAPPING_STACK (map_set_rest_length
, reg
[rrr
]);
1608 map_set_rest_length
++;
1610 else if (CONSP (content
))
1612 attrib
= XCAR (content
);
1613 value
= XCDR (content
);
1614 if (!NUMBERP (attrib
) || !NUMBERP (value
))
1617 i
+= map_set_rest_length
- 1;
1618 ic
+= map_set_rest_length
- 1;
1619 POP_MAPPING_STACK (map_set_rest_length
, reg
[rrr
]);
1620 map_set_rest_length
++;
1622 else if (EQ (content
, Qt
))
1626 else if (EQ (content
, Qlambda
))
1628 i
+= map_set_rest_length
;
1629 ic
+= map_set_rest_length
;
1632 else if (SYMBOLP (content
))
1634 if (mapping_stack_pointer
1635 >= &mapping_stack
[MAX_MAP_SET_LEVEL
])
1637 PUSH_MAPPING_STACK (map_set_rest_length
, reg
[rrr
]);
1638 PUSH_MAPPING_STACK (map_set_rest_length
, op
);
1639 stack_idx_of_map_multiple
= stack_idx
+ 1;
1640 CCL_CALL_FOR_MAP_INSTRUCTION (content
, current_ic
);
1645 if (mapping_stack_pointer
<= (mapping_stack
+ 1))
1647 POP_MAPPING_STACK (map_set_rest_length
, reg
[rrr
]);
1648 i
+= map_set_rest_length
;
1649 ic
+= map_set_rest_length
;
1650 POP_MAPPING_STACK (map_set_rest_length
, reg
[rrr
]);
1660 Lisp_Object map
, attrib
, value
, content
;
1662 j
= XINT (ccl_prog
[ic
++]); /* map_id */
1664 if (j
>= XVECTOR (Vcode_conversion_map_vector
)->size
)
1669 map
= XVECTOR (Vcode_conversion_map_vector
)->contents
[j
];
1681 size
= XVECTOR (map
)->size
;
1682 point
= XUINT (XVECTOR (map
)->contents
[0]);
1683 point
= op
- point
+ 1;
1686 (!((point
>= 1) && (point
< size
))))
1691 content
= XVECTOR (map
)->contents
[point
];
1694 else if (NUMBERP (content
))
1695 reg
[rrr
] = XINT (content
);
1696 else if (EQ (content
, Qt
));
1697 else if (CONSP (content
))
1699 attrib
= XCAR (content
);
1700 value
= XCDR (content
);
1701 if (!NUMBERP (attrib
) || !NUMBERP (value
))
1703 reg
[rrr
] = XUINT(value
);
1706 else if (SYMBOLP (content
))
1707 CCL_CALL_FOR_MAP_INSTRUCTION (content
, ic
);
1725 /* The suppress_error member is set when e.g. a CCL-based coding
1726 system is used for terminal output. */
1727 if (!ccl
->suppress_error
&& destination
)
1729 /* We can insert an error message only if DESTINATION is
1730 specified and we still have a room to store the message
1738 switch (ccl
->status
)
1740 case CCL_STAT_INVALID_CMD
:
1741 sprintf(msg
, "\nCCL: Invalid command %x (ccl_code = %x) at %d.",
1742 code
& 0x1F, code
, this_ic
);
1745 int i
= ccl_backtrace_idx
- 1;
1748 msglen
= strlen (msg
);
1749 if (dst
+ msglen
<= (dst_bytes
? dst_end
: src
))
1751 bcopy (msg
, dst
, msglen
);
1755 for (j
= 0; j
< CCL_DEBUG_BACKTRACE_LEN
; j
++, i
--)
1757 if (i
< 0) i
= CCL_DEBUG_BACKTRACE_LEN
- 1;
1758 if (ccl_backtrace_table
[i
] == 0)
1760 sprintf(msg
, " %d", ccl_backtrace_table
[i
]);
1761 msglen
= strlen (msg
);
1762 if (dst
+ msglen
> (dst_bytes
? dst_end
: src
))
1764 bcopy (msg
, dst
, msglen
);
1773 sprintf(msg
, "\nCCL: Quited.");
1777 sprintf(msg
, "\nCCL: Unknown error type (%d).", ccl
->status
);
1780 msglen
= strlen (msg
);
1781 if (dst
+ msglen
<= (dst_bytes
? dst_end
: src
))
1783 bcopy (msg
, dst
, msglen
);
1786 if (ccl
->status
== CCL_STAT_INVALID_CMD
)
1788 /* Copy the remaining source data. */
1789 int i
= src_end
- src
;
1790 if (dst_bytes
&& (dst_end
- dst
) < i
)
1792 bcopy (src
, dst
, i
);
1800 ccl
->stack_idx
= stack_idx
;
1801 ccl
->prog
= ccl_prog
;
1802 if (consumed
) *consumed
= src
- source
;
1803 return (dst
? dst
- destination
: 0);
1806 /* Resolve symbols in the specified CCL code (Lisp vector). This
1807 function converts symbols of code conversion maps and character
1808 translation tables embeded in the CCL code into their ID numbers.
1810 The return value is a vector (CCL itself or a new vector in which
1811 all symbols are resolved), Qt if resolving of some symbol failed,
1812 or nil if CCL contains invalid data. */
1815 resolve_symbol_ccl_program (ccl
)
1818 int i
, veclen
, unresolved
= 0;
1819 Lisp_Object result
, contents
, val
;
1822 veclen
= XVECTOR (result
)->size
;
1824 for (i
= 0; i
< veclen
; i
++)
1826 contents
= XVECTOR (result
)->contents
[i
];
1827 if (INTEGERP (contents
))
1829 else if (CONSP (contents
)
1830 && SYMBOLP (XCAR (contents
))
1831 && SYMBOLP (XCDR (contents
)))
1833 /* This is the new style for embedding symbols. The form is
1834 (SYMBOL . PROPERTY). (get SYMBOL PROPERTY) should give
1837 if (EQ (result
, ccl
))
1838 result
= Fcopy_sequence (ccl
);
1840 val
= Fget (XCAR (contents
), XCDR (contents
));
1842 XVECTOR (result
)->contents
[i
] = val
;
1847 else if (SYMBOLP (contents
))
1849 /* This is the old style for embedding symbols. This style
1850 may lead to a bug if, for instance, a translation table
1851 and a code conversion map have the same name. */
1852 if (EQ (result
, ccl
))
1853 result
= Fcopy_sequence (ccl
);
1855 val
= Fget (contents
, Qtranslation_table_id
);
1857 XVECTOR (result
)->contents
[i
] = val
;
1860 val
= Fget (contents
, Qcode_conversion_map_id
);
1862 XVECTOR (result
)->contents
[i
] = val
;
1865 val
= Fget (contents
, Qccl_program_idx
);
1867 XVECTOR (result
)->contents
[i
] = val
;
1877 return (unresolved
? Qt
: result
);
1880 /* Return the compiled code (vector) of CCL program CCL_PROG.
1881 CCL_PROG is a name (symbol) of the program or already compiled
1882 code. If necessary, resolve symbols in the compiled code to index
1883 numbers. If we failed to get the compiled code or to resolve
1884 symbols, return Qnil. */
1887 ccl_get_compiled_code (ccl_prog
)
1888 Lisp_Object ccl_prog
;
1890 Lisp_Object val
, slot
;
1892 if (VECTORP (ccl_prog
))
1894 val
= resolve_symbol_ccl_program (ccl_prog
);
1895 return (VECTORP (val
) ? val
: Qnil
);
1897 if (!SYMBOLP (ccl_prog
))
1900 val
= Fget (ccl_prog
, Qccl_program_idx
);
1902 || XINT (val
) >= XVECTOR (Vccl_program_table
)->size
)
1904 slot
= XVECTOR (Vccl_program_table
)->contents
[XINT (val
)];
1905 if (! VECTORP (slot
)
1906 || XVECTOR (slot
)->size
!= 3
1907 || ! VECTORP (XVECTOR (slot
)->contents
[1]))
1909 if (NILP (XVECTOR (slot
)->contents
[2]))
1911 val
= resolve_symbol_ccl_program (XVECTOR (slot
)->contents
[1]);
1912 if (! VECTORP (val
))
1914 XVECTOR (slot
)->contents
[1] = val
;
1915 XVECTOR (slot
)->contents
[2] = Qt
;
1917 return XVECTOR (slot
)->contents
[1];
1920 /* Setup fields of the structure pointed by CCL appropriately for the
1921 execution of CCL program CCL_PROG. CCL_PROG is the name (symbol)
1922 of the CCL program or the already compiled code (vector).
1923 Return 0 if we succeed this setup, else return -1.
1925 If CCL_PROG is nil, we just reset the structure pointed by CCL. */
1927 setup_ccl_program (ccl
, ccl_prog
)
1928 struct ccl_program
*ccl
;
1929 Lisp_Object ccl_prog
;
1933 if (! NILP (ccl_prog
))
1935 struct Lisp_Vector
*vp
;
1937 ccl_prog
= ccl_get_compiled_code (ccl_prog
);
1938 if (! VECTORP (ccl_prog
))
1940 vp
= XVECTOR (ccl_prog
);
1941 ccl
->size
= vp
->size
;
1942 ccl
->prog
= vp
->contents
;
1943 ccl
->eof_ic
= XINT (vp
->contents
[CCL_HEADER_EOF
]);
1944 ccl
->buf_magnification
= XINT (vp
->contents
[CCL_HEADER_BUF_MAG
]);
1946 ccl
->ic
= CCL_HEADER_MAIN
;
1947 for (i
= 0; i
< 8; i
++)
1949 ccl
->last_block
= 0;
1950 ccl
->private_state
= 0;
1953 ccl
->eol_type
= CODING_EOL_LF
;
1954 ccl
->suppress_error
= 0;
1960 DEFUN ("ccl-program-p", Fccl_program_p
, Sccl_program_p
, 1, 1, 0,
1961 "Return t if OBJECT is a CCL program name or a compiled CCL program code.\n\
1962 See the documentation of `define-ccl-program' for the detail of CCL program.")
1968 if (VECTORP (object
))
1970 val
= resolve_symbol_ccl_program (object
);
1971 return (VECTORP (val
) ? Qt
: Qnil
);
1973 if (!SYMBOLP (object
))
1976 val
= Fget (object
, Qccl_program_idx
);
1977 return ((! NATNUMP (val
)
1978 || XINT (val
) >= XVECTOR (Vccl_program_table
)->size
)
1982 DEFUN ("ccl-execute", Fccl_execute
, Sccl_execute
, 2, 2, 0,
1983 "Execute CCL-PROGRAM with registers initialized by REGISTERS.\n\
1985 CCL-PROGRAM is a CCL program name (symbol)\n\
1986 or a compiled code generated by `ccl-compile' (for backward compatibility,\n\
1987 in this case, the overhead of the execution is bigger than the former case).\n\
1988 No I/O commands should appear in CCL-PROGRAM.\n\
1990 REGISTERS is a vector of [R0 R1 ... R7] where RN is an initial value\n\
1993 As side effect, each element of REGISTERS holds the value of\n\
1994 corresponding register after the execution.\n\
1996 See the documentation of `define-ccl-program' for the detail of CCL program.")
1998 Lisp_Object ccl_prog
, reg
;
2000 struct ccl_program ccl
;
2003 if (setup_ccl_program (&ccl
, ccl_prog
) < 0)
2004 error ("Invalid CCL program");
2006 CHECK_VECTOR (reg
, 1);
2007 if (XVECTOR (reg
)->size
!= 8)
2008 error ("Length of vector REGISTERS is not 8");
2010 for (i
= 0; i
< 8; i
++)
2011 ccl
.reg
[i
] = (INTEGERP (XVECTOR (reg
)->contents
[i
])
2012 ? XINT (XVECTOR (reg
)->contents
[i
])
2015 ccl_driver (&ccl
, (unsigned char *)0, (unsigned char *)0, 0, 0, (int *)0);
2017 if (ccl
.status
!= CCL_STAT_SUCCESS
)
2018 error ("Error in CCL program at %dth code", ccl
.ic
);
2020 for (i
= 0; i
< 8; i
++)
2021 XSETINT (XVECTOR (reg
)->contents
[i
], ccl
.reg
[i
]);
2025 DEFUN ("ccl-execute-on-string", Fccl_execute_on_string
, Sccl_execute_on_string
,
2027 "Execute CCL-PROGRAM with initial STATUS on STRING.\n\
2029 CCL-PROGRAM is a symbol registered by register-ccl-program,\n\
2030 or a compiled code generated by `ccl-compile' (for backward compatibility,\n\
2031 in this case, the execution is slower).\n\
2033 Read buffer is set to STRING, and write buffer is allocated automatically.\n\
2035 STATUS is a vector of [R0 R1 ... R7 IC], where\n\
2036 R0..R7 are initial values of corresponding registers,\n\
2037 IC is the instruction counter specifying from where to start the program.\n\
2038 If R0..R7 are nil, they are initialized to 0.\n\
2039 If IC is nil, it is initialized to head of the CCL program.\n\
2041 If optional 4th arg CONTINUE is non-nil, keep IC on read operation\n\
2042 when read buffer is exausted, else, IC is always set to the end of\n\
2043 CCL-PROGRAM on exit.\n\
2045 It returns the contents of write buffer as a string,\n\
2046 and as side effect, STATUS is updated.\n\
2047 If the optional 5th arg UNIBYTE-P is non-nil, the returned string\n\
2048 is a unibyte string. By default it is a multibyte string.\n\
2050 See the documentation of `define-ccl-program' for the detail of CCL program.")
2051 (ccl_prog
, status
, str
, contin
, unibyte_p
)
2052 Lisp_Object ccl_prog
, status
, str
, contin
, unibyte_p
;
2055 struct ccl_program ccl
;
2059 struct gcpro gcpro1
, gcpro2
;
2061 if (setup_ccl_program (&ccl
, ccl_prog
) < 0)
2062 error ("Invalid CCL program");
2064 CHECK_VECTOR (status
, 1);
2065 if (XVECTOR (status
)->size
!= 9)
2066 error ("Length of vector STATUS is not 9");
2067 CHECK_STRING (str
, 2);
2069 GCPRO2 (status
, str
);
2071 for (i
= 0; i
< 8; i
++)
2073 if (NILP (XVECTOR (status
)->contents
[i
]))
2074 XSETINT (XVECTOR (status
)->contents
[i
], 0);
2075 if (INTEGERP (XVECTOR (status
)->contents
[i
]))
2076 ccl
.reg
[i
] = XINT (XVECTOR (status
)->contents
[i
]);
2078 if (INTEGERP (XVECTOR (status
)->contents
[i
]))
2080 i
= XFASTINT (XVECTOR (status
)->contents
[8]);
2081 if (ccl
.ic
< i
&& i
< ccl
.size
)
2084 outbufsize
= STRING_BYTES (XSTRING (str
)) * ccl
.buf_magnification
+ 256;
2085 outbuf
= (char *) xmalloc (outbufsize
);
2086 ccl
.last_block
= NILP (contin
);
2087 ccl
.multibyte
= STRING_MULTIBYTE (str
);
2088 produced
= ccl_driver (&ccl
, XSTRING (str
)->data
, outbuf
,
2089 STRING_BYTES (XSTRING (str
)), outbufsize
, (int *) 0);
2090 for (i
= 0; i
< 8; i
++)
2091 XSET (XVECTOR (status
)->contents
[i
], Lisp_Int
, ccl
.reg
[i
]);
2092 XSETINT (XVECTOR (status
)->contents
[8], ccl
.ic
);
2095 if (NILP (unibyte_p
))
2099 produced
= str_as_multibyte (outbuf
, outbufsize
, produced
, &nchars
);
2100 val
= make_multibyte_string (outbuf
, nchars
, produced
);
2103 val
= make_unibyte_string (outbuf
, produced
);
2106 if (ccl
.status
== CCL_STAT_SUSPEND_BY_DST
)
2107 error ("Output buffer for the CCL programs overflow");
2108 if (ccl
.status
!= CCL_STAT_SUCCESS
2109 && ccl
.status
!= CCL_STAT_SUSPEND_BY_SRC
)
2110 error ("Error in CCL program at %dth code", ccl
.ic
);
2115 DEFUN ("register-ccl-program", Fregister_ccl_program
, Sregister_ccl_program
,
2117 "Register CCL program CCL_PROG as NAME in `ccl-program-table'.\n\
2118 CCL_PROG should be a compiled CCL program (vector), or nil.\n\
2119 If it is nil, just reserve NAME as a CCL program name.\n\
2120 Return index number of the registered CCL program.")
2122 Lisp_Object name
, ccl_prog
;
2124 int len
= XVECTOR (Vccl_program_table
)->size
;
2126 Lisp_Object resolved
;
2128 CHECK_SYMBOL (name
, 0);
2130 if (!NILP (ccl_prog
))
2132 CHECK_VECTOR (ccl_prog
, 1);
2133 resolved
= resolve_symbol_ccl_program (ccl_prog
);
2134 if (NILP (resolved
))
2135 error ("Error in CCL program");
2136 if (VECTORP (resolved
))
2138 ccl_prog
= resolved
;
2145 for (idx
= 0; idx
< len
; idx
++)
2149 slot
= XVECTOR (Vccl_program_table
)->contents
[idx
];
2150 if (!VECTORP (slot
))
2151 /* This is the first unsed slot. Register NAME here. */
2154 if (EQ (name
, XVECTOR (slot
)->contents
[0]))
2156 /* Update this slot. */
2157 XVECTOR (slot
)->contents
[1] = ccl_prog
;
2158 XVECTOR (slot
)->contents
[2] = resolved
;
2159 return make_number (idx
);
2165 /* Extend the table. */
2166 Lisp_Object new_table
;
2169 new_table
= Fmake_vector (make_number (len
* 2), Qnil
);
2170 for (j
= 0; j
< len
; j
++)
2171 XVECTOR (new_table
)->contents
[j
]
2172 = XVECTOR (Vccl_program_table
)->contents
[j
];
2173 Vccl_program_table
= new_table
;
2179 elt
= Fmake_vector (make_number (3), Qnil
);
2180 XVECTOR (elt
)->contents
[0] = name
;
2181 XVECTOR (elt
)->contents
[1] = ccl_prog
;
2182 XVECTOR (elt
)->contents
[2] = resolved
;
2183 XVECTOR (Vccl_program_table
)->contents
[idx
] = elt
;
2186 Fput (name
, Qccl_program_idx
, make_number (idx
));
2187 return make_number (idx
);
2190 /* Register code conversion map.
2191 A code conversion map consists of numbers, Qt, Qnil, and Qlambda.
2192 The first element is start code point.
2193 The rest elements are mapped numbers.
2194 Symbol t means to map to an original number before mapping.
2195 Symbol nil means that the corresponding element is empty.
2196 Symbol lambda menas to terminate mapping here.
2199 DEFUN ("register-code-conversion-map", Fregister_code_conversion_map
,
2200 Sregister_code_conversion_map
,
2202 "Register SYMBOL as code conversion map MAP.\n\
2203 Return index number of the registered map.")
2205 Lisp_Object symbol
, map
;
2207 int len
= XVECTOR (Vcode_conversion_map_vector
)->size
;
2211 CHECK_SYMBOL (symbol
, 0);
2212 CHECK_VECTOR (map
, 1);
2214 for (i
= 0; i
< len
; i
++)
2216 Lisp_Object slot
= XVECTOR (Vcode_conversion_map_vector
)->contents
[i
];
2221 if (EQ (symbol
, XCAR (slot
)))
2223 index
= make_number (i
);
2225 Fput (symbol
, Qcode_conversion_map
, map
);
2226 Fput (symbol
, Qcode_conversion_map_id
, index
);
2233 Lisp_Object new_vector
= Fmake_vector (make_number (len
* 2), Qnil
);
2236 for (j
= 0; j
< len
; j
++)
2237 XVECTOR (new_vector
)->contents
[j
]
2238 = XVECTOR (Vcode_conversion_map_vector
)->contents
[j
];
2239 Vcode_conversion_map_vector
= new_vector
;
2242 index
= make_number (i
);
2243 Fput (symbol
, Qcode_conversion_map
, map
);
2244 Fput (symbol
, Qcode_conversion_map_id
, index
);
2245 XVECTOR (Vcode_conversion_map_vector
)->contents
[i
] = Fcons (symbol
, map
);
2253 staticpro (&Vccl_program_table
);
2254 Vccl_program_table
= Fmake_vector (make_number (32), Qnil
);
2256 Qccl_program
= intern ("ccl-program");
2257 staticpro (&Qccl_program
);
2259 Qccl_program_idx
= intern ("ccl-program-idx");
2260 staticpro (&Qccl_program_idx
);
2262 Qcode_conversion_map
= intern ("code-conversion-map");
2263 staticpro (&Qcode_conversion_map
);
2265 Qcode_conversion_map_id
= intern ("code-conversion-map-id");
2266 staticpro (&Qcode_conversion_map_id
);
2268 DEFVAR_LISP ("code-conversion-map-vector", &Vcode_conversion_map_vector
,
2269 "Vector of code conversion maps.");
2270 Vcode_conversion_map_vector
= Fmake_vector (make_number (16), Qnil
);
2272 DEFVAR_LISP ("font-ccl-encoder-alist", &Vfont_ccl_encoder_alist
,
2273 "Alist of fontname patterns vs corresponding CCL program.\n\
2274 Each element looks like (REGEXP . CCL-CODE),\n\
2275 where CCL-CODE is a compiled CCL program.\n\
2276 When a font whose name matches REGEXP is used for displaying a character,\n\
2277 CCL-CODE is executed to calculate the code point in the font\n\
2278 from the charset number and position code(s) of the character which are set\n\
2279 in CCL registers R0, R1, and R2 before the execution.\n\
2280 The code point in the font is set in CCL registers R1 and R2\n\
2281 when the execution terminated.\n\
2282 If the font is single-byte font, the register R2 is not used.");
2283 Vfont_ccl_encoder_alist
= Qnil
;
2285 defsubr (&Sccl_program_p
);
2286 defsubr (&Sccl_execute
);
2287 defsubr (&Sccl_execute_on_string
);
2288 defsubr (&Sregister_ccl_program
);
2289 defsubr (&Sregister_code_conversion_map
);