HCoop / bpt / emacs.git / blob
? search:
summary | shortlog | log | commit | commitdiff | tree
blame | history | raw | HEAD
(Vccl_translation_table_vector, Qccl_program,
[bpt/emacs.git] / src / ccl.c
1 /* CCL (Code Conversion Language) interpreter.
2 Copyright (C) 1995, 1997 Electrotechnical Laboratory, JAPAN.
3 Licensed to the Free Software Foundation.
4
5 This file is part of GNU Emacs.
6
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)
10 any later version.
11
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.
16
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. */
21
22 #include <stdio.h>
23
24 #ifdef emacs
25
26 #include <config.h>
27 #include "lisp.h"
28 #include "charset.h"
29 #include "ccl.h"
30 #include "coding.h"
31
32 #else /* not emacs */
33
34 #include "mulelib.h"
35
36 #endif /* not emacs */
37
38 /* Where is stored translation tables for CCL program. */
39 Lisp_Object Vccl_translation_table_vector;
40
41 /* Alist of fontname patterns vs corresponding CCL program. */
42 Lisp_Object Vfont_ccl_encoder_alist;
43
44 /* This symbol is property which assocate with ccl program vector. e.g.
45 (get 'ccl-big5-encoder 'ccl-program) returns ccl program vector */
46 Lisp_Object Qccl_program;
47
48 /* These symbol is properties whish associate with ccl translation table and its id
49 respectively. */
50 Lisp_Object Qccl_translation_table;
51 Lisp_Object Qccl_translation_table_id;
52
53 /* Vector of CCL program names vs corresponding program data. */
54 Lisp_Object Vccl_program_table;
55
56 /* CCL (Code Conversion Language) is a simple language which has
57 operations on one input buffer, one output buffer, and 7 registers.
58 The syntax of CCL is described in `ccl.el'. Emacs Lisp function
59 `ccl-compile' compiles a CCL program and produces a CCL code which
60 is a vector of integers. The structure of this vector is as
61 follows: The 1st element: buffer-magnification, a factor for the
62 size of output buffer compared with the size of input buffer. The
63 2nd element: address of CCL code to be executed when encountered
64 with end of input stream. The 3rd and the remaining elements: CCL
65 codes. */
66
67 /* Header of CCL compiled code */
68 #define CCL_HEADER_BUF_MAG 0
69 #define CCL_HEADER_EOF 1
70 #define CCL_HEADER_MAIN 2
71
72 /* CCL code is a sequence of 28-bit non-negative integers (i.e. the
73 MSB is always 0), each contains CCL command and/or arguments in the
74 following format:
75
76 |----------------- integer (28-bit) ------------------|
77 |------- 17-bit ------|- 3-bit --|- 3-bit --|- 5-bit -|
78 |--constant argument--|-register-|-register-|-command-|
79 ccccccccccccccccc RRR rrr XXXXX
80 or
81 |------- relative address -------|-register-|-command-|
82 cccccccccccccccccccc rrr XXXXX
83 or
84 |------------- constant or other args ----------------|
85 cccccccccccccccccccccccccccc
86
87 where, `cc...c' is a non-negative integer indicating constant value
88 (the left most `c' is always 0) or an absolute jump address, `RRR'
89 and `rrr' are CCL register number, `XXXXX' is one of the following
90 CCL commands. */
91
92 /* CCL commands
93
94 Each comment fields shows one or more lines for command syntax and
95 the following lines for semantics of the command. In semantics, IC
96 stands for Instruction Counter. */
97
98 #define CCL_SetRegister 0x00 /* Set register a register value:
99 1:00000000000000000RRRrrrXXXXX
100 ------------------------------
101 reg[rrr] = reg[RRR];
102 */
103
104 #define CCL_SetShortConst 0x01 /* Set register a short constant value:
105 1:CCCCCCCCCCCCCCCCCCCCrrrXXXXX
106 ------------------------------
107 reg[rrr] = CCCCCCCCCCCCCCCCCCC;
108 */
109
110 #define CCL_SetConst 0x02 /* Set register a constant value:
111 1:00000000000000000000rrrXXXXX
112 2:CONSTANT
113 ------------------------------
114 reg[rrr] = CONSTANT;
115 IC++;
116 */
117
118 #define CCL_SetArray 0x03 /* Set register an element of array:
119 1:CCCCCCCCCCCCCCCCCRRRrrrXXXXX
120 2:ELEMENT[0]
121 3:ELEMENT[1]
122 ...
123 ------------------------------
124 if (0 <= reg[RRR] < CC..C)
125 reg[rrr] = ELEMENT[reg[RRR]];
126 IC += CC..C;
127 */
128
129 #define CCL_Jump 0x04 /* Jump:
130 1:A--D--D--R--E--S--S-000XXXXX
131 ------------------------------
132 IC += ADDRESS;
133 */
134
135 /* Note: If CC..C is greater than 0, the second code is omitted. */
136
137 #define CCL_JumpCond 0x05 /* Jump conditional:
138 1:A--D--D--R--E--S--S-rrrXXXXX
139 ------------------------------
140 if (!reg[rrr])
141 IC += ADDRESS;
142 */
143
144
145 #define CCL_WriteRegisterJump 0x06 /* Write register and jump:
146 1:A--D--D--R--E--S--S-rrrXXXXX
147 ------------------------------
148 write (reg[rrr]);
149 IC += ADDRESS;
150 */
151
152 #define CCL_WriteRegisterReadJump 0x07 /* Write register, read, and jump:
153 1:A--D--D--R--E--S--S-rrrXXXXX
154 2:A--D--D--R--E--S--S-rrrYYYYY
155 -----------------------------
156 write (reg[rrr]);
157 IC++;
158 read (reg[rrr]);
159 IC += ADDRESS;
160 */
161 /* Note: If read is suspended, the resumed execution starts from the
162 second code (YYYYY == CCL_ReadJump). */
163
164 #define CCL_WriteConstJump 0x08 /* Write constant and jump:
165 1:A--D--D--R--E--S--S-000XXXXX
166 2:CONST
167 ------------------------------
168 write (CONST);
169 IC += ADDRESS;
170 */
171
172 #define CCL_WriteConstReadJump 0x09 /* Write constant, read, and jump:
173 1:A--D--D--R--E--S--S-rrrXXXXX
174 2:CONST
175 3:A--D--D--R--E--S--S-rrrYYYYY
176 -----------------------------
177 write (CONST);
178 IC += 2;
179 read (reg[rrr]);
180 IC += ADDRESS;
181 */
182 /* Note: If read is suspended, the resumed execution starts from the
183 second code (YYYYY == CCL_ReadJump). */
184
185 #define CCL_WriteStringJump 0x0A /* Write string and jump:
186 1:A--D--D--R--E--S--S-000XXXXX
187 2:LENGTH
188 3:0000STRIN[0]STRIN[1]STRIN[2]
189 ...
190 ------------------------------
191 write_string (STRING, LENGTH);
192 IC += ADDRESS;
193 */
194
195 #define CCL_WriteArrayReadJump 0x0B /* Write an array element, read, and jump:
196 1:A--D--D--R--E--S--S-rrrXXXXX
197 2:LENGTH
198 3:ELEMENET[0]
199 4:ELEMENET[1]
200 ...
201 N:A--D--D--R--E--S--S-rrrYYYYY
202 ------------------------------
203 if (0 <= reg[rrr] < LENGTH)
204 write (ELEMENT[reg[rrr]]);
205 IC += LENGTH + 2; (... pointing at N+1)
206 read (reg[rrr]);
207 IC += ADDRESS;
208 */
209 /* Note: If read is suspended, the resumed execution starts from the
210 Nth code (YYYYY == CCL_ReadJump). */
211
212 #define CCL_ReadJump 0x0C /* Read and jump:
213 1:A--D--D--R--E--S--S-rrrYYYYY
214 -----------------------------
215 read (reg[rrr]);
216 IC += ADDRESS;
217 */
218
219 #define CCL_Branch 0x0D /* Jump by branch table:
220 1:CCCCCCCCCCCCCCCCCCCCrrrXXXXX
221 2:A--D--D--R--E-S-S[0]000XXXXX
222 3:A--D--D--R--E-S-S[1]000XXXXX
223 ...
224 ------------------------------
225 if (0 <= reg[rrr] < CC..C)
226 IC += ADDRESS[reg[rrr]];
227 else
228 IC += ADDRESS[CC..C];
229 */
230
231 #define CCL_ReadRegister 0x0E /* Read bytes into registers:
232 1:CCCCCCCCCCCCCCCCCCCCrrrXXXXX
233 2:CCCCCCCCCCCCCCCCCCCCrrrXXXXX
234 ...
235 ------------------------------
236 while (CCC--)
237 read (reg[rrr]);
238 */
239
240 #define CCL_WriteExprConst 0x0F /* write result of expression:
241 1:00000OPERATION000RRR000XXXXX
242 2:CONSTANT
243 ------------------------------
244 write (reg[RRR] OPERATION CONSTANT);
245 IC++;
246 */
247
248 /* Note: If the Nth read is suspended, the resumed execution starts
249 from the Nth code. */
250
251 #define CCL_ReadBranch 0x10 /* Read one byte into a register,
252 and jump by branch table:
253 1:CCCCCCCCCCCCCCCCCCCCrrrXXXXX
254 2:A--D--D--R--E-S-S[0]000XXXXX
255 3:A--D--D--R--E-S-S[1]000XXXXX
256 ...
257 ------------------------------
258 read (read[rrr]);
259 if (0 <= reg[rrr] < CC..C)
260 IC += ADDRESS[reg[rrr]];
261 else
262 IC += ADDRESS[CC..C];
263 */
264
265 #define CCL_WriteRegister 0x11 /* Write registers:
266 1:CCCCCCCCCCCCCCCCCCCrrrXXXXX
267 2:CCCCCCCCCCCCCCCCCCCrrrXXXXX
268 ...
269 ------------------------------
270 while (CCC--)
271 write (reg[rrr]);
272 ...
273 */
274
275 /* Note: If the Nth write is suspended, the resumed execution
276 starts from the Nth code. */
277
278 #define CCL_WriteExprRegister 0x12 /* Write result of expression
279 1:00000OPERATIONRrrRRR000XXXXX
280 ------------------------------
281 write (reg[RRR] OPERATION reg[Rrr]);
282 */
283
284 #define CCL_Call 0x13 /* Call the CCL program whose ID is
285 (CC..C).
286 1:CCCCCCCCCCCCCCCCCCCC000XXXXX
287 ------------------------------
288 call (CC..C)
289 */
290
291 #define CCL_WriteConstString 0x14 /* Write a constant or a string:
292 1:CCCCCCCCCCCCCCCCCCCCrrrXXXXX
293 [2:0000STRIN[0]STRIN[1]STRIN[2]]
294 [...]
295 -----------------------------
296 if (!rrr)
297 write (CC..C)
298 else
299 write_string (STRING, CC..C);
300 IC += (CC..C + 2) / 3;
301 */
302
303 #define CCL_WriteArray 0x15 /* Write an element of array:
304 1:CCCCCCCCCCCCCCCCCCCCrrrXXXXX
305 2:ELEMENT[0]
306 3:ELEMENT[1]
307 ...
308 ------------------------------
309 if (0 <= reg[rrr] < CC..C)
310 write (ELEMENT[reg[rrr]]);
311 IC += CC..C;
312 */
313
314 #define CCL_End 0x16 /* Terminate:
315 1:00000000000000000000000XXXXX
316 ------------------------------
317 terminate ();
318 */
319
320 /* The following two codes execute an assignment arithmetic/logical
321 operation. The form of the operation is like REG OP= OPERAND. */
322
323 #define CCL_ExprSelfConst 0x17 /* REG OP= constant:
324 1:00000OPERATION000000rrrXXXXX
325 2:CONSTANT
326 ------------------------------
327 reg[rrr] OPERATION= CONSTANT;
328 */
329
330 #define CCL_ExprSelfReg 0x18 /* REG1 OP= REG2:
331 1:00000OPERATION000RRRrrrXXXXX
332 ------------------------------
333 reg[rrr] OPERATION= reg[RRR];
334 */
335
336 /* The following codes execute an arithmetic/logical operation. The
337 form of the operation is like REG_X = REG_Y OP OPERAND2. */
338
339 #define CCL_SetExprConst 0x19 /* REG_X = REG_Y OP constant:
340 1:00000OPERATION000RRRrrrXXXXX
341 2:CONSTANT
342 ------------------------------
343 reg[rrr] = reg[RRR] OPERATION CONSTANT;
344 IC++;
345 */
346
347 #define CCL_SetExprReg 0x1A /* REG1 = REG2 OP REG3:
348 1:00000OPERATIONRrrRRRrrrXXXXX
349 ------------------------------
350 reg[rrr] = reg[RRR] OPERATION reg[Rrr];
351 */
352
353 #define CCL_JumpCondExprConst 0x1B /* Jump conditional according to
354 an operation on constant:
355 1:A--D--D--R--E--S--S-rrrXXXXX
356 2:OPERATION
357 3:CONSTANT
358 -----------------------------
359 reg[7] = reg[rrr] OPERATION CONSTANT;
360 if (!(reg[7]))
361 IC += ADDRESS;
362 else
363 IC += 2
364 */
365
366 #define CCL_JumpCondExprReg 0x1C /* Jump conditional according to
367 an operation on register:
368 1:A--D--D--R--E--S--S-rrrXXXXX
369 2:OPERATION
370 3:RRR
371 -----------------------------
372 reg[7] = reg[rrr] OPERATION reg[RRR];
373 if (!reg[7])
374 IC += ADDRESS;
375 else
376 IC += 2;
377 */
378
379 #define CCL_ReadJumpCondExprConst 0x1D /* Read and jump conditional according
380 to an operation on constant:
381 1:A--D--D--R--E--S--S-rrrXXXXX
382 2:OPERATION
383 3:CONSTANT
384 -----------------------------
385 read (reg[rrr]);
386 reg[7] = reg[rrr] OPERATION CONSTANT;
387 if (!reg[7])
388 IC += ADDRESS;
389 else
390 IC += 2;
391 */
392
393 #define CCL_ReadJumpCondExprReg 0x1E /* Read and jump conditional according
394 to an operation on register:
395 1:A--D--D--R--E--S--S-rrrXXXXX
396 2:OPERATION
397 3:RRR
398 -----------------------------
399 read (reg[rrr]);
400 reg[7] = reg[rrr] OPERATION reg[RRR];
401 if (!reg[7])
402 IC += ADDRESS;
403 else
404 IC += 2;
405 */
406
407 #define CCL_Extention 0x1F /* Extended CCL code
408 1:ExtendedCOMMNDRrrRRRrrrXXXXX
409 2:ARGUEMENT
410 3:...
411 ------------------------------
412 extended_command (rrr,RRR,Rrr,ARGS)
413 */
414
415 /*
416 From here, Extended CCL Instruction.
417 Bit length of extended command is 14.
418 Therefore the instruction code begins from 0 to 16384(0x3fff).
419 */
420
421 #define CCL_ReadMultibyteCharacter 0x00 /* Read Multibyte Character
422 1:ExtendedCOMMNDRrrRRRrrrXXXXX
423
424 Read a multibyte characeter.
425 A code point is stored
426 into rrr register.
427 A charset ID is stored
428 into RRR register.
429 */
430 #define CCL_WriteMultibyteCharacter 0x01 /* Write Multibyte Character
431 1:ExtendedCOMMNDRrrRRRrrrXXXXX
432
433 Write a multibyte character.
434 Write a character whose code point
435 is in rrr register, and its charset ID
436 is in RRR charset.
437 */
438 #define CCL_UnifyCharacter 0x02 /* Unify Multibyte Character
439 1:ExtendedCOMMNDRrrRRRrrrXXXXX
440
441 Unify a character where its code point
442 is in rrr register, and its charset ID
443 is in RRR register with the table of
444 the unification table ID
445 in Rrr register.
446
447 Return a unified character where its
448 code point is in rrr register, and its
449 charset ID is in RRR register.
450 */
451 #define CCL_UnifyCharacterConstTbl 0x03 /* Unify Multibyte Character
452 1:ExtendedCOMMNDRrrRRRrrrXXXXX
453 2:ARGUMENT(Unification Table ID)
454
455 Unify a character where its code point
456 is in rrr register, and its charset ID
457 is in RRR register with the table of
458 the unification table ID
459 in 2nd argument.
460
461 Return a unified character where its
462 code point is in rrr register, and its
463 charset ID is in RRR register.
464 */
465 #define CCL_IterateMultipleMap 0x10 /* Iterate Multiple Map
466 1:ExtendedCOMMNDXXXRRRrrrXXXXX
467 2:NUMBER of TABLES
468 3:TABLE-ID1
469 4:TABLE-ID2
470 ...
471
472 iterate to lookup tables from a number
473 until finding a value.
474
475 Each table consists of a vector
476 whose element is number or
477 nil or t or lambda.
478 If the element is nil,
479 its table is neglected.
480 In the case of t or lambda,
481 return the original value.
482
483 */
484 #define CCL_TranslateMultipleMap 0x11 /* Translate Multiple Map
485 1:ExtendedCOMMNDXXXRRRrrrXXXXX
486 2:NUMBER of TABLE-IDs and SEPARATERs
487 (i.e. m1+m2+m3+...mk+k-1)
488 3:TABLE-ID 1,1
489 4:TABLE-ID 1,2
490 ...
491 m1+2:TABLE-ID 1,m1
492 m1+3: -1 (SEPARATOR)
493 m1+4:TABLE-ID 2,1
494 ...
495 m1+m2+4:TABLE-ID 2,m2
496 m1+m2+5: -1
497 ...
498 m1+m2+...+mk+k+1:TABLE-ID k,mk
499
500 Translate the code point in
501 rrr register by tables.
502 Translation starts from the table
503 where RRR register points out.
504
505 We translate the given value
506 from the tables which are separated
507 by -1.
508 When each translation is failed to find
509 any values, we regard the traslation
510 as identity.
511
512 We iterate to traslate by using each
513 table set(tables separated by -1)
514 until lookup the last table except
515 lookup lambda.
516
517 Each table consists of a vector
518 whose element is number
519 or nil or t or lambda.
520 If the element is nil,
521 it is neglected and use the next table.
522 In the case of t,
523 it is translated to the original value.
524 In the case of lambda,
525 it cease the translation and return the
526 current value.
527
528 */
529 #define CCL_TranslateSingleMap 0x12 /* Translate Single Map
530 1:ExtendedCOMMNDXXXRRRrrrXXXXX
531 2:TABLE-ID
532
533 Translate a number in rrr register.
534 If it is not found any translation,
535 set RRR register -1 but rrr register
536 is not changed.
537 */
538
539 /* CCL arithmetic/logical operators. */
540 #define CCL_PLUS 0x00 /* X = Y + Z */
541 #define CCL_MINUS 0x01 /* X = Y - Z */
542 #define CCL_MUL 0x02 /* X = Y * Z */
543 #define CCL_DIV 0x03 /* X = Y / Z */
544 #define CCL_MOD 0x04 /* X = Y % Z */
545 #define CCL_AND 0x05 /* X = Y & Z */
546 #define CCL_OR 0x06 /* X = Y | Z */
547 #define CCL_XOR 0x07 /* X = Y ^ Z */
548 #define CCL_LSH 0x08 /* X = Y << Z */
549 #define CCL_RSH 0x09 /* X = Y >> Z */
550 #define CCL_LSH8 0x0A /* X = (Y << 8) | Z */
551 #define CCL_RSH8 0x0B /* X = Y >> 8, r[7] = Y & 0xFF */
552 #define CCL_DIVMOD 0x0C /* X = Y / Z, r[7] = Y % Z */
553 #define CCL_LS 0x10 /* X = (X < Y) */
554 #define CCL_GT 0x11 /* X = (X > Y) */
555 #define CCL_EQ 0x12 /* X = (X == Y) */
556 #define CCL_LE 0x13 /* X = (X <= Y) */
557 #define CCL_GE 0x14 /* X = (X >= Y) */
558 #define CCL_NE 0x15 /* X = (X != Y) */
559
560 #define CCL_ENCODE_SJIS 0x16 /* X = HIGHER_BYTE (SJIS (Y, Z))
561 r[7] = LOWER_BYTE (SJIS (Y, Z) */
562 #define CCL_DECODE_SJIS 0x17 /* X = HIGHER_BYTE (DE-SJIS (Y, Z))
563 r[7] = LOWER_BYTE (DE-SJIS (Y, Z)) */
564
565 /* Terminate CCL program successfully. */
566 #define CCL_SUCCESS \
567 do { \
568 ccl->status = CCL_STAT_SUCCESS; \
569 ccl->ic = CCL_HEADER_MAIN; \
570 goto ccl_finish; \
571 } while (0)
572
573 /* Suspend CCL program because of reading from empty input buffer or
574 writing to full output buffer. When this program is resumed, the
575 same I/O command is executed. */
576 #define CCL_SUSPEND(stat) \
577 do { \
578 ic--; \
579 ccl->status = stat; \
580 goto ccl_finish; \
581 } while (0)
582
583 /* Terminate CCL program because of invalid command. Should not occur
584 in the normal case. */
585 #define CCL_INVALID_CMD \
586 do { \
587 ccl->status = CCL_STAT_INVALID_CMD; \
588 goto ccl_error_handler; \
589 } while (0)
590
591 /* Encode one character CH to multibyte form and write to the current
592 output buffer. If CH is less than 256, CH is written as is. */
593 #define CCL_WRITE_CHAR(ch) \
594 do { \
595 if (!dst) \
596 CCL_INVALID_CMD; \
597 else \
598 { \
599 unsigned char work[4], *str; \
600 int len = CHAR_STRING (ch, work, str); \
601 if (dst + len <= (dst_bytes ? dst_end : src)) \
602 { \
603 bcopy (str, dst, len); \
604 dst += len; \
605 } \
606 else \
607 CCL_SUSPEND (CCL_STAT_SUSPEND_BY_DST); \
608 } \
609 } while (0)
610
611 /* Write a string at ccl_prog[IC] of length LEN to the current output
612 buffer. */
613 #define CCL_WRITE_STRING(len) \
614 do { \
615 if (!dst) \
616 CCL_INVALID_CMD; \
617 else if (dst + len <= (dst_bytes ? dst_end : src)) \
618 for (i = 0; i < len; i++) \
619 *dst++ = ((XFASTINT (ccl_prog[ic + (i / 3)])) \
620 >> ((2 - (i % 3)) * 8)) & 0xFF; \
621 else \
622 CCL_SUSPEND (CCL_STAT_SUSPEND_BY_DST); \
623 } while (0)
624
625 /* Read one byte from the current input buffer into Rth register. */
626 #define CCL_READ_CHAR(r) \
627 do { \
628 if (!src) \
629 CCL_INVALID_CMD; \
630 else if (src < src_end) \
631 r = *src++; \
632 else if (ccl->last_block) \
633 { \
634 ic = ccl->eof_ic; \
635 goto ccl_finish; \
636 } \
637 else \
638 CCL_SUSPEND (CCL_STAT_SUSPEND_BY_SRC); \
639 } while (0)
640
641
642 /* Execute CCL code on SRC_BYTES length text at SOURCE. The resulting
643 text goes to a place pointed by DESTINATION, the length of which
644 should not exceed DST_BYTES. The bytes actually processed is
645 returned as *CONSUMED. The return value is the length of the
646 resulting text. As a side effect, the contents of CCL registers
647 are updated. If SOURCE or DESTINATION is NULL, only operations on
648 registers are permitted. */
649
650 #ifdef CCL_DEBUG
651 #define CCL_DEBUG_BACKTRACE_LEN 256
652 int ccl_backtrace_table[CCL_BACKTRACE_TABLE];
653 int ccl_backtrace_idx;
654 #endif
655
656 struct ccl_prog_stack
657 {
658 Lisp_Object *ccl_prog; /* Pointer to an array of CCL code. */
659 int ic; /* Instruction Counter. */
660 };
661
662 ccl_driver (ccl, source, destination, src_bytes, dst_bytes, consumed)
663 struct ccl_program *ccl;
664 unsigned char *source, *destination;
665 int src_bytes, dst_bytes;
666 int *consumed;
667 {
668 register int *reg = ccl->reg;
669 register int ic = ccl->ic;
670 register int code, field1, field2;
671 register Lisp_Object *ccl_prog = ccl->prog;
672 unsigned char *src = source, *src_end = src + src_bytes;
673 unsigned char *dst = destination, *dst_end = dst + dst_bytes;
674 int jump_address;
675 int i, j, op;
676 int stack_idx = 0;
677 /* For the moment, we only support depth 256 of stack. */
678 struct ccl_prog_stack ccl_prog_stack_struct[256];
679
680 if (ic >= ccl->eof_ic)
681 ic = CCL_HEADER_MAIN;
682
683 #ifdef CCL_DEBUG
684 ccl_backtrace_idx = 0;
685 #endif
686
687 for (;;)
688 {
689 #ifdef CCL_DEBUG
690 ccl_backtrace_table[ccl_backtrace_idx++] = ic;
691 if (ccl_backtrace_idx >= CCL_DEBUG_BACKTRACE_LEN)
692 ccl_backtrace_idx = 0;
693 ccl_backtrace_table[ccl_backtrace_idx] = 0;
694 #endif
695
696 if (!NILP (Vquit_flag) && NILP (Vinhibit_quit))
697 {
698 /* We can't just signal Qquit, instead break the loop as if
699 the whole data is processed. Don't reset Vquit_flag, it
700 must be handled later at a safer place. */
701 if (consumed)
702 src = source + src_bytes;
703 ccl->status = CCL_STAT_QUIT;
704 break;
705 }
706
707 code = XINT (ccl_prog[ic]); ic++;
708 field1 = code >> 8;
709 field2 = (code & 0xFF) >> 5;
710
711 #define rrr field2
712 #define RRR (field1 & 7)
713 #define Rrr ((field1 >> 3) & 7)
714 #define ADDR field1
715 #define EXCMD (field1 >> 6)
716
717 switch (code & 0x1F)
718 {
719 case CCL_SetRegister: /* 00000000000000000RRRrrrXXXXX */
720 reg[rrr] = reg[RRR];
721 break;
722
723 case CCL_SetShortConst: /* CCCCCCCCCCCCCCCCCCCCrrrXXXXX */
724 reg[rrr] = field1;
725 break;
726
727 case CCL_SetConst: /* 00000000000000000000rrrXXXXX */
728 reg[rrr] = XINT (ccl_prog[ic]);
729 ic++;
730 break;
731
732 case CCL_SetArray: /* CCCCCCCCCCCCCCCCCCCCRRRrrrXXXXX */
733 i = reg[RRR];
734 j = field1 >> 3;
735 if ((unsigned int) i < j)
736 reg[rrr] = XINT (ccl_prog[ic + i]);
737 ic += j;
738 break;
739
740 case CCL_Jump: /* A--D--D--R--E--S--S-000XXXXX */
741 ic += ADDR;
742 break;
743
744 case CCL_JumpCond: /* A--D--D--R--E--S--S-rrrXXXXX */
745 if (!reg[rrr])
746 ic += ADDR;
747 break;
748
749 case CCL_WriteRegisterJump: /* A--D--D--R--E--S--S-rrrXXXXX */
750 i = reg[rrr];
751 CCL_WRITE_CHAR (i);
752 ic += ADDR;
753 break;
754
755 case CCL_WriteRegisterReadJump: /* A--D--D--R--E--S--S-rrrXXXXX */
756 i = reg[rrr];
757 CCL_WRITE_CHAR (i);
758 ic++;
759 CCL_READ_CHAR (reg[rrr]);
760 ic += ADDR - 1;
761 break;
762
763 case CCL_WriteConstJump: /* A--D--D--R--E--S--S-000XXXXX */
764 i = XINT (ccl_prog[ic]);
765 CCL_WRITE_CHAR (i);
766 ic += ADDR;
767 break;
768
769 case CCL_WriteConstReadJump: /* A--D--D--R--E--S--S-rrrXXXXX */
770 i = XINT (ccl_prog[ic]);
771 CCL_WRITE_CHAR (i);
772 ic++;
773 CCL_READ_CHAR (reg[rrr]);
774 ic += ADDR - 1;
775 break;
776
777 case CCL_WriteStringJump: /* A--D--D--R--E--S--S-000XXXXX */
778 j = XINT (ccl_prog[ic]);
779 ic++;
780 CCL_WRITE_STRING (j);
781 ic += ADDR - 1;
782 break;
783
784 case CCL_WriteArrayReadJump: /* A--D--D--R--E--S--S-rrrXXXXX */
785 i = reg[rrr];
786 j = XINT (ccl_prog[ic]);
787 if ((unsigned int) i < j)
788 {
789 i = XINT (ccl_prog[ic + 1 + i]);
790 CCL_WRITE_CHAR (i);
791 }
792 ic += j + 2;
793 CCL_READ_CHAR (reg[rrr]);
794 ic += ADDR - (j + 2);
795 break;
796
797 case CCL_ReadJump: /* A--D--D--R--E--S--S-rrrYYYYY */
798 CCL_READ_CHAR (reg[rrr]);
799 ic += ADDR;
800 break;
801
802 case CCL_ReadBranch: /* CCCCCCCCCCCCCCCCCCCCrrrXXXXX */
803 CCL_READ_CHAR (reg[rrr]);
804 /* fall through ... */
805 case CCL_Branch: /* CCCCCCCCCCCCCCCCCCCCrrrXXXXX */
806 if ((unsigned int) reg[rrr] < field1)
807 ic += XINT (ccl_prog[ic + reg[rrr]]);
808 else
809 ic += XINT (ccl_prog[ic + field1]);
810 break;
811
812 case CCL_ReadRegister: /* CCCCCCCCCCCCCCCCCCCCrrXXXXX */
813 while (1)
814 {
815 CCL_READ_CHAR (reg[rrr]);
816 if (!field1) break;
817 code = XINT (ccl_prog[ic]); ic++;
818 field1 = code >> 8;
819 field2 = (code & 0xFF) >> 5;
820 }
821 break;
822
823 case CCL_WriteExprConst: /* 1:00000OPERATION000RRR000XXXXX */
824 rrr = 7;
825 i = reg[RRR];
826 j = XINT (ccl_prog[ic]);
827 op = field1 >> 6;
828 ic++;
829 goto ccl_set_expr;
830
831 case CCL_WriteRegister: /* CCCCCCCCCCCCCCCCCCCrrrXXXXX */
832 while (1)
833 {
834 i = reg[rrr];
835 CCL_WRITE_CHAR (i);
836 if (!field1) break;
837 code = XINT (ccl_prog[ic]); ic++;
838 field1 = code >> 8;
839 field2 = (code & 0xFF) >> 5;
840 }
841 break;
842
843 case CCL_WriteExprRegister: /* 1:00000OPERATIONRrrRRR000XXXXX */
844 rrr = 7;
845 i = reg[RRR];
846 j = reg[Rrr];
847 op = field1 >> 6;
848 goto ccl_set_expr;
849
850 case CCL_Call: /* CCCCCCCCCCCCCCCCCCCC000XXXXX */
851 {
852 Lisp_Object slot;
853
854 if (stack_idx >= 256
855 || field1 < 0
856 || field1 >= XVECTOR (Vccl_program_table)->size
857 || (slot = XVECTOR (Vccl_program_table)->contents[field1],
858 !CONSP (slot))
859 || !VECTORP (XCONS (slot)->cdr))
860 {
861 if (stack_idx > 0)
862 {
863 ccl_prog = ccl_prog_stack_struct[0].ccl_prog;
864 ic = ccl_prog_stack_struct[0].ic;
865 }
866 CCL_INVALID_CMD;
867 }
868
869 ccl_prog_stack_struct[stack_idx].ccl_prog = ccl_prog;
870 ccl_prog_stack_struct[stack_idx].ic = ic;
871 stack_idx++;
872 ccl_prog = XVECTOR (XCONS (slot)->cdr)->contents;
873 ic = CCL_HEADER_MAIN;
874 }
875 break;
876
877 case CCL_WriteConstString: /* CCCCCCCCCCCCCCCCCCCCrrrXXXXX */
878 if (!rrr)
879 CCL_WRITE_CHAR (field1);
880 else
881 {
882 CCL_WRITE_STRING (field1);
883 ic += (field1 + 2) / 3;
884 }
885 break;
886
887 case CCL_WriteArray: /* CCCCCCCCCCCCCCCCCCCCrrrXXXXX */
888 i = reg[rrr];
889 if ((unsigned int) i < field1)
890 {
891 j = XINT (ccl_prog[ic + i]);
892 CCL_WRITE_CHAR (j);
893 }
894 ic += field1;
895 break;
896
897 case CCL_End: /* 0000000000000000000000XXXXX */
898 if (stack_idx-- > 0)
899 {
900 ccl_prog = ccl_prog_stack_struct[stack_idx].ccl_prog;
901 ic = ccl_prog_stack_struct[stack_idx].ic;
902 break;
903 }
904 CCL_SUCCESS;
905
906 case CCL_ExprSelfConst: /* 00000OPERATION000000rrrXXXXX */
907 i = XINT (ccl_prog[ic]);
908 ic++;
909 op = field1 >> 6;
910 goto ccl_expr_self;
911
912 case CCL_ExprSelfReg: /* 00000OPERATION000RRRrrrXXXXX */
913 i = reg[RRR];
914 op = field1 >> 6;
915
916 ccl_expr_self:
917 switch (op)
918 {
919 case CCL_PLUS: reg[rrr] += i; break;
920 case CCL_MINUS: reg[rrr] -= i; break;
921 case CCL_MUL: reg[rrr] *= i; break;
922 case CCL_DIV: reg[rrr] /= i; break;
923 case CCL_MOD: reg[rrr] %= i; break;
924 case CCL_AND: reg[rrr] &= i; break;
925 case CCL_OR: reg[rrr] |= i; break;
926 case CCL_XOR: reg[rrr] ^= i; break;
927 case CCL_LSH: reg[rrr] <<= i; break;
928 case CCL_RSH: reg[rrr] >>= i; break;
929 case CCL_LSH8: reg[rrr] <<= 8; reg[rrr] |= i; break;
930 case CCL_RSH8: reg[7] = reg[rrr] & 0xFF; reg[rrr] >>= 8; break;
931 case CCL_DIVMOD: reg[7] = reg[rrr] % i; reg[rrr] /= i; break;
932 case CCL_LS: reg[rrr] = reg[rrr] < i; break;
933 case CCL_GT: reg[rrr] = reg[rrr] > i; break;
934 case CCL_EQ: reg[rrr] = reg[rrr] == i; break;
935 case CCL_LE: reg[rrr] = reg[rrr] <= i; break;
936 case CCL_GE: reg[rrr] = reg[rrr] >= i; break;
937 case CCL_NE: reg[rrr] = reg[rrr] != i; break;
938 default: CCL_INVALID_CMD;
939 }
940 break;
941
942 case CCL_SetExprConst: /* 00000OPERATION000RRRrrrXXXXX */
943 i = reg[RRR];
944 j = XINT (ccl_prog[ic]);
945 op = field1 >> 6;
946 jump_address = ++ic;
947 goto ccl_set_expr;
948
949 case CCL_SetExprReg: /* 00000OPERATIONRrrRRRrrrXXXXX */
950 i = reg[RRR];
951 j = reg[Rrr];
952 op = field1 >> 6;
953 jump_address = ic;
954 goto ccl_set_expr;
955
956 case CCL_ReadJumpCondExprConst: /* A--D--D--R--E--S--S-rrrXXXXX */
957 CCL_READ_CHAR (reg[rrr]);
958 case CCL_JumpCondExprConst: /* A--D--D--R--E--S--S-rrrXXXXX */
959 i = reg[rrr];
960 op = XINT (ccl_prog[ic]);
961 jump_address = ic++ + ADDR;
962 j = XINT (ccl_prog[ic]);
963 ic++;
964 rrr = 7;
965 goto ccl_set_expr;
966
967 case CCL_ReadJumpCondExprReg: /* A--D--D--R--E--S--S-rrrXXXXX */
968 CCL_READ_CHAR (reg[rrr]);
969 case CCL_JumpCondExprReg:
970 i = reg[rrr];
971 op = XINT (ccl_prog[ic]);
972 jump_address = ic++ + ADDR;
973 j = reg[XINT (ccl_prog[ic])];
974 ic++;
975 rrr = 7;
976
977 ccl_set_expr:
978 switch (op)
979 {
980 case CCL_PLUS: reg[rrr] = i + j; break;
981 case CCL_MINUS: reg[rrr] = i - j; break;
982 case CCL_MUL: reg[rrr] = i * j; break;
983 case CCL_DIV: reg[rrr] = i / j; break;
984 case CCL_MOD: reg[rrr] = i % j; break;
985 case CCL_AND: reg[rrr] = i & j; break;
986 case CCL_OR: reg[rrr] = i | j; break;
987 case CCL_XOR: reg[rrr] = i ^ j;; break;
988 case CCL_LSH: reg[rrr] = i << j; break;
989 case CCL_RSH: reg[rrr] = i >> j; break;
990 case CCL_LSH8: reg[rrr] = (i << 8) | j; break;
991 case CCL_RSH8: reg[rrr] = i >> 8; reg[7] = i & 0xFF; break;
992 case CCL_DIVMOD: reg[rrr] = i / j; reg[7] = i % j; break;
993 case CCL_LS: reg[rrr] = i < j; break;
994 case CCL_GT: reg[rrr] = i > j; break;
995 case CCL_EQ: reg[rrr] = i == j; break;
996 case CCL_LE: reg[rrr] = i <= j; break;
997 case CCL_GE: reg[rrr] = i >= j; break;
998 case CCL_NE: reg[rrr] = i != j; break;
999 case CCL_ENCODE_SJIS: ENCODE_SJIS (i, j, reg[rrr], reg[7]); break;
1000 case CCL_DECODE_SJIS: DECODE_SJIS (i, j, reg[rrr], reg[7]); break;
1001 default: CCL_INVALID_CMD;
1002 }
1003 code &= 0x1F;
1004 if (code == CCL_WriteExprConst || code == CCL_WriteExprRegister)
1005 {
1006 i = reg[rrr];
1007 CCL_WRITE_CHAR (i);
1008 }
1009 else if (!reg[rrr])
1010 ic = jump_address;
1011 break;
1012
1013 case CCL_Extention:
1014 switch (EXCMD)
1015 {
1016 case CCL_ReadMultibyteCharacter:
1017 if (!src)
1018 CCL_INVALID_CMD;
1019 do {
1020 if (src >= src_end)
1021 goto ccl_read_multibyte_character_suspend;
1022
1023 i = *src++;
1024 if (i == LEADING_CODE_COMPOSITION)
1025 {
1026 if (src >= src_end)
1027 goto ccl_read_multibyte_character_suspend;
1028 if (*src == 0xFF)
1029 {
1030 ccl->private_state = COMPOSING_WITH_RULE_HEAD;
1031 src++;
1032 }
1033 else
1034 ccl->private_state = COMPOSING_NO_RULE_HEAD;
1035 }
1036 if (ccl->private_state != 0)
1037 {
1038 /* composite character */
1039 if (*src < 0xA0)
1040 ccl->private_state = 0;
1041 else
1042 {
1043 if (i == 0xA0)
1044 {
1045 if (src >= src_end)
1046 goto ccl_read_multibyte_character_suspend;
1047 i = *src++ & 0x7F;
1048 }
1049 else
1050 i -= 0x20;
1051
1052 if (COMPOSING_WITH_RULE_RULE == ccl->private_state)
1053 {
1054 ccl->private_state = COMPOSING_WITH_RULE_HEAD;
1055 continue;
1056 }
1057 else if (COMPOSING_WITH_RULE_HEAD == ccl->private_state)
1058 ccl->private_state = COMPOSING_WITH_RULE_RULE;
1059 }
1060 }
1061 if (i < 0x80)
1062 {
1063 /* ASCII */
1064 reg[rrr] = i;
1065 reg[RRR] = CHARSET_ASCII;
1066 }
1067 else if (i <= MAX_CHARSET_OFFICIAL_DIMENSION1)
1068 {
1069 if (src >= src_end)
1070 goto ccl_read_multibyte_character_suspend;
1071 reg[RRR] = i;
1072 reg[rrr] = (*src++ & 0x7F);
1073 }
1074 else if (i <= MAX_CHARSET_OFFICIAL_DIMENSION2)
1075 {
1076 if ((src + 1) >= src_end)
1077 goto ccl_read_multibyte_character_suspend;
1078 reg[RRR] = i;
1079 i = (*src++ & 0x7F);
1080 reg[rrr] = ((i << 7) | (*src & 0x7F));
1081 src++;
1082 }
1083 else if ((i == LEADING_CODE_PRIVATE_11) ||
1084 (i == LEADING_CODE_PRIVATE_12))
1085 {
1086 if ((src + 1) >= src_end)
1087 goto ccl_read_multibyte_character_suspend;
1088 reg[RRR] = *src++;
1089 reg[rrr] = (*src++ & 0x7F);
1090 }
1091 else if ((i == LEADING_CODE_PRIVATE_21) ||
1092 (i == LEADING_CODE_PRIVATE_22))
1093 {
1094 if ((src + 2) >= src_end)
1095 goto ccl_read_multibyte_character_suspend;
1096 reg[RRR] = *src++;
1097 i = (*src++ & 0x7F);
1098 reg[rrr] = ((i << 7) | (*src & 0x7F));
1099 src++;
1100 }
1101 else
1102 {
1103 /* INVALID CODE
1104 Returned charset is -1.*/
1105 reg[RRR] = -1;
1106 }
1107 } while (0);
1108 break;
1109
1110 ccl_read_multibyte_character_suspend:
1111 src--;
1112 if (ccl->last_block)
1113 {
1114 ic = ccl->eof_ic;
1115 goto ccl_finish;
1116 }
1117 else
1118 CCL_SUSPEND (CCL_STAT_SUSPEND_BY_SRC);
1119
1120 break;
1121
1122 case CCL_WriteMultibyteCharacter:
1123 i = reg[RRR]; /* charset */
1124 if (i == CHARSET_ASCII)
1125 i = reg[rrr] & 0x7F;
1126 else if (i == CHARSET_COMPOSITION)
1127 i = MAKE_COMPOSITE_CHAR (reg[rrr]);
1128 else if (CHARSET_DIMENSION (i) == 1)
1129 i = ((i - 0x70) << 7) | (reg[rrr] & 0x7F);
1130 else if (i < MIN_CHARSET_PRIVATE_DIMENSION2)
1131 i = ((i - 0x8F) << 14) | reg[rrr];
1132 else
1133 i = ((i - 0xE0) << 14) | reg[rrr];
1134
1135 CCL_WRITE_CHAR (i);
1136
1137 break;
1138
1139 case CCL_UnifyCharacter:
1140 i = reg[RRR]; /* charset */
1141 if (i == CHARSET_ASCII)
1142 i = reg[rrr] & 0x7F;
1143 else if (i == CHARSET_COMPOSITION)
1144 {
1145 reg[RRR] = -1;
1146 break;
1147 }
1148 else if (CHARSET_DIMENSION (i) == 1)
1149 i = ((i - 0x70) << 7) | (reg[rrr] & 0x7F);
1150 else if (i < MIN_CHARSET_PRIVATE_DIMENSION2)
1151 i = ((i - 0x8F) << 14) | (reg[rrr] & 0x3FFF);
1152 else
1153 i = ((i - 0xE0) << 14) | (reg[rrr] & 0x3FFF);
1154
1155 op = unify_char (UNIFICATION_ID_TABLE (reg[Rrr]), i, -1, 0, 0);
1156 SPLIT_CHAR (op, reg[RRR], i, j);
1157 if (j != -1)
1158 i = (i << 7) | j;
1159
1160 reg[rrr] = i;
1161 break;
1162
1163 case CCL_UnifyCharacterConstTbl:
1164 op = XINT (ccl_prog[ic]); /* table */
1165 ic++;
1166 i = reg[RRR]; /* charset */
1167 if (i == CHARSET_ASCII)
1168 i = reg[rrr] & 0x7F;
1169 else if (i == CHARSET_COMPOSITION)
1170 {
1171 reg[RRR] = -1;
1172 break;
1173 }
1174 else if (CHARSET_DIMENSION (i) == 1)
1175 i = ((i - 0x70) << 7) | (reg[rrr] & 0x7F);
1176 else if (i < MIN_CHARSET_PRIVATE_DIMENSION2)
1177 i = ((i - 0x8F) << 14) | (reg[rrr] & 0x3FFF);
1178 else
1179 i = ((i - 0xE0) << 14) | (reg[rrr] & 0x3FFF);
1180
1181 op = unify_char (UNIFICATION_ID_TABLE (op), i, -1, 0, 0);
1182 SPLIT_CHAR (op, reg[RRR], i, j);
1183 if (j != -1)
1184 i = (i << 7) | j;
1185
1186 reg[rrr] = i;
1187 break;
1188
1189 case CCL_IterateMultipleMap:
1190 {
1191 Lisp_Object table, content, attrib, value;
1192 int point, size, fin_ic;
1193
1194 j = XINT (ccl_prog[ic++]); /* number of tables. */
1195 fin_ic = ic + j;
1196 op = reg[rrr];
1197 if ((j > reg[RRR]) && (j >= 0))
1198 {
1199 ic += reg[RRR];
1200 i = reg[RRR];
1201 }
1202 else
1203 {
1204 reg[RRR] = -1;
1205 ic = fin_ic;
1206 break;
1207 }
1208
1209 for (;i < j;i++)
1210 {
1211
1212 size = XVECTOR (Vccl_translation_table_vector)->size;
1213 point = ccl_prog[ic++];
1214 if (point >= size) continue;
1215 table = XVECTOR (Vccl_translation_table_vector)->
1216 contents[point];
1217 if (!CONSP (table)) continue;
1218 table = XCONS(table)->cdr;
1219 if (!VECTORP (table)) continue;
1220 size = XVECTOR (table)->size;
1221 if (size <= 1) continue;
1222 point = XUINT (XVECTOR (table)->contents[0]);
1223 point = op - point + 1;
1224 if (!((point >= 1) && (point < size))) continue;
1225 content = XVECTOR (table)->contents[point];
1226
1227 if (NILP (content))
1228 continue;
1229 else if (NUMBERP (content))
1230 {
1231 reg[RRR] = i;
1232 reg[rrr] = XUINT(content);
1233 break;
1234 }
1235 else if (EQ (content, Qt) || EQ (content, Qlambda))
1236 {
1237 reg[RRR] = i;
1238 break;
1239 }
1240 else if (CONSP (content))
1241 {
1242 attrib = XCONS (content)->car;
1243 value = XCONS (content)->cdr;
1244 if (!NUMBERP (attrib) || !NUMBERP (value))
1245 continue;
1246 reg[RRR] = i;
1247 reg[rrr] = XUINT(value);
1248 break;
1249 }
1250 }
1251 if (i == j)
1252 reg[RRR] = -1;
1253 ic = fin_ic;
1254 }
1255 break;
1256
1257 case CCL_TranslateMultipleMap:
1258 {
1259 Lisp_Object table, content, attrib, value;
1260 int point, size, table_vector_size;
1261 int skip_to_next, fin_ic;
1262
1263 j = XINT (ccl_prog[ic++]); /* number of tables and separators. */
1264 fin_ic = ic + j;
1265 if ((j > reg[RRR]) && (j >= 0))
1266 {
1267 ic += reg[RRR];
1268 i = reg[RRR];
1269 }
1270 else
1271 {
1272 ic = fin_ic;
1273 reg[RRR] = -1;
1274 break;
1275 }
1276 op = reg[rrr];
1277 reg[RRR] = -1;
1278 skip_to_next = 0;
1279 table_vector_size = XVECTOR (Vccl_translation_table_vector)->size;
1280 for (;i < j;i++)
1281 {
1282 point = ccl_prog[ic++];
1283 if (XINT(point) == -1)
1284 {
1285 skip_to_next = 0;
1286 continue;
1287 }
1288 if (skip_to_next) continue;
1289 if (point >= table_vector_size) continue;
1290 table = XVECTOR (Vccl_translation_table_vector)->
1291 contents[point];
1292 if (!CONSP (table)) continue;
1293 table = XCONS (table)->cdr;
1294 if (!VECTORP (table)) continue;
1295 size = XVECTOR (table)->size;
1296 if (size <= 1) continue;
1297 point = XUINT (XVECTOR (table)->contents[0]);
1298 point = op - point + 1;
1299 if (!((point >= 1) && (point < size))) continue;
1300 content = XVECTOR (table)->contents[point];
1301
1302 if (NILP (content))
1303 continue;
1304 else if (NUMBERP (content))
1305 {
1306 op = XUINT (content);
1307 reg[RRR] = i;
1308 skip_to_next = 1;
1309 }
1310 else if (CONSP (content))
1311 {
1312 attrib = XCONS (content)->car;
1313 value = XCONS (content)->cdr;
1314 if (!NUMBERP (attrib) || !NUMBERP (value))
1315 continue;
1316 reg[RRR] = i;
1317 op = XUINT (value);
1318
1319 }
1320 else if (EQ (content, Qt))
1321 {
1322 reg[RRR] = i;
1323 op = reg[rrr];
1324 skip_to_next = 1;
1325 }
1326 else if (EQ (content, Qlambda))
1327 break;
1328 }
1329 ic = fin_ic;
1330 }
1331 reg[rrr] = op;
1332 break;
1333
1334 case CCL_TranslateSingleMap:
1335 {
1336 Lisp_Object table, attrib, value, content;
1337 int size, point;
1338 j = XINT (ccl_prog[ic++]); /* table_id */
1339 op = reg[rrr];
1340 if (j >= XVECTOR (Vccl_translation_table_vector)->size)
1341 {
1342 reg[RRR] = -1;
1343 break;
1344 }
1345 table = XVECTOR (Vccl_translation_table_vector)->
1346 contents[j];
1347 if (!CONSP (table))
1348 {
1349 reg[RRR] = -1;
1350 break;
1351 }
1352 table = XCONS(table)->cdr;
1353 if (!VECTORP (table))
1354 {
1355 reg[RRR] = -1;
1356 break;
1357 }
1358 size = XVECTOR (table)->size;
1359 point = XUINT (XVECTOR (table)->contents[0]);
1360 point = op - point + 1;
1361 reg[RRR] = 0;
1362 if ((size <= 1) ||
1363 (!((point >= 1) && (point < size))))
1364 reg[RRR] = -1;
1365 else
1366 {
1367 content = XVECTOR (table)->contents[point];
1368 if (NILP (content))
1369 reg[RRR] = -1;
1370 else if (NUMBERP (content))
1371 reg[rrr] = XUINT (content);
1372 else if (EQ (content, Qt))
1373 reg[RRR] = i;
1374 else if (CONSP (content))
1375 {
1376 attrib = XCONS (content)->car;
1377 value = XCONS (content)->cdr;
1378 if (!NUMBERP (attrib) || !NUMBERP (value))
1379 continue;
1380 reg[rrr] = XUINT(value);
1381 break;
1382 }
1383 else
1384 reg[RRR] = -1;
1385 }
1386 }
1387 break;
1388
1389 default:
1390 CCL_INVALID_CMD;
1391 }
1392 break;
1393
1394 default:
1395 CCL_INVALID_CMD;
1396 }
1397 }
1398
1399 ccl_error_handler:
1400 if (destination)
1401 {
1402 /* We can insert an error message only if DESTINATION is
1403 specified and we still have a room to store the message
1404 there. */
1405 char msg[256];
1406 int msglen;
1407
1408 switch (ccl->status)
1409 {
1410 case CCL_STAT_INVALID_CMD:
1411 sprintf(msg, "\nCCL: Invalid command %x (ccl_code = %x) at %d.",
1412 code & 0x1F, code, ic);
1413 #ifdef CCL_DEBUG
1414 {
1415 int i = ccl_backtrace_idx - 1;
1416 int j;
1417
1418 msglen = strlen (msg);
1419 if (dst + msglen <= (dst_bytes ? dst_end : src))
1420 {
1421 bcopy (msg, dst, msglen);
1422 dst += msglen;
1423 }
1424
1425 for (j = 0; j < CCL_DEBUG_BACKTRACE_LEN; j++, i--)
1426 {
1427 if (i < 0) i = CCL_DEBUG_BACKTRACE_LEN - 1;
1428 if (ccl_backtrace_table[i] == 0)
1429 break;
1430 sprintf(msg, " %d", ccl_backtrace_table[i]);
1431 msglen = strlen (msg);
1432 if (dst + msglen > (dst_bytes ? dst_end : src))
1433 break;
1434 bcopy (msg, dst, msglen);
1435 dst += msglen;
1436 }
1437 }
1438 #endif
1439 goto ccl_finish;
1440
1441 case CCL_STAT_QUIT:
1442 sprintf(msg, "\nCCL: Quited.");
1443 break;
1444
1445 default:
1446 sprintf(msg, "\nCCL: Unknown error type (%d).", ccl->status);
1447 }
1448
1449 msglen = strlen (msg);
1450 if (dst + msglen <= (dst_bytes ? dst_end : src))
1451 {
1452 bcopy (msg, dst, msglen);
1453 dst += msglen;
1454 }
1455 }
1456
1457 ccl_finish:
1458 ccl->ic = ic;
1459 if (consumed) *consumed = src - source;
1460 return dst - destination;
1461 }
1462
1463 /* Setup fields of the structure pointed by CCL appropriately for the
1464 execution of compiled CCL code in VEC (vector of integer). */
1465 void
1466 setup_ccl_program (ccl, vec)
1467 struct ccl_program *ccl;
1468 Lisp_Object vec;
1469 {
1470 int i;
1471
1472 ccl->size = XVECTOR (vec)->size;
1473 ccl->prog = XVECTOR (vec)->contents;
1474 ccl->ic = CCL_HEADER_MAIN;
1475 ccl->eof_ic = XINT (XVECTOR (vec)->contents[CCL_HEADER_EOF]);
1476 ccl->buf_magnification = XINT (XVECTOR (vec)->contents[CCL_HEADER_BUF_MAG]);
1477 for (i = 0; i < 8; i++)
1478 ccl->reg[i] = 0;
1479 ccl->last_block = 0;
1480 ccl->private_state = 0;
1481 ccl->status = 0;
1482 }
1483
1484 #ifdef emacs
1485
1486 DEFUN ("ccl-execute", Fccl_execute, Sccl_execute, 2, 2, 0,
1487 "Execute CCL-PROGRAM with registers initialized by REGISTERS.\n\
1488 CCL-PROGRAM is a compiled code generated by `ccl-compile',\n\
1489 no I/O commands should appear in the CCL program.\n\
1490 REGISTERS is a vector of [R0 R1 ... R7] where RN is an initial value\n\
1491 of Nth register.\n\
1492 As side effect, each element of REGISTER holds the value of\n\
1493 corresponding register after the execution.")
1494 (ccl_prog, reg)
1495 Lisp_Object ccl_prog, reg;
1496 {
1497 struct ccl_program ccl;
1498 int i;
1499
1500 CHECK_VECTOR (ccl_prog, 0);
1501 CHECK_VECTOR (reg, 1);
1502 if (XVECTOR (reg)->size != 8)
1503 error ("Invalid length of vector REGISTERS");
1504
1505 setup_ccl_program (&ccl, ccl_prog);
1506 for (i = 0; i < 8; i++)
1507 ccl.reg[i] = (INTEGERP (XVECTOR (reg)->contents[i])
1508 ? XINT (XVECTOR (reg)->contents[i])
1509 : 0);
1510
1511 ccl_driver (&ccl, (char *)0, (char *)0, 0, 0, (int *)0);
1512 QUIT;
1513 if (ccl.status != CCL_STAT_SUCCESS)
1514 error ("Error in CCL program at %dth code", ccl.ic);
1515
1516 for (i = 0; i < 8; i++)
1517 XSETINT (XVECTOR (reg)->contents[i], ccl.reg[i]);
1518 return Qnil;
1519 }
1520
1521 DEFUN ("ccl-execute-on-string", Fccl_execute_on_string, Sccl_execute_on_string,
1522 3, 4, 0,
1523 "Execute CCL-PROGRAM with initial STATUS on STRING.\n\
1524 CCL-PROGRAM is a compiled code generated by `ccl-compile'.\n\
1525 Read buffer is set to STRING, and write buffer is allocated automatically.\n\
1526 STATUS is a vector of [R0 R1 ... R7 IC], where\n\
1527 R0..R7 are initial values of corresponding registers,\n\
1528 IC is the instruction counter specifying from where to start the program.\n\
1529 If R0..R7 are nil, they are initialized to 0.\n\
1530 If IC is nil, it is initialized to head of the CCL program.\n\
1531 Returns the contents of write buffer as a string,\n\
1532 and as side effect, STATUS is updated.\n\
1533 If optional 4th arg CONTINUE is non-nil, keep IC on read operation\n\
1534 when read buffer is exausted, else, IC is always set to the end of\n\
1535 CCL-PROGRAM on exit.")
1536 (ccl_prog, status, str, contin)
1537 Lisp_Object ccl_prog, status, str, contin;
1538 {
1539 Lisp_Object val;
1540 struct ccl_program ccl;
1541 int i, produced;
1542 int outbufsize;
1543 char *outbuf;
1544 struct gcpro gcpro1, gcpro2, gcpro3;
1545
1546 CHECK_VECTOR (ccl_prog, 0);
1547 CHECK_VECTOR (status, 1);
1548 if (XVECTOR (status)->size != 9)
1549 error ("Invalid length of vector STATUS");
1550 CHECK_STRING (str, 2);
1551 GCPRO3 (ccl_prog, status, str);
1552
1553 setup_ccl_program (&ccl, ccl_prog);
1554 for (i = 0; i < 8; i++)
1555 {
1556 if (NILP (XVECTOR (status)->contents[i]))
1557 XSETINT (XVECTOR (status)->contents[i], 0);
1558 if (INTEGERP (XVECTOR (status)->contents[i]))
1559 ccl.reg[i] = XINT (XVECTOR (status)->contents[i]);
1560 }
1561 if (INTEGERP (XVECTOR (status)->contents[i]))
1562 {
1563 i = XFASTINT (XVECTOR (status)->contents[8]);
1564 if (ccl.ic < i && i < ccl.size)
1565 ccl.ic = i;
1566 }
1567 outbufsize = XSTRING (str)->size_byte * ccl.buf_magnification + 256;
1568 outbuf = (char *) xmalloc (outbufsize);
1569 if (!outbuf)
1570 error ("Not enough memory");
1571 ccl.last_block = NILP (contin);
1572 produced = ccl_driver (&ccl, XSTRING (str)->data, outbuf,
1573 XSTRING (str)->size_byte, outbufsize, (int *)0);
1574 for (i = 0; i < 8; i++)
1575 XSET (XVECTOR (status)->contents[i], Lisp_Int, ccl.reg[i]);
1576 XSETINT (XVECTOR (status)->contents[8], ccl.ic);
1577 UNGCPRO;
1578
1579 val = make_string (outbuf, produced);
1580 free (outbuf);
1581 QUIT;
1582 if (ccl.status != CCL_STAT_SUCCESS
1583 && ccl.status != CCL_STAT_SUSPEND_BY_SRC
1584 && ccl.status != CCL_STAT_SUSPEND_BY_DST)
1585 error ("Error in CCL program at %dth code", ccl.ic);
1586
1587 return val;
1588 }
1589
1590 DEFUN ("register-ccl-program", Fregister_ccl_program, Sregister_ccl_program,
1591 2, 2, 0,
1592 "Register CCL program PROGRAM of NAME in `ccl-program-table'.\n\
1593 PROGRAM should be a compiled code of CCL program, or nil.\n\
1594 Return index number of the registered CCL program.")
1595 (name, ccl_prog)
1596 Lisp_Object name, ccl_prog;
1597 {
1598 int len = XVECTOR (Vccl_program_table)->size;
1599 int i;
1600
1601 CHECK_SYMBOL (name, 0);
1602 if (!NILP (ccl_prog))
1603 CHECK_VECTOR (ccl_prog, 1);
1604
1605 for (i = 0; i < len; i++)
1606 {
1607 Lisp_Object slot = XVECTOR (Vccl_program_table)->contents[i];
1608
1609 if (!CONSP (slot))
1610 break;
1611
1612 if (EQ (name, XCONS (slot)->car))
1613 {
1614 XCONS (slot)->cdr = ccl_prog;
1615 return make_number (i);
1616 }
1617 }
1618
1619 if (i == len)
1620 {
1621 Lisp_Object new_table = Fmake_vector (make_number (len * 2), Qnil);
1622 int j;
1623
1624 for (j = 0; j < len; j++)
1625 XVECTOR (new_table)->contents[j]
1626 = XVECTOR (Vccl_program_table)->contents[j];
1627 Vccl_program_table = new_table;
1628 }
1629
1630 XVECTOR (Vccl_program_table)->contents[i] = Fcons (name, ccl_prog);
1631 return make_number (i);
1632 }
1633
1634 /* register CCL translation table.
1635 CCL translation table consists of numbers and Qt and Qnil and Qlambda.
1636 The first element is start code point.
1637 The rest elements are translated numbers.
1638 Qt shows that an original number before translation.
1639 Qnil shows that an empty element.
1640 Qlambda makes translation stopped.
1641 */
1642
1643 DEFUN ("register-ccl-translation-table", Fregister_ccl_translation_table,
1644 Sregister_ccl_translation_table,
1645 2, 2, 0,
1646 "Register CCL translation table.\n\
1647 TABLE should be a vector. SYMBOL is used for pointing the translation table out.\n\
1648 Return index number of the registered translation table.")
1649 (symbol, table)
1650 Lisp_Object symbol, table;
1651 {
1652 int len = XVECTOR (Vccl_translation_table_vector)->size;
1653 int i;
1654 Lisp_Object index;
1655
1656 CHECK_SYMBOL (symbol, 0);
1657 CHECK_VECTOR (table, 1);
1658
1659 for (i = 0; i < len; i++)
1660 {
1661 Lisp_Object slot = XVECTOR (Vccl_translation_table_vector)->contents[i];
1662
1663 if (!CONSP (slot))
1664 break;
1665
1666 if (EQ (symbol, XCONS (slot)->car))
1667 {
1668 index = make_number (i);
1669 XCONS (slot)->cdr = table;
1670 Fput (symbol, Qccl_translation_table, table);
1671 Fput (symbol, Qccl_translation_table_id, index);
1672 return index;
1673 }
1674 }
1675
1676 if (i == len)
1677 {
1678 Lisp_Object new_vector = Fmake_vector (make_number (len * 2), Qnil);
1679 int j;
1680
1681 for (j = 0; j < len; j++)
1682 XVECTOR (new_vector)->contents[j]
1683 = XVECTOR (Vccl_translation_table_vector)->contents[j];
1684 Vccl_translation_table_vector = new_vector;
1685 }
1686
1687 index = make_number (i);
1688 Fput (symbol, Qccl_translation_table, table);
1689 Fput (symbol, Qccl_translation_table_id, index);
1690 XVECTOR (Vccl_translation_table_vector)->contents[i] = Fcons (symbol, table);
1691 return index;
1692 }
1693
1694
1695 syms_of_ccl ()
1696 {
1697 staticpro (&Vccl_program_table);
1698 Vccl_program_table = Fmake_vector (make_number (32), Qnil);
1699
1700 Qccl_program = intern("ccl-program");
1701 staticpro(&Qccl_program);
1702
1703 Qccl_translation_table = intern ("ccl-translation-table");
1704 staticpro (&Qccl_translation_table);
1705
1706 Qccl_translation_table_id = intern ("ccl-translation-table-id");
1707 staticpro (&Qccl_translation_table_id);
1708
1709 DEFVAR_LISP ("ccl-translation-table-vector", &Vccl_translation_table_vector,
1710 "Where is stored translation tables for CCL program.\n\
1711 Because CCL program can't access these tables except by the index of the vector.");
1712 Vccl_translation_table_vector = Fmake_vector (XFASTINT (16), Qnil);
1713
1714 DEFVAR_LISP ("font-ccl-encoder-alist", &Vfont_ccl_encoder_alist,
1715 "Alist of fontname patterns vs corresponding CCL program.\n\
1716 Each element looks like (REGEXP . CCL-CODE),\n\
1717 where CCL-CODE is a compiled CCL program.\n\
1718 When a font whose name matches REGEXP is used for displaying a character,\n\
1719 CCL-CODE is executed to calculate the code point in the font\n\
1720 from the charset number and position code(s) of the character which are set\n\
1721 in CCL registers R0, R1, and R2 before the execution.\n\
1722 The code point in the font is set in CCL registers R1 and R2\n\
1723 when the execution terminated.\n\
1724 If the font is single-byte font, the register R2 is not used.");
1725 Vfont_ccl_encoder_alist = Qnil;
1726
1727 defsubr (&Sccl_execute);
1728 defsubr (&Sccl_execute_on_string);
1729 defsubr (&Sregister_ccl_program);
1730 defsubr (&Sregister_ccl_translation_table);
1731 }
1732
1733 #endif /* emacs */
Unnamed repository; edit this file 'description' to name the repository.