1 |
/* CCL (Code Conversion Language) interpreter. |
/* CCL (Code Conversion Language) interpreter. |
2 |
Copyright (C) 1995, 1997 Electrotechnical Laboratory, JAPAN. |
Copyright (C) 1995, 1997 Electrotechnical Laboratory, JAPAN. |
3 |
Copyright (C) 2001 Free Software Foundation, Inc. |
Copyright (C) 2001, 2002 Free Software Foundation, Inc. |
4 |
Licensed to the Free Software Foundation. |
Licensed to the Free Software Foundation. |
5 |
|
|
6 |
This file is part of GNU Emacs. |
This file is part of GNU Emacs. |
20 |
the Free Software Foundation, Inc., 59 Temple Place - Suite 330, |
the Free Software Foundation, Inc., 59 Temple Place - Suite 330, |
21 |
Boston, MA 02111-1307, USA. */ |
Boston, MA 02111-1307, USA. */ |
22 |
|
|
|
#ifdef emacs |
|
23 |
#include <config.h> |
#include <config.h> |
|
#endif |
|
24 |
|
|
25 |
#include <stdio.h> |
#include <stdio.h> |
26 |
|
|
|
#ifdef emacs |
|
|
|
|
27 |
#include "lisp.h" |
#include "lisp.h" |
28 |
#include "charset.h" |
#include "charset.h" |
29 |
#include "ccl.h" |
#include "ccl.h" |
30 |
#include "coding.h" |
#include "coding.h" |
31 |
|
|
|
#else /* not emacs */ |
|
|
|
|
|
#include "mulelib.h" |
|
|
|
|
|
#endif /* not emacs */ |
|
|
|
|
32 |
/* This contains all code conversion map available to CCL. */ |
/* This contains all code conversion map available to CCL. */ |
33 |
Lisp_Object Vcode_conversion_map_vector; |
Lisp_Object Vcode_conversion_map_vector; |
34 |
|
|
55 |
already resolved to index numbers or not. */ |
already resolved to index numbers or not. */ |
56 |
Lisp_Object Vccl_program_table; |
Lisp_Object Vccl_program_table; |
57 |
|
|
58 |
|
/* Vector of registered hash tables for translation. */ |
59 |
|
Lisp_Object Vtranslation_hash_table_vector; |
60 |
|
|
61 |
|
/* Return a hash table of id number ID. */ |
62 |
|
#define GET_HASH_TABLE(id) \ |
63 |
|
(XHASH_TABLE (XCDR(XVECTOR(Vtranslation_hash_table_vector)->contents[(id)]))) |
64 |
|
|
65 |
/* CCL (Code Conversion Language) is a simple language which has |
/* CCL (Code Conversion Language) is a simple language which has |
66 |
operations on one input buffer, one output buffer, and 7 registers. |
operations on one input buffer, one output buffer, and 7 registers. |
67 |
The syntax of CCL is described in `ccl.el'. Emacs Lisp function |
The syntax of CCL is described in `ccl.el'. Emacs Lisp function |
426 |
extended_command (rrr,RRR,Rrr,ARGS) |
extended_command (rrr,RRR,Rrr,ARGS) |
427 |
*/ |
*/ |
428 |
|
|
429 |
/* |
/* |
430 |
Here after, Extended CCL Instructions. |
Here after, Extended CCL Instructions. |
431 |
Bit length of extended command is 14. |
Bit length of extended command is 14. |
432 |
Therefore, the instruction code range is 0..16384(0x3fff). |
Therefore, the instruction code range is 0..16384(0x3fff). |
484 |
3:MAP-ID1 |
3:MAP-ID1 |
485 |
4:MAP-ID2 |
4:MAP-ID2 |
486 |
... |
... |
487 |
*/ |
*/ |
488 |
|
|
489 |
/* Map the code in reg[rrr] by MAPs starting from the Nth (N = |
/* Map the code in reg[rrr] by MAPs starting from the Nth (N = |
490 |
reg[RRR]) map. |
reg[RRR]) map. |
562 |
where |
where |
563 |
STARTPOINT is an offset to be used for indexing a map, |
STARTPOINT is an offset to be used for indexing a map, |
564 |
ENDPOINT is a maximum index number of a map, |
ENDPOINT is a maximum index number of a map, |
565 |
VAL and VALn is a number, nil, t, or lambda. |
VAL and VALn is a number, nil, t, or lambda. |
566 |
|
|
567 |
Valid index range of a map of type (a) is: |
Valid index range of a map of type (a) is: |
568 |
STARTPOINT <= index < STARTPOINT + map_size - 1 |
STARTPOINT <= index < STARTPOINT + map_size - 1 |
649 |
set reg[RRR] to -1. |
set reg[RRR] to -1. |
650 |
*/ |
*/ |
651 |
|
|
652 |
|
#define CCL_LookupIntConstTbl 0x13 /* Lookup multibyte character by |
653 |
|
integer key. Afterwards R7 set |
654 |
|
to 1 iff lookup succeeded. |
655 |
|
1:ExtendedCOMMNDRrrRRRXXXXXXXX |
656 |
|
2:ARGUMENT(Hash table ID) */ |
657 |
|
|
658 |
|
#define CCL_LookupCharConstTbl 0x14 /* Lookup integer by multibyte |
659 |
|
character key. Afterwards R7 set |
660 |
|
to 1 iff lookup succeeded. |
661 |
|
1:ExtendedCOMMNDRrrRRRrrrXXXXX |
662 |
|
2:ARGUMENT(Hash table ID) */ |
663 |
|
|
664 |
/* CCL arithmetic/logical operators. */ |
/* CCL arithmetic/logical operators. */ |
665 |
#define CCL_PLUS 0x00 /* X = Y + Z */ |
#define CCL_PLUS 0x00 /* X = Y + Z */ |
666 |
#define CCL_MINUS 0x01 /* X = Y - Z */ |
#define CCL_MINUS 0x01 /* X = Y - Z */ |
852 |
|
|
853 |
#ifdef CCL_DEBUG |
#ifdef CCL_DEBUG |
854 |
#define CCL_DEBUG_BACKTRACE_LEN 256 |
#define CCL_DEBUG_BACKTRACE_LEN 256 |
855 |
int ccl_backtrace_table[CCL_BACKTRACE_TABLE]; |
int ccl_backtrace_table[CCL_DEBUG_BACKTRACE_LEN]; |
856 |
int ccl_backtrace_idx; |
int ccl_backtrace_idx; |
857 |
#endif |
#endif |
858 |
|
|
862 |
int ic; /* Instruction Counter. */ |
int ic; /* Instruction Counter. */ |
863 |
}; |
}; |
864 |
|
|
865 |
/* For the moment, we only support depth 256 of stack. */ |
/* For the moment, we only support depth 256 of stack. */ |
866 |
static struct ccl_prog_stack ccl_prog_stack_struct[256]; |
static struct ccl_prog_stack ccl_prog_stack_struct[256]; |
867 |
|
|
868 |
int |
int |
1096 |
} |
} |
1097 |
CCL_INVALID_CMD; |
CCL_INVALID_CMD; |
1098 |
} |
} |
1099 |
|
|
1100 |
ccl_prog_stack_struct[stack_idx].ccl_prog = ccl_prog; |
ccl_prog_stack_struct[stack_idx].ccl_prog = ccl_prog; |
1101 |
ccl_prog_stack_struct[stack_idx].ic = ic; |
ccl_prog_stack_struct[stack_idx].ic = ic; |
1102 |
stack_idx++; |
stack_idx++; |
1260 |
src++; |
src++; |
1261 |
goto ccl_read_multibyte_character_suspend; |
goto ccl_read_multibyte_character_suspend; |
1262 |
} |
} |
1263 |
|
|
1264 |
if (!ccl->multibyte) |
if (!ccl->multibyte) |
1265 |
{ |
{ |
1266 |
int bytes; |
int bytes; |
1274 |
i = *src++; |
i = *src++; |
1275 |
if (i == '\n' && ccl->eol_type != CODING_EOL_LF) |
if (i == '\n' && ccl->eol_type != CODING_EOL_LF) |
1276 |
{ |
{ |
1277 |
/* We are encoding. */ |
/* We are encoding. */ |
1278 |
if (ccl->eol_type == CODING_EOL_CRLF) |
if (ccl->eol_type == CODING_EOL_CRLF) |
1279 |
{ |
{ |
1280 |
if (ccl->cr_consumed) |
if (ccl->cr_consumed) |
1399 |
SPLIT_CHAR (op, reg[RRR], i, j); |
SPLIT_CHAR (op, reg[RRR], i, j); |
1400 |
if (j != -1) |
if (j != -1) |
1401 |
i = (i << 7) | j; |
i = (i << 7) | j; |
1402 |
|
|
1403 |
reg[rrr] = i; |
reg[rrr] = i; |
1404 |
break; |
break; |
1405 |
|
|
1411 |
SPLIT_CHAR (op, reg[RRR], i, j); |
SPLIT_CHAR (op, reg[RRR], i, j); |
1412 |
if (j != -1) |
if (j != -1) |
1413 |
i = (i << 7) | j; |
i = (i << 7) | j; |
1414 |
|
|
1415 |
reg[rrr] = i; |
reg[rrr] = i; |
1416 |
break; |
break; |
1417 |
|
|
1418 |
|
case CCL_LookupIntConstTbl: |
1419 |
|
op = XINT (ccl_prog[ic]); /* table */ |
1420 |
|
ic++; |
1421 |
|
{ |
1422 |
|
struct Lisp_Hash_Table *h = GET_HASH_TABLE (op); |
1423 |
|
|
1424 |
|
op = hash_lookup (h, make_number (reg[RRR]), NULL); |
1425 |
|
if (op >= 0) |
1426 |
|
{ |
1427 |
|
Lisp_Object opl; |
1428 |
|
opl = HASH_VALUE (h, op); |
1429 |
|
if (!CHAR_VALID_P (XINT (opl), 0)) |
1430 |
|
CCL_INVALID_CMD; |
1431 |
|
SPLIT_CHAR (XINT (opl), reg[RRR], i, j); |
1432 |
|
if (j != -1) |
1433 |
|
i = (i << 7) | j; |
1434 |
|
reg[rrr] = i; |
1435 |
|
reg[7] = 1; /* r7 true for success */ |
1436 |
|
} |
1437 |
|
else |
1438 |
|
reg[7] = 0; |
1439 |
|
} |
1440 |
|
break; |
1441 |
|
|
1442 |
|
case CCL_LookupCharConstTbl: |
1443 |
|
op = XINT (ccl_prog[ic]); /* table */ |
1444 |
|
ic++; |
1445 |
|
CCL_MAKE_CHAR (reg[RRR], reg[rrr], i); |
1446 |
|
{ |
1447 |
|
struct Lisp_Hash_Table *h = GET_HASH_TABLE (op); |
1448 |
|
|
1449 |
|
op = hash_lookup (h, make_number (i), NULL); |
1450 |
|
if (op >= 0) |
1451 |
|
{ |
1452 |
|
Lisp_Object opl; |
1453 |
|
opl = HASH_VALUE (h, op); |
1454 |
|
if (!INTEGERP (opl)) |
1455 |
|
CCL_INVALID_CMD; |
1456 |
|
reg[RRR] = XINT (opl); |
1457 |
|
reg[7] = 1; /* r7 true for success */ |
1458 |
|
} |
1459 |
|
else |
1460 |
|
reg[7] = 0; |
1461 |
|
} |
1462 |
|
break; |
1463 |
|
|
1464 |
case CCL_IterateMultipleMap: |
case CCL_IterateMultipleMap: |
1465 |
{ |
{ |
1466 |
Lisp_Object map, content, attrib, value; |
Lisp_Object map, content, attrib, value; |
1517 |
else |
else |
1518 |
continue; |
continue; |
1519 |
} |
} |
1520 |
else |
else |
1521 |
continue; |
continue; |
1522 |
|
|
1523 |
if (NILP (content)) |
if (NILP (content)) |
1553 |
ic = fin_ic; |
ic = fin_ic; |
1554 |
} |
} |
1555 |
break; |
break; |
1556 |
|
|
1557 |
case CCL_MapMultiple: |
case CCL_MapMultiple: |
1558 |
{ |
{ |
1559 |
Lisp_Object map, content, attrib, value; |
Lisp_Object map, content, attrib, value; |
1640 |
} |
} |
1641 |
} |
} |
1642 |
map_vector_size = ASIZE (Vcode_conversion_map_vector); |
map_vector_size = ASIZE (Vcode_conversion_map_vector); |
1643 |
|
|
1644 |
do { |
do { |
1645 |
for (;map_set_rest_length > 0;i++, ic++, map_set_rest_length--) |
for (;map_set_rest_length > 0;i++, ic++, map_set_rest_length--) |
1646 |
{ |
{ |
1690 |
else |
else |
1691 |
continue; |
continue; |
1692 |
} |
} |
1693 |
else |
else |
1694 |
continue; |
continue; |
1695 |
|
|
1696 |
if (NILP (content)) |
if (NILP (content)) |
1808 |
} |
} |
1809 |
} |
} |
1810 |
break; |
break; |
1811 |
|
|
1812 |
default: |
default: |
1813 |
CCL_INVALID_CMD; |
CCL_INVALID_CMD; |
1814 |
} |
} |
1881 |
bcopy (msg, dst, msglen); |
bcopy (msg, dst, msglen); |
1882 |
dst += msglen; |
dst += msglen; |
1883 |
} |
} |
1884 |
|
|
1885 |
if (ccl->status == CCL_STAT_INVALID_CMD) |
if (ccl->status == CCL_STAT_INVALID_CMD) |
1886 |
{ |
{ |
1887 |
#if 0 /* If the remaining bytes contain 0x80..0x9F, copying them |
#if 0 /* If the remaining bytes contain 0x80..0x9F, copying them |
2063 |
return 0; |
return 0; |
2064 |
} |
} |
2065 |
|
|
|
#ifdef emacs |
|
|
|
|
2066 |
DEFUN ("ccl-program-p", Fccl_program_p, Sccl_program_p, 1, 1, 0, |
DEFUN ("ccl-program-p", Fccl_program_p, Sccl_program_p, 1, 1, 0, |
2067 |
doc: /* Return t if OBJECT is a CCL program name or a compiled CCL program code. |
doc: /* Return t if OBJECT is a CCL program name or a compiled CCL program code. |
2068 |
See the documentation of `define-ccl-program' for the detail of CCL program. */) |
See the documentation of `define-ccl-program' for the detail of CCL program. */) |
2188 |
if (ccl.ic < i && i < ccl.size) |
if (ccl.ic < i && i < ccl.size) |
2189 |
ccl.ic = i; |
ccl.ic = i; |
2190 |
} |
} |
2191 |
outbufsize = STRING_BYTES (XSTRING (str)) * ccl.buf_magnification + 256; |
outbufsize = SBYTES (str) * ccl.buf_magnification + 256; |
2192 |
outbuf = (char *) xmalloc (outbufsize); |
outbuf = (char *) xmalloc (outbufsize); |
2193 |
ccl.last_block = NILP (contin); |
ccl.last_block = NILP (contin); |
2194 |
ccl.multibyte = STRING_MULTIBYTE (str); |
ccl.multibyte = STRING_MULTIBYTE (str); |
2195 |
produced = ccl_driver (&ccl, XSTRING (str)->data, outbuf, |
produced = ccl_driver (&ccl, SDATA (str), outbuf, |
2196 |
STRING_BYTES (XSTRING (str)), outbufsize, (int *) 0); |
SBYTES (str), outbufsize, (int *) 0); |
2197 |
for (i = 0; i < 8; i++) |
for (i = 0; i < 8; i++) |
2198 |
XSET (AREF (status, i), Lisp_Int, ccl.reg[i]); |
XSET (AREF (status, i), Lisp_Int, ccl.reg[i]); |
2199 |
XSETINT (AREF (status, 8), ccl.ic); |
XSETINT (AREF (status, 8), ccl.ic); |
2317 |
|
|
2318 |
CHECK_SYMBOL (symbol); |
CHECK_SYMBOL (symbol); |
2319 |
CHECK_VECTOR (map); |
CHECK_VECTOR (map); |
2320 |
|
|
2321 |
for (i = 0; i < len; i++) |
for (i = 0; i < len; i++) |
2322 |
{ |
{ |
2323 |
Lisp_Object slot = AREF (Vcode_conversion_map_vector, i); |
Lisp_Object slot = AREF (Vcode_conversion_map_vector, i); |
2389 |
If the font is single-byte font, the register R2 is not used. */); |
If the font is single-byte font, the register R2 is not used. */); |
2390 |
Vfont_ccl_encoder_alist = Qnil; |
Vfont_ccl_encoder_alist = Qnil; |
2391 |
|
|
2392 |
|
DEFVAR_LISP ("translation-hash-table-vector", &Vtranslation_hash_table_vector, |
2393 |
|
doc: /* Vector containing all translation hash tables ever defined. |
2394 |
|
Comprises pairs (SYMBOL . TABLE) where SYMBOL and TABLE were set up by calls |
2395 |
|
to `define-translation-hash-table'. The vector is indexed by the table id |
2396 |
|
used by CCL. */); |
2397 |
|
Vtranslation_hash_table_vector = Qnil; |
2398 |
|
|
2399 |
defsubr (&Sccl_program_p); |
defsubr (&Sccl_program_p); |
2400 |
defsubr (&Sccl_execute); |
defsubr (&Sccl_execute); |
2401 |
defsubr (&Sccl_execute_on_string); |
defsubr (&Sccl_execute_on_string); |
2402 |
defsubr (&Sregister_ccl_program); |
defsubr (&Sregister_ccl_program); |
2403 |
defsubr (&Sregister_code_conversion_map); |
defsubr (&Sregister_code_conversion_map); |
2404 |
} |
} |
|
|
|
|
#endif /* emacs */ |
|