1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25
26
27 #include <config.h>
28
29 #include <stdio.h>
30 #include <setjmp.h>
31
32 #include "lisp.h"
33 #include "character.h"
34 #include "charset.h"
35 #include "ccl.h"
36 #include "coding.h"
37
38 Lisp_Object Qccl, Qcclp;
39
40
41 Lisp_Object Vcode_conversion_map_vector;
42
43
44 Lisp_Object Vfont_ccl_encoder_alist;
45
46 47
48 Lisp_Object Qccl_program;
49
50 51
52 Lisp_Object Qcode_conversion_map;
53 Lisp_Object Qcode_conversion_map_id;
54
55 56
57 Lisp_Object Qccl_program_idx;
58
59 60 61 62 63 64 65
66 Lisp_Object Vccl_program_table;
67
68
69 Lisp_Object Vtranslation_hash_table_vector;
70
71
72 #define GET_HASH_TABLE(id) \
73 (XHASH_TABLE (XCDR(XVECTOR(Vtranslation_hash_table_vector)->contents[(id)])))
74
75 extern int charset_unicode;
76
77 78 79 80 81 82 83 84 85 86
87
88
89 #define CCL_HEADER_BUF_MAG 0
90 #define CCL_HEADER_EOF 1
91 #define CCL_HEADER_MAIN 2
92
93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111
112
113 114 115 116 117
118
119 #define CCL_SetRegister 0x00 120 121 122 123
124
125 #define CCL_SetShortConst 0x01 126 127 128 129
130
131 #define CCL_SetConst 0x02 132 133 134 135 136 137
138
139 #define CCL_SetArray 0x03 140 141 142 143 144 145 146 147 148
149
150 #define CCL_Jump 0x04 151 152 153 154
155
156
157
158 #define CCL_JumpCond 0x05 159 160 161 162 163
164
165
166 #define CCL_WriteRegisterJump 0x06 167 168 169 170 171
172
173 #define CCL_WriteRegisterReadJump 0x07 174 175 176 177 178 179 180 181
182 183
184
185 #define CCL_WriteConstJump 0x08 186 187 188 189 190 191
192
193 #define CCL_WriteConstReadJump 0x09 194 195 196 197 198 199 200 201 202
203 204
205
206 #define CCL_WriteStringJump 0x0A 207 208 209 210 211 212 213 214 215 216 217
218
219 #define CCL_WriteArrayReadJump 0x0B 220 221 222 223 224 225 226 227 228 229 230 231 232
233 234
235
236 #define CCL_ReadJump 0x0C 237 238 239 240 241
242
243 #define CCL_Branch 0x0D 244 245 246 247 248 249 250 251 252 253
254
255 #define CCL_ReadRegister 0x0E 256 257 258 259 260 261 262
263
264 #define CCL_WriteExprConst 0x0F 265 266 267 268 269 270
271
272 273
274
275 #define CCL_ReadBranch 0x10 276 277 278 279 280 281 282 283 284 285 286 287
288
289 #define CCL_WriteRegister 0x11 290 291 292 293 294 295 296 297
298
299 300
301
302 #define CCL_WriteExprRegister 0x12 303 304 305 306
307
308 #define CCL_Call 0x13 309 310 311 312 313 314 315 316 317 318
319
320 #define CCL_WriteConstString 0x14 321 322 323 324 325 326 327 328 329 330 331 332 333
334
335 #define CCL_WriteArray 0x15 336 337 338 339 340 341 342 343 344
345
346 #define CCL_End 0x16 347 348 349 350
351
352 353
354
355 #define CCL_ExprSelfConst 0x17 356 357 358 359 360
361
362 #define CCL_ExprSelfReg 0x18 363 364 365 366
367
368 369
370
371 #define CCL_SetExprConst 0x19 372 373 374 375 376 377
378
379 #define CCL_SetExprReg 0x1A 380 381 382 383
384
385 #define CCL_JumpCondExprConst 0x1B 386 387 388 389 390 391 392 393 394 395 396
397
398 #define CCL_JumpCondExprReg 0x1C 399 400 401 402 403 404 405 406 407 408 409
410
411 #define CCL_ReadJumpCondExprConst 0x1D 412 413 414 415 416 417 418 419 420 421 422 423
424
425 #define CCL_ReadJumpCondExprReg 0x1E 426 427 428 429 430 431 432 433 434 435 436 437
438
439 #define CCL_Extension 0x1F 440 441 442 443 444 445
446
447 448 449 450 451
452
453 454 455
456
457 #define CCL_ReadMultibyteChar2 0x00 458
459
460 461 462
463
464 #define CCL_WriteMultibyteChar2 0x01 465
466
467 468 469 470 471
472
473 #define CCL_TranslateCharacter 0x02 474
475
476 477 478 479 480
481
482 #define CCL_TranslateCharacterConstTbl 0x03 483 484 485
486
487 488 489 490 491 492 493 494 495 496 497
498
499 #define CCL_IterateMultipleMap 0x10 500 501 502 503 504 505
506
507 508 509 510 511 512 513 514 515 516 517 518 519 520 521 522 523 524 525 526 527 528 529 530 531 532 533 534 535 536 537 538 539 540 541 542 543 544 545 546 547 548 549 550 551 552 553 554 555 556 557 558 559 560 561 562 563 564 565 566 567 568 569 570 571 572 573 574 575 576 577 578 579 580 581 582 583 584 585 586 587 588
589
590 #define CCL_MapMultiple 0x11 591 592 593 594 595 596 597 598 599 600 601
602
603 #define MAX_MAP_SET_LEVEL 30
604
605 typedef struct
606 {
607 int rest_length;
608 int orig_val;
609 } tr_stack;
610
611 static tr_stack mapping_stack[MAX_MAP_SET_LEVEL];
612 static tr_stack *mapping_stack_pointer;
613
614 615
616 static int stack_idx_of_map_multiple;
617
618 #define PUSH_MAPPING_STACK(restlen, orig) \
619 do \
620 { \
621 mapping_stack_pointer->rest_length = (restlen); \
622 mapping_stack_pointer->orig_val = (orig); \
623 mapping_stack_pointer++; \
624 } \
625 while (0)
626
627 #define POP_MAPPING_STACK(restlen, orig) \
628 do \
629 { \
630 mapping_stack_pointer--; \
631 (restlen) = mapping_stack_pointer->rest_length; \
632 (orig) = mapping_stack_pointer->orig_val; \
633 } \
634 while (0)
635
636 #define CCL_CALL_FOR_MAP_INSTRUCTION(symbol, ret_ic) \
637 do \
638 { \
639 struct ccl_program called_ccl; \
640 if (stack_idx >= 256 \
641 || (setup_ccl_program (&called_ccl, (symbol)) != 0)) \
642 { \
643 if (stack_idx > 0) \
644 { \
645 ccl_prog = ccl_prog_stack_struct[0].ccl_prog; \
646 ic = ccl_prog_stack_struct[0].ic; \
647 eof_ic = ccl_prog_stack_struct[0].eof_ic; \
648 } \
649 CCL_INVALID_CMD; \
650 } \
651 ccl_prog_stack_struct[stack_idx].ccl_prog = ccl_prog; \
652 ccl_prog_stack_struct[stack_idx].ic = (ret_ic); \
653 ccl_prog_stack_struct[stack_idx].eof_ic = eof_ic; \
654 stack_idx++; \
655 ccl_prog = called_ccl.prog; \
656 ic = CCL_HEADER_MAIN; \
657 eof_ic = XFASTINT (ccl_prog[CCL_HEADER_EOF]); \
658 goto ccl_repeat; \
659 } \
660 while (0)
661
662 #define CCL_MapSingle 0x12 663 664 665 666 667 668 669 670 671
672
673 #define CCL_LookupIntConstTbl 0x13 674 675 676 677
678
679 #define CCL_LookupCharConstTbl 0x14 680 681 682 683
684
685
686 #define CCL_PLUS 0x00
687 #define CCL_MINUS 0x01
688 #define CCL_MUL 0x02
689 #define CCL_DIV 0x03
690 #define CCL_MOD 0x04
691 #define CCL_AND 0x05
692 #define CCL_OR 0x06
693 #define CCL_XOR 0x07
694 #define CCL_LSH 0x08
695 #define CCL_RSH 0x09
696 #define CCL_LSH8 0x0A
697 #define CCL_RSH8 0x0B
698 #define CCL_DIVMOD 0x0C
699 #define CCL_LS 0x10
700 #define CCL_GT 0x11
701 #define CCL_EQ 0x12
702 #define CCL_LE 0x13
703 #define CCL_GE 0x14
704 #define CCL_NE 0x15
705
706 #define CCL_DECODE_SJIS 0x16 707
708 #define CCL_ENCODE_SJIS 0x17 709
710
711
712 #define CCL_SUCCESS \
713 do \
714 { \
715 ccl->status = CCL_STAT_SUCCESS; \
716 goto ccl_finish; \
717 } \
718 while(0)
719
720 721 722
723 #define CCL_SUSPEND(stat) \
724 do \
725 { \
726 ic--; \
727 ccl->status = stat; \
728 goto ccl_finish; \
729 } \
730 while (0)
731
732 733
734 #ifndef CCL_DEBUG
735
736 #define CCL_INVALID_CMD \
737 do \
738 { \
739 ccl->status = CCL_STAT_INVALID_CMD; \
740 goto ccl_error_handler; \
741 } \
742 while(0)
743
744 #else
745
746 #define CCL_INVALID_CMD \
747 do \
748 { \
749 ccl_debug_hook (this_ic); \
750 ccl->status = CCL_STAT_INVALID_CMD; \
751 goto ccl_error_handler; \
752 } \
753 while(0)
754
755 #endif
756
757 758
759 #define CCL_WRITE_CHAR(ch) \
760 do { \
761 if (! dst) \
762 CCL_INVALID_CMD; \
763 else if (dst < dst_end) \
764 *dst++ = (ch); \
765 else \
766 CCL_SUSPEND (CCL_STAT_SUSPEND_BY_DST); \
767 } while (0)
768
769 770
771 #define CCL_WRITE_STRING(len) \
772 do { \
773 int i; \
774 if (!dst) \
775 CCL_INVALID_CMD; \
776 else if (dst + len <= dst_end) \
777 { \
778 if (XFASTINT (ccl_prog[ic]) & 0x1000000) \
779 for (i = 0; i < len; i++) \
780 *dst++ = XFASTINT (ccl_prog[ic + i]) & 0xFFFFFF; \
781 else \
782 for (i = 0; i < len; i++) \
783 *dst++ = ((XFASTINT (ccl_prog[ic + (i / 3)])) \
784 >> ((2 - (i % 3)) * 8)) & 0xFF; \
785 } \
786 else \
787 CCL_SUSPEND (CCL_STAT_SUSPEND_BY_DST); \
788 } while (0)
789
790
791 #define CCL_READ_CHAR(r) \
792 do { \
793 if (! src) \
794 CCL_INVALID_CMD; \
795 else if (src < src_end) \
796 r = *src++; \
797 else if (ccl->last_block) \
798 { \
799 r = -1; \
800 ic = ccl->eof_ic; \
801 goto ccl_repeat; \
802 } \
803 else \
804 CCL_SUSPEND (CCL_STAT_SUSPEND_BY_SRC); \
805 } while (0)
806
807 808 809
810
811 #define CCL_DECODE_CHAR(id, code) \
812 ((id) == 0 ? (code) \
813 : (charset = CHARSET_FROM_ID ((id)), DECODE_CHAR (charset, (code))))
814
815 816 817
818
819 #define CCL_ENCODE_CHAR(c, charset_list, id, encoded) \
820 do { \
821 unsigned code; \
822 \
823 charset = char_charset ((c), (charset_list), &code); \
824 if (! charset && ! NILP (charset_list)) \
825 charset = char_charset ((c), Qnil, &code); \
826 if (charset) \
827 { \
828 (id) = CHARSET_ID (charset); \
829 (encoded) = code; \
830 } \
831 } while (0)
832
833 834 835 836 837 838 839
840
841 #ifdef CCL_DEBUG
842 #define CCL_DEBUG_BACKTRACE_LEN 256
843 int ccl_backtrace_table[CCL_DEBUG_BACKTRACE_LEN];
844 int ccl_backtrace_idx;
845
846 int
847 ccl_debug_hook (int ic)
848 {
849 return ic;
850 }
851
852 #endif
853
854 struct ccl_prog_stack
855 {
856 Lisp_Object *ccl_prog;
857 int ic;
858 int eof_ic;
859 };
860
861
862 static struct ccl_prog_stack ccl_prog_stack_struct[256];
863
864 void
865 ccl_driver (ccl, source, destination, src_size, dst_size, charset_list)
866 struct ccl_program *ccl;
867 int *source, *destination;
868 int src_size, dst_size;
869 Lisp_Object charset_list;
870 {
871 register int *reg = ccl->reg;
872 register int ic = ccl->ic;
873 register int code = 0, field1, field2;
874 register Lisp_Object *ccl_prog = ccl->prog;
875 int *src = source, *src_end = src + src_size;
876 int *dst = destination, *dst_end = dst + dst_size;
877 int jump_address;
878 int i = 0, j, op;
879 int stack_idx = ccl->stack_idx;
880
881 int this_ic = 0;
882 struct charset *charset;
883 int eof_ic = ccl->eof_ic;
884 int eof_hit = 0;
885
886 if (ccl->buf_magnification == 0)
887 dst = NULL;
888
889
890 mapping_stack_pointer = mapping_stack;
891
892 #ifdef CCL_DEBUG
893 ccl_backtrace_idx = 0;
894 #endif
895
896 for (;;)
897 {
898 ccl_repeat:
899 #ifdef CCL_DEBUG
900 ccl_backtrace_table[ccl_backtrace_idx++] = ic;
901 if (ccl_backtrace_idx >= CCL_DEBUG_BACKTRACE_LEN)
902 ccl_backtrace_idx = 0;
903 ccl_backtrace_table[ccl_backtrace_idx] = 0;
904 #endif
905
906 if (!NILP (Vquit_flag) && NILP (Vinhibit_quit))
907 {
908 909 910
911 if (src)
912 src = source + src_size;
913 ccl->status = CCL_STAT_QUIT;
914 break;
915 }
916
917 this_ic = ic;
918 code = XINT (ccl_prog[ic]); ic++;
919 field1 = code >> 8;
920 field2 = (code & 0xFF) >> 5;
921
922 #define rrr field2
923 #define RRR (field1 & 7)
924 #define Rrr ((field1 >> 3) & 7)
925 #define ADDR field1
926 #define EXCMD (field1 >> 6)
927
928 switch (code & 0x1F)
929 {
930 case CCL_SetRegister:
931 reg[rrr] = reg[RRR];
932 break;
933
934 case CCL_SetShortConst:
935 reg[rrr] = field1;
936 break;
937
938 case CCL_SetConst:
939 reg[rrr] = XINT (ccl_prog[ic]);
940 ic++;
941 break;
942
943 case CCL_SetArray:
944 i = reg[RRR];
945 j = field1 >> 3;
946 if ((unsigned int) i < j)
947 reg[rrr] = XINT (ccl_prog[ic + i]);
948 ic += j;
949 break;
950
951 case CCL_Jump:
952 ic += ADDR;
953 break;
954
955 case CCL_JumpCond:
956 if (!reg[rrr])
957 ic += ADDR;
958 break;
959
960 case CCL_WriteRegisterJump:
961 i = reg[rrr];
962 CCL_WRITE_CHAR (i);
963 ic += ADDR;
964 break;
965
966 case CCL_WriteRegisterReadJump:
967 i = reg[rrr];
968 CCL_WRITE_CHAR (i);
969 ic++;
970 CCL_READ_CHAR (reg[rrr]);
971 ic += ADDR - 1;
972 break;
973
974 case CCL_WriteConstJump:
975 i = XINT (ccl_prog[ic]);
976 CCL_WRITE_CHAR (i);
977 ic += ADDR;
978 break;
979
980 case CCL_WriteConstReadJump:
981 i = XINT (ccl_prog[ic]);
982 CCL_WRITE_CHAR (i);
983 ic++;
984 CCL_READ_CHAR (reg[rrr]);
985 ic += ADDR - 1;
986 break;
987
988 case CCL_WriteStringJump:
989 j = XINT (ccl_prog[ic]);
990 ic++;
991 CCL_WRITE_STRING (j);
992 ic += ADDR - 1;
993 break;
994
995 case CCL_WriteArrayReadJump:
996 i = reg[rrr];
997 j = XINT (ccl_prog[ic]);
998 if ((unsigned int) i < j)
999 {
1000 i = XINT (ccl_prog[ic + 1 + i]);
1001 CCL_WRITE_CHAR (i);
1002 }
1003 ic += j + 2;
1004 CCL_READ_CHAR (reg[rrr]);
1005 ic += ADDR - (j + 2);
1006 break;
1007
1008 case CCL_ReadJump:
1009 CCL_READ_CHAR (reg[rrr]);
1010 ic += ADDR;
1011 break;
1012
1013 case CCL_ReadBranch:
1014 CCL_READ_CHAR (reg[rrr]);
1015
1016 case CCL_Branch:
1017 if ((unsigned int) reg[rrr] < field1)
1018 ic += XINT (ccl_prog[ic + reg[rrr]]);
1019 else
1020 ic += XINT (ccl_prog[ic + field1]);
1021 break;
1022
1023 case CCL_ReadRegister:
1024 while (1)
1025 {
1026 CCL_READ_CHAR (reg[rrr]);
1027 if (!field1) break;
1028 code = XINT (ccl_prog[ic]); ic++;
1029 field1 = code >> 8;
1030 field2 = (code & 0xFF) >> 5;
1031 }
1032 break;
1033
1034 case CCL_WriteExprConst:
1035 rrr = 7;
1036 i = reg[RRR];
1037 j = XINT (ccl_prog[ic]);
1038 op = field1 >> 6;
1039 jump_address = ic + 1;
1040 goto ccl_set_expr;
1041
1042 case CCL_WriteRegister:
1043 while (1)
1044 {
1045 i = reg[rrr];
1046 CCL_WRITE_CHAR (i);
1047 if (!field1) break;
1048 code = XINT (ccl_prog[ic]); ic++;
1049 field1 = code >> 8;
1050 field2 = (code & 0xFF) >> 5;
1051 }
1052 break;
1053
1054 case CCL_WriteExprRegister:
1055 rrr = 7;
1056 i = reg[RRR];
1057 j = reg[Rrr];
1058 op = field1 >> 6;
1059 jump_address = ic;
1060 goto ccl_set_expr;
1061
1062 case CCL_Call:
1063 {
1064 Lisp_Object slot;
1065 int prog_id;
1066
1067 1068
1069 if (rrr)
1070 {
1071 prog_id = XINT (ccl_prog[ic]);
1072 ic++;
1073 }
1074 else
1075 prog_id = field1;
1076
1077 if (stack_idx >= 256
1078 || prog_id < 0
1079 || prog_id >= ASIZE (Vccl_program_table)
1080 || (slot = AREF (Vccl_program_table, prog_id), !VECTORP (slot))
1081 || !VECTORP (AREF (slot, 1)))
1082 {
1083 if (stack_idx > 0)
1084 {
1085 ccl_prog = ccl_prog_stack_struct[0].ccl_prog;
1086 ic = ccl_prog_stack_struct[0].ic;
1087 eof_ic = ccl_prog_stack_struct[0].eof_ic;
1088 }
1089 CCL_INVALID_CMD;
1090 }
1091
1092 ccl_prog_stack_struct[stack_idx].ccl_prog = ccl_prog;
1093 ccl_prog_stack_struct[stack_idx].ic = ic;
1094 ccl_prog_stack_struct[stack_idx].eof_ic = eof_ic;
1095 stack_idx++;
1096 ccl_prog = XVECTOR (AREF (slot, 1))->contents;
1097 ic = CCL_HEADER_MAIN;
1098 eof_ic = XFASTINT (ccl_prog[CCL_HEADER_EOF]);
1099 }
1100 break;
1101
1102 case CCL_WriteConstString:
1103 if (!rrr)
1104 CCL_WRITE_CHAR (field1);
1105 else
1106 {
1107 CCL_WRITE_STRING (field1);
1108 ic += (field1 + 2) / 3;
1109 }
1110 break;
1111
1112 case CCL_WriteArray:
1113 i = reg[rrr];
1114 if ((unsigned int) i < field1)
1115 {
1116 j = XINT (ccl_prog[ic + i]);
1117 CCL_WRITE_CHAR (j);
1118 }
1119 ic += field1;
1120 break;
1121
1122 case CCL_End:
1123 if (stack_idx > 0)
1124 {
1125 stack_idx--;
1126 ccl_prog = ccl_prog_stack_struct[stack_idx].ccl_prog;
1127 ic = ccl_prog_stack_struct[stack_idx].ic;
1128 eof_ic = ccl_prog_stack_struct[stack_idx].eof_ic;
1129 if (eof_hit)
1130 ic = eof_ic;
1131 break;
1132 }
1133 if (src)
1134 src = src_end;
1135 1136
1137 ic--;
1138 CCL_SUCCESS;
1139
1140 case CCL_ExprSelfConst:
1141 i = XINT (ccl_prog[ic]);
1142 ic++;
1143 op = field1 >> 6;
1144 goto ccl_expr_self;
1145
1146 case CCL_ExprSelfReg:
1147 i = reg[RRR];
1148 op = field1 >> 6;
1149
1150 ccl_expr_self:
1151 switch (op)
1152 {
1153 case CCL_PLUS: reg[rrr] += i; break;
1154 case CCL_MINUS: reg[rrr] -= i; break;
1155 case CCL_MUL: reg[rrr] *= i; break;
1156 case CCL_DIV: reg[rrr] /= i; break;
1157 case CCL_MOD: reg[rrr] %= i; break;
1158 case CCL_AND: reg[rrr] &= i; break;
1159 case CCL_OR: reg[rrr] |= i; break;
1160 case CCL_XOR: reg[rrr] ^= i; break;
1161 case CCL_LSH: reg[rrr] <<= i; break;
1162 case CCL_RSH: reg[rrr] >>= i; break;
1163 case CCL_LSH8: reg[rrr] <<= 8; reg[rrr] |= i; break;
1164 case CCL_RSH8: reg[7] = reg[rrr] & 0xFF; reg[rrr] >>= 8; break;
1165 case CCL_DIVMOD: reg[7] = reg[rrr] % i; reg[rrr] /= i; break;
1166 case CCL_LS: reg[rrr] = reg[rrr] < i; break;
1167 case CCL_GT: reg[rrr] = reg[rrr] > i; break;
1168 case CCL_EQ: reg[rrr] = reg[rrr] == i; break;
1169 case CCL_LE: reg[rrr] = reg[rrr] <= i; break;
1170 case CCL_GE: reg[rrr] = reg[rrr] >= i; break;
1171 case CCL_NE: reg[rrr] = reg[rrr] != i; break;
1172 default: CCL_INVALID_CMD;
1173 }
1174 break;
1175
1176 case CCL_SetExprConst:
1177 i = reg[RRR];
1178 j = XINT (ccl_prog[ic]);
1179 op = field1 >> 6;
1180 jump_address = ++ic;
1181 goto ccl_set_expr;
1182
1183 case CCL_SetExprReg:
1184 i = reg[RRR];
1185 j = reg[Rrr];
1186 op = field1 >> 6;
1187 jump_address = ic;
1188 goto ccl_set_expr;
1189
1190 case CCL_ReadJumpCondExprConst:
1191 CCL_READ_CHAR (reg[rrr]);
1192 case CCL_JumpCondExprConst:
1193 i = reg[rrr];
1194 op = XINT (ccl_prog[ic]);
1195 jump_address = ic++ + ADDR;
1196 j = XINT (ccl_prog[ic]);
1197 ic++;
1198 rrr = 7;
1199 goto ccl_set_expr;
1200
1201 case CCL_ReadJumpCondExprReg:
1202 CCL_READ_CHAR (reg[rrr]);
1203 case CCL_JumpCondExprReg:
1204 i = reg[rrr];
1205 op = XINT (ccl_prog[ic]);
1206 jump_address = ic++ + ADDR;
1207 j = reg[XINT (ccl_prog[ic])];
1208 ic++;
1209 rrr = 7;
1210
1211 ccl_set_expr:
1212 switch (op)
1213 {
1214 case CCL_PLUS: reg[rrr] = i + j; break;
1215 case CCL_MINUS: reg[rrr] = i - j; break;
1216 case CCL_MUL: reg[rrr] = i * j; break;
1217 case CCL_DIV: reg[rrr] = i / j; break;
1218 case CCL_MOD: reg[rrr] = i % j; break;
1219 case CCL_AND: reg[rrr] = i & j; break;
1220 case CCL_OR: reg[rrr] = i | j; break;
1221 case CCL_XOR: reg[rrr] = i ^ j; break;
1222 case CCL_LSH: reg[rrr] = i << j; break;
1223 case CCL_RSH: reg[rrr] = i >> j; break;
1224 case CCL_LSH8: reg[rrr] = (i << 8) | j; break;
1225 case CCL_RSH8: reg[rrr] = i >> 8; reg[7] = i & 0xFF; break;
1226 case CCL_DIVMOD: reg[rrr] = i / j; reg[7] = i % j; break;
1227 case CCL_LS: reg[rrr] = i < j; break;
1228 case CCL_GT: reg[rrr] = i > j; break;
1229 case CCL_EQ: reg[rrr] = i == j; break;
1230 case CCL_LE: reg[rrr] = i <= j; break;
1231 case CCL_GE: reg[rrr] = i >= j; break;
1232 case CCL_NE: reg[rrr] = i != j; break;
1233 case CCL_DECODE_SJIS:
1234 {
1235 i = (i << 8) | j;
1236 SJIS_TO_JIS (i);
1237 reg[rrr] = i >> 8;
1238 reg[7] = i & 0xFF;
1239 break;
1240 }
1241 case CCL_ENCODE_SJIS:
1242 {
1243 i = (i << 8) | j;
1244 JIS_TO_SJIS (i);
1245 reg[rrr] = i >> 8;
1246 reg[7] = i & 0xFF;
1247 break;
1248 }
1249 default: CCL_INVALID_CMD;
1250 }
1251 code &= 0x1F;
1252 if (code == CCL_WriteExprConst || code == CCL_WriteExprRegister)
1253 {
1254 i = reg[rrr];
1255 CCL_WRITE_CHAR (i);
1256 ic = jump_address;
1257 }
1258 else if (!reg[rrr])
1259 ic = jump_address;
1260 break;
1261
1262 case CCL_Extension:
1263 switch (EXCMD)
1264 {
1265 case CCL_ReadMultibyteChar2:
1266 if (!src)
1267 CCL_INVALID_CMD;
1268 CCL_READ_CHAR (i);
1269 CCL_ENCODE_CHAR (i, charset_list, reg[RRR], reg[rrr]);
1270 break;
1271
1272 case CCL_WriteMultibyteChar2:
1273 if (! dst)
1274 CCL_INVALID_CMD;
1275 i = CCL_DECODE_CHAR (reg[RRR], reg[rrr]);
1276 CCL_WRITE_CHAR (i);
1277 break;
1278
1279 case CCL_TranslateCharacter:
1280 i = CCL_DECODE_CHAR (reg[RRR], reg[rrr]);
1281 op = translate_char (GET_TRANSLATION_TABLE (reg[Rrr]), i);
1282 CCL_ENCODE_CHAR (op, charset_list, reg[RRR], reg[rrr]);
1283 break;
1284
1285 case CCL_TranslateCharacterConstTbl:
1286 op = XINT (ccl_prog[ic]);
1287 ic++;
1288 i = CCL_DECODE_CHAR (reg[RRR], reg[rrr]);
1289 op = translate_char (GET_TRANSLATION_TABLE (op), i);
1290 CCL_ENCODE_CHAR (op, charset_list, reg[RRR], reg[rrr]);
1291 break;
1292
1293 case CCL_LookupIntConstTbl:
1294 op = XINT (ccl_prog[ic]);
1295 ic++;
1296 {
1297 struct Lisp_Hash_Table *h = GET_HASH_TABLE (op);
1298
1299 op = hash_lookup (h, make_number (reg[RRR]), NULL);
1300 if (op >= 0)
1301 {
1302 Lisp_Object opl;
1303 opl = HASH_VALUE (h, op);
1304 if (! CHARACTERP (opl))
1305 CCL_INVALID_CMD;
1306 reg[RRR] = charset_unicode;
1307 reg[rrr] = op;
1308 reg[7] = 1;
1309 }
1310 else
1311 reg[7] = 0;
1312 }
1313 break;
1314
1315 case CCL_LookupCharConstTbl:
1316 op = XINT (ccl_prog[ic]);
1317 ic++;
1318 i = CCL_DECODE_CHAR (reg[RRR], reg[rrr]);
1319 {
1320 struct Lisp_Hash_Table *h = GET_HASH_TABLE (op);
1321
1322 op = hash_lookup (h, make_number (i), NULL);
1323 if (op >= 0)
1324 {
1325 Lisp_Object opl;
1326 opl = HASH_VALUE (h, op);
1327 if (!INTEGERP (opl))
1328 CCL_INVALID_CMD;
1329 reg[RRR] = XINT (opl);
1330 reg[7] = 1;
1331 }
1332 else
1333 reg[7] = 0;
1334 }
1335 break;
1336
1337 case CCL_IterateMultipleMap:
1338 {
1339 Lisp_Object map, content, attrib, value;
1340 int point, size, fin_ic;
1341
1342 j = XINT (ccl_prog[ic++]);
1343 fin_ic = ic + j;
1344 op = reg[rrr];
1345 if ((j > reg[RRR]) && (j >= 0))
1346 {
1347 ic += reg[RRR];
1348 i = reg[RRR];
1349 }
1350 else
1351 {
1352 reg[RRR] = -1;
1353 ic = fin_ic;
1354 break;
1355 }
1356
1357 for (;i < j;i++)
1358 {
1359
1360 size = ASIZE (Vcode_conversion_map_vector);
1361 point = XINT (ccl_prog[ic++]);
1362 if (point >= size) continue;
1363 map = AREF (Vcode_conversion_map_vector, point);
1364
1365
1366 if (!CONSP (map)) continue;
1367 map = XCDR (map);
1368 if (!VECTORP (map)) continue;
1369 size = ASIZE (map);
1370 if (size <= 1) continue;
1371
1372 content = AREF (map, 0);
1373
1374 1375 1376
1377 if (NUMBERP (content))
1378 {
1379 point = XUINT (content);
1380 point = op - point + 1;
1381 if (!((point >= 1) && (point < size))) continue;
1382 content = AREF (map, point);
1383 }
1384 else if (EQ (content, Qt))
1385 {
1386 if (size != 4) continue;
1387 if ((op >= XUINT (AREF (map, 2)))
1388 && (op < XUINT (AREF (map, 3))))
1389 content = AREF (map, 1);
1390 else
1391 continue;
1392 }
1393 else
1394 continue;
1395
1396 if (NILP (content))
1397 continue;
1398 else if (NUMBERP (content))
1399 {
1400 reg[RRR] = i;
1401 reg[rrr] = XINT(content);
1402 break;
1403 }
1404 else if (EQ (content, Qt) || EQ (content, Qlambda))
1405 {
1406 reg[RRR] = i;
1407 break;
1408 }
1409 else if (CONSP (content))
1410 {
1411 attrib = XCAR (content);
1412 value = XCDR (content);
1413 if (!NUMBERP (attrib) || !NUMBERP (value))
1414 continue;
1415 reg[RRR] = i;
1416 reg[rrr] = XUINT (value);
1417 break;
1418 }
1419 else if (SYMBOLP (content))
1420 CCL_CALL_FOR_MAP_INSTRUCTION (content, fin_ic);
1421 else
1422 CCL_INVALID_CMD;
1423 }
1424 if (i == j)
1425 reg[RRR] = -1;
1426 ic = fin_ic;
1427 }
1428 break;
1429
1430 case CCL_MapMultiple:
1431 {
1432 Lisp_Object map, content, attrib, value;
1433 int point, size, map_vector_size;
1434 int map_set_rest_length, fin_ic;
1435 int current_ic = this_ic;
1436
1437
1438 if (stack_idx_of_map_multiple > 0)
1439 {
1440 if (stack_idx_of_map_multiple <= stack_idx)
1441 {
1442 stack_idx_of_map_multiple = 0;
1443 mapping_stack_pointer = mapping_stack;
1444 CCL_INVALID_CMD;
1445 }
1446 }
1447 else
1448 mapping_stack_pointer = mapping_stack;
1449 stack_idx_of_map_multiple = 0;
1450
1451 map_set_rest_length =
1452 XINT (ccl_prog[ic++]);
1453 fin_ic = ic + map_set_rest_length;
1454 op = reg[rrr];
1455
1456 if ((map_set_rest_length > reg[RRR]) && (reg[RRR] >= 0))
1457 {
1458 ic += reg[RRR];
1459 i = reg[RRR];
1460 map_set_rest_length -= i;
1461 }
1462 else
1463 {
1464 ic = fin_ic;
1465 reg[RRR] = -1;
1466 mapping_stack_pointer = mapping_stack;
1467 break;
1468 }
1469
1470 if (mapping_stack_pointer <= (mapping_stack + 1))
1471 {
1472
1473 mapping_stack_pointer = mapping_stack;
1474 PUSH_MAPPING_STACK (0, op);
1475 reg[RRR] = -1;
1476 }
1477 else
1478 {
1479
1480 int orig_op;
1481
1482 POP_MAPPING_STACK (map_set_rest_length, orig_op);
1483 POP_MAPPING_STACK (map_set_rest_length, reg[rrr]);
1484 switch (op)
1485 {
1486 case -1:
1487
1488 op = orig_op;
1489 i++;
1490 ic++;
1491 map_set_rest_length--;
1492 break;
1493 case -2:
1494
1495 op = reg[rrr];
1496 i++;
1497 ic++;
1498 map_set_rest_length--;
1499 break;
1500 case -3:
1501
1502 op = orig_op;
1503 i += map_set_rest_length;
1504 ic += map_set_rest_length;
1505 map_set_rest_length = 0;
1506 break;
1507 default:
1508
1509 i += map_set_rest_length;
1510 ic += map_set_rest_length;
1511 POP_MAPPING_STACK (map_set_rest_length, reg[rrr]);
1512 break;
1513 }
1514 }
1515 map_vector_size = ASIZE (Vcode_conversion_map_vector);
1516
1517 do {
1518 for (;map_set_rest_length > 0;i++, ic++, map_set_rest_length--)
1519 {
1520 point = XINT(ccl_prog[ic]);
1521 if (point < 0)
1522 {
1523
1524 point = -point + 1;
1525 if (mapping_stack_pointer
1526 >= &mapping_stack[MAX_MAP_SET_LEVEL])
1527 CCL_INVALID_CMD;
1528 PUSH_MAPPING_STACK (map_set_rest_length - point,
1529 reg[rrr]);
1530 map_set_rest_length = point;
1531 reg[rrr] = op;
1532 continue;
1533 }
1534
1535 if (point >= map_vector_size) continue;
1536 map = AREF (Vcode_conversion_map_vector, point);
1537
1538
1539 if (!CONSP (map)) continue;
1540 map = XCDR (map);
1541 if (!VECTORP (map)) continue;
1542 size = ASIZE (map);
1543 if (size <= 1) continue;
1544
1545 content = AREF (map, 0);
1546
1547 1548 1549
1550 if (NUMBERP (content))
1551 {
1552 point = XUINT (content);
1553 point = op - point + 1;
1554 if (!((point >= 1) && (point < size))) continue;
1555 content = AREF (map, point);
1556 }
1557 else if (EQ (content, Qt))
1558 {
1559 if (size != 4) continue;
1560 if ((op >= XUINT (AREF (map, 2))) &&
1561 (op < XUINT (AREF (map, 3))))
1562 content = AREF (map, 1);
1563 else
1564 continue;
1565 }
1566 else
1567 continue;
1568
1569 if (NILP (content))
1570 continue;
1571
1572 reg[RRR] = i;
1573 if (NUMBERP (content))
1574 {
1575 op = XINT (content);
1576 i += map_set_rest_length - 1;
1577 ic += map_set_rest_length - 1;
1578 POP_MAPPING_STACK (map_set_rest_length, reg[rrr]);
1579 map_set_rest_length++;
1580 }
1581 else if (CONSP (content))
1582 {
1583 attrib = XCAR (content);
1584 value = XCDR (content);
1585 if (!NUMBERP (attrib) || !NUMBERP (value))
1586 continue;
1587 op = XUINT (value);
1588 i += map_set_rest_length - 1;
1589 ic += map_set_rest_length - 1;
1590 POP_MAPPING_STACK (map_set_rest_length, reg[rrr]);
1591 map_set_rest_length++;
1592 }
1593 else if (EQ (content, Qt))
1594 {
1595 op = reg[rrr];
1596 }
1597 else if (EQ (content, Qlambda))
1598 {
1599 i += map_set_rest_length;
1600 ic += map_set_rest_length;
1601 break;
1602 }
1603 else if (SYMBOLP (content))
1604 {
1605 if (mapping_stack_pointer
1606 >= &mapping_stack[MAX_MAP_SET_LEVEL])
1607 CCL_INVALID_CMD;
1608 PUSH_MAPPING_STACK (map_set_rest_length, reg[rrr]);
1609 PUSH_MAPPING_STACK (map_set_rest_length, op);
1610 stack_idx_of_map_multiple = stack_idx + 1;
1611 CCL_CALL_FOR_MAP_INSTRUCTION (content, current_ic);
1612 }
1613 else
1614 CCL_INVALID_CMD;
1615 }
1616 if (mapping_stack_pointer <= (mapping_stack + 1))
1617 break;
1618 POP_MAPPING_STACK (map_set_rest_length, reg[rrr]);
1619 i += map_set_rest_length;
1620 ic += map_set_rest_length;
1621 POP_MAPPING_STACK (map_set_rest_length, reg[rrr]);
1622 } while (1);
1623
1624 ic = fin_ic;
1625 }
1626 reg[rrr] = op;
1627 break;
1628
1629 case CCL_MapSingle:
1630 {
1631 Lisp_Object map, attrib, value, content;
1632 int size, point;
1633 j = XINT (ccl_prog[ic++]);
1634 op = reg[rrr];
1635 if (j >= ASIZE (Vcode_conversion_map_vector))
1636 {
1637 reg[RRR] = -1;
1638 break;
1639 }
1640 map = AREF (Vcode_conversion_map_vector, j);
1641 if (!CONSP (map))
1642 {
1643 reg[RRR] = -1;
1644 break;
1645 }
1646 map = XCDR (map);
1647 if (!VECTORP (map))
1648 {
1649 reg[RRR] = -1;
1650 break;
1651 }
1652 size = ASIZE (map);
1653 point = XUINT (AREF (map, 0));
1654 point = op - point + 1;
1655 reg[RRR] = 0;
1656 if ((size <= 1) ||
1657 (!((point >= 1) && (point < size))))
1658 reg[RRR] = -1;
1659 else
1660 {
1661 reg[RRR] = 0;
1662 content = AREF (map, point);
1663 if (NILP (content))
1664 reg[RRR] = -1;
1665 else if (NUMBERP (content))
1666 reg[rrr] = XINT (content);
1667 else if (EQ (content, Qt));
1668 else if (CONSP (content))
1669 {
1670 attrib = XCAR (content);
1671 value = XCDR (content);
1672 if (!NUMBERP (attrib) || !NUMBERP (value))
1673 continue;
1674 reg[rrr] = XUINT(value);
1675 break;
1676 }
1677 else if (SYMBOLP (content))
1678 CCL_CALL_FOR_MAP_INSTRUCTION (content, ic);
1679 else
1680 reg[RRR] = -1;
1681 }
1682 }
1683 break;
1684
1685 default:
1686 CCL_INVALID_CMD;
1687 }
1688 break;
1689
1690 default:
1691 CCL_INVALID_CMD;
1692 }
1693 }
1694
1695 ccl_error_handler:
1696 1697
1698 if (!ccl->suppress_error && destination)
1699 {
1700 1701 1702
1703 char msg[256];
1704 int msglen;
1705
1706 if (!dst)
1707 dst = destination;
1708
1709 switch (ccl->status)
1710 {
1711 case CCL_STAT_INVALID_CMD:
1712 sprintf(msg, "\nCCL: Invalid command %x (ccl_code = %x) at %d.",
1713 code & 0x1F, code, this_ic);
1714 #ifdef CCL_DEBUG
1715 {
1716 int i = ccl_backtrace_idx - 1;
1717 int j;
1718
1719 msglen = strlen (msg);
1720 if (dst + msglen <= (dst_bytes ? dst_end : src))
1721 {
1722 bcopy (msg, dst, msglen);
1723 dst += msglen;
1724 }
1725
1726 for (j = 0; j < CCL_DEBUG_BACKTRACE_LEN; j++, i--)
1727 {
1728 if (i < 0) i = CCL_DEBUG_BACKTRACE_LEN - 1;
1729 if (ccl_backtrace_table[i] == 0)
1730 break;
1731 sprintf(msg, " %d", ccl_backtrace_table[i]);
1732 msglen = strlen (msg);
1733 if (dst + msglen > (dst_bytes ? dst_end : src))
1734 break;
1735 bcopy (msg, dst, msglen);
1736 dst += msglen;
1737 }
1738 goto ccl_finish;
1739 }
1740 #endif
1741 break;
1742
1743 case CCL_STAT_QUIT:
1744 if (! ccl->quit_silently)
1745 sprintf(msg, "\nCCL: Quited.");
1746 break;
1747
1748 default:
1749 sprintf(msg, "\nCCL: Unknown error type (%d)", ccl->status);
1750 }
1751
1752 msglen = strlen (msg);
1753 if (dst + msglen <= dst_end)
1754 {
1755 for (i = 0; i < msglen; i++)
1756 *dst++ = msg[i];
1757 }
1758
1759 if (ccl->status == CCL_STAT_INVALID_CMD)
1760 {
1761 #if 0 1762
1763
1764
1765 int i = src_end - src;
1766 if (dst_bytes && (dst_end - dst) < i)
1767 i = dst_end - dst;
1768 bcopy (src, dst, i);
1769 src += i;
1770 dst += i;
1771 #else
1772
1773 src = src_end;
1774 #endif
1775 }
1776 }
1777
1778 ccl_finish:
1779 ccl->ic = ic;
1780 ccl->stack_idx = stack_idx;
1781 ccl->prog = ccl_prog;
1782 ccl->consumed = src - source;
1783 if (dst != NULL)
1784 ccl->produced = dst - destination;
1785 else
1786 ccl->produced = 0;
1787 }
1788
1789 1790 1791 1792 1793 1794 1795
1796
1797 static Lisp_Object
1798 resolve_symbol_ccl_program (ccl)
1799 Lisp_Object ccl;
1800 {
1801 int i, veclen, unresolved = 0;
1802 Lisp_Object result, contents, val;
1803
1804 result = ccl;
1805 veclen = ASIZE (result);
1806
1807 for (i = 0; i < veclen; i++)
1808 {
1809 contents = AREF (result, i);
1810 if (INTEGERP (contents))
1811 continue;
1812 else if (CONSP (contents)
1813 && SYMBOLP (XCAR (contents))
1814 && SYMBOLP (XCDR (contents)))
1815 {
1816 1817 1818
1819
1820 if (EQ (result, ccl))
1821 result = Fcopy_sequence (ccl);
1822
1823 val = Fget (XCAR (contents), XCDR (contents));
1824 if (NATNUMP (val))
1825 ASET (result, i, val);
1826 else
1827 unresolved = 1;
1828 continue;
1829 }
1830 else if (SYMBOLP (contents))
1831 {
1832 1833 1834
1835 if (EQ (result, ccl))
1836 result = Fcopy_sequence (ccl);
1837
1838 val = Fget (contents, Qtranslation_table_id);
1839 if (NATNUMP (val))
1840 ASET (result, i, val);
1841 else
1842 {
1843 val = Fget (contents, Qcode_conversion_map_id);
1844 if (NATNUMP (val))
1845 ASET (result, i, val);
1846 else
1847 {
1848 val = Fget (contents, Qccl_program_idx);
1849 if (NATNUMP (val))
1850 ASET (result, i, val);
1851 else
1852 unresolved = 1;
1853 }
1854 }
1855 continue;
1856 }
1857 return Qnil;
1858 }
1859
1860 return (unresolved ? Qt : result);
1861 }
1862
1863 1864 1865 1866 1867
1868
1869 static Lisp_Object
1870 ccl_get_compiled_code (ccl_prog, idx)
1871 Lisp_Object ccl_prog;
1872 int *idx;
1873 {
1874 Lisp_Object val, slot;
1875
1876 if (VECTORP (ccl_prog))
1877 {
1878 val = resolve_symbol_ccl_program (ccl_prog);
1879 *idx = -1;
1880 return (VECTORP (val) ? val : Qnil);
1881 }
1882 if (!SYMBOLP (ccl_prog))
1883 return Qnil;
1884
1885 val = Fget (ccl_prog, Qccl_program_idx);
1886 if (! NATNUMP (val)
1887 || XINT (val) >= ASIZE (Vccl_program_table))
1888 return Qnil;
1889 slot = AREF (Vccl_program_table, XINT (val));
1890 if (! VECTORP (slot)
1891 || ASIZE (slot) != 4
1892 || ! VECTORP (AREF (slot, 1)))
1893 return Qnil;
1894 *idx = XINT (val);
1895 if (NILP (AREF (slot, 2)))
1896 {
1897 val = resolve_symbol_ccl_program (AREF (slot, 1));
1898 if (! VECTORP (val))
1899 return Qnil;
1900 ASET (slot, 1, val);
1901 ASET (slot, 2, Qt);
1902 }
1903 return AREF (slot, 1);
1904 }
1905
1906 1907 1908 1909 1910 1911
1912 int
1913 setup_ccl_program (ccl, ccl_prog)
1914 struct ccl_program *ccl;
1915 Lisp_Object ccl_prog;
1916 {
1917 int i;
1918
1919 if (! NILP (ccl_prog))
1920 {
1921 struct Lisp_Vector *vp;
1922
1923 ccl_prog = ccl_get_compiled_code (ccl_prog, &ccl->idx);
1924 if (! VECTORP (ccl_prog))
1925 return -1;
1926 vp = XVECTOR (ccl_prog);
1927 ccl->size = vp->size;
1928 ccl->prog = vp->contents;
1929 ccl->eof_ic = XINT (vp->contents[CCL_HEADER_EOF]);
1930 ccl->buf_magnification = XINT (vp->contents[CCL_HEADER_BUF_MAG]);
1931 if (ccl->idx >= 0)
1932 {
1933 Lisp_Object slot;
1934
1935 slot = AREF (Vccl_program_table, ccl->idx);
1936 ASET (slot, 3, Qnil);
1937 }
1938 }
1939 ccl->ic = CCL_HEADER_MAIN;
1940 for (i = 0; i < 8; i++)
1941 ccl->reg[i] = 0;
1942 ccl->last_block = 0;
1943 ccl->private_state = 0;
1944 ccl->status = 0;
1945 ccl->stack_idx = 0;
1946 ccl->suppress_error = 0;
1947 ccl->eight_bit_control = 0;
1948 ccl->quit_silently = 0;
1949 return 0;
1950 }
1951
1952
1953
1954
1955 int
1956 check_ccl_update (ccl)
1957 struct ccl_program *ccl;
1958 {
1959 Lisp_Object slot, ccl_prog;
1960
1961 if (ccl->idx < 0)
1962 return 0;
1963 slot = AREF (Vccl_program_table, ccl->idx);
1964 if (NILP (AREF (slot, 3)))
1965 return 0;
1966 ccl_prog = ccl_get_compiled_code (AREF (slot, 0), &ccl->idx);
1967 if (! VECTORP (ccl_prog))
1968 return -1;
1969 ccl->size = ASIZE (ccl_prog);
1970 ccl->prog = XVECTOR (ccl_prog)->contents;
1971 ccl->eof_ic = XINT (AREF (ccl_prog, CCL_HEADER_EOF));
1972 ccl->buf_magnification = XINT (AREF (ccl_prog, CCL_HEADER_BUF_MAG));
1973 ASET (slot, 3, Qnil);
1974 return 0;
1975 }
1976
1977
1978 DEFUN ("ccl-program-p", Fccl_program_p, Sccl_program_p, 1, 1, 0,
1979 doc: 1980 )
1981 (object)
1982 Lisp_Object object;
1983 {
1984 Lisp_Object val;
1985
1986 if (VECTORP (object))
1987 {
1988 val = resolve_symbol_ccl_program (object);
1989 return (VECTORP (val) ? Qt : Qnil);
1990 }
1991 if (!SYMBOLP (object))
1992 return Qnil;
1993
1994 val = Fget (object, Qccl_program_idx);
1995 return ((! NATNUMP (val)
1996 || XINT (val) >= ASIZE (Vccl_program_table))
1997 ? Qnil : Qt);
1998 }
1999
2000 DEFUN ("ccl-execute", Fccl_execute, Sccl_execute, 2, 2, 0,
2001 doc: 2002 2003 2004 2005 2006 2007 2008 2009 2010 2011 2012 2013 2014 2015 )
2016 (ccl_prog, reg)
2017 Lisp_Object ccl_prog, reg;
2018 {
2019 struct ccl_program ccl;
2020 int i;
2021
2022 if (setup_ccl_program (&ccl, ccl_prog) < 0)
2023 error ("Invalid CCL program");
2024
2025 CHECK_VECTOR (reg);
2026 if (ASIZE (reg) != 8)
2027 error ("Length of vector REGISTERS is not 8");
2028
2029 for (i = 0; i < 8; i++)
2030 ccl.reg[i] = (INTEGERP (AREF (reg, i))
2031 ? XINT (AREF (reg, i))
2032 : 0);
2033
2034 ccl_driver (&ccl, NULL, NULL, 0, 0, Qnil);
2035 QUIT;
2036 if (ccl.status != CCL_STAT_SUCCESS)
2037 error ("Error in CCL program at %dth code", ccl.ic);
2038
2039 for (i = 0; i < 8; i++)
2040 ASET (reg, i, make_number (ccl.reg[i]));
2041 return Qnil;
2042 }
2043
2044 DEFUN ("ccl-execute-on-string", Fccl_execute_on_string, Sccl_execute_on_string,
2045 3, 5, 0,
2046 doc: 2047 2048 2049 2050 2051 2052 2053 2054 2055 2056 2057 2058 2059 2060 2061 2062 2063 2064 2065 2066 2067 2068 2069 2070 )
2071 (ccl_prog, status, str, contin, unibyte_p)
2072 Lisp_Object ccl_prog, status, str, contin, unibyte_p;
2073 {
2074 Lisp_Object val;
2075 struct ccl_program ccl;
2076 int i;
2077 int outbufsize;
2078 unsigned char *outbuf, *outp;
2079 int str_chars, str_bytes;
2080 #define CCL_EXECUTE_BUF_SIZE 1024
2081 int source[CCL_EXECUTE_BUF_SIZE], destination[CCL_EXECUTE_BUF_SIZE];
2082 int consumed_chars, consumed_bytes, produced_chars;
2083
2084 if (setup_ccl_program (&ccl, ccl_prog) < 0)
2085 error ("Invalid CCL program");
2086
2087 CHECK_VECTOR (status);
2088 if (ASIZE (status) != 9)
2089 error ("Length of vector STATUS is not 9");
2090 CHECK_STRING (str);
2091
2092 str_chars = SCHARS (str);
2093 str_bytes = SBYTES (str);
2094
2095 for (i = 0; i < 8; i++)
2096 {
2097 if (NILP (AREF (status, i)))
2098 ASET (status, i, make_number (0));
2099 if (INTEGERP (AREF (status, i)))
2100 ccl.reg[i] = XINT (AREF (status, i));
2101 }
2102 if (INTEGERP (AREF (status, i)))
2103 {
2104 i = XFASTINT (AREF (status, 8));
2105 if (ccl.ic < i && i < ccl.size)
2106 ccl.ic = i;
2107 }
2108
2109 outbufsize = (ccl.buf_magnification
2110 ? str_bytes * ccl.buf_magnification + 256
2111 : str_bytes + 256);
2112 outp = outbuf = (unsigned char *) xmalloc (outbufsize);
2113
2114 consumed_chars = consumed_bytes = 0;
2115 produced_chars = 0;
2116 while (1)
2117 {
2118 const unsigned char *p = SDATA (str) + consumed_bytes;
2119 const unsigned char *endp = SDATA (str) + str_bytes;
2120 int i = 0;
2121 int *src, src_size;
2122
2123 if (endp - p == str_chars - consumed_chars)
2124 while (i < CCL_EXECUTE_BUF_SIZE && p < endp)
2125 source[i++] = *p++;
2126 else
2127 while (i < CCL_EXECUTE_BUF_SIZE && p < endp)
2128 source[i++] = STRING_CHAR_ADVANCE (p);
2129 consumed_chars += i;
2130 consumed_bytes = p - SDATA (str);
2131
2132 if (consumed_bytes == str_bytes)
2133 ccl.last_block = NILP (contin);
2134 src = source;
2135 src_size = i;
2136 while (1)
2137 {
2138 ccl_driver (&ccl, src, destination, src_size, CCL_EXECUTE_BUF_SIZE,
2139 Qnil);
2140 produced_chars += ccl.produced;
2141 if (NILP (unibyte_p))
2142 {
2143 if (outp - outbuf + MAX_MULTIBYTE_LENGTH * ccl.produced
2144 > outbufsize)
2145 {
2146 int offset = outp - outbuf;
2147 outbufsize += MAX_MULTIBYTE_LENGTH * ccl.produced;
2148 outbuf = (unsigned char *) xrealloc (outbuf, outbufsize);
2149 outp = outbuf + offset;
2150 }
2151 for (i = 0; i < ccl.produced; i++)
2152 CHAR_STRING_ADVANCE (destination[i], outp);
2153 }
2154 else
2155 {
2156 if (outp - outbuf + ccl.produced > outbufsize)
2157 {
2158 int offset = outp - outbuf;
2159 outbufsize += ccl.produced;
2160 outbuf = (unsigned char *) xrealloc (outbuf, outbufsize);
2161 outp = outbuf + offset;
2162 }
2163 for (i = 0; i < ccl.produced; i++)
2164 *outp++ = destination[i];
2165 }
2166 src += ccl.consumed;
2167 src_size -= ccl.consumed;
2168 if (ccl.status != CCL_STAT_SUSPEND_BY_DST)
2169 break;
2170 }
2171
2172 if (ccl.status != CCL_STAT_SUSPEND_BY_SRC
2173 || str_chars == consumed_chars)
2174 break;
2175 }
2176
2177 if (ccl.status == CCL_STAT_INVALID_CMD)
2178 error ("Error in CCL program at %dth code", ccl.ic);
2179 if (ccl.status == CCL_STAT_QUIT)
2180 error ("CCL program interrupted at %dth code", ccl.ic);
2181
2182 for (i = 0; i < 8; i++)
2183 ASET (status, i, make_number (ccl.reg[i]));
2184 ASET (status, 8, make_number (ccl.ic));
2185
2186 if (NILP (unibyte_p))
2187 val = make_multibyte_string ((char *) outbuf, produced_chars,
2188 outp - outbuf);
2189 else
2190 val = make_unibyte_string ((char *) outbuf, produced_chars);
2191 xfree (outbuf);
2192
2193 return val;
2194 }
2195
2196 DEFUN ("register-ccl-program", Fregister_ccl_program, Sregister_ccl_program,
2197 2, 2, 0,
2198 doc: 2199 2200 2201 )
2202 (name, ccl_prog)
2203 Lisp_Object name, ccl_prog;
2204 {
2205 int len = ASIZE (Vccl_program_table);
2206 int idx;
2207 Lisp_Object resolved;
2208
2209 CHECK_SYMBOL (name);
2210 resolved = Qnil;
2211 if (!NILP (ccl_prog))
2212 {
2213 CHECK_VECTOR (ccl_prog);
2214 resolved = resolve_symbol_ccl_program (ccl_prog);
2215 if (NILP (resolved))
2216 error ("Error in CCL program");
2217 if (VECTORP (resolved))
2218 {
2219 ccl_prog = resolved;
2220 resolved = Qt;
2221 }
2222 else
2223 resolved = Qnil;
2224 }
2225
2226 for (idx = 0; idx < len; idx++)
2227 {
2228 Lisp_Object slot;
2229
2230 slot = AREF (Vccl_program_table, idx);
2231 if (!VECTORP (slot))
2232
2233 break;
2234
2235 if (EQ (name, AREF (slot, 0)))
2236 {
2237
2238 ASET (slot, 1, ccl_prog);
2239 ASET (slot, 2, resolved);
2240 ASET (slot, 3, Qt);
2241 return make_number (idx);
2242 }
2243 }
2244
2245 if (idx == len)
2246
2247 Vccl_program_table = larger_vector (Vccl_program_table, len * 2, Qnil);
2248
2249 {
2250 Lisp_Object elt;
2251
2252 elt = Fmake_vector (make_number (4), Qnil);
2253 ASET (elt, 0, name);
2254 ASET (elt, 1, ccl_prog);
2255 ASET (elt, 2, resolved);
2256 ASET (elt, 3, Qt);
2257 ASET (Vccl_program_table, idx, elt);
2258 }
2259
2260 Fput (name, Qccl_program_idx, make_number (idx));
2261 return make_number (idx);
2262 }
2263
2264 2265 2266 2267 2268 2269 2270 2271
2272
2273 DEFUN ("register-code-conversion-map", Fregister_code_conversion_map,
2274 Sregister_code_conversion_map,
2275 2, 2, 0,
2276 doc: 2277 )
2278 (symbol, map)
2279 Lisp_Object symbol, map;
2280 {
2281 int len = ASIZE (Vcode_conversion_map_vector);
2282 int i;
2283 Lisp_Object index;
2284
2285 CHECK_SYMBOL (symbol);
2286 CHECK_VECTOR (map);
2287
2288 for (i = 0; i < len; i++)
2289 {
2290 Lisp_Object slot = AREF (Vcode_conversion_map_vector, i);
2291
2292 if (!CONSP (slot))
2293 break;
2294
2295 if (EQ (symbol, XCAR (slot)))
2296 {
2297 index = make_number (i);
2298 XSETCDR (slot, map);
2299 Fput (symbol, Qcode_conversion_map, map);
2300 Fput (symbol, Qcode_conversion_map_id, index);
2301 return index;
2302 }
2303 }
2304
2305 if (i == len)
2306 Vcode_conversion_map_vector = larger_vector (Vcode_conversion_map_vector,
2307 len * 2, Qnil);
2308
2309 index = make_number (i);
2310 Fput (symbol, Qcode_conversion_map, map);
2311 Fput (symbol, Qcode_conversion_map_id, index);
2312 ASET (Vcode_conversion_map_vector, i, Fcons (symbol, map));
2313 return index;
2314 }
2315
2316
2317 void
2318 syms_of_ccl ()
2319 {
2320 staticpro (&Vccl_program_table);
2321 Vccl_program_table = Fmake_vector (make_number (32), Qnil);
2322
2323 Qccl = intern_c_string ("ccl");
2324 staticpro (&Qccl);
2325
2326 Qcclp = intern_c_string ("cclp");
2327 staticpro (&Qcclp);
2328
2329 Qccl_program = intern_c_string ("ccl-program");
2330 staticpro (&Qccl_program);
2331
2332 Qccl_program_idx = intern_c_string ("ccl-program-idx");
2333 staticpro (&Qccl_program_idx);
2334
2335 Qcode_conversion_map = intern_c_string ("code-conversion-map");
2336 staticpro (&Qcode_conversion_map);
2337
2338 Qcode_conversion_map_id = intern_c_string ("code-conversion-map-id");
2339 staticpro (&Qcode_conversion_map_id);
2340
2341 DEFVAR_LISP ("code-conversion-map-vector", &Vcode_conversion_map_vector,
2342 doc: );
2343 Vcode_conversion_map_vector = Fmake_vector (make_number (16), Qnil);
2344
2345 DEFVAR_LISP ("font-ccl-encoder-alist", &Vfont_ccl_encoder_alist,
2346 doc: 2347 2348 2349 2350 2351 2352 2353 2354 2355 );
2356 Vfont_ccl_encoder_alist = Qnil;
2357
2358 DEFVAR_LISP ("translation-hash-table-vector", &Vtranslation_hash_table_vector,
2359 doc: 2360 2361 2362 );
2363 Vtranslation_hash_table_vector = Qnil;
2364
2365 defsubr (&Sccl_program_p);
2366 defsubr (&Sccl_execute);
2367 defsubr (&Sccl_execute_on_string);
2368 defsubr (&Sregister_ccl_program);
2369 defsubr (&Sregister_code_conversion_map);
2370 }
2371
2372 2373