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 /* Alist of fontname patterns vs corresponding CCL program. */
39 Lisp_Object Vfont_ccl_encoder_alist
;
41 /* Vector of CCL program names vs corresponding program data. */
42 Lisp_Object Vccl_program_table
;
44 /* CCL (Code Conversion Language) is a simple language which has
45 operations on one input buffer, one output buffer, and 7 registers.
46 The syntax of CCL is described in `ccl.el'. Emacs Lisp function
47 `ccl-compile' compiles a CCL program and produces a CCL code which
48 is a vector of integers. The structure of this vector is as
49 follows: The 1st element: buffer-magnification, a factor for the
50 size of output buffer compared with the size of input buffer. The
51 2nd element: address of CCL code to be executed when encountered
52 with end of input stream. The 3rd and the remaining elements: CCL
55 /* Header of CCL compiled code */
56 #define CCL_HEADER_BUF_MAG 0
57 #define CCL_HEADER_EOF 1
58 #define CCL_HEADER_MAIN 2
60 /* CCL code is a sequence of 28-bit non-negative integers (i.e. the
61 MSB is always 0), each contains CCL command and/or arguments in the
64 |----------------- integer (28-bit) ------------------|
65 |------- 17-bit ------|- 3-bit --|- 3-bit --|- 5-bit -|
66 |--constant argument--|-register-|-register-|-command-|
67 ccccccccccccccccc RRR rrr XXXXX
69 |------- relative address -------|-register-|-command-|
70 cccccccccccccccccccc rrr XXXXX
72 |------------- constant or other args ----------------|
73 cccccccccccccccccccccccccccc
75 where, `cc...c' is a non-negative integer indicating constant value
76 (the left most `c' is always 0) or an absolute jump address, `RRR'
77 and `rrr' are CCL register number, `XXXXX' is one of the following
82 Each comment fields shows one or more lines for command syntax and
83 the following lines for semantics of the command. In semantics, IC
84 stands for Instruction Counter. */
86 #define CCL_SetRegister 0x00 /* Set register a register value:
87 1:00000000000000000RRRrrrXXXXX
88 ------------------------------
92 #define CCL_SetShortConst 0x01 /* Set register a short constant value:
93 1:CCCCCCCCCCCCCCCCCCCCrrrXXXXX
94 ------------------------------
95 reg[rrr] = CCCCCCCCCCCCCCCCCCC;
98 #define CCL_SetConst 0x02 /* Set register a constant value:
99 1:00000000000000000000rrrXXXXX
101 ------------------------------
106 #define CCL_SetArray 0x03 /* Set register an element of array:
107 1:CCCCCCCCCCCCCCCCCRRRrrrXXXXX
111 ------------------------------
112 if (0 <= reg[RRR] < CC..C)
113 reg[rrr] = ELEMENT[reg[RRR]];
117 #define CCL_Jump 0x04 /* Jump:
118 1:A--D--D--R--E--S--S-000XXXXX
119 ------------------------------
123 /* Note: If CC..C is greater than 0, the second code is omitted. */
125 #define CCL_JumpCond 0x05 /* Jump conditional:
126 1:A--D--D--R--E--S--S-rrrXXXXX
127 ------------------------------
133 #define CCL_WriteRegisterJump 0x06 /* Write register and jump:
134 1:A--D--D--R--E--S--S-rrrXXXXX
135 ------------------------------
140 #define CCL_WriteRegisterReadJump 0x07 /* Write register, read, and jump:
141 1:A--D--D--R--E--S--S-rrrXXXXX
142 2:A--D--D--R--E--S--S-rrrYYYYY
143 -----------------------------
149 /* Note: If read is suspended, the resumed execution starts from the
150 second code (YYYYY == CCL_ReadJump). */
152 #define CCL_WriteConstJump 0x08 /* Write constant and jump:
153 1:A--D--D--R--E--S--S-000XXXXX
155 ------------------------------
160 #define CCL_WriteConstReadJump 0x09 /* Write constant, read, and jump:
161 1:A--D--D--R--E--S--S-rrrXXXXX
163 3:A--D--D--R--E--S--S-rrrYYYYY
164 -----------------------------
170 /* Note: If read is suspended, the resumed execution starts from the
171 second code (YYYYY == CCL_ReadJump). */
173 #define CCL_WriteStringJump 0x0A /* Write string and jump:
174 1:A--D--D--R--E--S--S-000XXXXX
176 3:0000STRIN[0]STRIN[1]STRIN[2]
178 ------------------------------
179 write_string (STRING, LENGTH);
183 #define CCL_WriteArrayReadJump 0x0B /* Write an array element, read, and jump:
184 1:A--D--D--R--E--S--S-rrrXXXXX
189 N:A--D--D--R--E--S--S-rrrYYYYY
190 ------------------------------
191 if (0 <= reg[rrr] < LENGTH)
192 write (ELEMENT[reg[rrr]]);
193 IC += LENGTH + 2; (... pointing at N+1)
197 /* Note: If read is suspended, the resumed execution starts from the
198 Nth code (YYYYY == CCL_ReadJump). */
200 #define CCL_ReadJump 0x0C /* Read and jump:
201 1:A--D--D--R--E--S--S-rrrYYYYY
202 -----------------------------
207 #define CCL_Branch 0x0D /* Jump by branch table:
208 1:CCCCCCCCCCCCCCCCCCCCrrrXXXXX
209 2:A--D--D--R--E-S-S[0]000XXXXX
210 3:A--D--D--R--E-S-S[1]000XXXXX
212 ------------------------------
213 if (0 <= reg[rrr] < CC..C)
214 IC += ADDRESS[reg[rrr]];
216 IC += ADDRESS[CC..C];
219 #define CCL_ReadRegister 0x0E /* Read bytes into registers:
220 1:CCCCCCCCCCCCCCCCCCCCrrrXXXXX
221 2:CCCCCCCCCCCCCCCCCCCCrrrXXXXX
223 ------------------------------
228 #define CCL_WriteExprConst 0x0F /* write result of expression:
229 1:00000OPERATION000RRR000XXXXX
231 ------------------------------
232 write (reg[RRR] OPERATION CONSTANT);
236 /* Note: If the Nth read is suspended, the resumed execution starts
237 from the Nth code. */
239 #define CCL_ReadBranch 0x10 /* Read one byte into a register,
240 and jump by branch table:
241 1:CCCCCCCCCCCCCCCCCCCCrrrXXXXX
242 2:A--D--D--R--E-S-S[0]000XXXXX
243 3:A--D--D--R--E-S-S[1]000XXXXX
245 ------------------------------
247 if (0 <= reg[rrr] < CC..C)
248 IC += ADDRESS[reg[rrr]];
250 IC += ADDRESS[CC..C];
253 #define CCL_WriteRegister 0x11 /* Write registers:
254 1:CCCCCCCCCCCCCCCCCCCrrrXXXXX
255 2:CCCCCCCCCCCCCCCCCCCrrrXXXXX
257 ------------------------------
263 /* Note: If the Nth write is suspended, the resumed execution
264 starts from the Nth code. */
266 #define CCL_WriteExprRegister 0x12 /* Write result of expression
267 1:00000OPERATIONRrrRRR000XXXXX
268 ------------------------------
269 write (reg[RRR] OPERATION reg[Rrr]);
272 #define CCL_Call 0x13 /* Write a constant:
273 1:CCCCCCCCCCCCCCCCCCCC000XXXXX
274 ------------------------------
278 #define CCL_WriteConstString 0x14 /* Write a constant or a string:
279 1:CCCCCCCCCCCCCCCCCCCCrrrXXXXX
280 [2:0000STRIN[0]STRIN[1]STRIN[2]]
282 -----------------------------
286 write_string (STRING, CC..C);
287 IC += (CC..C + 2) / 3;
290 #define CCL_WriteArray 0x15 /* Write an element of array:
291 1:CCCCCCCCCCCCCCCCCCCCrrrXXXXX
295 ------------------------------
296 if (0 <= reg[rrr] < CC..C)
297 write (ELEMENT[reg[rrr]]);
301 #define CCL_End 0x16 /* Terminate:
302 1:00000000000000000000000XXXXX
303 ------------------------------
307 /* The following two codes execute an assignment arithmetic/logical
308 operation. The form of the operation is like REG OP= OPERAND. */
310 #define CCL_ExprSelfConst 0x17 /* REG OP= constant:
311 1:00000OPERATION000000rrrXXXXX
313 ------------------------------
314 reg[rrr] OPERATION= CONSTANT;
317 #define CCL_ExprSelfReg 0x18 /* REG1 OP= REG2:
318 1:00000OPERATION000RRRrrrXXXXX
319 ------------------------------
320 reg[rrr] OPERATION= reg[RRR];
323 /* The following codes execute an arithmetic/logical operation. The
324 form of the operation is like REG_X = REG_Y OP OPERAND2. */
326 #define CCL_SetExprConst 0x19 /* REG_X = REG_Y OP constant:
327 1:00000OPERATION000RRRrrrXXXXX
329 ------------------------------
330 reg[rrr] = reg[RRR] OPERATION CONSTANT;
334 #define CCL_SetExprReg 0x1A /* REG1 = REG2 OP REG3:
335 1:00000OPERATIONRrrRRRrrrXXXXX
336 ------------------------------
337 reg[rrr] = reg[RRR] OPERATION reg[Rrr];
340 #define CCL_JumpCondExprConst 0x1B /* Jump conditional according to
341 an operation on constant:
342 1:A--D--D--R--E--S--S-rrrXXXXX
345 -----------------------------
346 reg[7] = reg[rrr] OPERATION CONSTANT;
353 #define CCL_JumpCondExprReg 0x1C /* Jump conditional according to
354 an operation on register:
355 1:A--D--D--R--E--S--S-rrrXXXXX
358 -----------------------------
359 reg[7] = reg[rrr] OPERATION reg[RRR];
366 #define CCL_ReadJumpCondExprConst 0x1D /* Read and jump conditional according
367 to an operation on constant:
368 1:A--D--D--R--E--S--S-rrrXXXXX
371 -----------------------------
373 reg[7] = reg[rrr] OPERATION CONSTANT;
380 #define CCL_ReadJumpCondExprReg 0x1E /* Read and jump conditional according
381 to an operation on register:
382 1:A--D--D--R--E--S--S-rrrXXXXX
385 -----------------------------
387 reg[7] = reg[rrr] OPERATION reg[RRR];
394 #define CCL_Extention 0x1F /* Extended CCL code
395 1:ExtendedCOMMNDRrrRRRrrrXXXXX
398 ------------------------------
399 extended_command (rrr,RRR,Rrr,ARGS)
403 /* CCL arithmetic/logical operators. */
404 #define CCL_PLUS 0x00 /* X = Y + Z */
405 #define CCL_MINUS 0x01 /* X = Y - Z */
406 #define CCL_MUL 0x02 /* X = Y * Z */
407 #define CCL_DIV 0x03 /* X = Y / Z */
408 #define CCL_MOD 0x04 /* X = Y % Z */
409 #define CCL_AND 0x05 /* X = Y & Z */
410 #define CCL_OR 0x06 /* X = Y | Z */
411 #define CCL_XOR 0x07 /* X = Y ^ Z */
412 #define CCL_LSH 0x08 /* X = Y << Z */
413 #define CCL_RSH 0x09 /* X = Y >> Z */
414 #define CCL_LSH8 0x0A /* X = (Y << 8) | Z */
415 #define CCL_RSH8 0x0B /* X = Y >> 8, r[7] = Y & 0xFF */
416 #define CCL_DIVMOD 0x0C /* X = Y / Z, r[7] = Y % Z */
417 #define CCL_LS 0x10 /* X = (X < Y) */
418 #define CCL_GT 0x11 /* X = (X > Y) */
419 #define CCL_EQ 0x12 /* X = (X == Y) */
420 #define CCL_LE 0x13 /* X = (X <= Y) */
421 #define CCL_GE 0x14 /* X = (X >= Y) */
422 #define CCL_NE 0x15 /* X = (X != Y) */
424 #define CCL_ENCODE_SJIS 0x16 /* X = HIGHER_BYTE (SJIS (Y, Z))
425 r[7] = LOWER_BYTE (SJIS (Y, Z) */
426 #define CCL_DECODE_SJIS 0x17 /* X = HIGHER_BYTE (DE-SJIS (Y, Z))
427 r[7] = LOWER_BYTE (DE-SJIS (Y, Z)) */
429 /* Macros for exit status of CCL program. */
430 #define CCL_STAT_SUCCESS 0 /* Terminated successfully. */
431 #define CCL_STAT_SUSPEND 1 /* Terminated because of empty input
432 buffer or full output buffer. */
433 #define CCL_STAT_INVALID_CMD 2 /* Terminated because of invalid
435 #define CCL_STAT_QUIT 3 /* Terminated because of quit. */
437 /* Terminate CCL program successfully. */
438 #define CCL_SUCCESS \
440 ccl->status = CCL_STAT_SUCCESS; \
441 ccl->ic = CCL_HEADER_MAIN; \
445 /* Suspend CCL program because of reading from empty input buffer or
446 writing to full output buffer. When this program is resumed, the
447 same I/O command is executed. */
448 #define CCL_SUSPEND \
451 ccl->status = CCL_STAT_SUSPEND; \
455 /* Terminate CCL program because of invalid command. Should not occur
456 in the normal case. */
457 #define CCL_INVALID_CMD \
459 ccl->status = CCL_STAT_INVALID_CMD; \
460 goto ccl_error_handler; \
463 /* Encode one character CH to multibyte form and write to the current
464 output buffer. If CH is less than 256, CH is written as is. */
465 #define CCL_WRITE_CHAR(ch) \
471 unsigned char work[4], *str; \
472 int len = CHAR_STRING (ch, work, str); \
473 if (dst + len <= dst_end) \
475 bcopy (str, dst, len); \
483 /* Write a string at ccl_prog[IC] of length LEN to the current output
485 #define CCL_WRITE_STRING(len) \
489 else if (dst + len <= dst_end) \
490 for (i = 0; i < len; i++) \
491 *dst++ = ((XFASTINT (ccl_prog[ic + (i / 3)])) \
492 >> ((2 - (i % 3)) * 8)) & 0xFF; \
497 /* Read one byte from the current input buffer into Rth register. */
498 #define CCL_READ_CHAR(r) \
502 else if (src < src_end) \
504 else if (ccl->last_block) \
514 /* Execute CCL code on SRC_BYTES length text at SOURCE. The resulting
515 text goes to a place pointed by DESTINATION, the length of which
516 should not exceed DST_BYTES. The bytes actually processed is
517 returned as *CONSUMED. The return value is the length of the
518 resulting text. As a side effect, the contents of CCL registers
519 are updated. If SOURCE or DESTINATION is NULL, only operations on
520 registers are permitted. */
523 #define CCL_DEBUG_BACKTRACE_LEN 256
524 int ccl_backtrace_table
[CCL_BACKTRACE_TABLE
];
525 int ccl_backtrace_idx
;
528 struct ccl_prog_stack
530 Lisp_Object
*ccl_prog
; /* Pointer to an array of CCL code. */
531 int ic
; /* Instruction Counter. */
534 ccl_driver (ccl
, source
, destination
, src_bytes
, dst_bytes
, consumed
)
535 struct ccl_program
*ccl
;
536 unsigned char *source
, *destination
;
537 int src_bytes
, dst_bytes
;
540 register int *reg
= ccl
->reg
;
541 register int ic
= ccl
->ic
;
542 register int code
, field1
, field2
;
543 register Lisp_Object
*ccl_prog
= ccl
->prog
;
544 unsigned char *src
= source
, *src_end
= src
+ src_bytes
;
545 unsigned char *dst
= destination
, *dst_end
= dst
+ dst_bytes
;
549 /* For the moment, we only support depth 256 of stack. */
550 struct ccl_prog_stack ccl_prog_stack_struct
[256];
552 if (ic
>= ccl
->eof_ic
)
553 ic
= CCL_HEADER_MAIN
;
556 ccl_backtrace_idx
= 0;
562 ccl_backtrace_table
[ccl_backtrace_idx
++] = ic
;
563 if (ccl_backtrace_idx
>= CCL_DEBUG_BACKTRACE_LEN
)
564 ccl_backtrace_idx
= 0;
565 ccl_backtrace_table
[ccl_backtrace_idx
] = 0;
568 if (!NILP (Vquit_flag
) && NILP (Vinhibit_quit
))
570 /* We can't just signal Qquit, instead break the loop as if
571 the whole data is processed. Don't reset Vquit_flag, it
572 must be handled later at a safer place. */
574 src
= source
+ src_bytes
;
575 ccl
->status
= CCL_STAT_QUIT
;
579 code
= XINT (ccl_prog
[ic
]); ic
++;
581 field2
= (code
& 0xFF) >> 5;
584 #define RRR (field1 & 7)
585 #define Rrr ((field1 >> 3) & 7)
590 case CCL_SetRegister
: /* 00000000000000000RRRrrrXXXXX */
594 case CCL_SetShortConst
: /* CCCCCCCCCCCCCCCCCCCCrrrXXXXX */
598 case CCL_SetConst
: /* 00000000000000000000rrrXXXXX */
599 reg
[rrr
] = XINT (ccl_prog
[ic
]);
603 case CCL_SetArray
: /* CCCCCCCCCCCCCCCCCCCCRRRrrrXXXXX */
606 if ((unsigned int) i
< j
)
607 reg
[rrr
] = XINT (ccl_prog
[ic
+ i
]);
611 case CCL_Jump
: /* A--D--D--R--E--S--S-000XXXXX */
615 case CCL_JumpCond
: /* A--D--D--R--E--S--S-rrrXXXXX */
620 case CCL_WriteRegisterJump
: /* A--D--D--R--E--S--S-rrrXXXXX */
626 case CCL_WriteRegisterReadJump
: /* A--D--D--R--E--S--S-rrrXXXXX */
630 CCL_READ_CHAR (reg
[rrr
]);
634 case CCL_WriteConstJump
: /* A--D--D--R--E--S--S-000XXXXX */
635 i
= XINT (ccl_prog
[ic
]);
640 case CCL_WriteConstReadJump
: /* A--D--D--R--E--S--S-rrrXXXXX */
641 i
= XINT (ccl_prog
[ic
]);
644 CCL_READ_CHAR (reg
[rrr
]);
648 case CCL_WriteStringJump
: /* A--D--D--R--E--S--S-000XXXXX */
649 j
= XINT (ccl_prog
[ic
]);
651 CCL_WRITE_STRING (j
);
655 case CCL_WriteArrayReadJump
: /* A--D--D--R--E--S--S-rrrXXXXX */
657 j
= XINT (ccl_prog
[ic
]);
658 if ((unsigned int) i
< j
)
660 i
= XINT (ccl_prog
[ic
+ 1 + i
]);
664 CCL_READ_CHAR (reg
[rrr
]);
665 ic
+= ADDR
- (j
+ 2);
668 case CCL_ReadJump
: /* A--D--D--R--E--S--S-rrrYYYYY */
669 CCL_READ_CHAR (reg
[rrr
]);
673 case CCL_ReadBranch
: /* CCCCCCCCCCCCCCCCCCCCrrrXXXXX */
674 CCL_READ_CHAR (reg
[rrr
]);
675 /* fall through ... */
676 case CCL_Branch
: /* CCCCCCCCCCCCCCCCCCCCrrrXXXXX */
677 if ((unsigned int) reg
[rrr
] < field1
)
678 ic
+= XINT (ccl_prog
[ic
+ reg
[rrr
]]);
680 ic
+= XINT (ccl_prog
[ic
+ field1
]);
683 case CCL_ReadRegister
: /* CCCCCCCCCCCCCCCCCCCCrrXXXXX */
686 CCL_READ_CHAR (reg
[rrr
]);
688 code
= XINT (ccl_prog
[ic
]); ic
++;
690 field2
= (code
& 0xFF) >> 5;
694 case CCL_WriteExprConst
: /* 1:00000OPERATION000RRR000XXXXX */
697 j
= XINT (ccl_prog
[ic
]);
702 case CCL_WriteRegister
: /* CCCCCCCCCCCCCCCCCCCrrrXXXXX */
708 code
= XINT (ccl_prog
[ic
]); ic
++;
710 field2
= (code
& 0xFF) >> 5;
714 case CCL_WriteExprRegister
: /* 1:00000OPERATIONRrrRRR000XXXXX */
721 case CCL_Call
: /* CCCCCCCCCCCCCCCCCCCC000XXXXX */
727 || field1
>= XVECTOR (Vccl_program_table
)->size
728 || (slot
= XVECTOR (Vccl_program_table
)->contents
[field1
],
730 || !VECTORP (XCONS (slot
)->cdr
))
734 ccl_prog
= ccl_prog_stack_struct
[0].ccl_prog
;
735 ic
= ccl_prog_stack_struct
[0].ic
;
740 ccl_prog_stack_struct
[stack_idx
].ccl_prog
= ccl_prog
;
741 ccl_prog_stack_struct
[stack_idx
].ic
= ic
;
743 ccl_prog
= XVECTOR (XCONS (slot
)->cdr
)->contents
;
744 ic
= CCL_HEADER_MAIN
;
748 case CCL_WriteConstString
: /* CCCCCCCCCCCCCCCCCCCCrrrXXXXX */
750 CCL_WRITE_CHAR (field1
);
753 CCL_WRITE_STRING (field1
);
754 ic
+= (field1
+ 2) / 3;
758 case CCL_WriteArray
: /* CCCCCCCCCCCCCCCCCCCCrrrXXXXX */
760 if ((unsigned int) i
< field1
)
762 j
= XINT (ccl_prog
[ic
+ i
]);
768 case CCL_End
: /* 0000000000000000000000XXXXX */
771 ccl_prog
= ccl_prog_stack_struct
[stack_idx
].ccl_prog
;
772 ic
= ccl_prog_stack_struct
[stack_idx
].ic
;
777 case CCL_ExprSelfConst
: /* 00000OPERATION000000rrrXXXXX */
778 i
= XINT (ccl_prog
[ic
]);
783 case CCL_ExprSelfReg
: /* 00000OPERATION000RRRrrrXXXXX */
790 case CCL_PLUS
: reg
[rrr
] += i
; break;
791 case CCL_MINUS
: reg
[rrr
] -= i
; break;
792 case CCL_MUL
: reg
[rrr
] *= i
; break;
793 case CCL_DIV
: reg
[rrr
] /= i
; break;
794 case CCL_MOD
: reg
[rrr
] %= i
; break;
795 case CCL_AND
: reg
[rrr
] &= i
; break;
796 case CCL_OR
: reg
[rrr
] |= i
; break;
797 case CCL_XOR
: reg
[rrr
] ^= i
; break;
798 case CCL_LSH
: reg
[rrr
] <<= i
; break;
799 case CCL_RSH
: reg
[rrr
] >>= i
; break;
800 case CCL_LSH8
: reg
[rrr
] <<= 8; reg
[rrr
] |= i
; break;
801 case CCL_RSH8
: reg
[7] = reg
[rrr
] & 0xFF; reg
[rrr
] >>= 8; break;
802 case CCL_DIVMOD
: reg
[7] = reg
[rrr
] % i
; reg
[rrr
] /= i
; break;
803 case CCL_LS
: reg
[rrr
] = reg
[rrr
] < i
; break;
804 case CCL_GT
: reg
[rrr
] = reg
[rrr
] > i
; break;
805 case CCL_EQ
: reg
[rrr
] = reg
[rrr
] == i
; break;
806 case CCL_LE
: reg
[rrr
] = reg
[rrr
] <= i
; break;
807 case CCL_GE
: reg
[rrr
] = reg
[rrr
] >= i
; break;
808 case CCL_NE
: reg
[rrr
] = reg
[rrr
] != i
; break;
809 default: CCL_INVALID_CMD
;
813 case CCL_SetExprConst
: /* 00000OPERATION000RRRrrrXXXXX */
815 j
= XINT (ccl_prog
[ic
]);
820 case CCL_SetExprReg
: /* 00000OPERATIONRrrRRRrrrXXXXX */
827 case CCL_ReadJumpCondExprConst
: /* A--D--D--R--E--S--S-rrrXXXXX */
828 CCL_READ_CHAR (reg
[rrr
]);
829 case CCL_JumpCondExprConst
: /* A--D--D--R--E--S--S-rrrXXXXX */
831 op
= XINT (ccl_prog
[ic
]);
832 jump_address
= ic
++ + ADDR
;
833 j
= XINT (ccl_prog
[ic
]);
838 case CCL_ReadJumpCondExprReg
: /* A--D--D--R--E--S--S-rrrXXXXX */
839 CCL_READ_CHAR (reg
[rrr
]);
840 case CCL_JumpCondExprReg
:
842 op
= XINT (ccl_prog
[ic
]);
843 jump_address
= ic
++ + ADDR
;
844 j
= reg
[XINT (ccl_prog
[ic
])];
851 case CCL_PLUS
: reg
[rrr
] = i
+ j
; break;
852 case CCL_MINUS
: reg
[rrr
] = i
- j
; break;
853 case CCL_MUL
: reg
[rrr
] = i
* j
; break;
854 case CCL_DIV
: reg
[rrr
] = i
/ j
; break;
855 case CCL_MOD
: reg
[rrr
] = i
% j
; break;
856 case CCL_AND
: reg
[rrr
] = i
& j
; break;
857 case CCL_OR
: reg
[rrr
] = i
| j
; break;
858 case CCL_XOR
: reg
[rrr
] = i
^ j
;; break;
859 case CCL_LSH
: reg
[rrr
] = i
<< j
; break;
860 case CCL_RSH
: reg
[rrr
] = i
>> j
; break;
861 case CCL_LSH8
: reg
[rrr
] = (i
<< 8) | j
; break;
862 case CCL_RSH8
: reg
[rrr
] = i
>> 8; reg
[7] = i
& 0xFF; break;
863 case CCL_DIVMOD
: reg
[rrr
] = i
/ j
; reg
[7] = i
% j
; break;
864 case CCL_LS
: reg
[rrr
] = i
< j
; break;
865 case CCL_GT
: reg
[rrr
] = i
> j
; break;
866 case CCL_EQ
: reg
[rrr
] = i
== j
; break;
867 case CCL_LE
: reg
[rrr
] = i
<= j
; break;
868 case CCL_GE
: reg
[rrr
] = i
>= j
; break;
869 case CCL_NE
: reg
[rrr
] = i
!= j
; break;
870 case CCL_ENCODE_SJIS
: ENCODE_SJIS (i
, j
, reg
[rrr
], reg
[7]); break;
871 case CCL_DECODE_SJIS
: DECODE_SJIS (i
, j
, reg
[rrr
], reg
[7]); break;
872 default: CCL_INVALID_CMD
;
875 if (code
== CCL_WriteExprConst
|| code
== CCL_WriteExprRegister
)
892 /* We can insert an error message only if DESTINATION is
893 specified and we still have a room to store the message
900 case CCL_STAT_INVALID_CMD
:
901 sprintf(msg
, "\nCCL: Invalid command %x (ccl_code = %x) at %d.",
902 code
& 0x1F, code
, ic
);
905 int i
= ccl_backtrace_idx
- 1;
908 msglen
= strlen (msg
);
909 if (dst
+ msglen
<= dst_end
)
911 bcopy (msg
, dst
, msglen
);
915 for (j
= 0; j
< CCL_DEBUG_BACKTRACE_LEN
; j
++, i
--)
917 if (i
< 0) i
= CCL_DEBUG_BACKTRACE_LEN
- 1;
918 if (ccl_backtrace_table
[i
] == 0)
920 sprintf(msg
, " %d", ccl_backtrace_table
[i
]);
921 msglen
= strlen (msg
);
922 if (dst
+ msglen
> dst_end
)
924 bcopy (msg
, dst
, msglen
);
932 sprintf(msg
, "\nCCL: Quited.");
936 sprintf(msg
, "\nCCL: Unknown error type (%d).", ccl
->status
);
939 msglen
= strlen (msg
);
940 if (dst
+ msglen
<= dst_end
)
942 bcopy (msg
, dst
, msglen
);
949 if (consumed
) *consumed
= src
- source
;
950 return dst
- destination
;
953 /* Setup fields of the structure pointed by CCL appropriately for the
954 execution of compiled CCL code in VEC (vector of integer). */
955 setup_ccl_program (ccl
, vec
)
956 struct ccl_program
*ccl
;
961 ccl
->size
= XVECTOR (vec
)->size
;
962 ccl
->prog
= XVECTOR (vec
)->contents
;
963 ccl
->ic
= CCL_HEADER_MAIN
;
964 ccl
->eof_ic
= XINT (XVECTOR (vec
)->contents
[CCL_HEADER_EOF
]);
965 ccl
->buf_magnification
= XINT (XVECTOR (vec
)->contents
[CCL_HEADER_BUF_MAG
]);
966 for (i
= 0; i
< 8; i
++)
974 DEFUN ("ccl-execute", Fccl_execute
, Sccl_execute
, 2, 2, 0,
975 "Execute CCL-PROGRAM with registers initialized by REGISTERS.\n\
976 CCL-PROGRAM is a compiled code generated by `ccl-compile',\n\
977 no I/O commands should appear in the CCL program.\n\
978 REGISTERS is a vector of [R0 R1 ... R7] where RN is an initial value\n\
980 As side effect, each element of REGISTER holds the value of\n\
981 corresponding register after the execution.")
983 Lisp_Object ccl_prog
, reg
;
985 struct ccl_program ccl
;
988 CHECK_VECTOR (ccl_prog
, 0);
989 CHECK_VECTOR (reg
, 1);
990 if (XVECTOR (reg
)->size
!= 8)
991 error ("Invalid length of vector REGISTERS");
993 setup_ccl_program (&ccl
, ccl_prog
);
994 for (i
= 0; i
< 8; i
++)
995 ccl
.reg
[i
] = (INTEGERP (XVECTOR (reg
)->contents
[i
])
996 ? XINT (XVECTOR (reg
)->contents
[i
])
999 ccl_driver (&ccl
, (char *)0, (char *)0, 0, 0, (int *)0);
1001 if (ccl
.status
!= CCL_STAT_SUCCESS
)
1002 error ("Error in CCL program at %dth code", ccl
.ic
);
1004 for (i
= 0; i
< 8; i
++)
1005 XSETINT (XVECTOR (reg
)->contents
[i
], ccl
.reg
[i
]);
1009 DEFUN ("ccl-execute-on-string", Fccl_execute_on_string
, Sccl_execute_on_string
,
1011 "Execute CCL-PROGRAM with initial STATUS on STRING.\n\
1012 CCL-PROGRAM is a compiled code generated by `ccl-compile'.\n\
1013 Read buffer is set to STRING, and write buffer is allocated automatically.\n\
1014 STATUS is a vector of [R0 R1 ... R7 IC], where\n\
1015 R0..R7 are initial values of corresponding registers,\n\
1016 IC is the instruction counter specifying from where to start the program.\n\
1017 If R0..R7 are nil, they are initialized to 0.\n\
1018 If IC is nil, it is initialized to head of the CCL program.\n\
1019 Returns the contents of write buffer as a string,\n\
1020 and as side effect, STATUS is updated.\n\
1021 If optional 4th arg CONTINUE is non-nil, keep IC on read operation\n\
1022 when read buffer is exausted, else, IC is always set to the end of\n\
1023 CCL-PROGRAM on exit.")
1024 (ccl_prog
, status
, str
, contin
)
1025 Lisp_Object ccl_prog
, status
, str
, contin
;
1028 struct ccl_program ccl
;
1032 struct gcpro gcpro1
, gcpro2
, gcpro3
;
1034 CHECK_VECTOR (ccl_prog
, 0);
1035 CHECK_VECTOR (status
, 1);
1036 if (XVECTOR (status
)->size
!= 9)
1037 error ("Invalid length of vector STATUS");
1038 CHECK_STRING (str
, 2);
1039 GCPRO3 (ccl_prog
, status
, str
);
1041 setup_ccl_program (&ccl
, ccl_prog
);
1042 for (i
= 0; i
< 8; i
++)
1044 if (NILP (XVECTOR (status
)->contents
[i
]))
1045 XSETINT (XVECTOR (status
)->contents
[i
], 0);
1046 if (INTEGERP (XVECTOR (status
)->contents
[i
]))
1047 ccl
.reg
[i
] = XINT (XVECTOR (status
)->contents
[i
]);
1049 if (INTEGERP (XVECTOR (status
)->contents
[i
]))
1051 i
= XFASTINT (XVECTOR (status
)->contents
[8]);
1052 if (ccl
.ic
< i
&& i
< ccl
.size
)
1055 outbufsize
= XSTRING (str
)->size
* ccl
.buf_magnification
+ 256;
1056 outbuf
= (char *) xmalloc (outbufsize
);
1058 error ("Not enough memory");
1059 ccl
.last_block
= NILP (contin
);
1060 produced
= ccl_driver (&ccl
, XSTRING (str
)->data
, outbuf
,
1061 XSTRING (str
)->size
, outbufsize
, (int *)0);
1062 for (i
= 0; i
< 8; i
++)
1063 XSET (XVECTOR (status
)->contents
[i
], Lisp_Int
, ccl
.reg
[i
]);
1064 XSETINT (XVECTOR (status
)->contents
[8], ccl
.ic
);
1067 val
= make_string (outbuf
, produced
);
1070 if (ccl
.status
!= CCL_STAT_SUCCESS
1071 && ccl
.status
!= CCL_STAT_SUSPEND
)
1072 error ("Error in CCL program at %dth code", ccl
.ic
);
1077 DEFUN ("register-ccl-program", Fregister_ccl_program
, Sregister_ccl_program
,
1079 "Register CCL program PROGRAM of NAME in `ccl-program-table'.\n\
1080 PROGRAM should be a compiled code of CCL program, or nil.\n\
1081 Return index number of the registered CCL program.")
1083 Lisp_Object name
, ccl_prog
;
1085 int len
= XVECTOR (Vccl_program_table
)->size
;
1088 CHECK_SYMBOL (name
, 0);
1089 if (!NILP (ccl_prog
))
1090 CHECK_VECTOR (ccl_prog
, 1);
1092 for (i
= 0; i
< len
; i
++)
1094 Lisp_Object slot
= XVECTOR (Vccl_program_table
)->contents
[i
];
1099 if (EQ (name
, XCONS (slot
)->car
))
1101 XCONS (slot
)->cdr
= ccl_prog
;
1102 return make_number (i
);
1108 Lisp_Object new_table
= Fmake_vector (len
* 2, Qnil
);
1111 for (j
= 0; j
< len
; j
++)
1112 XVECTOR (new_table
)->contents
[j
]
1113 = XVECTOR (Vccl_program_table
)->contents
[j
];
1114 Vccl_program_table
= new_table
;
1117 XVECTOR (Vccl_program_table
)->contents
[i
] = Fcons (name
, ccl_prog
);
1118 return make_number (i
);
1123 staticpro (&Vccl_program_table
);
1124 Vccl_program_table
= Fmake_vector (32, Qnil
);
1126 DEFVAR_LISP ("font-ccl-encoder-alist", &Vfont_ccl_encoder_alist
,
1127 "Alist of fontname patterns vs corresponding CCL program.\n\
1128 Each element looks like (REGEXP . CCL-CODE),\n\
1129 where CCL-CODE is a compiled CCL program.\n\
1130 When a font whose name matches REGEXP is used for displaying a character,\n\
1131 CCL-CODE is executed to calculate the code point in the font\n\
1132 from the charset number and position code(s) of the character which are set\n\
1133 in CCL registers R0, R1, and R2 before the execution.\n\
1134 The code point in the font is set in CCL registers R1 and R2\n\
1135 when the execution terminated.\n\
1136 If the font is single-byte font, the register R2 is not used.");
1137 Vfont_ccl_encoder_alist
= Qnil
;
1139 defsubr (&Sccl_execute
);
1140 defsubr (&Sccl_execute_on_string
);
1141 defsubr (&Sregister_ccl_program
);