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 XEmacs.
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. */
22 /* Synched up with : FSF Emacs 20.2 */
30 #include "character.h"
32 #include "mule-charset.h"
35 #include "file-coding.h"
42 #endif /* not emacs */
44 /* Alist of fontname patterns vs corresponding CCL program. */
45 Lisp_Object Vfont_ccl_encoder_alist;
47 /* Vector of CCL program names vs corresponding program data. */
48 Lisp_Object Vccl_program_table;
50 /* CCL (Code Conversion Language) is a simple language which has
51 operations on one input buffer, one output buffer, and 7 registers.
52 The syntax of CCL is described in `ccl.el'. Emacs Lisp function
53 `ccl-compile' compiles a CCL program and produces a CCL code which
54 is a vector of integers. The structure of this vector is as
55 follows: The 1st element: buffer-magnification, a factor for the
56 size of output buffer compared with the size of input buffer. The
57 2nd element: address of CCL code to be executed when encountered
58 with end of input stream. The 3rd and the remaining elements: CCL
61 /* Header of CCL compiled code */
62 #define CCL_HEADER_BUF_MAG 0
63 #define CCL_HEADER_EOF 1
64 #define CCL_HEADER_MAIN 2
66 /* CCL code is a sequence of 28-bit non-negative integers (i.e. the
67 MSB is always 0), each contains CCL command and/or arguments in the
70 |----------------- integer (28-bit) ------------------|
71 |------- 17-bit ------|- 3-bit --|- 3-bit --|- 5-bit -|
72 |--constant argument--|-register-|-register-|-command-|
73 ccccccccccccccccc RRR rrr XXXXX
75 |------- relative address -------|-register-|-command-|
76 cccccccccccccccccccc rrr XXXXX
78 |------------- constant or other args ----------------|
79 cccccccccccccccccccccccccccc
81 where, `cc...c' is a non-negative integer indicating constant value
82 (the left most `c' is always 0) or an absolute jump address, `RRR'
83 and `rrr' are CCL register number, `XXXXX' is one of the following
88 Each comment fields shows one or more lines for command syntax and
89 the following lines for semantics of the command. In semantics, IC
90 stands for Instruction Counter. */
92 #define CCL_SetRegister 0x00 /* Set register a register value:
93 1:00000000000000000RRRrrrXXXXX
94 ------------------------------
98 #define CCL_SetShortConst 0x01 /* Set register a short constant value:
99 1:CCCCCCCCCCCCCCCCCCCCrrrXXXXX
100 ------------------------------
101 reg[rrr] = CCCCCCCCCCCCCCCCCCC;
104 #define CCL_SetConst 0x02 /* Set register a constant value:
105 1:00000000000000000000rrrXXXXX
107 ------------------------------
112 #define CCL_SetArray 0x03 /* Set register an element of array:
113 1:CCCCCCCCCCCCCCCCCRRRrrrXXXXX
117 ------------------------------
118 if (0 <= reg[RRR] < CC..C)
119 reg[rrr] = ELEMENT[reg[RRR]];
123 #define CCL_Jump 0x04 /* Jump:
124 1:A--D--D--R--E--S--S-000XXXXX
125 ------------------------------
129 /* Note: If CC..C is greater than 0, the second code is omitted. */
131 #define CCL_JumpCond 0x05 /* Jump conditional:
132 1:A--D--D--R--E--S--S-rrrXXXXX
133 ------------------------------
139 #define CCL_WriteRegisterJump 0x06 /* Write register and jump:
140 1:A--D--D--R--E--S--S-rrrXXXXX
141 ------------------------------
146 #define CCL_WriteRegisterReadJump 0x07 /* Write register, read, and jump:
147 1:A--D--D--R--E--S--S-rrrXXXXX
148 2:A--D--D--R--E--S--S-rrrYYYYY
149 -----------------------------
155 /* Note: If read is suspended, the resumed execution starts from the
156 second code (YYYYY == CCL_ReadJump). */
158 #define CCL_WriteConstJump 0x08 /* Write constant and jump:
159 1:A--D--D--R--E--S--S-000XXXXX
161 ------------------------------
166 #define CCL_WriteConstReadJump 0x09 /* Write constant, read, and jump:
167 1:A--D--D--R--E--S--S-rrrXXXXX
169 3:A--D--D--R--E--S--S-rrrYYYYY
170 -----------------------------
176 /* Note: If read is suspended, the resumed execution starts from the
177 second code (YYYYY == CCL_ReadJump). */
179 #define CCL_WriteStringJump 0x0A /* Write string and jump:
180 1:A--D--D--R--E--S--S-000XXXXX
182 3:0000STRIN[0]STRIN[1]STRIN[2]
184 ------------------------------
185 write_string (STRING, LENGTH);
189 #define CCL_WriteArrayReadJump 0x0B /* Write an array element, read, and jump:
190 1:A--D--D--R--E--S--S-rrrXXXXX
195 N:A--D--D--R--E--S--S-rrrYYYYY
196 ------------------------------
197 if (0 <= reg[rrr] < LENGTH)
198 write (ELEMENT[reg[rrr]]);
199 IC += LENGTH + 2; (... pointing at N+1)
203 /* Note: If read is suspended, the resumed execution starts from the
204 Nth code (YYYYY == CCL_ReadJump). */
206 #define CCL_ReadJump 0x0C /* Read and jump:
207 1:A--D--D--R--E--S--S-rrrYYYYY
208 -----------------------------
213 #define CCL_Branch 0x0D /* Jump by branch table:
214 1:CCCCCCCCCCCCCCCCCCCCrrrXXXXX
215 2:A--D--D--R--E-S-S[0]000XXXXX
216 3:A--D--D--R--E-S-S[1]000XXXXX
218 ------------------------------
219 if (0 <= reg[rrr] < CC..C)
220 IC += ADDRESS[reg[rrr]];
222 IC += ADDRESS[CC..C];
225 #define CCL_ReadRegister 0x0E /* Read bytes into registers:
226 1:CCCCCCCCCCCCCCCCCCCCrrrXXXXX
227 2:CCCCCCCCCCCCCCCCCCCCrrrXXXXX
229 ------------------------------
234 #define CCL_WriteExprConst 0x0F /* write result of expression:
235 1:00000OPERATION000RRR000XXXXX
237 ------------------------------
238 write (reg[RRR] OPERATION CONSTANT);
242 /* Note: If the Nth read is suspended, the resumed execution starts
243 from the Nth code. */
245 #define CCL_ReadBranch 0x10 /* Read one byte into a register,
246 and jump by branch table:
247 1:CCCCCCCCCCCCCCCCCCCCrrrXXXXX
248 2:A--D--D--R--E-S-S[0]000XXXXX
249 3:A--D--D--R--E-S-S[1]000XXXXX
251 ------------------------------
253 if (0 <= reg[rrr] < CC..C)
254 IC += ADDRESS[reg[rrr]];
256 IC += ADDRESS[CC..C];
259 #define CCL_WriteRegister 0x11 /* Write registers:
260 1:CCCCCCCCCCCCCCCCCCCrrrXXXXX
261 2:CCCCCCCCCCCCCCCCCCCrrrXXXXX
263 ------------------------------
269 /* Note: If the Nth write is suspended, the resumed execution
270 starts from the Nth code. */
272 #define CCL_WriteExprRegister 0x12 /* Write result of expression
273 1:00000OPERATIONRrrRRR000XXXXX
274 ------------------------------
275 write (reg[RRR] OPERATION reg[Rrr]);
278 #define CCL_Call 0x13 /* Write a constant:
279 1:CCCCCCCCCCCCCCCCCCCC000XXXXX
280 ------------------------------
284 #define CCL_WriteConstString 0x14 /* Write a constant or a string:
285 1:CCCCCCCCCCCCCCCCCCCCrrrXXXXX
286 [2:0000STRIN[0]STRIN[1]STRIN[2]]
288 -----------------------------
292 write_string (STRING, CC..C);
293 IC += (CC..C + 2) / 3;
296 #define CCL_WriteArray 0x15 /* Write an element of array:
297 1:CCCCCCCCCCCCCCCCCCCCrrrXXXXX
301 ------------------------------
302 if (0 <= reg[rrr] < CC..C)
303 write (ELEMENT[reg[rrr]]);
307 #define CCL_End 0x16 /* Terminate:
308 1:00000000000000000000000XXXXX
309 ------------------------------
313 /* The following two codes execute an assignment arithmetic/logical
314 operation. The form of the operation is like REG OP= OPERAND. */
316 #define CCL_ExprSelfConst 0x17 /* REG OP= constant:
317 1:00000OPERATION000000rrrXXXXX
319 ------------------------------
320 reg[rrr] OPERATION= CONSTANT;
323 #define CCL_ExprSelfReg 0x18 /* REG1 OP= REG2:
324 1:00000OPERATION000RRRrrrXXXXX
325 ------------------------------
326 reg[rrr] OPERATION= reg[RRR];
329 /* The following codes execute an arithmetic/logical operation. The
330 form of the operation is like REG_X = REG_Y OP OPERAND2. */
332 #define CCL_SetExprConst 0x19 /* REG_X = REG_Y OP constant:
333 1:00000OPERATION000RRRrrrXXXXX
335 ------------------------------
336 reg[rrr] = reg[RRR] OPERATION CONSTANT;
340 #define CCL_SetExprReg 0x1A /* REG1 = REG2 OP REG3:
341 1:00000OPERATIONRrrRRRrrrXXXXX
342 ------------------------------
343 reg[rrr] = reg[RRR] OPERATION reg[Rrr];
346 #define CCL_JumpCondExprConst 0x1B /* Jump conditional according to
347 an operation on constant:
348 1:A--D--D--R--E--S--S-rrrXXXXX
351 -----------------------------
352 reg[7] = reg[rrr] OPERATION CONSTANT;
359 #define CCL_JumpCondExprReg 0x1C /* Jump conditional according to
360 an operation on register:
361 1:A--D--D--R--E--S--S-rrrXXXXX
364 -----------------------------
365 reg[7] = reg[rrr] OPERATION reg[RRR];
372 #define CCL_ReadJumpCondExprConst 0x1D /* Read and jump conditional according
373 to an operation on constant:
374 1:A--D--D--R--E--S--S-rrrXXXXX
377 -----------------------------
379 reg[7] = reg[rrr] OPERATION CONSTANT;
386 #define CCL_ReadJumpCondExprReg 0x1E /* Read and jump conditional according
387 to an operation on register:
388 1:A--D--D--R--E--S--S-rrrXXXXX
391 -----------------------------
393 reg[7] = reg[rrr] OPERATION reg[RRR];
400 #define CCL_Extention 0x1F /* Extended CCL code
401 1:ExtendedCOMMNDRrrRRRrrrXXXXX
404 ------------------------------
405 extended_command (rrr,RRR,Rrr,ARGS)
409 /* CCL arithmetic/logical operators. */
410 #define CCL_PLUS 0x00 /* X = Y + Z */
411 #define CCL_MINUS 0x01 /* X = Y - Z */
412 #define CCL_MUL 0x02 /* X = Y * Z */
413 #define CCL_DIV 0x03 /* X = Y / Z */
414 #define CCL_MOD 0x04 /* X = Y % Z */
415 #define CCL_AND 0x05 /* X = Y & Z */
416 #define CCL_OR 0x06 /* X = Y | Z */
417 #define CCL_XOR 0x07 /* X = Y ^ Z */
418 #define CCL_LSH 0x08 /* X = Y << Z */
419 #define CCL_RSH 0x09 /* X = Y >> Z */
420 #define CCL_LSH8 0x0A /* X = (Y << 8) | Z */
421 #define CCL_RSH8 0x0B /* X = Y >> 8, r[7] = Y & 0xFF */
422 #define CCL_DIVMOD 0x0C /* X = Y / Z, r[7] = Y % Z */
423 #define CCL_LS 0x10 /* X = (X < Y) */
424 #define CCL_GT 0x11 /* X = (X > Y) */
425 #define CCL_EQ 0x12 /* X = (X == Y) */
426 #define CCL_LE 0x13 /* X = (X <= Y) */
427 #define CCL_GE 0x14 /* X = (X >= Y) */
428 #define CCL_NE 0x15 /* X = (X != Y) */
430 #define CCL_ENCODE_SJIS 0x16 /* X = HIGHER_BYTE (SJIS (Y, Z))
431 r[7] = LOWER_BYTE (SJIS (Y, Z) */
432 #define CCL_DECODE_SJIS 0x17 /* X = HIGHER_BYTE (DE-SJIS (Y, Z))
433 r[7] = LOWER_BYTE (DE-SJIS (Y, Z)) */
435 /* Macros for exit status of CCL program. */
436 #define CCL_STAT_SUCCESS 0 /* Terminated successfully. */
437 #define CCL_STAT_SUSPEND 1 /* Terminated because of empty input
438 buffer or full output buffer. */
439 #define CCL_STAT_INVALID_CMD 2 /* Terminated because of invalid
441 #define CCL_STAT_QUIT 3 /* Terminated because of quit. */
443 /* Encode one character CH to multibyte form and write to the current
444 output buffer. If CH is less than 256, CH is written as is. */
445 #define CCL_WRITE_CHAR(ch) do { \
448 ccl->status = CCL_STAT_INVALID_CMD; \
449 goto ccl_error_handler; \
453 Bufbyte work[MAX_EMCHAR_LEN]; \
454 int len = ( ch < ( conversion_mode == CCL_MODE_ENCODING ? \
456 simple_set_charptr_emchar (work, ch) : \
457 non_ascii_set_charptr_emchar (work, ch); \
458 Dynarr_add_many (destination, work, len); \
462 /* Write a string at ccl_prog[IC] of length LEN to the current output
464 #define CCL_WRITE_STRING(len) do { \
467 ccl->status = CCL_STAT_INVALID_CMD; \
468 goto ccl_error_handler; \
471 for (i = 0; i < len; i++) \
472 Dynarr_add(destination, \
473 (XINT (ccl_prog[ic + (i / 3)]) \
474 >> ((2 - (i % 3)) * 8)) & 0xFF); \
477 /* Read one byte from the current input buffer into Rth register. */
478 #define CCL_READ_CHAR(r) do { \
481 ccl->status = CCL_STAT_INVALID_CMD; \
482 goto ccl_error_handler; \
484 else if (src < src_end) \
486 else if (ccl->last_block) \
492 /* Suspend CCL program because of \
493 reading from empty input buffer or \
494 writing to full output buffer. \
495 When this program is resumed, the \
496 same I/O command is executed. */ \
499 ccl->status = CCL_STAT_SUSPEND; \
505 /* Execute CCL code on SRC_BYTES length text at SOURCE. The resulting
506 text goes to a place pointed by DESTINATION. The bytes actually
507 processed is returned as *CONSUMED. The return value is the length
508 of the resulting text. As a side effect, the contents of CCL registers
509 are updated. If SOURCE or DESTINATION is NULL, only operations on
510 registers are permitted. */
513 #define CCL_DEBUG_BACKTRACE_LEN 256
514 int ccl_backtrace_table[CCL_BACKTRACE_TABLE];
515 int ccl_backtrace_idx;
518 struct ccl_prog_stack
520 Lisp_Object *ccl_prog; /* Pointer to an array of CCL code. */
521 int ic; /* Instruction Counter. */
525 ccl_driver (struct ccl_program *ccl, CONST unsigned char *source, unsigned_char_dynarr *destination, int src_bytes, int *consumed, int conversion_mode)
529 int code = -1; /* init to illegal value, */
531 Lisp_Object *ccl_prog = ccl->prog;
532 CONST unsigned char *src = source, *src_end = src + src_bytes;
533 int jump_address = 0; /* shut up the compiler */
537 /* For the moment, we only support depth 256 of stack. */
538 struct ccl_prog_stack ccl_prog_stack_struct[256];
540 if (ic >= ccl->eof_ic)
541 ic = CCL_HEADER_MAIN;
544 ccl_backtrace_idx = 0;
550 ccl_backtrace_table[ccl_backtrace_idx++] = ic;
551 if (ccl_backtrace_idx >= CCL_DEBUG_BACKTRACE_LEN)
552 ccl_backtrace_idx = 0;
553 ccl_backtrace_table[ccl_backtrace_idx] = 0;
556 if (!NILP (Vquit_flag) && NILP (Vinhibit_quit))
558 /* We can't just signal Qquit, instead break the loop as if
559 the whole data is processed. Don't reset Vquit_flag, it
560 must be handled later at a safer place. */
562 src = source + src_bytes;
563 ccl->status = CCL_STAT_QUIT;
567 code = XINT (ccl_prog[ic]); ic++;
569 field2 = (code & 0xFF) >> 5;
572 #define RRR (field1 & 7)
573 #define Rrr ((field1 >> 3) & 7)
578 case CCL_SetRegister: /* 00000000000000000RRRrrrXXXXX */
582 case CCL_SetShortConst: /* CCCCCCCCCCCCCCCCCCCCrrrXXXXX */
586 case CCL_SetConst: /* 00000000000000000000rrrXXXXX */
587 reg[rrr] = XINT (ccl_prog[ic]);
591 case CCL_SetArray: /* CCCCCCCCCCCCCCCCCCCCRRRrrrXXXXX */
594 if ((unsigned int) i < j)
595 reg[rrr] = XINT (ccl_prog[ic + i]);
599 case CCL_Jump: /* A--D--D--R--E--S--S-000XXXXX */
603 case CCL_JumpCond: /* A--D--D--R--E--S--S-rrrXXXXX */
608 case CCL_WriteRegisterJump: /* A--D--D--R--E--S--S-rrrXXXXX */
614 case CCL_WriteRegisterReadJump: /* A--D--D--R--E--S--S-rrrXXXXX */
618 CCL_READ_CHAR (reg[rrr]);
622 case CCL_WriteConstJump: /* A--D--D--R--E--S--S-000XXXXX */
623 i = XINT (ccl_prog[ic]);
628 case CCL_WriteConstReadJump: /* A--D--D--R--E--S--S-rrrXXXXX */
629 i = XINT (ccl_prog[ic]);
632 CCL_READ_CHAR (reg[rrr]);
636 case CCL_WriteStringJump: /* A--D--D--R--E--S--S-000XXXXX */
637 j = XINT (ccl_prog[ic]);
639 CCL_WRITE_STRING (j);
643 case CCL_WriteArrayReadJump: /* A--D--D--R--E--S--S-rrrXXXXX */
645 j = XINT (ccl_prog[ic]);
646 if ((unsigned int) i < j)
648 i = XINT (ccl_prog[ic + 1 + i]);
652 CCL_READ_CHAR (reg[rrr]);
653 ic += ADDR - (j + 2);
656 case CCL_ReadJump: /* A--D--D--R--E--S--S-rrrYYYYY */
657 CCL_READ_CHAR (reg[rrr]);
661 case CCL_ReadBranch: /* CCCCCCCCCCCCCCCCCCCCrrrXXXXX */
662 CCL_READ_CHAR (reg[rrr]);
663 /* fall through ... */
664 case CCL_Branch: /* CCCCCCCCCCCCCCCCCCCCrrrXXXXX */
665 if ((unsigned int) reg[rrr] < field1)
666 ic += XINT (ccl_prog[ic + reg[rrr]]);
668 ic += XINT (ccl_prog[ic + field1]);
671 case CCL_ReadRegister: /* CCCCCCCCCCCCCCCCCCCCrrXXXXX */
674 CCL_READ_CHAR (reg[rrr]);
676 code = XINT (ccl_prog[ic]); ic++;
678 field2 = (code & 0xFF) >> 5;
682 case CCL_WriteExprConst: /* 1:00000OPERATION000RRR000XXXXX */
685 j = XINT (ccl_prog[ic]);
690 case CCL_WriteRegister: /* CCCCCCCCCCCCCCCCCCCrrrXXXXX */
696 code = XINT (ccl_prog[ic]); ic++;
698 field2 = (code & 0xFF) >> 5;
702 case CCL_WriteExprRegister: /* 1:00000OPERATIONRrrRRR000XXXXX */
709 case CCL_Call: /* CCCCCCCCCCCCCCCCCCCC000XXXXX */
715 || field1 >= XVECTOR_LENGTH (Vccl_program_table)
716 || (slot = XVECTOR_DATA (Vccl_program_table)[field1],
718 || !VECTORP (XCDR (slot)))
722 ccl_prog = ccl_prog_stack_struct[0].ccl_prog;
723 ic = ccl_prog_stack_struct[0].ic;
725 ccl->status = CCL_STAT_INVALID_CMD;
726 goto ccl_error_handler;
729 ccl_prog_stack_struct[stack_idx].ccl_prog = ccl_prog;
730 ccl_prog_stack_struct[stack_idx].ic = ic;
732 ccl_prog = XVECTOR_DATA (XCDR (slot));
733 ic = CCL_HEADER_MAIN;
737 case CCL_WriteConstString: /* CCCCCCCCCCCCCCCCCCCCrrrXXXXX */
739 CCL_WRITE_CHAR (field1);
742 CCL_WRITE_STRING (field1);
743 ic += (field1 + 2) / 3;
747 case CCL_WriteArray: /* CCCCCCCCCCCCCCCCCCCCrrrXXXXX */
749 if ((unsigned int) i < field1)
751 j = XINT (ccl_prog[ic + i]);
757 case CCL_End: /* 0000000000000000000000XXXXX */
760 ccl_prog = ccl_prog_stack_struct[stack_idx].ccl_prog;
761 ic = ccl_prog_stack_struct[stack_idx].ic;
764 /* Terminate CCL program successfully. */
765 ccl->status = CCL_STAT_SUCCESS;
766 ccl->ic = CCL_HEADER_MAIN;
769 case CCL_ExprSelfConst: /* 00000OPERATION000000rrrXXXXX */
770 i = XINT (ccl_prog[ic]);
775 case CCL_ExprSelfReg: /* 00000OPERATION000RRRrrrXXXXX */
782 case CCL_PLUS: reg[rrr] += i; break;
783 case CCL_MINUS: reg[rrr] -= i; break;
784 case CCL_MUL: reg[rrr] *= i; break;
785 case CCL_DIV: reg[rrr] /= i; break;
786 case CCL_MOD: reg[rrr] %= i; break;
787 case CCL_AND: reg[rrr] &= i; break;
788 case CCL_OR: reg[rrr] |= i; break;
789 case CCL_XOR: reg[rrr] ^= i; break;
790 case CCL_LSH: reg[rrr] <<= i; break;
791 case CCL_RSH: reg[rrr] >>= i; break;
792 case CCL_LSH8: reg[rrr] <<= 8; reg[rrr] |= i; break;
793 case CCL_RSH8: reg[7] = reg[rrr] & 0xFF; reg[rrr] >>= 8; break;
794 case CCL_DIVMOD: reg[7] = reg[rrr] % i; reg[rrr] /= i; break;
795 case CCL_LS: reg[rrr] = reg[rrr] < i; break;
796 case CCL_GT: reg[rrr] = reg[rrr] > i; break;
797 case CCL_EQ: reg[rrr] = reg[rrr] == i; break;
798 case CCL_LE: reg[rrr] = reg[rrr] <= i; break;
799 case CCL_GE: reg[rrr] = reg[rrr] >= i; break;
800 case CCL_NE: reg[rrr] = reg[rrr] != i; break;
802 ccl->status = CCL_STAT_INVALID_CMD;
803 goto ccl_error_handler;
807 case CCL_SetExprConst: /* 00000OPERATION000RRRrrrXXXXX */
809 j = XINT (ccl_prog[ic]);
814 case CCL_SetExprReg: /* 00000OPERATIONRrrRRRrrrXXXXX */
821 case CCL_ReadJumpCondExprConst: /* A--D--D--R--E--S--S-rrrXXXXX */
822 CCL_READ_CHAR (reg[rrr]);
823 case CCL_JumpCondExprConst: /* A--D--D--R--E--S--S-rrrXXXXX */
825 op = XINT (ccl_prog[ic]);
826 jump_address = ic++ + ADDR;
827 j = XINT (ccl_prog[ic]);
832 case CCL_ReadJumpCondExprReg: /* A--D--D--R--E--S--S-rrrXXXXX */
833 CCL_READ_CHAR (reg[rrr]);
834 case CCL_JumpCondExprReg:
836 op = XINT (ccl_prog[ic]);
837 jump_address = ic++ + ADDR;
838 j = reg[XINT (ccl_prog[ic])];
845 case CCL_PLUS: reg[rrr] = i + j; break;
846 case CCL_MINUS: reg[rrr] = i - j; break;
847 case CCL_MUL: reg[rrr] = i * j; break;
848 case CCL_DIV: reg[rrr] = i / j; break;
849 case CCL_MOD: reg[rrr] = i % j; break;
850 case CCL_AND: reg[rrr] = i & j; break;
851 case CCL_OR: reg[rrr] = i | j; break;
852 case CCL_XOR: reg[rrr] = i ^ j; break;
853 case CCL_LSH: reg[rrr] = i << j; break;
854 case CCL_RSH: reg[rrr] = i >> j; break;
855 case CCL_LSH8: reg[rrr] = (i << 8) | j; break;
856 case CCL_RSH8: reg[rrr] = i >> 8; reg[7] = i & 0xFF; break;
857 case CCL_DIVMOD: reg[rrr] = i / j; reg[7] = i % j; break;
858 case CCL_LS: reg[rrr] = i < j; break;
859 case CCL_GT: reg[rrr] = i > j; break;
860 case CCL_EQ: reg[rrr] = i == j; break;
861 case CCL_LE: reg[rrr] = i <= j; break;
862 case CCL_GE: reg[rrr] = i >= j; break;
863 case CCL_NE: reg[rrr] = i != j; break;
864 case CCL_ENCODE_SJIS: ENCODE_SJIS (i, j, reg[rrr], reg[7]); break;
865 case CCL_DECODE_SJIS: DECODE_SJIS (i, j, reg[rrr], reg[7]); break;
867 ccl->status = CCL_STAT_INVALID_CMD;
868 goto ccl_error_handler;
871 if (code == CCL_WriteExprConst || code == CCL_WriteExprRegister)
881 ccl->status = CCL_STAT_INVALID_CMD;
882 goto ccl_error_handler;
889 /* We can insert an error message only if DESTINATION is
890 specified and we still have a room to store the message
896 /* Terminate CCL program because of invalid command.
897 Should not occur in the normal case. */
898 case CCL_STAT_INVALID_CMD:
899 sprintf(msg, "\nCCL: Invalid command %x (ccl_code = %x) at %d.",
900 code & 0x1F, code, ic);
903 int i = ccl_backtrace_idx - 1;
906 Dynarr_add_many (destination, (unsigned char *) msg, strlen (msg));
908 for (j = 0; j < CCL_DEBUG_BACKTRACE_LEN; j++, i--)
910 if (i < 0) i = CCL_DEBUG_BACKTRACE_LEN - 1;
911 if (ccl_backtrace_table[i] == 0)
913 sprintf(msg, " %d", ccl_backtrace_table[i]);
914 Dynarr_add_many (destination, (unsigned char *) msg, strlen (msg));
921 sprintf(msg, "\nCCL: Quited.");
925 sprintf(msg, "\nCCL: Unknown error type (%d).", ccl->status);
928 Dynarr_add_many (destination, (unsigned char *) msg, strlen (msg));
933 if (consumed) *consumed = src - source;
935 return Dynarr_length (destination);
940 /* Setup fields of the structure pointed by CCL appropriately for the
941 execution of compiled CCL code in VEC (vector of integer). */
943 setup_ccl_program (struct ccl_program *ccl, Lisp_Object vec)
947 ccl->size = XVECTOR_LENGTH (vec);
948 ccl->prog = XVECTOR_DATA (vec);
949 ccl->ic = CCL_HEADER_MAIN;
950 ccl->eof_ic = XINT (XVECTOR_DATA (vec)[CCL_HEADER_EOF]);
951 ccl->buf_magnification = XINT (XVECTOR_DATA (vec)[CCL_HEADER_BUF_MAG]);
952 for (i = 0; i < 8; i++)
960 DEFUN ("ccl-execute", Fccl_execute, 2, 2, 0, /*
961 Execute CCL-PROGRAM with registers initialized by REGISTERS.
962 CCL-PROGRAM is a compiled code generated by `ccl-compile',
963 no I/O commands should appear in the CCL program.
964 REGISTERS is a vector of [R0 R1 ... R7] where RN is an initial value
966 As side effect, each element of REGISTER holds the value of
967 corresponding register after the execution.
971 struct ccl_program ccl;
974 CHECK_VECTOR (ccl_prog);
976 if (XVECTOR_LENGTH (reg) != 8)
977 signal_simple_error ("Vector should be of length 8", reg);
979 setup_ccl_program (&ccl, ccl_prog);
980 for (i = 0; i < 8; i++)
981 ccl.reg[i] = (INTP (XVECTOR_DATA (reg)[i])
982 ? XINT (XVECTOR_DATA (reg)[i])
985 ccl_driver (&ccl, (CONST unsigned char *)0, (unsigned_char_dynarr *)0,
986 0, (int *)0, CCL_MODE_ENCODING);
988 if (ccl.status != CCL_STAT_SUCCESS)
989 error ("Error in CCL program at %dth code", ccl.ic);
991 for (i = 0; i < 8; i++)
992 XSETINT (XVECTOR_DATA (reg)[i], ccl.reg[i]);
996 DEFUN ("ccl-execute-on-string", Fccl_execute_on_string, 3, 4, 0, /*
997 Execute CCL-PROGRAM with initial STATUS on STRING.
998 CCL-PROGRAM is a compiled code generated by `ccl-compile'.
999 Read buffer is set to STRING, and write buffer is allocated automatically.
1000 STATUS is a vector of [R0 R1 ... R7 IC], where
1001 R0..R7 are initial values of corresponding registers,
1002 IC is the instruction counter specifying from where to start the program.
1003 If R0..R7 are nil, they are initialized to 0.
1004 If IC is nil, it is initialized to head of the CCL program.
1005 Returns the contents of write buffer as a string,
1006 and as side effect, STATUS is updated.
1007 If optional 4th arg CONTINUE is non-nil, keep IC on read operation
1008 when read buffer is exausted, else, IC is always set to the end of
1009 CCL-PROGRAM on exit.
1011 (ccl_prog, status, str, contin))
1014 struct ccl_program ccl;
1016 unsigned_char_dynarr *outbuf;
1017 struct gcpro gcpro1, gcpro2, gcpro3;
1019 CHECK_VECTOR (ccl_prog);
1020 CHECK_VECTOR (status);
1021 if (XVECTOR_LENGTH (status) != 9)
1022 signal_simple_error ("Vector should be of length 9", status);
1024 GCPRO3 (ccl_prog, status, str);
1026 setup_ccl_program (&ccl, ccl_prog);
1027 for (i = 0; i < 8; i++)
1029 if (NILP (XVECTOR_DATA (status)[i]))
1030 XSETINT (XVECTOR_DATA (status)[i], 0);
1031 if (INTP (XVECTOR_DATA (status)[i]))
1032 ccl.reg[i] = XINT (XVECTOR_DATA (status)[i]);
1034 if (INTP (XVECTOR_DATA (status)[8]))
1036 i = XINT (XVECTOR_DATA (status)[8]);
1037 if (ccl.ic < i && i < ccl.size)
1040 outbuf = Dynarr_new (unsigned_char);
1041 ccl.last_block = NILP (contin);
1042 produced = ccl_driver (&ccl, XSTRING_DATA (str), outbuf,
1043 XSTRING_LENGTH (str), (int *)0, CCL_MODE_ENCODING);
1044 for (i = 0; i < 8; i++)
1045 XVECTOR_DATA (status)[i] = make_int(ccl.reg[i]);
1046 XSETINT (XVECTOR_DATA (status)[8], ccl.ic);
1049 val = make_string (Dynarr_atp (outbuf, 0), produced);
1050 Dynarr_free (outbuf);
1052 if (ccl.status != CCL_STAT_SUCCESS
1053 && ccl.status != CCL_STAT_SUSPEND)
1054 error ("Error in CCL program at %dth code", ccl.ic);
1059 DEFUN ("register-ccl-program", Fregister_ccl_program, 2, 2, 0, /*
1060 Register CCL program PROGRAM of NAME in `ccl-program-table'.
1061 PROGRAM should be a compiled code of CCL program, or nil.
1062 Return index number of the registered CCL program.
1066 int len = XVECTOR_LENGTH (Vccl_program_table);
1069 CHECK_SYMBOL (name);
1070 if (!NILP (ccl_prog))
1071 CHECK_VECTOR (ccl_prog);
1073 for (i = 0; i < len; i++)
1075 Lisp_Object slot = XVECTOR_DATA (Vccl_program_table)[i];
1080 if (EQ (name, XCAR (slot)))
1082 XCDR (slot) = ccl_prog;
1083 return make_int (i);
1089 Lisp_Object new_table = Fmake_vector (make_int (len * 2), Qnil);
1092 for (j = 0; j < len; j++)
1093 XVECTOR_DATA (new_table)[j]
1094 = XVECTOR_DATA (Vccl_program_table)[j];
1095 Vccl_program_table = new_table;
1098 XVECTOR_DATA (Vccl_program_table)[i] = Fcons (name, ccl_prog);
1099 return make_int (i);
1103 syms_of_mule_ccl (void)
1105 DEFSUBR (Fccl_execute);
1106 DEFSUBR (Fccl_execute_on_string);
1107 DEFSUBR (Fregister_ccl_program);
1111 vars_of_mule_ccl (void)
1113 staticpro (&Vccl_program_table);
1114 Vccl_program_table = Fmake_vector (make_int (32), Qnil);
1116 DEFVAR_LISP ("font-ccl-encoder-alist", &Vfont_ccl_encoder_alist /*
1117 Alist of fontname patterns vs corresponding CCL program.
1118 Each element looks like (REGEXP . CCL-CODE),
1119 where CCL-CODE is a compiled CCL program.
1120 When a font whose name matches REGEXP is used for displaying a character,
1121 CCL-CODE is executed to calculate the code point in the font
1122 from the charset number and position code(s) of the character which are set
1123 in CCL registers R0, R1, and R2 before the execution.
1124 The code point in the font is set in CCL registers R1 and R2
1125 when the execution terminated.
1126 If the font is single-byte font, the register R2 is not used.
1128 Vfont_ccl_encoder_alist = Qnil;