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. */
36 #endif /* not emacs */
38 /* Where is stored translation tables for CCL program. */
39 Lisp_Object Vccl_translation_table_vector
;
41 /* Alist of fontname patterns vs corresponding CCL program. */
42 Lisp_Object Vfont_ccl_encoder_alist
;
44 /* This symbol is property which assocate with ccl program vector. e.g.
45 (get 'ccl-big5-encoder 'ccl-program) returns ccl program vector */
46 Lisp_Object Qccl_program
;
48 /* These symbol is properties whish associate with ccl translation table and its id
50 Lisp_Object Qccl_translation_table
;
51 Lisp_Object Qccl_translation_table_id
;
53 /* Vector of CCL program names vs corresponding program data. */
54 Lisp_Object Vccl_program_table
;
56 /* CCL (Code Conversion Language) is a simple language which has
57 operations on one input buffer, one output buffer, and 7 registers.
58 The syntax of CCL is described in `ccl.el'. Emacs Lisp function
59 `ccl-compile' compiles a CCL program and produces a CCL code which
60 is a vector of integers. The structure of this vector is as
61 follows: The 1st element: buffer-magnification, a factor for the
62 size of output buffer compared with the size of input buffer. The
63 2nd element: address of CCL code to be executed when encountered
64 with end of input stream. The 3rd and the remaining elements: CCL
67 /* Header of CCL compiled code */
68 #define CCL_HEADER_BUF_MAG 0
69 #define CCL_HEADER_EOF 1
70 #define CCL_HEADER_MAIN 2
72 /* CCL code is a sequence of 28-bit non-negative integers (i.e. the
73 MSB is always 0), each contains CCL command and/or arguments in the
76 |----------------- integer (28-bit) ------------------|
77 |------- 17-bit ------|- 3-bit --|- 3-bit --|- 5-bit -|
78 |--constant argument--|-register-|-register-|-command-|
79 ccccccccccccccccc RRR rrr XXXXX
81 |------- relative address -------|-register-|-command-|
82 cccccccccccccccccccc rrr XXXXX
84 |------------- constant or other args ----------------|
85 cccccccccccccccccccccccccccc
87 where, `cc...c' is a non-negative integer indicating constant value
88 (the left most `c' is always 0) or an absolute jump address, `RRR'
89 and `rrr' are CCL register number, `XXXXX' is one of the following
94 Each comment fields shows one or more lines for command syntax and
95 the following lines for semantics of the command. In semantics, IC
96 stands for Instruction Counter. */
98 #define CCL_SetRegister 0x00 /* Set register a register value:
99 1:00000000000000000RRRrrrXXXXX
100 ------------------------------
104 #define CCL_SetShortConst 0x01 /* Set register a short constant value:
105 1:CCCCCCCCCCCCCCCCCCCCrrrXXXXX
106 ------------------------------
107 reg[rrr] = CCCCCCCCCCCCCCCCCCC;
110 #define CCL_SetConst 0x02 /* Set register a constant value:
111 1:00000000000000000000rrrXXXXX
113 ------------------------------
118 #define CCL_SetArray 0x03 /* Set register an element of array:
119 1:CCCCCCCCCCCCCCCCCRRRrrrXXXXX
123 ------------------------------
124 if (0 <= reg[RRR] < CC..C)
125 reg[rrr] = ELEMENT[reg[RRR]];
129 #define CCL_Jump 0x04 /* Jump:
130 1:A--D--D--R--E--S--S-000XXXXX
131 ------------------------------
135 /* Note: If CC..C is greater than 0, the second code is omitted. */
137 #define CCL_JumpCond 0x05 /* Jump conditional:
138 1:A--D--D--R--E--S--S-rrrXXXXX
139 ------------------------------
145 #define CCL_WriteRegisterJump 0x06 /* Write register and jump:
146 1:A--D--D--R--E--S--S-rrrXXXXX
147 ------------------------------
152 #define CCL_WriteRegisterReadJump 0x07 /* Write register, read, and jump:
153 1:A--D--D--R--E--S--S-rrrXXXXX
154 2:A--D--D--R--E--S--S-rrrYYYYY
155 -----------------------------
161 /* Note: If read is suspended, the resumed execution starts from the
162 second code (YYYYY == CCL_ReadJump). */
164 #define CCL_WriteConstJump 0x08 /* Write constant and jump:
165 1:A--D--D--R--E--S--S-000XXXXX
167 ------------------------------
172 #define CCL_WriteConstReadJump 0x09 /* Write constant, read, and jump:
173 1:A--D--D--R--E--S--S-rrrXXXXX
175 3:A--D--D--R--E--S--S-rrrYYYYY
176 -----------------------------
182 /* Note: If read is suspended, the resumed execution starts from the
183 second code (YYYYY == CCL_ReadJump). */
185 #define CCL_WriteStringJump 0x0A /* Write string and jump:
186 1:A--D--D--R--E--S--S-000XXXXX
188 3:0000STRIN[0]STRIN[1]STRIN[2]
190 ------------------------------
191 write_string (STRING, LENGTH);
195 #define CCL_WriteArrayReadJump 0x0B /* Write an array element, read, and jump:
196 1:A--D--D--R--E--S--S-rrrXXXXX
201 N:A--D--D--R--E--S--S-rrrYYYYY
202 ------------------------------
203 if (0 <= reg[rrr] < LENGTH)
204 write (ELEMENT[reg[rrr]]);
205 IC += LENGTH + 2; (... pointing at N+1)
209 /* Note: If read is suspended, the resumed execution starts from the
210 Nth code (YYYYY == CCL_ReadJump). */
212 #define CCL_ReadJump 0x0C /* Read and jump:
213 1:A--D--D--R--E--S--S-rrrYYYYY
214 -----------------------------
219 #define CCL_Branch 0x0D /* Jump by branch table:
220 1:CCCCCCCCCCCCCCCCCCCCrrrXXXXX
221 2:A--D--D--R--E-S-S[0]000XXXXX
222 3:A--D--D--R--E-S-S[1]000XXXXX
224 ------------------------------
225 if (0 <= reg[rrr] < CC..C)
226 IC += ADDRESS[reg[rrr]];
228 IC += ADDRESS[CC..C];
231 #define CCL_ReadRegister 0x0E /* Read bytes into registers:
232 1:CCCCCCCCCCCCCCCCCCCCrrrXXXXX
233 2:CCCCCCCCCCCCCCCCCCCCrrrXXXXX
235 ------------------------------
240 #define CCL_WriteExprConst 0x0F /* write result of expression:
241 1:00000OPERATION000RRR000XXXXX
243 ------------------------------
244 write (reg[RRR] OPERATION CONSTANT);
248 /* Note: If the Nth read is suspended, the resumed execution starts
249 from the Nth code. */
251 #define CCL_ReadBranch 0x10 /* Read one byte into a register,
252 and jump by branch table:
253 1:CCCCCCCCCCCCCCCCCCCCrrrXXXXX
254 2:A--D--D--R--E-S-S[0]000XXXXX
255 3:A--D--D--R--E-S-S[1]000XXXXX
257 ------------------------------
259 if (0 <= reg[rrr] < CC..C)
260 IC += ADDRESS[reg[rrr]];
262 IC += ADDRESS[CC..C];
265 #define CCL_WriteRegister 0x11 /* Write registers:
266 1:CCCCCCCCCCCCCCCCCCCrrrXXXXX
267 2:CCCCCCCCCCCCCCCCCCCrrrXXXXX
269 ------------------------------
275 /* Note: If the Nth write is suspended, the resumed execution
276 starts from the Nth code. */
278 #define CCL_WriteExprRegister 0x12 /* Write result of expression
279 1:00000OPERATIONRrrRRR000XXXXX
280 ------------------------------
281 write (reg[RRR] OPERATION reg[Rrr]);
284 #define CCL_Call 0x13 /* Call the CCL program whose ID is
286 1:CCCCCCCCCCCCCCCCCCCC000XXXXX
287 ------------------------------
291 #define CCL_WriteConstString 0x14 /* Write a constant or a string:
292 1:CCCCCCCCCCCCCCCCCCCCrrrXXXXX
293 [2:0000STRIN[0]STRIN[1]STRIN[2]]
295 -----------------------------
299 write_string (STRING, CC..C);
300 IC += (CC..C + 2) / 3;
303 #define CCL_WriteArray 0x15 /* Write an element of array:
304 1:CCCCCCCCCCCCCCCCCCCCrrrXXXXX
308 ------------------------------
309 if (0 <= reg[rrr] < CC..C)
310 write (ELEMENT[reg[rrr]]);
314 #define CCL_End 0x16 /* Terminate:
315 1:00000000000000000000000XXXXX
316 ------------------------------
320 /* The following two codes execute an assignment arithmetic/logical
321 operation. The form of the operation is like REG OP= OPERAND. */
323 #define CCL_ExprSelfConst 0x17 /* REG OP= constant:
324 1:00000OPERATION000000rrrXXXXX
326 ------------------------------
327 reg[rrr] OPERATION= CONSTANT;
330 #define CCL_ExprSelfReg 0x18 /* REG1 OP= REG2:
331 1:00000OPERATION000RRRrrrXXXXX
332 ------------------------------
333 reg[rrr] OPERATION= reg[RRR];
336 /* The following codes execute an arithmetic/logical operation. The
337 form of the operation is like REG_X = REG_Y OP OPERAND2. */
339 #define CCL_SetExprConst 0x19 /* REG_X = REG_Y OP constant:
340 1:00000OPERATION000RRRrrrXXXXX
342 ------------------------------
343 reg[rrr] = reg[RRR] OPERATION CONSTANT;
347 #define CCL_SetExprReg 0x1A /* REG1 = REG2 OP REG3:
348 1:00000OPERATIONRrrRRRrrrXXXXX
349 ------------------------------
350 reg[rrr] = reg[RRR] OPERATION reg[Rrr];
353 #define CCL_JumpCondExprConst 0x1B /* Jump conditional according to
354 an operation on constant:
355 1:A--D--D--R--E--S--S-rrrXXXXX
358 -----------------------------
359 reg[7] = reg[rrr] OPERATION CONSTANT;
366 #define CCL_JumpCondExprReg 0x1C /* Jump conditional according to
367 an operation on register:
368 1:A--D--D--R--E--S--S-rrrXXXXX
371 -----------------------------
372 reg[7] = reg[rrr] OPERATION reg[RRR];
379 #define CCL_ReadJumpCondExprConst 0x1D /* Read and jump conditional according
380 to an operation on constant:
381 1:A--D--D--R--E--S--S-rrrXXXXX
384 -----------------------------
386 reg[7] = reg[rrr] OPERATION CONSTANT;
393 #define CCL_ReadJumpCondExprReg 0x1E /* Read and jump conditional according
394 to an operation on register:
395 1:A--D--D--R--E--S--S-rrrXXXXX
398 -----------------------------
400 reg[7] = reg[rrr] OPERATION reg[RRR];
407 #define CCL_Extention 0x1F /* Extended CCL code
408 1:ExtendedCOMMNDRrrRRRrrrXXXXX
411 ------------------------------
412 extended_command (rrr,RRR,Rrr,ARGS)
416 From here, Extended CCL Instruction.
417 Bit length of extended command is 14.
418 Therefore the instruction code begins from 0 to 16384(0x3fff).
421 #define CCL_ReadMultibyteCharacter 0x00 /* Read Multibyte Character
422 1:ExtendedCOMMNDRrrRRRrrrXXXXX
424 Read a multibyte characeter.
425 A code point is stored
427 A charset ID is stored
430 #define CCL_WriteMultibyteCharacter 0x01 /* Write Multibyte Character
431 1:ExtendedCOMMNDRrrRRRrrrXXXXX
433 Write a multibyte character.
434 Write a character whose code point
435 is in rrr register, and its charset ID
438 #define CCL_UnifyCharacter 0x02 /* Unify Multibyte Character
439 1:ExtendedCOMMNDRrrRRRrrrXXXXX
441 Unify a character where its code point
442 is in rrr register, and its charset ID
443 is in RRR register with the table of
444 the unification table ID
447 Return a unified character where its
448 code point is in rrr register, and its
449 charset ID is in RRR register.
451 #define CCL_UnifyCharacterConstTbl 0x03 /* Unify Multibyte Character
452 1:ExtendedCOMMNDRrrRRRrrrXXXXX
453 2:ARGUMENT(Unification Table ID)
455 Unify a character where its code point
456 is in rrr register, and its charset ID
457 is in RRR register with the table of
458 the unification table ID
461 Return a unified character where its
462 code point is in rrr register, and its
463 charset ID is in RRR register.
465 #define CCL_IterateMultipleMap 0x10 /* Iterate Multiple Map
466 1:ExtendedCOMMNDXXXRRRrrrXXXXX
472 iterate to lookup tables from a number
473 until finding a value.
475 Each table consists of a vector
476 whose element is number or
478 If the element is nil,
479 its table is neglected.
480 In the case of t or lambda,
481 return the original value.
484 #define CCL_TranslateMultipleMap 0x11 /* Translate Multiple Map
485 1:ExtendedCOMMNDXXXRRRrrrXXXXX
486 2:NUMBER of TABLE-IDs and SEPARATERs
487 (i.e. m1+m2+m3+...mk+k-1)
495 m1+m2+4:TABLE-ID 2,m2
498 m1+m2+...+mk+k+1:TABLE-ID k,mk
500 Translate the code point in
501 rrr register by tables.
502 Translation starts from the table
503 where RRR register points out.
505 We translate the given value
506 from the tables which are separated
508 When each translation is failed to find
509 any values, we regard the traslation
512 We iterate to traslate by using each
513 table set(tables separated by -1)
514 until lookup the last table except
517 Each table consists of a vector
518 whose element is number
519 or nil or t or lambda.
520 If the element is nil,
521 it is neglected and use the next table.
523 it is translated to the original value.
524 In the case of lambda,
525 it cease the translation and return the
529 #define CCL_TranslateSingleMap 0x12 /* Translate Single Map
530 1:ExtendedCOMMNDXXXRRRrrrXXXXX
533 Translate a number in rrr register.
534 If it is not found any translation,
535 set RRR register -1 but rrr register
539 /* CCL arithmetic/logical operators. */
540 #define CCL_PLUS 0x00 /* X = Y + Z */
541 #define CCL_MINUS 0x01 /* X = Y - Z */
542 #define CCL_MUL 0x02 /* X = Y * Z */
543 #define CCL_DIV 0x03 /* X = Y / Z */
544 #define CCL_MOD 0x04 /* X = Y % Z */
545 #define CCL_AND 0x05 /* X = Y & Z */
546 #define CCL_OR 0x06 /* X = Y | Z */
547 #define CCL_XOR 0x07 /* X = Y ^ Z */
548 #define CCL_LSH 0x08 /* X = Y << Z */
549 #define CCL_RSH 0x09 /* X = Y >> Z */
550 #define CCL_LSH8 0x0A /* X = (Y << 8) | Z */
551 #define CCL_RSH8 0x0B /* X = Y >> 8, r[7] = Y & 0xFF */
552 #define CCL_DIVMOD 0x0C /* X = Y / Z, r[7] = Y % Z */
553 #define CCL_LS 0x10 /* X = (X < Y) */
554 #define CCL_GT 0x11 /* X = (X > Y) */
555 #define CCL_EQ 0x12 /* X = (X == Y) */
556 #define CCL_LE 0x13 /* X = (X <= Y) */
557 #define CCL_GE 0x14 /* X = (X >= Y) */
558 #define CCL_NE 0x15 /* X = (X != Y) */
560 #define CCL_ENCODE_SJIS 0x16 /* X = HIGHER_BYTE (SJIS (Y, Z))
561 r[7] = LOWER_BYTE (SJIS (Y, Z) */
562 #define CCL_DECODE_SJIS 0x17 /* X = HIGHER_BYTE (DE-SJIS (Y, Z))
563 r[7] = LOWER_BYTE (DE-SJIS (Y, Z)) */
565 /* Terminate CCL program successfully. */
566 #define CCL_SUCCESS \
568 ccl->status = CCL_STAT_SUCCESS; \
569 ccl->ic = CCL_HEADER_MAIN; \
573 /* Suspend CCL program because of reading from empty input buffer or
574 writing to full output buffer. When this program is resumed, the
575 same I/O command is executed. */
576 #define CCL_SUSPEND(stat) \
579 ccl->status = stat; \
583 /* Terminate CCL program because of invalid command. Should not occur
584 in the normal case. */
585 #define CCL_INVALID_CMD \
587 ccl->status = CCL_STAT_INVALID_CMD; \
588 goto ccl_error_handler; \
591 /* Encode one character CH to multibyte form and write to the current
592 output buffer. If CH is less than 256, CH is written as is. */
593 #define CCL_WRITE_CHAR(ch) \
599 unsigned char work[4], *str; \
600 int len = CHAR_STRING (ch, work, str); \
601 if (dst + len <= (dst_bytes ? dst_end : src)) \
603 bcopy (str, dst, len); \
607 CCL_SUSPEND (CCL_STAT_SUSPEND_BY_DST); \
611 /* Write a string at ccl_prog[IC] of length LEN to the current output
613 #define CCL_WRITE_STRING(len) \
617 else if (dst + len <= (dst_bytes ? dst_end : src)) \
618 for (i = 0; i < len; i++) \
619 *dst++ = ((XFASTINT (ccl_prog[ic + (i / 3)])) \
620 >> ((2 - (i % 3)) * 8)) & 0xFF; \
622 CCL_SUSPEND (CCL_STAT_SUSPEND_BY_DST); \
625 /* Read one byte from the current input buffer into Rth register. */
626 #define CCL_READ_CHAR(r) \
630 else if (src < src_end) \
632 else if (ccl->last_block) \
638 CCL_SUSPEND (CCL_STAT_SUSPEND_BY_SRC); \
642 /* Execute CCL code on SRC_BYTES length text at SOURCE. The resulting
643 text goes to a place pointed by DESTINATION, the length of which
644 should not exceed DST_BYTES. The bytes actually processed is
645 returned as *CONSUMED. The return value is the length of the
646 resulting text. As a side effect, the contents of CCL registers
647 are updated. If SOURCE or DESTINATION is NULL, only operations on
648 registers are permitted. */
651 #define CCL_DEBUG_BACKTRACE_LEN 256
652 int ccl_backtrace_table
[CCL_BACKTRACE_TABLE
];
653 int ccl_backtrace_idx
;
656 struct ccl_prog_stack
658 Lisp_Object
*ccl_prog
; /* Pointer to an array of CCL code. */
659 int ic
; /* Instruction Counter. */
662 ccl_driver (ccl
, source
, destination
, src_bytes
, dst_bytes
, consumed
)
663 struct ccl_program
*ccl
;
664 unsigned char *source
, *destination
;
665 int src_bytes
, dst_bytes
;
668 register int *reg
= ccl
->reg
;
669 register int ic
= ccl
->ic
;
670 register int code
, field1
, field2
;
671 register Lisp_Object
*ccl_prog
= ccl
->prog
;
672 unsigned char *src
= source
, *src_end
= src
+ src_bytes
;
673 unsigned char *dst
= destination
, *dst_end
= dst
+ dst_bytes
;
677 /* For the moment, we only support depth 256 of stack. */
678 struct ccl_prog_stack ccl_prog_stack_struct
[256];
680 if (ic
>= ccl
->eof_ic
)
681 ic
= CCL_HEADER_MAIN
;
684 ccl_backtrace_idx
= 0;
690 ccl_backtrace_table
[ccl_backtrace_idx
++] = ic
;
691 if (ccl_backtrace_idx
>= CCL_DEBUG_BACKTRACE_LEN
)
692 ccl_backtrace_idx
= 0;
693 ccl_backtrace_table
[ccl_backtrace_idx
] = 0;
696 if (!NILP (Vquit_flag
) && NILP (Vinhibit_quit
))
698 /* We can't just signal Qquit, instead break the loop as if
699 the whole data is processed. Don't reset Vquit_flag, it
700 must be handled later at a safer place. */
702 src
= source
+ src_bytes
;
703 ccl
->status
= CCL_STAT_QUIT
;
707 code
= XINT (ccl_prog
[ic
]); ic
++;
709 field2
= (code
& 0xFF) >> 5;
712 #define RRR (field1 & 7)
713 #define Rrr ((field1 >> 3) & 7)
715 #define EXCMD (field1 >> 6)
719 case CCL_SetRegister
: /* 00000000000000000RRRrrrXXXXX */
723 case CCL_SetShortConst
: /* CCCCCCCCCCCCCCCCCCCCrrrXXXXX */
727 case CCL_SetConst
: /* 00000000000000000000rrrXXXXX */
728 reg
[rrr
] = XINT (ccl_prog
[ic
]);
732 case CCL_SetArray
: /* CCCCCCCCCCCCCCCCCCCCRRRrrrXXXXX */
735 if ((unsigned int) i
< j
)
736 reg
[rrr
] = XINT (ccl_prog
[ic
+ i
]);
740 case CCL_Jump
: /* A--D--D--R--E--S--S-000XXXXX */
744 case CCL_JumpCond
: /* A--D--D--R--E--S--S-rrrXXXXX */
749 case CCL_WriteRegisterJump
: /* A--D--D--R--E--S--S-rrrXXXXX */
755 case CCL_WriteRegisterReadJump
: /* A--D--D--R--E--S--S-rrrXXXXX */
759 CCL_READ_CHAR (reg
[rrr
]);
763 case CCL_WriteConstJump
: /* A--D--D--R--E--S--S-000XXXXX */
764 i
= XINT (ccl_prog
[ic
]);
769 case CCL_WriteConstReadJump
: /* A--D--D--R--E--S--S-rrrXXXXX */
770 i
= XINT (ccl_prog
[ic
]);
773 CCL_READ_CHAR (reg
[rrr
]);
777 case CCL_WriteStringJump
: /* A--D--D--R--E--S--S-000XXXXX */
778 j
= XINT (ccl_prog
[ic
]);
780 CCL_WRITE_STRING (j
);
784 case CCL_WriteArrayReadJump
: /* A--D--D--R--E--S--S-rrrXXXXX */
786 j
= XINT (ccl_prog
[ic
]);
787 if ((unsigned int) i
< j
)
789 i
= XINT (ccl_prog
[ic
+ 1 + i
]);
793 CCL_READ_CHAR (reg
[rrr
]);
794 ic
+= ADDR
- (j
+ 2);
797 case CCL_ReadJump
: /* A--D--D--R--E--S--S-rrrYYYYY */
798 CCL_READ_CHAR (reg
[rrr
]);
802 case CCL_ReadBranch
: /* CCCCCCCCCCCCCCCCCCCCrrrXXXXX */
803 CCL_READ_CHAR (reg
[rrr
]);
804 /* fall through ... */
805 case CCL_Branch
: /* CCCCCCCCCCCCCCCCCCCCrrrXXXXX */
806 if ((unsigned int) reg
[rrr
] < field1
)
807 ic
+= XINT (ccl_prog
[ic
+ reg
[rrr
]]);
809 ic
+= XINT (ccl_prog
[ic
+ field1
]);
812 case CCL_ReadRegister
: /* CCCCCCCCCCCCCCCCCCCCrrXXXXX */
815 CCL_READ_CHAR (reg
[rrr
]);
817 code
= XINT (ccl_prog
[ic
]); ic
++;
819 field2
= (code
& 0xFF) >> 5;
823 case CCL_WriteExprConst
: /* 1:00000OPERATION000RRR000XXXXX */
826 j
= XINT (ccl_prog
[ic
]);
831 case CCL_WriteRegister
: /* CCCCCCCCCCCCCCCCCCCrrrXXXXX */
837 code
= XINT (ccl_prog
[ic
]); ic
++;
839 field2
= (code
& 0xFF) >> 5;
843 case CCL_WriteExprRegister
: /* 1:00000OPERATIONRrrRRR000XXXXX */
850 case CCL_Call
: /* CCCCCCCCCCCCCCCCCCCC000XXXXX */
856 || field1
>= XVECTOR (Vccl_program_table
)->size
857 || (slot
= XVECTOR (Vccl_program_table
)->contents
[field1
],
859 || !VECTORP (XCONS (slot
)->cdr
))
863 ccl_prog
= ccl_prog_stack_struct
[0].ccl_prog
;
864 ic
= ccl_prog_stack_struct
[0].ic
;
869 ccl_prog_stack_struct
[stack_idx
].ccl_prog
= ccl_prog
;
870 ccl_prog_stack_struct
[stack_idx
].ic
= ic
;
872 ccl_prog
= XVECTOR (XCONS (slot
)->cdr
)->contents
;
873 ic
= CCL_HEADER_MAIN
;
877 case CCL_WriteConstString
: /* CCCCCCCCCCCCCCCCCCCCrrrXXXXX */
879 CCL_WRITE_CHAR (field1
);
882 CCL_WRITE_STRING (field1
);
883 ic
+= (field1
+ 2) / 3;
887 case CCL_WriteArray
: /* CCCCCCCCCCCCCCCCCCCCrrrXXXXX */
889 if ((unsigned int) i
< field1
)
891 j
= XINT (ccl_prog
[ic
+ i
]);
897 case CCL_End
: /* 0000000000000000000000XXXXX */
900 ccl_prog
= ccl_prog_stack_struct
[stack_idx
].ccl_prog
;
901 ic
= ccl_prog_stack_struct
[stack_idx
].ic
;
906 case CCL_ExprSelfConst
: /* 00000OPERATION000000rrrXXXXX */
907 i
= XINT (ccl_prog
[ic
]);
912 case CCL_ExprSelfReg
: /* 00000OPERATION000RRRrrrXXXXX */
919 case CCL_PLUS
: reg
[rrr
] += i
; break;
920 case CCL_MINUS
: reg
[rrr
] -= i
; break;
921 case CCL_MUL
: reg
[rrr
] *= i
; break;
922 case CCL_DIV
: reg
[rrr
] /= i
; break;
923 case CCL_MOD
: reg
[rrr
] %= i
; break;
924 case CCL_AND
: reg
[rrr
] &= i
; break;
925 case CCL_OR
: reg
[rrr
] |= i
; break;
926 case CCL_XOR
: reg
[rrr
] ^= i
; break;
927 case CCL_LSH
: reg
[rrr
] <<= i
; break;
928 case CCL_RSH
: reg
[rrr
] >>= i
; break;
929 case CCL_LSH8
: reg
[rrr
] <<= 8; reg
[rrr
] |= i
; break;
930 case CCL_RSH8
: reg
[7] = reg
[rrr
] & 0xFF; reg
[rrr
] >>= 8; break;
931 case CCL_DIVMOD
: reg
[7] = reg
[rrr
] % i
; reg
[rrr
] /= i
; break;
932 case CCL_LS
: reg
[rrr
] = reg
[rrr
] < i
; break;
933 case CCL_GT
: reg
[rrr
] = reg
[rrr
] > i
; break;
934 case CCL_EQ
: reg
[rrr
] = reg
[rrr
] == i
; break;
935 case CCL_LE
: reg
[rrr
] = reg
[rrr
] <= i
; break;
936 case CCL_GE
: reg
[rrr
] = reg
[rrr
] >= i
; break;
937 case CCL_NE
: reg
[rrr
] = reg
[rrr
] != i
; break;
938 default: CCL_INVALID_CMD
;
942 case CCL_SetExprConst
: /* 00000OPERATION000RRRrrrXXXXX */
944 j
= XINT (ccl_prog
[ic
]);
949 case CCL_SetExprReg
: /* 00000OPERATIONRrrRRRrrrXXXXX */
956 case CCL_ReadJumpCondExprConst
: /* A--D--D--R--E--S--S-rrrXXXXX */
957 CCL_READ_CHAR (reg
[rrr
]);
958 case CCL_JumpCondExprConst
: /* A--D--D--R--E--S--S-rrrXXXXX */
960 op
= XINT (ccl_prog
[ic
]);
961 jump_address
= ic
++ + ADDR
;
962 j
= XINT (ccl_prog
[ic
]);
967 case CCL_ReadJumpCondExprReg
: /* A--D--D--R--E--S--S-rrrXXXXX */
968 CCL_READ_CHAR (reg
[rrr
]);
969 case CCL_JumpCondExprReg
:
971 op
= XINT (ccl_prog
[ic
]);
972 jump_address
= ic
++ + ADDR
;
973 j
= reg
[XINT (ccl_prog
[ic
])];
980 case CCL_PLUS
: reg
[rrr
] = i
+ j
; break;
981 case CCL_MINUS
: reg
[rrr
] = i
- j
; break;
982 case CCL_MUL
: reg
[rrr
] = i
* j
; break;
983 case CCL_DIV
: reg
[rrr
] = i
/ j
; break;
984 case CCL_MOD
: reg
[rrr
] = i
% j
; break;
985 case CCL_AND
: reg
[rrr
] = i
& j
; break;
986 case CCL_OR
: reg
[rrr
] = i
| j
; break;
987 case CCL_XOR
: reg
[rrr
] = i
^ j
;; break;
988 case CCL_LSH
: reg
[rrr
] = i
<< j
; break;
989 case CCL_RSH
: reg
[rrr
] = i
>> j
; break;
990 case CCL_LSH8
: reg
[rrr
] = (i
<< 8) | j
; break;
991 case CCL_RSH8
: reg
[rrr
] = i
>> 8; reg
[7] = i
& 0xFF; break;
992 case CCL_DIVMOD
: reg
[rrr
] = i
/ j
; reg
[7] = i
% j
; break;
993 case CCL_LS
: reg
[rrr
] = i
< j
; break;
994 case CCL_GT
: reg
[rrr
] = i
> j
; break;
995 case CCL_EQ
: reg
[rrr
] = i
== j
; break;
996 case CCL_LE
: reg
[rrr
] = i
<= j
; break;
997 case CCL_GE
: reg
[rrr
] = i
>= j
; break;
998 case CCL_NE
: reg
[rrr
] = i
!= j
; break;
999 case CCL_ENCODE_SJIS
: ENCODE_SJIS (i
, j
, reg
[rrr
], reg
[7]); break;
1000 case CCL_DECODE_SJIS
: DECODE_SJIS (i
, j
, reg
[rrr
], reg
[7]); break;
1001 default: CCL_INVALID_CMD
;
1004 if (code
== CCL_WriteExprConst
|| code
== CCL_WriteExprRegister
)
1016 case CCL_ReadMultibyteCharacter
:
1021 goto ccl_read_multibyte_character_suspend
;
1024 if (i
== LEADING_CODE_COMPOSITION
)
1027 goto ccl_read_multibyte_character_suspend
;
1030 ccl
->private_state
= COMPOSING_WITH_RULE_HEAD
;
1034 ccl
->private_state
= COMPOSING_NO_RULE_HEAD
;
1036 if (ccl
->private_state
!= 0)
1038 /* composite character */
1040 ccl
->private_state
= 0;
1046 goto ccl_read_multibyte_character_suspend
;
1052 if (COMPOSING_WITH_RULE_RULE
== ccl
->private_state
)
1054 ccl
->private_state
= COMPOSING_WITH_RULE_HEAD
;
1057 else if (COMPOSING_WITH_RULE_HEAD
== ccl
->private_state
)
1058 ccl
->private_state
= COMPOSING_WITH_RULE_RULE
;
1065 reg
[RRR
] = CHARSET_ASCII
;
1067 else if (i
<= MAX_CHARSET_OFFICIAL_DIMENSION1
)
1070 goto ccl_read_multibyte_character_suspend
;
1072 reg
[rrr
] = (*src
++ & 0x7F);
1074 else if (i
<= MAX_CHARSET_OFFICIAL_DIMENSION2
)
1076 if ((src
+ 1) >= src_end
)
1077 goto ccl_read_multibyte_character_suspend
;
1079 i
= (*src
++ & 0x7F);
1080 reg
[rrr
] = ((i
<< 7) | (*src
& 0x7F));
1083 else if ((i
== LEADING_CODE_PRIVATE_11
) ||
1084 (i
== LEADING_CODE_PRIVATE_12
))
1086 if ((src
+ 1) >= src_end
)
1087 goto ccl_read_multibyte_character_suspend
;
1089 reg
[rrr
] = (*src
++ & 0x7F);
1091 else if ((i
== LEADING_CODE_PRIVATE_21
) ||
1092 (i
== LEADING_CODE_PRIVATE_22
))
1094 if ((src
+ 2) >= src_end
)
1095 goto ccl_read_multibyte_character_suspend
;
1097 i
= (*src
++ & 0x7F);
1098 reg
[rrr
] = ((i
<< 7) | (*src
& 0x7F));
1104 Returned charset is -1.*/
1110 ccl_read_multibyte_character_suspend
:
1112 if (ccl
->last_block
)
1118 CCL_SUSPEND (CCL_STAT_SUSPEND_BY_SRC
);
1122 case CCL_WriteMultibyteCharacter
:
1123 i
= reg
[RRR
]; /* charset */
1124 if (i
== CHARSET_ASCII
)
1125 i
= reg
[rrr
] & 0x7F;
1126 else if (i
== CHARSET_COMPOSITION
)
1127 i
= MAKE_COMPOSITE_CHAR (reg
[rrr
]);
1128 else if (CHARSET_DIMENSION (i
) == 1)
1129 i
= ((i
- 0x70) << 7) | (reg
[rrr
] & 0x7F);
1130 else if (i
< MIN_CHARSET_PRIVATE_DIMENSION2
)
1131 i
= ((i
- 0x8F) << 14) | reg
[rrr
];
1133 i
= ((i
- 0xE0) << 14) | reg
[rrr
];
1139 case CCL_UnifyCharacter
:
1140 i
= reg
[RRR
]; /* charset */
1141 if (i
== CHARSET_ASCII
)
1142 i
= reg
[rrr
] & 0x7F;
1143 else if (i
== CHARSET_COMPOSITION
)
1148 else if (CHARSET_DIMENSION (i
) == 1)
1149 i
= ((i
- 0x70) << 7) | (reg
[rrr
] & 0x7F);
1150 else if (i
< MIN_CHARSET_PRIVATE_DIMENSION2
)
1151 i
= ((i
- 0x8F) << 14) | (reg
[rrr
] & 0x3FFF);
1153 i
= ((i
- 0xE0) << 14) | (reg
[rrr
] & 0x3FFF);
1155 op
= unify_char (UNIFICATION_ID_TABLE (reg
[Rrr
]), i
, -1, 0, 0);
1156 SPLIT_CHAR (op
, reg
[RRR
], i
, j
);
1163 case CCL_UnifyCharacterConstTbl
:
1164 op
= XINT (ccl_prog
[ic
]); /* table */
1166 i
= reg
[RRR
]; /* charset */
1167 if (i
== CHARSET_ASCII
)
1168 i
= reg
[rrr
] & 0x7F;
1169 else if (i
== CHARSET_COMPOSITION
)
1174 else if (CHARSET_DIMENSION (i
) == 1)
1175 i
= ((i
- 0x70) << 7) | (reg
[rrr
] & 0x7F);
1176 else if (i
< MIN_CHARSET_PRIVATE_DIMENSION2
)
1177 i
= ((i
- 0x8F) << 14) | (reg
[rrr
] & 0x3FFF);
1179 i
= ((i
- 0xE0) << 14) | (reg
[rrr
] & 0x3FFF);
1181 op
= unify_char (UNIFICATION_ID_TABLE (op
), i
, -1, 0, 0);
1182 SPLIT_CHAR (op
, reg
[RRR
], i
, j
);
1189 case CCL_IterateMultipleMap
:
1191 Lisp_Object table
, content
, attrib
, value
;
1192 int point
, size
, fin_ic
;
1194 j
= XINT (ccl_prog
[ic
++]); /* number of tables. */
1197 if ((j
> reg
[RRR
]) && (j
>= 0))
1212 size
= XVECTOR (Vccl_translation_table_vector
)->size
;
1213 point
= ccl_prog
[ic
++];
1214 if (point
>= size
) continue;
1215 table
= XVECTOR (Vccl_translation_table_vector
)->
1217 if (!CONSP (table
)) continue;
1218 table
= XCONS(table
)->cdr
;
1219 if (!VECTORP (table
)) continue;
1220 size
= XVECTOR (table
)->size
;
1221 if (size
<= 1) continue;
1222 point
= XUINT (XVECTOR (table
)->contents
[0]);
1223 point
= op
- point
+ 1;
1224 if (!((point
>= 1) && (point
< size
))) continue;
1225 content
= XVECTOR (table
)->contents
[point
];
1229 else if (NUMBERP (content
))
1232 reg
[rrr
] = XUINT(content
);
1235 else if (EQ (content
, Qt
) || EQ (content
, Qlambda
))
1240 else if (CONSP (content
))
1242 attrib
= XCONS (content
)->car
;
1243 value
= XCONS (content
)->cdr
;
1244 if (!NUMBERP (attrib
) || !NUMBERP (value
))
1247 reg
[rrr
] = XUINT(value
);
1257 case CCL_TranslateMultipleMap
:
1259 Lisp_Object table
, content
, attrib
, value
;
1260 int point
, size
, table_vector_size
;
1261 int skip_to_next
, fin_ic
;
1263 j
= XINT (ccl_prog
[ic
++]); /* number of tables and separators. */
1265 if ((j
> reg
[RRR
]) && (j
>= 0))
1279 table_vector_size
= XVECTOR (Vccl_translation_table_vector
)->size
;
1282 point
= ccl_prog
[ic
++];
1283 if (XINT(point
) == -1)
1288 if (skip_to_next
) continue;
1289 if (point
>= table_vector_size
) continue;
1290 table
= XVECTOR (Vccl_translation_table_vector
)->
1292 if (!CONSP (table
)) continue;
1293 table
= XCONS (table
)->cdr
;
1294 if (!VECTORP (table
)) continue;
1295 size
= XVECTOR (table
)->size
;
1296 if (size
<= 1) continue;
1297 point
= XUINT (XVECTOR (table
)->contents
[0]);
1298 point
= op
- point
+ 1;
1299 if (!((point
>= 1) && (point
< size
))) continue;
1300 content
= XVECTOR (table
)->contents
[point
];
1304 else if (NUMBERP (content
))
1306 op
= XUINT (content
);
1310 else if (CONSP (content
))
1312 attrib
= XCONS (content
)->car
;
1313 value
= XCONS (content
)->cdr
;
1314 if (!NUMBERP (attrib
) || !NUMBERP (value
))
1320 else if (EQ (content
, Qt
))
1326 else if (EQ (content
, Qlambda
))
1334 case CCL_TranslateSingleMap
:
1336 Lisp_Object table
, attrib
, value
, content
;
1338 j
= XINT (ccl_prog
[ic
++]); /* table_id */
1340 if (j
>= XVECTOR (Vccl_translation_table_vector
)->size
)
1345 table
= XVECTOR (Vccl_translation_table_vector
)->
1352 table
= XCONS(table
)->cdr
;
1353 if (!VECTORP (table
))
1358 size
= XVECTOR (table
)->size
;
1359 point
= XUINT (XVECTOR (table
)->contents
[0]);
1360 point
= op
- point
+ 1;
1363 (!((point
>= 1) && (point
< size
))))
1367 content
= XVECTOR (table
)->contents
[point
];
1370 else if (NUMBERP (content
))
1371 reg
[rrr
] = XUINT (content
);
1372 else if (EQ (content
, Qt
))
1374 else if (CONSP (content
))
1376 attrib
= XCONS (content
)->car
;
1377 value
= XCONS (content
)->cdr
;
1378 if (!NUMBERP (attrib
) || !NUMBERP (value
))
1380 reg
[rrr
] = XUINT(value
);
1402 /* We can insert an error message only if DESTINATION is
1403 specified and we still have a room to store the message
1408 switch (ccl
->status
)
1410 case CCL_STAT_INVALID_CMD
:
1411 sprintf(msg
, "\nCCL: Invalid command %x (ccl_code = %x) at %d.",
1412 code
& 0x1F, code
, ic
);
1415 int i
= ccl_backtrace_idx
- 1;
1418 msglen
= strlen (msg
);
1419 if (dst
+ msglen
<= (dst_bytes
? dst_end
: src
))
1421 bcopy (msg
, dst
, msglen
);
1425 for (j
= 0; j
< CCL_DEBUG_BACKTRACE_LEN
; j
++, i
--)
1427 if (i
< 0) i
= CCL_DEBUG_BACKTRACE_LEN
- 1;
1428 if (ccl_backtrace_table
[i
] == 0)
1430 sprintf(msg
, " %d", ccl_backtrace_table
[i
]);
1431 msglen
= strlen (msg
);
1432 if (dst
+ msglen
> (dst_bytes
? dst_end
: src
))
1434 bcopy (msg
, dst
, msglen
);
1442 sprintf(msg
, "\nCCL: Quited.");
1446 sprintf(msg
, "\nCCL: Unknown error type (%d).", ccl
->status
);
1449 msglen
= strlen (msg
);
1450 if (dst
+ msglen
<= (dst_bytes
? dst_end
: src
))
1452 bcopy (msg
, dst
, msglen
);
1459 if (consumed
) *consumed
= src
- source
;
1460 return dst
- destination
;
1463 /* Setup fields of the structure pointed by CCL appropriately for the
1464 execution of compiled CCL code in VEC (vector of integer). */
1466 setup_ccl_program (ccl
, vec
)
1467 struct ccl_program
*ccl
;
1472 ccl
->size
= XVECTOR (vec
)->size
;
1473 ccl
->prog
= XVECTOR (vec
)->contents
;
1474 ccl
->ic
= CCL_HEADER_MAIN
;
1475 ccl
->eof_ic
= XINT (XVECTOR (vec
)->contents
[CCL_HEADER_EOF
]);
1476 ccl
->buf_magnification
= XINT (XVECTOR (vec
)->contents
[CCL_HEADER_BUF_MAG
]);
1477 for (i
= 0; i
< 8; i
++)
1479 ccl
->last_block
= 0;
1480 ccl
->private_state
= 0;
1486 DEFUN ("ccl-execute", Fccl_execute
, Sccl_execute
, 2, 2, 0,
1487 "Execute CCL-PROGRAM with registers initialized by REGISTERS.\n\
1488 CCL-PROGRAM is a compiled code generated by `ccl-compile',\n\
1489 no I/O commands should appear in the CCL program.\n\
1490 REGISTERS is a vector of [R0 R1 ... R7] where RN is an initial value\n\
1492 As side effect, each element of REGISTER holds the value of\n\
1493 corresponding register after the execution.")
1495 Lisp_Object ccl_prog
, reg
;
1497 struct ccl_program ccl
;
1500 CHECK_VECTOR (ccl_prog
, 0);
1501 CHECK_VECTOR (reg
, 1);
1502 if (XVECTOR (reg
)->size
!= 8)
1503 error ("Invalid length of vector REGISTERS");
1505 setup_ccl_program (&ccl
, ccl_prog
);
1506 for (i
= 0; i
< 8; i
++)
1507 ccl
.reg
[i
] = (INTEGERP (XVECTOR (reg
)->contents
[i
])
1508 ? XINT (XVECTOR (reg
)->contents
[i
])
1511 ccl_driver (&ccl
, (char *)0, (char *)0, 0, 0, (int *)0);
1513 if (ccl
.status
!= CCL_STAT_SUCCESS
)
1514 error ("Error in CCL program at %dth code", ccl
.ic
);
1516 for (i
= 0; i
< 8; i
++)
1517 XSETINT (XVECTOR (reg
)->contents
[i
], ccl
.reg
[i
]);
1521 DEFUN ("ccl-execute-on-string", Fccl_execute_on_string
, Sccl_execute_on_string
,
1523 "Execute CCL-PROGRAM with initial STATUS on STRING.\n\
1524 CCL-PROGRAM is a compiled code generated by `ccl-compile'.\n\
1525 Read buffer is set to STRING, and write buffer is allocated automatically.\n\
1526 STATUS is a vector of [R0 R1 ... R7 IC], where\n\
1527 R0..R7 are initial values of corresponding registers,\n\
1528 IC is the instruction counter specifying from where to start the program.\n\
1529 If R0..R7 are nil, they are initialized to 0.\n\
1530 If IC is nil, it is initialized to head of the CCL program.\n\
1532 If optional 4th arg CONTIN is non-nil, keep IC on read operation\n\
1533 when read buffer is exausted, else, IC is always set to the end of\n\
1534 CCL-PROGRAM on exit.\n\
1536 It returns the contents of write buffer as a string,\n\
1537 and as side effect, STATUS is updated.\n\
1538 If the optional 5th arg UNIBYTE-P is non-nil, the returned string\n\
1539 is a unibyte string. By default it is a multibyte string.")
1540 (ccl_prog
, status
, str
, contin
, unibyte_p
)
1541 Lisp_Object ccl_prog
, status
, str
, contin
, unibyte_p
;
1544 struct ccl_program ccl
;
1548 struct gcpro gcpro1
, gcpro2
, gcpro3
;
1550 CHECK_VECTOR (ccl_prog
, 0);
1551 CHECK_VECTOR (status
, 1);
1552 if (XVECTOR (status
)->size
!= 9)
1553 error ("Invalid length of vector STATUS");
1554 CHECK_STRING (str
, 2);
1555 GCPRO3 (ccl_prog
, status
, str
);
1557 setup_ccl_program (&ccl
, ccl_prog
);
1558 for (i
= 0; i
< 8; i
++)
1560 if (NILP (XVECTOR (status
)->contents
[i
]))
1561 XSETINT (XVECTOR (status
)->contents
[i
], 0);
1562 if (INTEGERP (XVECTOR (status
)->contents
[i
]))
1563 ccl
.reg
[i
] = XINT (XVECTOR (status
)->contents
[i
]);
1565 if (INTEGERP (XVECTOR (status
)->contents
[i
]))
1567 i
= XFASTINT (XVECTOR (status
)->contents
[8]);
1568 if (ccl
.ic
< i
&& i
< ccl
.size
)
1571 outbufsize
= STRING_BYTES (XSTRING (str
)) * ccl
.buf_magnification
+ 256;
1572 outbuf
= (char *) xmalloc (outbufsize
);
1574 error ("Not enough memory");
1575 ccl
.last_block
= NILP (contin
);
1576 produced
= ccl_driver (&ccl
, XSTRING (str
)->data
, outbuf
,
1577 STRING_BYTES (XSTRING (str
)), outbufsize
, (int *)0);
1578 for (i
= 0; i
< 8; i
++)
1579 XSET (XVECTOR (status
)->contents
[i
], Lisp_Int
, ccl
.reg
[i
]);
1580 XSETINT (XVECTOR (status
)->contents
[8], ccl
.ic
);
1583 if (NILP (unibyte_p
))
1584 val
= make_string (outbuf
, produced
);
1586 val
= make_unibyte_string (outbuf
, produced
);
1589 if (ccl
.status
!= CCL_STAT_SUCCESS
1590 && ccl
.status
!= CCL_STAT_SUSPEND_BY_SRC
1591 && ccl
.status
!= CCL_STAT_SUSPEND_BY_DST
)
1592 error ("Error in CCL program at %dth code", ccl
.ic
);
1597 DEFUN ("register-ccl-program", Fregister_ccl_program
, Sregister_ccl_program
,
1599 "Register CCL program PROGRAM of NAME in `ccl-program-table'.\n\
1600 PROGRAM should be a compiled code of CCL program, or nil.\n\
1601 Return index number of the registered CCL program.")
1603 Lisp_Object name
, ccl_prog
;
1605 int len
= XVECTOR (Vccl_program_table
)->size
;
1608 CHECK_SYMBOL (name
, 0);
1609 if (!NILP (ccl_prog
))
1610 CHECK_VECTOR (ccl_prog
, 1);
1612 for (i
= 0; i
< len
; i
++)
1614 Lisp_Object slot
= XVECTOR (Vccl_program_table
)->contents
[i
];
1619 if (EQ (name
, XCONS (slot
)->car
))
1621 XCONS (slot
)->cdr
= ccl_prog
;
1622 return make_number (i
);
1628 Lisp_Object new_table
= Fmake_vector (make_number (len
* 2), Qnil
);
1631 for (j
= 0; j
< len
; j
++)
1632 XVECTOR (new_table
)->contents
[j
]
1633 = XVECTOR (Vccl_program_table
)->contents
[j
];
1634 Vccl_program_table
= new_table
;
1637 XVECTOR (Vccl_program_table
)->contents
[i
] = Fcons (name
, ccl_prog
);
1638 return make_number (i
);
1641 /* register CCL translation table.
1642 CCL translation table consists of numbers and Qt and Qnil and Qlambda.
1643 The first element is start code point.
1644 The rest elements are translated numbers.
1645 Qt shows that an original number before translation.
1646 Qnil shows that an empty element.
1647 Qlambda makes translation stopped.
1650 DEFUN ("register-ccl-translation-table", Fregister_ccl_translation_table
,
1651 Sregister_ccl_translation_table
,
1653 "Register CCL translation table.\n\
1654 TABLE should be a vector. SYMBOL is used for pointing the translation table out.\n\
1655 Return index number of the registered translation table.")
1657 Lisp_Object symbol
, table
;
1659 int len
= XVECTOR (Vccl_translation_table_vector
)->size
;
1663 CHECK_SYMBOL (symbol
, 0);
1664 CHECK_VECTOR (table
, 1);
1666 for (i
= 0; i
< len
; i
++)
1668 Lisp_Object slot
= XVECTOR (Vccl_translation_table_vector
)->contents
[i
];
1673 if (EQ (symbol
, XCONS (slot
)->car
))
1675 index
= make_number (i
);
1676 XCONS (slot
)->cdr
= table
;
1677 Fput (symbol
, Qccl_translation_table
, table
);
1678 Fput (symbol
, Qccl_translation_table_id
, index
);
1685 Lisp_Object new_vector
= Fmake_vector (make_number (len
* 2), Qnil
);
1688 for (j
= 0; j
< len
; j
++)
1689 XVECTOR (new_vector
)->contents
[j
]
1690 = XVECTOR (Vccl_translation_table_vector
)->contents
[j
];
1691 Vccl_translation_table_vector
= new_vector
;
1694 index
= make_number (i
);
1695 Fput (symbol
, Qccl_translation_table
, table
);
1696 Fput (symbol
, Qccl_translation_table_id
, index
);
1697 XVECTOR (Vccl_translation_table_vector
)->contents
[i
] = Fcons (symbol
, table
);
1704 staticpro (&Vccl_program_table
);
1705 Vccl_program_table
= Fmake_vector (make_number (32), Qnil
);
1707 Qccl_program
= intern("ccl-program");
1708 staticpro(&Qccl_program
);
1710 Qccl_translation_table
= intern ("ccl-translation-table");
1711 staticpro (&Qccl_translation_table
);
1713 Qccl_translation_table_id
= intern ("ccl-translation-table-id");
1714 staticpro (&Qccl_translation_table_id
);
1716 DEFVAR_LISP ("ccl-translation-table-vector", &Vccl_translation_table_vector
,
1717 "Where is stored translation tables for CCL program.\n\
1718 Because CCL program can't access these tables except by the index of the vector.");
1719 Vccl_translation_table_vector
= Fmake_vector (XFASTINT (16), Qnil
);
1721 DEFVAR_LISP ("font-ccl-encoder-alist", &Vfont_ccl_encoder_alist
,
1722 "Alist of fontname patterns vs corresponding CCL program.\n\
1723 Each element looks like (REGEXP . CCL-CODE),\n\
1724 where CCL-CODE is a compiled CCL program.\n\
1725 When a font whose name matches REGEXP is used for displaying a character,\n\
1726 CCL-CODE is executed to calculate the code point in the font\n\
1727 from the charset number and position code(s) of the character which are set\n\
1728 in CCL registers R0, R1, and R2 before the execution.\n\
1729 The code point in the font is set in CCL registers R1 and R2\n\
1730 when the execution terminated.\n\
1731 If the font is single-byte font, the register R2 is not used.");
1732 Vfont_ccl_encoder_alist
= Qnil
;
1734 defsubr (&Sccl_execute
);
1735 defsubr (&Sccl_execute_on_string
);
1736 defsubr (&Sregister_ccl_program
);
1737 defsubr (&Sregister_ccl_translation_table
);