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