Mercurial > hg > xemacs-beta

comparison src/mule-ccl.c @ 428:3ecd8885ac67 r21-2-22

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r21-2-22
author cvs
date Mon, 13 Aug 2007 11:28:15 +0200
parents
children 84b14dcb0985
comparison
equal deleted inserted replaced
427:0a0253eac470 428:3ecd8885ac67
1 /* CCL (Code Conversion Language) interpreter.
2 Copyright (C) 1995, 1997, 1998, 1999 Electrotechnical Laboratory, JAPAN.
3 Licensed to the Free Software Foundation.
4
5 This file is part of XEmacs.
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 /* Synched up with : FSF Emacs 20.3.10 without ExCCL
23 * (including {Read|Write}MultibyteChar) */
24
25 #ifdef emacs
26
27 #include <config.h>
28
29 #if 0
30 #ifdef STDC_HEADERS
31 #include <stdlib.h>
32 #endif
33 #endif
34
35 #include "lisp.h"
36 #include "buffer.h"
37 #include "mule-charset.h"
38 #include "mule-ccl.h"
39 #include "file-coding.h"
40
41 #else /* not emacs */
42
43 #include <stdio.h>
44 #include "mulelib.h"
45
46 #endif /* not emacs */
47
48 /* This contains all code conversion map available to CCL. */
49 /*
50 Lisp_Object Vcode_conversion_map_vector;
51 */
52
53 /* Alist of fontname patterns vs corresponding CCL program. */
54 Lisp_Object Vfont_ccl_encoder_alist;
55
56 /* This symbol is a property which assocates with ccl program vector.
57 Ex: (get 'ccl-big5-encoder 'ccl-program) returns ccl program vector. */
58 Lisp_Object Qccl_program;
59
60 /* These symbols are properties which associate with code conversion
61 map and their ID respectively. */
62 /*
63 Lisp_Object Qcode_conversion_map;
64 Lisp_Object Qcode_conversion_map_id;
65 */
66
67 /* Symbols of ccl program have this property, a value of the property
68 is an index for Vccl_protram_table. */
69 Lisp_Object Qccl_program_idx;
70
71 /* Vector of CCL program names vs corresponding program data. */
72 Lisp_Object Vccl_program_table;
73
74 /* CCL (Code Conversion Language) is a simple language which has
75 operations on one input buffer, one output buffer, and 7 registers.
76 The syntax of CCL is described in `ccl.el'. Emacs Lisp function
77 `ccl-compile' compiles a CCL program and produces a CCL code which
78 is a vector of integers. The structure of this vector is as
79 follows: The 1st element: buffer-magnification, a factor for the
80 size of output buffer compared with the size of input buffer. The
81 2nd element: address of CCL code to be executed when encountered
82 with end of input stream. The 3rd and the remaining elements: CCL
83 codes. */
84
85 /* Header of CCL compiled code */
86 #define CCL_HEADER_BUF_MAG 0
87 #define CCL_HEADER_EOF 1
88 #define CCL_HEADER_MAIN 2
89
90 /* CCL code is a sequence of 28-bit non-negative integers (i.e. the
91 MSB is always 0), each contains CCL command and/or arguments in the
92 following format:
93
94 |----------------- integer (28-bit) ------------------|
95 |------- 17-bit ------|- 3-bit --|- 3-bit --|- 5-bit -|
96 |--constant argument--|-register-|-register-|-command-|
97 ccccccccccccccccc RRR rrr XXXXX
98 or
99 |------- relative address -------|-register-|-command-|
100 cccccccccccccccccccc rrr XXXXX
101 or
102 |------------- constant or other args ----------------|
103 cccccccccccccccccccccccccccc
104
105 where, `cc...c' is a non-negative integer indicating constant value
106 (the left most `c' is always 0) or an absolute jump address, `RRR'
107 and `rrr' are CCL register number, `XXXXX' is one of the following
108 CCL commands. */
109
110 /* CCL commands
111
112 Each comment fields shows one or more lines for command syntax and
113 the following lines for semantics of the command. In semantics, IC
114 stands for Instruction Counter. */
115
116 #define CCL_SetRegister 0x00 /* Set register a register value:
117 1:00000000000000000RRRrrrXXXXX
118 ------------------------------
119 reg[rrr] = reg[RRR];
120 */
121
122 #define CCL_SetShortConst 0x01 /* Set register a short constant value:
123 1:CCCCCCCCCCCCCCCCCCCCrrrXXXXX
124 ------------------------------
125 reg[rrr] = CCCCCCCCCCCCCCCCCCC;
126 */
127
128 #define CCL_SetConst 0x02 /* Set register a constant value:
129 1:00000000000000000000rrrXXXXX
130 2:CONSTANT
131 ------------------------------
132 reg[rrr] = CONSTANT;
133 IC++;
134 */
135
136 #define CCL_SetArray 0x03 /* Set register an element of array:
137 1:CCCCCCCCCCCCCCCCCRRRrrrXXXXX
138 2:ELEMENT[0]
139 3:ELEMENT[1]
140 ...
141 ------------------------------
142 if (0 <= reg[RRR] < CC..C)
143 reg[rrr] = ELEMENT[reg[RRR]];
144 IC += CC..C;
145 */
146
147 #define CCL_Jump 0x04 /* Jump:
148 1:A--D--D--R--E--S--S-000XXXXX
149 ------------------------------
150 IC += ADDRESS;
151 */
152
153 /* Note: If CC..C is greater than 0, the second code is omitted. */
154
155 #define CCL_JumpCond 0x05 /* Jump conditional:
156 1:A--D--D--R--E--S--S-rrrXXXXX
157 ------------------------------
158 if (!reg[rrr])
159 IC += ADDRESS;
160 */
161
162
163 #define CCL_WriteRegisterJump 0x06 /* Write register and jump:
164 1:A--D--D--R--E--S--S-rrrXXXXX
165 ------------------------------
166 write (reg[rrr]);
167 IC += ADDRESS;
168 */
169
170 #define CCL_WriteRegisterReadJump 0x07 /* Write register, read, and jump:
171 1:A--D--D--R--E--S--S-rrrXXXXX
172 2:A--D--D--R--E--S--S-rrrYYYYY
173 -----------------------------
174 write (reg[rrr]);
175 IC++;
176 read (reg[rrr]);
177 IC += ADDRESS;
178 */
179 /* Note: If read is suspended, the resumed execution starts from the
180 second code (YYYYY == CCL_ReadJump). */
181
182 #define CCL_WriteConstJump 0x08 /* Write constant and jump:
183 1:A--D--D--R--E--S--S-000XXXXX
184 2:CONST
185 ------------------------------
186 write (CONST);
187 IC += ADDRESS;
188 */
189
190 #define CCL_WriteConstReadJump 0x09 /* Write constant, read, and jump:
191 1:A--D--D--R--E--S--S-rrrXXXXX
192 2:CONST
193 3:A--D--D--R--E--S--S-rrrYYYYY
194 -----------------------------
195 write (CONST);
196 IC += 2;
197 read (reg[rrr]);
198 IC += ADDRESS;
199 */
200 /* Note: If read is suspended, the resumed execution starts from the
201 second code (YYYYY == CCL_ReadJump). */
202
203 #define CCL_WriteStringJump 0x0A /* Write string and jump:
204 1:A--D--D--R--E--S--S-000XXXXX
205 2:LENGTH
206 3:0000STRIN[0]STRIN[1]STRIN[2]
207 ...
208 ------------------------------
209 write_string (STRING, LENGTH);
210 IC += ADDRESS;
211 */
212
213 #define CCL_WriteArrayReadJump 0x0B /* Write an array element, read, and jump:
214 1:A--D--D--R--E--S--S-rrrXXXXX
215 2:LENGTH
216 3:ELEMENET[0]
217 4:ELEMENET[1]
218 ...
219 N:A--D--D--R--E--S--S-rrrYYYYY
220 ------------------------------
221 if (0 <= reg[rrr] < LENGTH)
222 write (ELEMENT[reg[rrr]]);
223 IC += LENGTH + 2; (... pointing at N+1)
224 read (reg[rrr]);
225 IC += ADDRESS;
226 */
227 /* Note: If read is suspended, the resumed execution starts from the
228 Nth code (YYYYY == CCL_ReadJump). */
229
230 #define CCL_ReadJump 0x0C /* Read and jump:
231 1:A--D--D--R--E--S--S-rrrYYYYY
232 -----------------------------
233 read (reg[rrr]);
234 IC += ADDRESS;
235 */
236
237 #define CCL_Branch 0x0D /* Jump by branch table:
238 1:CCCCCCCCCCCCCCCCCCCCrrrXXXXX
239 2:A--D--D--R--E-S-S[0]000XXXXX
240 3:A--D--D--R--E-S-S[1]000XXXXX
241 ...
242 ------------------------------
243 if (0 <= reg[rrr] < CC..C)
244 IC += ADDRESS[reg[rrr]];
245 else
246 IC += ADDRESS[CC..C];
247 */
248
249 #define CCL_ReadRegister 0x0E /* Read bytes into registers:
250 1:CCCCCCCCCCCCCCCCCCCCrrrXXXXX
251 2:CCCCCCCCCCCCCCCCCCCCrrrXXXXX
252 ...
253 ------------------------------
254 while (CCC--)
255 read (reg[rrr]);
256 */
257
258 #define CCL_WriteExprConst 0x0F /* write result of expression:
259 1:00000OPERATION000RRR000XXXXX
260 2:CONSTANT
261 ------------------------------
262 write (reg[RRR] OPERATION CONSTANT);
263 IC++;
264 */
265
266 /* Note: If the Nth read is suspended, the resumed execution starts
267 from the Nth code. */
268
269 #define CCL_ReadBranch 0x10 /* Read one byte into a register,
270 and jump by branch table:
271 1:CCCCCCCCCCCCCCCCCCCCrrrXXXXX
272 2:A--D--D--R--E-S-S[0]000XXXXX
273 3:A--D--D--R--E-S-S[1]000XXXXX
274 ...
275 ------------------------------
276 read (read[rrr]);
277 if (0 <= reg[rrr] < CC..C)
278 IC += ADDRESS[reg[rrr]];
279 else
280 IC += ADDRESS[CC..C];
281 */
282
283 #define CCL_WriteRegister 0x11 /* Write registers:
284 1:CCCCCCCCCCCCCCCCCCCrrrXXXXX
285 2:CCCCCCCCCCCCCCCCCCCrrrXXXXX
286 ...
287 ------------------------------
288 while (CCC--)
289 write (reg[rrr]);
290 ...
291 */
292
293 /* Note: If the Nth write is suspended, the resumed execution
294 starts from the Nth code. */
295
296 #define CCL_WriteExprRegister 0x12 /* Write result of expression
297 1:00000OPERATIONRrrRRR000XXXXX
298 ------------------------------
299 write (reg[RRR] OPERATION reg[Rrr]);
300 */
301
302 #define CCL_Call 0x13 /* Call the CCL program whose ID is
303 (CC..C).
304 1:CCCCCCCCCCCCCCCCCCCC000XXXXX
305 ------------------------------
306 call (CC..C)
307 */
308
309 #define CCL_WriteConstString 0x14 /* Write a constant or a string:
310 1:CCCCCCCCCCCCCCCCCCCCrrrXXXXX
311 [2:0000STRIN[0]STRIN[1]STRIN[2]]
312 [...]
313 -----------------------------
314 if (!rrr)
315 write (CC..C)
316 else
317 write_string (STRING, CC..C);
318 IC += (CC..C + 2) / 3;
319 */
320
321 #define CCL_WriteArray 0x15 /* Write an element of array:
322 1:CCCCCCCCCCCCCCCCCCCCrrrXXXXX
323 2:ELEMENT[0]
324 3:ELEMENT[1]
325 ...
326 ------------------------------
327 if (0 <= reg[rrr] < CC..C)
328 write (ELEMENT[reg[rrr]]);
329 IC += CC..C;
330 */
331
332 #define CCL_End 0x16 /* Terminate:
333 1:00000000000000000000000XXXXX
334 ------------------------------
335 terminate ();
336 */
337
338 /* The following two codes execute an assignment arithmetic/logical
339 operation. The form of the operation is like REG OP= OPERAND. */
340
341 #define CCL_ExprSelfConst 0x17 /* REG OP= constant:
342 1:00000OPERATION000000rrrXXXXX
343 2:CONSTANT
344 ------------------------------
345 reg[rrr] OPERATION= CONSTANT;
346 */
347
348 #define CCL_ExprSelfReg 0x18 /* REG1 OP= REG2:
349 1:00000OPERATION000RRRrrrXXXXX
350 ------------------------------
351 reg[rrr] OPERATION= reg[RRR];
352 */
353
354 /* The following codes execute an arithmetic/logical operation. The
355 form of the operation is like REG_X = REG_Y OP OPERAND2. */
356
357 #define CCL_SetExprConst 0x19 /* REG_X = REG_Y OP constant:
358 1:00000OPERATION000RRRrrrXXXXX
359 2:CONSTANT
360 ------------------------------
361 reg[rrr] = reg[RRR] OPERATION CONSTANT;
362 IC++;
363 */
364
365 #define CCL_SetExprReg 0x1A /* REG1 = REG2 OP REG3:
366 1:00000OPERATIONRrrRRRrrrXXXXX
367 ------------------------------
368 reg[rrr] = reg[RRR] OPERATION reg[Rrr];
369 */
370
371 #define CCL_JumpCondExprConst 0x1B /* Jump conditional according to
372 an operation on constant:
373 1:A--D--D--R--E--S--S-rrrXXXXX
374 2:OPERATION
375 3:CONSTANT
376 -----------------------------
377 reg[7] = reg[rrr] OPERATION CONSTANT;
378 if (!(reg[7]))
379 IC += ADDRESS;
380 else
381 IC += 2
382 */
383
384 #define CCL_JumpCondExprReg 0x1C /* Jump conditional according to
385 an operation on register:
386 1:A--D--D--R--E--S--S-rrrXXXXX
387 2:OPERATION
388 3:RRR
389 -----------------------------
390 reg[7] = reg[rrr] OPERATION reg[RRR];
391 if (!reg[7])
392 IC += ADDRESS;
393 else
394 IC += 2;
395 */
396
397 #define CCL_ReadJumpCondExprConst 0x1D /* Read and jump conditional according
398 to an operation on constant:
399 1:A--D--D--R--E--S--S-rrrXXXXX
400 2:OPERATION
401 3:CONSTANT
402 -----------------------------
403 read (reg[rrr]);
404 reg[7] = reg[rrr] OPERATION CONSTANT;
405 if (!reg[7])
406 IC += ADDRESS;
407 else
408 IC += 2;
409 */
410
411 #define CCL_ReadJumpCondExprReg 0x1E /* Read and jump conditional according
412 to an operation on register:
413 1:A--D--D--R--E--S--S-rrrXXXXX
414 2:OPERATION
415 3:RRR
416 -----------------------------
417 read (reg[rrr]);
418 reg[7] = reg[rrr] OPERATION reg[RRR];
419 if (!reg[7])
420 IC += ADDRESS;
421 else
422 IC += 2;
423 */
424
425 #define CCL_Extention 0x1F /* Extended CCL code
426 1:ExtendedCOMMNDRrrRRRrrrXXXXX
427 2:ARGUEMENT
428 3:...
429 ------------------------------
430 extended_command (rrr,RRR,Rrr,ARGS)
431 */
432
433 /*
434 Here after, Extended CCL Instructions.
435 Bit length of extended command is 14.
436 Therefore, the instruction code range is 0..16384(0x3fff).
437 */
438
439 /* Read a multibyte characeter.
440 A code point is stored into reg[rrr]. A charset ID is stored into
441 reg[RRR]. */
442
443 #define CCL_ReadMultibyteChar2 0x00 /* Read Multibyte Character
444 1:ExtendedCOMMNDRrrRRRrrrXXXXX */
445
446 /* Write a multibyte character.
447 Write a character whose code point is reg[rrr] and the charset ID
448 is reg[RRR]. */
449
450 #define CCL_WriteMultibyteChar2 0x01 /* Write Multibyte Character
451 1:ExtendedCOMMNDRrrRRRrrrXXXXX */
452
453 #if 0
454 /* Translate a character whose code point is reg[rrr] and the charset
455 ID is reg[RRR] by a translation table whose ID is reg[Rrr].
456
457 A translated character is set in reg[rrr] (code point) and reg[RRR]
458 (charset ID). */
459
460 #define CCL_TranslateCharacter 0x02 /* Translate a multibyte character
461 1:ExtendedCOMMNDRrrRRRrrrXXXXX */
462
463 /* Translate a character whose code point is reg[rrr] and the charset
464 ID is reg[RRR] by a translation table whose ID is ARGUMENT.
465
466 A translated character is set in reg[rrr] (code point) and reg[RRR]
467 (charset ID). */
468
469 #define CCL_TranslateCharacterConstTbl 0x03 /* Translate a multibyte character
470 1:ExtendedCOMMNDRrrRRRrrrXXXXX
471 2:ARGUMENT(Translation Table ID)
472 */
473
474 /* Iterate looking up MAPs for reg[rrr] starting from the Nth (N =
475 reg[RRR]) MAP until some value is found.
476
477 Each MAP is a Lisp vector whose element is number, nil, t, or
478 lambda.
479 If the element is nil, ignore the map and proceed to the next map.
480 If the element is t or lambda, finish without changing reg[rrr].
481 If the element is a number, set reg[rrr] to the number and finish.
482
483 Detail of the map structure is descibed in the comment for
484 CCL_MapMultiple below. */
485
486 #define CCL_IterateMultipleMap 0x10 /* Iterate multiple maps
487 1:ExtendedCOMMNDXXXRRRrrrXXXXX
488 2:NUMBER of MAPs
489 3:MAP-ID1
490 4:MAP-ID2
491 ...
492 */
493
494 /* Map the code in reg[rrr] by MAPs starting from the Nth (N =
495 reg[RRR]) map.
496
497 MAPs are supplied in the succeeding CCL codes as follows:
498
499 When CCL program gives this nested structure of map to this command:
500 ((MAP-ID11
501 MAP-ID12
502 (MAP-ID121 MAP-ID122 MAP-ID123)
503 MAP-ID13)
504 (MAP-ID21
505 (MAP-ID211 (MAP-ID2111) MAP-ID212)
506 MAP-ID22)),
507 the compiled CCL codes has this sequence:
508 CCL_MapMultiple (CCL code of this command)
509 16 (total number of MAPs and SEPARATORs)
510 -7 (1st SEPARATOR)
511 MAP-ID11
512 MAP-ID12
513 -3 (2nd SEPARATOR)
514 MAP-ID121
515 MAP-ID122
516 MAP-ID123
517 MAP-ID13
518 -7 (3rd SEPARATOR)
519 MAP-ID21
520 -4 (4th SEPARATOR)
521 MAP-ID211
522 -1 (5th SEPARATOR)
523 MAP_ID2111
524 MAP-ID212
525 MAP-ID22
526
527 A value of each SEPARATOR follows this rule:
528 MAP-SET := SEPARATOR [(MAP-ID | MAP-SET)]+
529 SEPARATOR := -(number of MAP-IDs and SEPARATORs in the MAP-SET)
530
531 (*)....Nest level of MAP-SET must not be over than MAX_MAP_SET_LEVEL.
532
533 When some map fails to map (i.e. it doesn't have a value for
534 reg[rrr]), the mapping is treated as identity.
535
536 The mapping is iterated for all maps in each map set (set of maps
537 separated by SEPARATOR) except in the case that lambda is
538 encountered. More precisely, the mapping proceeds as below:
539
540 At first, VAL0 is set to reg[rrr], and it is translated by the
541 first map to VAL1. Then, VAL1 is translated by the next map to
542 VAL2. This mapping is iterated until the last map is used. The
543 result of the mapping is the last value of VAL?.
544
545 But, when VALm is mapped to VALn and VALn is not a number, the
546 mapping proceed as below:
547
548 If VALn is nil, the lastest map is ignored and the mapping of VALm
549 proceed to the next map.
550
551 In VALn is t, VALm is reverted to reg[rrr] and the mapping of VALm
552 proceed to the next map.
553
554 If VALn is lambda, the whole mapping process terminates, and VALm
555 is the result of this mapping.
556
557 Each map is a Lisp vector of the following format (a) or (b):
558 (a)......[STARTPOINT VAL1 VAL2 ...]
559 (b)......[t VAL STARTPOINT ENDPOINT],
560 where
561 STARTPOINT is an offset to be used for indexing a map,
562 ENDPOINT is a maximum index number of a map,
563 VAL and VALn is a number, nil, t, or lambda.
564
565 Valid index range of a map of type (a) is:
566 STARTPOINT <= index < STARTPOINT + map_size - 1
567 Valid index range of a map of type (b) is:
568 STARTPOINT <= index < ENDPOINT */
569
570 #define CCL_MapMultiple 0x11 /* Mapping by multiple code conversion maps
571 1:ExtendedCOMMNDXXXRRRrrrXXXXX
572 2:N-2
573 3:SEPARATOR_1 (< 0)
574 4:MAP-ID_1
575 5:MAP-ID_2
576 ...
577 M:SEPARATOR_x (< 0)
578 M+1:MAP-ID_y
579 ...
580 N:SEPARATOR_z (< 0)
581 */
582
583 #define MAX_MAP_SET_LEVEL 20
584
585 typedef struct
586 {
587 int rest_length;
588 int orig_val;
589 } tr_stack;
590
591 static tr_stack mapping_stack[MAX_MAP_SET_LEVEL];
592 static tr_stack *mapping_stack_pointer;
593 #endif
594
595 #define PUSH_MAPPING_STACK(restlen, orig) \
596 { \
597 mapping_stack_pointer->rest_length = (restlen); \
598 mapping_stack_pointer->orig_val = (orig); \
599 mapping_stack_pointer++; \
600 }
601
602 #define POP_MAPPING_STACK(restlen, orig) \
603 { \
604 mapping_stack_pointer--; \
605 (restlen) = mapping_stack_pointer->rest_length; \
606 (orig) = mapping_stack_pointer->orig_val; \
607 } \
608
609 #define CCL_MapSingle 0x12 /* Map by single code conversion map
610 1:ExtendedCOMMNDXXXRRRrrrXXXXX
611 2:MAP-ID
612 ------------------------------
613 Map reg[rrr] by MAP-ID.
614 If some valid mapping is found,
615 set reg[rrr] to the result,
616 else
617 set reg[RRR] to -1.
618 */
619
620 /* CCL arithmetic/logical operators. */
621 #define CCL_PLUS 0x00 /* X = Y + Z */
622 #define CCL_MINUS 0x01 /* X = Y - Z */
623 #define CCL_MUL 0x02 /* X = Y * Z */
624 #define CCL_DIV 0x03 /* X = Y / Z */
625 #define CCL_MOD 0x04 /* X = Y % Z */
626 #define CCL_AND 0x05 /* X = Y & Z */
627 #define CCL_OR 0x06 /* X = Y | Z */
628 #define CCL_XOR 0x07 /* X = Y ^ Z */
629 #define CCL_LSH 0x08 /* X = Y << Z */
630 #define CCL_RSH 0x09 /* X = Y >> Z */
631 #define CCL_LSH8 0x0A /* X = (Y << 8) | Z */
632 #define CCL_RSH8 0x0B /* X = Y >> 8, r[7] = Y & 0xFF */
633 #define CCL_DIVMOD 0x0C /* X = Y / Z, r[7] = Y % Z */
634 #define CCL_LS 0x10 /* X = (X < Y) */
635 #define CCL_GT 0x11 /* X = (X > Y) */
636 #define CCL_EQ 0x12 /* X = (X == Y) */
637 #define CCL_LE 0x13 /* X = (X <= Y) */
638 #define CCL_GE 0x14 /* X = (X >= Y) */
639 #define CCL_NE 0x15 /* X = (X != Y) */
640
641 #define CCL_DECODE_SJIS 0x16 /* X = HIGHER_BYTE (DE-SJIS (Y, Z))
642 r[7] = LOWER_BYTE (DE-SJIS (Y, Z)) */
643 #define CCL_ENCODE_SJIS 0x17 /* X = HIGHER_BYTE (SJIS (Y, Z))
644 r[7] = LOWER_BYTE (SJIS (Y, Z) */
645
646 /* Suspend CCL program because of reading from empty input buffer or
647 writing to full output buffer. When this program is resumed, the
648 same I/O command is executed. */
649 #define CCL_SUSPEND(stat) \
650 do { \
651 ic--; \
652 ccl->status = stat; \
653 goto ccl_finish; \
654 } while (0)
655
656 /* Terminate CCL program because of invalid command. Should not occur
657 in the normal case. */
658 #define CCL_INVALID_CMD \
659 do { \
660 ccl->status = CCL_STAT_INVALID_CMD; \
661 goto ccl_error_handler; \
662 } while (0)
663
664 /* Encode one character CH to multibyte form and write to the current
665 output buffer. If CH is less than 256, CH is written as is. */
666 #define CCL_WRITE_CHAR(ch) do { \
667 if (!destination) \
668 { \
669 ccl->status = CCL_STAT_INVALID_CMD; \
670 goto ccl_error_handler; \
671 } \
672 else \
673 { \
674 Bufbyte work[MAX_EMCHAR_LEN]; \
675 int len = ( ch < ( conversion_mode == CCL_MODE_ENCODING ? \
676 256 : 128 ) ) ? \
677 simple_set_charptr_emchar (work, ch) : \
678 non_ascii_set_charptr_emchar (work, ch); \
679 Dynarr_add_many (destination, work, len); \
680 } \
681 } while (0)
682
683 /* Write a string at ccl_prog[IC] of length LEN to the current output
684 buffer. */
685 #define CCL_WRITE_STRING(len) do { \
686 if (!destination) \
687 { \
688 ccl->status = CCL_STAT_INVALID_CMD; \
689 goto ccl_error_handler; \
690 } \
691 else \
692 { \
693 Bufbyte work[MAX_EMCHAR_LEN]; \
694 for (i = 0; i < len; i++) \
695 { \
696 int ch = (XINT (ccl_prog[ic + (i / 3)]) \
697 >> ((2 - (i % 3)) * 8)) & 0xFF; \
698 int bytes = \
699 ( ch < ( conversion_mode == CCL_MODE_ENCODING ? \
700 256 : 128 ) ) ? \
701 simple_set_charptr_emchar (work, ch) : \
702 non_ascii_set_charptr_emchar (work, ch); \
703 Dynarr_add_many (destination, work, bytes); \
704 } \
705 } \
706 } while (0)
707
708 /* Read one byte from the current input buffer into Rth register. */
709 #define CCL_READ_CHAR(r) do { \
710 if (!src && !ccl->last_block) \
711 { \
712 ccl->status = CCL_STAT_INVALID_CMD; \
713 goto ccl_error_handler; \
714 } \
715 else if (src < src_end) \
716 r = *src++; \
717 else if (ccl->last_block) \
718 { \
719 ic = ccl->eof_ic; \
720 goto ccl_repeat; \
721 } \
722 else \
723 /* Suspend CCL program because of \
724 reading from empty input buffer or \
725 writing to full output buffer. \
726 When this program is resumed, the \
727 same I/O command is executed. */ \
728 { \
729 ic--; \
730 ccl->status = CCL_STAT_SUSPEND_BY_SRC; \
731 goto ccl_finish; \
732 } \
733 } while (0)
734
735
736 /* Execute CCL code on SRC_BYTES length text at SOURCE. The resulting
737 text goes to a place pointed by DESTINATION. The bytes actually
738 processed is returned as *CONSUMED. The return value is the length
739 of the resulting text. As a side effect, the contents of CCL registers
740 are updated. If SOURCE or DESTINATION is NULL, only operations on
741 registers are permitted. */
742
743 #ifdef CCL_DEBUG
744 #define CCL_DEBUG_BACKTRACE_LEN 256
745 int ccl_backtrace_table[CCL_BACKTRACE_TABLE];
746 int ccl_backtrace_idx;
747 #endif
748
749 struct ccl_prog_stack
750 {
751 Lisp_Object *ccl_prog; /* Pointer to an array of CCL code. */
752 int ic; /* Instruction Counter. */
753 };
754
755 /* For the moment, we only support depth 256 of stack. */
756 static struct ccl_prog_stack ccl_prog_stack_struct[256];
757
758 int
759 ccl_driver (struct ccl_program *ccl, CONST unsigned char *source,
760 unsigned_char_dynarr *destination, int src_bytes,
761 int *consumed, int conversion_mode)
762 {
763 int *reg = ccl->reg;
764 int ic = ccl->ic;
765 int code = -1; /* init to illegal value, */
766 int field1, field2;
767 Lisp_Object *ccl_prog = ccl->prog;
768 CONST unsigned char *src = source, *src_end = src + src_bytes;
769 int jump_address = 0; /* shut up the compiler */
770 int i, j, op;
771 int stack_idx = ccl->stack_idx;
772 /* Instruction counter of the current CCL code. */
773 int this_ic = 0;
774
775 if (ic >= ccl->eof_ic)
776 ic = CCL_HEADER_MAIN;
777
778 #if 0 /* not for XEmacs ? */
779 if (ccl->buf_magnification ==0) /* We can't produce any bytes. */
780 dst = NULL;
781 #endif
782
783 #ifdef CCL_DEBUG
784 ccl_backtrace_idx = 0;
785 #endif
786
787 for (;;)
788 {
789 ccl_repeat:
790 #ifdef CCL_DEBUG
791 ccl_backtrace_table[ccl_backtrace_idx++] = ic;
792 if (ccl_backtrace_idx >= CCL_DEBUG_BACKTRACE_LEN)
793 ccl_backtrace_idx = 0;
794 ccl_backtrace_table[ccl_backtrace_idx] = 0;
795 #endif
796
797 if (!NILP (Vquit_flag) && NILP (Vinhibit_quit))
798 {
799 /* We can't just signal Qquit, instead break the loop as if
800 the whole data is processed. Don't reset Vquit_flag, it
801 must be handled later at a safer place. */
802 if (consumed)
803 src = source + src_bytes;
804 ccl->status = CCL_STAT_QUIT;
805 break;
806 }
807
808 this_ic = ic;
809 code = XINT (ccl_prog[ic]); ic++;
810 field1 = code >> 8;
811 field2 = (code & 0xFF) >> 5;
812
813 #define rrr field2
814 #define RRR (field1 & 7)
815 #define Rrr ((field1 >> 3) & 7)
816 #define ADDR field1
817 #define EXCMD (field1 >> 6)
818
819 switch (code & 0x1F)
820 {
821 case CCL_SetRegister: /* 00000000000000000RRRrrrXXXXX */
822 reg[rrr] = reg[RRR];
823 break;
824
825 case CCL_SetShortConst: /* CCCCCCCCCCCCCCCCCCCCrrrXXXXX */
826 reg[rrr] = field1;
827 break;
828
829 case CCL_SetConst: /* 00000000000000000000rrrXXXXX */
830 reg[rrr] = XINT (ccl_prog[ic]);
831 ic++;
832 break;
833
834 case CCL_SetArray: /* CCCCCCCCCCCCCCCCCCCCRRRrrrXXXXX */
835 i = reg[RRR];
836 j = field1 >> 3;
837 if ((unsigned int) i < j)
838 reg[rrr] = XINT (ccl_prog[ic + i]);
839 ic += j;
840 break;
841
842 case CCL_Jump: /* A--D--D--R--E--S--S-000XXXXX */
843 ic += ADDR;
844 break;
845
846 case CCL_JumpCond: /* A--D--D--R--E--S--S-rrrXXXXX */
847 if (!reg[rrr])
848 ic += ADDR;
849 break;
850
851 case CCL_WriteRegisterJump: /* A--D--D--R--E--S--S-rrrXXXXX */
852 i = reg[rrr];
853 CCL_WRITE_CHAR (i);
854 ic += ADDR;
855 break;
856
857 case CCL_WriteRegisterReadJump: /* A--D--D--R--E--S--S-rrrXXXXX */
858 i = reg[rrr];
859 CCL_WRITE_CHAR (i);
860 ic++;
861 CCL_READ_CHAR (reg[rrr]);
862 ic += ADDR - 1;
863 break;
864
865 case CCL_WriteConstJump: /* A--D--D--R--E--S--S-000XXXXX */
866 i = XINT (ccl_prog[ic]);
867 CCL_WRITE_CHAR (i);
868 ic += ADDR;
869 break;
870
871 case CCL_WriteConstReadJump: /* A--D--D--R--E--S--S-rrrXXXXX */
872 i = XINT (ccl_prog[ic]);
873 CCL_WRITE_CHAR (i);
874 ic++;
875 CCL_READ_CHAR (reg[rrr]);
876 ic += ADDR - 1;
877 break;
878
879 case CCL_WriteStringJump: /* A--D--D--R--E--S--S-000XXXXX */
880 j = XINT (ccl_prog[ic]);
881 ic++;
882 CCL_WRITE_STRING (j);
883 ic += ADDR - 1;
884 break;
885
886 case CCL_WriteArrayReadJump: /* A--D--D--R--E--S--S-rrrXXXXX */
887 i = reg[rrr];
888 j = XINT (ccl_prog[ic]);
889 if ((unsigned int) i < j)
890 {
891 i = XINT (ccl_prog[ic + 1 + i]);
892 CCL_WRITE_CHAR (i);
893 }
894 ic += j + 2;
895 CCL_READ_CHAR (reg[rrr]);
896 ic += ADDR - (j + 2);
897 break;
898
899 case CCL_ReadJump: /* A--D--D--R--E--S--S-rrrYYYYY */
900 CCL_READ_CHAR (reg[rrr]);
901 ic += ADDR;
902 break;
903
904 case CCL_ReadBranch: /* CCCCCCCCCCCCCCCCCCCCrrrXXXXX */
905 CCL_READ_CHAR (reg[rrr]);
906 /* fall through ... */
907 case CCL_Branch: /* CCCCCCCCCCCCCCCCCCCCrrrXXXXX */
908 if ((unsigned int) reg[rrr] < field1)
909 ic += XINT (ccl_prog[ic + reg[rrr]]);
910 else
911 ic += XINT (ccl_prog[ic + field1]);
912 break;
913
914 case CCL_ReadRegister: /* CCCCCCCCCCCCCCCCCCCCrrXXXXX */
915 while (1)
916 {
917 CCL_READ_CHAR (reg[rrr]);
918 if (!field1) break;
919 code = XINT (ccl_prog[ic]); ic++;
920 field1 = code >> 8;
921 field2 = (code & 0xFF) >> 5;
922 }
923 break;
924
925 case CCL_WriteExprConst: /* 1:00000OPERATION000RRR000XXXXX */
926 rrr = 7;
927 i = reg[RRR];
928 j = XINT (ccl_prog[ic]);
929 op = field1 >> 6;
930 ic++;
931 goto ccl_set_expr;
932
933 case CCL_WriteRegister: /* CCCCCCCCCCCCCCCCCCCrrrXXXXX */
934 while (1)
935 {
936 i = reg[rrr];
937 CCL_WRITE_CHAR (i);
938 if (!field1) break;
939 code = XINT (ccl_prog[ic]); ic++;
940 field1 = code >> 8;
941 field2 = (code & 0xFF) >> 5;
942 }
943 break;
944
945 case CCL_WriteExprRegister: /* 1:00000OPERATIONRrrRRR000XXXXX */
946 rrr = 7;
947 i = reg[RRR];
948 j = reg[Rrr];
949 op = field1 >> 6;
950 goto ccl_set_expr;
951
952 case CCL_Call: /* CCCCCCCCCCCCCCCCCCCC000XXXXX */
953 {
954 Lisp_Object slot;
955
956 if (stack_idx >= 256
957 || field1 < 0
958 || field1 >= XVECTOR_LENGTH (Vccl_program_table)
959 || (slot = XVECTOR_DATA (Vccl_program_table)[field1],
960 !CONSP (slot))
961 || !VECTORP (XCDR (slot)))
962 {
963 if (stack_idx > 0)
964 {
965 ccl_prog = ccl_prog_stack_struct[0].ccl_prog;
966 ic = ccl_prog_stack_struct[0].ic;
967 }
968 ccl->status = CCL_STAT_INVALID_CMD;
969 goto ccl_error_handler;
970 }
971
972 ccl_prog_stack_struct[stack_idx].ccl_prog = ccl_prog;
973 ccl_prog_stack_struct[stack_idx].ic = ic;
974 stack_idx++;
975 ccl_prog = XVECTOR_DATA (XCDR (slot));
976 ic = CCL_HEADER_MAIN;
977 }
978 break;
979
980 case CCL_WriteConstString: /* CCCCCCCCCCCCCCCCCCCCrrrXXXXX */
981 if (!rrr)
982 CCL_WRITE_CHAR (field1);
983 else
984 {
985 CCL_WRITE_STRING (field1);
986 ic += (field1 + 2) / 3;
987 }
988 break;
989
990 case CCL_WriteArray: /* CCCCCCCCCCCCCCCCCCCCrrrXXXXX */
991 i = reg[rrr];
992 if ((unsigned int) i < field1)
993 {
994 j = XINT (ccl_prog[ic + i]);
995 CCL_WRITE_CHAR (j);
996 }
997 ic += field1;
998 break;
999
1000 case CCL_End: /* 0000000000000000000000XXXXX */
1001 if (stack_idx-- > 0)
1002 {
1003 ccl_prog = ccl_prog_stack_struct[stack_idx].ccl_prog;
1004 ic = ccl_prog_stack_struct[stack_idx].ic;
1005 break;
1006 }
1007 if (src)
1008 src = src_end;
1009 /* ccl->ic should points to this command code again to
1010 suppress further processing. */
1011 ic--;
1012 /* Terminate CCL program successfully. */
1013 ccl->status = CCL_STAT_SUCCESS;
1014 goto ccl_finish;
1015
1016 case CCL_ExprSelfConst: /* 00000OPERATION000000rrrXXXXX */
1017 i = XINT (ccl_prog[ic]);
1018 ic++;
1019 op = field1 >> 6;
1020 goto ccl_expr_self;
1021
1022 case CCL_ExprSelfReg: /* 00000OPERATION000RRRrrrXXXXX */
1023 i = reg[RRR];
1024 op = field1 >> 6;
1025
1026 ccl_expr_self:
1027 switch (op)
1028 {
1029 case CCL_PLUS: reg[rrr] += i; break;
1030 case CCL_MINUS: reg[rrr] -= i; break;
1031 case CCL_MUL: reg[rrr] *= i; break;
1032 case CCL_DIV: reg[rrr] /= i; break;
1033 case CCL_MOD: reg[rrr] %= i; break;
1034 case CCL_AND: reg[rrr] &= i; break;
1035 case CCL_OR: reg[rrr] |= i; break;
1036 case CCL_XOR: reg[rrr] ^= i; break;
1037 case CCL_LSH: reg[rrr] <<= i; break;
1038 case CCL_RSH: reg[rrr] >>= i; break;
1039 case CCL_LSH8: reg[rrr] <<= 8; reg[rrr] |= i; break;
1040 case CCL_RSH8: reg[7] = reg[rrr] & 0xFF; reg[rrr] >>= 8; break;
1041 case CCL_DIVMOD: reg[7] = reg[rrr] % i; reg[rrr] /= i; break;
1042 case CCL_LS: reg[rrr] = reg[rrr] < i; break;
1043 case CCL_GT: reg[rrr] = reg[rrr] > i; break;
1044 case CCL_EQ: reg[rrr] = reg[rrr] == i; break;
1045 case CCL_LE: reg[rrr] = reg[rrr] <= i; break;
1046 case CCL_GE: reg[rrr] = reg[rrr] >= i; break;
1047 case CCL_NE: reg[rrr] = reg[rrr] != i; break;
1048 default:
1049 ccl->status = CCL_STAT_INVALID_CMD;
1050 goto ccl_error_handler;
1051 }
1052 break;
1053
1054 case CCL_SetExprConst: /* 00000OPERATION000RRRrrrXXXXX */
1055 i = reg[RRR];
1056 j = XINT (ccl_prog[ic]);
1057 op = field1 >> 6;
1058 jump_address = ++ic;
1059 goto ccl_set_expr;
1060
1061 case CCL_SetExprReg: /* 00000OPERATIONRrrRRRrrrXXXXX */
1062 i = reg[RRR];
1063 j = reg[Rrr];
1064 op = field1 >> 6;
1065 jump_address = ic;
1066 goto ccl_set_expr;
1067
1068 case CCL_ReadJumpCondExprConst: /* A--D--D--R--E--S--S-rrrXXXXX */
1069 CCL_READ_CHAR (reg[rrr]);
1070 case CCL_JumpCondExprConst: /* A--D--D--R--E--S--S-rrrXXXXX */
1071 i = reg[rrr];
1072 op = XINT (ccl_prog[ic]);
1073 jump_address = ic++ + ADDR;
1074 j = XINT (ccl_prog[ic]);
1075 ic++;
1076 rrr = 7;
1077 goto ccl_set_expr;
1078
1079 case CCL_ReadJumpCondExprReg: /* A--D--D--R--E--S--S-rrrXXXXX */
1080 CCL_READ_CHAR (reg[rrr]);
1081 case CCL_JumpCondExprReg:
1082 i = reg[rrr];
1083 op = XINT (ccl_prog[ic]);
1084 jump_address = ic++ + ADDR;
1085 j = reg[XINT (ccl_prog[ic])];
1086 ic++;
1087 rrr = 7;
1088
1089 ccl_set_expr:
1090 switch (op)
1091 {
1092 case CCL_PLUS: reg[rrr] = i + j; break;
1093 case CCL_MINUS: reg[rrr] = i - j; break;
1094 case CCL_MUL: reg[rrr] = i * j; break;
1095 case CCL_DIV: reg[rrr] = i / j; break;
1096 case CCL_MOD: reg[rrr] = i % j; break;
1097 case CCL_AND: reg[rrr] = i & j; break;
1098 case CCL_OR: reg[rrr] = i | j; break;
1099 case CCL_XOR: reg[rrr] = i ^ j; break;
1100 case CCL_LSH: reg[rrr] = i << j; break;
1101 case CCL_RSH: reg[rrr] = i >> j; break;
1102 case CCL_LSH8: reg[rrr] = (i << 8) | j; break;
1103 case CCL_RSH8: reg[rrr] = i >> 8; reg[7] = i & 0xFF; break;
1104 case CCL_DIVMOD: reg[rrr] = i / j; reg[7] = i % j; break;
1105 case CCL_LS: reg[rrr] = i < j; break;
1106 case CCL_GT: reg[rrr] = i > j; break;
1107 case CCL_EQ: reg[rrr] = i == j; break;
1108 case CCL_LE: reg[rrr] = i <= j; break;
1109 case CCL_GE: reg[rrr] = i >= j; break;
1110 case CCL_NE: reg[rrr] = i != j; break;
1111 case CCL_DECODE_SJIS: DECODE_SJIS (i, j, reg[rrr], reg[7]); break;
1112 case CCL_ENCODE_SJIS: ENCODE_SJIS (i, j, reg[rrr], reg[7]); break;
1113 default:
1114 ccl->status = CCL_STAT_INVALID_CMD;
1115 goto ccl_error_handler;
1116 }
1117 code &= 0x1F;
1118 if (code == CCL_WriteExprConst || code == CCL_WriteExprRegister)
1119 {
1120 i = reg[rrr];
1121 CCL_WRITE_CHAR (i);
1122 }
1123 else if (!reg[rrr])
1124 ic = jump_address;
1125 break;
1126
1127 case CCL_Extention:
1128 switch (EXCMD)
1129 {
1130 case CCL_ReadMultibyteChar2:
1131 if (!src)
1132 CCL_INVALID_CMD;
1133
1134 do {
1135 if (src >= src_end)
1136 {
1137 src++;
1138 goto ccl_read_multibyte_character_suspend;
1139 }
1140
1141 i = *src++;
1142 #if 0
1143 if (i == LEADING_CODE_COMPOSITION)
1144 {
1145 if (src >= src_end)
1146 goto ccl_read_multibyte_character_suspend;
1147 if (*src == 0xFF)
1148 {
1149 ccl->private_state = COMPOSING_WITH_RULE_HEAD;
1150 src++;
1151 }
1152 else
1153 ccl->private_state = COMPOSING_NO_RULE_HEAD;
1154
1155 continue;
1156 }
1157 if (ccl->private_state != COMPOSING_NO)
1158 {
1159 /* composite character */
1160 if (i < 0xA0)
1161 ccl->private_state = COMPOSING_NO;
1162 else
1163 {
1164 if (COMPOSING_WITH_RULE_RULE == ccl->private_state)
1165 {
1166 ccl->private_state = COMPOSING_WITH_RULE_HEAD;
1167 continue;
1168 }
1169 else if (COMPOSING_WITH_RULE_HEAD == ccl->private_state)
1170 ccl->private_state = COMPOSING_WITH_RULE_RULE;
1171
1172 if (i == 0xA0)
1173 {
1174 if (src >= src_end)
1175 goto ccl_read_multibyte_character_suspend;
1176 i = *src++ & 0x7F;
1177 }
1178 else
1179 i -= 0x20;
1180 }
1181 }
1182 #endif
1183
1184 if (i < 0x80)
1185 {
1186 /* ASCII */
1187 reg[rrr] = i;
1188 reg[RRR] = LEADING_BYTE_ASCII;
1189 }
1190 else if (i <= MAX_LEADING_BYTE_OFFICIAL_1)
1191 {
1192 if (src >= src_end)
1193 goto ccl_read_multibyte_character_suspend;
1194 reg[RRR] = i;
1195 reg[rrr] = (*src++ & 0x7F);
1196 }
1197 else if (i <= MAX_LEADING_BYTE_OFFICIAL_2)
1198 {
1199 if ((src + 1) >= src_end)
1200 goto ccl_read_multibyte_character_suspend;
1201 reg[RRR] = i;
1202 i = (*src++ & 0x7F);
1203 reg[rrr] = ((i << 7) | (*src & 0x7F));
1204 src++;
1205 }
1206 else if (i == PRE_LEADING_BYTE_PRIVATE_1)
1207 {
1208 if ((src + 1) >= src_end)
1209 goto ccl_read_multibyte_character_suspend;
1210 reg[RRR] = *src++;
1211 reg[rrr] = (*src++ & 0x7F);
1212 }
1213 else if (i == PRE_LEADING_BYTE_PRIVATE_2)
1214 {
1215 if ((src + 2) >= src_end)
1216 goto ccl_read_multibyte_character_suspend;
1217 reg[RRR] = *src++;
1218 i = (*src++ & 0x7F);
1219 reg[rrr] = ((i << 7) | (*src & 0x7F));
1220 src++;
1221 }
1222 else
1223 {
1224 /* INVALID CODE. Return a single byte character. */
1225 reg[RRR] = LEADING_BYTE_ASCII;
1226 reg[rrr] = i;
1227 }
1228 break;
1229 } while (1);
1230 break;
1231
1232 ccl_read_multibyte_character_suspend:
1233 src--;
1234 if (ccl->last_block)
1235 {
1236 ic = ccl->eof_ic;
1237 goto ccl_repeat;
1238 }
1239 else
1240 CCL_SUSPEND (CCL_STAT_SUSPEND_BY_SRC);
1241
1242 break;
1243
1244 case CCL_WriteMultibyteChar2:
1245 i = reg[RRR]; /* charset */
1246 if (i == LEADING_BYTE_ASCII)
1247 i = reg[rrr] & 0xFF;
1248 #if 0
1249 else if (i == CHARSET_COMPOSITION)
1250 i = MAKE_COMPOSITE_CHAR (reg[rrr]);
1251 #endif
1252 else if (XCHARSET_DIMENSION (CHARSET_BY_LEADING_BYTE (i)) == 1)
1253 i = ((i - FIELD2_TO_OFFICIAL_LEADING_BYTE) << 7)
1254 | (reg[rrr] & 0x7F);
1255 else if (i < MIN_LEADING_BYTE_OFFICIAL_2)
1256 i = ((i - FIELD1_TO_OFFICIAL_LEADING_BYTE) << 14) | reg[rrr];
1257 else
1258 i = ((i - FIELD1_TO_PRIVATE_LEADING_BYTE) << 14) | reg[rrr];
1259
1260 CCL_WRITE_CHAR (i);
1261
1262 break;
1263
1264 #if 0
1265 case CCL_TranslateCharacter:
1266 i = reg[RRR]; /* charset */
1267 if (i == LEADING_BYTE_ASCII)
1268 i = reg[rrr];
1269 else if (i == CHARSET_COMPOSITION)
1270 {
1271 reg[RRR] = -1;
1272 break;
1273 }
1274 else if (CHARSET_DIMENSION (i) == 1)
1275 i = ((i - 0x70) << 7) | (reg[rrr] & 0x7F);
1276 else if (i < MIN_LEADING_BYTE_OFFICIAL_2)
1277 i = ((i - 0x8F) << 14) | (reg[rrr] & 0x3FFF);
1278 else
1279 i = ((i - 0xE0) << 14) | (reg[rrr] & 0x3FFF);
1280
1281 op = translate_char (GET_TRANSLATION_TABLE (reg[Rrr]),
1282 i, -1, 0, 0);
1283 SPLIT_CHAR (op, reg[RRR], i, j);
1284 if (j != -1)
1285 i = (i << 7) | j;
1286
1287 reg[rrr] = i;
1288 break;
1289
1290 case CCL_TranslateCharacterConstTbl:
1291 op = XINT (ccl_prog[ic]); /* table */
1292 ic++;
1293 i = reg[RRR]; /* charset */
1294 if (i == LEADING_BYTE_ASCII)
1295 i = reg[rrr];
1296 else if (i == CHARSET_COMPOSITION)
1297 {
1298 reg[RRR] = -1;
1299 break;
1300 }
1301 else if (CHARSET_DIMENSION (i) == 1)
1302 i = ((i - 0x70) << 7) | (reg[rrr] & 0x7F);
1303 else if (i < MIN_LEADING_BYTE_OFFICIAL_2)
1304 i = ((i - 0x8F) << 14) | (reg[rrr] & 0x3FFF);
1305 else
1306 i = ((i - 0xE0) << 14) | (reg[rrr] & 0x3FFF);
1307
1308 op = translate_char (GET_TRANSLATION_TABLE (op), i, -1, 0, 0);
1309 SPLIT_CHAR (op, reg[RRR], i, j);
1310 if (j != -1)
1311 i = (i << 7) | j;
1312
1313 reg[rrr] = i;
1314 break;
1315
1316 case CCL_IterateMultipleMap:
1317 {
1318 Lisp_Object map, content, attrib, value;
1319 int point, size, fin_ic;
1320
1321 j = XINT (ccl_prog[ic++]); /* number of maps. */
1322 fin_ic = ic + j;
1323 op = reg[rrr];
1324 if ((j > reg[RRR]) && (j >= 0))
1325 {
1326 ic += reg[RRR];
1327 i = reg[RRR];
1328 }
1329 else
1330 {
1331 reg[RRR] = -1;
1332 ic = fin_ic;
1333 break;
1334 }
1335
1336 for (;i < j;i++)
1337 {
1338
1339 size = XVECTOR (Vcode_conversion_map_vector)->size;
1340 point = XINT (ccl_prog[ic++]);
1341 if (point >= size) continue;
1342 map =
1343 XVECTOR (Vcode_conversion_map_vector)->contents[point];
1344
1345 /* Check map varidity. */
1346 if (!CONSP (map)) continue;
1347 map = XCONS(map)->cdr;
1348 if (!VECTORP (map)) continue;
1349 size = XVECTOR (map)->size;
1350 if (size <= 1) continue;
1351
1352 content = XVECTOR (map)->contents[0];
1353
1354 /* check map type,
1355 [STARTPOINT VAL1 VAL2 ...] or
1356 [t ELELMENT STARTPOINT ENDPOINT] */
1357 if (NUMBERP (content))
1358 {
1359 point = XUINT (content);
1360 point = op - point + 1;
1361 if (!((point >= 1) && (point < size))) continue;
1362 content = XVECTOR (map)->contents[point];
1363 }
1364 else if (EQ (content, Qt))
1365 {
1366 if (size != 4) continue;
1367 if ((op >= XUINT (XVECTOR (map)->contents[2]))
1368 && (op < XUINT (XVECTOR (map)->contents[3])))
1369 content = XVECTOR (map)->contents[1];
1370 else
1371 continue;
1372 }
1373 else
1374 continue;
1375
1376 if (NILP (content))
1377 continue;
1378 else if (NUMBERP (content))
1379 {
1380 reg[RRR] = i;
1381 reg[rrr] = XINT(content);
1382 break;
1383 }
1384 else if (EQ (content, Qt) || EQ (content, Qlambda))
1385 {
1386 reg[RRR] = i;
1387 break;
1388 }
1389 else if (CONSP (content))
1390 {
1391 attrib = XCONS (content)->car;
1392 value = XCONS (content)->cdr;
1393 if (!NUMBERP (attrib) || !NUMBERP (value))
1394 continue;
1395 reg[RRR] = i;
1396 reg[rrr] = XUINT (value);
1397 break;
1398 }
1399 }
1400 if (i == j)
1401 reg[RRR] = -1;
1402 ic = fin_ic;
1403 }
1404 break;
1405
1406 case CCL_MapMultiple:
1407 {
1408 Lisp_Object map, content, attrib, value;
1409 int point, size, map_vector_size;
1410 int map_set_rest_length, fin_ic;
1411
1412 map_set_rest_length =
1413 XINT (ccl_prog[ic++]); /* number of maps and separators. */
1414 fin_ic = ic + map_set_rest_length;
1415 if ((map_set_rest_length > reg[RRR]) && (reg[RRR] >= 0))
1416 {
1417 ic += reg[RRR];
1418 i = reg[RRR];
1419 map_set_rest_length -= i;
1420 }
1421 else
1422 {
1423 ic = fin_ic;
1424 reg[RRR] = -1;
1425 break;
1426 }
1427 mapping_stack_pointer = mapping_stack;
1428 op = reg[rrr];
1429 PUSH_MAPPING_STACK (0, op);
1430 reg[RRR] = -1;
1431 map_vector_size = XVECTOR (Vcode_conversion_map_vector)->size;
1432 for (;map_set_rest_length > 0;i++, map_set_rest_length--)
1433 {
1434 point = XINT(ccl_prog[ic++]);
1435 if (point < 0)
1436 {
1437 point = -point;
1438 if (mapping_stack_pointer
1439 >= &mapping_stack[MAX_MAP_SET_LEVEL])
1440 {
1441 CCL_INVALID_CMD;
1442 }
1443 PUSH_MAPPING_STACK (map_set_rest_length - point,
1444 reg[rrr]);
1445 map_set_rest_length = point + 1;
1446 reg[rrr] = op;
1447 continue;
1448 }
1449
1450 if (point >= map_vector_size) continue;
1451 map = (XVECTOR (Vcode_conversion_map_vector)
1452 ->contents[point]);
1453
1454 /* Check map varidity. */
1455 if (!CONSP (map)) continue;
1456 map = XCONS (map)->cdr;
1457 if (!VECTORP (map)) continue;
1458 size = XVECTOR (map)->size;
1459 if (size <= 1) continue;
1460
1461 content = XVECTOR (map)->contents[0];
1462
1463 /* check map type,
1464 [STARTPOINT VAL1 VAL2 ...] or
1465 [t ELEMENT STARTPOINT ENDPOINT] */
1466 if (NUMBERP (content))
1467 {
1468 point = XUINT (content);
1469 point = op - point + 1;
1470 if (!((point >= 1) && (point < size))) continue;
1471 content = XVECTOR (map)->contents[point];
1472 }
1473 else if (EQ (content, Qt))
1474 {
1475 if (size != 4) continue;
1476 if ((op >= XUINT (XVECTOR (map)->contents[2])) &&
1477 (op < XUINT (XVECTOR (map)->contents[3])))
1478 content = XVECTOR (map)->contents[1];
1479 else
1480 continue;
1481 }
1482 else
1483 continue;
1484
1485 if (NILP (content))
1486 continue;
1487 else if (NUMBERP (content))
1488 {
1489 op = XINT (content);
1490 reg[RRR] = i;
1491 i += map_set_rest_length;
1492 POP_MAPPING_STACK (map_set_rest_length, reg[rrr]);
1493 }
1494 else if (CONSP (content))
1495 {
1496 attrib = XCONS (content)->car;
1497 value = XCONS (content)->cdr;
1498 if (!NUMBERP (attrib) || !NUMBERP (value))
1499 continue;
1500 reg[RRR] = i;
1501 op = XUINT (value);
1502 i += map_set_rest_length;
1503 POP_MAPPING_STACK (map_set_rest_length, reg[rrr]);
1504 }
1505 else if (EQ (content, Qt))
1506 {
1507 reg[RRR] = i;
1508 op = reg[rrr];
1509 i += map_set_rest_length;
1510 POP_MAPPING_STACK (map_set_rest_length, reg[rrr]);
1511 }
1512 else if (EQ (content, Qlambda))
1513 {
1514 break;
1515 }
1516 else
1517 CCL_INVALID_CMD;
1518 }
1519 ic = fin_ic;
1520 }
1521 reg[rrr] = op;
1522 break;
1523
1524 case CCL_MapSingle:
1525 {
1526 Lisp_Object map, attrib, value, content;
1527 int size, point;
1528 j = XINT (ccl_prog[ic++]); /* map_id */
1529 op = reg[rrr];
1530 if (j >= XVECTOR (Vcode_conversion_map_vector)->size)
1531 {
1532 reg[RRR] = -1;
1533 break;
1534 }
1535 map = XVECTOR (Vcode_conversion_map_vector)->contents[j];
1536 if (!CONSP (map))
1537 {
1538 reg[RRR] = -1;
1539 break;
1540 }
1541 map = XCONS(map)->cdr;
1542 if (!VECTORP (map))
1543 {
1544 reg[RRR] = -1;
1545 break;
1546 }
1547 size = XVECTOR (map)->size;
1548 point = XUINT (XVECTOR (map)->contents[0]);
1549 point = op - point + 1;
1550 reg[RRR] = 0;
1551 if ((size <= 1) ||
1552 (!((point >= 1) && (point < size))))
1553 reg[RRR] = -1;
1554 else
1555 {
1556 content = XVECTOR (map)->contents[point];
1557 if (NILP (content))
1558 reg[RRR] = -1;
1559 else if (NUMBERP (content))
1560 reg[rrr] = XINT (content);
1561 else if (EQ (content, Qt))
1562 reg[RRR] = i;
1563 else if (CONSP (content))
1564 {
1565 attrib = XCONS (content)->car;
1566 value = XCONS (content)->cdr;
1567 if (!NUMBERP (attrib) || !NUMBERP (value))
1568 continue;
1569 reg[rrr] = XUINT(value);
1570 break;
1571 }
1572 else
1573 reg[RRR] = -1;
1574 }
1575 }
1576 break;
1577 #endif
1578
1579 default:
1580 CCL_INVALID_CMD;
1581 }
1582 break;
1583
1584 default:
1585 ccl->status = CCL_STAT_INVALID_CMD;
1586 goto ccl_error_handler;
1587 }
1588 }
1589
1590 ccl_error_handler:
1591 if (destination)
1592 {
1593 /* We can insert an error message only if DESTINATION is
1594 specified and we still have a room to store the message
1595 there. */
1596 char msg[256];
1597
1598 #if 0 /* not for XEmacs ? */
1599 if (!dst)
1600 dst = destination;
1601 #endif
1602
1603 switch (ccl->status)
1604 {
1605 /* Terminate CCL program because of invalid command.
1606 Should not occur in the normal case. */
1607 case CCL_STAT_INVALID_CMD:
1608 sprintf(msg, "\nCCL: Invalid command %x (ccl_code = %x) at %d.",
1609 code & 0x1F, code, this_ic);
1610 #ifdef CCL_DEBUG
1611 {
1612 int i = ccl_backtrace_idx - 1;
1613 int j;
1614
1615 Dynarr_add_many (destination, (unsigned char *) msg, strlen (msg));
1616
1617 for (j = 0; j < CCL_DEBUG_BACKTRACE_LEN; j++, i--)
1618 {
1619 if (i < 0) i = CCL_DEBUG_BACKTRACE_LEN - 1;
1620 if (ccl_backtrace_table[i] == 0)
1621 break;
1622 sprintf(msg, " %d", ccl_backtrace_table[i]);
1623 Dynarr_add_many (destination, (unsigned char *) msg, strlen (msg));
1624 }
1625 goto ccl_finish;
1626 }
1627 #endif
1628 break;
1629
1630 case CCL_STAT_QUIT:
1631 sprintf(msg, "\nCCL: Quited.");
1632 break;
1633
1634 default:
1635 sprintf(msg, "\nCCL: Unknown error type (%d).", ccl->status);
1636 }
1637
1638 Dynarr_add_many (destination, (unsigned char *) msg, strlen (msg));
1639 }
1640
1641 ccl_finish:
1642 ccl->ic = ic;
1643 ccl->stack_idx = stack_idx;
1644 ccl->prog = ccl_prog;
1645 if (consumed) *consumed = src - source;
1646 if (destination)
1647 return Dynarr_length (destination);
1648 else
1649 return 0;
1650 }
1651
1652 /* Setup fields of the structure pointed by CCL appropriately for the
1653 execution of compiled CCL code in VEC (vector of integer).
1654 If VEC is nil, we skip setting ups based on VEC. */
1655 void
1656 setup_ccl_program (struct ccl_program *ccl, Lisp_Object vec)
1657 {
1658 int i;
1659
1660 if (VECTORP (vec))
1661 {
1662 ccl->size = XVECTOR_LENGTH (vec);
1663 ccl->prog = XVECTOR_DATA (vec);
1664 ccl->eof_ic = XINT (XVECTOR_DATA (vec)[CCL_HEADER_EOF]);
1665 ccl->buf_magnification = XINT (XVECTOR_DATA (vec)[CCL_HEADER_BUF_MAG]);
1666 }
1667 ccl->ic = CCL_HEADER_MAIN;
1668 for (i = 0; i < 8; i++)
1669 ccl->reg[i] = 0;
1670 ccl->last_block = 0;
1671 ccl->private_state = 0;
1672 ccl->status = 0;
1673 ccl->stack_idx = 0;
1674 }
1675
1676 /* Resolve symbols in the specified CCL code (Lisp vector). This
1677 function converts symbols of code conversion maps and character
1678 translation tables embeded in the CCL code into their ID numbers. */
1679
1680 static Lisp_Object
1681 resolve_symbol_ccl_program (Lisp_Object ccl)
1682 {
1683 int i, veclen;
1684 Lisp_Object result, contents /*, prop */;
1685
1686 result = ccl;
1687 veclen = XVECTOR_LENGTH (result);
1688
1689 /* Set CCL program's table ID */
1690 for (i = 0; i < veclen; i++)
1691 {
1692 contents = XVECTOR_DATA (result)[i];
1693 if (SYMBOLP (contents))
1694 {
1695 if (EQ(result, ccl))
1696 result = Fcopy_sequence (ccl);
1697
1698 #if 0
1699 prop = Fget (contents, Qtranslation_table_id);
1700 if (NUMBERP (prop))
1701 {
1702 XVECTOR_DATA (result)[i] = prop;
1703 continue;
1704 }
1705 prop = Fget (contents, Qcode_conversion_map_id);
1706 if (NUMBERP (prop))
1707 {
1708 XVECTOR_DATA (result)[i] = prop;
1709 continue;
1710 }
1711 prop = Fget (contents, Qccl_program_idx);
1712 if (NUMBERP (prop))
1713 {
1714 XVECTOR_DATA (result)[i] = prop;
1715 continue;
1716 }
1717 #endif
1718 }
1719 }
1720
1721 return result;
1722 }
1723
1724
1725 #ifdef emacs
1726
1727 DEFUN ("ccl-execute", Fccl_execute, 2, 2, 0, /*
1728 Execute CCL-PROGRAM with registers initialized by REGISTERS.
1729
1730 CCL-PROGRAM is a symbol registered by register-ccl-program,
1731 or a compiled code generated by `ccl-compile' (for backward compatibility,
1732 in this case, the execution is slower).
1733 No I/O commands should appear in CCL-PROGRAM.
1734
1735 REGISTERS is a vector of [R0 R1 ... R7] where RN is an initial value
1736 of Nth register.
1737
1738 As side effect, each element of REGISTER holds the value of
1739 corresponding register after the execution.
1740 */
1741 (ccl_prog, reg))
1742 {
1743 struct ccl_program ccl;
1744 int i;
1745 Lisp_Object ccl_id;
1746
1747 if (SYMBOLP (ccl_prog) &&
1748 !NILP (ccl_id = Fget (ccl_prog, Qccl_program_idx, Qnil)))
1749 {
1750 ccl_prog = XVECTOR_DATA (Vccl_program_table)[XUINT (ccl_id)];
1751 CHECK_LIST (ccl_prog);
1752 ccl_prog = XCDR (ccl_prog);
1753 CHECK_VECTOR (ccl_prog);
1754 }
1755 else
1756 {
1757 CHECK_VECTOR (ccl_prog);
1758 ccl_prog = resolve_symbol_ccl_program (ccl_prog);
1759 }
1760
1761 CHECK_VECTOR (reg);
1762 if (XVECTOR_LENGTH (reg) != 8)
1763 error ("Invalid length of vector REGISTERS");
1764
1765 setup_ccl_program (&ccl, ccl_prog);
1766 for (i = 0; i < 8; i++)
1767 ccl.reg[i] = (INTP (XVECTOR_DATA (reg)[i])
1768 ? XINT (XVECTOR_DATA (reg)[i])
1769 : 0);
1770
1771 ccl_driver (&ccl, (CONST unsigned char *)0, (unsigned_char_dynarr *)0,
1772 0, (int *)0, CCL_MODE_ENCODING);
1773 QUIT;
1774 if (ccl.status != CCL_STAT_SUCCESS)
1775 error ("Error in CCL program at %dth code", ccl.ic);
1776
1777 for (i = 0; i < 8; i++)
1778 XSETINT (XVECTOR_DATA (reg)[i], ccl.reg[i]);
1779 return Qnil;
1780 }
1781
1782 DEFUN ("ccl-execute-on-string", Fccl_execute_on_string, 3, 4, 0, /*
1783 Execute CCL-PROGRAM with initial STATUS on STRING.
1784
1785 CCL-PROGRAM is a symbol registered by register-ccl-program,
1786 or a compiled code generated by `ccl-compile' (for backward compatibility,
1787 in this case, the execution is slower).
1788
1789 Read buffer is set to STRING, and write buffer is allocated automatically.
1790
1791 If IC is nil, it is initialized to head of the CCL program.\n\
1792 STATUS is a vector of [R0 R1 ... R7 IC], where
1793 R0..R7 are initial values of corresponding registers,
1794 IC is the instruction counter specifying from where to start the program.
1795 If R0..R7 are nil, they are initialized to 0.
1796 If IC is nil, it is initialized to head of the CCL program.
1797
1798 If optional 4th arg CONTINUE is non-nil, keep IC on read operation
1799 when read buffer is exausted, else, IC is always set to the end of
1800 CCL-PROGRAM on exit.
1801
1802 It returns the contents of write buffer as a string,
1803 and as side effect, STATUS is updated.
1804 */
1805 (ccl_prog, status, str, contin))
1806 {
1807 Lisp_Object val;
1808 struct ccl_program ccl;
1809 int i, produced;
1810 unsigned_char_dynarr *outbuf;
1811 struct gcpro gcpro1, gcpro2, gcpro3;
1812 Lisp_Object ccl_id;
1813
1814 if (SYMBOLP (ccl_prog) &&
1815 !NILP (ccl_id = Fget (ccl_prog, Qccl_program_idx, Qnil)))
1816 {
1817 ccl_prog = XVECTOR (Vccl_program_table)->contents[XUINT (ccl_id)];
1818 CHECK_LIST (ccl_prog);
1819 ccl_prog = XCDR (ccl_prog);
1820 CHECK_VECTOR (ccl_prog);
1821 }
1822 else
1823 {
1824 CHECK_VECTOR (ccl_prog);
1825 ccl_prog = resolve_symbol_ccl_program (ccl_prog);
1826 }
1827
1828 CHECK_VECTOR (status);
1829 if (XVECTOR_LENGTH (status) != 9)
1830 signal_simple_error ("Vector should be of length 9", status);
1831 CHECK_STRING (str);
1832 GCPRO3 (ccl_prog, status, str);
1833
1834 setup_ccl_program (&ccl, ccl_prog);
1835 for (i = 0; i < 8; i++)
1836 {
1837 if (NILP (XVECTOR_DATA (status)[i]))
1838 XSETINT (XVECTOR_DATA (status)[i], 0);
1839 if (INTP (XVECTOR_DATA (status)[i]))
1840 ccl.reg[i] = XINT (XVECTOR_DATA (status)[i]);
1841 }
1842 if (INTP (XVECTOR_DATA (status)[8]))
1843 {
1844 i = XINT (XVECTOR_DATA (status)[8]);
1845 if (ccl.ic < i && i < ccl.size)
1846 ccl.ic = i;
1847 }
1848 outbuf = Dynarr_new (unsigned_char);
1849 ccl.last_block = NILP (contin);
1850 produced = ccl_driver (&ccl, XSTRING_DATA (str), outbuf,
1851 XSTRING_LENGTH (str), (int *)0, CCL_MODE_DECODING);
1852 for (i = 0; i < 8; i++)
1853 XVECTOR_DATA (status)[i] = make_int(ccl.reg[i]);
1854 XSETINT (XVECTOR_DATA (status)[8], ccl.ic);
1855 UNGCPRO;
1856
1857 val = make_string (Dynarr_atp (outbuf, 0), produced);
1858 Dynarr_free (outbuf);
1859 QUIT;
1860 if (ccl.status != CCL_STAT_SUCCESS
1861 && ccl.status != CCL_STAT_SUSPEND_BY_SRC
1862 && ccl.status != CCL_STAT_SUSPEND_BY_DST)
1863 error ("Error in CCL program at %dth code", ccl.ic);
1864
1865 return val;
1866 }
1867
1868 DEFUN ("register-ccl-program", Fregister_ccl_program, 2, 2, 0, /*
1869 Register CCL program PROGRAM of NAME in `ccl-program-table'.
1870 PROGRAM should be a compiled code of CCL program, or nil.
1871 Return index number of the registered CCL program.
1872 */
1873 (name, ccl_prog))
1874 {
1875 int len = XVECTOR_LENGTH (Vccl_program_table);
1876 int i;
1877
1878 CHECK_SYMBOL (name);
1879 if (!NILP (ccl_prog))
1880 {
1881 CHECK_VECTOR (ccl_prog);
1882 ccl_prog = resolve_symbol_ccl_program (ccl_prog);
1883 }
1884
1885 for (i = 0; i < len; i++)
1886 {
1887 Lisp_Object slot = XVECTOR_DATA (Vccl_program_table)[i];
1888
1889 if (!CONSP (slot))
1890 break;
1891
1892 if (EQ (name, XCAR (slot)))
1893 {
1894 XCDR (slot) = ccl_prog;
1895 return make_int (i);
1896 }
1897 }
1898
1899 if (i == len)
1900 {
1901 Lisp_Object new_table = Fmake_vector (make_int (len * 2), Qnil);
1902 int j;
1903
1904 for (j = 0; j < len; j++)
1905 XVECTOR_DATA (new_table)[j]
1906 = XVECTOR_DATA (Vccl_program_table)[j];
1907 Vccl_program_table = new_table;
1908 }
1909
1910 XVECTOR_DATA (Vccl_program_table)[i] = Fcons (name, ccl_prog);
1911 Fput (name, Qccl_program_idx, make_int (i));
1912 return make_int (i);
1913 }
1914
1915 #if 0
1916 /* Register code conversion map.
1917 A code conversion map consists of numbers, Qt, Qnil, and Qlambda.
1918 The first element is start code point.
1919 The rest elements are mapped numbers.
1920 Symbol t means to map to an original number before mapping.
1921 Symbol nil means that the corresponding element is empty.
1922 Symbol lambda menas to terminate mapping here.
1923 */
1924
1925 DEFUN ("register-code-conversion-map", Fregister_code_conversion_map,
1926 Sregister_code_conversion_map,
1927 2, 2, 0,
1928 "Register SYMBOL as code conversion map MAP.\n\
1929 Return index number of the registered map.")
1930 (symbol, map)
1931 Lisp_Object symbol, map;
1932 {
1933 int len = XVECTOR (Vcode_conversion_map_vector)->size;
1934 int i;
1935 Lisp_Object index;
1936
1937 CHECK_SYMBOL (symbol, 0);
1938 CHECK_VECTOR (map, 1);
1939
1940 for (i = 0; i < len; i++)
1941 {
1942 Lisp_Object slot = XVECTOR (Vcode_conversion_map_vector)->contents[i];
1943
1944 if (!CONSP (slot))
1945 break;
1946
1947 if (EQ (symbol, XCONS (slot)->car))
1948 {
1949 index = make_int (i);
1950 XCONS (slot)->cdr = map;
1951 Fput (symbol, Qcode_conversion_map, map);
1952 Fput (symbol, Qcode_conversion_map_id, index);
1953 return index;
1954 }
1955 }
1956
1957 if (i == len)
1958 {
1959 Lisp_Object new_vector = Fmake_vector (make_int (len * 2), Qnil);
1960 int j;
1961
1962 for (j = 0; j < len; j++)
1963 XVECTOR (new_vector)->contents[j]
1964 = XVECTOR (Vcode_conversion_map_vector)->contents[j];
1965 Vcode_conversion_map_vector = new_vector;
1966 }
1967
1968 index = make_int (i);
1969 Fput (symbol, Qcode_conversion_map, map);
1970 Fput (symbol, Qcode_conversion_map_id, index);
1971 XVECTOR (Vcode_conversion_map_vector)->contents[i] = Fcons (symbol, map);
1972 return index;
1973 }
1974 #endif
1975
1976
1977 void
1978 syms_of_mule_ccl (void)
1979 {
1980 DEFSUBR (Fccl_execute);
1981 DEFSUBR (Fccl_execute_on_string);
1982 DEFSUBR (Fregister_ccl_program);
1983 #if 0
1984 DEFSUBR (&Fregister_code_conversion_map);
1985 #endif
1986 }
1987
1988 void
1989 vars_of_mule_ccl (void)
1990 {
1991 staticpro (&Vccl_program_table);
1992 Vccl_program_table = Fmake_vector (make_int (32), Qnil);
1993
1994 Qccl_program = intern ("ccl-program");
1995 staticpro (&Qccl_program);
1996
1997 Qccl_program_idx = intern ("ccl-program-idx");
1998 staticpro (&Qccl_program_idx);
1999
2000 #if 0
2001 Qcode_conversion_map = intern ("code-conversion-map");
2002 staticpro (&Qcode_conversion_map);
2003
2004 Qcode_conversion_map_id = intern ("code-conversion-map-id");
2005 staticpro (&Qcode_conversion_map_id);
2006
2007 DEFVAR_LISP ("code-conversion-map-vector", &Vcode_conversion_map_vector /*
2008 Vector of code conversion maps.*/ );
2009 Vcode_conversion_map_vector = Fmake_vector (make_int (16), Qnil);
2010 #endif
2011
2012 DEFVAR_LISP ("font-ccl-encoder-alist", &Vfont_ccl_encoder_alist /*
2013 Alist of fontname patterns vs corresponding CCL program.
2014 Each element looks like (REGEXP . CCL-CODE),
2015 where CCL-CODE is a compiled CCL program.
2016 When a font whose name matches REGEXP is used for displaying a character,
2017 CCL-CODE is executed to calculate the code point in the font
2018 from the charset number and position code(s) of the character which are set
2019 in CCL registers R0, R1, and R2 before the execution.
2020 The code point in the font is set in CCL registers R1 and R2
2021 when the execution terminated.
2022 If the font is single-byte font, the register R2 is not used.
2023 */ );
2024 Vfont_ccl_encoder_alist = Qnil;
2025 }
2026
2027 #endif /* emacs */