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 "mule-charset.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 < 256 ) ? \
451 simple_set_charptr_emchar (work, ch) : \
452 non_ascii_set_charptr_emchar (work, ch); \
453 Dynarr_add_many (destination, work, len); \
457 /* Write a string at ccl_prog[IC] of length LEN to the current output
459 #define CCL_WRITE_STRING(len) do { \
462 ccl->status = CCL_STAT_INVALID_CMD; \
463 goto ccl_error_handler; \
466 for (i = 0; i < len; i++) \
467 Dynarr_add(destination, \
468 (XINT (ccl_prog[ic + (i / 3)]) \
469 >> ((2 - (i % 3)) * 8)) & 0xFF); \
472 /* Read one byte from the current input buffer into Rth register. */
473 #define CCL_READ_CHAR(r) do { \
476 ccl->status = CCL_STAT_INVALID_CMD; \
477 goto ccl_error_handler; \
479 else if (src < src_end) \
481 else if (ccl->last_block) \
487 /* Suspend CCL program because of \
488 reading from empty input buffer or \
489 writing to full output buffer. \
490 When this program is resumed, the \
491 same I/O command is executed. */ \
494 ccl->status = CCL_STAT_SUSPEND; \
500 /* Execute CCL code on SRC_BYTES length text at SOURCE. The resulting
501 text goes to a place pointed by DESTINATION. The bytes actually
502 processed is returned as *CONSUMED. The return value is the length
503 of the resulting text. As a side effect, the contents of CCL registers
504 are updated. If SOURCE or DESTINATION is NULL, only operations on
505 registers are permitted. */
508 #define CCL_DEBUG_BACKTRACE_LEN 256
509 int ccl_backtrace_table[CCL_BACKTRACE_TABLE];
510 int ccl_backtrace_idx;
513 struct ccl_prog_stack
515 Lisp_Object *ccl_prog; /* Pointer to an array of CCL code. */
516 int ic; /* Instruction Counter. */
520 ccl_driver (struct ccl_program *ccl, CONST unsigned char *source, unsigned_char_dynarr *destination, int src_bytes, int *consumed)
524 int code = -1; /* init to illegal value, */
526 Lisp_Object *ccl_prog = ccl->prog;
527 CONST unsigned char *src = source, *src_end = src + src_bytes;
528 int jump_address = 0; /* shut up the compiler */
532 /* For the moment, we only support depth 256 of stack. */
533 struct ccl_prog_stack ccl_prog_stack_struct[256];
535 if (ic >= ccl->eof_ic)
536 ic = CCL_HEADER_MAIN;
539 ccl_backtrace_idx = 0;
545 ccl_backtrace_table[ccl_backtrace_idx++] = ic;
546 if (ccl_backtrace_idx >= CCL_DEBUG_BACKTRACE_LEN)
547 ccl_backtrace_idx = 0;
548 ccl_backtrace_table[ccl_backtrace_idx] = 0;
551 if (!NILP (Vquit_flag) && NILP (Vinhibit_quit))
553 /* We can't just signal Qquit, instead break the loop as if
554 the whole data is processed. Don't reset Vquit_flag, it
555 must be handled later at a safer place. */
557 src = source + src_bytes;
558 ccl->status = CCL_STAT_QUIT;
562 code = XINT (ccl_prog[ic]); ic++;
564 field2 = (code & 0xFF) >> 5;
567 #define RRR (field1 & 7)
568 #define Rrr ((field1 >> 3) & 7)
573 case CCL_SetRegister: /* 00000000000000000RRRrrrXXXXX */
577 case CCL_SetShortConst: /* CCCCCCCCCCCCCCCCCCCCrrrXXXXX */
581 case CCL_SetConst: /* 00000000000000000000rrrXXXXX */
582 reg[rrr] = XINT (ccl_prog[ic]);
586 case CCL_SetArray: /* CCCCCCCCCCCCCCCCCCCCRRRrrrXXXXX */
589 if ((unsigned int) i < j)
590 reg[rrr] = XINT (ccl_prog[ic + i]);
594 case CCL_Jump: /* A--D--D--R--E--S--S-000XXXXX */
598 case CCL_JumpCond: /* A--D--D--R--E--S--S-rrrXXXXX */
603 case CCL_WriteRegisterJump: /* A--D--D--R--E--S--S-rrrXXXXX */
609 case CCL_WriteRegisterReadJump: /* A--D--D--R--E--S--S-rrrXXXXX */
613 CCL_READ_CHAR (reg[rrr]);
617 case CCL_WriteConstJump: /* A--D--D--R--E--S--S-000XXXXX */
618 i = XINT (ccl_prog[ic]);
623 case CCL_WriteConstReadJump: /* A--D--D--R--E--S--S-rrrXXXXX */
624 i = XINT (ccl_prog[ic]);
627 CCL_READ_CHAR (reg[rrr]);
631 case CCL_WriteStringJump: /* A--D--D--R--E--S--S-000XXXXX */
632 j = XINT (ccl_prog[ic]);
634 CCL_WRITE_STRING (j);
638 case CCL_WriteArrayReadJump: /* A--D--D--R--E--S--S-rrrXXXXX */
640 j = XINT (ccl_prog[ic]);
641 if ((unsigned int) i < j)
643 i = XINT (ccl_prog[ic + 1 + i]);
647 CCL_READ_CHAR (reg[rrr]);
648 ic += ADDR - (j + 2);
651 case CCL_ReadJump: /* A--D--D--R--E--S--S-rrrYYYYY */
652 CCL_READ_CHAR (reg[rrr]);
656 case CCL_ReadBranch: /* CCCCCCCCCCCCCCCCCCCCrrrXXXXX */
657 CCL_READ_CHAR (reg[rrr]);
658 /* fall through ... */
659 case CCL_Branch: /* CCCCCCCCCCCCCCCCCCCCrrrXXXXX */
660 if ((unsigned int) reg[rrr] < field1)
661 ic += XINT (ccl_prog[ic + reg[rrr]]);
663 ic += XINT (ccl_prog[ic + field1]);
666 case CCL_ReadRegister: /* CCCCCCCCCCCCCCCCCCCCrrXXXXX */
669 CCL_READ_CHAR (reg[rrr]);
671 code = XINT (ccl_prog[ic]); ic++;
673 field2 = (code & 0xFF) >> 5;
677 case CCL_WriteExprConst: /* 1:00000OPERATION000RRR000XXXXX */
680 j = XINT (ccl_prog[ic]);
685 case CCL_WriteRegister: /* CCCCCCCCCCCCCCCCCCCrrrXXXXX */
691 code = XINT (ccl_prog[ic]); ic++;
693 field2 = (code & 0xFF) >> 5;
697 case CCL_WriteExprRegister: /* 1:00000OPERATIONRrrRRR000XXXXX */
704 case CCL_Call: /* CCCCCCCCCCCCCCCCCCCC000XXXXX */
710 || field1 >= XVECTOR_LENGTH (Vccl_program_table)
711 || (slot = XVECTOR_DATA (Vccl_program_table)[field1],
713 || !VECTORP (XCDR (slot)))
717 ccl_prog = ccl_prog_stack_struct[0].ccl_prog;
718 ic = ccl_prog_stack_struct[0].ic;
720 ccl->status = CCL_STAT_INVALID_CMD;
721 goto ccl_error_handler;
724 ccl_prog_stack_struct[stack_idx].ccl_prog = ccl_prog;
725 ccl_prog_stack_struct[stack_idx].ic = ic;
727 ccl_prog = XVECTOR_DATA (XCDR (slot));
728 ic = CCL_HEADER_MAIN;
732 case CCL_WriteConstString: /* CCCCCCCCCCCCCCCCCCCCrrrXXXXX */
734 CCL_WRITE_CHAR (field1);
737 CCL_WRITE_STRING (field1);
738 ic += (field1 + 2) / 3;
742 case CCL_WriteArray: /* CCCCCCCCCCCCCCCCCCCCrrrXXXXX */
744 if ((unsigned int) i < field1)
746 j = XINT (ccl_prog[ic + i]);
752 case CCL_End: /* 0000000000000000000000XXXXX */
755 ccl_prog = ccl_prog_stack_struct[stack_idx].ccl_prog;
756 ic = ccl_prog_stack_struct[stack_idx].ic;
759 /* Terminate CCL program successfully. */
760 ccl->status = CCL_STAT_SUCCESS;
761 ccl->ic = CCL_HEADER_MAIN;
764 case CCL_ExprSelfConst: /* 00000OPERATION000000rrrXXXXX */
765 i = XINT (ccl_prog[ic]);
770 case CCL_ExprSelfReg: /* 00000OPERATION000RRRrrrXXXXX */
777 case CCL_PLUS: reg[rrr] += i; break;
778 case CCL_MINUS: reg[rrr] -= i; break;
779 case CCL_MUL: reg[rrr] *= i; break;
780 case CCL_DIV: reg[rrr] /= i; break;
781 case CCL_MOD: reg[rrr] %= i; break;
782 case CCL_AND: reg[rrr] &= i; break;
783 case CCL_OR: reg[rrr] |= i; break;
784 case CCL_XOR: reg[rrr] ^= i; break;
785 case CCL_LSH: reg[rrr] <<= i; break;
786 case CCL_RSH: reg[rrr] >>= i; break;
787 case CCL_LSH8: reg[rrr] <<= 8; reg[rrr] |= i; break;
788 case CCL_RSH8: reg[7] = reg[rrr] & 0xFF; reg[rrr] >>= 8; break;
789 case CCL_DIVMOD: reg[7] = reg[rrr] % i; reg[rrr] /= i; break;
790 case CCL_LS: reg[rrr] = reg[rrr] < i; break;
791 case CCL_GT: reg[rrr] = reg[rrr] > i; break;
792 case CCL_EQ: reg[rrr] = reg[rrr] == i; break;
793 case CCL_LE: reg[rrr] = reg[rrr] <= i; break;
794 case CCL_GE: reg[rrr] = reg[rrr] >= i; break;
795 case CCL_NE: reg[rrr] = reg[rrr] != i; break;
797 ccl->status = CCL_STAT_INVALID_CMD;
798 goto ccl_error_handler;
802 case CCL_SetExprConst: /* 00000OPERATION000RRRrrrXXXXX */
804 j = XINT (ccl_prog[ic]);
809 case CCL_SetExprReg: /* 00000OPERATIONRrrRRRrrrXXXXX */
816 case CCL_ReadJumpCondExprConst: /* A--D--D--R--E--S--S-rrrXXXXX */
817 CCL_READ_CHAR (reg[rrr]);
818 case CCL_JumpCondExprConst: /* A--D--D--R--E--S--S-rrrXXXXX */
820 op = XINT (ccl_prog[ic]);
821 jump_address = ic++ + ADDR;
822 j = XINT (ccl_prog[ic]);
827 case CCL_ReadJumpCondExprReg: /* A--D--D--R--E--S--S-rrrXXXXX */
828 CCL_READ_CHAR (reg[rrr]);
829 case CCL_JumpCondExprReg:
831 op = XINT (ccl_prog[ic]);
832 jump_address = ic++ + ADDR;
833 j = reg[XINT (ccl_prog[ic])];
840 case CCL_PLUS: reg[rrr] = i + j; break;
841 case CCL_MINUS: reg[rrr] = i - j; break;
842 case CCL_MUL: reg[rrr] = i * j; break;
843 case CCL_DIV: reg[rrr] = i / j; break;
844 case CCL_MOD: reg[rrr] = i % j; break;
845 case CCL_AND: reg[rrr] = i & j; break;
846 case CCL_OR: reg[rrr] = i | j; break;
847 case CCL_XOR: reg[rrr] = i ^ j; break;
848 case CCL_LSH: reg[rrr] = i << j; break;
849 case CCL_RSH: reg[rrr] = i >> j; break;
850 case CCL_LSH8: reg[rrr] = (i << 8) | j; break;
851 case CCL_RSH8: reg[rrr] = i >> 8; reg[7] = i & 0xFF; break;
852 case CCL_DIVMOD: reg[rrr] = i / j; reg[7] = i % j; break;
853 case CCL_LS: reg[rrr] = i < j; break;
854 case CCL_GT: reg[rrr] = i > j; break;
855 case CCL_EQ: reg[rrr] = i == j; break;
856 case CCL_LE: reg[rrr] = i <= j; break;
857 case CCL_GE: reg[rrr] = i >= j; break;
858 case CCL_NE: reg[rrr] = i != j; break;
859 case CCL_ENCODE_SJIS: ENCODE_SJIS (i, j, reg[rrr], reg[7]); break;
860 case CCL_DECODE_SJIS: DECODE_SJIS (i, j, reg[rrr], reg[7]); break;
862 ccl->status = CCL_STAT_INVALID_CMD;
863 goto ccl_error_handler;
866 if (code == CCL_WriteExprConst || code == CCL_WriteExprRegister)
876 ccl->status = CCL_STAT_INVALID_CMD;
877 goto ccl_error_handler;
884 /* We can insert an error message only if DESTINATION is
885 specified and we still have a room to store the message
891 /* Terminate CCL program because of invalid command.
892 Should not occur in the normal case. */
893 case CCL_STAT_INVALID_CMD:
894 sprintf(msg, "\nCCL: Invalid command %x (ccl_code = %x) at %d.",
895 code & 0x1F, code, ic);
898 int i = ccl_backtrace_idx - 1;
901 Dynarr_add_many (destination, (unsigned char *) msg, strlen (msg));
903 for (j = 0; j < CCL_DEBUG_BACKTRACE_LEN; j++, i--)
905 if (i < 0) i = CCL_DEBUG_BACKTRACE_LEN - 1;
906 if (ccl_backtrace_table[i] == 0)
908 sprintf(msg, " %d", ccl_backtrace_table[i]);
909 Dynarr_add_many (destination, (unsigned char *) msg, strlen (msg));
916 sprintf(msg, "\nCCL: Quited.");
920 sprintf(msg, "\nCCL: Unknown error type (%d).", ccl->status);
923 Dynarr_add_many (destination, (unsigned char *) msg, strlen (msg));
928 if (consumed) *consumed = src - source;
930 return Dynarr_length (destination);
935 /* Setup fields of the structure pointed by CCL appropriately for the
936 execution of compiled CCL code in VEC (vector of integer). */
938 setup_ccl_program (struct ccl_program *ccl, Lisp_Object vec)
942 ccl->size = XVECTOR_LENGTH (vec);
943 ccl->prog = XVECTOR_DATA (vec);
944 ccl->ic = CCL_HEADER_MAIN;
945 ccl->eof_ic = XINT (XVECTOR_DATA (vec)[CCL_HEADER_EOF]);
946 ccl->buf_magnification = XINT (XVECTOR_DATA (vec)[CCL_HEADER_BUF_MAG]);
947 for (i = 0; i < 8; i++)
955 DEFUN ("ccl-execute", Fccl_execute, 2, 2, 0, /*
956 Execute CCL-PROGRAM with registers initialized by REGISTERS.
957 CCL-PROGRAM is a compiled code generated by `ccl-compile',
958 no I/O commands should appear in the CCL program.
959 REGISTERS is a vector of [R0 R1 ... R7] where RN is an initial value
961 As side effect, each element of REGISTER holds the value of
962 corresponding register after the execution.
966 struct ccl_program ccl;
969 CHECK_VECTOR (ccl_prog);
971 if (XVECTOR_LENGTH (reg) != 8)
972 signal_simple_error ("Vector should be of length 8", reg);
974 setup_ccl_program (&ccl, ccl_prog);
975 for (i = 0; i < 8; i++)
976 ccl.reg[i] = (INTP (XVECTOR_DATA (reg)[i])
977 ? XINT (XVECTOR_DATA (reg)[i])
980 ccl_driver (&ccl, (CONST unsigned char *)0, (unsigned_char_dynarr *)0,
983 if (ccl.status != CCL_STAT_SUCCESS)
984 error ("Error in CCL program at %dth code", ccl.ic);
986 for (i = 0; i < 8; i++)
987 XSETINT (XVECTOR_DATA (reg)[i], ccl.reg[i]);
991 DEFUN ("ccl-execute-on-string", Fccl_execute_on_string, 3, 4, 0, /*
992 Execute CCL-PROGRAM with initial STATUS on STRING.
993 CCL-PROGRAM is a compiled code generated by `ccl-compile'.
994 Read buffer is set to STRING, and write buffer is allocated automatically.
995 STATUS is a vector of [R0 R1 ... R7 IC], where
996 R0..R7 are initial values of corresponding registers,
997 IC is the instruction counter specifying from where to start the program.
998 If R0..R7 are nil, they are initialized to 0.
999 If IC is nil, it is initialized to head of the CCL program.
1000 Returns the contents of write buffer as a string,
1001 and as side effect, STATUS is updated.
1002 If optional 4th arg CONTINUE is non-nil, keep IC on read operation
1003 when read buffer is exausted, else, IC is always set to the end of
1004 CCL-PROGRAM on exit.
1006 (ccl_prog, status, str, contin))
1009 struct ccl_program ccl;
1011 unsigned_char_dynarr *outbuf;
1012 struct gcpro gcpro1, gcpro2, gcpro3;
1014 CHECK_VECTOR (ccl_prog);
1015 CHECK_VECTOR (status);
1016 if (XVECTOR_LENGTH (status) != 9)
1017 signal_simple_error ("Vector should be of length 9", status);
1019 GCPRO3 (ccl_prog, status, str);
1021 setup_ccl_program (&ccl, ccl_prog);
1022 for (i = 0; i < 8; i++)
1024 if (NILP (XVECTOR_DATA (status)[i]))
1025 XSETINT (XVECTOR_DATA (status)[i], 0);
1026 if (INTP (XVECTOR_DATA (status)[i]))
1027 ccl.reg[i] = XINT (XVECTOR_DATA (status)[i]);
1029 if (INTP (XVECTOR_DATA (status)[8]))
1031 i = XINT (XVECTOR_DATA (status)[8]);
1032 if (ccl.ic < i && i < ccl.size)
1035 outbuf = Dynarr_new (unsigned_char);
1036 ccl.last_block = NILP (contin);
1037 produced = ccl_driver (&ccl, XSTRING_DATA (str), outbuf,
1038 XSTRING_LENGTH (str), (int *)0);
1039 for (i = 0; i < 8; i++)
1040 XVECTOR_DATA (status)[i] = make_int(ccl.reg[i]);
1041 XSETINT (XVECTOR_DATA (status)[8], ccl.ic);
1044 val = make_string (Dynarr_atp (outbuf, 0), produced);
1045 Dynarr_free (outbuf);
1047 if (ccl.status != CCL_STAT_SUCCESS
1048 && ccl.status != CCL_STAT_SUSPEND)
1049 error ("Error in CCL program at %dth code", ccl.ic);
1054 DEFUN ("register-ccl-program", Fregister_ccl_program, 2, 2, 0, /*
1055 Register CCL program PROGRAM of NAME in `ccl-program-table'.
1056 PROGRAM should be a compiled code of CCL program, or nil.
1057 Return index number of the registered CCL program.
1061 int len = XVECTOR_LENGTH (Vccl_program_table);
1064 CHECK_SYMBOL (name);
1065 if (!NILP (ccl_prog))
1066 CHECK_VECTOR (ccl_prog);
1068 for (i = 0; i < len; i++)
1070 Lisp_Object slot = XVECTOR_DATA (Vccl_program_table)[i];
1075 if (EQ (name, XCAR (slot)))
1077 XCDR (slot) = ccl_prog;
1078 return make_int (i);
1084 Lisp_Object new_table = Fmake_vector (make_int (len * 2), Qnil);
1087 for (j = 0; j < len; j++)
1088 XVECTOR_DATA (new_table)[j]
1089 = XVECTOR_DATA (Vccl_program_table)[j];
1090 Vccl_program_table = new_table;
1093 XVECTOR_DATA (Vccl_program_table)[i] = Fcons (name, ccl_prog);
1094 return make_int (i);
1098 syms_of_mule_ccl (void)
1100 DEFSUBR (Fccl_execute);
1101 DEFSUBR (Fccl_execute_on_string);
1102 DEFSUBR (Fregister_ccl_program);
1106 vars_of_mule_ccl (void)
1108 staticpro (&Vccl_program_table);
1109 Vccl_program_table = Fmake_vector (make_int (32), Qnil);
1111 DEFVAR_LISP ("font-ccl-encoder-alist", &Vfont_ccl_encoder_alist /*
1112 Alist of fontname patterns vs corresponding CCL program.
1113 Each element looks like (REGEXP . CCL-CODE),
1114 where CCL-CODE is a compiled CCL program.
1115 When a font whose name matches REGEXP is used for displaying a character,
1116 CCL-CODE is executed to calculate the code point in the font
1117 from the charset number and position code(s) of the character which are set
1118 in CCL registers R0, R1, and R2 before the execution.
1119 The code point in the font is set in CCL registers R1 and R2
1120 when the execution terminated.
1121 If the font is single-byte font, the register R2 is not used.
1123 Vfont_ccl_encoder_alist = Qnil;