Mercurial > hg > xemacs-beta

comparison src/mule-ccl.c @ 422:95016f13131a r21-2-19

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r21-2-19
author cvs
date Mon, 13 Aug 2007 11:25:01 +0200
parents e804706bfb8c
children 11054d720c21
comparison
equal deleted inserted replaced
421:fff06e11db74 422:95016f13131a
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
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
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. */
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 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. */
658 #define CCL_INVALID_CMD \
659 do { \
660 ccl->status = CCL_STAT_INVALID_CMD; \
661 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) \
470 >> ((2 - (i % 3)) * 8)) & 0xFF); \ 695 >> ((2 - (i % 3)) * 8)) & 0xFF); \
471 } while (0) 696 } while (0)
472 697
473 /* Read one byte from the current input buffer into Rth register. */ 698 /* Read one byte from the current input buffer into Rth register. */
474 #define CCL_READ_CHAR(r) do { \ 699 #define CCL_READ_CHAR(r) do { \
475 if (!src) \ 700 if (!src && !ccl->last_block) \
476 { \ 701 { \
477 ccl->status = CCL_STAT_INVALID_CMD; \ 702 ccl->status = CCL_STAT_INVALID_CMD; \
478 goto ccl_error_handler; \ 703 goto ccl_error_handler; \
479 } \ 704 } \
480 else if (src < src_end) \ 705 else if (src < src_end) \
481 r = *src++; \ 706 r = *src++; \
482 else if (ccl->last_block) \ 707 else if (ccl->last_block) \
483 { \ 708 { \
484 ic = ccl->eof_ic; \ 709 ic = ccl->eof_ic; \
485 goto ccl_finish; \ 710 goto ccl_repeat; \
486 } \ 711 } \
487 else \ 712 else \
488 /* Suspend CCL program because of \ 713 /* Suspend CCL program because of \
489 reading from empty input buffer or \ 714 reading from empty input buffer or \
490 writing to full output buffer. \ 715 writing to full output buffer. \
491 When this program is resumed, the \ 716 When this program is resumed, the \
492 same I/O command is executed. */ \ 717 same I/O command is executed. */ \
493 { \ 718 { \
494 ic--; \ 719 ic--; \
495 ccl->status = CCL_STAT_SUSPEND; \ 720 ccl->status = CCL_STAT_SUSPEND_BY_SRC; \
496 goto ccl_finish; \ 721 goto ccl_finish; \
497 } \ 722 } \
498 } while (0) 723 } while (0)
499 724
500 725
515 { 740 {
516 Lisp_Object *ccl_prog; /* Pointer to an array of CCL code. */ 741 Lisp_Object *ccl_prog; /* Pointer to an array of CCL code. */
517 int ic; /* Instruction Counter. */ 742 int ic; /* Instruction Counter. */
518 }; 743 };
519 744
745 /* For the moment, we only support depth 256 of stack. */
746 static struct ccl_prog_stack ccl_prog_stack_struct[256];
747
520 int 748 int
521 ccl_driver (struct ccl_program *ccl, CONST unsigned char *source, unsigned_char_dynarr *destination, int src_bytes, int *consumed, int conversion_mode) 749 ccl_driver (struct ccl_program *ccl, CONST unsigned char *source,
750 unsigned_char_dynarr *destination, int src_bytes,
751 int *consumed, int conversion_mode)
522 { 752 {
523 int *reg = ccl->reg; 753 int *reg = ccl->reg;
524 int ic = ccl->ic; 754 int ic = ccl->ic;
525 int code = -1; /* init to illegal value, */ 755 int code = -1; /* init to illegal value, */
526 int field1, field2; 756 int field1, field2;
527 Lisp_Object *ccl_prog = ccl->prog; 757 Lisp_Object *ccl_prog = ccl->prog;
528 CONST unsigned char *src = source, *src_end = src + src_bytes; 758 CONST unsigned char *src = source, *src_end = src + src_bytes;
529 int jump_address = 0; /* shut up the compiler */ 759 int jump_address = 0; /* shut up the compiler */
530
531 int i, j, op; 760 int i, j, op;
532 int stack_idx = 0; 761 int stack_idx = ccl->stack_idx;
533 /* For the moment, we only support depth 256 of stack. */ 762 /* Instruction counter of the current CCL code. */
534 struct ccl_prog_stack ccl_prog_stack_struct[256]; 763 int this_ic;
535 764
536 if (ic >= ccl->eof_ic) 765 if (ic >= ccl->eof_ic)
537 ic = CCL_HEADER_MAIN; 766 ic = CCL_HEADER_MAIN;
767
768 #if 0 /* not for XEmacs ? */
769 if (ccl->buf_magnification ==0) /* We can't produce any bytes. */
770 dst = NULL;
771 #endif
538 772
539 #ifdef CCL_DEBUG 773 #ifdef CCL_DEBUG
540 ccl_backtrace_idx = 0; 774 ccl_backtrace_idx = 0;
541 #endif 775 #endif
542 776
543 for (;;) 777 for (;;)
544 { 778 {
779 ccl_repeat:
545 #ifdef CCL_DEBUG 780 #ifdef CCL_DEBUG
546 ccl_backtrace_table[ccl_backtrace_idx++] = ic; 781 ccl_backtrace_table[ccl_backtrace_idx++] = ic;
547 if (ccl_backtrace_idx >= CCL_DEBUG_BACKTRACE_LEN) 782 if (ccl_backtrace_idx >= CCL_DEBUG_BACKTRACE_LEN)
548 ccl_backtrace_idx = 0; 783 ccl_backtrace_idx = 0;
549 ccl_backtrace_table[ccl_backtrace_idx] = 0; 784 ccl_backtrace_table[ccl_backtrace_idx] = 0;
558 src = source + src_bytes; 793 src = source + src_bytes;
559 ccl->status = CCL_STAT_QUIT; 794 ccl->status = CCL_STAT_QUIT;
560 break; 795 break;
561 } 796 }
562 797
798 this_ic = ic;
563 code = XINT (ccl_prog[ic]); ic++; 799 code = XINT (ccl_prog[ic]); ic++;
564 field1 = code >> 8; 800 field1 = code >> 8;
565 field2 = (code & 0xFF) >> 5; 801 field2 = (code & 0xFF) >> 5;
566 802
567 #define rrr field2 803 #define rrr field2
568 #define RRR (field1 & 7) 804 #define RRR (field1 & 7)
569 #define Rrr ((field1 >> 3) & 7) 805 #define Rrr ((field1 >> 3) & 7)
570 #define ADDR field1 806 #define ADDR field1
807 #define EXCMD (field1 >> 6)
571 808
572 switch (code & 0x1F) 809 switch (code & 0x1F)
573 { 810 {
574 case CCL_SetRegister: /* 00000000000000000RRRrrrXXXXX */ 811 case CCL_SetRegister: /* 00000000000000000RRRrrrXXXXX */
575 reg[rrr] = reg[RRR]; 812 reg[rrr] = reg[RRR];
755 { 992 {
756 ccl_prog = ccl_prog_stack_struct[stack_idx].ccl_prog; 993 ccl_prog = ccl_prog_stack_struct[stack_idx].ccl_prog;
757 ic = ccl_prog_stack_struct[stack_idx].ic; 994 ic = ccl_prog_stack_struct[stack_idx].ic;
758 break; 995 break;
759 } 996 }
997 if (src)
998 src = src_end;
999 /* ccl->ic should points to this command code again to
1000 suppress further processing. */
1001 ic--;
760 /* Terminate CCL program successfully. */ 1002 /* Terminate CCL program successfully. */
761 ccl->status = CCL_STAT_SUCCESS; 1003 ccl->status = CCL_STAT_SUCCESS;
762 ccl->ic = CCL_HEADER_MAIN;
763 goto ccl_finish; 1004 goto ccl_finish;
764 1005
765 case CCL_ExprSelfConst: /* 00000OPERATION000000rrrXXXXX */ 1006 case CCL_ExprSelfConst: /* 00000OPERATION000000rrrXXXXX */
766 i = XINT (ccl_prog[ic]); 1007 i = XINT (ccl_prog[ic]);
767 ic++; 1008 ic++;
855 case CCL_GT: reg[rrr] = i > j; break; 1096 case CCL_GT: reg[rrr] = i > j; break;
856 case CCL_EQ: reg[rrr] = i == j; break; 1097 case CCL_EQ: reg[rrr] = i == j; break;
857 case CCL_LE: reg[rrr] = i <= j; break; 1098 case CCL_LE: reg[rrr] = i <= j; break;
858 case CCL_GE: reg[rrr] = i >= j; break; 1099 case CCL_GE: reg[rrr] = i >= j; break;
859 case CCL_NE: reg[rrr] = i != j; break; 1100 case CCL_NE: reg[rrr] = i != j; break;
1101 case CCL_DECODE_SJIS: DECODE_SJIS (i, j, reg[rrr], reg[7]); break;
860 case CCL_ENCODE_SJIS: ENCODE_SJIS (i, j, reg[rrr], reg[7]); break; 1102 case CCL_ENCODE_SJIS: ENCODE_SJIS (i, j, reg[rrr], reg[7]); break;
861 case CCL_DECODE_SJIS: DECODE_SJIS (i, j, reg[rrr], reg[7]); break;
862 default: 1103 default:
863 ccl->status = CCL_STAT_INVALID_CMD; 1104 ccl->status = CCL_STAT_INVALID_CMD;
864 goto ccl_error_handler; 1105 goto ccl_error_handler;
865 } 1106 }
866 code &= 0x1F; 1107 code &= 0x1F;
871 } 1112 }
872 else if (!reg[rrr]) 1113 else if (!reg[rrr])
873 ic = jump_address; 1114 ic = jump_address;
874 break; 1115 break;
875 1116
1117 case CCL_Extention:
1118 switch (EXCMD)
1119 {
1120 case CCL_ReadMultibyteChar2:
1121 if (!src)
1122 CCL_INVALID_CMD;
1123
1124 do {
1125 if (src >= src_end)
1126 {
1127 src++;
1128 goto ccl_read_multibyte_character_suspend;
1129 }
1130
1131 i = *src++;
1132 #if 0
1133 if (i == LEADING_CODE_COMPOSITION)
1134 {
1135 if (src >= src_end)
1136 goto ccl_read_multibyte_character_suspend;
1137 if (*src == 0xFF)
1138 {
1139 ccl->private_state = COMPOSING_WITH_RULE_HEAD;
1140 src++;
1141 }
1142 else
1143 ccl->private_state = COMPOSING_NO_RULE_HEAD;
1144
1145 continue;
1146 }
1147 if (ccl->private_state != COMPOSING_NO)
1148 {
1149 /* composite character */
1150 if (i < 0xA0)
1151 ccl->private_state = COMPOSING_NO;
1152 else
1153 {
1154 if (COMPOSING_WITH_RULE_RULE == ccl->private_state)
1155 {
1156 ccl->private_state = COMPOSING_WITH_RULE_HEAD;
1157 continue;
1158 }
1159 else if (COMPOSING_WITH_RULE_HEAD == ccl->private_state)
1160 ccl->private_state = COMPOSING_WITH_RULE_RULE;
1161
1162 if (i == 0xA0)
1163 {
1164 if (src >= src_end)
1165 goto ccl_read_multibyte_character_suspend;
1166 i = *src++ & 0x7F;
1167 }
1168 else
1169 i -= 0x20;
1170 }
1171 }
1172 #endif
1173
1174 if (i < 0x80)
1175 {
1176 /* ASCII */
1177 reg[rrr] = i;
1178 reg[RRR] = LEADING_BYTE_ASCII;
1179 }
1180 else if (i <= MAX_LEADING_BYTE_OFFICIAL_1)
1181 {
1182 if (src >= src_end)
1183 goto ccl_read_multibyte_character_suspend;
1184 reg[RRR] = i;
1185 reg[rrr] = (*src++ & 0x7F);
1186 }
1187 else if (i <= MAX_LEADING_BYTE_OFFICIAL_2)
1188 {
1189 if ((src + 1) >= src_end)
1190 goto ccl_read_multibyte_character_suspend;
1191 reg[RRR] = i;
1192 i = (*src++ & 0x7F);
1193 reg[rrr] = ((i << 7) | (*src & 0x7F));
1194 src++;
1195 }
1196 else if (i == PRE_LEADING_BYTE_PRIVATE_1)
1197 {
1198 if ((src + 1) >= src_end)
1199 goto ccl_read_multibyte_character_suspend;
1200 reg[RRR] = *src++;
1201 reg[rrr] = (*src++ & 0x7F);
1202 }
1203 else if (i == PRE_LEADING_BYTE_PRIVATE_2)
1204 {
1205 if ((src + 2) >= src_end)
1206 goto ccl_read_multibyte_character_suspend;
1207 reg[RRR] = *src++;
1208 i = (*src++ & 0x7F);
1209 reg[rrr] = ((i << 7) | (*src & 0x7F));
1210 src++;
1211 }
1212 else
1213 {
1214 /* INVALID CODE. Return a single byte character. */
1215 reg[RRR] = LEADING_BYTE_ASCII;
1216 reg[rrr] = i;
1217 }
1218 break;
1219 } while (1);
1220 break;
1221
1222 ccl_read_multibyte_character_suspend:
1223 src--;
1224 if (ccl->last_block)
1225 {
1226 ic = ccl->eof_ic;
1227 goto ccl_repeat;
1228 }
1229 else
1230 CCL_SUSPEND (CCL_STAT_SUSPEND_BY_SRC);
1231
1232 break;
1233
1234 case CCL_WriteMultibyteChar2:
1235 i = reg[RRR]; /* charset */
1236 if (i == LEADING_BYTE_ASCII)
1237 i = reg[rrr] & 0xFF;
1238 #if 0
1239 else if (i == CHARSET_COMPOSITION)
1240 i = MAKE_COMPOSITE_CHAR (reg[rrr]);
1241 #endif
1242 else if (XCHARSET_DIMENSION (CHARSET_BY_LEADING_BYTE (i)) == 1)
1243 i = ((i - FIELD2_TO_OFFICIAL_LEADING_BYTE) << 7)
1244 | (reg[rrr] & 0x7F);
1245 else if (i < MIN_LEADING_BYTE_OFFICIAL_2)
1246 i = ((i - FIELD1_TO_OFFICIAL_LEADING_BYTE) << 14) | reg[rrr];
1247 else
1248 i = ((i - FIELD1_TO_PRIVATE_LEADING_BYTE) << 14) | reg[rrr];
1249
1250 CCL_WRITE_CHAR (i);
1251
1252 break;
1253
1254 #if 0
1255 case CCL_TranslateCharacter:
1256 i = reg[RRR]; /* charset */
1257 if (i == LEADING_BYTE_ASCII)
1258 i = reg[rrr];
1259 else if (i == CHARSET_COMPOSITION)
1260 {
1261 reg[RRR] = -1;
1262 break;
1263 }
1264 else if (CHARSET_DIMENSION (i) == 1)
1265 i = ((i - 0x70) << 7) | (reg[rrr] & 0x7F);
1266 else if (i < MIN_LEADING_BYTE_OFFICIAL_2)
1267 i = ((i - 0x8F) << 14) | (reg[rrr] & 0x3FFF);
1268 else
1269 i = ((i - 0xE0) << 14) | (reg[rrr] & 0x3FFF);
1270
1271 op = translate_char (GET_TRANSLATION_TABLE (reg[Rrr]),
1272 i, -1, 0, 0);
1273 SPLIT_CHAR (op, reg[RRR], i, j);
1274 if (j != -1)
1275 i = (i << 7) | j;
1276
1277 reg[rrr] = i;
1278 break;
1279
1280 case CCL_TranslateCharacterConstTbl:
1281 op = XINT (ccl_prog[ic]); /* table */
1282 ic++;
1283 i = reg[RRR]; /* charset */
1284 if (i == LEADING_BYTE_ASCII)
1285 i = reg[rrr];
1286 else if (i == CHARSET_COMPOSITION)
1287 {
1288 reg[RRR] = -1;
1289 break;
1290 }
1291 else if (CHARSET_DIMENSION (i) == 1)
1292 i = ((i - 0x70) << 7) | (reg[rrr] & 0x7F);
1293 else if (i < MIN_LEADING_BYTE_OFFICIAL_2)
1294 i = ((i - 0x8F) << 14) | (reg[rrr] & 0x3FFF);
1295 else
1296 i = ((i - 0xE0) << 14) | (reg[rrr] & 0x3FFF);
1297
1298 op = translate_char (GET_TRANSLATION_TABLE (op), i, -1, 0, 0);
1299 SPLIT_CHAR (op, reg[RRR], i, j);
1300 if (j != -1)
1301 i = (i << 7) | j;
1302
1303 reg[rrr] = i;
1304 break;
1305
1306 case CCL_IterateMultipleMap:
1307 {
1308 Lisp_Object map, content, attrib, value;
1309 int point, size, fin_ic;
1310
1311 j = XINT (ccl_prog[ic++]); /* number of maps. */
1312 fin_ic = ic + j;
1313 op = reg[rrr];
1314 if ((j > reg[RRR]) && (j >= 0))
1315 {
1316 ic += reg[RRR];
1317 i = reg[RRR];
1318 }
1319 else
1320 {
1321 reg[RRR] = -1;
1322 ic = fin_ic;
1323 break;
1324 }
1325
1326 for (;i < j;i++)
1327 {
1328
1329 size = XVECTOR (Vcode_conversion_map_vector)->size;
1330 point = XINT (ccl_prog[ic++]);
1331 if (point >= size) continue;
1332 map =
1333 XVECTOR (Vcode_conversion_map_vector)->contents[point];
1334
1335 /* Check map varidity. */
1336 if (!CONSP (map)) continue;
1337 map = XCONS(map)->cdr;
1338 if (!VECTORP (map)) continue;
1339 size = XVECTOR (map)->size;
1340 if (size <= 1) continue;
1341
1342 content = XVECTOR (map)->contents[0];
1343
1344 /* check map type,
1345 [STARTPOINT VAL1 VAL2 ...] or
1346 [t ELELMENT STARTPOINT ENDPOINT] */
1347 if (NUMBERP (content))
1348 {
1349 point = XUINT (content);
1350 point = op - point + 1;
1351 if (!((point >= 1) && (point < size))) continue;
1352 content = XVECTOR (map)->contents[point];
1353 }
1354 else if (EQ (content, Qt))
1355 {
1356 if (size != 4) continue;
1357 if ((op >= XUINT (XVECTOR (map)->contents[2]))
1358 && (op < XUINT (XVECTOR (map)->contents[3])))
1359 content = XVECTOR (map)->contents[1];
1360 else
1361 continue;
1362 }
1363 else
1364 continue;
1365
1366 if (NILP (content))
1367 continue;
1368 else if (NUMBERP (content))
1369 {
1370 reg[RRR] = i;
1371 reg[rrr] = XINT(content);
1372 break;
1373 }
1374 else if (EQ (content, Qt) || EQ (content, Qlambda))
1375 {
1376 reg[RRR] = i;
1377 break;
1378 }
1379 else if (CONSP (content))
1380 {
1381 attrib = XCONS (content)->car;
1382 value = XCONS (content)->cdr;
1383 if (!NUMBERP (attrib) || !NUMBERP (value))
1384 continue;
1385 reg[RRR] = i;
1386 reg[rrr] = XUINT (value);
1387 break;
1388 }
1389 }
1390 if (i == j)
1391 reg[RRR] = -1;
1392 ic = fin_ic;
1393 }
1394 break;
1395
1396 case CCL_MapMultiple:
1397 {
1398 Lisp_Object map, content, attrib, value;
1399 int point, size, map_vector_size;
1400 int map_set_rest_length, fin_ic;
1401
1402 map_set_rest_length =
1403 XINT (ccl_prog[ic++]); /* number of maps and separators. */
1404 fin_ic = ic + map_set_rest_length;
1405 if ((map_set_rest_length > reg[RRR]) && (reg[RRR] >= 0))
1406 {
1407 ic += reg[RRR];
1408 i = reg[RRR];
1409 map_set_rest_length -= i;
1410 }
1411 else
1412 {
1413 ic = fin_ic;
1414 reg[RRR] = -1;
1415 break;
1416 }
1417 mapping_stack_pointer = mapping_stack;
1418 op = reg[rrr];
1419 PUSH_MAPPING_STACK (0, op);
1420 reg[RRR] = -1;
1421 map_vector_size = XVECTOR (Vcode_conversion_map_vector)->size;
1422 for (;map_set_rest_length > 0;i++, map_set_rest_length--)
1423 {
1424 point = XINT(ccl_prog[ic++]);
1425 if (point < 0)
1426 {
1427 point = -point;
1428 if (mapping_stack_pointer
1429 >= &mapping_stack[MAX_MAP_SET_LEVEL])
1430 {
1431 CCL_INVALID_CMD;
1432 }
1433 PUSH_MAPPING_STACK (map_set_rest_length - point,
1434 reg[rrr]);
1435 map_set_rest_length = point + 1;
1436 reg[rrr] = op;
1437 continue;
1438 }
1439
1440 if (point >= map_vector_size) continue;
1441 map = (XVECTOR (Vcode_conversion_map_vector)
1442 ->contents[point]);
1443
1444 /* Check map varidity. */
1445 if (!CONSP (map)) continue;
1446 map = XCONS (map)->cdr;
1447 if (!VECTORP (map)) continue;
1448 size = XVECTOR (map)->size;
1449 if (size <= 1) continue;
1450
1451 content = XVECTOR (map)->contents[0];
1452
1453 /* check map type,
1454 [STARTPOINT VAL1 VAL2 ...] or
1455 [t ELEMENT STARTPOINT ENDPOINT] */
1456 if (NUMBERP (content))
1457 {
1458 point = XUINT (content);
1459 point = op - point + 1;
1460 if (!((point >= 1) && (point < size))) continue;
1461 content = XVECTOR (map)->contents[point];
1462 }
1463 else if (EQ (content, Qt))
1464 {
1465 if (size != 4) continue;
1466 if ((op >= XUINT (XVECTOR (map)->contents[2])) &&
1467 (op < XUINT (XVECTOR (map)->contents[3])))
1468 content = XVECTOR (map)->contents[1];
1469 else
1470 continue;
1471 }
1472 else
1473 continue;
1474
1475 if (NILP (content))
1476 continue;
1477 else if (NUMBERP (content))
1478 {
1479 op = XINT (content);
1480 reg[RRR] = i;
1481 i += map_set_rest_length;
1482 POP_MAPPING_STACK (map_set_rest_length, reg[rrr]);
1483 }
1484 else if (CONSP (content))
1485 {
1486 attrib = XCONS (content)->car;
1487 value = XCONS (content)->cdr;
1488 if (!NUMBERP (attrib) || !NUMBERP (value))
1489 continue;
1490 reg[RRR] = i;
1491 op = XUINT (value);
1492 i += map_set_rest_length;
1493 POP_MAPPING_STACK (map_set_rest_length, reg[rrr]);
1494 }
1495 else if (EQ (content, Qt))
1496 {
1497 reg[RRR] = i;
1498 op = reg[rrr];
1499 i += map_set_rest_length;
1500 POP_MAPPING_STACK (map_set_rest_length, reg[rrr]);
1501 }
1502 else if (EQ (content, Qlambda))
1503 {
1504 break;
1505 }
1506 else
1507 CCL_INVALID_CMD;
1508 }
1509 ic = fin_ic;
1510 }
1511 reg[rrr] = op;
1512 break;
1513
1514 case CCL_MapSingle:
1515 {
1516 Lisp_Object map, attrib, value, content;
1517 int size, point;
1518 j = XINT (ccl_prog[ic++]); /* map_id */
1519 op = reg[rrr];
1520 if (j >= XVECTOR (Vcode_conversion_map_vector)->size)
1521 {
1522 reg[RRR] = -1;
1523 break;
1524 }
1525 map = XVECTOR (Vcode_conversion_map_vector)->contents[j];
1526 if (!CONSP (map))
1527 {
1528 reg[RRR] = -1;
1529 break;
1530 }
1531 map = XCONS(map)->cdr;
1532 if (!VECTORP (map))
1533 {
1534 reg[RRR] = -1;
1535 break;
1536 }
1537 size = XVECTOR (map)->size;
1538 point = XUINT (XVECTOR (map)->contents[0]);
1539 point = op - point + 1;
1540 reg[RRR] = 0;
1541 if ((size <= 1) ||
1542 (!((point >= 1) && (point < size))))
1543 reg[RRR] = -1;
1544 else
1545 {
1546 content = XVECTOR (map)->contents[point];
1547 if (NILP (content))
1548 reg[RRR] = -1;
1549 else if (NUMBERP (content))
1550 reg[rrr] = XINT (content);
1551 else if (EQ (content, Qt))
1552 reg[RRR] = i;
1553 else if (CONSP (content))
1554 {
1555 attrib = XCONS (content)->car;
1556 value = XCONS (content)->cdr;
1557 if (!NUMBERP (attrib) || !NUMBERP (value))
1558 continue;
1559 reg[rrr] = XUINT(value);
1560 break;
1561 }
1562 else
1563 reg[RRR] = -1;
1564 }
1565 }
1566 break;
1567 #endif
1568
1569 default:
1570 CCL_INVALID_CMD;
1571 }
1572 break;
1573
876 default: 1574 default:
877 ccl->status = CCL_STAT_INVALID_CMD; 1575 ccl->status = CCL_STAT_INVALID_CMD;
878 goto ccl_error_handler; 1576 goto ccl_error_handler;
879 } 1577 }
880 } 1578 }
885 /* We can insert an error message only if DESTINATION is 1583 /* We can insert an error message only if DESTINATION is
886 specified and we still have a room to store the message 1584 specified and we still have a room to store the message
887 there. */ 1585 there. */
888 char msg[256]; 1586 char msg[256];
889 1587
1588 #if 0 /* not for XEmacs ? */
1589 if (!dst)
1590 dst = destination;
1591 #endif
1592
890 switch (ccl->status) 1593 switch (ccl->status)
891 { 1594 {
892 /* Terminate CCL program because of invalid command. 1595 /* Terminate CCL program because of invalid command.
893 Should not occur in the normal case. */ 1596 Should not occur in the normal case. */
894 case CCL_STAT_INVALID_CMD: 1597 case CCL_STAT_INVALID_CMD:
895 sprintf(msg, "\nCCL: Invalid command %x (ccl_code = %x) at %d.", 1598 sprintf(msg, "\nCCL: Invalid command %x (ccl_code = %x) at %d.",
896 code & 0x1F, code, ic); 1599 code & 0x1F, code, this_ic);
897 #ifdef CCL_DEBUG 1600 #ifdef CCL_DEBUG
898 { 1601 {
899 int i = ccl_backtrace_idx - 1; 1602 int i = ccl_backtrace_idx - 1;
900 int j; 1603 int j;
901 1604
907 if (ccl_backtrace_table[i] == 0) 1610 if (ccl_backtrace_table[i] == 0)
908 break; 1611 break;
909 sprintf(msg, " %d", ccl_backtrace_table[i]); 1612 sprintf(msg, " %d", ccl_backtrace_table[i]);
910 Dynarr_add_many (destination, (unsigned char *) msg, strlen (msg)); 1613 Dynarr_add_many (destination, (unsigned char *) msg, strlen (msg));
911 } 1614 }
1615 goto ccl_finish;
912 } 1616 }
913 #endif 1617 #endif
914 goto ccl_finish; 1618 break;
915 1619
916 case CCL_STAT_QUIT: 1620 case CCL_STAT_QUIT:
917 sprintf(msg, "\nCCL: Quited."); 1621 sprintf(msg, "\nCCL: Quited.");
918 break; 1622 break;
919 1623
924 Dynarr_add_many (destination, (unsigned char *) msg, strlen (msg)); 1628 Dynarr_add_many (destination, (unsigned char *) msg, strlen (msg));
925 } 1629 }
926 1630
927 ccl_finish: 1631 ccl_finish:
928 ccl->ic = ic; 1632 ccl->ic = ic;
1633 ccl->stack_idx = stack_idx;
1634 ccl->prog = ccl_prog;
929 if (consumed) *consumed = src - source; 1635 if (consumed) *consumed = src - source;
930 if (destination) 1636 if (destination)
931 return Dynarr_length (destination); 1637 return Dynarr_length (destination);
932 else 1638 else
933 return 0; 1639 return 0;
934 } 1640 }
935 1641
936 /* Setup fields of the structure pointed by CCL appropriately for the 1642 /* Setup fields of the structure pointed by CCL appropriately for the
937 execution of compiled CCL code in VEC (vector of integer). */ 1643 execution of compiled CCL code in VEC (vector of integer).
1644 If VEC is nil, we skip setting ups based on VEC. */
938 void 1645 void
939 setup_ccl_program (struct ccl_program *ccl, Lisp_Object vec) 1646 setup_ccl_program (struct ccl_program *ccl, Lisp_Object vec)
940 { 1647 {
941 int i; 1648 int i;
942 1649
943 ccl->size = XVECTOR_LENGTH (vec); 1650 if (VECTORP (vec))
944 ccl->prog = XVECTOR_DATA (vec); 1651 {
1652 ccl->size = XVECTOR_LENGTH (vec);
1653 ccl->prog = XVECTOR_DATA (vec);
1654 ccl->eof_ic = XINT (XVECTOR_DATA (vec)[CCL_HEADER_EOF]);
1655 ccl->buf_magnification = XINT (XVECTOR_DATA (vec)[CCL_HEADER_BUF_MAG]);
1656 }
945 ccl->ic = CCL_HEADER_MAIN; 1657 ccl->ic = CCL_HEADER_MAIN;
946 ccl->eof_ic = XINT (XVECTOR_DATA (vec)[CCL_HEADER_EOF]);
947 ccl->buf_magnification = XINT (XVECTOR_DATA (vec)[CCL_HEADER_BUF_MAG]);
948 for (i = 0; i < 8; i++) 1658 for (i = 0; i < 8; i++)
949 ccl->reg[i] = 0; 1659 ccl->reg[i] = 0;
950 ccl->last_block = 0; 1660 ccl->last_block = 0;
1661 ccl->private_state = 0;
951 ccl->status = 0; 1662 ccl->status = 0;
1663 ccl->stack_idx = 0;
952 } 1664 }
1665
1666 /* Resolve symbols in the specified CCL code (Lisp vector). This
1667 function converts symbols of code conversion maps and character
1668 translation tables embeded in the CCL code into their ID numbers. */
1669
1670 Lisp_Object
1671 resolve_symbol_ccl_program (Lisp_Object ccl)
1672 {
1673 int i, veclen;
1674 Lisp_Object result, contents /*, prop */;
1675
1676 result = ccl;
1677 veclen = XVECTOR_LENGTH (result);
1678
1679 /* Set CCL program's table ID */
1680 for (i = 0; i < veclen; i++)
1681 {
1682 contents = XVECTOR_DATA (result)[i];
1683 if (SYMBOLP (contents))
1684 {
1685 if (EQ(result, ccl))
1686 result = Fcopy_sequence (ccl);
1687
1688 #if 0
1689 prop = Fget (contents, Qtranslation_table_id);
1690 if (NUMBERP (prop))
1691 {
1692 XVECTOR_DATA (result)[i] = prop;
1693 continue;
1694 }
1695 prop = Fget (contents, Qcode_conversion_map_id);
1696 if (NUMBERP (prop))
1697 {
1698 XVECTOR_DATA (result)[i] = prop;
1699 continue;
1700 }
1701 prop = Fget (contents, Qccl_program_idx);
1702 if (NUMBERP (prop))
1703 {
1704 XVECTOR_DATA (result)[i] = prop;
1705 continue;
1706 }
1707 #endif
1708 }
1709 }
1710
1711 return result;
1712 }
1713
953 1714
954 #ifdef emacs 1715 #ifdef emacs
955 1716
956 DEFUN ("ccl-execute", Fccl_execute, 2, 2, 0, /* 1717 DEFUN ("ccl-execute", Fccl_execute, 2, 2, 0, /*
957 Execute CCL-PROGRAM with registers initialized by REGISTERS. 1718 Execute CCL-PROGRAM with registers initialized by REGISTERS.
958 CCL-PROGRAM is a compiled code generated by `ccl-compile', 1719
959 no I/O commands should appear in the CCL program. 1720 CCL-PROGRAM is a symbol registered by register-ccl-program,
1721 or a compiled code generated by `ccl-compile' (for backward compatibility,
1722 in this case, the execution is slower).
1723 No I/O commands should appear in CCL-PROGRAM.
1724
960 REGISTERS is a vector of [R0 R1 ... R7] where RN is an initial value 1725 REGISTERS is a vector of [R0 R1 ... R7] where RN is an initial value
961 of Nth register. 1726 of Nth register.
1727
962 As side effect, each element of REGISTER holds the value of 1728 As side effect, each element of REGISTER holds the value of
963 corresponding register after the execution. 1729 corresponding register after the execution.
964 */ 1730 */
965 (ccl_prog, reg)) 1731 (ccl_prog, reg))
966 { 1732 {
967 struct ccl_program ccl; 1733 struct ccl_program ccl;
968 int i; 1734 int i;
969 1735 Lisp_Object ccl_id;
970 CHECK_VECTOR (ccl_prog); 1736
1737 if ((SYMBOLP (ccl_prog)) &&
1738 (!NILP (ccl_id = Fget (ccl_prog, Qccl_program_idx, Qnil))))
1739 {
1740 ccl_prog = XVECTOR_DATA (Vccl_program_table)[XUINT (ccl_id)];
1741 CHECK_LIST (ccl_prog);
1742 ccl_prog = XCDR (ccl_prog);
1743 CHECK_VECTOR (ccl_prog);
1744 }
1745 else
1746 {
1747 CHECK_VECTOR (ccl_prog);
1748 ccl_prog = resolve_symbol_ccl_program (ccl_prog);
1749 }
1750
971 CHECK_VECTOR (reg); 1751 CHECK_VECTOR (reg);
972 if (XVECTOR_LENGTH (reg) != 8) 1752 if (XVECTOR_LENGTH (reg) != 8)
973 signal_simple_error ("Vector should be of length 8", reg); 1753 error ("Invalid length of vector REGISTERS");
974 1754
975 setup_ccl_program (&ccl, ccl_prog); 1755 setup_ccl_program (&ccl, ccl_prog);
976 for (i = 0; i < 8; i++) 1756 for (i = 0; i < 8; i++)
977 ccl.reg[i] = (INTP (XVECTOR_DATA (reg)[i]) 1757 ccl.reg[i] = (INTP (XVECTOR_DATA (reg)[i])
978 ? XINT (XVECTOR_DATA (reg)[i]) 1758 ? XINT (XVECTOR_DATA (reg)[i])
989 return Qnil; 1769 return Qnil;
990 } 1770 }
991 1771
992 DEFUN ("ccl-execute-on-string", Fccl_execute_on_string, 3, 4, 0, /* 1772 DEFUN ("ccl-execute-on-string", Fccl_execute_on_string, 3, 4, 0, /*
993 Execute CCL-PROGRAM with initial STATUS on STRING. 1773 Execute CCL-PROGRAM with initial STATUS on STRING.
994 CCL-PROGRAM is a compiled code generated by `ccl-compile'. 1774
1775 CCL-PROGRAM is a symbol registered by register-ccl-program,
1776 or a compiled code generated by `ccl-compile' (for backward compatibility,
1777 in this case, the execution is slower).
1778
995 Read buffer is set to STRING, and write buffer is allocated automatically. 1779 Read buffer is set to STRING, and write buffer is allocated automatically.
1780
1781 If IC is nil, it is initialized to head of the CCL program.\n\
996 STATUS is a vector of [R0 R1 ... R7 IC], where 1782 STATUS is a vector of [R0 R1 ... R7 IC], where
997 R0..R7 are initial values of corresponding registers, 1783 R0..R7 are initial values of corresponding registers,
998 IC is the instruction counter specifying from where to start the program. 1784 IC is the instruction counter specifying from where to start the program.
999 If R0..R7 are nil, they are initialized to 0. 1785 If R0..R7 are nil, they are initialized to 0.
1000 If IC is nil, it is initialized to head of the CCL program. 1786 If IC is nil, it is initialized to head of the CCL program.
1001 Returns the contents of write buffer as a string, 1787
1002 and as side effect, STATUS is updated.
1003 If optional 4th arg CONTINUE is non-nil, keep IC on read operation 1788 If optional 4th arg CONTINUE is non-nil, keep IC on read operation
1004 when read buffer is exausted, else, IC is always set to the end of 1789 when read buffer is exausted, else, IC is always set to the end of
1005 CCL-PROGRAM on exit. 1790 CCL-PROGRAM on exit.
1791
1792 It returns the contents of write buffer as a string,
1793 and as side effect, STATUS is updated.
1006 */ 1794 */
1007 (ccl_prog, status, str, contin)) 1795 (ccl_prog, status, str, contin))
1008 { 1796 {
1009 Lisp_Object val; 1797 Lisp_Object val;
1010 struct ccl_program ccl; 1798 struct ccl_program ccl;
1011 int i, produced; 1799 int i, produced;
1012 unsigned_char_dynarr *outbuf; 1800 unsigned_char_dynarr *outbuf;
1013 struct gcpro gcpro1, gcpro2, gcpro3; 1801 struct gcpro gcpro1, gcpro2, gcpro3;
1014 1802 Lisp_Object ccl_id;
1015 CHECK_VECTOR (ccl_prog); 1803
1804 if ((SYMBOLP (ccl_prog)) &&
1805 (!NILP (ccl_id = Fget (ccl_prog, Qccl_program_idx, Qnil))))
1806 {
1807 ccl_prog = XVECTOR (Vccl_program_table)->contents[XUINT (ccl_id)];
1808 CHECK_LIST (ccl_prog);
1809 ccl_prog = XCDR (ccl_prog);
1810 CHECK_VECTOR (ccl_prog);
1811 }
1812 else
1813 {
1814 CHECK_VECTOR (ccl_prog);
1815 ccl_prog = resolve_symbol_ccl_program (ccl_prog);
1816 }
1817
1016 CHECK_VECTOR (status); 1818 CHECK_VECTOR (status);
1017 if (XVECTOR_LENGTH (status) != 9) 1819 if (XVECTOR_LENGTH (status) != 9)
1018 signal_simple_error ("Vector should be of length 9", status); 1820 signal_simple_error ("Vector should be of length 9", status);
1019 CHECK_STRING (str); 1821 CHECK_STRING (str);
1020 GCPRO3 (ccl_prog, status, str); 1822 GCPRO3 (ccl_prog, status, str);
1044 1846
1045 val = make_string (Dynarr_atp (outbuf, 0), produced); 1847 val = make_string (Dynarr_atp (outbuf, 0), produced);
1046 Dynarr_free (outbuf); 1848 Dynarr_free (outbuf);
1047 QUIT; 1849 QUIT;
1048 if (ccl.status != CCL_STAT_SUCCESS 1850 if (ccl.status != CCL_STAT_SUCCESS
1049 && ccl.status != CCL_STAT_SUSPEND) 1851 && ccl.status != CCL_STAT_SUSPEND_BY_SRC
1852 && ccl.status != CCL_STAT_SUSPEND_BY_DST)
1050 error ("Error in CCL program at %dth code", ccl.ic); 1853 error ("Error in CCL program at %dth code", ccl.ic);
1051 1854
1052 return val; 1855 return val;
1053 } 1856 }
1054 1857
1062 int len = XVECTOR_LENGTH (Vccl_program_table); 1865 int len = XVECTOR_LENGTH (Vccl_program_table);
1063 int i; 1866 int i;
1064 1867
1065 CHECK_SYMBOL (name); 1868 CHECK_SYMBOL (name);
1066 if (!NILP (ccl_prog)) 1869 if (!NILP (ccl_prog))
1067 CHECK_VECTOR (ccl_prog); 1870 {
1871 CHECK_VECTOR (ccl_prog);
1872 ccl_prog = resolve_symbol_ccl_program (ccl_prog);
1873 }
1068 1874
1069 for (i = 0; i < len; i++) 1875 for (i = 0; i < len; i++)
1070 { 1876 {
1071 Lisp_Object slot = XVECTOR_DATA (Vccl_program_table)[i]; 1877 Lisp_Object slot = XVECTOR_DATA (Vccl_program_table)[i];
1072 1878
1090 = XVECTOR_DATA (Vccl_program_table)[j]; 1896 = XVECTOR_DATA (Vccl_program_table)[j];
1091 Vccl_program_table = new_table; 1897 Vccl_program_table = new_table;
1092 } 1898 }
1093 1899
1094 XVECTOR_DATA (Vccl_program_table)[i] = Fcons (name, ccl_prog); 1900 XVECTOR_DATA (Vccl_program_table)[i] = Fcons (name, ccl_prog);
1901 Fput (name, Qccl_program_idx, make_int (i));
1095 return make_int (i); 1902 return make_int (i);
1096 } 1903 }
1904
1905 #if 0
1906 /* Register code conversion map.
1907 A code conversion map consists of numbers, Qt, Qnil, and Qlambda.
1908 The first element is start code point.
1909 The rest elements are mapped numbers.
1910 Symbol t means to map to an original number before mapping.
1911 Symbol nil means that the corresponding element is empty.
1912 Symbol lambda menas to terminate mapping here.
1913 */
1914
1915 DEFUN ("register-code-conversion-map", Fregister_code_conversion_map,
1916 Sregister_code_conversion_map,
1917 2, 2, 0,
1918 "Register SYMBOL as code conversion map MAP.\n\
1919 Return index number of the registered map.")
1920 (symbol, map)
1921 Lisp_Object symbol, map;
1922 {
1923 int len = XVECTOR (Vcode_conversion_map_vector)->size;
1924 int i;
1925 Lisp_Object index;
1926
1927 CHECK_SYMBOL (symbol, 0);
1928 CHECK_VECTOR (map, 1);
1929
1930 for (i = 0; i < len; i++)
1931 {
1932 Lisp_Object slot = XVECTOR (Vcode_conversion_map_vector)->contents[i];
1933
1934 if (!CONSP (slot))
1935 break;
1936
1937 if (EQ (symbol, XCONS (slot)->car))
1938 {
1939 index = make_int (i);
1940 XCONS (slot)->cdr = map;
1941 Fput (symbol, Qcode_conversion_map, map);
1942 Fput (symbol, Qcode_conversion_map_id, index);
1943 return index;
1944 }
1945 }
1946
1947 if (i == len)
1948 {
1949 Lisp_Object new_vector = Fmake_vector (make_int (len * 2), Qnil);
1950 int j;
1951
1952 for (j = 0; j < len; j++)
1953 XVECTOR (new_vector)->contents[j]
1954 = XVECTOR (Vcode_conversion_map_vector)->contents[j];
1955 Vcode_conversion_map_vector = new_vector;
1956 }
1957
1958 index = make_int (i);
1959 Fput (symbol, Qcode_conversion_map, map);
1960 Fput (symbol, Qcode_conversion_map_id, index);
1961 XVECTOR (Vcode_conversion_map_vector)->contents[i] = Fcons (symbol, map);
1962 return index;
1963 }
1964 #endif
1965
1097 1966
1098 void 1967 void
1099 syms_of_mule_ccl (void) 1968 syms_of_mule_ccl (void)
1100 { 1969 {
1101 DEFSUBR (Fccl_execute); 1970 DEFSUBR (Fccl_execute);
1102 DEFSUBR (Fccl_execute_on_string); 1971 DEFSUBR (Fccl_execute_on_string);
1103 DEFSUBR (Fregister_ccl_program); 1972 DEFSUBR (Fregister_ccl_program);
1973 #if 0
1974 DEFSUBR (&Fregister_code_conversion_map);
1975 #endif
1104 } 1976 }
1105 1977
1106 void 1978 void
1107 vars_of_mule_ccl (void) 1979 vars_of_mule_ccl (void)
1108 { 1980 {
1109 staticpro (&Vccl_program_table); 1981 staticpro (&Vccl_program_table);
1110 Vccl_program_table = Fmake_vector (make_int (32), Qnil); 1982 Vccl_program_table = Fmake_vector (make_int (32), Qnil);
1983
1984 Qccl_program = intern ("ccl-program");
1985 staticpro (&Qccl_program);
1986
1987 Qccl_program_idx = intern ("ccl-program-idx");
1988 staticpro (&Qccl_program_idx);
1989
1990 #if 0
1991 Qcode_conversion_map = intern ("code-conversion-map");
1992 staticpro (&Qcode_conversion_map);
1993
1994 Qcode_conversion_map_id = intern ("code-conversion-map-id");
1995 staticpro (&Qcode_conversion_map_id);
1996
1997 DEFVAR_LISP ("code-conversion-map-vector", &Vcode_conversion_map_vector /*
1998 Vector of code conversion maps.*/ );
1999 Vcode_conversion_map_vector = Fmake_vector (make_int (16), Qnil);
2000 #endif
1111 2001
1112 DEFVAR_LISP ("font-ccl-encoder-alist", &Vfont_ccl_encoder_alist /* 2002 DEFVAR_LISP ("font-ccl-encoder-alist", &Vfont_ccl_encoder_alist /*
1113 Alist of fontname patterns vs corresponding CCL program. 2003 Alist of fontname patterns vs corresponding CCL program.
1114 Each element looks like (REGEXP . CCL-CODE), 2004 Each element looks like (REGEXP . CCL-CODE),
1115 where CCL-CODE is a compiled CCL program. 2005 where CCL-CODE is a compiled CCL program.