Mercurial > hg > xemacs-beta

comparison src/mule-ccl.c @ 444:576fb035e263 r21-2-37

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r21-2-37
author cvs
date Mon, 13 Aug 2007 11:36:19 +0200
parents abe6d1db359e
children 98528da0b7fc
comparison
equal deleted inserted replaced
443:a8296e22da4e 444:576fb035e263
1 /* CCL (Code Conversion Language) interpreter. 1 /* CCL (Code Conversion Language) interpreter.
2 Copyright (C) 1995, 1997, 1998, 1999 Electrotechnical Laboratory, JAPAN. 2 Copyright (C) 1995, 1997 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 GNU Emacs.
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
8 it under the terms of the GNU General Public License as published by 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) 9 the Free Software Foundation; either version 2, or (at your option)
10 any later version. 10 any later version.
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.3.10 without ExCCL 22 /* Synched up with : FSF Emacs 21.0.90 except TranslateCharacter */
23 * (including {Read|Write}MultibyteChar) */
24 23
25 #ifdef emacs 24 #ifdef emacs
26
27 #include <config.h> 25 #include <config.h>
28
29 #if 0
30 #ifdef STDC_HEADERS
31 #include <stdlib.h>
32 #endif 26 #endif
33 #endif 27
28 #include <stdio.h>
29
30 #ifdef emacs
34 31
35 #include "lisp.h" 32 #include "lisp.h"
36 #include "buffer.h" 33 #include "buffer.h"
37 #include "mule-charset.h" 34 #include "mule-charset.h"
38 #include "mule-ccl.h" 35 #include "mule-ccl.h"
39 #include "file-coding.h" 36 #include "file-coding.h"
40 37
41 #else /* not emacs */ 38 #else /* not emacs */
42 39
43 #include <stdio.h>
44 #include "mulelib.h" 40 #include "mulelib.h"
45 41
46 #endif /* not emacs */ 42 #endif /* not emacs */
47 43
48 /* This contains all code conversion map available to CCL. */ 44 /* This contains all code conversion map available to CCL. */
49 /*
50 Lisp_Object Vcode_conversion_map_vector; 45 Lisp_Object Vcode_conversion_map_vector;
51 */
52 46
53 /* Alist of fontname patterns vs corresponding CCL program. */ 47 /* Alist of fontname patterns vs corresponding CCL program. */
54 Lisp_Object Vfont_ccl_encoder_alist; 48 Lisp_Object Vfont_ccl_encoder_alist;
55 49
56 /* This symbol is a property which assocates with ccl program vector. 50 /* This symbol is a property which associates with ccl program vector.
57 Ex: (get 'ccl-big5-encoder 'ccl-program) returns ccl program vector. */ 51 Ex: (get 'ccl-big5-encoder 'ccl-program) returns ccl program vector. */
58 Lisp_Object Qccl_program; 52 Lisp_Object Qccl_program;
59 53
60 /* These symbols are properties which associate with code conversion 54 /* These symbols are properties which associate with code conversion
61 map and their ID respectively. */ 55 map and their ID respectively. */
62 /*
63 Lisp_Object Qcode_conversion_map; 56 Lisp_Object Qcode_conversion_map;
64 Lisp_Object Qcode_conversion_map_id; 57 Lisp_Object Qcode_conversion_map_id;
65 */
66 58
67 /* Symbols of ccl program have this property, a value of the property 59 /* Symbols of ccl program have this property, a value of the property
68 is an index for Vccl_protram_table. */ 60 is an index for Vccl_program_table. */
69 Lisp_Object Qccl_program_idx; 61 Lisp_Object Qccl_program_idx;
70 62
71 /* Vector of CCL program names vs corresponding program data. */ 63 /* Table of registered CCL programs. Each element is a vector of
64 NAME, CCL_PROG, and RESOLVEDP where NAME (symbol) is the name of
65 the program, CCL_PROG (vector) is the compiled code of the program,
66 RESOLVEDP (t or nil) is the flag to tell if symbols in CCL_PROG is
67 already resolved to index numbers or not. */
72 Lisp_Object Vccl_program_table; 68 Lisp_Object Vccl_program_table;
73 69
74 /* CCL (Code Conversion Language) is a simple language which has 70 /* CCL (Code Conversion Language) is a simple language which has
75 operations on one input buffer, one output buffer, and 7 registers. 71 operations on one input buffer, one output buffer, and 7 registers.
76 The syntax of CCL is described in `ccl.el'. Emacs Lisp function 72 The syntax of CCL is described in `ccl.el'. Emacs Lisp function
179 /* Note: If read is suspended, the resumed execution starts from the 175 /* Note: If read is suspended, the resumed execution starts from the
180 second code (YYYYY == CCL_ReadJump). */ 176 second code (YYYYY == CCL_ReadJump). */
181 177
182 #define CCL_WriteConstJump 0x08 /* Write constant and jump: 178 #define CCL_WriteConstJump 0x08 /* Write constant and jump:
183 1:A--D--D--R--E--S--S-000XXXXX 179 1:A--D--D--R--E--S--S-000XXXXX
184 2:const 180 2:CONST
185 ------------------------------ 181 ------------------------------
186 write (const); 182 write (CONST);
187 IC += ADDRESS; 183 IC += ADDRESS;
188 */ 184 */
189 185
190 #define CCL_WriteConstReadJump 0x09 /* Write constant, read, and jump: 186 #define CCL_WriteConstReadJump 0x09 /* Write constant, read, and jump:
191 1:A--D--D--R--E--S--S-rrrXXXXX 187 1:A--D--D--R--E--S--S-rrrXXXXX
192 2:const 188 2:CONST
193 3:A--D--D--R--E--S--S-rrrYYYYY 189 3:A--D--D--R--E--S--S-rrrYYYYY
194 ----------------------------- 190 -----------------------------
195 write (const); 191 write (CONST);
196 IC += 2; 192 IC += 2;
197 read (reg[rrr]); 193 read (reg[rrr]);
198 IC += ADDRESS; 194 IC += ADDRESS;
199 */ 195 */
200 /* Note: If read is suspended, the resumed execution starts from the 196 /* Note: If read is suspended, the resumed execution starts from the
298 ------------------------------ 294 ------------------------------
299 write (reg[RRR] OPERATION reg[Rrr]); 295 write (reg[RRR] OPERATION reg[Rrr]);
300 */ 296 */
301 297
302 #define CCL_Call 0x13 /* Call the CCL program whose ID is 298 #define CCL_Call 0x13 /* Call the CCL program whose ID is
303 (CC..C). 299 CC..C or cc..c.
304 1:CCCCCCCCCCCCCCCCCCCC000XXXXX 300 1:CCCCCCCCCCCCCCCCCCCCFFFXXXXX
305 ------------------------------ 301 [2:00000000cccccccccccccccccccc]
306 call (CC..C) 302 ------------------------------
303 if (FFF)
304 call (cc..c)
305 IC++;
306 else
307 call (CC..C)
307 */ 308 */
308 309
309 #define CCL_WriteConstString 0x14 /* Write a constant or a string: 310 #define CCL_WriteConstString 0x14 /* Write a constant or a string:
310 1:CCCCCCCCCCCCCCCCCCCCrrrXXXXX 311 1:CCCCCCCCCCCCCCCCCCCCrrrXXXXX
311 [2:0000STRIN[0]STRIN[1]STRIN[2]] 312 [2:0000STRIN[0]STRIN[1]STRIN[2]]
420 IC += ADDRESS; 421 IC += ADDRESS;
421 else 422 else
422 IC += 2; 423 IC += 2;
423 */ 424 */
424 425
425 #define CCL_Extension 0x1F /* Extended CCL code 426 #define CCL_Extention 0x1F /* Extended CCL code
426 1:ExtendedCOMMNDRrrRRRrrrXXXXX 427 1:ExtendedCOMMNDRrrRRRrrrXXXXX
427 2:ARGUEMENT 428 2:ARGUMENT
428 3:... 429 3:...
429 ------------------------------ 430 ------------------------------
430 extended_command (rrr,RRR,Rrr,ARGS) 431 extended_command (rrr,RRR,Rrr,ARGS)
431 */ 432 */
432 433
448 is reg[RRR]. */ 449 is reg[RRR]. */
449 450
450 #define CCL_WriteMultibyteChar2 0x01 /* Write Multibyte Character 451 #define CCL_WriteMultibyteChar2 0x01 /* Write Multibyte Character
451 1:ExtendedCOMMNDRrrRRRrrrXXXXX */ 452 1:ExtendedCOMMNDRrrRRRrrrXXXXX */
452 453
453 #if 0
454 /* Translate a character whose code point is reg[rrr] and the charset 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]. 455 ID is reg[RRR] by a translation table whose ID is reg[Rrr].
456 456
457 A translated character is set in reg[rrr] (code point) and reg[RRR] 457 A translated character is set in reg[rrr] (code point) and reg[RRR]
458 (charset ID). */ 458 (charset ID). */
478 lambda. 478 lambda.
479 If the element is nil, ignore the map and proceed to the next map. 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]. 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. 481 If the element is a number, set reg[rrr] to the number and finish.
482 482
483 Detail of the map structure is descibed in the comment for 483 Detail of the map structure is described in the comment for
484 CCL_MapMultiple below. */ 484 CCL_MapMultiple below. */
485 485
486 #define CCL_IterateMultipleMap 0x10 /* Iterate multiple maps 486 #define CCL_IterateMultipleMap 0x10 /* Iterate multiple maps
487 1:ExtendedCOMMNDXXXRRRrrrXXXXX 487 1:ExtendedCOMMNDXXXRRRrrrXXXXX
488 2:NUMBER of MAPs 488 2:NUMBER of MAPs
502 (MAP-ID121 MAP-ID122 MAP-ID123) 502 (MAP-ID121 MAP-ID122 MAP-ID123)
503 MAP-ID13) 503 MAP-ID13)
504 (MAP-ID21 504 (MAP-ID21
505 (MAP-ID211 (MAP-ID2111) MAP-ID212) 505 (MAP-ID211 (MAP-ID2111) MAP-ID212)
506 MAP-ID22)), 506 MAP-ID22)),
507 the compiled CCL codes has this sequence: 507 the compiled CCL code has this sequence:
508 CCL_MapMultiple (CCL code of this command) 508 CCL_MapMultiple (CCL code of this command)
509 16 (total number of MAPs and SEPARATORs) 509 16 (total number of MAPs and SEPARATORs)
510 -7 (1st SEPARATOR) 510 -7 (1st SEPARATOR)
511 MAP-ID11 511 MAP-ID11
512 MAP-ID12 512 MAP-ID12
538 encountered. More precisely, the mapping proceeds as below: 538 encountered. More precisely, the mapping proceeds as below:
539 539
540 At first, VAL0 is set to reg[rrr], and it is translated by the 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 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 542 VAL2. This mapping is iterated until the last map is used. The
543 result of the mapping is the last value of VAL?. 543 result of the mapping is the last value of VAL?. When the mapping
544 process reached to the end of the map set, it moves to the next
545 map set. If the next does not exit, the mapping process terminates,
546 and regard the last value as a result.
544 547
545 But, when VALm is mapped to VALn and VALn is not a number, the 548 But, when VALm is mapped to VALn and VALn is not a number, the
546 mapping proceed as below: 549 mapping proceeds as follows:
547 550
548 If VALn is nil, the lastest map is ignored and the mapping of VALm 551 If VALn is nil, the lastest map is ignored and the mapping of VALm
549 proceed to the next map. 552 proceeds to the next map.
550 553
551 In VALn is t, VALm is reverted to reg[rrr] and the mapping of VALm 554 In VALn is t, VALm is reverted to reg[rrr] and the mapping of VALm
552 proceed to the next map. 555 proceeds to the next map.
553 556
554 If VALn is lambda, the whole mapping process terminates, and VALm 557 If VALn is lambda, move to the next map set like reaching to the
555 is the result of this mapping. 558 end of the current map set.
559
560 If VALn is a symbol, call the CCL program refered by it.
561 Then, use reg[rrr] as a mapped value except for -1, -2 and -3.
562 Such special values are regarded as nil, t, and lambda respectively.
556 563
557 Each map is a Lisp vector of the following format (a) or (b): 564 Each map is a Lisp vector of the following format (a) or (b):
558 (a)......[STARTPOINT VAL1 VAL2 ...] 565 (a)......[STARTPOINT VAL1 VAL2 ...]
559 (b)......[t VAL STARTPOINT ENDPOINT], 566 (b)......[t VAL STARTPOINT ENDPOINT],
560 where 567 where
578 M+1:MAP-ID_y 585 M+1:MAP-ID_y
579 ... 586 ...
580 N:SEPARATOR_z (< 0) 587 N:SEPARATOR_z (< 0)
581 */ 588 */
582 589
583 #define MAX_MAP_SET_LEVEL 20 590 #define MAX_MAP_SET_LEVEL 30
584 591
585 typedef struct 592 typedef struct
586 { 593 {
587 int rest_length; 594 int rest_length;
588 int orig_val; 595 int orig_val;
589 } tr_stack; 596 } tr_stack;
590 597
591 static tr_stack mapping_stack[MAX_MAP_SET_LEVEL]; 598 static tr_stack mapping_stack[MAX_MAP_SET_LEVEL];
592 static tr_stack *mapping_stack_pointer; 599 static tr_stack *mapping_stack_pointer;
593 #endif 600
594 601 /* If this variable is non-zero, it indicates the stack_idx
595 #define PUSH_MAPPING_STACK(restlen, orig) \ 602 of immediately called by CCL_MapMultiple. */
596 { \ 603 static int stack_idx_of_map_multiple = 0;
597 mapping_stack_pointer->rest_length = (restlen); \ 604
598 mapping_stack_pointer->orig_val = (orig); \ 605 #define PUSH_MAPPING_STACK(restlen, orig) \
599 mapping_stack_pointer++; \ 606 do { \
600 } 607 mapping_stack_pointer->rest_length = (restlen); \
601 608 mapping_stack_pointer->orig_val = (orig); \
602 #define POP_MAPPING_STACK(restlen, orig) \ 609 mapping_stack_pointer++; \
603 { \ 610 } while (0)
604 mapping_stack_pointer--; \ 611
605 (restlen) = mapping_stack_pointer->rest_length; \ 612 #define POP_MAPPING_STACK(restlen, orig) \
606 (orig) = mapping_stack_pointer->orig_val; \ 613 do { \
607 } \ 614 mapping_stack_pointer--; \
615 (restlen) = mapping_stack_pointer->rest_length; \
616 (orig) = mapping_stack_pointer->orig_val; \
617 } while (0)
618
619 #define CCL_CALL_FOR_MAP_INSTRUCTION(symbol, ret_ic) \
620 do { \
621 struct ccl_program called_ccl; \
622 if (stack_idx >= 256 \
623 || (setup_ccl_program (&called_ccl, (symbol)) != 0)) \
624 { \
625 if (stack_idx > 0) \
626 { \
627 ccl_prog = ccl_prog_stack_struct[0].ccl_prog; \
628 ic = ccl_prog_stack_struct[0].ic; \
629 } \
630 CCL_INVALID_CMD; \
631 } \
632 ccl_prog_stack_struct[stack_idx].ccl_prog = ccl_prog; \
633 ccl_prog_stack_struct[stack_idx].ic = (ret_ic); \
634 stack_idx++; \
635 ccl_prog = called_ccl.prog; \
636 ic = CCL_HEADER_MAIN; \
637 goto ccl_repeat; \
638 } while (0)
608 639
609 #define CCL_MapSingle 0x12 /* Map by single code conversion map 640 #define CCL_MapSingle 0x12 /* Map by single code conversion map
610 1:ExtendedCOMMNDXXXRRRrrrXXXXX 641 1:ExtendedCOMMNDXXXRRRrrrXXXXX
611 2:MAP-ID 642 2:MAP-ID
612 ------------------------------ 643 ------------------------------
641 #define CCL_DECODE_SJIS 0x16 /* X = HIGHER_BYTE (DE-SJIS (Y, Z)) 672 #define CCL_DECODE_SJIS 0x16 /* X = HIGHER_BYTE (DE-SJIS (Y, Z))
642 r[7] = LOWER_BYTE (DE-SJIS (Y, Z)) */ 673 r[7] = LOWER_BYTE (DE-SJIS (Y, Z)) */
643 #define CCL_ENCODE_SJIS 0x17 /* X = HIGHER_BYTE (SJIS (Y, Z)) 674 #define CCL_ENCODE_SJIS 0x17 /* X = HIGHER_BYTE (SJIS (Y, Z))
644 r[7] = LOWER_BYTE (SJIS (Y, Z) */ 675 r[7] = LOWER_BYTE (SJIS (Y, Z) */
645 676
677 /* Terminate CCL program successfully. */
678 #define CCL_SUCCESS \
679 do { \
680 ccl->status = CCL_STAT_SUCCESS; \
681 goto ccl_finish; \
682 } while (0)
683
646 /* Suspend CCL program because of reading from empty input buffer or 684 /* Suspend CCL program because of reading from empty input buffer or
647 writing to full output buffer. When this program is resumed, the 685 writing to full output buffer. When this program is resumed, the
648 same I/O command is executed. The `if (1)' is for warning suppression. */ 686 same I/O command is executed. */
649 #define CCL_SUSPEND(stat) \ 687 #define CCL_SUSPEND(stat) \
650 do { \ 688 do { \
651 ic--; \ 689 ic--; \
652 ccl->status = stat; \ 690 ccl->status = stat; \
653 if (1) goto ccl_finish; \ 691 goto ccl_finish; \
654 } while (0) 692 } while (0)
655 693
656 /* Terminate CCL program because of invalid command. Should not occur 694 /* Terminate CCL program because of invalid command. Should not occur
657 in the normal case. The `if (1)' is for warning suppression. */ 695 in the normal case. */
658 #define CCL_INVALID_CMD \ 696 #define CCL_INVALID_CMD \
659 do { \ 697 do { \
660 ccl->status = CCL_STAT_INVALID_CMD; \ 698 ccl->status = CCL_STAT_INVALID_CMD; \
661 if (1) goto ccl_error_handler; \ 699 goto ccl_error_handler; \
662 } while (0) 700 } while (0)
663 701
664 /* Encode one character CH to multibyte form and write to the current 702 /* Encode one character CH to multibyte form and write to the current
665 output buffer. If CH is less than 256, CH is written as is. */ 703 output buffer. At encoding time, if CH is less than 256, CH is
666 #define CCL_WRITE_CHAR(ch) do { \ 704 written as is. At decoding time, if CH cannot be regarded as an
667 if (!destination) \ 705 ASCII character, write it in multibyte form. */
668 { \ 706 #define CCL_WRITE_CHAR(ch) \
669 ccl->status = CCL_STAT_INVALID_CMD; \ 707 do { \
670 goto ccl_error_handler; \ 708 if (!destination) \
671 } \ 709 CCL_INVALID_CMD; \
672 else \ 710 if (conversion_mode == CCL_MODE_ENCODING) \
673 { \ 711 { \
674 Bufbyte work[MAX_EMCHAR_LEN]; \ 712 if (ch == '\n') \
675 int len = ( ch < ( conversion_mode == CCL_MODE_ENCODING ? \ 713 { \
676 256 : 128 ) ) ? \ 714 if (ccl->eol_type == CCL_CODING_EOL_CRLF) \
677 simple_set_charptr_emchar (work, ch) : \ 715 { \
678 non_ascii_set_charptr_emchar (work, ch); \ 716 Dynarr_add (destination, '\r'); \
679 Dynarr_add_many (destination, work, len); \ 717 Dynarr_add (destination, '\n'); \
680 } \ 718 } \
681 } while (0) 719 else if (ccl->eol_type == CCL_CODING_EOL_CR) \
720 Dynarr_add (destination, '\r'); \
721 else \
722 Dynarr_add (destination, '\n'); \
723 } \
724 else if (ch < 0x100) \
725 { \
726 Dynarr_add (destination, ch); \
727 } \
728 else \
729 { \
730 Bufbyte work[MAX_EMCHAR_LEN]; \
731 int len; \
732 len = non_ascii_set_charptr_emchar (work, ch); \
733 Dynarr_add_many (destination, work, len); \
734 } \
735 } \
736 else \
737 { \
738 if (!CHAR_MULTIBYTE_P(ch)) \
739 { \
740 Dynarr_add (destination, ch); \
741 } \
742 else \
743 { \
744 Bufbyte work[MAX_EMCHAR_LEN]; \
745 int len; \
746 len = non_ascii_set_charptr_emchar (work, ch); \
747 Dynarr_add_many (destination, work, len); \
748 } \
749 } \
750 } while (0)
682 751
683 /* Write a string at ccl_prog[IC] of length LEN to the current output 752 /* Write a string at ccl_prog[IC] of length LEN to the current output
684 buffer. */ 753 buffer. But this macro treat this string as a binary. Therefore,
685 #define CCL_WRITE_STRING(len) do { \ 754 cannot handle a multibyte string except for Control-1 characters. */
686 if (!destination) \ 755 #define CCL_WRITE_STRING(len) \
687 { \ 756 do { \
688 ccl->status = CCL_STAT_INVALID_CMD; \ 757 Bufbyte work[MAX_EMCHAR_LEN]; \
689 goto ccl_error_handler; \ 758 int ch, bytes; \
690 } \ 759 if (!destination) \
691 else \ 760 CCL_INVALID_CMD; \
692 { \ 761 else if (conversion_mode == CCL_MODE_ENCODING) \
693 Bufbyte work[MAX_EMCHAR_LEN]; \ 762 { \
694 for (i = 0; i < len; i++) \ 763 for (i = 0; i < len; i++) \
695 { \ 764 { \
696 int ch = (XINT (ccl_prog[ic + (i / 3)]) \ 765 ch = ((XINT (ccl_prog[ic + (i / 3)])) \
697 >> ((2 - (i % 3)) * 8)) & 0xFF; \ 766 >> ((2 - (i % 3)) * 8)) & 0xFF; \
698 int bytes = \ 767 if (ch == '\n') \
699 ( ch < ( conversion_mode == CCL_MODE_ENCODING ? \ 768 { \
700 256 : 128 ) ) ? \ 769 if (ccl->eol_type == CCL_CODING_EOL_CRLF) \
701 simple_set_charptr_emchar (work, ch) : \ 770 { \
702 non_ascii_set_charptr_emchar (work, ch); \ 771 Dynarr_add (destination, '\r'); \
703 Dynarr_add_many (destination, work, bytes); \ 772 Dynarr_add (destination, '\n'); \
704 } \ 773 } \
705 } \ 774 else if (ccl->eol_type == CCL_CODING_EOL_CR) \
706 } while (0) 775 Dynarr_add (destination, '\r'); \
776 else \
777 Dynarr_add (destination, '\n'); \
778 } \
779 if (ch < 0x100) \
780 { \
781 Dynarr_add (destination, ch); \
782 } \
783 else \
784 { \
785 bytes = non_ascii_set_charptr_emchar (work, ch); \
786 Dynarr_add_many (destination, work, len); \
787 } \
788 } \
789 } \
790 else \
791 { \
792 for (i = 0; i < len; i++) \
793 { \
794 ch = ((XINT (ccl_prog[ic + (i / 3)])) \
795 >> ((2 - (i % 3)) * 8)) & 0xFF; \
796 if (!CHAR_MULTIBYTE_P(ch)) \
797 { \
798 Dynarr_add (destination, ch); \
799 } \
800 else \
801 { \
802 bytes = non_ascii_set_charptr_emchar (work, ch); \
803 Dynarr_add_many (destination, work, len); \
804 } \
805 } \
806 } \
807 } while (0)
707 808
708 /* Read one byte from the current input buffer into Rth register. */ 809 /* Read one byte from the current input buffer into Rth register. */
709 #define CCL_READ_CHAR(r) do { \ 810 #define CCL_READ_CHAR(r) \
710 if (!src && !ccl->last_block) \ 811 do { \
711 { \ 812 if (!src) \
712 ccl->status = CCL_STAT_INVALID_CMD; \ 813 CCL_INVALID_CMD; \
713 goto ccl_error_handler; \ 814 if (src < src_end) \
714 } \ 815 r = *src++; \
715 else if (src < src_end) \ 816 else \
716 r = *src++; \ 817 { \
717 else if (ccl->last_block) \ 818 if (ccl->last_block) \
718 { \ 819 { \
719 ic = ccl->eof_ic; \ 820 ic = ccl->eof_ic; \
720 goto ccl_repeat; \ 821 goto ccl_repeat; \
721 } \ 822 } \
722 else \ 823 else \
723 /* Suspend CCL program because of \ 824 CCL_SUSPEND (CCL_STAT_SUSPEND_BY_SRC); \
724 reading from empty input buffer or \ 825 } \
725 writing to full output buffer. \ 826 } while (0)
726 When this program is resumed, the \ 827
727 same I/O command is executed. */ \ 828
728 { \ 829 /* Set C to the character code made from CHARSET and CODE. This is
729 ic--; \ 830 like MAKE_CHAR but check the validity of CHARSET and CODE. If they
730 ccl->status = CCL_STAT_SUSPEND_BY_SRC; \ 831 are not valid, set C to (CODE & 0xFF) because that is usually the
731 goto ccl_finish; \ 832 case that CCL_ReadMultibyteChar2 read an invalid code and it set
732 } \ 833 CODE to that invalid byte. */
733 } while (0) 834
835 /* On XEmacs, TranslateCharacter is not supported. Thus, this
836 macro is not used. */
837 #if 0
838 #define CCL_MAKE_CHAR(charset, code, c) \
839 do { \
840 if (charset == CHARSET_ASCII) \
841 c = code & 0xFF; \
842 else if (CHARSET_DEFINED_P (charset) \
843 && (code & 0x7F) >= 32 \
844 && (code < 256 || ((code >> 7) & 0x7F) >= 32)) \
845 { \
846 int c1 = code & 0x7F, c2 = 0; \
847 \
848 if (code >= 256) \
849 c2 = c1, c1 = (code >> 7) & 0x7F; \
850 c = MAKE_CHAR (charset, c1, c2); \
851 } \
852 else \
853 c = code & 0xFF; \
854 } while (0)
855 #endif
734 856
735 857
736 /* Execute CCL code on SRC_BYTES length text at SOURCE. The resulting 858 /* Execute CCL code on SRC_BYTES length text at SOURCE. The resulting
737 text goes to a place pointed by DESTINATION. The bytes actually 859 text goes to a place pointed by DESTINATION, the length of which
738 processed is returned as *CONSUMED. The return value is the length 860 should not exceed DST_BYTES. The bytes actually processed is
739 of the resulting text. As a side effect, the contents of CCL registers 861 returned as *CONSUMED. The return value is the length of the
862 resulting text. As a side effect, the contents of CCL registers
740 are updated. If SOURCE or DESTINATION is NULL, only operations on 863 are updated. If SOURCE or DESTINATION is NULL, only operations on
741 registers are permitted. */ 864 registers are permitted. */
742 865
743 #ifdef CCL_DEBUG 866 #ifdef CCL_DEBUG
744 #define CCL_DEBUG_BACKTRACE_LEN 256 867 #define CCL_DEBUG_BACKTRACE_LEN 256
754 877
755 /* For the moment, we only support depth 256 of stack. */ 878 /* For the moment, we only support depth 256 of stack. */
756 static struct ccl_prog_stack ccl_prog_stack_struct[256]; 879 static struct ccl_prog_stack ccl_prog_stack_struct[256];
757 880
758 int 881 int
759 ccl_driver (struct ccl_program *ccl, const unsigned char *source, 882 ccl_driver (struct ccl_program *ccl,
760 unsigned_char_dynarr *destination, int src_bytes, 883 const unsigned char *source,
761 int *consumed, int conversion_mode) 884 unsigned_char_dynarr *destination,
885 int src_bytes,
886 int *consumed,
887 int conversion_mode)
762 { 888 {
763 int *reg = ccl->reg; 889 register int *reg = ccl->reg;
764 int ic = ccl->ic; 890 register int ic = ccl->ic;
765 int code = -1; /* init to illegal value, */ 891 register int code = -1;
766 int field1, field2; 892 register int field1, field2;
767 Lisp_Object *ccl_prog = ccl->prog; 893 register Lisp_Object *ccl_prog = ccl->prog;
768 const unsigned char *src = source, *src_end = src + src_bytes; 894 const unsigned char *src = source, *src_end = src + src_bytes;
769 int jump_address = 0; /* shut up the compiler */ 895 int jump_address;
770 int i, j, op; 896 int i, j, op;
771 int stack_idx = ccl->stack_idx; 897 int stack_idx = ccl->stack_idx;
772 /* Instruction counter of the current CCL code. */ 898 /* Instruction counter of the current CCL code. */
773 int this_ic = 0; 899 int this_ic = 0;
774 900
775 if (ic >= ccl->eof_ic) 901 if (ic >= ccl->eof_ic)
776 ic = CCL_HEADER_MAIN; 902 ic = CCL_HEADER_MAIN;
777 903
778 #if 0 /* not for XEmacs ? */
779 if (ccl->buf_magnification ==0) /* We can't produce any bytes. */ 904 if (ccl->buf_magnification ==0) /* We can't produce any bytes. */
780 dst = NULL; 905 destination = NULL;
781 #endif 906
907 /* Set mapping stack pointer. */
908 mapping_stack_pointer = mapping_stack;
782 909
783 #ifdef CCL_DEBUG 910 #ifdef CCL_DEBUG
784 ccl_backtrace_idx = 0; 911 ccl_backtrace_idx = 0;
785 #endif 912 #endif
786 913
925 case CCL_WriteExprConst: /* 1:00000OPERATION000RRR000XXXXX */ 1052 case CCL_WriteExprConst: /* 1:00000OPERATION000RRR000XXXXX */
926 rrr = 7; 1053 rrr = 7;
927 i = reg[RRR]; 1054 i = reg[RRR];
928 j = XINT (ccl_prog[ic]); 1055 j = XINT (ccl_prog[ic]);
929 op = field1 >> 6; 1056 op = field1 >> 6;
930 ic++; 1057 jump_address = ic + 1;
931 goto ccl_set_expr; 1058 goto ccl_set_expr;
932 1059
933 case CCL_WriteRegister: /* CCCCCCCCCCCCCCCCCCCrrrXXXXX */ 1060 case CCL_WriteRegister: /* CCCCCCCCCCCCCCCCCCCrrrXXXXX */
934 while (1) 1061 while (1)
935 { 1062 {
945 case CCL_WriteExprRegister: /* 1:00000OPERATIONRrrRRR000XXXXX */ 1072 case CCL_WriteExprRegister: /* 1:00000OPERATIONRrrRRR000XXXXX */
946 rrr = 7; 1073 rrr = 7;
947 i = reg[RRR]; 1074 i = reg[RRR];
948 j = reg[Rrr]; 1075 j = reg[Rrr];
949 op = field1 >> 6; 1076 op = field1 >> 6;
1077 jump_address = ic;
950 goto ccl_set_expr; 1078 goto ccl_set_expr;
951 1079
952 case CCL_Call: /* CCCCCCCCCCCCCCCCCCCC000XXXXX */ 1080 case CCL_Call: /* 1:CCCCCCCCCCCCCCCCCCCCFFFXXXXX */
953 { 1081 {
954 Lisp_Object slot; 1082 Lisp_Object slot;
1083 int prog_id;
1084
1085 /* If FFF is nonzero, the CCL program ID is in the
1086 following code. */
1087 if (rrr)
1088 {
1089 prog_id = XINT (ccl_prog[ic]);
1090 ic++;
1091 }
1092 else
1093 prog_id = field1;
955 1094
956 if (stack_idx >= 256 1095 if (stack_idx >= 256
957 || field1 < 0 1096 || prog_id < 0
958 || field1 >= XVECTOR_LENGTH (Vccl_program_table) 1097 || prog_id >= XVECTOR (Vccl_program_table)->size
959 || (slot = XVECTOR_DATA (Vccl_program_table)[field1], 1098 || (slot = XVECTOR (Vccl_program_table)->contents[prog_id],
960 !CONSP (slot)) 1099 !VECTORP (slot))
961 || !VECTORP (XCDR (slot))) 1100 || !VECTORP (XVECTOR (slot)->contents[1]))
962 { 1101 {
963 if (stack_idx > 0) 1102 if (stack_idx > 0)
964 { 1103 {
965 ccl_prog = ccl_prog_stack_struct[0].ccl_prog; 1104 ccl_prog = ccl_prog_stack_struct[0].ccl_prog;
966 ic = ccl_prog_stack_struct[0].ic; 1105 ic = ccl_prog_stack_struct[0].ic;
967 } 1106 }
968 ccl->status = CCL_STAT_INVALID_CMD; 1107 CCL_INVALID_CMD;
969 goto ccl_error_handler;
970 } 1108 }
971 1109
972 ccl_prog_stack_struct[stack_idx].ccl_prog = ccl_prog; 1110 ccl_prog_stack_struct[stack_idx].ccl_prog = ccl_prog;
973 ccl_prog_stack_struct[stack_idx].ic = ic; 1111 ccl_prog_stack_struct[stack_idx].ic = ic;
974 stack_idx++; 1112 stack_idx++;
975 ccl_prog = XVECTOR_DATA (XCDR (slot)); 1113 ccl_prog = XVECTOR (XVECTOR (slot)->contents[1])->contents;
976 ic = CCL_HEADER_MAIN; 1114 ic = CCL_HEADER_MAIN;
977 } 1115 }
978 break; 1116 break;
979 1117
980 case CCL_WriteConstString: /* CCCCCCCCCCCCCCCCCCCCrrrXXXXX */ 1118 case CCL_WriteConstString: /* CCCCCCCCCCCCCCCCCCCCrrrXXXXX */
996 } 1134 }
997 ic += field1; 1135 ic += field1;
998 break; 1136 break;
999 1137
1000 case CCL_End: /* 0000000000000000000000XXXXX */ 1138 case CCL_End: /* 0000000000000000000000XXXXX */
1001 if (stack_idx-- > 0) 1139 if (stack_idx > 0)
1002 { 1140 {
1141 stack_idx--;
1003 ccl_prog = ccl_prog_stack_struct[stack_idx].ccl_prog; 1142 ccl_prog = ccl_prog_stack_struct[stack_idx].ccl_prog;
1004 ic = ccl_prog_stack_struct[stack_idx].ic; 1143 ic = ccl_prog_stack_struct[stack_idx].ic;
1005 break; 1144 break;
1006 } 1145 }
1007 if (src) 1146 if (src)
1008 src = src_end; 1147 src = src_end;
1009 /* ccl->ic should points to this command code again to 1148 /* ccl->ic should points to this command code again to
1010 suppress further processing. */ 1149 suppress further processing. */
1011 ic--; 1150 ic--;
1012 /* Terminate CCL program successfully. */ 1151 CCL_SUCCESS;
1013 ccl->status = CCL_STAT_SUCCESS;
1014 goto ccl_finish;
1015 1152
1016 case CCL_ExprSelfConst: /* 00000OPERATION000000rrrXXXXX */ 1153 case CCL_ExprSelfConst: /* 00000OPERATION000000rrrXXXXX */
1017 i = XINT (ccl_prog[ic]); 1154 i = XINT (ccl_prog[ic]);
1018 ic++; 1155 ic++;
1019 op = field1 >> 6; 1156 op = field1 >> 6;
1043 case CCL_GT: reg[rrr] = reg[rrr] > i; break; 1180 case CCL_GT: reg[rrr] = reg[rrr] > i; break;
1044 case CCL_EQ: reg[rrr] = reg[rrr] == i; break; 1181 case CCL_EQ: reg[rrr] = reg[rrr] == i; break;
1045 case CCL_LE: reg[rrr] = reg[rrr] <= i; break; 1182 case CCL_LE: reg[rrr] = reg[rrr] <= i; break;
1046 case CCL_GE: reg[rrr] = reg[rrr] >= i; break; 1183 case CCL_GE: reg[rrr] = reg[rrr] >= i; break;
1047 case CCL_NE: reg[rrr] = reg[rrr] != i; break; 1184 case CCL_NE: reg[rrr] = reg[rrr] != i; break;
1048 default: 1185 default: CCL_INVALID_CMD;
1049 ccl->status = CCL_STAT_INVALID_CMD;
1050 goto ccl_error_handler;
1051 } 1186 }
1052 break; 1187 break;
1053 1188
1054 case CCL_SetExprConst: /* 00000OPERATION000RRRrrrXXXXX */ 1189 case CCL_SetExprConst: /* 00000OPERATION000RRRrrrXXXXX */
1055 i = reg[RRR]; 1190 i = reg[RRR];
1094 case CCL_MUL: reg[rrr] = i * j; break; 1229 case CCL_MUL: reg[rrr] = i * j; break;
1095 case CCL_DIV: reg[rrr] = i / j; break; 1230 case CCL_DIV: reg[rrr] = i / j; break;
1096 case CCL_MOD: reg[rrr] = i % j; break; 1231 case CCL_MOD: reg[rrr] = i % j; break;
1097 case CCL_AND: reg[rrr] = i & j; break; 1232 case CCL_AND: reg[rrr] = i & j; break;
1098 case CCL_OR: reg[rrr] = i | j; break; 1233 case CCL_OR: reg[rrr] = i | j; break;
1099 case CCL_XOR: reg[rrr] = i ^ j; break; 1234 case CCL_XOR: reg[rrr] = i ^ j;; break;
1100 case CCL_LSH: reg[rrr] = i << j; break; 1235 case CCL_LSH: reg[rrr] = i << j; break;
1101 case CCL_RSH: reg[rrr] = i >> j; break; 1236 case CCL_RSH: reg[rrr] = i >> j; break;
1102 case CCL_LSH8: reg[rrr] = (i << 8) | j; break; 1237 case CCL_LSH8: reg[rrr] = (i << 8) | j; break;
1103 case CCL_RSH8: reg[rrr] = i >> 8; reg[7] = i & 0xFF; break; 1238 case CCL_RSH8: reg[rrr] = i >> 8; reg[7] = i & 0xFF; break;
1104 case CCL_DIVMOD: reg[rrr] = i / j; reg[7] = i % j; break; 1239 case CCL_DIVMOD: reg[rrr] = i / j; reg[7] = i % j; break;
1106 case CCL_GT: reg[rrr] = i > j; break; 1241 case CCL_GT: reg[rrr] = i > j; break;
1107 case CCL_EQ: reg[rrr] = i == j; break; 1242 case CCL_EQ: reg[rrr] = i == j; break;
1108 case CCL_LE: reg[rrr] = i <= j; break; 1243 case CCL_LE: reg[rrr] = i <= j; break;
1109 case CCL_GE: reg[rrr] = i >= j; break; 1244 case CCL_GE: reg[rrr] = i >= j; break;
1110 case CCL_NE: reg[rrr] = i != j; break; 1245 case CCL_NE: reg[rrr] = i != j; break;
1111 case CCL_DECODE_SJIS: DECODE_SJIS (i, j, reg[rrr], reg[7]); break; 1246 case CCL_DECODE_SJIS:
1112 case CCL_ENCODE_SJIS: ENCODE_SJIS (i, j, reg[rrr], reg[7]); break; 1247 /* DECODE_SJIS set MSB for internal format
1113 default: 1248 as opposed to Emacs. */
1114 ccl->status = CCL_STAT_INVALID_CMD; 1249 DECODE_SJIS (i, j, reg[rrr], reg[7]);
1115 goto ccl_error_handler; 1250 reg[rrr] &= 0x7F;
1251 reg[7] &= 0x7F;
1252 break;
1253 case CCL_ENCODE_SJIS:
1254 /* ENCODE_SJIS assumes MSB of SJIS-char is set
1255 as opposed to Emacs. */
1256 ENCODE_SJIS (i | 0x80, j | 0x80, reg[rrr], reg[7]);
1257 break;
1258 default: CCL_INVALID_CMD;
1116 } 1259 }
1117 code &= 0x1F; 1260 code &= 0x1F;
1118 if (code == CCL_WriteExprConst || code == CCL_WriteExprRegister) 1261 if (code == CCL_WriteExprConst || code == CCL_WriteExprRegister)
1119 { 1262 {
1120 i = reg[rrr]; 1263 i = reg[rrr];
1121 CCL_WRITE_CHAR (i); 1264 CCL_WRITE_CHAR (i);
1265 ic = jump_address;
1122 } 1266 }
1123 else if (!reg[rrr]) 1267 else if (!reg[rrr])
1124 ic = jump_address; 1268 ic = jump_address;
1125 break; 1269 break;
1126 1270
1127 case CCL_Extension: 1271 case CCL_Extention:
1128 switch (EXCMD) 1272 switch (EXCMD)
1129 { 1273 {
1130 case CCL_ReadMultibyteChar2: 1274 case CCL_ReadMultibyteChar2:
1131 if (!src) 1275 if (!src)
1132 CCL_INVALID_CMD; 1276 CCL_INVALID_CMD;
1137 src++; 1281 src++;
1138 goto ccl_read_multibyte_character_suspend; 1282 goto ccl_read_multibyte_character_suspend;
1139 } 1283 }
1140 1284
1141 i = *src++; 1285 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) 1286 if (i < 0x80)
1185 { 1287 {
1186 /* ASCII */ 1288 /* ASCII */
1187 reg[rrr] = i; 1289 reg[rrr] = i;
1188 reg[RRR] = LEADING_BYTE_ASCII; 1290 reg[RRR] = LEADING_BYTE_ASCII;
1243 1345
1244 case CCL_WriteMultibyteChar2: 1346 case CCL_WriteMultibyteChar2:
1245 i = reg[RRR]; /* charset */ 1347 i = reg[RRR]; /* charset */
1246 if (i == LEADING_BYTE_ASCII) 1348 if (i == LEADING_BYTE_ASCII)
1247 i = reg[rrr] & 0xFF; 1349 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) 1350 else if (XCHARSET_DIMENSION (CHARSET_BY_LEADING_BYTE (i)) == 1)
1253 i = ((i - FIELD2_TO_OFFICIAL_LEADING_BYTE) << 7) 1351 i = (((i - FIELD2_TO_OFFICIAL_LEADING_BYTE) << 7)
1254 | (reg[rrr] & 0x7F); 1352 | (reg[rrr] & 0x7F));
1255 else if (i < MIN_LEADING_BYTE_OFFICIAL_2) 1353 else if (i < MAX_LEADING_BYTE_OFFICIAL_2)
1256 i = ((i - FIELD1_TO_OFFICIAL_LEADING_BYTE) << 14) | reg[rrr]; 1354 i = ((i - FIELD1_TO_OFFICIAL_LEADING_BYTE) << 14) | reg[rrr];
1257 else 1355 else
1258 i = ((i - FIELD1_TO_PRIVATE_LEADING_BYTE) << 14) | reg[rrr]; 1356 i = ((i - FIELD1_TO_PRIVATE_LEADING_BYTE) << 14) | reg[rrr];
1259 1357
1260 CCL_WRITE_CHAR (i); 1358 CCL_WRITE_CHAR (i);
1261 1359
1262 break; 1360 break;
1263 1361
1362 case CCL_TranslateCharacter:
1264 #if 0 1363 #if 0
1265 case CCL_TranslateCharacter: 1364 /* XEmacs does not have translate_char, and its
1266 i = reg[RRR]; /* charset */ 1365 equivalent nor. We do nothing on this operation. */
1267 if (i == LEADING_BYTE_ASCII) 1366 CCL_MAKE_CHAR (reg[RRR], reg[rrr], i);
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]), 1367 op = translate_char (GET_TRANSLATION_TABLE (reg[Rrr]),
1282 i, -1, 0, 0); 1368 i, -1, 0, 0);
1283 SPLIT_CHAR (op, reg[RRR], i, j); 1369 SPLIT_CHAR (op, reg[RRR], i, j);
1284 if (j != -1) 1370 if (j != -1)
1285 i = (i << 7) | j; 1371 i = (i << 7) | j;
1286 1372
1287 reg[rrr] = i; 1373 reg[rrr] = i;
1374 #endif
1288 break; 1375 break;
1289 1376
1290 case CCL_TranslateCharacterConstTbl: 1377 case CCL_TranslateCharacterConstTbl:
1378 #if 0
1379 /* XEmacs does not have translate_char, and its
1380 equivalent nor. We do nothing on this operation. */
1291 op = XINT (ccl_prog[ic]); /* table */ 1381 op = XINT (ccl_prog[ic]); /* table */
1292 ic++; 1382 ic++;
1293 i = reg[RRR]; /* charset */ 1383 CCL_MAKE_CHAR (reg[RRR], reg[rrr], i);
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); 1384 op = translate_char (GET_TRANSLATION_TABLE (op), i, -1, 0, 0);
1309 SPLIT_CHAR (op, reg[RRR], i, j); 1385 SPLIT_CHAR (op, reg[RRR], i, j);
1310 if (j != -1) 1386 if (j != -1)
1311 i = (i << 7) | j; 1387 i = (i << 7) | j;
1312 1388
1313 reg[rrr] = i; 1389 reg[rrr] = i;
1390 #endif
1314 break; 1391 break;
1315 1392
1316 case CCL_IterateMultipleMap: 1393 case CCL_IterateMultipleMap:
1317 { 1394 {
1318 Lisp_Object map, content, attrib, value; 1395 Lisp_Object map, content, attrib, value;
1340 point = XINT (ccl_prog[ic++]); 1417 point = XINT (ccl_prog[ic++]);
1341 if (point >= size) continue; 1418 if (point >= size) continue;
1342 map = 1419 map =
1343 XVECTOR (Vcode_conversion_map_vector)->contents[point]; 1420 XVECTOR (Vcode_conversion_map_vector)->contents[point];
1344 1421
1345 /* Check map varidity. */ 1422 /* Check map validity. */
1346 if (!CONSP (map)) continue; 1423 if (!CONSP (map)) continue;
1347 map = XCONS(map)->cdr; 1424 map = XCDR (map);
1348 if (!VECTORP (map)) continue; 1425 if (!VECTORP (map)) continue;
1349 size = XVECTOR (map)->size; 1426 size = XVECTOR (map)->size;
1350 if (size <= 1) continue; 1427 if (size <= 1) continue;
1351 1428
1352 content = XVECTOR (map)->contents[0]; 1429 content = XVECTOR (map)->contents[0];
1353 1430
1354 /* check map type, 1431 /* check map type,
1355 [STARTPOINT VAL1 VAL2 ...] or 1432 [STARTPOINT VAL1 VAL2 ...] or
1356 [t ELELMENT STARTPOINT ENDPOINT] */ 1433 [t ELEMENT STARTPOINT ENDPOINT] */
1357 if (NUMBERP (content)) 1434 if (INTP (content))
1358 { 1435 {
1359 point = XUINT (content); 1436 point = XUINT (content);
1360 point = op - point + 1; 1437 point = op - point + 1;
1361 if (!((point >= 1) && (point < size))) continue; 1438 if (!((point >= 1) && (point < size))) continue;
1362 content = XVECTOR (map)->contents[point]; 1439 content = XVECTOR (map)->contents[point];
1373 else 1450 else
1374 continue; 1451 continue;
1375 1452
1376 if (NILP (content)) 1453 if (NILP (content))
1377 continue; 1454 continue;
1378 else if (NUMBERP (content)) 1455 else if (INTP (content))
1379 { 1456 {
1380 reg[RRR] = i; 1457 reg[RRR] = i;
1381 reg[rrr] = XINT(content); 1458 reg[rrr] = XINT(content);
1382 break; 1459 break;
1383 } 1460 }
1386 reg[RRR] = i; 1463 reg[RRR] = i;
1387 break; 1464 break;
1388 } 1465 }
1389 else if (CONSP (content)) 1466 else if (CONSP (content))
1390 { 1467 {
1391 attrib = XCONS (content)->car; 1468 attrib = XCAR (content);
1392 value = XCONS (content)->cdr; 1469 value = XCDR (content);
1393 if (!NUMBERP (attrib) || !NUMBERP (value)) 1470 if (!INTP (attrib) || !INTP (value))
1394 continue; 1471 continue;
1395 reg[RRR] = i; 1472 reg[RRR] = i;
1396 reg[rrr] = XUINT (value); 1473 reg[rrr] = XUINT (value);
1397 break; 1474 break;
1398 } 1475 }
1476 else if (SYMBOLP (content))
1477 CCL_CALL_FOR_MAP_INSTRUCTION (content, fin_ic);
1478 else
1479 CCL_INVALID_CMD;
1399 } 1480 }
1400 if (i == j) 1481 if (i == j)
1401 reg[RRR] = -1; 1482 reg[RRR] = -1;
1402 ic = fin_ic; 1483 ic = fin_ic;
1403 } 1484 }
1406 case CCL_MapMultiple: 1487 case CCL_MapMultiple:
1407 { 1488 {
1408 Lisp_Object map, content, attrib, value; 1489 Lisp_Object map, content, attrib, value;
1409 int point, size, map_vector_size; 1490 int point, size, map_vector_size;
1410 int map_set_rest_length, fin_ic; 1491 int map_set_rest_length, fin_ic;
1492 int current_ic = this_ic;
1493
1494 /* inhibit recursive call on MapMultiple. */
1495 if (stack_idx_of_map_multiple > 0)
1496 {
1497 if (stack_idx_of_map_multiple <= stack_idx)
1498 {
1499 stack_idx_of_map_multiple = 0;
1500 mapping_stack_pointer = mapping_stack;
1501 CCL_INVALID_CMD;
1502 }
1503 }
1504 else
1505 mapping_stack_pointer = mapping_stack;
1506 stack_idx_of_map_multiple = 0;
1411 1507
1412 map_set_rest_length = 1508 map_set_rest_length =
1413 XINT (ccl_prog[ic++]); /* number of maps and separators. */ 1509 XINT (ccl_prog[ic++]); /* number of maps and separators. */
1414 fin_ic = ic + map_set_rest_length; 1510 fin_ic = ic + map_set_rest_length;
1511 op = reg[rrr];
1512
1415 if ((map_set_rest_length > reg[RRR]) && (reg[RRR] >= 0)) 1513 if ((map_set_rest_length > reg[RRR]) && (reg[RRR] >= 0))
1416 { 1514 {
1417 ic += reg[RRR]; 1515 ic += reg[RRR];
1418 i = reg[RRR]; 1516 i = reg[RRR];
1419 map_set_rest_length -= i; 1517 map_set_rest_length -= i;
1420 } 1518 }
1421 else 1519 else
1422 { 1520 {
1423 ic = fin_ic; 1521 ic = fin_ic;
1424 reg[RRR] = -1; 1522 reg[RRR] = -1;
1523 mapping_stack_pointer = mapping_stack;
1425 break; 1524 break;
1426 } 1525 }
1427 mapping_stack_pointer = mapping_stack; 1526
1428 op = reg[rrr]; 1527 if (mapping_stack_pointer <= (mapping_stack + 1))
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 { 1528 {
1434 point = XINT(ccl_prog[ic++]); 1529 /* Set up initial state. */
1435 if (point < 0) 1530 mapping_stack_pointer = mapping_stack;
1531 PUSH_MAPPING_STACK (0, op);
1532 reg[RRR] = -1;
1533 }
1534 else
1535 {
1536 /* Recover after calling other ccl program. */
1537 int orig_op;
1538
1539 POP_MAPPING_STACK (map_set_rest_length, orig_op);
1540 POP_MAPPING_STACK (map_set_rest_length, reg[rrr]);
1541 switch (op)
1436 { 1542 {
1437 point = -point; 1543 case -1:
1438 if (mapping_stack_pointer 1544 /* Regard it as Qnil. */
1439 >= &mapping_stack[MAX_MAP_SET_LEVEL]) 1545 op = orig_op;
1440 { 1546 i++;
1441 CCL_INVALID_CMD; 1547 ic++;
1442 } 1548 map_set_rest_length--;
1443 PUSH_MAPPING_STACK (map_set_rest_length - point, 1549 break;
1444 reg[rrr]); 1550 case -2:
1445 map_set_rest_length = point + 1; 1551 /* Regard it as Qt. */
1446 reg[rrr] = op; 1552 op = reg[rrr];
1447 continue; 1553 i++;
1448 } 1554 ic++;
1449 1555 map_set_rest_length--;
1450 if (point >= map_vector_size) continue; 1556 break;
1451 map = (XVECTOR (Vcode_conversion_map_vector) 1557 case -3:
1452 ->contents[point]); 1558 /* Regard it as Qlambda. */
1453 1559 op = orig_op;
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; 1560 i += map_set_rest_length;
1561 ic += map_set_rest_length;
1562 map_set_rest_length = 0;
1563 break;
1564 default:
1565 /* Regard it as normal mapping. */
1566 i += map_set_rest_length;
1567 ic += map_set_rest_length;
1492 POP_MAPPING_STACK (map_set_rest_length, reg[rrr]); 1568 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; 1569 break;
1515 } 1570 }
1516 else
1517 CCL_INVALID_CMD;
1518 } 1571 }
1572 map_vector_size = XVECTOR (Vcode_conversion_map_vector)->size;
1573
1574 do {
1575 for (;map_set_rest_length > 0;i++, ic++, map_set_rest_length--)
1576 {
1577 point = XINT(ccl_prog[ic]);
1578 if (point < 0)
1579 {
1580 /* +1 is for including separator. */
1581 point = -point + 1;
1582 if (mapping_stack_pointer
1583 >= &mapping_stack[MAX_MAP_SET_LEVEL])
1584 CCL_INVALID_CMD;
1585 PUSH_MAPPING_STACK (map_set_rest_length - point,
1586 reg[rrr]);
1587 map_set_rest_length = point;
1588 reg[rrr] = op;
1589 continue;
1590 }
1591
1592 if (point >= map_vector_size) continue;
1593 map = (XVECTOR (Vcode_conversion_map_vector)
1594 ->contents[point]);
1595
1596 /* Check map validity. */
1597 if (!CONSP (map)) continue;
1598 map = XCDR (map);
1599 if (!VECTORP (map)) continue;
1600 size = XVECTOR (map)->size;
1601 if (size <= 1) continue;
1602
1603 content = XVECTOR (map)->contents[0];
1604
1605 /* check map type,
1606 [STARTPOINT VAL1 VAL2 ...] or
1607 [t ELEMENT STARTPOINT ENDPOINT] */
1608 if (INTP (content))
1609 {
1610 point = XUINT (content);
1611 point = op - point + 1;
1612 if (!((point >= 1) && (point < size))) continue;
1613 content = XVECTOR (map)->contents[point];
1614 }
1615 else if (EQ (content, Qt))
1616 {
1617 if (size != 4) continue;
1618 if ((op >= XUINT (XVECTOR (map)->contents[2])) &&
1619 (op < XUINT (XVECTOR (map)->contents[3])))
1620 content = XVECTOR (map)->contents[1];
1621 else
1622 continue;
1623 }
1624 else
1625 continue;
1626
1627 if (NILP (content))
1628 continue;
1629
1630 reg[RRR] = i;
1631 if (INTP (content))
1632 {
1633 op = XINT (content);
1634 i += map_set_rest_length - 1;
1635 ic += map_set_rest_length - 1;
1636 POP_MAPPING_STACK (map_set_rest_length, reg[rrr]);
1637 map_set_rest_length++;
1638 }
1639 else if (CONSP (content))
1640 {
1641 attrib = XCAR (content);
1642 value = XCDR (content);
1643 if (!INTP (attrib) || !INTP (value))
1644 continue;
1645 op = XUINT (value);
1646 i += map_set_rest_length - 1;
1647 ic += map_set_rest_length - 1;
1648 POP_MAPPING_STACK (map_set_rest_length, reg[rrr]);
1649 map_set_rest_length++;
1650 }
1651 else if (EQ (content, Qt))
1652 {
1653 op = reg[rrr];
1654 }
1655 else if (EQ (content, Qlambda))
1656 {
1657 i += map_set_rest_length;
1658 ic += map_set_rest_length;
1659 break;
1660 }
1661 else if (SYMBOLP (content))
1662 {
1663 if (mapping_stack_pointer
1664 >= &mapping_stack[MAX_MAP_SET_LEVEL])
1665 CCL_INVALID_CMD;
1666 PUSH_MAPPING_STACK (map_set_rest_length, reg[rrr]);
1667 PUSH_MAPPING_STACK (map_set_rest_length, op);
1668 stack_idx_of_map_multiple = stack_idx + 1;
1669 CCL_CALL_FOR_MAP_INSTRUCTION (content, current_ic);
1670 }
1671 else
1672 CCL_INVALID_CMD;
1673 }
1674 if (mapping_stack_pointer <= (mapping_stack + 1))
1675 break;
1676 POP_MAPPING_STACK (map_set_rest_length, reg[rrr]);
1677 i += map_set_rest_length;
1678 ic += map_set_rest_length;
1679 POP_MAPPING_STACK (map_set_rest_length, reg[rrr]);
1680 } while (1);
1681
1519 ic = fin_ic; 1682 ic = fin_ic;
1520 } 1683 }
1521 reg[rrr] = op; 1684 reg[rrr] = op;
1522 break; 1685 break;
1523 1686
1536 if (!CONSP (map)) 1699 if (!CONSP (map))
1537 { 1700 {
1538 reg[RRR] = -1; 1701 reg[RRR] = -1;
1539 break; 1702 break;
1540 } 1703 }
1541 map = XCONS(map)->cdr; 1704 map = XCDR (map);
1542 if (!VECTORP (map)) 1705 if (!VECTORP (map))
1543 { 1706 {
1544 reg[RRR] = -1; 1707 reg[RRR] = -1;
1545 break; 1708 break;
1546 } 1709 }
1551 if ((size <= 1) || 1714 if ((size <= 1) ||
1552 (!((point >= 1) && (point < size)))) 1715 (!((point >= 1) && (point < size))))
1553 reg[RRR] = -1; 1716 reg[RRR] = -1;
1554 else 1717 else
1555 { 1718 {
1719 reg[RRR] = 0;
1556 content = XVECTOR (map)->contents[point]; 1720 content = XVECTOR (map)->contents[point];
1557 if (NILP (content)) 1721 if (NILP (content))
1558 reg[RRR] = -1; 1722 reg[RRR] = -1;
1559 else if (NUMBERP (content)) 1723 else if (INTP (content))
1560 reg[rrr] = XINT (content); 1724 reg[rrr] = XINT (content);
1561 else if (EQ (content, Qt)) 1725 else if (EQ (content, Qt));
1562 reg[RRR] = i;
1563 else if (CONSP (content)) 1726 else if (CONSP (content))
1564 { 1727 {
1565 attrib = XCONS (content)->car; 1728 attrib = XCAR (content);
1566 value = XCONS (content)->cdr; 1729 value = XCDR (content);
1567 if (!NUMBERP (attrib) || !NUMBERP (value)) 1730 if (!INTP (attrib) || !INTP (value))
1568 continue; 1731 continue;
1569 reg[rrr] = XUINT(value); 1732 reg[rrr] = XUINT(value);
1570 break; 1733 break;
1571 } 1734 }
1735 else if (SYMBOLP (content))
1736 CCL_CALL_FOR_MAP_INSTRUCTION (content, ic);
1572 else 1737 else
1573 reg[RRR] = -1; 1738 reg[RRR] = -1;
1574 } 1739 }
1575 } 1740 }
1576 break; 1741 break;
1577 #endif
1578 1742
1579 default: 1743 default:
1580 CCL_INVALID_CMD; 1744 CCL_INVALID_CMD;
1581 } 1745 }
1582 break; 1746 break;
1583 1747
1584 default: 1748 default:
1585 ccl->status = CCL_STAT_INVALID_CMD; 1749 CCL_INVALID_CMD;
1586 goto ccl_error_handler;
1587 } 1750 }
1588 } 1751 }
1589 1752
1590 ccl_error_handler: 1753 ccl_error_handler:
1591 if (destination) 1754 if (destination)
1593 /* We can insert an error message only if DESTINATION is 1756 /* We can insert an error message only if DESTINATION is
1594 specified and we still have a room to store the message 1757 specified and we still have a room to store the message
1595 there. */ 1758 there. */
1596 char msg[256]; 1759 char msg[256];
1597 1760
1598 #if 0 /* not for XEmacs ? */
1599 if (!dst)
1600 dst = destination;
1601 #endif
1602
1603 switch (ccl->status) 1761 switch (ccl->status)
1604 { 1762 {
1605 /* Terminate CCL program because of invalid command.
1606 Should not occur in the normal case. */
1607 case CCL_STAT_INVALID_CMD: 1763 case CCL_STAT_INVALID_CMD:
1608 sprintf(msg, "\nCCL: Invalid command %x (ccl_code = %x) at %d.", 1764 sprintf(msg, "\nCCL: Invalid command %x (ccl_code = %x) at %d.",
1609 code & 0x1F, code, this_ic); 1765 code & 0x1F, code, this_ic);
1610 #ifdef CCL_DEBUG 1766 #ifdef CCL_DEBUG
1611 { 1767 {
1626 } 1782 }
1627 #endif 1783 #endif
1628 break; 1784 break;
1629 1785
1630 case CCL_STAT_QUIT: 1786 case CCL_STAT_QUIT:
1631 sprintf(msg, "\nCCL: Quited."); 1787 sprintf(msg, "\nCCL: Exited.");
1632 break; 1788 break;
1633 1789
1634 default: 1790 default:
1635 sprintf(msg, "\nCCL: Unknown error type (%d).", ccl->status); 1791 sprintf(msg, "\nCCL: Unknown error type (%d).", ccl->status);
1636 } 1792 }
1641 ccl_finish: 1797 ccl_finish:
1642 ccl->ic = ic; 1798 ccl->ic = ic;
1643 ccl->stack_idx = stack_idx; 1799 ccl->stack_idx = stack_idx;
1644 ccl->prog = ccl_prog; 1800 ccl->prog = ccl_prog;
1645 if (consumed) *consumed = src - source; 1801 if (consumed) *consumed = src - source;
1646 if (destination) 1802 if (!destination)
1647 return Dynarr_length (destination);
1648 else
1649 return 0; 1803 return 0;
1804 return Dynarr_length (destination);
1650 } 1805 }
1651 1806
1807 /* Resolve symbols in the specified CCL code (Lisp vector). This
1808 function converts symbols of code conversion maps and character
1809 translation tables embedded in the CCL code into their ID numbers.
1810
1811 The return value is a vector (CCL itself or a new vector in which
1812 all symbols are resolved), Qt if resolving of some symbol failed,
1813 or nil if CCL contains invalid data. */
1814
1815 static Lisp_Object
1816 resolve_symbol_ccl_program (Lisp_Object ccl)
1817 {
1818 int i, veclen, unresolved = 0;
1819 Lisp_Object result, contents, val;
1820
1821 result = ccl;
1822 veclen = XVECTOR (result)->size;
1823
1824 for (i = 0; i < veclen; i++)
1825 {
1826 contents = XVECTOR (result)->contents[i];
1827 if (INTP (contents))
1828 continue;
1829 else if (CONSP (contents)
1830 && SYMBOLP (XCAR (contents))
1831 && SYMBOLP (XCDR (contents)))
1832 {
1833 /* This is the new style for embedding symbols. The form is
1834 (SYMBOL . PROPERTY). (get SYMBOL PROPERTY) should give
1835 an index number. */
1836
1837 if (EQ (result, ccl))
1838 result = Fcopy_sequence (ccl);
1839
1840 val = Fget (XCAR (contents), XCDR (contents), Qnil);
1841 if (NATNUMP (val))
1842 XVECTOR (result)->contents[i] = val;
1843 else
1844 unresolved = 1;
1845 continue;
1846 }
1847 else if (SYMBOLP (contents))
1848 {
1849 /* This is the old style for embedding symbols. This style
1850 may lead to a bug if, for instance, a translation table
1851 and a code conversion map have the same name. */
1852 if (EQ (result, ccl))
1853 result = Fcopy_sequence (ccl);
1854
1855 val = Fget (contents, Qcode_conversion_map_id, Qnil);
1856 if (NATNUMP (val))
1857 XVECTOR (result)->contents[i] = val;
1858 else
1859 {
1860 val = Fget (contents, Qccl_program_idx, Qnil);
1861 if (NATNUMP (val))
1862 XVECTOR (result)->contents[i] = val;
1863 else
1864 unresolved = 1;
1865 }
1866 continue;
1867 }
1868 return Qnil;
1869 }
1870
1871 return (unresolved ? Qt : result);
1872 }
1873
1874 /* Return the compiled code (vector) of CCL program CCL_PROG.
1875 CCL_PROG is a name (symbol) of the program or already compiled
1876 code. If necessary, resolve symbols in the compiled code to index
1877 numbers. If we failed to get the compiled code or to resolve
1878 symbols, return Qnil. */
1879
1880 static Lisp_Object
1881 ccl_get_compiled_code (Lisp_Object ccl_prog)
1882 {
1883 Lisp_Object val, slot;
1884
1885 if (VECTORP (ccl_prog))
1886 {
1887 val = resolve_symbol_ccl_program (ccl_prog);
1888 return (VECTORP (val) ? val : Qnil);
1889 }
1890 if (!SYMBOLP (ccl_prog))
1891 return Qnil;
1892
1893 val = Fget (ccl_prog, Qccl_program_idx, Qnil);
1894 if (! NATNUMP (val)
1895 || XINT (val) >= XVECTOR_LENGTH (Vccl_program_table))
1896 return Qnil;
1897 slot = XVECTOR_DATA (Vccl_program_table)[XINT (val)];
1898 if (! VECTORP (slot)
1899 || XVECTOR (slot)->size != 3
1900 || ! VECTORP (XVECTOR_DATA (slot)[1]))
1901 return Qnil;
1902 if (NILP (XVECTOR_DATA (slot)[2]))
1903 {
1904 val = resolve_symbol_ccl_program (XVECTOR_DATA (slot)[1]);
1905 if (! VECTORP (val))
1906 return Qnil;
1907 XVECTOR_DATA (slot)[1] = val;
1908 XVECTOR_DATA (slot)[2] = Qt;
1909 }
1910 return XVECTOR_DATA (slot)[1];
1911 }
1912
1652 /* Setup fields of the structure pointed by CCL appropriately for the 1913 /* Setup fields of the structure pointed by CCL appropriately for the
1653 execution of compiled CCL code in VEC (vector of integer). 1914 execution of CCL program CCL_PROG. CCL_PROG is the name (symbol)
1654 If VEC is nil, we skip setting ups based on VEC. */ 1915 of the CCL program or the already compiled code (vector).
1655 void 1916 Return 0 if we succeed this setup, else return -1.
1656 setup_ccl_program (struct ccl_program *ccl, Lisp_Object vec) 1917
1918 If CCL_PROG is nil, we just reset the structure pointed by CCL. */
1919 int
1920 setup_ccl_program (struct ccl_program *ccl, Lisp_Object ccl_prog)
1657 { 1921 {
1658 int i; 1922 int i;
1659 1923
1660 if (VECTORP (vec)) 1924 if (! NILP (ccl_prog))
1661 { 1925 {
1662 ccl->size = XVECTOR_LENGTH (vec); 1926 ccl_prog = ccl_get_compiled_code (ccl_prog);
1663 ccl->prog = XVECTOR_DATA (vec); 1927 if (! VECTORP (ccl_prog))
1664 ccl->eof_ic = XINT (XVECTOR_DATA (vec)[CCL_HEADER_EOF]); 1928 return -1;
1665 ccl->buf_magnification = XINT (XVECTOR_DATA (vec)[CCL_HEADER_BUF_MAG]); 1929 ccl->size = XVECTOR_LENGTH (ccl_prog);
1930 ccl->prog = XVECTOR_DATA (ccl_prog);
1931 ccl->eof_ic = XINT (XVECTOR_DATA (ccl_prog)[CCL_HEADER_EOF]);
1932 ccl->buf_magnification = XINT (XVECTOR_DATA (ccl_prog)[CCL_HEADER_BUF_MAG]);
1666 } 1933 }
1667 ccl->ic = CCL_HEADER_MAIN; 1934 ccl->ic = CCL_HEADER_MAIN;
1668 for (i = 0; i < 8; i++) 1935 for (i = 0; i < 8; i++)
1669 ccl->reg[i] = 0; 1936 ccl->reg[i] = 0;
1670 ccl->last_block = 0; 1937 ccl->last_block = 0;
1671 ccl->private_state = 0; 1938 ccl->private_state = 0;
1672 ccl->status = 0; 1939 ccl->status = 0;
1673 ccl->stack_idx = 0; 1940 ccl->stack_idx = 0;
1941 ccl->eol_type = CCL_CODING_EOL_LF;
1942 return 0;
1674 } 1943 }
1675 1944
1676 /* Resolve symbols in the specified CCL code (Lisp vector). This 1945 #ifdef emacs
1677 function converts symbols of code conversion maps and character 1946
1678 translation tables embeded in the CCL code into their ID numbers. */ 1947 DEFUN ("ccl-program-p", Fccl_program_p, 1, 1, 0, /*
1679 1948 Return t if OBJECT is a CCL program name or a compiled CCL program code.
1680 static Lisp_Object 1949 See the documentation of `define-ccl-program' for the detail of CCL program.
1681 resolve_symbol_ccl_program (Lisp_Object ccl) 1950 */
1951 (object))
1682 { 1952 {
1683 int i, veclen; 1953 Lisp_Object val;
1684 Lisp_Object result, contents /*, prop */; 1954
1685 1955 if (VECTORP (object))
1686 result = ccl;
1687 veclen = XVECTOR_LENGTH (result);
1688
1689 /* Set CCL program's table ID */
1690 for (i = 0; i < veclen; i++)
1691 { 1956 {
1692 contents = XVECTOR_DATA (result)[i]; 1957 val = resolve_symbol_ccl_program (object);
1693 if (SYMBOLP (contents)) 1958 return (VECTORP (val) ? Qt : Qnil);
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 } 1959 }
1720 1960 if (!SYMBOLP (object))
1721 return result; 1961 return Qnil;
1962
1963 val = Fget (object, Qccl_program_idx, Qnil);
1964 return ((! NATNUMP (val)
1965 || XINT (val) >= XVECTOR_LENGTH (Vccl_program_table))
1966 ? Qnil : Qt);
1722 } 1967 }
1723
1724
1725 #ifdef emacs
1726 1968
1727 DEFUN ("ccl-execute", Fccl_execute, 2, 2, 0, /* 1969 DEFUN ("ccl-execute", Fccl_execute, 2, 2, 0, /*
1728 Execute CCL-PROGRAM with registers initialized by REGISTERS. 1970 Execute CCL-PROGRAM with registers initialized by REGISTERS.
1729 1971
1730 CCL-PROGRAM is a symbol registered by register-ccl-program, 1972 CCL-PROGRAM is a CCL program name (symbol)
1731 or a compiled code generated by `ccl-compile' (for backward compatibility, 1973 or a compiled code generated by `ccl-compile' (for backward compatibility,
1732 in this case, the execution is slower). 1974 in this case, the overhead of the execution is bigger than the former case).
1733 No I/O commands should appear in CCL-PROGRAM. 1975 No I/O commands should appear in CCL-PROGRAM.
1734 1976
1735 REGISTERS is a vector of [R0 R1 ... R7] where RN is an initial value 1977 REGISTERS is a vector of [R0 R1 ... R7] where RN is an initial value
1736 of Nth register. 1978 of Nth register.
1737 1979
1738 As side effect, each element of REGISTER holds the value of 1980 As side effect, each element of REGISTERS holds the value of
1739 corresponding register after the execution. 1981 corresponding register after the execution.
1982
1983 See the documentation of `define-ccl-program' for the detail of CCL program.
1740 */ 1984 */
1741 (ccl_prog, reg)) 1985 (ccl_prog, reg))
1742 { 1986 {
1743 struct ccl_program ccl; 1987 struct ccl_program ccl;
1744 int i; 1988 int i;
1745 Lisp_Object ccl_id; 1989
1746 1990 if (setup_ccl_program (&ccl, ccl_prog) < 0)
1747 if (SYMBOLP (ccl_prog) && 1991 error ("Invalid CCL program");
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 1992
1761 CHECK_VECTOR (reg); 1993 CHECK_VECTOR (reg);
1762 if (XVECTOR_LENGTH (reg) != 8) 1994 if (XVECTOR_LENGTH (reg) != 8)
1763 error ("Invalid length of vector REGISTERS"); 1995 error ("Length of vector REGISTERS is not 8");
1764 1996
1765 setup_ccl_program (&ccl, ccl_prog);
1766 for (i = 0; i < 8; i++) 1997 for (i = 0; i < 8; i++)
1767 ccl.reg[i] = (INTP (XVECTOR_DATA (reg)[i]) 1998 ccl.reg[i] = (INTP (XVECTOR_DATA (reg)[i])
1768 ? XINT (XVECTOR_DATA (reg)[i]) 1999 ? XINT (XVECTOR_DATA (reg)[i])
1769 : 0); 2000 : 0);
1770 2001
1771 ccl_driver (&ccl, (const unsigned char *)0, (unsigned_char_dynarr *)0, 2002 ccl_driver (&ccl, (const unsigned char *)0,
1772 0, (int *)0, CCL_MODE_ENCODING); 2003 (unsigned_char_dynarr *)0, 0, (int *)0,
2004 CCL_MODE_ENCODING);
1773 QUIT; 2005 QUIT;
1774 if (ccl.status != CCL_STAT_SUCCESS) 2006 if (ccl.status != CCL_STAT_SUCCESS)
1775 error ("Error in CCL program at %dth code", ccl.ic); 2007 error ("Error in CCL program at %dth code", ccl.ic);
1776 2008
1777 for (i = 0; i < 8; i++) 2009 for (i = 0; i < 8; i++)
1778 XSETINT (XVECTOR_DATA (reg)[i], ccl.reg[i]); 2010 XSETINT (XVECTOR (reg)->contents[i], ccl.reg[i]);
1779 return Qnil; 2011 return Qnil;
1780 } 2012 }
1781 2013
1782 DEFUN ("ccl-execute-on-string", Fccl_execute_on_string, 3, 4, 0, /* 2014 DEFUN ("ccl-execute-on-string", Fccl_execute_on_string,
2015 3, 4, 0, /*
1783 Execute CCL-PROGRAM with initial STATUS on STRING. 2016 Execute CCL-PROGRAM with initial STATUS on STRING.
1784 2017
1785 CCL-PROGRAM is a symbol registered by register-ccl-program, 2018 CCL-PROGRAM is a symbol registered by register-ccl-program,
1786 or a compiled code generated by `ccl-compile' (for backward compatibility, 2019 or a compiled code generated by `ccl-compile' (for backward compatibility,
1787 in this case, the execution is slower). 2020 in this case, the execution is slower).
1788 2021
1789 Read buffer is set to STRING, and write buffer is allocated automatically. 2022 Read buffer is set to STRING, and write buffer is allocated automatically.
1790 2023
1791 If IC is nil, it is initialized to head of the CCL program.\n\
1792 STATUS is a vector of [R0 R1 ... R7 IC], where 2024 STATUS is a vector of [R0 R1 ... R7 IC], where
1793 R0..R7 are initial values of corresponding registers, 2025 R0..R7 are initial values of corresponding registers,
1794 IC is the instruction counter specifying from where to start the program. 2026 IC is the instruction counter specifying from where to start the program.
1795 If R0..R7 are nil, they are initialized to 0. 2027 If R0..R7 are nil, they are initialized to 0.
1796 If IC is nil, it is initialized to head of the CCL program. 2028 If IC is nil, it is initialized to head of the CCL program.
1797 2029
1798 If optional 4th arg CONTINUE is non-nil, keep IC on read operation 2030 If optional 4th arg CONTINUE is non-nil, keep IC on read operation
1799 when read buffer is exausted, else, IC is always set to the end of 2031 when read buffer is exhausted, else, IC is always set to the end of
1800 CCL-PROGRAM on exit. 2032 CCL-PROGRAM on exit.
1801 2033
1802 It returns the contents of write buffer as a string, 2034 It returns the contents of write buffer as a string,
1803 and as side effect, STATUS is updated. 2035 and as side effect, STATUS is updated.
2036
2037 See the documentation of `define-ccl-program' for the detail of CCL program.
1804 */ 2038 */
1805 (ccl_prog, status, str, contin)) 2039 (ccl_prog, status, string, continue_))
1806 { 2040 {
1807 Lisp_Object val; 2041 Lisp_Object val;
1808 struct ccl_program ccl; 2042 struct ccl_program ccl;
1809 int i, produced; 2043 int i, produced;
1810 unsigned_char_dynarr *outbuf; 2044 unsigned_char_dynarr *outbuf;
1811 struct gcpro gcpro1, gcpro2, gcpro3; 2045 struct gcpro gcpro1, gcpro2;
1812 Lisp_Object ccl_id; 2046
1813 2047 if (setup_ccl_program (&ccl, ccl_prog) < 0)
1814 if (SYMBOLP (ccl_prog) && 2048 error ("Invalid CCL program");
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 2049
1828 CHECK_VECTOR (status); 2050 CHECK_VECTOR (status);
1829 if (XVECTOR_LENGTH (status) != 9) 2051 if (XVECTOR (status)->size != 9)
1830 signal_simple_error ("Vector should be of length 9", status); 2052 error ("Length of vector STATUS is not 9");
1831 CHECK_STRING (str); 2053 CHECK_STRING (string);
1832 GCPRO3 (ccl_prog, status, str); 2054
1833 2055 GCPRO2 (status, string);
1834 setup_ccl_program (&ccl, ccl_prog); 2056
1835 for (i = 0; i < 8; i++) 2057 for (i = 0; i < 8; i++)
1836 { 2058 {
1837 if (NILP (XVECTOR_DATA (status)[i])) 2059 if (NILP (XVECTOR_DATA (status)[i]))
1838 XSETINT (XVECTOR_DATA (status)[i], 0); 2060 XSETINT (XVECTOR_DATA (status)[i], 0);
1839 if (INTP (XVECTOR_DATA (status)[i])) 2061 if (INTP (XVECTOR_DATA (status)[i]))
1840 ccl.reg[i] = XINT (XVECTOR_DATA (status)[i]); 2062 ccl.reg[i] = XINT (XVECTOR_DATA (status)[i]);
1841 } 2063 }
1842 if (INTP (XVECTOR_DATA (status)[8])) 2064 if (INTP (XVECTOR (status)->contents[i]))
1843 { 2065 {
1844 i = XINT (XVECTOR_DATA (status)[8]); 2066 i = XINT (XVECTOR_DATA (status)[8]);
1845 if (ccl.ic < i && i < ccl.size) 2067 if (ccl.ic < i && i < ccl.size)
1846 ccl.ic = i; 2068 ccl.ic = i;
1847 } 2069 }
1848 outbuf = Dynarr_new (unsigned_char); 2070 outbuf = Dynarr_new (unsigned_char);
1849 ccl.last_block = NILP (contin); 2071 ccl.last_block = NILP (continue_);
1850 produced = ccl_driver (&ccl, XSTRING_DATA (str), outbuf, 2072 produced = ccl_driver (&ccl, XSTRING_DATA (string), outbuf,
1851 XSTRING_LENGTH (str), (int *)0, CCL_MODE_DECODING); 2073 XSTRING_LENGTH (string),
2074 (int *) 0,
2075 CCL_MODE_DECODING);
1852 for (i = 0; i < 8; i++) 2076 for (i = 0; i < 8; i++)
1853 XVECTOR_DATA (status)[i] = make_int(ccl.reg[i]); 2077 XSETINT (XVECTOR_DATA (status)[i], ccl.reg[i]);
1854 XSETINT (XVECTOR_DATA (status)[8], ccl.ic); 2078 XSETINT (XVECTOR_DATA (status)[8], ccl.ic);
1855 UNGCPRO; 2079 UNGCPRO;
1856 2080
1857 val = make_string (Dynarr_atp (outbuf, 0), produced); 2081 val = make_string (Dynarr_atp (outbuf, 0), produced);
1858 Dynarr_free (outbuf); 2082 Dynarr_free (outbuf);
1859 QUIT; 2083 QUIT;
2084 if (ccl.status == CCL_STAT_SUSPEND_BY_DST)
2085 error ("Output buffer for the CCL programs overflow");
1860 if (ccl.status != CCL_STAT_SUCCESS 2086 if (ccl.status != CCL_STAT_SUCCESS
1861 && ccl.status != CCL_STAT_SUSPEND_BY_SRC 2087 && ccl.status != CCL_STAT_SUSPEND_BY_SRC)
1862 && ccl.status != CCL_STAT_SUSPEND_BY_DST)
1863 error ("Error in CCL program at %dth code", ccl.ic); 2088 error ("Error in CCL program at %dth code", ccl.ic);
1864 2089
1865 return val; 2090 return val;
1866 } 2091 }
1867 2092
1868 DEFUN ("register-ccl-program", Fregister_ccl_program, 2, 2, 0, /* 2093 DEFUN ("register-ccl-program", Fregister_ccl_program,
1869 Register CCL program PROGRAM of NAME in `ccl-program-table'. 2094 2, 2, 0, /*
1870 PROGRAM should be a compiled code of CCL program, or nil. 2095 Register CCL program CCL-PROG as NAME in `ccl-program-table'.
2096 CCL-PROG should be a compiled CCL program (vector), or nil.
2097 If it is nil, just reserve NAME as a CCL program name.
1871 Return index number of the registered CCL program. 2098 Return index number of the registered CCL program.
1872 */ 2099 */
1873 (name, ccl_prog)) 2100 (name, ccl_prog))
1874 { 2101 {
1875 int len = XVECTOR_LENGTH (Vccl_program_table); 2102 int len = XVECTOR_LENGTH (Vccl_program_table);
1876 int i; 2103 int idx;
2104 Lisp_Object resolved;
1877 2105
1878 CHECK_SYMBOL (name); 2106 CHECK_SYMBOL (name);
2107 resolved = Qnil;
1879 if (!NILP (ccl_prog)) 2108 if (!NILP (ccl_prog))
1880 { 2109 {
1881 CHECK_VECTOR (ccl_prog); 2110 CHECK_VECTOR (ccl_prog);
1882 ccl_prog = resolve_symbol_ccl_program (ccl_prog); 2111 resolved = resolve_symbol_ccl_program (ccl_prog);
1883 } 2112 if (! NILP (resolved))
1884
1885 for (i = 0; i < len; i++)
1886 {
1887 Lisp_Object slot = XVECTOR_DATA (Vccl_program_table)[i];
1888
1889 if (!CONSP (slot))
1890 break;
1891
1892 if (EQ (name, XCAR (slot)))
1893 { 2113 {
1894 XCDR (slot) = ccl_prog; 2114 ccl_prog = resolved;
1895 return make_int (i); 2115 resolved = Qt;
1896 } 2116 }
1897 } 2117 }
1898 2118
1899 if (i == len) 2119 for (idx = 0; idx < len; idx++)
1900 { 2120 {
1901 Lisp_Object new_table = Fmake_vector (make_int (len * 2), Qnil); 2121 Lisp_Object slot;
2122
2123 slot = XVECTOR_DATA (Vccl_program_table)[idx];
2124 if (!VECTORP (slot))
2125 /* This is the first unused slot. Register NAME here. */
2126 break;
2127
2128 if (EQ (name, XVECTOR_DATA (slot)[0]))
2129 {
2130 /* Update this slot. */
2131 XVECTOR_DATA (slot)[1] = ccl_prog;
2132 XVECTOR_DATA (slot)[2] = resolved;
2133 return make_int (idx);
2134 }
2135 }
2136
2137 if (idx == len)
2138 {
2139 /* Extend the table. */
2140 Lisp_Object new_table;
1902 int j; 2141 int j;
1903 2142
2143 new_table = Fmake_vector (make_int (len * 2), Qnil);
1904 for (j = 0; j < len; j++) 2144 for (j = 0; j < len; j++)
1905 XVECTOR_DATA (new_table)[j] 2145 XVECTOR_DATA (new_table)[j]
1906 = XVECTOR_DATA (Vccl_program_table)[j]; 2146 = XVECTOR_DATA (Vccl_program_table)[j];
1907 Vccl_program_table = new_table; 2147 Vccl_program_table = new_table;
1908 } 2148 }
1909 2149
1910 XVECTOR_DATA (Vccl_program_table)[i] = Fcons (name, ccl_prog); 2150 {
1911 Fput (name, Qccl_program_idx, make_int (i)); 2151 Lisp_Object elt;
1912 return make_int (i); 2152
2153 elt = Fmake_vector (make_int (3), Qnil);
2154 XVECTOR_DATA (elt)[0] = name;
2155 XVECTOR_DATA (elt)[1] = ccl_prog;
2156 XVECTOR_DATA (elt)[2] = resolved;
2157 XVECTOR_DATA (Vccl_program_table)[idx] = elt;
2158 }
2159
2160 Fput (name, Qccl_program_idx, make_int (idx));
2161 return make_int (idx);
1913 } 2162 }
1914 2163
1915 #if 0
1916 /* Register code conversion map. 2164 /* Register code conversion map.
1917 A code conversion map consists of numbers, Qt, Qnil, and Qlambda. 2165 A code conversion map consists of numbers, Qt, Qnil, and Qlambda.
1918 The first element is start code point. 2166 The first element is start code point.
1919 The rest elements are mapped numbers. 2167 The rest elements are mapped numbers.
1920 Symbol t means to map to an original number before mapping. 2168 Symbol t means to map to an original number before mapping.
1921 Symbol nil means that the corresponding element is empty. 2169 Symbol nil means that the corresponding element is empty.
1922 Symbol lambda means to terminate mapping here. 2170 Symbol lambda means to terminate mapping here.
1923 */ 2171 */
1924 2172
1925 DEFUN ("register-code-conversion-map", Fregister_code_conversion_map, 2173 DEFUN ("register-code-conversion-map", Fregister_code_conversion_map,
1926 Sregister_code_conversion_map, 2174 2, 2, 0, /*
1927 2, 2, 0, 2175 Register SYMBOL as code conversion map MAP.
1928 "Register SYMBOL as code conversion map MAP.\n\ 2176 Return index number of the registered map.
1929 Return index number of the registered map.") 2177 */
1930 (symbol, map) 2178 (symbol, map))
1931 Lisp_Object symbol, map;
1932 { 2179 {
1933 int len = XVECTOR (Vcode_conversion_map_vector)->size; 2180 int len = XVECTOR_LENGTH (Vcode_conversion_map_vector);
1934 int i; 2181 int i;
1935 Lisp_Object index; 2182 Lisp_Object idx;
1936 2183
1937 CHECK_SYMBOL (symbol, 0); 2184 CHECK_SYMBOL (symbol);
1938 CHECK_VECTOR (map, 1); 2185 CHECK_VECTOR (map);
1939 2186
1940 for (i = 0; i < len; i++) 2187 for (i = 0; i < len; i++)
1941 { 2188 {
1942 Lisp_Object slot = XVECTOR (Vcode_conversion_map_vector)->contents[i]; 2189 Lisp_Object slot = XVECTOR_DATA (Vcode_conversion_map_vector)[i];
1943 2190
1944 if (!CONSP (slot)) 2191 if (!CONSP (slot))
1945 break; 2192 break;
1946 2193
1947 if (EQ (symbol, XCONS (slot)->car)) 2194 if (EQ (symbol, XCAR (slot)))
1948 { 2195 {
1949 index = make_int (i); 2196 idx = make_int (i);
1950 XCONS (slot)->cdr = map; 2197 XCDR (slot) = map;
1951 Fput (symbol, Qcode_conversion_map, map); 2198 Fput (symbol, Qcode_conversion_map, map);
1952 Fput (symbol, Qcode_conversion_map_id, index); 2199 Fput (symbol, Qcode_conversion_map_id, idx);
1953 return index; 2200 return idx;
1954 } 2201 }
1955 } 2202 }
1956 2203
1957 if (i == len) 2204 if (i == len)
1958 { 2205 {
1959 Lisp_Object new_vector = Fmake_vector (make_int (len * 2), Qnil); 2206 Lisp_Object new_vector = Fmake_vector (make_int (len * 2), Qnil);
1960 int j; 2207 int j;
1961 2208
1962 for (j = 0; j < len; j++) 2209 for (j = 0; j < len; j++)
1963 XVECTOR (new_vector)->contents[j] 2210 XVECTOR_DATA (new_vector)[j]
1964 = XVECTOR (Vcode_conversion_map_vector)->contents[j]; 2211 = XVECTOR_DATA (Vcode_conversion_map_vector)[j];
1965 Vcode_conversion_map_vector = new_vector; 2212 Vcode_conversion_map_vector = new_vector;
1966 } 2213 }
1967 2214
1968 index = make_int (i); 2215 idx = make_int (i);
1969 Fput (symbol, Qcode_conversion_map, map); 2216 Fput (symbol, Qcode_conversion_map, map);
1970 Fput (symbol, Qcode_conversion_map_id, index); 2217 Fput (symbol, Qcode_conversion_map_id, idx);
1971 XVECTOR (Vcode_conversion_map_vector)->contents[i] = Fcons (symbol, map); 2218 XVECTOR_DATA (Vcode_conversion_map_vector)[i] = Fcons (symbol, map);
1972 return index; 2219 return idx;
1973 } 2220 }
1974 #endif
1975 2221
1976 2222
1977 void 2223 void
1978 syms_of_mule_ccl (void) 2224 syms_of_mule_ccl (void)
1979 { 2225 {
2226 DEFSUBR (Fccl_program_p);
1980 DEFSUBR (Fccl_execute); 2227 DEFSUBR (Fccl_execute);
1981 DEFSUBR (Fccl_execute_on_string); 2228 DEFSUBR (Fccl_execute_on_string);
1982 DEFSUBR (Fregister_ccl_program); 2229 DEFSUBR (Fregister_ccl_program);
1983 #if 0 2230 DEFSUBR (Fregister_code_conversion_map);
1984 DEFSUBR (&Fregister_code_conversion_map);
1985 #endif
1986 } 2231 }
1987 2232
1988 void 2233 void
1989 vars_of_mule_ccl (void) 2234 vars_of_mule_ccl (void)
1990 { 2235 {
1991 staticpro (&Vccl_program_table); 2236 staticpro (&Vccl_program_table);
1992 Vccl_program_table = Fmake_vector (make_int (32), Qnil); 2237 Vccl_program_table = Fmake_vector (make_int (32), Qnil);
1993 2238
1994 Qccl_program = intern ("ccl-program"); 2239 defsymbol (&Qccl_program, "ccl-program");
1995 staticpro (&Qccl_program); 2240 defsymbol (&Qccl_program_idx, "ccl-program-idx");
1996 2241 defsymbol (&Qcode_conversion_map, "code-conversion-map");
1997 Qccl_program_idx = intern ("ccl-program-idx"); 2242 defsymbol (&Qcode_conversion_map_id, "code-conversion-map-id");
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 2243
2007 DEFVAR_LISP ("code-conversion-map-vector", &Vcode_conversion_map_vector /* 2244 DEFVAR_LISP ("code-conversion-map-vector", &Vcode_conversion_map_vector /*
2008 Vector of code conversion maps.*/ ); 2245 Vector of code conversion maps.
2246 */ );
2009 Vcode_conversion_map_vector = Fmake_vector (make_int (16), Qnil); 2247 Vcode_conversion_map_vector = Fmake_vector (make_int (16), Qnil);
2010 #endif
2011 2248
2012 DEFVAR_LISP ("font-ccl-encoder-alist", &Vfont_ccl_encoder_alist /* 2249 DEFVAR_LISP ("font-ccl-encoder-alist", &Vfont_ccl_encoder_alist /*
2013 Alist of fontname patterns vs corresponding CCL program. 2250 Alist of fontname patterns vs corresponding CCL program.
2014 Each element looks like (REGEXP . CCL-CODE), 2251 Each element looks like (REGEXP . CCL-CODE),
2015 where CCL-CODE is a compiled CCL program. 2252 where CCL-CODE is a compiled CCL program.