Mercurial > hg > xemacs-beta

comparison src/mule-ccl.c @ 398:74fd4e045ea6 r21-2-29

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r21-2-29
author cvs
date Mon, 13 Aug 2007 11:13:30 +0200
parents 8626e4521993
children 697ef44129c6
comparison
equal deleted inserted replaced
397:f4aeb21a5bad 398:74fd4e045ea6
1 /* CCL (Code Conversion Language) interpreter. 1 /* CCL (Code Conversion Language) interpreter.
2 Copyright (C) 1995, 1997 Electrotechnical Laboratory, JAPAN. 2 Copyright (C) 1995, 1997, 1998, 1999 Electrotechnical Laboratory, JAPAN.
3 Licensed to the Free Software Foundation. 3 Licensed to the Free Software Foundation.
4 4
5 This file is part of XEmacs. 5 This file is part of XEmacs.
6 6
7 GNU Emacs is free software; you can redistribute it and/or modify 7 GNU Emacs is free software; you can redistribute it and/or modify
17 You should have received a copy of the GNU General Public License 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 18 along with GNU Emacs; see the file COPYING. If not, write to
19 the Free Software Foundation, Inc., 59 Temple Place - Suite 330, 19 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
20 Boston, MA 02111-1307, USA. */ 20 Boston, MA 02111-1307, USA. */
21 21
22 /* Synched up with : FSF Emacs 20.2 */ 22 /* Synched up with : FSF Emacs 20.3.10 without ExCCL
23 * (including {Read|Write}MultibyteChar) */
23 24
24 #ifdef emacs 25 #ifdef emacs
25 26
26 #include <config.h> 27 #include <config.h>
28
29 #if 0
30 #ifdef STDC_HEADERS
31 #include <stdlib.h>
32 #endif
33 #endif
34
27 #include "lisp.h" 35 #include "lisp.h"
28 #include "buffer.h" 36 #include "buffer.h"
29 #include "mule-charset.h" 37 #include "mule-charset.h"
30 #include "mule-ccl.h" 38 #include "mule-ccl.h"
31 #include "file-coding.h" 39 #include "file-coding.h"
35 #include <stdio.h> 43 #include <stdio.h>
36 #include "mulelib.h" 44 #include "mulelib.h"
37 45
38 #endif /* not emacs */ 46 #endif /* not emacs */
39 47
48 /* This contains all code conversion map available to CCL. */
49 /*
50 Lisp_Object Vcode_conversion_map_vector;
51 */
52
40 /* Alist of fontname patterns vs corresponding CCL program. */ 53 /* Alist of fontname patterns vs corresponding CCL program. */
41 Lisp_Object Vfont_ccl_encoder_alist; 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;
42 70
43 /* Vector of CCL program names vs corresponding program data. */ 71 /* Vector of CCL program names vs corresponding program data. */
44 Lisp_Object Vccl_program_table; 72 Lisp_Object Vccl_program_table;
45 73
46 /* CCL (Code Conversion Language) is a simple language which has 74 /* CCL (Code Conversion Language) is a simple language which has
151 /* Note: If read is suspended, the resumed execution starts from the 179 /* Note: If read is suspended, the resumed execution starts from the
152 second code (YYYYY == CCL_ReadJump). */ 180 second code (YYYYY == CCL_ReadJump). */
153 181
154 #define CCL_WriteConstJump 0x08 /* Write constant and jump: 182 #define CCL_WriteConstJump 0x08 /* Write constant and jump:
155 1:A--D--D--R--E--S--S-000XXXXX 183 1:A--D--D--R--E--S--S-000XXXXX
156 2:CONST 184 2:const
157 ------------------------------ 185 ------------------------------
158 write (CONST); 186 write (const);
159 IC += ADDRESS; 187 IC += ADDRESS;
160 */ 188 */
161 189
162 #define CCL_WriteConstReadJump 0x09 /* Write constant, read, and jump: 190 #define CCL_WriteConstReadJump 0x09 /* Write constant, read, and jump:
163 1:A--D--D--R--E--S--S-rrrXXXXX 191 1:A--D--D--R--E--S--S-rrrXXXXX
164 2:CONST 192 2:const
165 3:A--D--D--R--E--S--S-rrrYYYYY 193 3:A--D--D--R--E--S--S-rrrYYYYY
166 ----------------------------- 194 -----------------------------
167 write (CONST); 195 write (const);
168 IC += 2; 196 IC += 2;
169 read (reg[rrr]); 197 read (reg[rrr]);
170 IC += ADDRESS; 198 IC += ADDRESS;
171 */ 199 */
172 /* Note: If read is suspended, the resumed execution starts from the 200 /* Note: If read is suspended, the resumed execution starts from the
269 1:00000OPERATIONRrrRRR000XXXXX 297 1:00000OPERATIONRrrRRR000XXXXX
270 ------------------------------ 298 ------------------------------
271 write (reg[RRR] OPERATION reg[Rrr]); 299 write (reg[RRR] OPERATION reg[Rrr]);
272 */ 300 */
273 301
274 #define CCL_Call 0x13 /* Write a constant: 302 #define CCL_Call 0x13 /* Call the CCL program whose ID is
303 (CC..C).
275 1:CCCCCCCCCCCCCCCCCCCC000XXXXX 304 1:CCCCCCCCCCCCCCCCCCCC000XXXXX
276 ------------------------------ 305 ------------------------------
277 call (CC..C) 306 call (CC..C)
278 */ 307 */
279 308
391 IC += ADDRESS; 420 IC += ADDRESS;
392 else 421 else
393 IC += 2; 422 IC += 2;
394 */ 423 */
395 424
396 #define CCL_Extention 0x1F /* Extended CCL code 425 #define CCL_Extension 0x1F /* Extended CCL code
397 1:ExtendedCOMMNDRrrRRRrrrXXXXX 426 1:ExtendedCOMMNDRrrRRRrrrXXXXX
398 2:ARGUEMENT 427 2:ARGUEMENT
399 3:... 428 3:...
400 ------------------------------ 429 ------------------------------
401 extended_command (rrr,RRR,Rrr,ARGS) 430 extended_command (rrr,RRR,Rrr,ARGS)
402 */ 431 */
403 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 */
404 619
405 /* CCL arithmetic/logical operators. */ 620 /* CCL arithmetic/logical operators. */
406 #define CCL_PLUS 0x00 /* X = Y + Z */ 621 #define CCL_PLUS 0x00 /* X = Y + Z */
407 #define CCL_MINUS 0x01 /* X = Y - Z */ 622 #define CCL_MINUS 0x01 /* X = Y - Z */
408 #define CCL_MUL 0x02 /* X = Y * Z */ 623 #define CCL_MUL 0x02 /* X = Y * Z */
421 #define CCL_EQ 0x12 /* X = (X == Y) */ 636 #define CCL_EQ 0x12 /* X = (X == Y) */
422 #define CCL_LE 0x13 /* X = (X <= Y) */ 637 #define CCL_LE 0x13 /* X = (X <= Y) */
423 #define CCL_GE 0x14 /* X = (X >= Y) */ 638 #define CCL_GE 0x14 /* X = (X >= Y) */
424 #define CCL_NE 0x15 /* X = (X != Y) */ 639 #define CCL_NE 0x15 /* X = (X != Y) */
425 640
426 #define CCL_ENCODE_SJIS 0x16 /* X = HIGHER_BYTE (SJIS (Y, Z)) 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))
427 r[7] = LOWER_BYTE (SJIS (Y, Z) */ 644 r[7] = LOWER_BYTE (SJIS (Y, Z) */
428 #define CCL_DECODE_SJIS 0x17 /* X = HIGHER_BYTE (DE-SJIS (Y, Z)) 645
429 r[7] = LOWER_BYTE (DE-SJIS (Y, Z)) */ 646 /* Suspend CCL program because of reading from empty input buffer or
430 647 writing to full output buffer. When this program is resumed, the
431 /* Macros for exit status of CCL program. */ 648 same I/O command is executed. The `if (1)' is for warning suppression. */
432 #define CCL_STAT_SUCCESS 0 /* Terminated successfully. */ 649 #define CCL_SUSPEND(stat) \
433 #define CCL_STAT_SUSPEND 1 /* Terminated because of empty input 650 do { \
434 buffer or full output buffer. */ 651 ic--; \
435 #define CCL_STAT_INVALID_CMD 2 /* Terminated because of invalid 652 ccl->status = stat; \
436 command. */ 653 if (1) goto ccl_finish; \
437 #define CCL_STAT_QUIT 3 /* Terminated because of quit. */ 654 } while (0)
655
656 /* Terminate CCL program because of invalid command. Should not occur
657 in the normal case. The `if (1)' is for warning suppression. */
658 #define CCL_INVALID_CMD \
659 do { \
660 ccl->status = CCL_STAT_INVALID_CMD; \
661 if (1) goto ccl_error_handler; \
662 } while (0)
438 663
439 /* Encode one character CH to multibyte form and write to the current 664 /* Encode one character CH to multibyte form and write to the current
440 output buffer. If CH is less than 256, CH is written as is. */ 665 output buffer. If CH is less than 256, CH is written as is. */
441 #define CCL_WRITE_CHAR(ch) do { \ 666 #define CCL_WRITE_CHAR(ch) do { \
442 if (!destination) \ 667 if (!destination) \
445 goto ccl_error_handler; \ 670 goto ccl_error_handler; \
446 } \ 671 } \
447 else \ 672 else \
448 { \ 673 { \
449 Bufbyte work[MAX_EMCHAR_LEN]; \ 674 Bufbyte work[MAX_EMCHAR_LEN]; \
450 int len = ( ch < 256 ) ? \ 675 int len = ( ch < ( conversion_mode == CCL_MODE_ENCODING ? \
676 256 : 128 ) ) ? \
451 simple_set_charptr_emchar (work, ch) : \ 677 simple_set_charptr_emchar (work, ch) : \
452 non_ascii_set_charptr_emchar (work, ch); \ 678 non_ascii_set_charptr_emchar (work, ch); \
453 Dynarr_add_many (destination, work, len); \ 679 Dynarr_add_many (destination, work, len); \
454 } \ 680 } \
455 } while (0) 681 } while (0)
456 682
457 /* Write a string at ccl_prog[IC] of length LEN to the current output 683 /* Write a string at ccl_prog[IC] of length LEN to the current output
458 buffer. */ 684 buffer. */
459 #define CCL_WRITE_STRING(len) do { \ 685 #define CCL_WRITE_STRING(len) do { \
460 if (!destination) \ 686 if (!destination) \
461 { \ 687 { \
462 ccl->status = CCL_STAT_INVALID_CMD; \ 688 ccl->status = CCL_STAT_INVALID_CMD; \
463 goto ccl_error_handler; \ 689 goto ccl_error_handler; \
464 } \ 690 } \
465 else \ 691 else \
466 for (i = 0; i < len; i++) \ 692 { \
467 Dynarr_add(destination, \ 693 Bufbyte work[MAX_EMCHAR_LEN]; \
468 (XINT (ccl_prog[ic + (i / 3)]) \ 694 for (i = 0; i < len; i++) \
469 >> ((2 - (i % 3)) * 8)) & 0xFF); \ 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 } \
470 } while (0) 706 } while (0)
471 707
472 /* Read one byte from the current input buffer into Rth register. */ 708 /* Read one byte from the current input buffer into Rth register. */
473 #define CCL_READ_CHAR(r) do { \ 709 #define CCL_READ_CHAR(r) do { \
474 if (!src) \ 710 if (!src && !ccl->last_block) \
475 { \ 711 { \
476 ccl->status = CCL_STAT_INVALID_CMD; \ 712 ccl->status = CCL_STAT_INVALID_CMD; \
477 goto ccl_error_handler; \ 713 goto ccl_error_handler; \
478 } \ 714 } \
479 else if (src < src_end) \ 715 else if (src < src_end) \
480 r = *src++; \ 716 r = *src++; \
481 else if (ccl->last_block) \ 717 else if (ccl->last_block) \
482 { \ 718 { \
483 ic = ccl->eof_ic; \ 719 ic = ccl->eof_ic; \
484 goto ccl_finish; \ 720 goto ccl_repeat; \
485 } \ 721 } \
486 else \ 722 else \
487 /* Suspend CCL program because of \ 723 /* Suspend CCL program because of \
488 reading from empty input buffer or \ 724 reading from empty input buffer or \
489 writing to full output buffer. \ 725 writing to full output buffer. \
490 When this program is resumed, the \ 726 When this program is resumed, the \
491 same I/O command is executed. */ \ 727 same I/O command is executed. */ \
492 { \ 728 { \
493 ic--; \ 729 ic--; \
494 ccl->status = CCL_STAT_SUSPEND; \ 730 ccl->status = CCL_STAT_SUSPEND_BY_SRC; \
495 goto ccl_finish; \ 731 goto ccl_finish; \
496 } \ 732 } \
497 } while (0) 733 } while (0)
498 734
499 735
514 { 750 {
515 Lisp_Object *ccl_prog; /* Pointer to an array of CCL code. */ 751 Lisp_Object *ccl_prog; /* Pointer to an array of CCL code. */
516 int ic; /* Instruction Counter. */ 752 int ic; /* Instruction Counter. */
517 }; 753 };
518 754
755 /* For the moment, we only support depth 256 of stack. */
756 static struct ccl_prog_stack ccl_prog_stack_struct[256];
757
519 int 758 int
520 ccl_driver (struct ccl_program *ccl, CONST unsigned char *source, unsigned_char_dynarr *destination, int src_bytes, int *consumed) 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)
521 { 762 {
522 int *reg = ccl->reg; 763 int *reg = ccl->reg;
523 int ic = ccl->ic; 764 int ic = ccl->ic;
524 int code = -1; /* init to illegal value, */ 765 int code = -1; /* init to illegal value, */
525 int field1, field2; 766 int field1, field2;
526 Lisp_Object *ccl_prog = ccl->prog; 767 Lisp_Object *ccl_prog = ccl->prog;
527 CONST unsigned char *src = source, *src_end = src + src_bytes; 768 const unsigned char *src = source, *src_end = src + src_bytes;
528 int jump_address = 0; /* shut up the compiler */ 769 int jump_address = 0; /* shut up the compiler */
529
530 int i, j, op; 770 int i, j, op;
531 int stack_idx = 0; 771 int stack_idx = ccl->stack_idx;
532 /* For the moment, we only support depth 256 of stack. */ 772 /* Instruction counter of the current CCL code. */
533 struct ccl_prog_stack ccl_prog_stack_struct[256]; 773 int this_ic = 0;
534 774
535 if (ic >= ccl->eof_ic) 775 if (ic >= ccl->eof_ic)
536 ic = CCL_HEADER_MAIN; 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
537 782
538 #ifdef CCL_DEBUG 783 #ifdef CCL_DEBUG
539 ccl_backtrace_idx = 0; 784 ccl_backtrace_idx = 0;
540 #endif 785 #endif
541 786
542 for (;;) 787 for (;;)
543 { 788 {
789 ccl_repeat:
544 #ifdef CCL_DEBUG 790 #ifdef CCL_DEBUG
545 ccl_backtrace_table[ccl_backtrace_idx++] = ic; 791 ccl_backtrace_table[ccl_backtrace_idx++] = ic;
546 if (ccl_backtrace_idx >= CCL_DEBUG_BACKTRACE_LEN) 792 if (ccl_backtrace_idx >= CCL_DEBUG_BACKTRACE_LEN)
547 ccl_backtrace_idx = 0; 793 ccl_backtrace_idx = 0;
548 ccl_backtrace_table[ccl_backtrace_idx] = 0; 794 ccl_backtrace_table[ccl_backtrace_idx] = 0;
557 src = source + src_bytes; 803 src = source + src_bytes;
558 ccl->status = CCL_STAT_QUIT; 804 ccl->status = CCL_STAT_QUIT;
559 break; 805 break;
560 } 806 }
561 807
808 this_ic = ic;
562 code = XINT (ccl_prog[ic]); ic++; 809 code = XINT (ccl_prog[ic]); ic++;
563 field1 = code >> 8; 810 field1 = code >> 8;
564 field2 = (code & 0xFF) >> 5; 811 field2 = (code & 0xFF) >> 5;
565 812
566 #define rrr field2 813 #define rrr field2
567 #define RRR (field1 & 7) 814 #define RRR (field1 & 7)
568 #define Rrr ((field1 >> 3) & 7) 815 #define Rrr ((field1 >> 3) & 7)
569 #define ADDR field1 816 #define ADDR field1
817 #define EXCMD (field1 >> 6)
570 818
571 switch (code & 0x1F) 819 switch (code & 0x1F)
572 { 820 {
573 case CCL_SetRegister: /* 00000000000000000RRRrrrXXXXX */ 821 case CCL_SetRegister: /* 00000000000000000RRRrrrXXXXX */
574 reg[rrr] = reg[RRR]; 822 reg[rrr] = reg[RRR];
754 { 1002 {
755 ccl_prog = ccl_prog_stack_struct[stack_idx].ccl_prog; 1003 ccl_prog = ccl_prog_stack_struct[stack_idx].ccl_prog;
756 ic = ccl_prog_stack_struct[stack_idx].ic; 1004 ic = ccl_prog_stack_struct[stack_idx].ic;
757 break; 1005 break;
758 } 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--;
759 /* Terminate CCL program successfully. */ 1012 /* Terminate CCL program successfully. */
760 ccl->status = CCL_STAT_SUCCESS; 1013 ccl->status = CCL_STAT_SUCCESS;
761 ccl->ic = CCL_HEADER_MAIN;
762 goto ccl_finish; 1014 goto ccl_finish;
763 1015
764 case CCL_ExprSelfConst: /* 00000OPERATION000000rrrXXXXX */ 1016 case CCL_ExprSelfConst: /* 00000OPERATION000000rrrXXXXX */
765 i = XINT (ccl_prog[ic]); 1017 i = XINT (ccl_prog[ic]);
766 ic++; 1018 ic++;
854 case CCL_GT: reg[rrr] = i > j; break; 1106 case CCL_GT: reg[rrr] = i > j; break;
855 case CCL_EQ: reg[rrr] = i == j; break; 1107 case CCL_EQ: reg[rrr] = i == j; break;
856 case CCL_LE: reg[rrr] = i <= j; break; 1108 case CCL_LE: reg[rrr] = i <= j; break;
857 case CCL_GE: reg[rrr] = i >= j; break; 1109 case CCL_GE: reg[rrr] = i >= j; break;
858 case CCL_NE: 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;
859 case CCL_ENCODE_SJIS: ENCODE_SJIS (i, j, reg[rrr], reg[7]); break; 1112 case CCL_ENCODE_SJIS: ENCODE_SJIS (i, j, reg[rrr], reg[7]); break;
860 case CCL_DECODE_SJIS: DECODE_SJIS (i, j, reg[rrr], reg[7]); break;
861 default: 1113 default:
862 ccl->status = CCL_STAT_INVALID_CMD; 1114 ccl->status = CCL_STAT_INVALID_CMD;
863 goto ccl_error_handler; 1115 goto ccl_error_handler;
864 } 1116 }
865 code &= 0x1F; 1117 code &= 0x1F;
870 } 1122 }
871 else if (!reg[rrr]) 1123 else if (!reg[rrr])
872 ic = jump_address; 1124 ic = jump_address;
873 break; 1125 break;
874 1126
1127 case CCL_Extension:
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
875 default: 1584 default:
876 ccl->status = CCL_STAT_INVALID_CMD; 1585 ccl->status = CCL_STAT_INVALID_CMD;
877 goto ccl_error_handler; 1586 goto ccl_error_handler;
878 } 1587 }
879 } 1588 }
884 /* We can insert an error message only if DESTINATION is 1593 /* We can insert an error message only if DESTINATION is
885 specified and we still have a room to store the message 1594 specified and we still have a room to store the message
886 there. */ 1595 there. */
887 char msg[256]; 1596 char msg[256];
888 1597
1598 #if 0 /* not for XEmacs ? */
1599 if (!dst)
1600 dst = destination;
1601 #endif
1602
889 switch (ccl->status) 1603 switch (ccl->status)
890 { 1604 {
891 /* Terminate CCL program because of invalid command. 1605 /* Terminate CCL program because of invalid command.
892 Should not occur in the normal case. */ 1606 Should not occur in the normal case. */
893 case CCL_STAT_INVALID_CMD: 1607 case CCL_STAT_INVALID_CMD:
894 sprintf(msg, "\nCCL: Invalid command %x (ccl_code = %x) at %d.", 1608 sprintf(msg, "\nCCL: Invalid command %x (ccl_code = %x) at %d.",
895 code & 0x1F, code, ic); 1609 code & 0x1F, code, this_ic);
896 #ifdef CCL_DEBUG 1610 #ifdef CCL_DEBUG
897 { 1611 {
898 int i = ccl_backtrace_idx - 1; 1612 int i = ccl_backtrace_idx - 1;
899 int j; 1613 int j;
900 1614
906 if (ccl_backtrace_table[i] == 0) 1620 if (ccl_backtrace_table[i] == 0)
907 break; 1621 break;
908 sprintf(msg, " %d", ccl_backtrace_table[i]); 1622 sprintf(msg, " %d", ccl_backtrace_table[i]);
909 Dynarr_add_many (destination, (unsigned char *) msg, strlen (msg)); 1623 Dynarr_add_many (destination, (unsigned char *) msg, strlen (msg));
910 } 1624 }
1625 goto ccl_finish;
911 } 1626 }
912 #endif 1627 #endif
913 goto ccl_finish; 1628 break;
914 1629
915 case CCL_STAT_QUIT: 1630 case CCL_STAT_QUIT:
916 sprintf(msg, "\nCCL: Quited."); 1631 sprintf(msg, "\nCCL: Quited.");
917 break; 1632 break;
918 1633
923 Dynarr_add_many (destination, (unsigned char *) msg, strlen (msg)); 1638 Dynarr_add_many (destination, (unsigned char *) msg, strlen (msg));
924 } 1639 }
925 1640
926 ccl_finish: 1641 ccl_finish:
927 ccl->ic = ic; 1642 ccl->ic = ic;
1643 ccl->stack_idx = stack_idx;
1644 ccl->prog = ccl_prog;
928 if (consumed) *consumed = src - source; 1645 if (consumed) *consumed = src - source;
929 if (destination) 1646 if (destination)
930 return Dynarr_length (destination); 1647 return Dynarr_length (destination);
931 else 1648 else
932 return 0; 1649 return 0;
933 } 1650 }
934 1651
935 /* Setup fields of the structure pointed by CCL appropriately for the 1652 /* Setup fields of the structure pointed by CCL appropriately for the
936 execution of compiled CCL code in VEC (vector of integer). */ 1653 execution of compiled CCL code in VEC (vector of integer).
1654 If VEC is nil, we skip setting ups based on VEC. */
937 void 1655 void
938 setup_ccl_program (struct ccl_program *ccl, Lisp_Object vec) 1656 setup_ccl_program (struct ccl_program *ccl, Lisp_Object vec)
939 { 1657 {
940 int i; 1658 int i;
941 1659
942 ccl->size = XVECTOR_LENGTH (vec); 1660 if (VECTORP (vec))
943 ccl->prog = XVECTOR_DATA (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 }
944 ccl->ic = CCL_HEADER_MAIN; 1667 ccl->ic = CCL_HEADER_MAIN;
945 ccl->eof_ic = XINT (XVECTOR_DATA (vec)[CCL_HEADER_EOF]);
946 ccl->buf_magnification = XINT (XVECTOR_DATA (vec)[CCL_HEADER_BUF_MAG]);
947 for (i = 0; i < 8; i++) 1668 for (i = 0; i < 8; i++)
948 ccl->reg[i] = 0; 1669 ccl->reg[i] = 0;
949 ccl->last_block = 0; 1670 ccl->last_block = 0;
1671 ccl->private_state = 0;
950 ccl->status = 0; 1672 ccl->status = 0;
1673 ccl->stack_idx = 0;
951 } 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
952 1724
953 #ifdef emacs 1725 #ifdef emacs
954 1726
955 DEFUN ("ccl-execute", Fccl_execute, 2, 2, 0, /* 1727 DEFUN ("ccl-execute", Fccl_execute, 2, 2, 0, /*
956 Execute CCL-PROGRAM with registers initialized by REGISTERS. 1728 Execute CCL-PROGRAM with registers initialized by REGISTERS.
957 CCL-PROGRAM is a compiled code generated by `ccl-compile', 1729
958 no I/O commands should appear in the CCL program. 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
959 REGISTERS is a vector of [R0 R1 ... R7] where RN is an initial value 1735 REGISTERS is a vector of [R0 R1 ... R7] where RN is an initial value
960 of Nth register. 1736 of Nth register.
1737
961 As side effect, each element of REGISTER holds the value of 1738 As side effect, each element of REGISTER holds the value of
962 corresponding register after the execution. 1739 corresponding register after the execution.
963 */ 1740 */
964 (ccl_prog, reg)) 1741 (ccl_prog, reg))
965 { 1742 {
966 struct ccl_program ccl; 1743 struct ccl_program ccl;
967 int i; 1744 int i;
968 1745 Lisp_Object ccl_id;
969 CHECK_VECTOR (ccl_prog); 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
970 CHECK_VECTOR (reg); 1761 CHECK_VECTOR (reg);
971 if (XVECTOR_LENGTH (reg) != 8) 1762 if (XVECTOR_LENGTH (reg) != 8)
972 signal_simple_error ("Vector should be of length 8", reg); 1763 error ("Invalid length of vector REGISTERS");
973 1764
974 setup_ccl_program (&ccl, ccl_prog); 1765 setup_ccl_program (&ccl, ccl_prog);
975 for (i = 0; i < 8; i++) 1766 for (i = 0; i < 8; i++)
976 ccl.reg[i] = (INTP (XVECTOR_DATA (reg)[i]) 1767 ccl.reg[i] = (INTP (XVECTOR_DATA (reg)[i])
977 ? XINT (XVECTOR_DATA (reg)[i]) 1768 ? XINT (XVECTOR_DATA (reg)[i])
978 : 0); 1769 : 0);
979 1770
980 ccl_driver (&ccl, (CONST unsigned char *)0, (unsigned_char_dynarr *)0, 1771 ccl_driver (&ccl, (const unsigned char *)0, (unsigned_char_dynarr *)0,
981 0, (int *)0); 1772 0, (int *)0, CCL_MODE_ENCODING);
982 QUIT; 1773 QUIT;
983 if (ccl.status != CCL_STAT_SUCCESS) 1774 if (ccl.status != CCL_STAT_SUCCESS)
984 error ("Error in CCL program at %dth code", ccl.ic); 1775 error ("Error in CCL program at %dth code", ccl.ic);
985 1776
986 for (i = 0; i < 8; i++) 1777 for (i = 0; i < 8; i++)
988 return Qnil; 1779 return Qnil;
989 } 1780 }
990 1781
991 DEFUN ("ccl-execute-on-string", Fccl_execute_on_string, 3, 4, 0, /* 1782 DEFUN ("ccl-execute-on-string", Fccl_execute_on_string, 3, 4, 0, /*
992 Execute CCL-PROGRAM with initial STATUS on STRING. 1783 Execute CCL-PROGRAM with initial STATUS on STRING.
993 CCL-PROGRAM is a compiled code generated by `ccl-compile'. 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
994 Read buffer is set to STRING, and write buffer is allocated automatically. 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\
995 STATUS is a vector of [R0 R1 ... R7 IC], where 1792 STATUS is a vector of [R0 R1 ... R7 IC], where
996 R0..R7 are initial values of corresponding registers, 1793 R0..R7 are initial values of corresponding registers,
997 IC is the instruction counter specifying from where to start the program. 1794 IC is the instruction counter specifying from where to start the program.
998 If R0..R7 are nil, they are initialized to 0. 1795 If R0..R7 are nil, they are initialized to 0.
999 If IC is nil, it is initialized to head of the CCL program. 1796 If IC is nil, it is initialized to head of the CCL program.
1000 Returns the contents of write buffer as a string, 1797
1001 and as side effect, STATUS is updated.
1002 If optional 4th arg CONTINUE is non-nil, keep IC on read operation 1798 If optional 4th arg CONTINUE is non-nil, keep IC on read operation
1003 when read buffer is exausted, else, IC is always set to the end of 1799 when read buffer is exausted, else, IC is always set to the end of
1004 CCL-PROGRAM on exit. 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.
1005 */ 1804 */
1006 (ccl_prog, status, str, contin)) 1805 (ccl_prog, status, str, contin))
1007 { 1806 {
1008 Lisp_Object val; 1807 Lisp_Object val;
1009 struct ccl_program ccl; 1808 struct ccl_program ccl;
1010 int i, produced; 1809 int i, produced;
1011 unsigned_char_dynarr *outbuf; 1810 unsigned_char_dynarr *outbuf;
1012 struct gcpro gcpro1, gcpro2, gcpro3; 1811 struct gcpro gcpro1, gcpro2, gcpro3;
1013 1812 Lisp_Object ccl_id;
1014 CHECK_VECTOR (ccl_prog); 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
1015 CHECK_VECTOR (status); 1828 CHECK_VECTOR (status);
1016 if (XVECTOR_LENGTH (status) != 9) 1829 if (XVECTOR_LENGTH (status) != 9)
1017 signal_simple_error ("Vector should be of length 9", status); 1830 signal_simple_error ("Vector should be of length 9", status);
1018 CHECK_STRING (str); 1831 CHECK_STRING (str);
1019 GCPRO3 (ccl_prog, status, str); 1832 GCPRO3 (ccl_prog, status, str);
1033 ccl.ic = i; 1846 ccl.ic = i;
1034 } 1847 }
1035 outbuf = Dynarr_new (unsigned_char); 1848 outbuf = Dynarr_new (unsigned_char);
1036 ccl.last_block = NILP (contin); 1849 ccl.last_block = NILP (contin);
1037 produced = ccl_driver (&ccl, XSTRING_DATA (str), outbuf, 1850 produced = ccl_driver (&ccl, XSTRING_DATA (str), outbuf,
1038 XSTRING_LENGTH (str), (int *)0); 1851 XSTRING_LENGTH (str), (int *)0, CCL_MODE_DECODING);
1039 for (i = 0; i < 8; i++) 1852 for (i = 0; i < 8; i++)
1040 XVECTOR_DATA (status)[i] = make_int(ccl.reg[i]); 1853 XVECTOR_DATA (status)[i] = make_int(ccl.reg[i]);
1041 XSETINT (XVECTOR_DATA (status)[8], ccl.ic); 1854 XSETINT (XVECTOR_DATA (status)[8], ccl.ic);
1042 UNGCPRO; 1855 UNGCPRO;
1043 1856
1044 val = make_string (Dynarr_atp (outbuf, 0), produced); 1857 val = make_string (Dynarr_atp (outbuf, 0), produced);
1045 Dynarr_free (outbuf); 1858 Dynarr_free (outbuf);
1046 QUIT; 1859 QUIT;
1047 if (ccl.status != CCL_STAT_SUCCESS 1860 if (ccl.status != CCL_STAT_SUCCESS
1048 && ccl.status != CCL_STAT_SUSPEND) 1861 && ccl.status != CCL_STAT_SUSPEND_BY_SRC
1862 && ccl.status != CCL_STAT_SUSPEND_BY_DST)
1049 error ("Error in CCL program at %dth code", ccl.ic); 1863 error ("Error in CCL program at %dth code", ccl.ic);
1050 1864
1051 return val; 1865 return val;
1052 } 1866 }
1053 1867
1061 int len = XVECTOR_LENGTH (Vccl_program_table); 1875 int len = XVECTOR_LENGTH (Vccl_program_table);
1062 int i; 1876 int i;
1063 1877
1064 CHECK_SYMBOL (name); 1878 CHECK_SYMBOL (name);
1065 if (!NILP (ccl_prog)) 1879 if (!NILP (ccl_prog))
1066 CHECK_VECTOR (ccl_prog); 1880 {
1881 CHECK_VECTOR (ccl_prog);
1882 ccl_prog = resolve_symbol_ccl_program (ccl_prog);
1883 }
1067 1884
1068 for (i = 0; i < len; i++) 1885 for (i = 0; i < len; i++)
1069 { 1886 {
1070 Lisp_Object slot = XVECTOR_DATA (Vccl_program_table)[i]; 1887 Lisp_Object slot = XVECTOR_DATA (Vccl_program_table)[i];
1071 1888
1089 = XVECTOR_DATA (Vccl_program_table)[j]; 1906 = XVECTOR_DATA (Vccl_program_table)[j];
1090 Vccl_program_table = new_table; 1907 Vccl_program_table = new_table;
1091 } 1908 }
1092 1909
1093 XVECTOR_DATA (Vccl_program_table)[i] = Fcons (name, ccl_prog); 1910 XVECTOR_DATA (Vccl_program_table)[i] = Fcons (name, ccl_prog);
1911 Fput (name, Qccl_program_idx, make_int (i));
1094 return make_int (i); 1912 return make_int (i);
1095 } 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
1096 1976
1097 void 1977 void
1098 syms_of_mule_ccl (void) 1978 syms_of_mule_ccl (void)
1099 { 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 {
1100 staticpro (&Vccl_program_table); 1991 staticpro (&Vccl_program_table);
1101 Vccl_program_table = Fmake_vector (make_int (32), Qnil); 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
1102 2011
1103 DEFVAR_LISP ("font-ccl-encoder-alist", &Vfont_ccl_encoder_alist /* 2012 DEFVAR_LISP ("font-ccl-encoder-alist", &Vfont_ccl_encoder_alist /*
1104 Alist of fontname patterns vs corresponding CCL program. 2013 Alist of fontname patterns vs corresponding CCL program.
1105 Each element looks like (REGEXP . CCL-CODE), 2014 Each element looks like (REGEXP . CCL-CODE),
1106 where CCL-CODE is a compiled CCL program. 2015 where CCL-CODE is a compiled CCL program.
1111 The code point in the font is set in CCL registers R1 and R2 2020 The code point in the font is set in CCL registers R1 and R2
1112 when the execution terminated. 2021 when the execution terminated.
1113 If the font is single-byte font, the register R2 is not used. 2022 If the font is single-byte font, the register R2 is not used.
1114 */ ); 2023 */ );
1115 Vfont_ccl_encoder_alist = Qnil; 2024 Vfont_ccl_encoder_alist = Qnil;
1116
1117 DEFSUBR (Fccl_execute);
1118 DEFSUBR (Fccl_execute_on_string);
1119 DEFSUBR (Fregister_ccl_program);
1120 } 2025 }
1121 2026
1122 #endif /* emacs */ 2027 #endif /* emacs */