Mercurial > hg > xemacs-beta

comparison src/mule-ccl.c @ 4072:aa28d959af41

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
[xemacs-hg @ 2007-07-22 22:03:29 by aidan] Add support for non-ISO2022 8 bit fixed-width coding-systems
author aidan
date Sun, 22 Jul 2007 22:04:14 +0000
parents d6a215ad08b8
children 6f05405e63fc
comparison
equal deleted inserted replaced
4071:d607d13fca67 4072:aa28d959af41
27 27
28 #include "buffer.h" 28 #include "buffer.h"
29 #include "charset.h" 29 #include "charset.h"
30 #include "mule-ccl.h" 30 #include "mule-ccl.h"
31 #include "file-coding.h" 31 #include "file-coding.h"
32 #include "elhash.h"
32 33
33 Lisp_Object Qccl_error; 34 Lisp_Object Qccl_error;
34 35
35 /* This contains all code conversion map available to CCL. */ 36 /* This contains all code conversion map available to CCL. */
36 Lisp_Object Vcode_conversion_map_vector; 37 Lisp_Object Vcode_conversion_map_vector;
37
38 /* Alist of fontname patterns vs corresponding CCL program. */
39 Lisp_Object Vfont_ccl_encoder_alist;
40 38
41 /* This symbol is a property which associates with ccl program vector. 39 /* This symbol is a property which associates with ccl program vector.
42 Ex: (get 'ccl-big5-encoder 'ccl-program) returns ccl program vector. 40 Ex: (get 'ccl-big5-encoder 'ccl-program) returns ccl program vector.
43 Moved to general-slots.h. */ 41 Moved to general-slots.h. */
44 /* Lisp_Object Qccl_program; */ 42 /* Lisp_Object Qccl_program; */
56 NAME, CCL_PROG, and RESOLVEDP where NAME (symbol) is the name of 54 NAME, CCL_PROG, and RESOLVEDP where NAME (symbol) is the name of
57 the program, CCL_PROG (vector) is the compiled code of the program, 55 the program, CCL_PROG (vector) is the compiled code of the program,
58 RESOLVEDP (t or nil) is the flag to tell if symbols in CCL_PROG is 56 RESOLVEDP (t or nil) is the flag to tell if symbols in CCL_PROG is
59 already resolved to index numbers or not. */ 57 already resolved to index numbers or not. */
60 Lisp_Object Vccl_program_table; 58 Lisp_Object Vccl_program_table;
59
60 /* Vector of registered hash tables for translation. */
61 Lisp_Object Vtranslation_hash_table_vector;
62
63 /* Return a hash table of id number ID. */
64 #define GET_HASH_TABLE(id) \
65 (XHASH_TABLE (XCDR(XVECTOR(Vtranslation_hash_table_vector)->contents[(id)])))
66 /* Copied from fns.c. */
67 #define HASH_VALUE(H, IDX) AREF ((H)->key_and_value, 2 * (IDX) + 1)
61 68
62 /* CCL (Code Conversion Language) is a simple language which has 69 /* CCL (Code Conversion Language) is a simple language which has
63 operations on one input buffer, one output buffer, and 7 registers. 70 operations on one input buffer, one output buffer, and 7 registers.
64 The syntax of CCL is described in `ccl.el'. Emacs Lisp function 71 The syntax of CCL is described in `ccl.el'. Emacs Lisp function
65 `ccl-compile' compiles a CCL program and produces a CCL code which 72 `ccl-compile' compiles a CCL program and produces a CCL code which
648 If some valid mapping is found, 655 If some valid mapping is found,
649 set reg[rrr] to the result, 656 set reg[rrr] to the result,
650 else 657 else
651 set reg[RRR] to -1. 658 set reg[RRR] to -1.
652 */ 659 */
660
661 #define CCL_LookupIntConstTbl 0x13 /* Lookup multibyte character by
662 integer key. Afterwards R7 set
663 to 1 iff lookup succeeded.
664 1:ExtendedCOMMNDRrrRRRXXXXXXXX
665 2:ARGUMENT(Hash table ID) */
666
667 #define CCL_LookupCharConstTbl 0x14 /* Lookup integer by multibyte
668 character key. Afterwards R7 set
669 to 1 iff lookup succeeded.
670 1:ExtendedCOMMNDRrrRRRrrrXXXXX
671 2:ARGUMENT(Hash table ID) */
672
653 673
654 /* CCL arithmetic/logical operators. */ 674 /* CCL arithmetic/logical operators. */
655 #define CCL_PLUS 0x00 /* X = Y + Z */ 675 #define CCL_PLUS 0x00 /* X = Y + Z */
656 #define CCL_MINUS 0x01 /* X = Y - Z */ 676 #define CCL_MINUS 0x01 /* X = Y - Z */
657 #define CCL_MUL 0x02 /* X = Y * Z */ 677 #define CCL_MUL 0x02 /* X = Y * Z */
771 CCL_INVALID_CMD; \ 791 CCL_INVALID_CMD; \
772 else if (conversion_mode == CCL_MODE_ENCODING) \ 792 else if (conversion_mode == CCL_MODE_ENCODING) \
773 { \ 793 { \
774 for (i = 0; i < (len); i++) \ 794 for (i = 0; i < (len); i++) \
775 { \ 795 { \
776 ch = ((XINT (ccl_prog[ic + (i / 3)])) \ 796 ch = ((XCHAR_OR_INT (ccl_prog[ic + (i / 3)])) \
777 >> ((2 - (i % 3)) * 8)) & 0xFF; \ 797 >> ((2 - (i % 3)) * 8)) & 0xFF; \
778 if (ch == '\n') \ 798 if (ch == '\n') \
779 { \ 799 { \
780 if (ccl->eol_type == CCL_CODING_EOL_CRLF) \ 800 if (ccl->eol_type == CCL_CODING_EOL_CRLF) \
781 { \ 801 { \
800 } \ 820 } \
801 else \ 821 else \
802 { \ 822 { \
803 for (i = 0; i < (len); i++) \ 823 for (i = 0; i < (len); i++) \
804 { \ 824 { \
805 ch = ((XINT (ccl_prog[ic + (i / 3)])) \ 825 ch = ((XCHAR_OR_INT (ccl_prog[ic + (i / 3)])) \
806 >> ((2 - (i % 3)) * 8)) & 0xFF; \ 826 >> ((2 - (i % 3)) * 8)) & 0xFF; \
807 if (!ichar_multibyte_p(ch)) \ 827 if (!ichar_multibyte_p(ch)) \
808 { \ 828 { \
809 Dynarr_add (destination, ch); \ 829 Dynarr_add (destination, ch); \
810 } \ 830 } \
835 CCL_SUSPEND (CCL_STAT_SUSPEND_BY_SRC); \ 855 CCL_SUSPEND (CCL_STAT_SUSPEND_BY_SRC); \
836 } \ 856 } \
837 } while (0) 857 } while (0)
838 858
839 #define POSSIBLE_LEADING_BYTE_P(leading_byte) \ 859 #define POSSIBLE_LEADING_BYTE_P(leading_byte) \
840 ((leading_byte > MIN_LEADING_BYTE) && \ 860 ((leading_byte >= MIN_LEADING_BYTE) && \
841 (leading_byte - MIN_LEADING_BYTE) < NUM_LEADING_BYTES) 861 (leading_byte - MIN_LEADING_BYTE) < NUM_LEADING_BYTES)
842 862
843 /* Set C to the character code made from CHARSET and CODE. This is 863 /* Set C to the character code made from CHARSET and CODE. This is
844 like make_ichar but check the validity of CHARSET and CODE. If they 864 like make_ichar but check the validity of CHARSET and CODE. If they
845 are not valid, set C to (CODE & 0xFF) because that is usually the 865 are not valid, set C to (CODE & 0xFF) because that is usually the
862 { \ 882 { \
863 c = ((code) & 0x1F) + 0x80; \ 883 c = ((code) & 0x1F) + 0x80; \
864 } \ 884 } \
865 else if (!NILP(charset_by_leading_byte(charset)) \ 885 else if (!NILP(charset_by_leading_byte(charset)) \
866 && ((code) >= 32) \ 886 && ((code) >= 32) \
867 && ((code) < 256 || ((code >> 8) & 0x7F) >= 32)) \ 887 && ((code) < 256 || ((code >> 7) & 0x7F) >= 32)) \
868 { \ 888 { \
869 int c1, c2 = 0; \ 889 int c1, c2 = 0; \
870 \ 890 \
871 if ((code) < 256) \ 891 if ((code) < 256) \
872 { \ 892 { \
873 c1 = (code) & 0x7F; \ 893 c1 = (code) & 0x7F; \
874 c2 = 0; \ 894 c2 = 0; \
875 } \ 895 } \
876 else \ 896 else \
877 { \ 897 { \
878 c1 = ((code) >> 8) & 0x7F; \ 898 c1 = ((code) >> 7) & 0x7F; \
879 c2 = (code) & 0x7F; \ 899 c2 = (code) & 0x7F; \
880 } \ 900 } \
881 c = make_ichar (charset_by_leading_byte(charset), \ 901 c = make_ichar (charset_by_leading_byte(charset), \
882 c1, c2); \ 902 c1, c2); \
883 } \ 903 } \
896 are updated. If SOURCE or DESTINATION is NULL, only operations on 916 are updated. If SOURCE or DESTINATION is NULL, only operations on
897 registers are permitted. */ 917 registers are permitted. */
898 918
899 #ifdef CCL_DEBUG 919 #ifdef CCL_DEBUG
900 #define CCL_DEBUG_BACKTRACE_LEN 256 920 #define CCL_DEBUG_BACKTRACE_LEN 256
901 int ccl_backtrace_table[CCL_BACKTRACE_TABLE]; 921 int ccl_backtrace_table[CCL_DEBUG_BACKTRACE_LEN];
902 int ccl_backtrace_idx; 922 int ccl_backtrace_idx;
903 #endif 923 #endif
904 924
905 struct ccl_prog_stack 925 struct ccl_prog_stack
906 { 926 {
964 ccl->status = CCL_STAT_QUIT; 984 ccl->status = CCL_STAT_QUIT;
965 break; 985 break;
966 } 986 }
967 987
968 this_ic = ic; 988 this_ic = ic;
969 code = XINT (ccl_prog[ic]); ic++; 989 code = XCHAR_OR_INT (ccl_prog[ic]); ic++;
970 field1 = code >> 8; 990 field1 = code >> 8;
971 field2 = (code & 0xFF) >> 5; 991 field2 = (code & 0xFF) >> 5;
972 992
973 #define rrr field2 993 #define rrr field2
974 #define RRR (field1 & 7) 994 #define RRR (field1 & 7)
985 case CCL_SetShortConst: /* CCCCCCCCCCCCCCCCCCCCrrrXXXXX */ 1005 case CCL_SetShortConst: /* CCCCCCCCCCCCCCCCCCCCrrrXXXXX */
986 reg[rrr] = field1; 1006 reg[rrr] = field1;
987 break; 1007 break;
988 1008
989 case CCL_SetConst: /* 00000000000000000000rrrXXXXX */ 1009 case CCL_SetConst: /* 00000000000000000000rrrXXXXX */
990 reg[rrr] = XINT (ccl_prog[ic]); 1010 reg[rrr] = XCHAR_OR_INT (ccl_prog[ic]);
991 ic++; 1011 ic++;
992 break; 1012 break;
993 1013
994 case CCL_SetArray: /* CCCCCCCCCCCCCCCCCCCCRRRrrrXXXXX */ 1014 case CCL_SetArray: /* CCCCCCCCCCCCCCCCCCCCRRRrrrXXXXX */
995 i = reg[RRR]; 1015 i = reg[RRR];
996 j = field1 >> 3; 1016 j = field1 >> 3;
997 /* #### it's non-obvious to me that we need these casts, 1017 /* #### it's non-obvious to me that we need these casts,
998 but the left one was already there so clearly the intention 1018 but the left one was already there so clearly the intention
999 was an unsigned comparison. --ben */ 1019 was an unsigned comparison. --ben */
1000 if ((unsigned int) i < (unsigned int) j) 1020 if ((unsigned int) i < (unsigned int) j)
1001 reg[rrr] = XINT (ccl_prog[ic + i]); 1021 reg[rrr] = XCHAR_OR_INT (ccl_prog[ic + i]);
1002 ic += j; 1022 ic += j;
1003 break; 1023 break;
1004 1024
1005 case CCL_Jump: /* A--D--D--R--E--S--S-000XXXXX */ 1025 case CCL_Jump: /* A--D--D--R--E--S--S-000XXXXX */
1006 ic += ADDR; 1026 ic += ADDR;
1024 CCL_READ_CHAR (reg[rrr]); 1044 CCL_READ_CHAR (reg[rrr]);
1025 ic += ADDR - 1; 1045 ic += ADDR - 1;
1026 break; 1046 break;
1027 1047
1028 case CCL_WriteConstJump: /* A--D--D--R--E--S--S-000XXXXX */ 1048 case CCL_WriteConstJump: /* A--D--D--R--E--S--S-000XXXXX */
1029 i = XINT (ccl_prog[ic]); 1049 i = XCHAR_OR_INT (ccl_prog[ic]);
1030 CCL_WRITE_CHAR (i); 1050 CCL_WRITE_CHAR (i);
1031 ic += ADDR; 1051 ic += ADDR;
1032 break; 1052 break;
1033 1053
1034 case CCL_WriteConstReadJump: /* A--D--D--R--E--S--S-rrrXXXXX */ 1054 case CCL_WriteConstReadJump: /* A--D--D--R--E--S--S-rrrXXXXX */
1035 i = XINT (ccl_prog[ic]); 1055 i = XCHAR_OR_INT (ccl_prog[ic]);
1036 CCL_WRITE_CHAR (i); 1056 CCL_WRITE_CHAR (i);
1037 ic++; 1057 ic++;
1038 CCL_READ_CHAR (reg[rrr]); 1058 CCL_READ_CHAR (reg[rrr]);
1039 ic += ADDR - 1; 1059 ic += ADDR - 1;
1040 break; 1060 break;
1041 1061
1042 case CCL_WriteStringJump: /* A--D--D--R--E--S--S-000XXXXX */ 1062 case CCL_WriteStringJump: /* A--D--D--R--E--S--S-000XXXXX */
1043 j = XINT (ccl_prog[ic]); 1063 j = XCHAR_OR_INT (ccl_prog[ic]);
1044 ic++; 1064 ic++;
1045 CCL_WRITE_STRING (j); 1065 CCL_WRITE_STRING (j);
1046 ic += ADDR - 1; 1066 ic += ADDR - 1;
1047 break; 1067 break;
1048 1068
1049 case CCL_WriteArrayReadJump: /* A--D--D--R--E--S--S-rrrXXXXX */ 1069 case CCL_WriteArrayReadJump: /* A--D--D--R--E--S--S-rrrXXXXX */
1050 i = reg[rrr]; 1070 i = reg[rrr];
1051 j = XINT (ccl_prog[ic]); 1071 j = XCHAR_OR_INT (ccl_prog[ic]);
1052 /* #### see comment at CCL_SetArray */ 1072 /* #### see comment at CCL_SetArray */
1053 if ((unsigned int) i < (unsigned int) j) 1073 if ((unsigned int) i < (unsigned int) j)
1054 { 1074 {
1055 i = XINT (ccl_prog[ic + 1 + i]); 1075 i = XCHAR_OR_INT (ccl_prog[ic + 1 + i]);
1056 CCL_WRITE_CHAR (i); 1076 CCL_WRITE_CHAR (i);
1057 } 1077 }
1058 ic += j + 2; 1078 ic += j + 2;
1059 CCL_READ_CHAR (reg[rrr]); 1079 CCL_READ_CHAR (reg[rrr]);
1060 ic += ADDR - (j + 2); 1080 ic += ADDR - (j + 2);
1069 CCL_READ_CHAR (reg[rrr]); 1089 CCL_READ_CHAR (reg[rrr]);
1070 /* fall through ... */ 1090 /* fall through ... */
1071 case CCL_Branch: /* CCCCCCCCCCCCCCCCCCCCrrrXXXXX */ 1091 case CCL_Branch: /* CCCCCCCCCCCCCCCCCCCCrrrXXXXX */
1072 /* #### see comment at CCL_SetArray */ 1092 /* #### see comment at CCL_SetArray */
1073 if ((unsigned int) reg[rrr] < (unsigned int) field1) 1093 if ((unsigned int) reg[rrr] < (unsigned int) field1)
1074 ic += XINT (ccl_prog[ic + reg[rrr]]); 1094 ic += XCHAR_OR_INT (ccl_prog[ic + reg[rrr]]);
1075 else 1095 else
1076 ic += XINT (ccl_prog[ic + field1]); 1096 ic += XCHAR_OR_INT (ccl_prog[ic + field1]);
1077 break; 1097 break;
1078 1098
1079 case CCL_ReadRegister: /* CCCCCCCCCCCCCCCCCCCCrrXXXXX */ 1099 case CCL_ReadRegister: /* CCCCCCCCCCCCCCCCCCCCrrXXXXX */
1080 while (1) 1100 while (1)
1081 { 1101 {
1082 CCL_READ_CHAR (reg[rrr]); 1102 CCL_READ_CHAR (reg[rrr]);
1083 if (!field1) break; 1103 if (!field1) break;
1084 code = XINT (ccl_prog[ic]); ic++; 1104 code = XCHAR_OR_INT (ccl_prog[ic]); ic++;
1085 field1 = code >> 8; 1105 field1 = code >> 8;
1086 field2 = (code & 0xFF) >> 5; 1106 field2 = (code & 0xFF) >> 5;
1087 } 1107 }
1088 break; 1108 break;
1089 1109
1090 case CCL_WriteExprConst: /* 1:00000OPERATION000RRR000XXXXX */ 1110 case CCL_WriteExprConst: /* 1:00000OPERATION000RRR000XXXXX */
1091 rrr = 7; 1111 rrr = 7;
1092 i = reg[RRR]; 1112 i = reg[RRR];
1093 j = XINT (ccl_prog[ic]); 1113 j = XCHAR_OR_INT (ccl_prog[ic]);
1094 op = field1 >> 6; 1114 op = field1 >> 6;
1095 jump_address = ic + 1; 1115 jump_address = ic + 1;
1096 goto ccl_set_expr; 1116 goto ccl_set_expr;
1097 1117
1098 case CCL_WriteRegister: /* CCCCCCCCCCCCCCCCCCCrrrXXXXX */ 1118 case CCL_WriteRegister: /* CCCCCCCCCCCCCCCCCCCrrrXXXXX */
1099 while (1) 1119 while (1)
1100 { 1120 {
1101 i = reg[rrr]; 1121 i = reg[rrr];
1102 CCL_WRITE_CHAR (i); 1122 CCL_WRITE_CHAR (i);
1103 if (!field1) break; 1123 if (!field1) break;
1104 code = XINT (ccl_prog[ic]); ic++; 1124 code = XCHAR_OR_INT (ccl_prog[ic]); ic++;
1105 field1 = code >> 8; 1125 field1 = code >> 8;
1106 field2 = (code & 0xFF) >> 5; 1126 field2 = (code & 0xFF) >> 5;
1107 } 1127 }
1108 break; 1128 break;
1109 1129
1122 1142
1123 /* If FFF is nonzero, the CCL program ID is in the 1143 /* If FFF is nonzero, the CCL program ID is in the
1124 following code. */ 1144 following code. */
1125 if (rrr) 1145 if (rrr)
1126 { 1146 {
1127 prog_id = XINT (ccl_prog[ic]); 1147 prog_id = XCHAR_OR_INT (ccl_prog[ic]);
1128 ic++; 1148 ic++;
1129 } 1149 }
1130 else 1150 else
1131 prog_id = field1; 1151 prog_id = field1;
1132 1152
1166 case CCL_WriteArray: /* CCCCCCCCCCCCCCCCCCCCrrrXXXXX */ 1186 case CCL_WriteArray: /* CCCCCCCCCCCCCCCCCCCCrrrXXXXX */
1167 i = reg[rrr]; 1187 i = reg[rrr];
1168 /* #### see comment at CCL_SetArray */ 1188 /* #### see comment at CCL_SetArray */
1169 if ((unsigned int) i < (unsigned int) field1) 1189 if ((unsigned int) i < (unsigned int) field1)
1170 { 1190 {
1171 j = XINT (ccl_prog[ic + i]); 1191 j = XCHAR_OR_INT (ccl_prog[ic + i]);
1172 CCL_WRITE_CHAR (j); 1192 CCL_WRITE_CHAR (j);
1173 } 1193 }
1174 ic += field1; 1194 ic += field1;
1175 break; 1195 break;
1176 1196
1188 suppress further processing. */ 1208 suppress further processing. */
1189 ic--; 1209 ic--;
1190 CCL_SUCCESS; 1210 CCL_SUCCESS;
1191 1211
1192 case CCL_ExprSelfConst: /* 00000OPERATION000000rrrXXXXX */ 1212 case CCL_ExprSelfConst: /* 00000OPERATION000000rrrXXXXX */
1193 i = XINT (ccl_prog[ic]); 1213 i = XCHAR_OR_INT (ccl_prog[ic]);
1194 ic++; 1214 ic++;
1195 op = field1 >> 6; 1215 op = field1 >> 6;
1196 goto ccl_expr_self; 1216 goto ccl_expr_self;
1197 1217
1198 case CCL_ExprSelfReg: /* 00000OPERATION000RRRrrrXXXXX */ 1218 case CCL_ExprSelfReg: /* 00000OPERATION000RRRrrrXXXXX */
1225 } 1245 }
1226 break; 1246 break;
1227 1247
1228 case CCL_SetExprConst: /* 00000OPERATION000RRRrrrXXXXX */ 1248 case CCL_SetExprConst: /* 00000OPERATION000RRRrrrXXXXX */
1229 i = reg[RRR]; 1249 i = reg[RRR];
1230 j = XINT (ccl_prog[ic]); 1250 j = XCHAR_OR_INT (ccl_prog[ic]);
1231 op = field1 >> 6; 1251 op = field1 >> 6;
1232 jump_address = ++ic; 1252 jump_address = ++ic;
1233 goto ccl_set_expr; 1253 goto ccl_set_expr;
1234 1254
1235 case CCL_SetExprReg: /* 00000OPERATIONRrrRRRrrrXXXXX */ 1255 case CCL_SetExprReg: /* 00000OPERATIONRrrRRRrrrXXXXX */
1241 1261
1242 case CCL_ReadJumpCondExprConst: /* A--D--D--R--E--S--S-rrrXXXXX */ 1262 case CCL_ReadJumpCondExprConst: /* A--D--D--R--E--S--S-rrrXXXXX */
1243 CCL_READ_CHAR (reg[rrr]); 1263 CCL_READ_CHAR (reg[rrr]);
1244 case CCL_JumpCondExprConst: /* A--D--D--R--E--S--S-rrrXXXXX */ 1264 case CCL_JumpCondExprConst: /* A--D--D--R--E--S--S-rrrXXXXX */
1245 i = reg[rrr]; 1265 i = reg[rrr];
1246 op = XINT (ccl_prog[ic]); 1266 op = XCHAR_OR_INT (ccl_prog[ic]);
1247 jump_address = ic++ + ADDR; 1267 jump_address = ic++ + ADDR;
1248 j = XINT (ccl_prog[ic]); 1268 j = XCHAR_OR_INT (ccl_prog[ic]);
1249 ic++; 1269 ic++;
1250 rrr = 7; 1270 rrr = 7;
1251 goto ccl_set_expr; 1271 goto ccl_set_expr;
1252 1272
1253 case CCL_ReadJumpCondExprReg: /* A--D--D--R--E--S--S-rrrXXXXX */ 1273 case CCL_ReadJumpCondExprReg: /* A--D--D--R--E--S--S-rrrXXXXX */
1254 CCL_READ_CHAR (reg[rrr]); 1274 CCL_READ_CHAR (reg[rrr]);
1255 case CCL_JumpCondExprReg: 1275 case CCL_JumpCondExprReg:
1256 i = reg[rrr]; 1276 i = reg[rrr];
1257 op = XINT (ccl_prog[ic]); 1277 op = XCHAR_OR_INT (ccl_prog[ic]);
1258 jump_address = ic++ + ADDR; 1278 jump_address = ic++ + ADDR;
1259 j = reg[XINT (ccl_prog[ic])]; 1279 j = reg[XCHAR_OR_INT (ccl_prog[ic])];
1260 ic++; 1280 ic++;
1261 rrr = 7; 1281 rrr = 7;
1262 1282
1263 ccl_set_expr: 1283 ccl_set_expr:
1264 switch (op) 1284 switch (op)
1356 else if (i == PRE_LEADING_BYTE_PRIVATE_1) 1376 else if (i == PRE_LEADING_BYTE_PRIVATE_1)
1357 { 1377 {
1358 if ((src + 1) >= src_end) 1378 if ((src + 1) >= src_end)
1359 goto ccl_read_multibyte_character_suspend; 1379 goto ccl_read_multibyte_character_suspend;
1360 reg[RRR] = *src++; 1380 reg[RRR] = *src++;
1361 reg[rrr] = (*src++ & 0x7F); 1381 reg[rrr] = (*src++ & 0xFF);
1362 } 1382 }
1363 else if (i == PRE_LEADING_BYTE_PRIVATE_2) 1383 else if (i == PRE_LEADING_BYTE_PRIVATE_2)
1364 { 1384 {
1365 if ((src + 2) >= src_end) 1385 if ((src + 2) >= src_end)
1366 goto ccl_read_multibyte_character_suspend; 1386 goto ccl_read_multibyte_character_suspend;
1436 1456
1437 case CCL_TranslateCharacterConstTbl: 1457 case CCL_TranslateCharacterConstTbl:
1438 #if 0 1458 #if 0
1439 /* XEmacs does not have translate_char or an equivalent. We 1459 /* XEmacs does not have translate_char or an equivalent. We
1440 do nothing on this operation. */ 1460 do nothing on this operation. */
1441 op = XINT (ccl_prog[ic]); /* table */ 1461 op = XCHAR_OR_INT (ccl_prog[ic]); /* table */
1442 ic++; 1462 ic++;
1443 CCL_MAKE_CHAR (reg[RRR], reg[rrr], i); 1463 CCL_MAKE_CHAR (reg[RRR], reg[rrr], i);
1444 op = translate_char (GET_TRANSLATION_TABLE (op), i, -1, 0, 0); 1464 op = translate_char (GET_TRANSLATION_TABLE (op), i, -1, 0, 0);
1445 SPLIT_CHAR (op, reg[RRR], i, j); 1465 SPLIT_CHAR (op, reg[RRR], i, j);
1446 if (j != -1) 1466 if (j != -1)
1452 1472
1453 case CCL_MuleToUnicode: 1473 case CCL_MuleToUnicode:
1454 { 1474 {
1455 Lisp_Object ucs; 1475 Lisp_Object ucs;
1456 1476
1457 CCL_MAKE_CHAR(reg[rrr], reg[RRR], op); 1477 CCL_MAKE_CHAR (reg[rrr], reg[RRR], op);
1478
1458 ucs = Fchar_to_unicode(make_char(op)); 1479 ucs = Fchar_to_unicode(make_char(op));
1459 1480
1460 if (NILP(ucs)) 1481 if (NILP(ucs))
1461 { 1482 {
1462 /* Uhh, char-to-unicode doesn't return nil at the 1483 /* Uhh, char-to-unicode doesn't return nil at the
1463 moment, only ever -1. */ 1484 moment, only ever -1. */
1464 reg[rrr] = 0xFFFD; /* REPLACEMENT CHARACTER */ 1485 reg[rrr] = 0xFFFD; /* REPLACEMENT CHARACTER */
1465 } 1486 }
1466 else 1487 else
1467 { 1488 {
1468 reg[rrr] = XINT(ucs); 1489 reg[rrr] = XCHAR_OR_INT(ucs);
1469 if (-1 == reg[rrr]) 1490 if (-1 == reg[rrr])
1470 { 1491 {
1471 reg[rrr] = 0xFFFD; /* REPLACEMENT CHARACTER */ 1492 reg[rrr] = 0xFFFD; /* REPLACEMENT CHARACTER */
1472 } 1493 }
1473 } 1494 }
1486 BREAKUP_ICHAR (op, scratch, i, j); 1507 BREAKUP_ICHAR (op, scratch, i, j);
1487 reg[RRR] = XCHARSET_ID(scratch); 1508 reg[RRR] = XCHARSET_ID(scratch);
1488 1509
1489 if (j != 0) 1510 if (j != 0)
1490 { 1511 {
1491 i = (i << 8) | j; 1512 i = (i << 7) | j;
1492 } 1513 }
1493 1514
1494 reg[rrr] = i; 1515 reg[rrr] = i;
1495 } 1516 }
1496 else 1517 else
1497 { 1518 {
1498 reg[rrr] = reg[RRR] = 0; 1519 reg[rrr] = reg[RRR] = 0;
1499 } 1520 }
1500 break; 1521 break;
1501 } 1522 }
1523
1524 case CCL_LookupIntConstTbl:
1525 op = XCHAR_OR_INT (ccl_prog[ic]); /* table */
1526 ic++;
1527 {
1528 struct Lisp_Hash_Table *h = GET_HASH_TABLE (op);
1529 htentry *e = find_htentry(make_int (reg[RRR]), h);
1530 Lisp_Object scratch;
1531
1532 if (!HTENTRY_CLEAR_P(e))
1533 {
1534 op = XCHARVAL (e->value);
1535 if (!valid_ichar_p(op))
1536 {
1537 CCL_INVALID_CMD;
1538 }
1539
1540 BREAKUP_ICHAR (op, scratch, i, j);
1541 reg[RRR] = XCHARSET_ID(scratch);
1542
1543 if (j != 0)
1544 {
1545 i = (i << 7) | j;
1546 }
1547 reg[rrr] = i;
1548 reg[7] = 1; /* r7 true for success */
1549 }
1550 else
1551 reg[7] = 0;
1552 }
1553 break;
1554
1555 case CCL_LookupCharConstTbl:
1556 op = XCHAR_OR_INT (ccl_prog[ic]); /* table */
1557 ic++;
1558 CCL_MAKE_CHAR (reg[RRR], reg[rrr], i);
1559 {
1560 struct Lisp_Hash_Table *h = GET_HASH_TABLE (op);
1561 htentry *e = find_htentry(make_int(i), h);
1562
1563 if (!HTENTRY_CLEAR_P(e))
1564 {
1565 op = e->value;
1566 if (!INTP (op))
1567 CCL_INVALID_CMD;
1568 reg[RRR] = XCHAR_OR_INT (op);
1569 reg[7] = 1; /* r7 true for success */
1570 }
1571 else
1572 reg[7] = 0;
1573 }
1574 break;
1575
1502 1576
1503 case CCL_IterateMultipleMap: 1577 case CCL_IterateMultipleMap:
1504 { 1578 {
1505 Lisp_Object map, content, attrib, value; 1579 Lisp_Object map, content, attrib, value;
1506 int point, size, fin_ic; 1580 int point, size, fin_ic;
1507 1581
1508 j = XINT (ccl_prog[ic++]); /* number of maps. */ 1582 j = XCHAR_OR_INT (ccl_prog[ic++]); /* number of maps. */
1509 fin_ic = ic + j; 1583 fin_ic = ic + j;
1510 op = reg[rrr]; 1584 op = reg[rrr];
1511 if ((j > reg[RRR]) && (j >= 0)) 1585 if ((j > reg[RRR]) && (j >= 0))
1512 { 1586 {
1513 ic += reg[RRR]; 1587 ic += reg[RRR];
1521 } 1595 }
1522 1596
1523 for (;i < j;i++) 1597 for (;i < j;i++)
1524 { 1598 {
1525 size = XVECTOR (Vcode_conversion_map_vector)->size; 1599 size = XVECTOR (Vcode_conversion_map_vector)->size;
1526 point = XINT (ccl_prog[ic++]); 1600 point = XCHAR_OR_INT (ccl_prog[ic++]);
1527 if (point >= size) continue; 1601 if (point >= size) continue;
1528 map = 1602 map =
1529 XVECTOR (Vcode_conversion_map_vector)->contents[point]; 1603 XVECTOR (Vcode_conversion_map_vector)->contents[point];
1530 1604
1531 /* Check map validity. */ 1605 /* Check map validity. */
1567 if (NILP (content)) 1641 if (NILP (content))
1568 continue; 1642 continue;
1569 else if (INTP (content)) 1643 else if (INTP (content))
1570 { 1644 {
1571 reg[RRR] = i; 1645 reg[RRR] = i;
1572 reg[rrr] = XINT(content); 1646 reg[rrr] = XCHAR_OR_INT(content);
1573 break; 1647 break;
1574 } 1648 }
1575 else if (EQ (content, Qt) || EQ (content, Qlambda)) 1649 else if (EQ (content, Qt) || EQ (content, Qlambda))
1576 { 1650 {
1577 reg[RRR] = i; 1651 reg[RRR] = i;
1618 else 1692 else
1619 mapping_stack_pointer = mapping_stack; 1693 mapping_stack_pointer = mapping_stack;
1620 stack_idx_of_map_multiple = 0; 1694 stack_idx_of_map_multiple = 0;
1621 1695
1622 map_set_rest_length = 1696 map_set_rest_length =
1623 XINT (ccl_prog[ic++]); /* number of maps and separators. */ 1697 XCHAR_OR_INT (ccl_prog[ic++]); /* number of maps and separators. */
1624 fin_ic = ic + map_set_rest_length; 1698 fin_ic = ic + map_set_rest_length;
1625 op = reg[rrr]; 1699 op = reg[rrr];
1626 1700
1627 if ((map_set_rest_length > reg[RRR]) && (reg[RRR] >= 0)) 1701 if ((map_set_rest_length > reg[RRR]) && (reg[RRR] >= 0))
1628 { 1702 {
1686 map_vector_size = XVECTOR (Vcode_conversion_map_vector)->size; 1760 map_vector_size = XVECTOR (Vcode_conversion_map_vector)->size;
1687 1761
1688 do { 1762 do {
1689 for (;map_set_rest_length > 0;i++, ic++, map_set_rest_length--) 1763 for (;map_set_rest_length > 0;i++, ic++, map_set_rest_length--)
1690 { 1764 {
1691 point = XINT(ccl_prog[ic]); 1765 point = XCHAR_OR_INT(ccl_prog[ic]);
1692 if (point < 0) 1766 if (point < 0)
1693 { 1767 {
1694 /* +1 is for including separator. */ 1768 /* +1 is for including separator. */
1695 point = -point + 1; 1769 point = -point + 1;
1696 if (mapping_stack_pointer 1770 if (mapping_stack_pointer
1747 continue; 1821 continue;
1748 1822
1749 reg[RRR] = i; 1823 reg[RRR] = i;
1750 if (INTP (content)) 1824 if (INTP (content))
1751 { 1825 {
1752 op = XINT (content); 1826 op = XCHAR_OR_INT (content);
1753 i += map_set_rest_length - 1; 1827 i += map_set_rest_length - 1;
1754 ic += map_set_rest_length - 1; 1828 ic += map_set_rest_length - 1;
1755 POP_MAPPING_STACK (map_set_rest_length, reg[rrr]); 1829 POP_MAPPING_STACK (map_set_rest_length, reg[rrr]);
1756 map_set_rest_length++; 1830 map_set_rest_length++;
1757 } 1831 }
1805 1879
1806 case CCL_MapSingle: 1880 case CCL_MapSingle:
1807 { 1881 {
1808 Lisp_Object map, attrib, value, content; 1882 Lisp_Object map, attrib, value, content;
1809 int size, point; 1883 int size, point;
1810 j = XINT (ccl_prog[ic++]); /* map_id */ 1884 j = XCHAR_OR_INT (ccl_prog[ic++]); /* map_id */
1811 op = reg[rrr]; 1885 op = reg[rrr];
1812 if (j >= XVECTOR (Vcode_conversion_map_vector)->size) 1886 if (j >= XVECTOR (Vcode_conversion_map_vector)->size)
1813 { 1887 {
1814 reg[RRR] = -1; 1888 reg[RRR] = -1;
1815 break; 1889 break;
1838 reg[RRR] = 0; 1912 reg[RRR] = 0;
1839 content = XVECTOR (map)->contents[point]; 1913 content = XVECTOR (map)->contents[point];
1840 if (NILP (content)) 1914 if (NILP (content))
1841 reg[RRR] = -1; 1915 reg[RRR] = -1;
1842 else if (INTP (content)) 1916 else if (INTP (content))
1843 reg[rrr] = XINT (content); 1917 reg[rrr] = XCHAR_OR_INT (content);
1844 else if (EQ (content, Qt)); 1918 else if (EQ (content, Qt));
1845 else if (CONSP (content)) 1919 else if (CONSP (content))
1846 { 1920 {
1847 attrib = XCAR (content); 1921 attrib = XCAR (content);
1848 value = XCDR (content); 1922 value = XCDR (content);
1941 veclen = XVECTOR (result)->size; 2015 veclen = XVECTOR (result)->size;
1942 2016
1943 for (i = 0; i < veclen; i++) 2017 for (i = 0; i < veclen; i++)
1944 { 2018 {
1945 contents = XVECTOR (result)->contents[i]; 2019 contents = XVECTOR (result)->contents[i];
1946 if (INTP (contents)) 2020 /* XEmacs change; accept characters as well as integers, on the basis
2021 that most CCL code written doesn't make a distinction. */
2022 if (INTP (contents) || CHARP(contents))
1947 continue; 2023 continue;
1948 else if (CONSP (contents) 2024 else if (CONSP (contents)
1949 && SYMBOLP (XCAR (contents)) 2025 && SYMBOLP (XCAR (contents))
1950 && SYMBOLP (XCDR (contents))) 2026 && SYMBOLP (XCDR (contents)))
1951 { 2027 {
2105 CHECK_VECTOR (reg); 2181 CHECK_VECTOR (reg);
2106 if (XVECTOR_LENGTH (reg) != 8) 2182 if (XVECTOR_LENGTH (reg) != 8)
2107 syntax_error ("Length of vector REGISTERS is not 8", Qunbound); 2183 syntax_error ("Length of vector REGISTERS is not 8", Qunbound);
2108 2184
2109 for (i = 0; i < 8; i++) 2185 for (i = 0; i < 8; i++)
2110 ccl.reg[i] = (INTP (XVECTOR_DATA (reg)[i]) 2186 ccl.reg[i] = (INTP (XVECTOR_DATA (reg)[i]) || CHARP (XVECTOR_DATA (reg)[i])
2111 ? XINT (XVECTOR_DATA (reg)[i]) 2187 ? XCHAR_OR_INT (XVECTOR_DATA (reg)[i])
2112 : 0); 2188 : 0);
2113 2189
2114 ccl_driver (&ccl, (const unsigned char *)0, 2190 ccl_driver (&ccl, (const unsigned char *)0,
2115 (unsigned_char_dynarr *)0, 0, (int *)0, 2191 (unsigned_char_dynarr *)0, 0, (int *)0,
2116 CCL_MODE_ENCODING); 2192 CCL_MODE_ENCODING);
2170 { 2246 {
2171 if (NILP (XVECTOR_DATA (status)[i])) 2247 if (NILP (XVECTOR_DATA (status)[i]))
2172 XVECTOR_DATA (status)[i] = make_int (0); 2248 XVECTOR_DATA (status)[i] = make_int (0);
2173 if (INTP (XVECTOR_DATA (status)[i])) 2249 if (INTP (XVECTOR_DATA (status)[i]))
2174 ccl.reg[i] = XINT (XVECTOR_DATA (status)[i]); 2250 ccl.reg[i] = XINT (XVECTOR_DATA (status)[i]);
2251 if (CHARP (XVECTOR_DATA (status)[i]))
2252 ccl.reg[i] = XCHAR (XVECTOR_DATA (status)[i]);
2175 } 2253 }
2176 if (INTP (XVECTOR (status)->contents[i])) 2254 if (INTP (XVECTOR (status)->contents[i]) ||
2255 CHARP (XVECTOR (status)->contents[i]))
2177 { 2256 {
2178 i = XINT (XVECTOR_DATA (status)[8]); 2257 i = XCHAR_OR_INT (XVECTOR_DATA (status)[8]);
2179 if (ccl.ic < i && i < ccl.size) 2258 if (ccl.ic < i && i < ccl.size)
2180 ccl.ic = i; 2259 ccl.ic = i;
2181 } 2260 }
2182 outbuf = Dynarr_new (unsigned_char); 2261 outbuf = Dynarr_new (unsigned_char);
2183 ccl.last_block = NILP (continue_); 2262 ccl.last_block = NILP (continue_);
2345 } 2424 }
2346 2425
2347 void 2426 void
2348 vars_of_mule_ccl (void) 2427 vars_of_mule_ccl (void)
2349 { 2428 {
2429
2350 staticpro (&Vccl_program_table); 2430 staticpro (&Vccl_program_table);
2351 Vccl_program_table = Fmake_vector (make_int (32), Qnil); 2431 Vccl_program_table = Fmake_vector (make_int (32), Qnil);
2352 2432
2433 #ifdef DEBUG_XEMACS
2434 DEFVAR_LISP ("ccl-program-table",
2435 &Vccl_program_table /*
2436 Vector containing all registered CCL programs.
2437 */ );
2438 #endif
2353 DEFSYMBOL (Qccl_program); 2439 DEFSYMBOL (Qccl_program);
2354 DEFSYMBOL (Qccl_program_idx); 2440 DEFSYMBOL (Qccl_program_idx);
2355 DEFSYMBOL (Qcode_conversion_map); 2441 DEFSYMBOL (Qcode_conversion_map);
2356 DEFSYMBOL (Qcode_conversion_map_id); 2442 DEFSYMBOL (Qcode_conversion_map_id);
2357 2443
2358 DEFVAR_LISP ("code-conversion-map-vector", &Vcode_conversion_map_vector /* 2444 DEFVAR_LISP ("code-conversion-map-vector", &Vcode_conversion_map_vector /*
2359 Vector of code conversion maps. 2445 Vector of code conversion maps.
2360 */ ); 2446 */ );
2361 Vcode_conversion_map_vector = Fmake_vector (make_int (16), Qnil); 2447 Vcode_conversion_map_vector = Fmake_vector (make_int (16), Qnil);
2362 2448
2363 DEFVAR_LISP ("font-ccl-encoder-alist", &Vfont_ccl_encoder_alist /* 2449 DEFVAR_LISP ("translation-hash-table-vector",
2364 Alist of fontname patterns vs corresponding CCL program. 2450 &Vtranslation_hash_table_vector /*
2365 Each element looks like (REGEXP . CCL-CODE), 2451 Vector containing all translation hash tables ever defined.
2366 where CCL-CODE is a compiled CCL program. 2452 Comprises pairs (SYMBOL . TABLE) where SYMBOL and TABLE were set up by calls
2367 When a font whose name matches REGEXP is used for displaying a character, 2453 to `define-translation-hash-table'. The vector is indexed by the table id
2368 CCL-CODE is executed to calculate the code point in the font 2454 used by CCL.
2369 from the charset number and position code(s) of the character which are set
2370 in CCL registers R0, R1, and R2 before the execution.
2371 The code point in the font is set in CCL registers R1 and R2
2372 when the execution terminated.
2373 If the font is single-byte font, the register R2 is not used.
2374 */ ); 2455 */ );
2375 Vfont_ccl_encoder_alist = Qnil; 2456 Vtranslation_hash_table_vector = Qnil;
2457
2376 } 2458 }
2377 2459
2378 #endif /* emacs */ 2460 #endif /* emacs */