Mercurial > hg > xemacs-beta

comparison src/mule-ccl.c @ 412:697ef44129c6 r21-2-14

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r21-2-14
author cvs
date Mon, 13 Aug 2007 11:20:41 +0200
parents 74fd4e045ea6
children da8ed4261e83
comparison
equal deleted inserted replaced
411:12e008d41344 412:697ef44129c6
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 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.3.10 without ExCCL 22 /* Synched up with : FSF Emacs 20.2 */
23 * (including {Read|Write}MultibyteChar) */
24 23
25 #ifdef emacs 24 #ifdef emacs
26 25
27 #include <config.h> 26 #include <config.h>
28
29 #if 0
30 #ifdef STDC_HEADERS
31 #include <stdlib.h>
32 #endif
33 #endif
34
35 #include "lisp.h" 27 #include "lisp.h"
36 #include "buffer.h" 28 #include "buffer.h"
37 #include "mule-charset.h" 29 #include "mule-charset.h"
38 #include "mule-ccl.h" 30 #include "mule-ccl.h"
39 #include "file-coding.h" 31 #include "file-coding.h"
43 #include <stdio.h> 35 #include <stdio.h>
44 #include "mulelib.h" 36 #include "mulelib.h"
45 37
46 #endif /* not emacs */ 38 #endif /* not emacs */
47 39
48 /* This contains all code conversion map available to CCL. */
49 /*
50 Lisp_Object Vcode_conversion_map_vector;
51 */
52
53 /* Alist of fontname patterns vs corresponding CCL program. */ 40 /* Alist of fontname patterns vs corresponding CCL program. */
54 Lisp_Object Vfont_ccl_encoder_alist; 41 Lisp_Object Vfont_ccl_encoder_alist;
55
56 /* This symbol is a property which assocates with ccl program vector.
57 Ex: (get 'ccl-big5-encoder 'ccl-program) returns ccl program vector. */
58 Lisp_Object Qccl_program;
59
60 /* These symbols are properties which associate with code conversion
61 map and their ID respectively. */
62 /*
63 Lisp_Object Qcode_conversion_map;
64 Lisp_Object Qcode_conversion_map_id;
65 */
66
67 /* Symbols of ccl program have this property, a value of the property
68 is an index for Vccl_protram_table. */
69 Lisp_Object Qccl_program_idx;
70 42
71 /* Vector of CCL program names vs corresponding program data. */ 43 /* Vector of CCL program names vs corresponding program data. */
72 Lisp_Object Vccl_program_table; 44 Lisp_Object Vccl_program_table;
73 45
74 /* CCL (Code Conversion Language) is a simple language which has 46 /* CCL (Code Conversion Language) is a simple language which has
179 /* Note: If read is suspended, the resumed execution starts from the 151 /* Note: If read is suspended, the resumed execution starts from the
180 second code (YYYYY == CCL_ReadJump). */ 152 second code (YYYYY == CCL_ReadJump). */
181 153
182 #define CCL_WriteConstJump 0x08 /* Write constant and jump: 154 #define CCL_WriteConstJump 0x08 /* Write constant and jump:
183 1:A--D--D--R--E--S--S-000XXXXX 155 1:A--D--D--R--E--S--S-000XXXXX
184 2:const 156 2:CONST
185 ------------------------------ 157 ------------------------------
186 write (const); 158 write (CONST);
187 IC += ADDRESS; 159 IC += ADDRESS;
188 */ 160 */
189 161
190 #define CCL_WriteConstReadJump 0x09 /* Write constant, read, and jump: 162 #define CCL_WriteConstReadJump 0x09 /* Write constant, read, and jump:
191 1:A--D--D--R--E--S--S-rrrXXXXX 163 1:A--D--D--R--E--S--S-rrrXXXXX
192 2:const 164 2:CONST
193 3:A--D--D--R--E--S--S-rrrYYYYY 165 3:A--D--D--R--E--S--S-rrrYYYYY
194 ----------------------------- 166 -----------------------------
195 write (const); 167 write (CONST);
196 IC += 2; 168 IC += 2;
197 read (reg[rrr]); 169 read (reg[rrr]);
198 IC += ADDRESS; 170 IC += ADDRESS;
199 */ 171 */
200 /* Note: If read is suspended, the resumed execution starts from the 172 /* Note: If read is suspended, the resumed execution starts from the
297 1:00000OPERATIONRrrRRR000XXXXX 269 1:00000OPERATIONRrrRRR000XXXXX
298 ------------------------------ 270 ------------------------------
299 write (reg[RRR] OPERATION reg[Rrr]); 271 write (reg[RRR] OPERATION reg[Rrr]);
300 */ 272 */
301 273
302 #define CCL_Call 0x13 /* Call the CCL program whose ID is 274 #define CCL_Call 0x13 /* Write a constant:
303 (CC..C).
304 1:CCCCCCCCCCCCCCCCCCCC000XXXXX 275 1:CCCCCCCCCCCCCCCCCCCC000XXXXX
305 ------------------------------ 276 ------------------------------
306 call (CC..C) 277 call (CC..C)
307 */ 278 */
308 279
420 IC += ADDRESS; 391 IC += ADDRESS;
421 else 392 else
422 IC += 2; 393 IC += 2;
423 */ 394 */
424 395
425 #define CCL_Extension 0x1F /* Extended CCL code 396 #define CCL_Extention 0x1F /* Extended CCL code
426 1:ExtendedCOMMNDRrrRRRrrrXXXXX 397 1:ExtendedCOMMNDRrrRRRrrrXXXXX
427 2:ARGUEMENT 398 2:ARGUEMENT
428 3:... 399 3:...
429 ------------------------------ 400 ------------------------------
430 extended_command (rrr,RRR,Rrr,ARGS) 401 extended_command (rrr,RRR,Rrr,ARGS)
431 */ 402 */
432 403
433 /*
434 Here after, Extended CCL Instructions.
435 Bit length of extended command is 14.
436 Therefore, the instruction code range is 0..16384(0x3fff).
437 */
438
439 /* Read a multibyte characeter.
440 A code point is stored into reg[rrr]. A charset ID is stored into
441 reg[RRR]. */
442
443 #define CCL_ReadMultibyteChar2 0x00 /* Read Multibyte Character
444 1:ExtendedCOMMNDRrrRRRrrrXXXXX */
445
446 /* Write a multibyte character.
447 Write a character whose code point is reg[rrr] and the charset ID
448 is reg[RRR]. */
449
450 #define CCL_WriteMultibyteChar2 0x01 /* Write Multibyte Character
451 1:ExtendedCOMMNDRrrRRRrrrXXXXX */
452
453 #if 0
454 /* Translate a character whose code point is reg[rrr] and the charset
455 ID is reg[RRR] by a translation table whose ID is reg[Rrr].
456
457 A translated character is set in reg[rrr] (code point) and reg[RRR]
458 (charset ID). */
459
460 #define CCL_TranslateCharacter 0x02 /* Translate a multibyte character
461 1:ExtendedCOMMNDRrrRRRrrrXXXXX */
462
463 /* Translate a character whose code point is reg[rrr] and the charset
464 ID is reg[RRR] by a translation table whose ID is ARGUMENT.
465
466 A translated character is set in reg[rrr] (code point) and reg[RRR]
467 (charset ID). */
468
469 #define CCL_TranslateCharacterConstTbl 0x03 /* Translate a multibyte character
470 1:ExtendedCOMMNDRrrRRRrrrXXXXX
471 2:ARGUMENT(Translation Table ID)
472 */
473
474 /* Iterate looking up MAPs for reg[rrr] starting from the Nth (N =
475 reg[RRR]) MAP until some value is found.
476
477 Each MAP is a Lisp vector whose element is number, nil, t, or
478 lambda.
479 If the element is nil, ignore the map and proceed to the next map.
480 If the element is t or lambda, finish without changing reg[rrr].
481 If the element is a number, set reg[rrr] to the number and finish.
482
483 Detail of the map structure is descibed in the comment for
484 CCL_MapMultiple below. */
485
486 #define CCL_IterateMultipleMap 0x10 /* Iterate multiple maps
487 1:ExtendedCOMMNDXXXRRRrrrXXXXX
488 2:NUMBER of MAPs
489 3:MAP-ID1
490 4:MAP-ID2
491 ...
492 */
493
494 /* Map the code in reg[rrr] by MAPs starting from the Nth (N =
495 reg[RRR]) map.
496
497 MAPs are supplied in the succeeding CCL codes as follows:
498
499 When CCL program gives this nested structure of map to this command:
500 ((MAP-ID11
501 MAP-ID12
502 (MAP-ID121 MAP-ID122 MAP-ID123)
503 MAP-ID13)
504 (MAP-ID21
505 (MAP-ID211 (MAP-ID2111) MAP-ID212)
506 MAP-ID22)),
507 the compiled CCL codes has this sequence:
508 CCL_MapMultiple (CCL code of this command)
509 16 (total number of MAPs and SEPARATORs)
510 -7 (1st SEPARATOR)
511 MAP-ID11
512 MAP-ID12
513 -3 (2nd SEPARATOR)
514 MAP-ID121
515 MAP-ID122
516 MAP-ID123
517 MAP-ID13
518 -7 (3rd SEPARATOR)
519 MAP-ID21
520 -4 (4th SEPARATOR)
521 MAP-ID211
522 -1 (5th SEPARATOR)
523 MAP_ID2111
524 MAP-ID212
525 MAP-ID22
526
527 A value of each SEPARATOR follows this rule:
528 MAP-SET := SEPARATOR [(MAP-ID | MAP-SET)]+
529 SEPARATOR := -(number of MAP-IDs and SEPARATORs in the MAP-SET)
530
531 (*)....Nest level of MAP-SET must not be over than MAX_MAP_SET_LEVEL.
532
533 When some map fails to map (i.e. it doesn't have a value for
534 reg[rrr]), the mapping is treated as identity.
535
536 The mapping is iterated for all maps in each map set (set of maps
537 separated by SEPARATOR) except in the case that lambda is
538 encountered. More precisely, the mapping proceeds as below:
539
540 At first, VAL0 is set to reg[rrr], and it is translated by the
541 first map to VAL1. Then, VAL1 is translated by the next map to
542 VAL2. This mapping is iterated until the last map is used. The
543 result of the mapping is the last value of VAL?.
544
545 But, when VALm is mapped to VALn and VALn is not a number, the
546 mapping proceed as below:
547
548 If VALn is nil, the lastest map is ignored and the mapping of VALm
549 proceed to the next map.
550
551 In VALn is t, VALm is reverted to reg[rrr] and the mapping of VALm
552 proceed to the next map.
553
554 If VALn is lambda, the whole mapping process terminates, and VALm
555 is the result of this mapping.
556
557 Each map is a Lisp vector of the following format (a) or (b):
558 (a)......[STARTPOINT VAL1 VAL2 ...]
559 (b)......[t VAL STARTPOINT ENDPOINT],
560 where
561 STARTPOINT is an offset to be used for indexing a map,
562 ENDPOINT is a maximum index number of a map,
563 VAL and VALn is a number, nil, t, or lambda.
564
565 Valid index range of a map of type (a) is:
566 STARTPOINT <= index < STARTPOINT + map_size - 1
567 Valid index range of a map of type (b) is:
568 STARTPOINT <= index < ENDPOINT */
569
570 #define CCL_MapMultiple 0x11 /* Mapping by multiple code conversion maps
571 1:ExtendedCOMMNDXXXRRRrrrXXXXX
572 2:N-2
573 3:SEPARATOR_1 (< 0)
574 4:MAP-ID_1
575 5:MAP-ID_2
576 ...
577 M:SEPARATOR_x (< 0)
578 M+1:MAP-ID_y
579 ...
580 N:SEPARATOR_z (< 0)
581 */
582
583 #define MAX_MAP_SET_LEVEL 20
584
585 typedef struct
586 {
587 int rest_length;
588 int orig_val;
589 } tr_stack;
590
591 static tr_stack mapping_stack[MAX_MAP_SET_LEVEL];
592 static tr_stack *mapping_stack_pointer;
593 #endif
594
595 #define PUSH_MAPPING_STACK(restlen, orig) \
596 { \
597 mapping_stack_pointer->rest_length = (restlen); \
598 mapping_stack_pointer->orig_val = (orig); \
599 mapping_stack_pointer++; \
600 }
601
602 #define POP_MAPPING_STACK(restlen, orig) \
603 { \
604 mapping_stack_pointer--; \
605 (restlen) = mapping_stack_pointer->rest_length; \
606 (orig) = mapping_stack_pointer->orig_val; \
607 } \
608
609 #define CCL_MapSingle 0x12 /* Map by single code conversion map
610 1:ExtendedCOMMNDXXXRRRrrrXXXXX
611 2:MAP-ID
612 ------------------------------
613 Map reg[rrr] by MAP-ID.
614 If some valid mapping is found,
615 set reg[rrr] to the result,
616 else
617 set reg[RRR] to -1.
618 */
619 404
620 /* CCL arithmetic/logical operators. */ 405 /* CCL arithmetic/logical operators. */
621 #define CCL_PLUS 0x00 /* X = Y + Z */ 406 #define CCL_PLUS 0x00 /* X = Y + Z */
622 #define CCL_MINUS 0x01 /* X = Y - Z */ 407 #define CCL_MINUS 0x01 /* X = Y - Z */
623 #define CCL_MUL 0x02 /* X = Y * Z */ 408 #define CCL_MUL 0x02 /* X = Y * Z */
636 #define CCL_EQ 0x12 /* X = (X == Y) */ 421 #define CCL_EQ 0x12 /* X = (X == Y) */
637 #define CCL_LE 0x13 /* X = (X <= Y) */ 422 #define CCL_LE 0x13 /* X = (X <= Y) */
638 #define CCL_GE 0x14 /* X = (X >= Y) */ 423 #define CCL_GE 0x14 /* X = (X >= Y) */
639 #define CCL_NE 0x15 /* X = (X != Y) */ 424 #define CCL_NE 0x15 /* X = (X != Y) */
640 425
641 #define CCL_DECODE_SJIS 0x16 /* X = HIGHER_BYTE (DE-SJIS (Y, Z)) 426 #define CCL_ENCODE_SJIS 0x16 /* X = HIGHER_BYTE (SJIS (Y, Z))
427 r[7] = LOWER_BYTE (SJIS (Y, Z) */
428 #define CCL_DECODE_SJIS 0x17 /* X = HIGHER_BYTE (DE-SJIS (Y, Z))
642 r[7] = LOWER_BYTE (DE-SJIS (Y, Z)) */ 429 r[7] = LOWER_BYTE (DE-SJIS (Y, Z)) */
643 #define CCL_ENCODE_SJIS 0x17 /* X = HIGHER_BYTE (SJIS (Y, Z)) 430
644 r[7] = LOWER_BYTE (SJIS (Y, Z) */ 431 /* Macros for exit status of CCL program. */
645 432 #define CCL_STAT_SUCCESS 0 /* Terminated successfully. */
646 /* Suspend CCL program because of reading from empty input buffer or 433 #define CCL_STAT_SUSPEND 1 /* Terminated because of empty input
647 writing to full output buffer. When this program is resumed, the 434 buffer or full output buffer. */
648 same I/O command is executed. The `if (1)' is for warning suppression. */ 435 #define CCL_STAT_INVALID_CMD 2 /* Terminated because of invalid
649 #define CCL_SUSPEND(stat) \ 436 command. */
650 do { \ 437 #define CCL_STAT_QUIT 3 /* Terminated because of quit. */
651 ic--; \
652 ccl->status = stat; \
653 if (1) goto ccl_finish; \
654 } while (0)
655
656 /* Terminate CCL program because of invalid command. Should not occur
657 in the normal case. The `if (1)' is for warning suppression. */
658 #define CCL_INVALID_CMD \
659 do { \
660 ccl->status = CCL_STAT_INVALID_CMD; \
661 if (1) goto ccl_error_handler; \
662 } while (0)
663 438
664 /* Encode one character CH to multibyte form and write to the current 439 /* 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. */ 440 output buffer. If CH is less than 256, CH is written as is. */
666 #define CCL_WRITE_CHAR(ch) do { \ 441 #define CCL_WRITE_CHAR(ch) do { \
667 if (!destination) \ 442 if (!destination) \
670 goto ccl_error_handler; \ 445 goto ccl_error_handler; \
671 } \ 446 } \
672 else \ 447 else \
673 { \ 448 { \
674 Bufbyte work[MAX_EMCHAR_LEN]; \ 449 Bufbyte work[MAX_EMCHAR_LEN]; \
675 int len = ( ch < ( conversion_mode == CCL_MODE_ENCODING ? \ 450 int len = ( ch < 256 ) ? \
676 256 : 128 ) ) ? \
677 simple_set_charptr_emchar (work, ch) : \ 451 simple_set_charptr_emchar (work, ch) : \
678 non_ascii_set_charptr_emchar (work, ch); \ 452 non_ascii_set_charptr_emchar (work, ch); \
679 Dynarr_add_many (destination, work, len); \ 453 Dynarr_add_many (destination, work, len); \
680 } \ 454 } \
681 } while (0) 455 } while (0)
682 456
683 /* Write a string at ccl_prog[IC] of length LEN to the current output 457 /* Write a string at ccl_prog[IC] of length LEN to the current output
684 buffer. */ 458 buffer. */
685 #define CCL_WRITE_STRING(len) do { \ 459 #define CCL_WRITE_STRING(len) do { \
686 if (!destination) \ 460 if (!destination) \
687 { \ 461 { \
688 ccl->status = CCL_STAT_INVALID_CMD; \ 462 ccl->status = CCL_STAT_INVALID_CMD; \
689 goto ccl_error_handler; \ 463 goto ccl_error_handler; \
690 } \ 464 } \
691 else \ 465 else \
692 { \ 466 for (i = 0; i < len; i++) \
693 Bufbyte work[MAX_EMCHAR_LEN]; \ 467 Dynarr_add(destination, \
694 for (i = 0; i < len; i++) \ 468 (XINT (ccl_prog[ic + (i / 3)]) \
695 { \ 469 >> ((2 - (i % 3)) * 8)) & 0xFF); \
696 int ch = (XINT (ccl_prog[ic + (i / 3)]) \
697 >> ((2 - (i % 3)) * 8)) & 0xFF; \
698 int bytes = \
699 ( ch < ( conversion_mode == CCL_MODE_ENCODING ? \
700 256 : 128 ) ) ? \
701 simple_set_charptr_emchar (work, ch) : \
702 non_ascii_set_charptr_emchar (work, ch); \
703 Dynarr_add_many (destination, work, bytes); \
704 } \
705 } \
706 } while (0) 470 } while (0)
707 471
708 /* Read one byte from the current input buffer into Rth register. */ 472 /* Read one byte from the current input buffer into Rth register. */
709 #define CCL_READ_CHAR(r) do { \ 473 #define CCL_READ_CHAR(r) do { \
710 if (!src && !ccl->last_block) \ 474 if (!src) \
711 { \ 475 { \
712 ccl->status = CCL_STAT_INVALID_CMD; \ 476 ccl->status = CCL_STAT_INVALID_CMD; \
713 goto ccl_error_handler; \ 477 goto ccl_error_handler; \
714 } \ 478 } \
715 else if (src < src_end) \ 479 else if (src < src_end) \
716 r = *src++; \ 480 r = *src++; \
717 else if (ccl->last_block) \ 481 else if (ccl->last_block) \
718 { \ 482 { \
719 ic = ccl->eof_ic; \ 483 ic = ccl->eof_ic; \
720 goto ccl_repeat; \ 484 goto ccl_finish; \
721 } \ 485 } \
722 else \ 486 else \
723 /* Suspend CCL program because of \ 487 /* Suspend CCL program because of \
724 reading from empty input buffer or \ 488 reading from empty input buffer or \
725 writing to full output buffer. \ 489 writing to full output buffer. \
726 When this program is resumed, the \ 490 When this program is resumed, the \
727 same I/O command is executed. */ \ 491 same I/O command is executed. */ \
728 { \ 492 { \
729 ic--; \ 493 ic--; \
730 ccl->status = CCL_STAT_SUSPEND_BY_SRC; \ 494 ccl->status = CCL_STAT_SUSPEND; \
731 goto ccl_finish; \ 495 goto ccl_finish; \
732 } \ 496 } \
733 } while (0) 497 } while (0)
734 498
735 499
750 { 514 {
751 Lisp_Object *ccl_prog; /* Pointer to an array of CCL code. */ 515 Lisp_Object *ccl_prog; /* Pointer to an array of CCL code. */
752 int ic; /* Instruction Counter. */ 516 int ic; /* Instruction Counter. */
753 }; 517 };
754 518
755 /* For the moment, we only support depth 256 of stack. */
756 static struct ccl_prog_stack ccl_prog_stack_struct[256];
757
758 int 519 int
759 ccl_driver (struct ccl_program *ccl, const unsigned char *source, 520 ccl_driver (struct ccl_program *ccl, CONST unsigned char *source, unsigned_char_dynarr *destination, int src_bytes, int *consumed)
760 unsigned_char_dynarr *destination, int src_bytes,
761 int *consumed, int conversion_mode)
762 { 521 {
763 int *reg = ccl->reg; 522 int *reg = ccl->reg;
764 int ic = ccl->ic; 523 int ic = ccl->ic;
765 int code = -1; /* init to illegal value, */ 524 int code = -1; /* init to illegal value, */
766 int field1, field2; 525 int field1, field2;
767 Lisp_Object *ccl_prog = ccl->prog; 526 Lisp_Object *ccl_prog = ccl->prog;
768 const unsigned char *src = source, *src_end = src + src_bytes; 527 CONST unsigned char *src = source, *src_end = src + src_bytes;
769 int jump_address = 0; /* shut up the compiler */ 528 int jump_address = 0; /* shut up the compiler */
529
770 int i, j, op; 530 int i, j, op;
771 int stack_idx = ccl->stack_idx; 531 int stack_idx = 0;
772 /* Instruction counter of the current CCL code. */ 532 /* For the moment, we only support depth 256 of stack. */
773 int this_ic = 0; 533 struct ccl_prog_stack ccl_prog_stack_struct[256];
774 534
775 if (ic >= ccl->eof_ic) 535 if (ic >= ccl->eof_ic)
776 ic = CCL_HEADER_MAIN; 536 ic = CCL_HEADER_MAIN;
777
778 #if 0 /* not for XEmacs ? */
779 if (ccl->buf_magnification ==0) /* We can't produce any bytes. */
780 dst = NULL;
781 #endif
782 537
783 #ifdef CCL_DEBUG 538 #ifdef CCL_DEBUG
784 ccl_backtrace_idx = 0; 539 ccl_backtrace_idx = 0;
785 #endif 540 #endif
786 541
787 for (;;) 542 for (;;)
788 { 543 {
789 ccl_repeat:
790 #ifdef CCL_DEBUG 544 #ifdef CCL_DEBUG
791 ccl_backtrace_table[ccl_backtrace_idx++] = ic; 545 ccl_backtrace_table[ccl_backtrace_idx++] = ic;
792 if (ccl_backtrace_idx >= CCL_DEBUG_BACKTRACE_LEN) 546 if (ccl_backtrace_idx >= CCL_DEBUG_BACKTRACE_LEN)
793 ccl_backtrace_idx = 0; 547 ccl_backtrace_idx = 0;
794 ccl_backtrace_table[ccl_backtrace_idx] = 0; 548 ccl_backtrace_table[ccl_backtrace_idx] = 0;
803 src = source + src_bytes; 557 src = source + src_bytes;
804 ccl->status = CCL_STAT_QUIT; 558 ccl->status = CCL_STAT_QUIT;
805 break; 559 break;
806 } 560 }
807 561
808 this_ic = ic;
809 code = XINT (ccl_prog[ic]); ic++; 562 code = XINT (ccl_prog[ic]); ic++;
810 field1 = code >> 8; 563 field1 = code >> 8;
811 field2 = (code & 0xFF) >> 5; 564 field2 = (code & 0xFF) >> 5;
812 565
813 #define rrr field2 566 #define rrr field2
814 #define RRR (field1 & 7) 567 #define RRR (field1 & 7)
815 #define Rrr ((field1 >> 3) & 7) 568 #define Rrr ((field1 >> 3) & 7)
816 #define ADDR field1 569 #define ADDR field1
817 #define EXCMD (field1 >> 6)
818 570
819 switch (code & 0x1F) 571 switch (code & 0x1F)
820 { 572 {
821 case CCL_SetRegister: /* 00000000000000000RRRrrrXXXXX */ 573 case CCL_SetRegister: /* 00000000000000000RRRrrrXXXXX */
822 reg[rrr] = reg[RRR]; 574 reg[rrr] = reg[RRR];
1002 { 754 {
1003 ccl_prog = ccl_prog_stack_struct[stack_idx].ccl_prog; 755 ccl_prog = ccl_prog_stack_struct[stack_idx].ccl_prog;
1004 ic = ccl_prog_stack_struct[stack_idx].ic; 756 ic = ccl_prog_stack_struct[stack_idx].ic;
1005 break; 757 break;
1006 } 758 }
1007 if (src)
1008 src = src_end;
1009 /* ccl->ic should points to this command code again to
1010 suppress further processing. */
1011 ic--;
1012 /* Terminate CCL program successfully. */ 759 /* Terminate CCL program successfully. */
1013 ccl->status = CCL_STAT_SUCCESS; 760 ccl->status = CCL_STAT_SUCCESS;
761 ccl->ic = CCL_HEADER_MAIN;
1014 goto ccl_finish; 762 goto ccl_finish;
1015 763
1016 case CCL_ExprSelfConst: /* 00000OPERATION000000rrrXXXXX */ 764 case CCL_ExprSelfConst: /* 00000OPERATION000000rrrXXXXX */
1017 i = XINT (ccl_prog[ic]); 765 i = XINT (ccl_prog[ic]);
1018 ic++; 766 ic++;
1106 case CCL_GT: reg[rrr] = i > j; break; 854 case CCL_GT: reg[rrr] = i > j; break;
1107 case CCL_EQ: reg[rrr] = i == j; break; 855 case CCL_EQ: reg[rrr] = i == j; break;
1108 case CCL_LE: reg[rrr] = i <= j; break; 856 case CCL_LE: reg[rrr] = i <= j; break;
1109 case CCL_GE: reg[rrr] = i >= j; break; 857 case CCL_GE: reg[rrr] = i >= j; break;
1110 case CCL_NE: reg[rrr] = i != j; break; 858 case CCL_NE: reg[rrr] = i != j; break;
859 case CCL_ENCODE_SJIS: ENCODE_SJIS (i, j, reg[rrr], reg[7]); break;
1111 case CCL_DECODE_SJIS: DECODE_SJIS (i, j, reg[rrr], reg[7]); break; 860 case CCL_DECODE_SJIS: DECODE_SJIS (i, j, reg[rrr], reg[7]); break;
1112 case CCL_ENCODE_SJIS: ENCODE_SJIS (i, j, reg[rrr], reg[7]); break;
1113 default: 861 default:
1114 ccl->status = CCL_STAT_INVALID_CMD; 862 ccl->status = CCL_STAT_INVALID_CMD;
1115 goto ccl_error_handler; 863 goto ccl_error_handler;
1116 } 864 }
1117 code &= 0x1F; 865 code &= 0x1F;
1122 } 870 }
1123 else if (!reg[rrr]) 871 else if (!reg[rrr])
1124 ic = jump_address; 872 ic = jump_address;
1125 break; 873 break;
1126 874
1127 case CCL_Extension:
1128 switch (EXCMD)
1129 {
1130 case CCL_ReadMultibyteChar2:
1131 if (!src)
1132 CCL_INVALID_CMD;
1133
1134 do {
1135 if (src >= src_end)
1136 {
1137 src++;
1138 goto ccl_read_multibyte_character_suspend;
1139 }
1140
1141 i = *src++;
1142 #if 0
1143 if (i == LEADING_CODE_COMPOSITION)
1144 {
1145 if (src >= src_end)
1146 goto ccl_read_multibyte_character_suspend;
1147 if (*src == 0xFF)
1148 {
1149 ccl->private_state = COMPOSING_WITH_RULE_HEAD;
1150 src++;
1151 }
1152 else
1153 ccl->private_state = COMPOSING_NO_RULE_HEAD;
1154
1155 continue;
1156 }
1157 if (ccl->private_state != COMPOSING_NO)
1158 {
1159 /* composite character */
1160 if (i < 0xA0)
1161 ccl->private_state = COMPOSING_NO;
1162 else
1163 {
1164 if (COMPOSING_WITH_RULE_RULE == ccl->private_state)
1165 {
1166 ccl->private_state = COMPOSING_WITH_RULE_HEAD;
1167 continue;
1168 }
1169 else if (COMPOSING_WITH_RULE_HEAD == ccl->private_state)
1170 ccl->private_state = COMPOSING_WITH_RULE_RULE;
1171
1172 if (i == 0xA0)
1173 {
1174 if (src >= src_end)
1175 goto ccl_read_multibyte_character_suspend;
1176 i = *src++ & 0x7F;
1177 }
1178 else
1179 i -= 0x20;
1180 }
1181 }
1182 #endif
1183
1184 if (i < 0x80)
1185 {
1186 /* ASCII */
1187 reg[rrr] = i;
1188 reg[RRR] = LEADING_BYTE_ASCII;
1189 }
1190 else if (i <= MAX_LEADING_BYTE_OFFICIAL_1)
1191 {
1192 if (src >= src_end)
1193 goto ccl_read_multibyte_character_suspend;
1194 reg[RRR] = i;
1195 reg[rrr] = (*src++ & 0x7F);
1196 }
1197 else if (i <= MAX_LEADING_BYTE_OFFICIAL_2)
1198 {
1199 if ((src + 1) >= src_end)
1200 goto ccl_read_multibyte_character_suspend;
1201 reg[RRR] = i;
1202 i = (*src++ & 0x7F);
1203 reg[rrr] = ((i << 7) | (*src & 0x7F));
1204 src++;
1205 }
1206 else if (i == PRE_LEADING_BYTE_PRIVATE_1)
1207 {
1208 if ((src + 1) >= src_end)
1209 goto ccl_read_multibyte_character_suspend;
1210 reg[RRR] = *src++;
1211 reg[rrr] = (*src++ & 0x7F);
1212 }
1213 else if (i == PRE_LEADING_BYTE_PRIVATE_2)
1214 {
1215 if ((src + 2) >= src_end)
1216 goto ccl_read_multibyte_character_suspend;
1217 reg[RRR] = *src++;
1218 i = (*src++ & 0x7F);
1219 reg[rrr] = ((i << 7) | (*src & 0x7F));
1220 src++;
1221 }
1222 else
1223 {
1224 /* INVALID CODE. Return a single byte character. */
1225 reg[RRR] = LEADING_BYTE_ASCII;
1226 reg[rrr] = i;
1227 }
1228 break;
1229 } while (1);
1230 break;
1231
1232 ccl_read_multibyte_character_suspend:
1233 src--;
1234 if (ccl->last_block)
1235 {
1236 ic = ccl->eof_ic;
1237 goto ccl_repeat;
1238 }
1239 else
1240 CCL_SUSPEND (CCL_STAT_SUSPEND_BY_SRC);
1241
1242 break;
1243
1244 case CCL_WriteMultibyteChar2:
1245 i = reg[RRR]; /* charset */
1246 if (i == LEADING_BYTE_ASCII)
1247 i = reg[rrr] & 0xFF;
1248 #if 0
1249 else if (i == CHARSET_COMPOSITION)
1250 i = MAKE_COMPOSITE_CHAR (reg[rrr]);
1251 #endif
1252 else if (XCHARSET_DIMENSION (CHARSET_BY_LEADING_BYTE (i)) == 1)
1253 i = ((i - FIELD2_TO_OFFICIAL_LEADING_BYTE) << 7)
1254 | (reg[rrr] & 0x7F);
1255 else if (i < MIN_LEADING_BYTE_OFFICIAL_2)
1256 i = ((i - FIELD1_TO_OFFICIAL_LEADING_BYTE) << 14) | reg[rrr];
1257 else
1258 i = ((i - FIELD1_TO_PRIVATE_LEADING_BYTE) << 14) | reg[rrr];
1259
1260 CCL_WRITE_CHAR (i);
1261
1262 break;
1263
1264 #if 0
1265 case CCL_TranslateCharacter:
1266 i = reg[RRR]; /* charset */
1267 if (i == LEADING_BYTE_ASCII)
1268 i = reg[rrr];
1269 else if (i == CHARSET_COMPOSITION)
1270 {
1271 reg[RRR] = -1;
1272 break;
1273 }
1274 else if (CHARSET_DIMENSION (i) == 1)
1275 i = ((i - 0x70) << 7) | (reg[rrr] & 0x7F);
1276 else if (i < MIN_LEADING_BYTE_OFFICIAL_2)
1277 i = ((i - 0x8F) << 14) | (reg[rrr] & 0x3FFF);
1278 else
1279 i = ((i - 0xE0) << 14) | (reg[rrr] & 0x3FFF);
1280
1281 op = translate_char (GET_TRANSLATION_TABLE (reg[Rrr]),
1282 i, -1, 0, 0);
1283 SPLIT_CHAR (op, reg[RRR], i, j);
1284 if (j != -1)
1285 i = (i << 7) | j;
1286
1287 reg[rrr] = i;
1288 break;
1289
1290 case CCL_TranslateCharacterConstTbl:
1291 op = XINT (ccl_prog[ic]); /* table */
1292 ic++;
1293 i = reg[RRR]; /* charset */
1294 if (i == LEADING_BYTE_ASCII)
1295 i = reg[rrr];
1296 else if (i == CHARSET_COMPOSITION)
1297 {
1298 reg[RRR] = -1;
1299 break;
1300 }
1301 else if (CHARSET_DIMENSION (i) == 1)
1302 i = ((i - 0x70) << 7) | (reg[rrr] & 0x7F);
1303 else if (i < MIN_LEADING_BYTE_OFFICIAL_2)
1304 i = ((i - 0x8F) << 14) | (reg[rrr] & 0x3FFF);
1305 else
1306 i = ((i - 0xE0) << 14) | (reg[rrr] & 0x3FFF);
1307
1308 op = translate_char (GET_TRANSLATION_TABLE (op), i, -1, 0, 0);
1309 SPLIT_CHAR (op, reg[RRR], i, j);
1310 if (j != -1)
1311 i = (i << 7) | j;
1312
1313 reg[rrr] = i;
1314 break;
1315
1316 case CCL_IterateMultipleMap:
1317 {
1318 Lisp_Object map, content, attrib, value;
1319 int point, size, fin_ic;
1320
1321 j = XINT (ccl_prog[ic++]); /* number of maps. */
1322 fin_ic = ic + j;
1323 op = reg[rrr];
1324 if ((j > reg[RRR]) && (j >= 0))
1325 {
1326 ic += reg[RRR];
1327 i = reg[RRR];
1328 }
1329 else
1330 {
1331 reg[RRR] = -1;
1332 ic = fin_ic;
1333 break;
1334 }
1335
1336 for (;i < j;i++)
1337 {
1338
1339 size = XVECTOR (Vcode_conversion_map_vector)->size;
1340 point = XINT (ccl_prog[ic++]);
1341 if (point >= size) continue;
1342 map =
1343 XVECTOR (Vcode_conversion_map_vector)->contents[point];
1344
1345 /* Check map varidity. */
1346 if (!CONSP (map)) continue;
1347 map = XCONS(map)->cdr;
1348 if (!VECTORP (map)) continue;
1349 size = XVECTOR (map)->size;
1350 if (size <= 1) continue;
1351
1352 content = XVECTOR (map)->contents[0];
1353
1354 /* check map type,
1355 [STARTPOINT VAL1 VAL2 ...] or
1356 [t ELELMENT STARTPOINT ENDPOINT] */
1357 if (NUMBERP (content))
1358 {
1359 point = XUINT (content);
1360 point = op - point + 1;
1361 if (!((point >= 1) && (point < size))) continue;
1362 content = XVECTOR (map)->contents[point];
1363 }
1364 else if (EQ (content, Qt))
1365 {
1366 if (size != 4) continue;
1367 if ((op >= XUINT (XVECTOR (map)->contents[2]))
1368 && (op < XUINT (XVECTOR (map)->contents[3])))
1369 content = XVECTOR (map)->contents[1];
1370 else
1371 continue;
1372 }
1373 else
1374 continue;
1375
1376 if (NILP (content))
1377 continue;
1378 else if (NUMBERP (content))
1379 {
1380 reg[RRR] = i;
1381 reg[rrr] = XINT(content);
1382 break;
1383 }
1384 else if (EQ (content, Qt) || EQ (content, Qlambda))
1385 {
1386 reg[RRR] = i;
1387 break;
1388 }
1389 else if (CONSP (content))
1390 {
1391 attrib = XCONS (content)->car;
1392 value = XCONS (content)->cdr;
1393 if (!NUMBERP (attrib) || !NUMBERP (value))
1394 continue;
1395 reg[RRR] = i;
1396 reg[rrr] = XUINT (value);
1397 break;
1398 }
1399 }
1400 if (i == j)
1401 reg[RRR] = -1;
1402 ic = fin_ic;
1403 }
1404 break;
1405
1406 case CCL_MapMultiple:
1407 {
1408 Lisp_Object map, content, attrib, value;
1409 int point, size, map_vector_size;
1410 int map_set_rest_length, fin_ic;
1411
1412 map_set_rest_length =
1413 XINT (ccl_prog[ic++]); /* number of maps and separators. */
1414 fin_ic = ic + map_set_rest_length;
1415 if ((map_set_rest_length > reg[RRR]) && (reg[RRR] >= 0))
1416 {
1417 ic += reg[RRR];
1418 i = reg[RRR];
1419 map_set_rest_length -= i;
1420 }
1421 else
1422 {
1423 ic = fin_ic;
1424 reg[RRR] = -1;
1425 break;
1426 }
1427 mapping_stack_pointer = mapping_stack;
1428 op = reg[rrr];
1429 PUSH_MAPPING_STACK (0, op);
1430 reg[RRR] = -1;
1431 map_vector_size = XVECTOR (Vcode_conversion_map_vector)->size;
1432 for (;map_set_rest_length > 0;i++, map_set_rest_length--)
1433 {
1434 point = XINT(ccl_prog[ic++]);
1435 if (point < 0)
1436 {
1437 point = -point;
1438 if (mapping_stack_pointer
1439 >= &mapping_stack[MAX_MAP_SET_LEVEL])
1440 {
1441 CCL_INVALID_CMD;
1442 }
1443 PUSH_MAPPING_STACK (map_set_rest_length - point,
1444 reg[rrr]);
1445 map_set_rest_length = point + 1;
1446 reg[rrr] = op;
1447 continue;
1448 }
1449
1450 if (point >= map_vector_size) continue;
1451 map = (XVECTOR (Vcode_conversion_map_vector)
1452 ->contents[point]);
1453
1454 /* Check map varidity. */
1455 if (!CONSP (map)) continue;
1456 map = XCONS (map)->cdr;
1457 if (!VECTORP (map)) continue;
1458 size = XVECTOR (map)->size;
1459 if (size <= 1) continue;
1460
1461 content = XVECTOR (map)->contents[0];
1462
1463 /* check map type,
1464 [STARTPOINT VAL1 VAL2 ...] or
1465 [t ELEMENT STARTPOINT ENDPOINT] */
1466 if (NUMBERP (content))
1467 {
1468 point = XUINT (content);
1469 point = op - point + 1;
1470 if (!((point >= 1) && (point < size))) continue;
1471 content = XVECTOR (map)->contents[point];
1472 }
1473 else if (EQ (content, Qt))
1474 {
1475 if (size != 4) continue;
1476 if ((op >= XUINT (XVECTOR (map)->contents[2])) &&
1477 (op < XUINT (XVECTOR (map)->contents[3])))
1478 content = XVECTOR (map)->contents[1];
1479 else
1480 continue;
1481 }
1482 else
1483 continue;
1484
1485 if (NILP (content))
1486 continue;
1487 else if (NUMBERP (content))
1488 {
1489 op = XINT (content);
1490 reg[RRR] = i;
1491 i += map_set_rest_length;
1492 POP_MAPPING_STACK (map_set_rest_length, reg[rrr]);
1493 }
1494 else if (CONSP (content))
1495 {
1496 attrib = XCONS (content)->car;
1497 value = XCONS (content)->cdr;
1498 if (!NUMBERP (attrib) || !NUMBERP (value))
1499 continue;
1500 reg[RRR] = i;
1501 op = XUINT (value);
1502 i += map_set_rest_length;
1503 POP_MAPPING_STACK (map_set_rest_length, reg[rrr]);
1504 }
1505 else if (EQ (content, Qt))
1506 {
1507 reg[RRR] = i;
1508 op = reg[rrr];
1509 i += map_set_rest_length;
1510 POP_MAPPING_STACK (map_set_rest_length, reg[rrr]);
1511 }
1512 else if (EQ (content, Qlambda))
1513 {
1514 break;
1515 }
1516 else
1517 CCL_INVALID_CMD;
1518 }
1519 ic = fin_ic;
1520 }
1521 reg[rrr] = op;
1522 break;
1523
1524 case CCL_MapSingle:
1525 {
1526 Lisp_Object map, attrib, value, content;
1527 int size, point;
1528 j = XINT (ccl_prog[ic++]); /* map_id */
1529 op = reg[rrr];
1530 if (j >= XVECTOR (Vcode_conversion_map_vector)->size)
1531 {
1532 reg[RRR] = -1;
1533 break;
1534 }
1535 map = XVECTOR (Vcode_conversion_map_vector)->contents[j];
1536 if (!CONSP (map))
1537 {
1538 reg[RRR] = -1;
1539 break;
1540 }
1541 map = XCONS(map)->cdr;
1542 if (!VECTORP (map))
1543 {
1544 reg[RRR] = -1;
1545 break;
1546 }
1547 size = XVECTOR (map)->size;
1548 point = XUINT (XVECTOR (map)->contents[0]);
1549 point = op - point + 1;
1550 reg[RRR] = 0;
1551 if ((size <= 1) ||
1552 (!((point >= 1) && (point < size))))
1553 reg[RRR] = -1;
1554 else
1555 {
1556 content = XVECTOR (map)->contents[point];
1557 if (NILP (content))
1558 reg[RRR] = -1;
1559 else if (NUMBERP (content))
1560 reg[rrr] = XINT (content);
1561 else if (EQ (content, Qt))
1562 reg[RRR] = i;
1563 else if (CONSP (content))
1564 {
1565 attrib = XCONS (content)->car;
1566 value = XCONS (content)->cdr;
1567 if (!NUMBERP (attrib) || !NUMBERP (value))
1568 continue;
1569 reg[rrr] = XUINT(value);
1570 break;
1571 }
1572 else
1573 reg[RRR] = -1;
1574 }
1575 }
1576 break;
1577 #endif
1578
1579 default:
1580 CCL_INVALID_CMD;
1581 }
1582 break;
1583
1584 default: 875 default:
1585 ccl->status = CCL_STAT_INVALID_CMD; 876 ccl->status = CCL_STAT_INVALID_CMD;
1586 goto ccl_error_handler; 877 goto ccl_error_handler;
1587 } 878 }
1588 } 879 }
1593 /* We can insert an error message only if DESTINATION is 884 /* We can insert an error message only if DESTINATION is
1594 specified and we still have a room to store the message 885 specified and we still have a room to store the message
1595 there. */ 886 there. */
1596 char msg[256]; 887 char msg[256];
1597 888
1598 #if 0 /* not for XEmacs ? */
1599 if (!dst)
1600 dst = destination;
1601 #endif
1602
1603 switch (ccl->status) 889 switch (ccl->status)
1604 { 890 {
1605 /* Terminate CCL program because of invalid command. 891 /* Terminate CCL program because of invalid command.
1606 Should not occur in the normal case. */ 892 Should not occur in the normal case. */
1607 case CCL_STAT_INVALID_CMD: 893 case CCL_STAT_INVALID_CMD:
1608 sprintf(msg, "\nCCL: Invalid command %x (ccl_code = %x) at %d.", 894 sprintf(msg, "\nCCL: Invalid command %x (ccl_code = %x) at %d.",
1609 code & 0x1F, code, this_ic); 895 code & 0x1F, code, ic);
1610 #ifdef CCL_DEBUG 896 #ifdef CCL_DEBUG
1611 { 897 {
1612 int i = ccl_backtrace_idx - 1; 898 int i = ccl_backtrace_idx - 1;
1613 int j; 899 int j;
1614 900
1620 if (ccl_backtrace_table[i] == 0) 906 if (ccl_backtrace_table[i] == 0)
1621 break; 907 break;
1622 sprintf(msg, " %d", ccl_backtrace_table[i]); 908 sprintf(msg, " %d", ccl_backtrace_table[i]);
1623 Dynarr_add_many (destination, (unsigned char *) msg, strlen (msg)); 909 Dynarr_add_many (destination, (unsigned char *) msg, strlen (msg));
1624 } 910 }
1625 goto ccl_finish;
1626 } 911 }
1627 #endif 912 #endif
1628 break; 913 goto ccl_finish;
1629 914
1630 case CCL_STAT_QUIT: 915 case CCL_STAT_QUIT:
1631 sprintf(msg, "\nCCL: Quited."); 916 sprintf(msg, "\nCCL: Quited.");
1632 break; 917 break;
1633 918
1638 Dynarr_add_many (destination, (unsigned char *) msg, strlen (msg)); 923 Dynarr_add_many (destination, (unsigned char *) msg, strlen (msg));
1639 } 924 }
1640 925
1641 ccl_finish: 926 ccl_finish:
1642 ccl->ic = ic; 927 ccl->ic = ic;
1643 ccl->stack_idx = stack_idx;
1644 ccl->prog = ccl_prog;
1645 if (consumed) *consumed = src - source; 928 if (consumed) *consumed = src - source;
1646 if (destination) 929 if (destination)
1647 return Dynarr_length (destination); 930 return Dynarr_length (destination);
1648 else 931 else
1649 return 0; 932 return 0;
1650 } 933 }
1651 934
1652 /* Setup fields of the structure pointed by CCL appropriately for the 935 /* Setup fields of the structure pointed by CCL appropriately for the
1653 execution of compiled CCL code in VEC (vector of integer). 936 execution of compiled CCL code in VEC (vector of integer). */
1654 If VEC is nil, we skip setting ups based on VEC. */
1655 void 937 void
1656 setup_ccl_program (struct ccl_program *ccl, Lisp_Object vec) 938 setup_ccl_program (struct ccl_program *ccl, Lisp_Object vec)
1657 { 939 {
1658 int i; 940 int i;
1659 941
1660 if (VECTORP (vec)) 942 ccl->size = XVECTOR_LENGTH (vec);
1661 { 943 ccl->prog = XVECTOR_DATA (vec);
1662 ccl->size = XVECTOR_LENGTH (vec);
1663 ccl->prog = XVECTOR_DATA (vec);
1664 ccl->eof_ic = XINT (XVECTOR_DATA (vec)[CCL_HEADER_EOF]);
1665 ccl->buf_magnification = XINT (XVECTOR_DATA (vec)[CCL_HEADER_BUF_MAG]);
1666 }
1667 ccl->ic = CCL_HEADER_MAIN; 944 ccl->ic = CCL_HEADER_MAIN;
945 ccl->eof_ic = XINT (XVECTOR_DATA (vec)[CCL_HEADER_EOF]);
946 ccl->buf_magnification = XINT (XVECTOR_DATA (vec)[CCL_HEADER_BUF_MAG]);
1668 for (i = 0; i < 8; i++) 947 for (i = 0; i < 8; i++)
1669 ccl->reg[i] = 0; 948 ccl->reg[i] = 0;
1670 ccl->last_block = 0; 949 ccl->last_block = 0;
1671 ccl->private_state = 0;
1672 ccl->status = 0; 950 ccl->status = 0;
1673 ccl->stack_idx = 0;
1674 } 951 }
1675
1676 /* Resolve symbols in the specified CCL code (Lisp vector). This
1677 function converts symbols of code conversion maps and character
1678 translation tables embeded in the CCL code into their ID numbers. */
1679
1680 static Lisp_Object
1681 resolve_symbol_ccl_program (Lisp_Object ccl)
1682 {
1683 int i, veclen;
1684 Lisp_Object result, contents /*, prop */;
1685
1686 result = ccl;
1687 veclen = XVECTOR_LENGTH (result);
1688
1689 /* Set CCL program's table ID */
1690 for (i = 0; i < veclen; i++)
1691 {
1692 contents = XVECTOR_DATA (result)[i];
1693 if (SYMBOLP (contents))
1694 {
1695 if (EQ(result, ccl))
1696 result = Fcopy_sequence (ccl);
1697
1698 #if 0
1699 prop = Fget (contents, Qtranslation_table_id);
1700 if (NUMBERP (prop))
1701 {
1702 XVECTOR_DATA (result)[i] = prop;
1703 continue;
1704 }
1705 prop = Fget (contents, Qcode_conversion_map_id);
1706 if (NUMBERP (prop))
1707 {
1708 XVECTOR_DATA (result)[i] = prop;
1709 continue;
1710 }
1711 prop = Fget (contents, Qccl_program_idx);
1712 if (NUMBERP (prop))
1713 {
1714 XVECTOR_DATA (result)[i] = prop;
1715 continue;
1716 }
1717 #endif
1718 }
1719 }
1720
1721 return result;
1722 }
1723
1724 952
1725 #ifdef emacs 953 #ifdef emacs
1726 954
1727 DEFUN ("ccl-execute", Fccl_execute, 2, 2, 0, /* 955 DEFUN ("ccl-execute", Fccl_execute, 2, 2, 0, /*
1728 Execute CCL-PROGRAM with registers initialized by REGISTERS. 956 Execute CCL-PROGRAM with registers initialized by REGISTERS.
1729 957 CCL-PROGRAM is a compiled code generated by `ccl-compile',
1730 CCL-PROGRAM is a symbol registered by register-ccl-program, 958 no I/O commands should appear in the CCL program.
1731 or a compiled code generated by `ccl-compile' (for backward compatibility,
1732 in this case, the execution is slower).
1733 No I/O commands should appear in CCL-PROGRAM.
1734
1735 REGISTERS is a vector of [R0 R1 ... R7] where RN is an initial value 959 REGISTERS is a vector of [R0 R1 ... R7] where RN is an initial value
1736 of Nth register. 960 of Nth register.
1737
1738 As side effect, each element of REGISTER holds the value of 961 As side effect, each element of REGISTER holds the value of
1739 corresponding register after the execution. 962 corresponding register after the execution.
1740 */ 963 */
1741 (ccl_prog, reg)) 964 (ccl_prog, reg))
1742 { 965 {
1743 struct ccl_program ccl; 966 struct ccl_program ccl;
1744 int i; 967 int i;
1745 Lisp_Object ccl_id; 968
1746 969 CHECK_VECTOR (ccl_prog);
1747 if (SYMBOLP (ccl_prog) &&
1748 !NILP (ccl_id = Fget (ccl_prog, Qccl_program_idx, Qnil)))
1749 {
1750 ccl_prog = XVECTOR_DATA (Vccl_program_table)[XUINT (ccl_id)];
1751 CHECK_LIST (ccl_prog);
1752 ccl_prog = XCDR (ccl_prog);
1753 CHECK_VECTOR (ccl_prog);
1754 }
1755 else
1756 {
1757 CHECK_VECTOR (ccl_prog);
1758 ccl_prog = resolve_symbol_ccl_program (ccl_prog);
1759 }
1760
1761 CHECK_VECTOR (reg); 970 CHECK_VECTOR (reg);
1762 if (XVECTOR_LENGTH (reg) != 8) 971 if (XVECTOR_LENGTH (reg) != 8)
1763 error ("Invalid length of vector REGISTERS"); 972 signal_simple_error ("Vector should be of length 8", reg);
1764 973
1765 setup_ccl_program (&ccl, ccl_prog); 974 setup_ccl_program (&ccl, ccl_prog);
1766 for (i = 0; i < 8; i++) 975 for (i = 0; i < 8; i++)
1767 ccl.reg[i] = (INTP (XVECTOR_DATA (reg)[i]) 976 ccl.reg[i] = (INTP (XVECTOR_DATA (reg)[i])
1768 ? XINT (XVECTOR_DATA (reg)[i]) 977 ? XINT (XVECTOR_DATA (reg)[i])
1769 : 0); 978 : 0);
1770 979
1771 ccl_driver (&ccl, (const unsigned char *)0, (unsigned_char_dynarr *)0, 980 ccl_driver (&ccl, (CONST unsigned char *)0, (unsigned_char_dynarr *)0,
1772 0, (int *)0, CCL_MODE_ENCODING); 981 0, (int *)0);
1773 QUIT; 982 QUIT;
1774 if (ccl.status != CCL_STAT_SUCCESS) 983 if (ccl.status != CCL_STAT_SUCCESS)
1775 error ("Error in CCL program at %dth code", ccl.ic); 984 error ("Error in CCL program at %dth code", ccl.ic);
1776 985
1777 for (i = 0; i < 8; i++) 986 for (i = 0; i < 8; i++)
1779 return Qnil; 988 return Qnil;
1780 } 989 }
1781 990
1782 DEFUN ("ccl-execute-on-string", Fccl_execute_on_string, 3, 4, 0, /* 991 DEFUN ("ccl-execute-on-string", Fccl_execute_on_string, 3, 4, 0, /*
1783 Execute CCL-PROGRAM with initial STATUS on STRING. 992 Execute CCL-PROGRAM with initial STATUS on STRING.
1784 993 CCL-PROGRAM is a compiled code generated by `ccl-compile'.
1785 CCL-PROGRAM is a symbol registered by register-ccl-program,
1786 or a compiled code generated by `ccl-compile' (for backward compatibility,
1787 in this case, the execution is slower).
1788
1789 Read buffer is set to STRING, and write buffer is allocated automatically. 994 Read buffer is set to STRING, and write buffer is allocated automatically.
1790
1791 If IC is nil, it is initialized to head of the CCL program.\n\
1792 STATUS is a vector of [R0 R1 ... R7 IC], where 995 STATUS is a vector of [R0 R1 ... R7 IC], where
1793 R0..R7 are initial values of corresponding registers, 996 R0..R7 are initial values of corresponding registers,
1794 IC is the instruction counter specifying from where to start the program. 997 IC is the instruction counter specifying from where to start the program.
1795 If R0..R7 are nil, they are initialized to 0. 998 If R0..R7 are nil, they are initialized to 0.
1796 If IC is nil, it is initialized to head of the CCL program. 999 If IC is nil, it is initialized to head of the CCL program.
1797 1000 Returns the contents of write buffer as a string,
1001 and as side effect, STATUS is updated.
1798 If optional 4th arg CONTINUE is non-nil, keep IC on read operation 1002 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 1003 when read buffer is exausted, else, IC is always set to the end of
1800 CCL-PROGRAM on exit. 1004 CCL-PROGRAM on exit.
1801
1802 It returns the contents of write buffer as a string,
1803 and as side effect, STATUS is updated.
1804 */ 1005 */
1805 (ccl_prog, status, str, contin)) 1006 (ccl_prog, status, str, contin))
1806 { 1007 {
1807 Lisp_Object val; 1008 Lisp_Object val;
1808 struct ccl_program ccl; 1009 struct ccl_program ccl;
1809 int i, produced; 1010 int i, produced;
1810 unsigned_char_dynarr *outbuf; 1011 unsigned_char_dynarr *outbuf;
1811 struct gcpro gcpro1, gcpro2, gcpro3; 1012 struct gcpro gcpro1, gcpro2, gcpro3;
1812 Lisp_Object ccl_id; 1013
1813 1014 CHECK_VECTOR (ccl_prog);
1814 if (SYMBOLP (ccl_prog) &&
1815 !NILP (ccl_id = Fget (ccl_prog, Qccl_program_idx, Qnil)))
1816 {
1817 ccl_prog = XVECTOR (Vccl_program_table)->contents[XUINT (ccl_id)];
1818 CHECK_LIST (ccl_prog);
1819 ccl_prog = XCDR (ccl_prog);
1820 CHECK_VECTOR (ccl_prog);
1821 }
1822 else
1823 {
1824 CHECK_VECTOR (ccl_prog);
1825 ccl_prog = resolve_symbol_ccl_program (ccl_prog);
1826 }
1827
1828 CHECK_VECTOR (status); 1015 CHECK_VECTOR (status);
1829 if (XVECTOR_LENGTH (status) != 9) 1016 if (XVECTOR_LENGTH (status) != 9)
1830 signal_simple_error ("Vector should be of length 9", status); 1017 signal_simple_error ("Vector should be of length 9", status);
1831 CHECK_STRING (str); 1018 CHECK_STRING (str);
1832 GCPRO3 (ccl_prog, status, str); 1019 GCPRO3 (ccl_prog, status, str);
1846 ccl.ic = i; 1033 ccl.ic = i;
1847 } 1034 }
1848 outbuf = Dynarr_new (unsigned_char); 1035 outbuf = Dynarr_new (unsigned_char);
1849 ccl.last_block = NILP (contin); 1036 ccl.last_block = NILP (contin);
1850 produced = ccl_driver (&ccl, XSTRING_DATA (str), outbuf, 1037 produced = ccl_driver (&ccl, XSTRING_DATA (str), outbuf,
1851 XSTRING_LENGTH (str), (int *)0, CCL_MODE_DECODING); 1038 XSTRING_LENGTH (str), (int *)0);
1852 for (i = 0; i < 8; i++) 1039 for (i = 0; i < 8; i++)
1853 XVECTOR_DATA (status)[i] = make_int(ccl.reg[i]); 1040 XVECTOR_DATA (status)[i] = make_int(ccl.reg[i]);
1854 XSETINT (XVECTOR_DATA (status)[8], ccl.ic); 1041 XSETINT (XVECTOR_DATA (status)[8], ccl.ic);
1855 UNGCPRO; 1042 UNGCPRO;
1856 1043
1857 val = make_string (Dynarr_atp (outbuf, 0), produced); 1044 val = make_string (Dynarr_atp (outbuf, 0), produced);
1858 Dynarr_free (outbuf); 1045 Dynarr_free (outbuf);
1859 QUIT; 1046 QUIT;
1860 if (ccl.status != CCL_STAT_SUCCESS 1047 if (ccl.status != CCL_STAT_SUCCESS
1861 && ccl.status != CCL_STAT_SUSPEND_BY_SRC 1048 && ccl.status != CCL_STAT_SUSPEND)
1862 && ccl.status != CCL_STAT_SUSPEND_BY_DST)
1863 error ("Error in CCL program at %dth code", ccl.ic); 1049 error ("Error in CCL program at %dth code", ccl.ic);
1864 1050
1865 return val; 1051 return val;
1866 } 1052 }
1867 1053
1875 int len = XVECTOR_LENGTH (Vccl_program_table); 1061 int len = XVECTOR_LENGTH (Vccl_program_table);
1876 int i; 1062 int i;
1877 1063
1878 CHECK_SYMBOL (name); 1064 CHECK_SYMBOL (name);
1879 if (!NILP (ccl_prog)) 1065 if (!NILP (ccl_prog))
1880 { 1066 CHECK_VECTOR (ccl_prog);
1881 CHECK_VECTOR (ccl_prog);
1882 ccl_prog = resolve_symbol_ccl_program (ccl_prog);
1883 }
1884 1067
1885 for (i = 0; i < len; i++) 1068 for (i = 0; i < len; i++)
1886 { 1069 {
1887 Lisp_Object slot = XVECTOR_DATA (Vccl_program_table)[i]; 1070 Lisp_Object slot = XVECTOR_DATA (Vccl_program_table)[i];
1888 1071
1906 = XVECTOR_DATA (Vccl_program_table)[j]; 1089 = XVECTOR_DATA (Vccl_program_table)[j];
1907 Vccl_program_table = new_table; 1090 Vccl_program_table = new_table;
1908 } 1091 }
1909 1092
1910 XVECTOR_DATA (Vccl_program_table)[i] = Fcons (name, ccl_prog); 1093 XVECTOR_DATA (Vccl_program_table)[i] = Fcons (name, ccl_prog);
1911 Fput (name, Qccl_program_idx, make_int (i));
1912 return make_int (i); 1094 return make_int (i);
1913 } 1095 }
1914
1915 #if 0
1916 /* Register code conversion map.
1917 A code conversion map consists of numbers, Qt, Qnil, and Qlambda.
1918 The first element is start code point.
1919 The rest elements are mapped numbers.
1920 Symbol t means to map to an original number before mapping.
1921 Symbol nil means that the corresponding element is empty.
1922 Symbol lambda menas to terminate mapping here.
1923 */
1924
1925 DEFUN ("register-code-conversion-map", Fregister_code_conversion_map,
1926 Sregister_code_conversion_map,
1927 2, 2, 0,
1928 "Register SYMBOL as code conversion map MAP.\n\
1929 Return index number of the registered map.")
1930 (symbol, map)
1931 Lisp_Object symbol, map;
1932 {
1933 int len = XVECTOR (Vcode_conversion_map_vector)->size;
1934 int i;
1935 Lisp_Object index;
1936
1937 CHECK_SYMBOL (symbol, 0);
1938 CHECK_VECTOR (map, 1);
1939
1940 for (i = 0; i < len; i++)
1941 {
1942 Lisp_Object slot = XVECTOR (Vcode_conversion_map_vector)->contents[i];
1943
1944 if (!CONSP (slot))
1945 break;
1946
1947 if (EQ (symbol, XCONS (slot)->car))
1948 {
1949 index = make_int (i);
1950 XCONS (slot)->cdr = map;
1951 Fput (symbol, Qcode_conversion_map, map);
1952 Fput (symbol, Qcode_conversion_map_id, index);
1953 return index;
1954 }
1955 }
1956
1957 if (i == len)
1958 {
1959 Lisp_Object new_vector = Fmake_vector (make_int (len * 2), Qnil);
1960 int j;
1961
1962 for (j = 0; j < len; j++)
1963 XVECTOR (new_vector)->contents[j]
1964 = XVECTOR (Vcode_conversion_map_vector)->contents[j];
1965 Vcode_conversion_map_vector = new_vector;
1966 }
1967
1968 index = make_int (i);
1969 Fput (symbol, Qcode_conversion_map, map);
1970 Fput (symbol, Qcode_conversion_map_id, index);
1971 XVECTOR (Vcode_conversion_map_vector)->contents[i] = Fcons (symbol, map);
1972 return index;
1973 }
1974 #endif
1975
1976 1096
1977 void 1097 void
1978 syms_of_mule_ccl (void) 1098 syms_of_mule_ccl (void)
1979 { 1099 {
1980 DEFSUBR (Fccl_execute);
1981 DEFSUBR (Fccl_execute_on_string);
1982 DEFSUBR (Fregister_ccl_program);
1983 #if 0
1984 DEFSUBR (&Fregister_code_conversion_map);
1985 #endif
1986 }
1987
1988 void
1989 vars_of_mule_ccl (void)
1990 {
1991 staticpro (&Vccl_program_table); 1100 staticpro (&Vccl_program_table);
1992 Vccl_program_table = Fmake_vector (make_int (32), Qnil); 1101 Vccl_program_table = Fmake_vector (make_int (32), Qnil);
1993
1994 Qccl_program = intern ("ccl-program");
1995 staticpro (&Qccl_program);
1996
1997 Qccl_program_idx = intern ("ccl-program-idx");
1998 staticpro (&Qccl_program_idx);
1999
2000 #if 0
2001 Qcode_conversion_map = intern ("code-conversion-map");
2002 staticpro (&Qcode_conversion_map);
2003
2004 Qcode_conversion_map_id = intern ("code-conversion-map-id");
2005 staticpro (&Qcode_conversion_map_id);
2006
2007 DEFVAR_LISP ("code-conversion-map-vector", &Vcode_conversion_map_vector /*
2008 Vector of code conversion maps.*/ );
2009 Vcode_conversion_map_vector = Fmake_vector (make_int (16), Qnil);
2010 #endif
2011 1102
2012 DEFVAR_LISP ("font-ccl-encoder-alist", &Vfont_ccl_encoder_alist /* 1103 DEFVAR_LISP ("font-ccl-encoder-alist", &Vfont_ccl_encoder_alist /*
2013 Alist of fontname patterns vs corresponding CCL program. 1104 Alist of fontname patterns vs corresponding CCL program.
2014 Each element looks like (REGEXP . CCL-CODE), 1105 Each element looks like (REGEXP . CCL-CODE),
2015 where CCL-CODE is a compiled CCL program. 1106 where CCL-CODE is a compiled CCL program.
2020 The code point in the font is set in CCL registers R1 and R2 1111 The code point in the font is set in CCL registers R1 and R2
2021 when the execution terminated. 1112 when the execution terminated.
2022 If the font is single-byte font, the register R2 is not used. 1113 If the font is single-byte font, the register R2 is not used.
2023 */ ); 1114 */ );
2024 Vfont_ccl_encoder_alist = Qnil; 1115 Vfont_ccl_encoder_alist = Qnil;
1116
1117 DEFSUBR (Fccl_execute);
1118 DEFSUBR (Fccl_execute_on_string);
1119 DEFSUBR (Fregister_ccl_program);
2025 } 1120 }
2026 1121
2027 #endif /* emacs */ 1122 #endif /* emacs */