Mercurial > emacs
comparison src/ccl.c @ 21551:f928f4d89772
Typo in comments fixed.
(Qccl_program_idx, Qunification_table, Qunification_table_id): New
variables.
(syms_of_ccl): Initialize and staticpro them.
(CCL_ReadMultibyteChar2): Macro name changed from
CCL_ReadMultibyteCharacter.
(CCL_WriteMultibyteChar2): Macro name changed from
CCL_WriteMultibyteChar2.
(CCL_
(MAX_TABLE_SET_LEVEL): New macro.
(tr_stack): New type.
(translate_stack, translate_stack_pointer): New variables.
(PUSH_TRANSLATE_STACK, POP_TRANSLATE_STACK): New macros.
(ccl_driver): Adjusted for the above changes.
(resolve_symbol_ccl_program): New function.
(Fccl_execute): The arg CCL-PROGRAM can be a symbol of CCL
program. If CCL-PRGRAM is a vector, convert symbols in it to ID
numbers by resolve_symbol_ccl_program.
(Fccl_execute_on_string): Likewise.
(Fregister_ccl_program): If the arg CCL-PRGRAM is a vector,
convert symbols in it to ID numbers by resolve_symbol_ccl_program.
author | Kenichi Handa <handa@m17n.org> |
---|---|
date | Wed, 15 Apr 1998 07:12:49 +0000 |
parents | 1b0d88d6fb42 |
children | f239266d104c |
comparison
equal
deleted
inserted
replaced
21550:dddb0d1318aa | 21551:f928f4d89772 |
---|---|
44 Lisp_Object Vccl_translation_table_vector; | 44 Lisp_Object Vccl_translation_table_vector; |
45 | 45 |
46 /* Alist of fontname patterns vs corresponding CCL program. */ | 46 /* Alist of fontname patterns vs corresponding CCL program. */ |
47 Lisp_Object Vfont_ccl_encoder_alist; | 47 Lisp_Object Vfont_ccl_encoder_alist; |
48 | 48 |
49 /* This symbol is property which assocate with ccl program vector. e.g. | 49 /* This symbol is a property which assocates with ccl program vector. |
50 (get 'ccl-big5-encoder 'ccl-program) returns ccl program vector */ | 50 Ex: (get 'ccl-big5-encoder 'ccl-program) returns ccl program vector. */ |
51 Lisp_Object Qccl_program; | 51 Lisp_Object Qccl_program; |
52 | 52 |
53 /* These symbol is properties whish associate with ccl translation table and its id | 53 /* These symbols are properties which associate with ccl translation |
54 respectively. */ | 54 tables and their ID respectively. */ |
55 Lisp_Object Qccl_translation_table; | 55 Lisp_Object Qccl_translation_table; |
56 Lisp_Object Qccl_translation_table_id; | 56 Lisp_Object Qccl_translation_table_id; |
57 | |
58 /* Symbols of ccl program have this property, a value of the property | |
59 is an index for Vccl_protram_table. */ | |
60 Lisp_Object Qccl_program_idx; | |
61 | |
62 /* These symbols are properties which associate with character | |
63 unification tables and their ID respectively. */ | |
64 Lisp_Object Qunification_table; | |
65 Lisp_Object Qunification_table_id; | |
57 | 66 |
58 /* Vector of CCL program names vs corresponding program data. */ | 67 /* Vector of CCL program names vs corresponding program data. */ |
59 Lisp_Object Vccl_program_table; | 68 Lisp_Object Vccl_program_table; |
60 | 69 |
61 /* CCL (Code Conversion Language) is a simple language which has | 70 /* CCL (Code Conversion Language) is a simple language which has |
416 ------------------------------ | 425 ------------------------------ |
417 extended_command (rrr,RRR,Rrr,ARGS) | 426 extended_command (rrr,RRR,Rrr,ARGS) |
418 */ | 427 */ |
419 | 428 |
420 /* | 429 /* |
421 From here, Extended CCL Instruction. | 430 Here after, Extended CCL Instructions. |
422 Bit length of extended command is 14. | 431 Bit length of extended command is 14. |
423 Therefore the instruction code begins from 0 to 16384(0x3fff). | 432 Therefore, the instruction code range is 0..16384(0x3fff). |
424 */ | 433 */ |
425 | 434 |
426 #define CCL_ReadMultibyteCharacter 0x00 /* Read Multibyte Character | 435 /* Read a multibyte characeter. |
427 1:ExtendedCOMMNDRrrRRRrrrXXXXX | 436 A code point is stored into reg[rrr]. A charset ID is stored into |
428 | 437 reg[RRR]. */ |
429 Read a multibyte characeter. | 438 |
430 A code point is stored | 439 #define CCL_ReadMultibyteChar2 0x00 /* Read Multibyte Character |
431 into rrr register. | 440 1:ExtendedCOMMNDRrrRRRrrrXXXXX */ |
432 A charset ID is stored | 441 |
433 into RRR register. | 442 /* Write a multibyte character. |
434 */ | 443 Write a character whose code point is reg[rrr] and the charset ID |
435 #define CCL_WriteMultibyteCharacter 0x01 /* Write Multibyte Character | 444 is reg[RRR]. */ |
436 1:ExtendedCOMMNDRrrRRRrrrXXXXX | 445 |
437 | 446 #define CCL_WriteMultibyteChar2 0x01 /* Write Multibyte Character |
438 Write a multibyte character. | 447 1:ExtendedCOMMNDRrrRRRrrrXXXXX */ |
439 Write a character whose code point | 448 |
440 is in rrr register, and its charset ID | 449 /* Unify a character whose code point is reg[rrr] the charset ID is |
441 is in RRR charset. | 450 reg[RRR] with a unification table whose ID is reg[Rrr]. |
442 */ | 451 |
443 #define CCL_UnifyCharacter 0x02 /* Unify Multibyte Character | 452 A unified character is set in reg[rrr] (code point) and reg[RRR] |
444 1:ExtendedCOMMNDRrrRRRrrrXXXXX | 453 (charset ID). */ |
445 | 454 |
446 Unify a character where its code point | 455 #define CCL_UnifyCharacter 0x02 /* Unify Multibyte Character |
447 is in rrr register, and its charset ID | 456 1:ExtendedCOMMNDRrrRRRrrrXXXXX */ |
448 is in RRR register with the table of | 457 |
449 the unification table ID | 458 /* Unify a character whose code point is reg[rrr] and the charset ID |
450 in Rrr register. | 459 is reg[RRR] with a unification table whose ID is ARGUMENT. |
451 | 460 |
452 Return a unified character where its | 461 A unified character is set in reg[rrr] (code point) and reg[RRR] |
453 code point is in rrr register, and its | 462 (charset ID). */ |
454 charset ID is in RRR register. | 463 |
455 */ | 464 #define CCL_UnifyCharacterConstTbl 0x03 /* Unify Multibyte Character |
456 #define CCL_UnifyCharacterConstTbl 0x03 /* Unify Multibyte Character | 465 1:ExtendedCOMMNDRrrRRRrrrXXXXX |
457 1:ExtendedCOMMNDRrrRRRrrrXXXXX | 466 2:ARGUMENT(Unification Table ID) |
458 2:ARGUMENT(Unification Table ID) | 467 */ |
459 | 468 |
460 Unify a character where its code point | 469 /* Iterate looking up TABLEs for reg[rrr] starting from the Nth (N = |
461 is in rrr register, and its charset ID | 470 reg[RRR]) TABLE until some value is found. |
462 is in RRR register with the table of | 471 |
463 the unification table ID | 472 Each TABLE is a Lisp vector whose element is number, nil, t, or |
464 in 2nd argument. | 473 lambda. |
465 | 474 If the element is nil, ignore the table and proceed to the next table. |
466 Return a unified character where its | 475 If the element is t or lambda, finish without changing reg[rrr]. |
467 code point is in rrr register, and its | 476 If the element is a number, set reg[rrr] to the number and finish. |
468 charset ID is in RRR register. | 477 |
469 */ | 478 Detail of the table structure is descibed in the comment for |
470 #define CCL_IterateMultipleMap 0x10 /* Iterate Multiple Map | 479 CCL_TranslateMultipleMap below. */ |
471 1:ExtendedCOMMNDXXXRRRrrrXXXXX | 480 |
472 2:NUMBER of TABLES | 481 #define CCL_IterateMultipleMap 0x10 /* Iterate Multiple Map |
473 3:TABLE-ID1 | 482 1:ExtendedCOMMNDXXXRRRrrrXXXXX |
474 4:TABLE-ID2 | 483 2:NUMBER of TABLEs |
475 ... | 484 3:TABLE-ID1 |
476 | 485 4:TABLE-ID2 |
477 iterate to lookup tables from a number | 486 ... |
478 until finding a value. | 487 */ |
479 | 488 |
480 Each table consists of a vector | 489 /* Translate code point reg[rrr] by TABLEs starting from the Nth (N = |
481 whose element is number or | 490 reg[RRR]) table. |
482 nil or t or lambda. | 491 |
483 If the element is nil, | 492 TABLEs are suppried in the succeeding CCL codes as follows: |
484 its table is neglected. | 493 |
485 In the case of t or lambda, | 494 When CCL program gives this nested structure of table to this command: |
486 return the original value. | 495 ((TABLE-ID11 |
487 | 496 TABLE-ID12 |
488 */ | 497 (TABLE-ID121 TABLE-ID122 TABLE-ID123) |
489 #define CCL_TranslateMultipleMap 0x11 /* Translate Multiple Map | 498 TABLE-ID13) |
490 1:ExtendedCOMMNDXXXRRRrrrXXXXX | 499 (TABLE-ID21 |
491 2:NUMBER of TABLE-IDs and SEPARATERs | 500 (TABLE-ID211 (TABLE-ID2111) TABLE-ID212) |
492 (i.e. m1+m2+m3+...mk+k-1) | 501 TABLE-ID22)), |
493 3:TABLE-ID 1,1 | 502 the compiled CCL codes has this sequence: |
494 4:TABLE-ID 1,2 | 503 CCL_TranslateMultipleMap (CCL code of this command) |
495 ... | 504 16 (total number of TABLEs and SEPARATERs) |
496 m1+2:TABLE-ID 1,m1 | 505 -7 (1st SEPARATER) |
497 m1+3: -1 (SEPARATOR) | 506 TABLE-ID11 |
498 m1+4:TABLE-ID 2,1 | 507 TABLE-ID12 |
499 ... | 508 -3 (2nd SEPARATER) |
500 m1+m2+4:TABLE-ID 2,m2 | 509 TABLE-ID121 |
501 m1+m2+5: -1 | 510 TABLE-ID122 |
502 ... | 511 TABLE-ID123 |
503 m1+m2+...+mk+k+1:TABLE-ID k,mk | 512 TABLE-ID13 |
504 | 513 -7 (3rd SEPARATER) |
505 Translate the code point in | 514 TABLE-ID21 |
506 rrr register by tables. | 515 -4 (4th SEPARATER) |
507 Translation starts from the table | 516 TABLE-ID211 |
508 where RRR register points out. | 517 -1 (5th SEPARATER) |
509 | 518 TABLE_ID2111 |
510 We translate the given value | 519 TABLE-ID212 |
511 from the tables which are separated | 520 TABLE-ID22 |
512 by -1. | 521 |
513 When each translation is failed to find | 522 A value of each SEPARATER follows this rule: |
514 any values, we regard the traslation | 523 TABLE-SET := SEPARATOR [(TABLE-ID | TABLE-SET)]+ |
515 as identity. | 524 SEPARATOR := -(number of TABLE-IDs and SEPARATORs in the TABLE-SET) |
516 | 525 |
517 We iterate to traslate by using each | 526 (*)....Nest level of TABLE-SET must not be over than MAX_TABLE_SET_LEVEL. |
518 table set(tables separated by -1) | 527 |
519 until lookup the last table except | 528 When some table fails to translate (i.e. it doesn't have a value |
520 lookup lambda. | 529 for reg[rrr]), the translation is treated as identity. |
521 | 530 |
522 Each table consists of a vector | 531 The translation is iterated for all tables in each table set (set |
523 whose element is number | 532 of tables separators by a SEPARATOR) except the case that lambda is |
524 or nil or t or lambda. | 533 encountered (see below). |
525 If the element is nil, | 534 |
526 it is neglected and use the next table. | 535 Each table is a Lisp vector of the following format (a) or (b): |
527 In the case of t, | 536 (a)......[STARTPOINT VAL1 VAL2 ...] |
528 it is translated to the original value. | 537 (b)......[t VAL STARTPOINT ENDPOINT], |
529 In the case of lambda, | 538 where |
530 it cease the translation and return the | 539 STARTPOINT is an offset to be used for indexing a table, |
531 current value. | 540 ENDPOINT is a maxmum index number of a table, |
532 | 541 VAL and VALn is a number, nil, t, or lambda. |
533 */ | 542 |
534 #define CCL_TranslateSingleMap 0x12 /* Translate Single Map | 543 Valid index range of a table of type (a) is: |
535 1:ExtendedCOMMNDXXXRRRrrrXXXXX | 544 STARTPOINT <= index < STARTPOINT + table_size - 1 |
536 2:TABLE-ID | 545 Valid index range of a table of type (b) is: |
537 | 546 STARTPOINT <= index < ENDPOINT |
538 Translate a number in rrr register. | 547 |
539 If it is not found any translation, | 548 If VALn is nil, the table is ignored and translation proceed to the |
540 set RRR register -1 but rrr register | 549 next table. |
541 is not changed. | 550 In VALn is t, reg[rrr] is reverted to the original value and |
542 */ | 551 translation proceed to the next table. |
552 If VALn is lambda, translation in the current TABLE-SET finishes | |
553 and proceed to the upper level TABLE-SET. */ | |
554 | |
555 #define CCL_TranslateMultipleMap 0x11 /* Translate Multiple Map | |
556 1:ExtendedCOMMNDXXXRRRrrrXXXXX | |
557 2:N-2 | |
558 3:SEPARATOR_1 (< 0) | |
559 4:TABLE-ID_1 | |
560 5:TABLE-ID_2 | |
561 ... | |
562 M:SEPARATOR_x (< 0) | |
563 M+1:TABLE-ID_y | |
564 ... | |
565 N:SEPARATOR_z (< 0) | |
566 */ | |
567 | |
568 #define MAX_TABLE_SET_LEVEL 20 | |
569 | |
570 typedef struct | |
571 { | |
572 int rest_length; | |
573 int orig_val; | |
574 } tr_stack; | |
575 | |
576 static tr_stack translate_stack[MAX_TABLE_SET_LEVEL]; | |
577 static tr_stack *translate_stack_pointer; | |
578 | |
579 #define PUSH_TRANSLATE_STACK(restlen, orig) \ | |
580 { \ | |
581 translate_stack_pointer->rest_length = (restlen); \ | |
582 translate_stack_pointer->orig_val = (orig); \ | |
583 translate_stack_pointer++; \ | |
584 } | |
585 | |
586 #define POP_TRANSLATE_STACK(restlen, orig) \ | |
587 { \ | |
588 translate_stack_pointer--; \ | |
589 (restlen) = translate_stack_pointer->rest_length; \ | |
590 (orig) = translate_stack_pointer->orig_val; \ | |
591 } \ | |
592 | |
593 #define CCL_TranslateSingleMap 0x12 /* Translate Single Map | |
594 1:ExtendedCOMMNDXXXRRRrrrXXXXX | |
595 2:TABLE-ID | |
596 ------------------------------ | |
597 Translate reg[rrr] by TABLE-ID. | |
598 If some valid translation is found, | |
599 set reg[rrr] to the result, | |
600 else | |
601 set reg[RRR] to -1. | |
602 */ | |
543 | 603 |
544 /* CCL arithmetic/logical operators. */ | 604 /* CCL arithmetic/logical operators. */ |
545 #define CCL_PLUS 0x00 /* X = Y + Z */ | 605 #define CCL_PLUS 0x00 /* X = Y + Z */ |
546 #define CCL_MINUS 0x01 /* X = Y - Z */ | 606 #define CCL_MINUS 0x01 /* X = Y - Z */ |
547 #define CCL_MUL 0x02 /* X = Y * Z */ | 607 #define CCL_MUL 0x02 /* X = Y * Z */ |
1017 break; | 1077 break; |
1018 | 1078 |
1019 case CCL_Extention: | 1079 case CCL_Extention: |
1020 switch (EXCMD) | 1080 switch (EXCMD) |
1021 { | 1081 { |
1022 case CCL_ReadMultibyteCharacter: | 1082 case CCL_ReadMultibyteChar2: |
1023 if (!src) | 1083 if (!src) |
1024 CCL_INVALID_CMD; | 1084 CCL_INVALID_CMD; |
1025 do { | 1085 do { |
1026 if (src >= src_end) | 1086 if (src >= src_end) |
1027 goto ccl_read_multibyte_character_suspend; | 1087 { |
1088 src++; | |
1089 goto ccl_read_multibyte_character_suspend; | |
1090 } | |
1028 | 1091 |
1029 i = *src++; | 1092 i = *src++; |
1030 if (i == LEADING_CODE_COMPOSITION) | 1093 if (i == LEADING_CODE_COMPOSITION) |
1031 { | 1094 { |
1032 if (src >= src_end) | 1095 if (src >= src_end) |
1084 reg[RRR] = i; | 1147 reg[RRR] = i; |
1085 i = (*src++ & 0x7F); | 1148 i = (*src++ & 0x7F); |
1086 reg[rrr] = ((i << 7) | (*src & 0x7F)); | 1149 reg[rrr] = ((i << 7) | (*src & 0x7F)); |
1087 src++; | 1150 src++; |
1088 } | 1151 } |
1089 else if ((i == LEADING_CODE_PRIVATE_11) || | 1152 else if ((i == LEADING_CODE_PRIVATE_11) |
1090 (i == LEADING_CODE_PRIVATE_12)) | 1153 || (i == LEADING_CODE_PRIVATE_12)) |
1091 { | 1154 { |
1092 if ((src + 1) >= src_end) | 1155 if ((src + 1) >= src_end) |
1093 goto ccl_read_multibyte_character_suspend; | 1156 goto ccl_read_multibyte_character_suspend; |
1094 reg[RRR] = *src++; | 1157 reg[RRR] = *src++; |
1095 reg[rrr] = (*src++ & 0x7F); | 1158 reg[rrr] = (*src++ & 0x7F); |
1096 } | 1159 } |
1097 else if ((i == LEADING_CODE_PRIVATE_21) || | 1160 else if ((i == LEADING_CODE_PRIVATE_21) |
1098 (i == LEADING_CODE_PRIVATE_22)) | 1161 || (i == LEADING_CODE_PRIVATE_22)) |
1099 { | 1162 { |
1100 if ((src + 2) >= src_end) | 1163 if ((src + 2) >= src_end) |
1101 goto ccl_read_multibyte_character_suspend; | 1164 goto ccl_read_multibyte_character_suspend; |
1102 reg[RRR] = *src++; | 1165 reg[RRR] = *src++; |
1103 i = (*src++ & 0x7F); | 1166 i = (*src++ & 0x7F); |
1104 reg[rrr] = ((i << 7) | (*src & 0x7F)); | 1167 reg[rrr] = ((i << 7) | (*src & 0x7F)); |
1105 src++; | 1168 src++; |
1106 } | 1169 } |
1107 else | 1170 else |
1108 { | 1171 { |
1109 /* INVALID CODE | 1172 /* INVALID CODE |
1110 Returned charset is -1.*/ | 1173 Returned charset is -1. */ |
1111 reg[RRR] = -1; | 1174 reg[RRR] = -1; |
1112 } | 1175 } |
1113 } while (0); | 1176 } while (0); |
1114 break; | 1177 break; |
1115 | 1178 |
1123 else | 1186 else |
1124 CCL_SUSPEND (CCL_STAT_SUSPEND_BY_SRC); | 1187 CCL_SUSPEND (CCL_STAT_SUSPEND_BY_SRC); |
1125 | 1188 |
1126 break; | 1189 break; |
1127 | 1190 |
1128 case CCL_WriteMultibyteCharacter: | 1191 case CCL_WriteMultibyteChar2: |
1129 i = reg[RRR]; /* charset */ | 1192 i = reg[RRR]; /* charset */ |
1130 if (i == CHARSET_ASCII) | 1193 if (i == CHARSET_ASCII) |
1131 i = reg[rrr] & 0x7F; | 1194 i = reg[rrr] & 0x7F; |
1132 else if (i == CHARSET_COMPOSITION) | 1195 else if (i == CHARSET_COMPOSITION) |
1133 i = MAKE_COMPOSITE_CHAR (reg[rrr]); | 1196 i = MAKE_COMPOSITE_CHAR (reg[rrr]); |
1216 { | 1279 { |
1217 | 1280 |
1218 size = XVECTOR (Vccl_translation_table_vector)->size; | 1281 size = XVECTOR (Vccl_translation_table_vector)->size; |
1219 point = XINT (ccl_prog[ic++]); | 1282 point = XINT (ccl_prog[ic++]); |
1220 if (point >= size) continue; | 1283 if (point >= size) continue; |
1221 table = XVECTOR (Vccl_translation_table_vector)-> | 1284 table = |
1222 contents[point]; | 1285 XVECTOR (Vccl_translation_table_vector)->contents[point]; |
1286 | |
1287 /* Check table varidity. */ | |
1223 if (!CONSP (table)) continue; | 1288 if (!CONSP (table)) continue; |
1224 table = XCONS(table)->cdr; | 1289 table = XCONS(table)->cdr; |
1225 if (!VECTORP (table)) continue; | 1290 if (!VECTORP (table)) continue; |
1226 size = XVECTOR (table)->size; | 1291 size = XVECTOR (table)->size; |
1227 if (size <= 1) continue; | 1292 if (size <= 1) continue; |
1228 point = XUINT (XVECTOR (table)->contents[0]); | 1293 |
1229 point = op - point + 1; | 1294 content = XVECTOR (table)->contents[0]; |
1230 if (!((point >= 1) && (point < size))) continue; | 1295 |
1231 content = XVECTOR (table)->contents[point]; | 1296 /* check table type, |
1297 [STARTPOINT VAL1 VAL2 ...] or | |
1298 [t ELELMENT STARTPOINT ENDPOINT] */ | |
1299 if (NUMBERP (content)) | |
1300 { | |
1301 point = XUINT (content); | |
1302 point = op - point + 1; | |
1303 if (!((point >= 1) && (point < size))) continue; | |
1304 content = XVECTOR (table)->contents[point]; | |
1305 } | |
1306 else if (EQ (content, Qt)) | |
1307 { | |
1308 if (size != 4) continue; | |
1309 if ((op >= XUINT (XVECTOR (table)->contents[2])) | |
1310 && (op < XUINT (XVECTOR (table)->contents[3]))) | |
1311 content = XVECTOR (table)->contents[1]; | |
1312 else | |
1313 continue; | |
1314 } | |
1315 else | |
1316 continue; | |
1232 | 1317 |
1233 if (NILP (content)) | 1318 if (NILP (content)) |
1234 continue; | 1319 continue; |
1235 else if (NUMBERP (content)) | 1320 else if (NUMBERP (content)) |
1236 { | 1321 { |
1237 reg[RRR] = i; | 1322 reg[RRR] = i; |
1238 reg[rrr] = XUINT(content); | 1323 reg[rrr] = XINT(content); |
1239 break; | 1324 break; |
1240 } | 1325 } |
1241 else if (EQ (content, Qt) || EQ (content, Qlambda)) | 1326 else if (EQ (content, Qt) || EQ (content, Qlambda)) |
1242 { | 1327 { |
1243 reg[RRR] = i; | 1328 reg[RRR] = i; |
1248 attrib = XCONS (content)->car; | 1333 attrib = XCONS (content)->car; |
1249 value = XCONS (content)->cdr; | 1334 value = XCONS (content)->cdr; |
1250 if (!NUMBERP (attrib) || !NUMBERP (value)) | 1335 if (!NUMBERP (attrib) || !NUMBERP (value)) |
1251 continue; | 1336 continue; |
1252 reg[RRR] = i; | 1337 reg[RRR] = i; |
1253 reg[rrr] = XUINT(value); | 1338 reg[rrr] = XUINT (value); |
1254 break; | 1339 break; |
1255 } | 1340 } |
1256 } | 1341 } |
1257 if (i == j) | 1342 if (i == j) |
1258 reg[RRR] = -1; | 1343 reg[RRR] = -1; |
1262 | 1347 |
1263 case CCL_TranslateMultipleMap: | 1348 case CCL_TranslateMultipleMap: |
1264 { | 1349 { |
1265 Lisp_Object table, content, attrib, value; | 1350 Lisp_Object table, content, attrib, value; |
1266 int point, size, table_vector_size; | 1351 int point, size, table_vector_size; |
1267 int skip_to_next, fin_ic; | 1352 int table_set_rest_length, fin_ic; |
1268 | 1353 |
1269 j = XINT (ccl_prog[ic++]); /* number of tables and separators. */ | 1354 table_set_rest_length = |
1270 fin_ic = ic + j; | 1355 XINT (ccl_prog[ic++]); /* number of tables and separators. */ |
1271 if ((j > reg[RRR]) && (j >= 0)) | 1356 fin_ic = ic + table_set_rest_length; |
1357 if ((table_set_rest_length > reg[RRR]) && (reg[RRR] >= 0)) | |
1272 { | 1358 { |
1273 ic += reg[RRR]; | 1359 ic += reg[RRR]; |
1274 i = reg[RRR]; | 1360 i = reg[RRR]; |
1361 table_set_rest_length -= i; | |
1275 } | 1362 } |
1276 else | 1363 else |
1277 { | 1364 { |
1278 ic = fin_ic; | 1365 ic = fin_ic; |
1279 reg[RRR] = -1; | 1366 reg[RRR] = -1; |
1280 break; | 1367 break; |
1281 } | 1368 } |
1369 translate_stack_pointer = translate_stack; | |
1282 op = reg[rrr]; | 1370 op = reg[rrr]; |
1371 PUSH_TRANSLATE_STACK (0, op); | |
1283 reg[RRR] = -1; | 1372 reg[RRR] = -1; |
1284 skip_to_next = 0; | 1373 table_vector_size |
1285 table_vector_size = XVECTOR (Vccl_translation_table_vector)->size; | 1374 = XVECTOR (Vccl_translation_table_vector)->size; |
1286 for (;i < j;i++) | 1375 for (;table_set_rest_length > 0;i++, table_set_rest_length--) |
1287 { | 1376 { |
1288 point = XINT (ccl_prog[ic++]); | 1377 point = XINT(ccl_prog[ic++]); |
1289 if (point == -1) | 1378 if (point < 0) |
1290 { | 1379 { |
1291 skip_to_next = 0; | 1380 point = -point; |
1381 if (translate_stack_pointer | |
1382 >= &translate_stack[MAX_TABLE_SET_LEVEL]) | |
1383 { | |
1384 CCL_INVALID_CMD; | |
1385 } | |
1386 PUSH_TRANSLATE_STACK (table_set_rest_length - point, | |
1387 reg[rrr]); | |
1388 table_set_rest_length = point + 1; | |
1389 reg[rrr] = op; | |
1292 continue; | 1390 continue; |
1293 } | 1391 } |
1294 if (skip_to_next) continue; | 1392 |
1295 if (point >= table_vector_size) continue; | 1393 if (point >= table_vector_size) continue; |
1296 table = XVECTOR (Vccl_translation_table_vector)-> | 1394 table = |
1297 contents[point]; | 1395 XVECTOR (Vccl_translation_table_vector)->contents[point]; |
1396 | |
1397 /* Check table varidity. */ | |
1298 if (!CONSP (table)) continue; | 1398 if (!CONSP (table)) continue; |
1299 table = XCONS (table)->cdr; | 1399 table = XCONS (table)->cdr; |
1300 if (!VECTORP (table)) continue; | 1400 if (!VECTORP (table)) continue; |
1301 size = XVECTOR (table)->size; | 1401 size = XVECTOR (table)->size; |
1302 if (size <= 1) continue; | 1402 if (size <= 1) continue; |
1303 point = XUINT (XVECTOR (table)->contents[0]); | 1403 |
1304 point = op - point + 1; | 1404 content = XVECTOR (table)->contents[0]; |
1305 if (!((point >= 1) && (point < size))) continue; | 1405 |
1306 content = XVECTOR (table)->contents[point]; | 1406 /* check table type, |
1407 [STARTPOINT VAL1 VAL2 ...] or | |
1408 [t ELEMENT STARTPOINT ENDPOINT] */ | |
1409 if (NUMBERP (content)) | |
1410 { | |
1411 point = XUINT (content); | |
1412 point = op - point + 1; | |
1413 if (!((point >= 1) && (point < size))) continue; | |
1414 content = XVECTOR (table)->contents[point]; | |
1415 } | |
1416 else if (EQ (content, Qt)) | |
1417 { | |
1418 if (size != 4) continue; | |
1419 if ((op >= XUINT (XVECTOR (table)->contents[2])) && | |
1420 (op < XUINT (XVECTOR (table)->contents[3]))) | |
1421 content = XVECTOR (table)->contents[1]; | |
1422 else | |
1423 continue; | |
1424 } | |
1425 else | |
1426 continue; | |
1307 | 1427 |
1308 if (NILP (content)) | 1428 if (NILP (content)) |
1309 continue; | 1429 continue; |
1310 else if (NUMBERP (content)) | 1430 else if (NUMBERP (content)) |
1311 { | 1431 { |
1312 op = XUINT (content); | 1432 op = XINT (content); |
1313 reg[RRR] = i; | 1433 reg[RRR] = i; |
1314 skip_to_next = 1; | 1434 i += table_set_rest_length; |
1435 POP_TRANSLATE_STACK (table_set_rest_length, reg[rrr]); | |
1315 } | 1436 } |
1316 else if (CONSP (content)) | 1437 else if (CONSP (content)) |
1317 { | 1438 { |
1318 attrib = XCONS (content)->car; | 1439 attrib = XCONS (content)->car; |
1319 value = XCONS (content)->cdr; | 1440 value = XCONS (content)->cdr; |
1320 if (!NUMBERP (attrib) || !NUMBERP (value)) | 1441 if (!NUMBERP (attrib) || !NUMBERP (value)) |
1321 continue; | 1442 continue; |
1322 reg[RRR] = i; | 1443 reg[RRR] = i; |
1323 op = XUINT (value); | 1444 op = XUINT (value); |
1324 | 1445 i += table_set_rest_length; |
1446 POP_TRANSLATE_STACK (table_set_rest_length, reg[rrr]); | |
1325 } | 1447 } |
1326 else if (EQ (content, Qt)) | 1448 else if (EQ (content, Qt)) |
1327 { | 1449 { |
1328 reg[RRR] = i; | 1450 reg[RRR] = i; |
1329 op = reg[rrr]; | 1451 op = reg[rrr]; |
1330 skip_to_next = 1; | 1452 i += table_set_rest_length; |
1453 POP_TRANSLATE_STACK (table_set_rest_length, reg[rrr]); | |
1331 } | 1454 } |
1332 else if (EQ (content, Qlambda)) | 1455 else if (EQ (content, Qlambda)) |
1333 break; | 1456 { |
1457 break; | |
1458 } | |
1459 else | |
1460 CCL_INVALID_CMD; | |
1334 } | 1461 } |
1335 ic = fin_ic; | 1462 ic = fin_ic; |
1336 } | 1463 } |
1337 reg[rrr] = op; | 1464 reg[rrr] = op; |
1338 break; | 1465 break; |
1346 if (j >= XVECTOR (Vccl_translation_table_vector)->size) | 1473 if (j >= XVECTOR (Vccl_translation_table_vector)->size) |
1347 { | 1474 { |
1348 reg[RRR] = -1; | 1475 reg[RRR] = -1; |
1349 break; | 1476 break; |
1350 } | 1477 } |
1351 table = XVECTOR (Vccl_translation_table_vector)-> | 1478 table = XVECTOR (Vccl_translation_table_vector)->contents[j]; |
1352 contents[j]; | |
1353 if (!CONSP (table)) | 1479 if (!CONSP (table)) |
1354 { | 1480 { |
1355 reg[RRR] = -1; | 1481 reg[RRR] = -1; |
1356 break; | 1482 break; |
1357 } | 1483 } |
1372 { | 1498 { |
1373 content = XVECTOR (table)->contents[point]; | 1499 content = XVECTOR (table)->contents[point]; |
1374 if (NILP (content)) | 1500 if (NILP (content)) |
1375 reg[RRR] = -1; | 1501 reg[RRR] = -1; |
1376 else if (NUMBERP (content)) | 1502 else if (NUMBERP (content)) |
1377 reg[rrr] = XUINT (content); | 1503 reg[rrr] = XINT (content); |
1378 else if (EQ (content, Qt)) | 1504 else if (EQ (content, Qt)) |
1379 reg[RRR] = i; | 1505 reg[RRR] = i; |
1380 else if (CONSP (content)) | 1506 else if (CONSP (content)) |
1381 { | 1507 { |
1382 attrib = XCONS (content)->car; | 1508 attrib = XCONS (content)->car; |
1420 { | 1546 { |
1421 int i = ccl_backtrace_idx - 1; | 1547 int i = ccl_backtrace_idx - 1; |
1422 int j; | 1548 int j; |
1423 | 1549 |
1424 msglen = strlen (msg); | 1550 msglen = strlen (msg); |
1425 if (dst + msglen <= (dst_bytes ? dst_end : src)) | 1551 if (dst + msglen <= dst_end) |
1426 { | 1552 { |
1427 bcopy (msg, dst, msglen); | 1553 bcopy (msg, dst, msglen); |
1428 dst += msglen; | 1554 dst += msglen; |
1429 } | 1555 } |
1430 | 1556 |
1433 if (i < 0) i = CCL_DEBUG_BACKTRACE_LEN - 1; | 1559 if (i < 0) i = CCL_DEBUG_BACKTRACE_LEN - 1; |
1434 if (ccl_backtrace_table[i] == 0) | 1560 if (ccl_backtrace_table[i] == 0) |
1435 break; | 1561 break; |
1436 sprintf(msg, " %d", ccl_backtrace_table[i]); | 1562 sprintf(msg, " %d", ccl_backtrace_table[i]); |
1437 msglen = strlen (msg); | 1563 msglen = strlen (msg); |
1438 if (dst + msglen > (dst_bytes ? dst_end : src)) | 1564 if (dst + msglen > dst_end) |
1439 break; | 1565 break; |
1440 bcopy (msg, dst, msglen); | 1566 bcopy (msg, dst, msglen); |
1441 dst += msglen; | 1567 dst += msglen; |
1442 } | 1568 } |
1443 } | 1569 } |
1451 default: | 1577 default: |
1452 sprintf(msg, "\nCCL: Unknown error type (%d).", ccl->status); | 1578 sprintf(msg, "\nCCL: Unknown error type (%d).", ccl->status); |
1453 } | 1579 } |
1454 | 1580 |
1455 msglen = strlen (msg); | 1581 msglen = strlen (msg); |
1456 if (dst + msglen <= (dst_bytes ? dst_end : src)) | 1582 if (dst + msglen <= dst_end) |
1457 { | 1583 { |
1458 bcopy (msg, dst, msglen); | 1584 bcopy (msg, dst, msglen); |
1459 dst += msglen; | 1585 dst += msglen; |
1460 } | 1586 } |
1461 } | 1587 } |
1485 ccl->last_block = 0; | 1611 ccl->last_block = 0; |
1486 ccl->private_state = 0; | 1612 ccl->private_state = 0; |
1487 ccl->status = 0; | 1613 ccl->status = 0; |
1488 } | 1614 } |
1489 | 1615 |
1616 /* Resolve symbols in the specified CCL code (Lisp vector). This | |
1617 function converts translation-table and unification-table symbols | |
1618 embeded in the CCL code into their ID numbers. */ | |
1619 | |
1620 Lisp_Object | |
1621 resolve_symbol_ccl_program (ccl) | |
1622 Lisp_Object ccl; | |
1623 { | |
1624 int i, veclen; | |
1625 Lisp_Object result, contents, prop; | |
1626 | |
1627 result = ccl; | |
1628 veclen = XVECTOR (result)->size; | |
1629 | |
1630 /* Set CCL program's table ID */ | |
1631 for (i = 0; i < veclen; i++) | |
1632 { | |
1633 contents = XVECTOR (result)->contents[i]; | |
1634 if (SYMBOLP (contents)) | |
1635 { | |
1636 if (EQ(result, ccl)) | |
1637 result = Fcopy_sequence (ccl); | |
1638 | |
1639 prop = Fget (contents, Qunification_table_id); | |
1640 if (NUMBERP (prop)) | |
1641 { | |
1642 XVECTOR (result)->contents[i] = prop; | |
1643 continue; | |
1644 } | |
1645 prop = Fget (contents, Qccl_translation_table_id); | |
1646 if (NUMBERP (prop)) | |
1647 { | |
1648 XVECTOR (result)->contents[i] = prop; | |
1649 continue; | |
1650 } | |
1651 prop = Fget (contents, Qccl_program_idx); | |
1652 if (NUMBERP (prop)) | |
1653 { | |
1654 XVECTOR (result)->contents[i] = prop; | |
1655 continue; | |
1656 } | |
1657 } | |
1658 } | |
1659 | |
1660 return result; | |
1661 } | |
1662 | |
1663 | |
1490 #ifdef emacs | 1664 #ifdef emacs |
1491 | 1665 |
1492 DEFUN ("ccl-execute", Fccl_execute, Sccl_execute, 2, 2, 0, | 1666 DEFUN ("ccl-execute", Fccl_execute, Sccl_execute, 2, 2, 0, |
1493 "Execute CCL-PROGRAM with registers initialized by REGISTERS.\n\ | 1667 "Execute CCL-PROGRAM with registers initialized by REGISTERS.\n\ |
1494 CCL-PROGRAM is a compiled code generated by `ccl-compile',\n\ | 1668 \n\ |
1495 no I/O commands should appear in the CCL program.\n\ | 1669 CCL-PROGRAM is a symbol registered by register-ccl-program,\n\ |
1670 or a compiled code generated by `ccl-compile' (for backward compatibility,\n\ | |
1671 in this case, the execution is slower).\n\ | |
1672 No I/O commands should appear in CCL-PROGRAM.\n\ | |
1673 \n\ | |
1496 REGISTERS is a vector of [R0 R1 ... R7] where RN is an initial value\n\ | 1674 REGISTERS is a vector of [R0 R1 ... R7] where RN is an initial value\n\ |
1497 of Nth register.\n\ | 1675 of Nth register.\n\ |
1498 As side effect, each element of REGISTER holds the value of\n\ | 1676 \n\ |
1677 As side effect, each element of REGISTERS holds the value of\n\ | |
1499 corresponding register after the execution.") | 1678 corresponding register after the execution.") |
1500 (ccl_prog, reg) | 1679 (ccl_prog, reg) |
1501 Lisp_Object ccl_prog, reg; | 1680 Lisp_Object ccl_prog, reg; |
1502 { | 1681 { |
1503 struct ccl_program ccl; | 1682 struct ccl_program ccl; |
1504 int i; | 1683 int i; |
1505 | 1684 Lisp_Object ccl_id; |
1506 CHECK_VECTOR (ccl_prog, 0); | 1685 |
1507 CHECK_VECTOR (reg, 1); | 1686 if ((SYMBOLP (ccl_prog)) && |
1687 (!NILP (ccl_id = Fget (ccl_prog, Qccl_program_idx)))) | |
1688 { | |
1689 ccl_prog = XVECTOR (Vccl_program_table)->contents[XUINT (ccl_id)]; | |
1690 CHECK_LIST (ccl_prog, 0); | |
1691 ccl_prog = XCONS (ccl_prog)->cdr; | |
1692 CHECK_VECTOR (ccl_prog, 1); | |
1693 } | |
1694 else | |
1695 { | |
1696 CHECK_VECTOR (ccl_prog, 1); | |
1697 ccl_prog = resolve_symbol_ccl_program (ccl_prog); | |
1698 } | |
1699 | |
1700 CHECK_VECTOR (reg, 2); | |
1508 if (XVECTOR (reg)->size != 8) | 1701 if (XVECTOR (reg)->size != 8) |
1509 error ("Invalid length of vector REGISTERS"); | 1702 error ("Invalid length of vector REGISTERS"); |
1510 | 1703 |
1511 setup_ccl_program (&ccl, ccl_prog); | 1704 setup_ccl_program (&ccl, ccl_prog); |
1512 for (i = 0; i < 8; i++) | 1705 for (i = 0; i < 8; i++) |
1525 } | 1718 } |
1526 | 1719 |
1527 DEFUN ("ccl-execute-on-string", Fccl_execute_on_string, Sccl_execute_on_string, | 1720 DEFUN ("ccl-execute-on-string", Fccl_execute_on_string, Sccl_execute_on_string, |
1528 3, 5, 0, | 1721 3, 5, 0, |
1529 "Execute CCL-PROGRAM with initial STATUS on STRING.\n\ | 1722 "Execute CCL-PROGRAM with initial STATUS on STRING.\n\ |
1530 CCL-PROGRAM is a compiled code generated by `ccl-compile'.\n\ | 1723 \n\ |
1724 CCL-PROGRAM is a symbol registered by register-ccl-program,\n\ | |
1725 or a compiled code generated by `ccl-compile' (for backward compatibility,\n\ | |
1726 in this case, the execution is slower).\n\ | |
1727 \n\ | |
1531 Read buffer is set to STRING, and write buffer is allocated automatically.\n\ | 1728 Read buffer is set to STRING, and write buffer is allocated automatically.\n\ |
1729 \n\ | |
1532 STATUS is a vector of [R0 R1 ... R7 IC], where\n\ | 1730 STATUS is a vector of [R0 R1 ... R7 IC], where\n\ |
1533 R0..R7 are initial values of corresponding registers,\n\ | 1731 R0..R7 are initial values of corresponding registers,\n\ |
1534 IC is the instruction counter specifying from where to start the program.\n\ | 1732 IC is the instruction counter specifying from where to start the program.\n\ |
1535 If R0..R7 are nil, they are initialized to 0.\n\ | 1733 If R0..R7 are nil, they are initialized to 0.\n\ |
1536 If IC is nil, it is initialized to head of the CCL program.\n\ | 1734 If IC is nil, it is initialized to head of the CCL program.\n\ |
1537 \n\ | 1735 \n\ |
1538 If optional 4th arg CONTIN is non-nil, keep IC on read operation\n\ | 1736 If optional 4th arg CONTINUE is non-nil, keep IC on read operation\n\ |
1539 when read buffer is exausted, else, IC is always set to the end of\n\ | 1737 when read buffer is exausted, else, IC is always set to the end of\n\ |
1540 CCL-PROGRAM on exit.\n\ | 1738 CCL-PROGRAM on exit. |
1541 \n\ | 1739 \n\ |
1542 It returns the contents of write buffer as a string,\n\ | 1740 It returns the contents of write buffer as a string,\n\ |
1543 and as side effect, STATUS is updated.\n\ | 1741 and as side effect, STATUS is updated.\n\ |
1544 If the optional 5th arg UNIBYTE-P is non-nil, the returned string\n\ | 1742 If the optional 5th arg UNIBYTE-P is non-nil, the returned string\n\ |
1545 is a unibyte string. By default it is a multibyte string.") | 1743 is a unibyte string. By default it is a multibyte string.") |
1546 (ccl_prog, status, str, contin, unibyte_p) | 1744 (ccl_prog, status, str, contin, unibyte_p) |
1547 Lisp_Object ccl_prog, status, str, contin, unibyte_p; | 1745 Lisp_Object ccl_prog, status, str, contin, unibyte_p; |
1548 { | 1746 { |
1550 struct ccl_program ccl; | 1748 struct ccl_program ccl; |
1551 int i, produced; | 1749 int i, produced; |
1552 int outbufsize; | 1750 int outbufsize; |
1553 char *outbuf; | 1751 char *outbuf; |
1554 struct gcpro gcpro1, gcpro2, gcpro3; | 1752 struct gcpro gcpro1, gcpro2, gcpro3; |
1555 | 1753 Lisp_Object ccl_id; |
1556 CHECK_VECTOR (ccl_prog, 0); | 1754 |
1755 if ((SYMBOLP (ccl_prog)) && | |
1756 (!NILP (ccl_id = Fget (ccl_prog, Qccl_program_idx)))) | |
1757 { | |
1758 ccl_prog = XVECTOR (Vccl_program_table)->contents[XUINT (ccl_id)]; | |
1759 CHECK_LIST (ccl_prog, 0); | |
1760 ccl_prog = XCONS (ccl_prog)->cdr; | |
1761 CHECK_VECTOR (ccl_prog, 1); | |
1762 } | |
1763 else | |
1764 { | |
1765 CHECK_VECTOR (ccl_prog, 1); | |
1766 ccl_prog = resolve_symbol_ccl_program (ccl_prog); | |
1767 } | |
1768 | |
1557 CHECK_VECTOR (status, 1); | 1769 CHECK_VECTOR (status, 1); |
1558 if (XVECTOR (status)->size != 9) | 1770 if (XVECTOR (status)->size != 9) |
1559 error ("Invalid length of vector STATUS"); | 1771 error ("Invalid length of vector STATUS"); |
1560 CHECK_STRING (str, 2); | 1772 CHECK_STRING (str, 2); |
1561 GCPRO3 (ccl_prog, status, str); | 1773 GCPRO3 (ccl_prog, status, str); |
1611 int len = XVECTOR (Vccl_program_table)->size; | 1823 int len = XVECTOR (Vccl_program_table)->size; |
1612 int i; | 1824 int i; |
1613 | 1825 |
1614 CHECK_SYMBOL (name, 0); | 1826 CHECK_SYMBOL (name, 0); |
1615 if (!NILP (ccl_prog)) | 1827 if (!NILP (ccl_prog)) |
1616 CHECK_VECTOR (ccl_prog, 1); | 1828 { |
1829 CHECK_VECTOR (ccl_prog, 1); | |
1830 ccl_prog = resolve_symbol_ccl_program (ccl_prog); | |
1831 } | |
1617 | 1832 |
1618 for (i = 0; i < len; i++) | 1833 for (i = 0; i < len; i++) |
1619 { | 1834 { |
1620 Lisp_Object slot = XVECTOR (Vccl_program_table)->contents[i]; | 1835 Lisp_Object slot = XVECTOR (Vccl_program_table)->contents[i]; |
1621 | 1836 |
1709 syms_of_ccl () | 1924 syms_of_ccl () |
1710 { | 1925 { |
1711 staticpro (&Vccl_program_table); | 1926 staticpro (&Vccl_program_table); |
1712 Vccl_program_table = Fmake_vector (make_number (32), Qnil); | 1927 Vccl_program_table = Fmake_vector (make_number (32), Qnil); |
1713 | 1928 |
1714 Qccl_program = intern("ccl-program"); | 1929 Qccl_program = intern ("ccl-program"); |
1715 staticpro(&Qccl_program); | 1930 staticpro (&Qccl_program); |
1931 | |
1932 Qccl_program_idx = intern ("ccl-program-idx"); | |
1933 staticpro (&Qccl_program_idx); | |
1716 | 1934 |
1717 Qccl_translation_table = intern ("ccl-translation-table"); | 1935 Qccl_translation_table = intern ("ccl-translation-table"); |
1718 staticpro (&Qccl_translation_table); | 1936 staticpro (&Qccl_translation_table); |
1719 | 1937 |
1720 Qccl_translation_table_id = intern ("ccl-translation-table-id"); | 1938 Qccl_translation_table_id = intern ("ccl-translation-table-id"); |
1721 staticpro (&Qccl_translation_table_id); | 1939 staticpro (&Qccl_translation_table_id); |
1940 | |
1941 Qunification_table = intern ("unification-table"); | |
1942 staticpro (&Qunification_table); | |
1943 | |
1944 Qunification_table_id = intern ("unification-table-id"); | |
1945 staticpro (&Qunification_table_id); | |
1722 | 1946 |
1723 DEFVAR_LISP ("ccl-translation-table-vector", &Vccl_translation_table_vector, | 1947 DEFVAR_LISP ("ccl-translation-table-vector", &Vccl_translation_table_vector, |
1724 "Where is stored translation tables for CCL program.\n\ | 1948 "Where is stored translation tables for CCL program.\n\ |
1725 Because CCL program can't access these tables except by the index of the vector."); | 1949 Because CCL program can't access these tables except by the index of the vector."); |
1726 Vccl_translation_table_vector = Fmake_vector (make_number (16), Qnil); | 1950 Vccl_translation_table_vector = Fmake_vector (make_number (16), Qnil); |