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 */
29 #include "character.h"
31 #include "file-coding.h"
38 #endif /* not emacs */
40 /* Alist of fontname patterns vs corresponding CCL program. */
41 Lisp_Object Vfont_ccl_encoder_alist;
43 /* Vector of CCL program names vs corresponding program data. */
44 Lisp_Object Vccl_program_table;
46 /* CCL (Code Conversion Language) is a simple language which has
47 operations on one input buffer, one output buffer, and 7 registers.
48 The syntax of CCL is described in `ccl.el'. Emacs Lisp function
49 `ccl-compile' compiles a CCL program and produces a CCL code which
50 is a vector of integers. The structure of this vector is as
51 follows: The 1st element: buffer-magnification, a factor for the
52 size of output buffer compared with the size of input buffer. The
53 2nd element: address of CCL code to be executed when encountered
54 with end of input stream. The 3rd and the remaining elements: CCL
57 /* Header of CCL compiled code */
58 #define CCL_HEADER_BUF_MAG 0
59 #define CCL_HEADER_EOF 1
60 #define CCL_HEADER_MAIN 2
62 /* CCL code is a sequence of 28-bit non-negative integers (i.e. the
63 MSB is always 0), each contains CCL command and/or arguments in the
66 |----------------- integer (28-bit) ------------------|
67 |------- 17-bit ------|- 3-bit --|- 3-bit --|- 5-bit -|
68 |--constant argument--|-register-|-register-|-command-|
69 ccccccccccccccccc RRR rrr XXXXX
71 |------- relative address -------|-register-|-command-|
72 cccccccccccccccccccc rrr XXXXX
74 |------------- constant or other args ----------------|
75 cccccccccccccccccccccccccccc
77 where, `cc...c' is a non-negative integer indicating constant value
78 (the left most `c' is always 0) or an absolute jump address, `RRR'
79 and `rrr' are CCL register number, `XXXXX' is one of the following
84 Each comment fields shows one or more lines for command syntax and
85 the following lines for semantics of the command. In semantics, IC
86 stands for Instruction Counter. */
88 #define CCL_SetRegister 0x00 /* Set register a register value:
89 1:00000000000000000RRRrrrXXXXX
90 ------------------------------
94 #define CCL_SetShortConst 0x01 /* Set register a short constant value:
95 1:CCCCCCCCCCCCCCCCCCCCrrrXXXXX
96 ------------------------------
97 reg[rrr] = CCCCCCCCCCCCCCCCCCC;
100 #define CCL_SetConst 0x02 /* Set register a constant value:
101 1:00000000000000000000rrrXXXXX
103 ------------------------------
108 #define CCL_SetArray 0x03 /* Set register an element of array:
109 1:CCCCCCCCCCCCCCCCCRRRrrrXXXXX
113 ------------------------------
114 if (0 <= reg[RRR] < CC..C)
115 reg[rrr] = ELEMENT[reg[RRR]];
119 #define CCL_Jump 0x04 /* Jump:
120 1:A--D--D--R--E--S--S-000XXXXX
121 ------------------------------
125 /* Note: If CC..C is greater than 0, the second code is omitted. */
127 #define CCL_JumpCond 0x05 /* Jump conditional:
128 1:A--D--D--R--E--S--S-rrrXXXXX
129 ------------------------------
135 #define CCL_WriteRegisterJump 0x06 /* Write register and jump:
136 1:A--D--D--R--E--S--S-rrrXXXXX
137 ------------------------------
142 #define CCL_WriteRegisterReadJump 0x07 /* Write register, read, and jump:
143 1:A--D--D--R--E--S--S-rrrXXXXX
144 2:A--D--D--R--E--S--S-rrrYYYYY
145 -----------------------------
151 /* Note: If read is suspended, the resumed execution starts from the
152 second code (YYYYY == CCL_ReadJump). */
154 #define CCL_WriteConstJump 0x08 /* Write constant and jump:
155 1:A--D--D--R--E--S--S-000XXXXX
157 ------------------------------
162 #define CCL_WriteConstReadJump 0x09 /* Write constant, read, and jump:
163 1:A--D--D--R--E--S--S-rrrXXXXX
165 3: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_WriteStringJump 0x0A /* Write string and jump:
176 1:A--D--D--R--E--S--S-000XXXXX
178 3:0000STRIN[0]STRIN[1]STRIN[2]
180 ------------------------------
181 write_string (STRING, LENGTH);
185 #define CCL_WriteArrayReadJump 0x0B /* Write an array element, read, and jump:
186 1:A--D--D--R--E--S--S-rrrXXXXX
191 N:A--D--D--R--E--S--S-rrrYYYYY
192 ------------------------------
193 if (0 <= reg[rrr] < LENGTH)
194 write (ELEMENT[reg[rrr]]);
195 IC += LENGTH + 2; (... pointing at N+1)
199 /* Note: If read is suspended, the resumed execution starts from the
200 Nth code (YYYYY == CCL_ReadJump). */
202 #define CCL_ReadJump 0x0C /* Read and jump:
203 1:A--D--D--R--E--S--S-rrrYYYYY
204 -----------------------------
209 #define CCL_Branch 0x0D /* Jump by branch table:
210 1:CCCCCCCCCCCCCCCCCCCCrrrXXXXX
211 2:A--D--D--R--E-S-S[0]000XXXXX
212 3:A--D--D--R--E-S-S[1]000XXXXX
214 ------------------------------
215 if (0 <= reg[rrr] < CC..C)
216 IC += ADDRESS[reg[rrr]];
218 IC += ADDRESS[CC..C];
221 #define CCL_ReadRegister 0x0E /* Read bytes into registers:
222 1:CCCCCCCCCCCCCCCCCCCCrrrXXXXX
223 2:CCCCCCCCCCCCCCCCCCCCrrrXXXXX
225 ------------------------------
230 #define CCL_WriteExprConst 0x0F /* write result of expression:
231 1:00000OPERATION000RRR000XXXXX
233 ------------------------------
234 write (reg[RRR] OPERATION CONSTANT);
238 /* Note: If the Nth read is suspended, the resumed execution starts
239 from the Nth code. */
241 #define CCL_ReadBranch 0x10 /* Read one byte into a register,
242 and jump by branch table:
243 1:CCCCCCCCCCCCCCCCCCCCrrrXXXXX
244 2:A--D--D--R--E-S-S[0]000XXXXX
245 3:A--D--D--R--E-S-S[1]000XXXXX
247 ------------------------------
249 if (0 <= reg[rrr] < CC..C)
250 IC += ADDRESS[reg[rrr]];
252 IC += ADDRESS[CC..C];
255 #define CCL_WriteRegister 0x11 /* Write registers:
256 1:CCCCCCCCCCCCCCCCCCCrrrXXXXX
257 2:CCCCCCCCCCCCCCCCCCCrrrXXXXX
259 ------------------------------
265 /* Note: If the Nth write is suspended, the resumed execution
266 starts from the Nth code. */
268 #define CCL_WriteExprRegister 0x12 /* Write result of expression
269 1:00000OPERATIONRrrRRR000XXXXX
270 ------------------------------
271 write (reg[RRR] OPERATION reg[Rrr]);
274 #define CCL_Call 0x13 /* Write a constant:
275 1:CCCCCCCCCCCCCCCCCCCC000XXXXX
276 ------------------------------
280 #define CCL_WriteConstString 0x14 /* Write a constant or a string:
281 1:CCCCCCCCCCCCCCCCCCCCrrrXXXXX
282 [2:0000STRIN[0]STRIN[1]STRIN[2]]
284 -----------------------------
288 write_string (STRING, CC..C);
289 IC += (CC..C + 2) / 3;
292 #define CCL_WriteArray 0x15 /* Write an element of array:
293 1:CCCCCCCCCCCCCCCCCCCCrrrXXXXX
297 ------------------------------
298 if (0 <= reg[rrr] < CC..C)
299 write (ELEMENT[reg[rrr]]);
303 #define CCL_End 0x16 /* Terminate:
304 1:00000000000000000000000XXXXX
305 ------------------------------
309 /* The following two codes execute an assignment arithmetic/logical
310 operation. The form of the operation is like REG OP= OPERAND. */
312 #define CCL_ExprSelfConst 0x17 /* REG OP= constant:
313 1:00000OPERATION000000rrrXXXXX
315 ------------------------------
316 reg[rrr] OPERATION= CONSTANT;
319 #define CCL_ExprSelfReg 0x18 /* REG1 OP= REG2:
320 1:00000OPERATION000RRRrrrXXXXX
321 ------------------------------
322 reg[rrr] OPERATION= reg[RRR];
325 /* The following codes execute an arithmetic/logical operation. The
326 form of the operation is like REG_X = REG_Y OP OPERAND2. */
328 #define CCL_SetExprConst 0x19 /* REG_X = REG_Y OP constant:
329 1:00000OPERATION000RRRrrrXXXXX
331 ------------------------------
332 reg[rrr] = reg[RRR] OPERATION CONSTANT;
336 #define CCL_SetExprReg 0x1A /* REG1 = REG2 OP REG3:
337 1:00000OPERATIONRrrRRRrrrXXXXX
338 ------------------------------
339 reg[rrr] = reg[RRR] OPERATION reg[Rrr];
342 #define CCL_JumpCondExprConst 0x1B /* Jump conditional according to
343 an operation on constant:
344 1:A--D--D--R--E--S--S-rrrXXXXX
347 -----------------------------
348 reg[7] = reg[rrr] OPERATION CONSTANT;
355 #define CCL_JumpCondExprReg 0x1C /* Jump conditional according to
356 an operation on register:
357 1:A--D--D--R--E--S--S-rrrXXXXX
360 -----------------------------
361 reg[7] = reg[rrr] OPERATION reg[RRR];
368 #define CCL_ReadJumpCondExprConst 0x1D /* Read and jump conditional according
369 to an operation on constant:
370 1:A--D--D--R--E--S--S-rrrXXXXX
373 -----------------------------
375 reg[7] = reg[rrr] OPERATION CONSTANT;
382 #define CCL_ReadJumpCondExprReg 0x1E /* Read and jump conditional according
383 to an operation on register:
384 1:A--D--D--R--E--S--S-rrrXXXXX
387 -----------------------------
389 reg[7] = reg[rrr] OPERATION reg[RRR];
396 #define CCL_Extention 0x1F /* Extended CCL code
397 1:ExtendedCOMMNDRrrRRRrrrXXXXX
400 ------------------------------
401 extended_command (rrr,RRR,Rrr,ARGS)
405 /* CCL arithmetic/logical operators. */
406 #define CCL_PLUS 0x00 /* X = Y + Z */
407 #define CCL_MINUS 0x01 /* X = Y - Z */
408 #define CCL_MUL 0x02 /* X = Y * Z */
409 #define CCL_DIV 0x03 /* X = Y / Z */
410 #define CCL_MOD 0x04 /* X = Y % Z */
411 #define CCL_AND 0x05 /* X = Y & Z */
412 #define CCL_OR 0x06 /* X = Y | Z */
413 #define CCL_XOR 0x07 /* X = Y ^ Z */
414 #define CCL_LSH 0x08 /* X = Y << Z */
415 #define CCL_RSH 0x09 /* X = Y >> Z */
416 #define CCL_LSH8 0x0A /* X = (Y << 8) | Z */
417 #define CCL_RSH8 0x0B /* X = Y >> 8, r[7] = Y & 0xFF */
418 #define CCL_DIVMOD 0x0C /* X = Y / Z, r[7] = Y % Z */
419 #define CCL_LS 0x10 /* X = (X < Y) */
420 #define CCL_GT 0x11 /* X = (X > Y) */
421 #define CCL_EQ 0x12 /* X = (X == Y) */
422 #define CCL_LE 0x13 /* X = (X <= Y) */
423 #define CCL_GE 0x14 /* X = (X >= Y) */
424 #define CCL_NE 0x15 /* X = (X != Y) */
426 #define CCL_ENCODE_SJIS 0x16 /* X = HIGHER_BYTE (SJIS (Y, Z))
427 r[7] = LOWER_BYTE (SJIS (Y, Z) */
428 #define CCL_DECODE_SJIS 0x17 /* X = HIGHER_BYTE (DE-SJIS (Y, Z))
429 r[7] = LOWER_BYTE (DE-SJIS (Y, Z)) */
431 /* Macros for exit status of CCL program. */
432 #define CCL_STAT_SUCCESS 0 /* Terminated successfully. */
433 #define CCL_STAT_SUSPEND 1 /* Terminated because of empty input
434 buffer or full output buffer. */
435 #define CCL_STAT_INVALID_CMD 2 /* Terminated because of invalid
437 #define CCL_STAT_QUIT 3 /* Terminated because of quit. */
439 /* Encode one character CH to multibyte form and write to the current
440 output buffer. If CH is less than 256, CH is written as is. */
441 #define CCL_WRITE_CHAR(ch) do { \
444 ccl->status = CCL_STAT_INVALID_CMD; \
445 goto ccl_error_handler; \
449 Bufbyte work[MAX_EMCHAR_LEN]; \
450 int len = ( ch < ( conversion_mode == CCL_MODE_ENCODING ? \
452 simple_set_charptr_emchar (work, ch) : \
453 non_ascii_set_charptr_emchar (work, ch); \
454 Dynarr_add_many (destination, work, len); \
458 /* Write a string at ccl_prog[IC] of length LEN to the current output
460 #define CCL_WRITE_STRING(len) do { \
463 ccl->status = CCL_STAT_INVALID_CMD; \
464 goto ccl_error_handler; \
467 for (i = 0; i < len; i++) \
468 Dynarr_add(destination, \
469 (XINT (ccl_prog[ic + (i / 3)]) \
470 >> ((2 - (i % 3)) * 8)) & 0xFF); \
473 /* Read one byte from the current input buffer into Rth register. */
474 #define CCL_READ_CHAR(r) do { \
477 ccl->status = CCL_STAT_INVALID_CMD; \
478 goto ccl_error_handler; \
480 else if (src < src_end) \
482 else if (ccl->last_block) \
488 /* Suspend CCL program because of \
489 reading from empty input buffer or \
490 writing to full output buffer. \
491 When this program is resumed, the \
492 same I/O command is executed. */ \
495 ccl->status = CCL_STAT_SUSPEND; \
501 /* Execute CCL code on SRC_BYTES length text at SOURCE. The resulting
502 text goes to a place pointed by DESTINATION. The bytes actually
503 processed is returned as *CONSUMED. The return value is the length
504 of the resulting text. As a side effect, the contents of CCL registers
505 are updated. If SOURCE or DESTINATION is NULL, only operations on
506 registers are permitted. */
509 #define CCL_DEBUG_BACKTRACE_LEN 256
510 int ccl_backtrace_table[CCL_BACKTRACE_TABLE];
511 int ccl_backtrace_idx;
514 struct ccl_prog_stack
516 Lisp_Object *ccl_prog; /* Pointer to an array of CCL code. */
517 int ic; /* Instruction Counter. */
521 ccl_driver (struct ccl_program *ccl, CONST unsigned char *source, unsigned_char_dynarr *destination, int src_bytes, int *consumed, int conversion_mode)
525 int code = -1; /* init to illegal value, */
527 Lisp_Object *ccl_prog = ccl->prog;
528 CONST unsigned char *src = source, *src_end = src + src_bytes;
529 int jump_address = 0; /* shut up the compiler */
533 /* For the moment, we only support depth 256 of stack. */
534 struct ccl_prog_stack ccl_prog_stack_struct[256];
536 if (ic >= ccl->eof_ic)
537 ic = CCL_HEADER_MAIN;
540 ccl_backtrace_idx = 0;
546 ccl_backtrace_table[ccl_backtrace_idx++] = ic;
547 if (ccl_backtrace_idx >= CCL_DEBUG_BACKTRACE_LEN)
548 ccl_backtrace_idx = 0;
549 ccl_backtrace_table[ccl_backtrace_idx] = 0;
552 if (!NILP (Vquit_flag) && NILP (Vinhibit_quit))
554 /* We can't just signal Qquit, instead break the loop as if
555 the whole data is processed. Don't reset Vquit_flag, it
556 must be handled later at a safer place. */
558 src = source + src_bytes;
559 ccl->status = CCL_STAT_QUIT;
563 code = XINT (ccl_prog[ic]); ic++;
565 field2 = (code & 0xFF) >> 5;
568 #define RRR (field1 & 7)
569 #define Rrr ((field1 >> 3) & 7)
574 case CCL_SetRegister: /* 00000000000000000RRRrrrXXXXX */
578 case CCL_SetShortConst: /* CCCCCCCCCCCCCCCCCCCCrrrXXXXX */
582 case CCL_SetConst: /* 00000000000000000000rrrXXXXX */
583 reg[rrr] = XINT (ccl_prog[ic]);
587 case CCL_SetArray: /* CCCCCCCCCCCCCCCCCCCCRRRrrrXXXXX */
590 if ((unsigned int) i < j)
591 reg[rrr] = XINT (ccl_prog[ic + i]);
595 case CCL_Jump: /* A--D--D--R--E--S--S-000XXXXX */
599 case CCL_JumpCond: /* A--D--D--R--E--S--S-rrrXXXXX */
604 case CCL_WriteRegisterJump: /* A--D--D--R--E--S--S-rrrXXXXX */
610 case CCL_WriteRegisterReadJump: /* A--D--D--R--E--S--S-rrrXXXXX */
614 CCL_READ_CHAR (reg[rrr]);
618 case CCL_WriteConstJump: /* A--D--D--R--E--S--S-000XXXXX */
619 i = XINT (ccl_prog[ic]);
624 case CCL_WriteConstReadJump: /* A--D--D--R--E--S--S-rrrXXXXX */
625 i = XINT (ccl_prog[ic]);
628 CCL_READ_CHAR (reg[rrr]);
632 case CCL_WriteStringJump: /* A--D--D--R--E--S--S-000XXXXX */
633 j = XINT (ccl_prog[ic]);
635 CCL_WRITE_STRING (j);
639 case CCL_WriteArrayReadJump: /* A--D--D--R--E--S--S-rrrXXXXX */
641 j = XINT (ccl_prog[ic]);
642 if ((unsigned int) i < j)
644 i = XINT (ccl_prog[ic + 1 + i]);
648 CCL_READ_CHAR (reg[rrr]);
649 ic += ADDR - (j + 2);
652 case CCL_ReadJump: /* A--D--D--R--E--S--S-rrrYYYYY */
653 CCL_READ_CHAR (reg[rrr]);
657 case CCL_ReadBranch: /* CCCCCCCCCCCCCCCCCCCCrrrXXXXX */
658 CCL_READ_CHAR (reg[rrr]);
659 /* fall through ... */
660 case CCL_Branch: /* CCCCCCCCCCCCCCCCCCCCrrrXXXXX */
661 if ((unsigned int) reg[rrr] < field1)
662 ic += XINT (ccl_prog[ic + reg[rrr]]);
664 ic += XINT (ccl_prog[ic + field1]);
667 case CCL_ReadRegister: /* CCCCCCCCCCCCCCCCCCCCrrXXXXX */
670 CCL_READ_CHAR (reg[rrr]);
672 code = XINT (ccl_prog[ic]); ic++;
674 field2 = (code & 0xFF) >> 5;
678 case CCL_WriteExprConst: /* 1:00000OPERATION000RRR000XXXXX */
681 j = XINT (ccl_prog[ic]);
686 case CCL_WriteRegister: /* CCCCCCCCCCCCCCCCCCCrrrXXXXX */
692 code = XINT (ccl_prog[ic]); ic++;
694 field2 = (code & 0xFF) >> 5;
698 case CCL_WriteExprRegister: /* 1:00000OPERATIONRrrRRR000XXXXX */
705 case CCL_Call: /* CCCCCCCCCCCCCCCCCCCC000XXXXX */
711 || field1 >= XVECTOR_LENGTH (Vccl_program_table)
712 || (slot = XVECTOR_DATA (Vccl_program_table)[field1],
714 || !VECTORP (XCDR (slot)))
718 ccl_prog = ccl_prog_stack_struct[0].ccl_prog;
719 ic = ccl_prog_stack_struct[0].ic;
721 ccl->status = CCL_STAT_INVALID_CMD;
722 goto ccl_error_handler;
725 ccl_prog_stack_struct[stack_idx].ccl_prog = ccl_prog;
726 ccl_prog_stack_struct[stack_idx].ic = ic;
728 ccl_prog = XVECTOR_DATA (XCDR (slot));
729 ic = CCL_HEADER_MAIN;
733 case CCL_WriteConstString: /* CCCCCCCCCCCCCCCCCCCCrrrXXXXX */
735 CCL_WRITE_CHAR (field1);
738 CCL_WRITE_STRING (field1);
739 ic += (field1 + 2) / 3;
743 case CCL_WriteArray: /* CCCCCCCCCCCCCCCCCCCCrrrXXXXX */
745 if ((unsigned int) i < field1)
747 j = XINT (ccl_prog[ic + i]);
753 case CCL_End: /* 0000000000000000000000XXXXX */
756 ccl_prog = ccl_prog_stack_struct[stack_idx].ccl_prog;
757 ic = ccl_prog_stack_struct[stack_idx].ic;
760 /* Terminate CCL program successfully. */
761 ccl->status = CCL_STAT_SUCCESS;
762 ccl->ic = CCL_HEADER_MAIN;
765 case CCL_ExprSelfConst: /* 00000OPERATION000000rrrXXXXX */
766 i = XINT (ccl_prog[ic]);
771 case CCL_ExprSelfReg: /* 00000OPERATION000RRRrrrXXXXX */
778 case CCL_PLUS: reg[rrr] += i; break;
779 case CCL_MINUS: reg[rrr] -= i; break;
780 case CCL_MUL: reg[rrr] *= i; break;
781 case CCL_DIV: reg[rrr] /= i; break;
782 case CCL_MOD: reg[rrr] %= i; break;
783 case CCL_AND: reg[rrr] &= i; break;
784 case CCL_OR: reg[rrr] |= i; break;
785 case CCL_XOR: reg[rrr] ^= i; break;
786 case CCL_LSH: reg[rrr] <<= i; break;
787 case CCL_RSH: reg[rrr] >>= i; break;
788 case CCL_LSH8: reg[rrr] <<= 8; reg[rrr] |= i; break;
789 case CCL_RSH8: reg[7] = reg[rrr] & 0xFF; reg[rrr] >>= 8; break;
790 case CCL_DIVMOD: reg[7] = reg[rrr] % i; reg[rrr] /= i; break;
791 case CCL_LS: reg[rrr] = reg[rrr] < i; break;
792 case CCL_GT: reg[rrr] = reg[rrr] > i; break;
793 case CCL_EQ: reg[rrr] = reg[rrr] == i; break;
794 case CCL_LE: reg[rrr] = reg[rrr] <= i; break;
795 case CCL_GE: reg[rrr] = reg[rrr] >= i; break;
796 case CCL_NE: reg[rrr] = reg[rrr] != i; break;
798 ccl->status = CCL_STAT_INVALID_CMD;
799 goto ccl_error_handler;
803 case CCL_SetExprConst: /* 00000OPERATION000RRRrrrXXXXX */
805 j = XINT (ccl_prog[ic]);
810 case CCL_SetExprReg: /* 00000OPERATIONRrrRRRrrrXXXXX */
817 case CCL_ReadJumpCondExprConst: /* A--D--D--R--E--S--S-rrrXXXXX */
818 CCL_READ_CHAR (reg[rrr]);
819 case CCL_JumpCondExprConst: /* A--D--D--R--E--S--S-rrrXXXXX */
821 op = XINT (ccl_prog[ic]);
822 jump_address = ic++ + ADDR;
823 j = XINT (ccl_prog[ic]);
828 case CCL_ReadJumpCondExprReg: /* A--D--D--R--E--S--S-rrrXXXXX */
829 CCL_READ_CHAR (reg[rrr]);
830 case CCL_JumpCondExprReg:
832 op = XINT (ccl_prog[ic]);
833 jump_address = ic++ + ADDR;
834 j = reg[XINT (ccl_prog[ic])];
841 case CCL_PLUS: reg[rrr] = i + j; break;
842 case CCL_MINUS: reg[rrr] = i - j; break;
843 case CCL_MUL: reg[rrr] = i * j; break;
844 case CCL_DIV: reg[rrr] = i / j; break;
845 case CCL_MOD: reg[rrr] = i % j; break;
846 case CCL_AND: reg[rrr] = i & j; break;
847 case CCL_OR: reg[rrr] = i | j; break;
848 case CCL_XOR: reg[rrr] = i ^ j; break;
849 case CCL_LSH: reg[rrr] = i << j; break;
850 case CCL_RSH: reg[rrr] = i >> j; break;
851 case CCL_LSH8: reg[rrr] = (i << 8) | j; break;
852 case CCL_RSH8: reg[rrr] = i >> 8; reg[7] = i & 0xFF; break;
853 case CCL_DIVMOD: reg[rrr] = i / j; reg[7] = i % j; break;
854 case CCL_LS: reg[rrr] = i < j; break;
855 case CCL_GT: reg[rrr] = i > j; break;
856 case CCL_EQ: reg[rrr] = i == j; break;
857 case CCL_LE: reg[rrr] = i <= j; break;
858 case CCL_GE: reg[rrr] = i >= j; break;
859 case CCL_NE: reg[rrr] = i != j; break;
860 case CCL_ENCODE_SJIS: ENCODE_SJIS (i, j, reg[rrr], reg[7]); break;
861 case CCL_DECODE_SJIS: DECODE_SJIS (i, j, reg[rrr], reg[7]); break;
863 ccl->status = CCL_STAT_INVALID_CMD;
864 goto ccl_error_handler;
867 if (code == CCL_WriteExprConst || code == CCL_WriteExprRegister)
877 ccl->status = CCL_STAT_INVALID_CMD;
878 goto ccl_error_handler;
885 /* We can insert an error message only if DESTINATION is
886 specified and we still have a room to store the message
892 /* Terminate CCL program because of invalid command.
893 Should not occur in the normal case. */
894 case CCL_STAT_INVALID_CMD:
895 sprintf(msg, "\nCCL: Invalid command %x (ccl_code = %x) at %d.",
896 code & 0x1F, code, ic);
899 int i = ccl_backtrace_idx - 1;
902 Dynarr_add_many (destination, (unsigned char *) msg, strlen (msg));
904 for (j = 0; j < CCL_DEBUG_BACKTRACE_LEN; j++, i--)
906 if (i < 0) i = CCL_DEBUG_BACKTRACE_LEN - 1;
907 if (ccl_backtrace_table[i] == 0)
909 sprintf(msg, " %d", ccl_backtrace_table[i]);
910 Dynarr_add_many (destination, (unsigned char *) msg, strlen (msg));
917 sprintf(msg, "\nCCL: Quited.");
921 sprintf(msg, "\nCCL: Unknown error type (%d).", ccl->status);
924 Dynarr_add_many (destination, (unsigned char *) msg, strlen (msg));
929 if (consumed) *consumed = src - source;
931 return Dynarr_length (destination);
936 /* Setup fields of the structure pointed by CCL appropriately for the
937 execution of compiled CCL code in VEC (vector of integer). */
939 setup_ccl_program (struct ccl_program *ccl, Lisp_Object vec)
943 ccl->size = XVECTOR_LENGTH (vec);
944 ccl->prog = XVECTOR_DATA (vec);
945 ccl->ic = CCL_HEADER_MAIN;
946 ccl->eof_ic = XINT (XVECTOR_DATA (vec)[CCL_HEADER_EOF]);
947 ccl->buf_magnification = XINT (XVECTOR_DATA (vec)[CCL_HEADER_BUF_MAG]);
948 for (i = 0; i < 8; i++)
956 DEFUN ("ccl-execute", Fccl_execute, 2, 2, 0, /*
957 Execute CCL-PROGRAM with registers initialized by REGISTERS.
958 CCL-PROGRAM is a compiled code generated by `ccl-compile',
959 no I/O commands should appear in the CCL program.
960 REGISTERS is a vector of [R0 R1 ... R7] where RN is an initial value
962 As side effect, each element of REGISTER holds the value of
963 corresponding register after the execution.
967 struct ccl_program ccl;
970 CHECK_VECTOR (ccl_prog);
972 if (XVECTOR_LENGTH (reg) != 8)
973 signal_simple_error ("Vector should be of length 8", reg);
975 setup_ccl_program (&ccl, ccl_prog);
976 for (i = 0; i < 8; i++)
977 ccl.reg[i] = (INTP (XVECTOR_DATA (reg)[i])
978 ? XINT (XVECTOR_DATA (reg)[i])
981 ccl_driver (&ccl, (CONST unsigned char *)0, (unsigned_char_dynarr *)0,
982 0, (int *)0, CCL_MODE_ENCODING);
984 if (ccl.status != CCL_STAT_SUCCESS)
985 error ("Error in CCL program at %dth code", ccl.ic);
987 for (i = 0; i < 8; i++)
988 XSETINT (XVECTOR_DATA (reg)[i], ccl.reg[i]);
992 DEFUN ("ccl-execute-on-string", Fccl_execute_on_string, 3, 4, 0, /*
993 Execute CCL-PROGRAM with initial STATUS on STRING.
994 CCL-PROGRAM is a compiled code generated by `ccl-compile'.
995 Read buffer is set to STRING, and write buffer is allocated automatically.
996 STATUS is a vector of [R0 R1 ... R7 IC], where
997 R0..R7 are initial values of corresponding registers,
998 IC is the instruction counter specifying from where to start the program.
999 If R0..R7 are nil, they are initialized to 0.
1000 If IC is nil, it is initialized to head of the CCL program.
1001 Returns the contents of write buffer as a string,
1002 and as side effect, STATUS is updated.
1003 If optional 4th arg CONTINUE is non-nil, keep IC on read operation
1004 when read buffer is exausted, else, IC is always set to the end of
1005 CCL-PROGRAM on exit.
1007 (ccl_prog, status, str, contin))
1010 struct ccl_program ccl;
1012 unsigned_char_dynarr *outbuf;
1013 struct gcpro gcpro1, gcpro2, gcpro3;
1015 CHECK_VECTOR (ccl_prog);
1016 CHECK_VECTOR (status);
1017 if (XVECTOR_LENGTH (status) != 9)
1018 signal_simple_error ("Vector should be of length 9", status);
1020 GCPRO3 (ccl_prog, status, str);
1022 setup_ccl_program (&ccl, ccl_prog);
1023 for (i = 0; i < 8; i++)
1025 if (NILP (XVECTOR_DATA (status)[i]))
1026 XSETINT (XVECTOR_DATA (status)[i], 0);
1027 if (INTP (XVECTOR_DATA (status)[i]))
1028 ccl.reg[i] = XINT (XVECTOR_DATA (status)[i]);
1030 if (INTP (XVECTOR_DATA (status)[8]))
1032 i = XINT (XVECTOR_DATA (status)[8]);
1033 if (ccl.ic < i && i < ccl.size)
1036 outbuf = Dynarr_new (unsigned_char);
1037 ccl.last_block = NILP (contin);
1038 produced = ccl_driver (&ccl, XSTRING_DATA (str), outbuf,
1039 XSTRING_LENGTH (str), (int *)0, CCL_MODE_ENCODING);
1040 for (i = 0; i < 8; i++)
1041 XVECTOR_DATA (status)[i] = make_int(ccl.reg[i]);
1042 XSETINT (XVECTOR_DATA (status)[8], ccl.ic);
1045 val = make_string (Dynarr_atp (outbuf, 0), produced);
1046 Dynarr_free (outbuf);
1048 if (ccl.status != CCL_STAT_SUCCESS
1049 && ccl.status != CCL_STAT_SUSPEND)
1050 error ("Error in CCL program at %dth code", ccl.ic);
1055 DEFUN ("register-ccl-program", Fregister_ccl_program, 2, 2, 0, /*
1056 Register CCL program PROGRAM of NAME in `ccl-program-table'.
1057 PROGRAM should be a compiled code of CCL program, or nil.
1058 Return index number of the registered CCL program.
1062 int len = XVECTOR_LENGTH (Vccl_program_table);
1065 CHECK_SYMBOL (name);
1066 if (!NILP (ccl_prog))
1067 CHECK_VECTOR (ccl_prog);
1069 for (i = 0; i < len; i++)
1071 Lisp_Object slot = XVECTOR_DATA (Vccl_program_table)[i];
1076 if (EQ (name, XCAR (slot)))
1078 XCDR (slot) = ccl_prog;
1079 return make_int (i);
1085 Lisp_Object new_table = Fmake_vector (make_int (len * 2), Qnil);
1088 for (j = 0; j < len; j++)
1089 XVECTOR_DATA (new_table)[j]
1090 = XVECTOR_DATA (Vccl_program_table)[j];
1091 Vccl_program_table = new_table;
1094 XVECTOR_DATA (Vccl_program_table)[i] = Fcons (name, ccl_prog);
1095 return make_int (i);
1099 syms_of_mule_ccl (void)
1101 DEFSUBR (Fccl_execute);
1102 DEFSUBR (Fccl_execute_on_string);
1103 DEFSUBR (Fregister_ccl_program);
1107 vars_of_mule_ccl (void)
1109 staticpro (&Vccl_program_table);
1110 Vccl_program_table = Fmake_vector (make_int (32), Qnil);
1112 DEFVAR_LISP ("font-ccl-encoder-alist", &Vfont_ccl_encoder_alist /*
1113 Alist of fontname patterns vs corresponding CCL program.
1114 Each element looks like (REGEXP . CCL-CODE),
1115 where CCL-CODE is a compiled CCL program.
1116 When a font whose name matches REGEXP is used for displaying a character,
1117 CCL-CODE is executed to calculate the code point in the font
1118 from the charset number and position code(s) of the character which are set
1119 in CCL registers R0, R1, and R2 before the execution.
1120 The code point in the font is set in CCL registers R1 and R2
1121 when the execution terminated.
1122 If the font is single-byte font, the register R2 is not used.
1124 Vfont_ccl_encoder_alist = Qnil;