X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/a37520c6767b258fd1619300baa82ae81f13a3e6..fe4dcb868e1371946b675415fdf19249a606281f:/src/ccl.c diff --git a/src/ccl.c b/src/ccl.c index 2be97ba88a..5bff1f3a0a 100644 --- a/src/ccl.c +++ b/src/ccl.c @@ -1,5 +1,6 @@ /* CCL (Code Conversion Language) interpreter. Copyright (C) 1995, 1997 Electrotechnical Laboratory, JAPAN. + Copyright (C) 2001, 2002 Free Software Foundation, Inc. Licensed to the Free Software Foundation. This file is part of GNU Emacs. @@ -19,25 +20,15 @@ along with GNU Emacs; see the file COPYING. If not, write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. */ -#ifdef emacs #include -#endif #include -#ifdef emacs - #include "lisp.h" #include "charset.h" #include "ccl.h" #include "coding.h" -#else /* not emacs */ - -#include "mulelib.h" - -#endif /* not emacs */ - /* This contains all code conversion map available to CCL. */ Lisp_Object Vcode_conversion_map_vector; @@ -64,6 +55,13 @@ Lisp_Object Qccl_program_idx; already resolved to index numbers or not. */ Lisp_Object Vccl_program_table; +/* Vector of registered hash tables for translation. */ +Lisp_Object Vtranslation_hash_table_vector; + +/* Return a hash table of id number ID. */ +#define GET_HASH_TABLE(id) \ + (XHASH_TABLE (XCDR(XVECTOR(Vtranslation_hash_table_vector)->contents[(id)]))) + /* CCL (Code Conversion Language) is a simple language which has operations on one input buffer, one output buffer, and 7 registers. The syntax of CCL is described in `ccl.el'. Emacs Lisp function @@ -420,7 +418,7 @@ Lisp_Object Vccl_program_table; IC += 2; */ -#define CCL_Extention 0x1F /* Extended CCL code +#define CCL_Extension 0x1F /* Extended CCL code 1:ExtendedCOMMNDRrrRRRrrrXXXXX 2:ARGUEMENT 3:... @@ -428,7 +426,7 @@ Lisp_Object Vccl_program_table; extended_command (rrr,RRR,Rrr,ARGS) */ -/* +/* Here after, Extended CCL Instructions. Bit length of extended command is 14. Therefore, the instruction code range is 0..16384(0x3fff). @@ -486,7 +484,7 @@ Lisp_Object Vccl_program_table; 3:MAP-ID1 4:MAP-ID2 ... - */ + */ /* Map the code in reg[rrr] by MAPs starting from the Nth (N = reg[RRR]) map. @@ -564,7 +562,7 @@ Lisp_Object Vccl_program_table; where STARTPOINT is an offset to be used for indexing a map, ENDPOINT is a maximum index number of a map, - VAL and VALn is a number, nil, t, or lambda. + VAL and VALn is a number, nil, t, or lambda. Valid index range of a map of type (a) is: STARTPOINT <= index < STARTPOINT + map_size - 1 @@ -600,21 +598,26 @@ static tr_stack *mapping_stack_pointer; static int stack_idx_of_map_multiple; #define PUSH_MAPPING_STACK(restlen, orig) \ - do { \ +do \ + { \ mapping_stack_pointer->rest_length = (restlen); \ mapping_stack_pointer->orig_val = (orig); \ mapping_stack_pointer++; \ - } while (0) + } \ +while (0) #define POP_MAPPING_STACK(restlen, orig) \ - do { \ +do \ + { \ mapping_stack_pointer--; \ (restlen) = mapping_stack_pointer->rest_length; \ (orig) = mapping_stack_pointer->orig_val; \ - } while (0) + } \ +while (0) #define CCL_CALL_FOR_MAP_INSTRUCTION(symbol, ret_ic) \ - do { \ +do \ + { \ struct ccl_program called_ccl; \ if (stack_idx >= 256 \ || (setup_ccl_program (&called_ccl, (symbol)) != 0)) \ @@ -623,16 +626,20 @@ static int stack_idx_of_map_multiple; { \ ccl_prog = ccl_prog_stack_struct[0].ccl_prog; \ ic = ccl_prog_stack_struct[0].ic; \ + eof_ic = ccl_prog_stack_struct[0].eof_ic; \ } \ CCL_INVALID_CMD; \ } \ ccl_prog_stack_struct[stack_idx].ccl_prog = ccl_prog; \ ccl_prog_stack_struct[stack_idx].ic = (ret_ic); \ + ccl_prog_stack_struct[stack_idx].eof_ic = eof_ic; \ stack_idx++; \ ccl_prog = called_ccl.prog; \ ic = CCL_HEADER_MAIN; \ + eof_ic = XFASTINT (ccl_prog[CCL_HEADER_EOF]); \ goto ccl_repeat; \ - } while (0) + } \ +while (0) #define CCL_MapSingle 0x12 /* Map by single code conversion map 1:ExtendedCOMMNDXXXRRRrrrXXXXX @@ -645,6 +652,18 @@ static int stack_idx_of_map_multiple; set reg[RRR] to -1. */ +#define CCL_LookupIntConstTbl 0x13 /* Lookup multibyte character by + integer key. Afterwards R7 set + to 1 iff lookup succeeded. + 1:ExtendedCOMMNDRrrRRRXXXXXXXX + 2:ARGUMENT(Hash table ID) */ + +#define CCL_LookupCharConstTbl 0x14 /* Lookup integer by multibyte + character key. Afterwards R7 set + to 1 iff lookup succeeded. + 1:ExtendedCOMMNDRrrRRRrrrXXXXX + 2:ARGUMENT(Hash table ID) */ + /* CCL arithmetic/logical operators. */ #define CCL_PLUS 0x00 /* X = Y + Z */ #define CCL_MINUS 0x01 /* X = Y - Z */ @@ -672,29 +691,50 @@ static int stack_idx_of_map_multiple; r[7] = LOWER_BYTE (SJIS (Y, Z) */ /* Terminate CCL program successfully. */ -#define CCL_SUCCESS \ - do { \ +#define CCL_SUCCESS \ +do \ + { \ ccl->status = CCL_STAT_SUCCESS; \ - goto ccl_finish; \ - } while (0) + goto ccl_finish; \ + } \ +while(0) /* Suspend CCL program because of reading from empty input buffer or writing to full output buffer. When this program is resumed, the same I/O command is executed. */ #define CCL_SUSPEND(stat) \ - do { \ +do \ + { \ ic--; \ ccl->status = stat; \ goto ccl_finish; \ - } while (0) + } \ +while (0) /* Terminate CCL program because of invalid command. Should not occur in the normal case. */ +#ifndef CCL_DEBUG + #define CCL_INVALID_CMD \ - do { \ +do \ + { \ ccl->status = CCL_STAT_INVALID_CMD; \ goto ccl_error_handler; \ - } while (0) + } \ +while(0) + +#else + +#define CCL_INVALID_CMD \ +do \ + { \ + ccl_debug_hook (this_ic); \ + ccl->status = CCL_STAT_INVALID_CMD; \ + goto ccl_error_handler; \ + } \ +while(0) + +#endif /* Encode one character CH to multibyte form and write to the current output buffer. If CH is less than 256, CH is written as is. */ @@ -708,13 +748,34 @@ static int stack_idx_of_map_multiple; if (bytes == 1) \ { \ *dst++ = (ch); \ - if ((ch) >= 0x80 && (ch) < 0xA0) \ + if (extra_bytes && (ch) >= 0x80 && (ch) < 0xA0) \ /* We may have to convert this eight-bit char to \ multibyte form later. */ \ extra_bytes++; \ } \ - else \ + else if (CHAR_VALID_P (ch, 0)) \ dst += CHAR_STRING (ch, dst); \ + else \ + CCL_INVALID_CMD; \ + } \ + else \ + CCL_SUSPEND (CCL_STAT_SUSPEND_BY_DST); \ + } while (0) + +/* Encode one character CH to multibyte form and write to the current + output buffer. The output bytes always forms a valid multibyte + sequence. */ +#define CCL_WRITE_MULTIBYTE_CHAR(ch) \ + do { \ + int bytes = CHAR_BYTES (ch); \ + if (!dst) \ + CCL_INVALID_CMD; \ + else if (dst + bytes + extra_bytes < (dst_bytes ? dst_end : src)) \ + { \ + if (CHAR_VALID_P ((ch), 0)) \ + dst += CHAR_STRING ((ch), dst); \ + else \ + CCL_INVALID_CMD; \ } \ else \ CCL_SUSPEND (CCL_STAT_SUSPEND_BY_DST); \ @@ -734,15 +795,15 @@ static int stack_idx_of_map_multiple; CCL_SUSPEND (CCL_STAT_SUSPEND_BY_DST); \ } while (0) -/* Read one byte from the current input buffer into Rth register. */ -#define CCL_READ_CHAR(r) \ +/* Read one byte from the current input buffer into REGth register. */ +#define CCL_READ_CHAR(REG) \ do { \ if (!src) \ CCL_INVALID_CMD; \ else if (src < src_end) \ { \ - r = *src++; \ - if (r == '\n' \ + REG = *src++; \ + if (REG == '\n' \ && ccl->eol_type != CODING_EOL_LF) \ { \ /* We are encoding. */ \ @@ -753,20 +814,21 @@ static int stack_idx_of_map_multiple; else \ { \ ccl->cr_consumed = 1; \ - r = '\r'; \ + REG = '\r'; \ src--; \ } \ } \ else \ - r = '\r'; \ + REG = '\r'; \ } \ - if (r == LEADING_CODE_8_BIT_CONTROL \ + if (REG == LEADING_CODE_8_BIT_CONTROL \ && ccl->multibyte) \ - r = *src++ - 0x20; \ + REG = *src++ - 0x20; \ } \ else if (ccl->last_block) \ { \ - ic = ccl->eof_ic; \ + REG = -1; \ + ic = eof_ic; \ goto ccl_repeat; \ } \ else \ @@ -809,17 +871,25 @@ static int stack_idx_of_map_multiple; #ifdef CCL_DEBUG #define CCL_DEBUG_BACKTRACE_LEN 256 -int ccl_backtrace_table[CCL_BACKTRACE_TABLE]; +int ccl_backtrace_table[CCL_DEBUG_BACKTRACE_LEN]; int ccl_backtrace_idx; + +int +ccl_debug_hook (int ic) +{ + return ic; +} + #endif struct ccl_prog_stack { Lisp_Object *ccl_prog; /* Pointer to an array of CCL code. */ int ic; /* Instruction Counter. */ + int eof_ic; /* Instruction Counter to jump on EOF. */ }; -/* For the moment, we only support depth 256 of stack. */ +/* For the moment, we only support depth 256 of stack. */ static struct ccl_prog_stack ccl_prog_stack_struct[256]; int @@ -831,25 +901,27 @@ ccl_driver (ccl, source, destination, src_bytes, dst_bytes, consumed) { register int *reg = ccl->reg; register int ic = ccl->ic; - register int code, field1, field2; + register int code = 0, field1, field2; register Lisp_Object *ccl_prog = ccl->prog; unsigned char *src = source, *src_end = src + src_bytes; unsigned char *dst = destination, *dst_end = dst + dst_bytes; int jump_address; - int i, j, op; + int i = 0, j, op; int stack_idx = ccl->stack_idx; /* Instruction counter of the current CCL code. */ - int this_ic; + int this_ic = 0; /* CCL_WRITE_CHAR will produce 8-bit code of range 0x80..0x9F. But, each of them will be converted to multibyte form of 2-byte sequence. For that conversion, we remember how many more bytes we must keep in DESTINATION in this variable. */ - int extra_bytes = 0; + int extra_bytes = ccl->eight_bit_control; + int eof_ic = ccl->eof_ic; + int eof_hit = 0; - if (ic >= ccl->eof_ic) + if (ic >= eof_ic) ic = CCL_HEADER_MAIN; - if (ccl->buf_magnification ==0) /* We can't produce any bytes. */ + if (ccl->buf_magnification == 0) /* We can't produce any bytes. */ dst = NULL; /* Set mapping stack pointer. */ @@ -1042,24 +1114,26 @@ ccl_driver (ccl, source, destination, src_bytes, dst_bytes, consumed) if (stack_idx >= 256 || prog_id < 0 - || prog_id >= XVECTOR (Vccl_program_table)->size - || (slot = XVECTOR (Vccl_program_table)->contents[prog_id], - !VECTORP (slot)) - || !VECTORP (XVECTOR (slot)->contents[1])) + || prog_id >= ASIZE (Vccl_program_table) + || (slot = AREF (Vccl_program_table, prog_id), !VECTORP (slot)) + || !VECTORP (AREF (slot, 1))) { if (stack_idx > 0) { ccl_prog = ccl_prog_stack_struct[0].ccl_prog; ic = ccl_prog_stack_struct[0].ic; + eof_ic = ccl_prog_stack_struct[0].eof_ic; } CCL_INVALID_CMD; } - + ccl_prog_stack_struct[stack_idx].ccl_prog = ccl_prog; ccl_prog_stack_struct[stack_idx].ic = ic; + ccl_prog_stack_struct[stack_idx].eof_ic = eof_ic; stack_idx++; - ccl_prog = XVECTOR (XVECTOR (slot)->contents[1])->contents; + ccl_prog = XVECTOR (AREF (slot, 1))->contents; ic = CCL_HEADER_MAIN; + eof_ic = XFASTINT (ccl_prog[CCL_HEADER_EOF]); } break; @@ -1089,6 +1163,9 @@ ccl_driver (ccl, source, destination, src_bytes, dst_bytes, consumed) stack_idx--; ccl_prog = ccl_prog_stack_struct[stack_idx].ccl_prog; ic = ccl_prog_stack_struct[stack_idx].ic; + eof_ic = ccl_prog_stack_struct[stack_idx].eof_ic; + if (eof_hit) + ic = eof_ic; break; } if (src) @@ -1206,107 +1283,127 @@ ccl_driver (ccl, source, destination, src_bytes, dst_bytes, consumed) ic = jump_address; break; - case CCL_Extention: + case CCL_Extension: switch (EXCMD) { case CCL_ReadMultibyteChar2: if (!src) CCL_INVALID_CMD; - do { - if (src >= src_end) - { - src++; + if (src >= src_end) + { + src++; + goto ccl_read_multibyte_character_suspend; + } + + if (!ccl->multibyte) + { + int bytes; + if (!UNIBYTE_STR_AS_MULTIBYTE_P (src, src_end - src, bytes)) + { + reg[RRR] = CHARSET_8_BIT_CONTROL; + reg[rrr] = *src++; + break; + } + } + i = *src++; + if (i == '\n' && ccl->eol_type != CODING_EOL_LF) + { + /* We are encoding. */ + if (ccl->eol_type == CODING_EOL_CRLF) + { + if (ccl->cr_consumed) + ccl->cr_consumed = 0; + else + { + ccl->cr_consumed = 1; + i = '\r'; + src--; + } + } + else + i = '\r'; + reg[rrr] = i; + reg[RRR] = CHARSET_ASCII; + } + else if (i < 0x80) + { + /* ASCII */ + reg[rrr] = i; + reg[RRR] = CHARSET_ASCII; + } + else if (i <= MAX_CHARSET_OFFICIAL_DIMENSION2) + { + int dimension = BYTES_BY_CHAR_HEAD (i) - 1; + + if (dimension == 0) + { + /* `i' is a leading code for an undefined charset. */ + reg[RRR] = CHARSET_8_BIT_GRAPHIC; + reg[rrr] = i; + } + else if (src + dimension > src_end) goto ccl_read_multibyte_character_suspend; - } - - i = *src++; - if (i == '\n' && ccl->eol_type != CODING_EOL_LF) - { - /* We are encoding. */ - if (ccl->eol_type == CODING_EOL_CRLF) - { - if (ccl->cr_consumed) - ccl->cr_consumed = 0; - else - { - ccl->cr_consumed = 1; - i = '\r'; - src--; - } - } - else - i = '\r'; - reg[rrr] = i; - reg[RRR] = CHARSET_ASCII; - } - else if (i < 0x80) - { - /* ASCII */ - reg[rrr] = i; - reg[RRR] = CHARSET_ASCII; - } - else if (i <= MAX_CHARSET_OFFICIAL_DIMENSION1) - { - if (src >= src_end) - goto ccl_read_multibyte_character_suspend; - reg[RRR] = i; - reg[rrr] = (*src++ & 0x7F); - } - else if (i <= MAX_CHARSET_OFFICIAL_DIMENSION2) - { - if ((src + 1) >= src_end) - goto ccl_read_multibyte_character_suspend; - reg[RRR] = i; - i = (*src++ & 0x7F); - reg[rrr] = ((i << 7) | (*src & 0x7F)); - src++; - } - else if ((i == LEADING_CODE_PRIVATE_11) - || (i == LEADING_CODE_PRIVATE_12)) - { - if ((src + 1) >= src_end) - goto ccl_read_multibyte_character_suspend; - reg[RRR] = *src++; - reg[rrr] = (*src++ & 0x7F); - } - else if ((i == LEADING_CODE_PRIVATE_21) - || (i == LEADING_CODE_PRIVATE_22)) - { - if ((src + 2) >= src_end) - goto ccl_read_multibyte_character_suspend; - reg[RRR] = *src++; - i = (*src++ & 0x7F); - reg[rrr] = ((i << 7) | (*src & 0x7F)); - src++; - } - else if (i == LEADING_CODE_8_BIT_CONTROL) - { - if (src >= src_end) - goto ccl_read_multibyte_character_suspend; - reg[RRR] = CHARSET_8_BIT_CONTROL; - reg[rrr] = (*src++ - 0x20); - } - else if (i >= 0xA0) - { - reg[RRR] = CHARSET_8_BIT_GRAPHIC; - reg[rrr] = i; - } - else - { - /* INVALID CODE. Return a single byte character. */ - reg[RRR] = CHARSET_ASCII; - reg[rrr] = i; - } - break; - } while (1); + else + { + reg[RRR] = i; + i = (*src++ & 0x7F); + if (dimension == 1) + reg[rrr] = i; + else + reg[rrr] = ((i << 7) | (*src++ & 0x7F)); + } + } + else if ((i == LEADING_CODE_PRIVATE_11) + || (i == LEADING_CODE_PRIVATE_12)) + { + if ((src + 1) >= src_end) + goto ccl_read_multibyte_character_suspend; + reg[RRR] = *src++; + reg[rrr] = (*src++ & 0x7F); + } + else if ((i == LEADING_CODE_PRIVATE_21) + || (i == LEADING_CODE_PRIVATE_22)) + { + if ((src + 2) >= src_end) + goto ccl_read_multibyte_character_suspend; + reg[RRR] = *src++; + i = (*src++ & 0x7F); + reg[rrr] = ((i << 7) | (*src & 0x7F)); + src++; + } + else if (i == LEADING_CODE_8_BIT_CONTROL) + { + if (src >= src_end) + goto ccl_read_multibyte_character_suspend; + reg[RRR] = CHARSET_8_BIT_CONTROL; + reg[rrr] = (*src++ - 0x20); + } + else if (i >= 0xA0) + { + reg[RRR] = CHARSET_8_BIT_GRAPHIC; + reg[rrr] = i; + } + else + { + /* INVALID CODE. Return a single byte character. */ + reg[RRR] = CHARSET_ASCII; + reg[rrr] = i; + } break; ccl_read_multibyte_character_suspend: + if (src <= src_end && !ccl->multibyte && ccl->last_block) + { + reg[RRR] = CHARSET_8_BIT_CONTROL; + reg[rrr] = i; + break; + } src--; if (ccl->last_block) { - ic = ccl->eof_ic; + ic = eof_ic; + eof_hit = 1; goto ccl_repeat; } else @@ -1327,7 +1424,7 @@ ccl_driver (ccl, source, destination, src_bytes, dst_bytes, consumed) else i = ((i - 0xE0) << 14) | reg[rrr]; - CCL_WRITE_CHAR (i); + CCL_WRITE_MULTIBYTE_CHAR (i); break; @@ -1338,7 +1435,7 @@ ccl_driver (ccl, source, destination, src_bytes, dst_bytes, consumed) SPLIT_CHAR (op, reg[RRR], i, j); if (j != -1) i = (i << 7) | j; - + reg[rrr] = i; break; @@ -1350,10 +1447,56 @@ ccl_driver (ccl, source, destination, src_bytes, dst_bytes, consumed) SPLIT_CHAR (op, reg[RRR], i, j); if (j != -1) i = (i << 7) | j; - + reg[rrr] = i; break; + case CCL_LookupIntConstTbl: + op = XINT (ccl_prog[ic]); /* table */ + ic++; + { + struct Lisp_Hash_Table *h = GET_HASH_TABLE (op); + + op = hash_lookup (h, make_number (reg[RRR]), NULL); + if (op >= 0) + { + Lisp_Object opl; + opl = HASH_VALUE (h, op); + if (!CHAR_VALID_P (XINT (opl), 0)) + CCL_INVALID_CMD; + SPLIT_CHAR (XINT (opl), reg[RRR], i, j); + if (j != -1) + i = (i << 7) | j; + reg[rrr] = i; + reg[7] = 1; /* r7 true for success */ + } + else + reg[7] = 0; + } + break; + + case CCL_LookupCharConstTbl: + op = XINT (ccl_prog[ic]); /* table */ + ic++; + CCL_MAKE_CHAR (reg[RRR], reg[rrr], i); + { + struct Lisp_Hash_Table *h = GET_HASH_TABLE (op); + + op = hash_lookup (h, make_number (i), NULL); + if (op >= 0) + { + Lisp_Object opl; + opl = HASH_VALUE (h, op); + if (!INTEGERP (opl)) + CCL_INVALID_CMD; + reg[RRR] = XINT (opl); + reg[7] = 1; /* r7 true for success */ + } + else + reg[7] = 0; + } + break; + case CCL_IterateMultipleMap: { Lisp_Object map, content, attrib, value; @@ -1377,20 +1520,19 @@ ccl_driver (ccl, source, destination, src_bytes, dst_bytes, consumed) for (;i < j;i++) { - size = XVECTOR (Vcode_conversion_map_vector)->size; + size = ASIZE (Vcode_conversion_map_vector); point = XINT (ccl_prog[ic++]); if (point >= size) continue; - map = - XVECTOR (Vcode_conversion_map_vector)->contents[point]; + map = AREF (Vcode_conversion_map_vector, point); /* Check map varidity. */ if (!CONSP (map)) continue; map = XCDR (map); if (!VECTORP (map)) continue; - size = XVECTOR (map)->size; + size = ASIZE (map); if (size <= 1) continue; - content = XVECTOR (map)->contents[0]; + content = AREF (map, 0); /* check map type, [STARTPOINT VAL1 VAL2 ...] or @@ -1400,18 +1542,18 @@ ccl_driver (ccl, source, destination, src_bytes, dst_bytes, consumed) point = XUINT (content); point = op - point + 1; if (!((point >= 1) && (point < size))) continue; - content = XVECTOR (map)->contents[point]; + content = AREF (map, point); } else if (EQ (content, Qt)) { if (size != 4) continue; - if ((op >= XUINT (XVECTOR (map)->contents[2])) - && (op < XUINT (XVECTOR (map)->contents[3]))) - content = XVECTOR (map)->contents[1]; + if ((op >= XUINT (AREF (map, 2))) + && (op < XUINT (AREF (map, 3)))) + content = AREF (map, 1); else continue; } - else + else continue; if (NILP (content)) @@ -1447,7 +1589,7 @@ ccl_driver (ccl, source, destination, src_bytes, dst_bytes, consumed) ic = fin_ic; } break; - + case CCL_MapMultiple: { Lisp_Object map, content, attrib, value; @@ -1533,8 +1675,8 @@ ccl_driver (ccl, source, destination, src_bytes, dst_bytes, consumed) break; } } - map_vector_size = XVECTOR (Vcode_conversion_map_vector)->size; - + map_vector_size = ASIZE (Vcode_conversion_map_vector); + do { for (;map_set_rest_length > 0;i++, ic++, map_set_rest_length--) { @@ -1554,17 +1696,16 @@ ccl_driver (ccl, source, destination, src_bytes, dst_bytes, consumed) } if (point >= map_vector_size) continue; - map = (XVECTOR (Vcode_conversion_map_vector) - ->contents[point]); + map = AREF (Vcode_conversion_map_vector, point); /* Check map varidity. */ if (!CONSP (map)) continue; map = XCDR (map); if (!VECTORP (map)) continue; - size = XVECTOR (map)->size; + size = ASIZE (map); if (size <= 1) continue; - content = XVECTOR (map)->contents[0]; + content = AREF (map, 0); /* check map type, [STARTPOINT VAL1 VAL2 ...] or @@ -1574,18 +1715,18 @@ ccl_driver (ccl, source, destination, src_bytes, dst_bytes, consumed) point = XUINT (content); point = op - point + 1; if (!((point >= 1) && (point < size))) continue; - content = XVECTOR (map)->contents[point]; + content = AREF (map, point); } else if (EQ (content, Qt)) { if (size != 4) continue; - if ((op >= XUINT (XVECTOR (map)->contents[2])) && - (op < XUINT (XVECTOR (map)->contents[3]))) - content = XVECTOR (map)->contents[1]; + if ((op >= XUINT (AREF (map, 2))) && + (op < XUINT (AREF (map, 3)))) + content = AREF (map, 1); else continue; } - else + else continue; if (NILP (content)) @@ -1654,12 +1795,12 @@ ccl_driver (ccl, source, destination, src_bytes, dst_bytes, consumed) int size, point; j = XINT (ccl_prog[ic++]); /* map_id */ op = reg[rrr]; - if (j >= XVECTOR (Vcode_conversion_map_vector)->size) + if (j >= ASIZE (Vcode_conversion_map_vector)) { reg[RRR] = -1; break; } - map = XVECTOR (Vcode_conversion_map_vector)->contents[j]; + map = AREF (Vcode_conversion_map_vector, j); if (!CONSP (map)) { reg[RRR] = -1; @@ -1671,8 +1812,8 @@ ccl_driver (ccl, source, destination, src_bytes, dst_bytes, consumed) reg[RRR] = -1; break; } - size = XVECTOR (map)->size; - point = XUINT (XVECTOR (map)->contents[0]); + size = ASIZE (map); + point = XUINT (AREF (map, 0)); point = op - point + 1; reg[RRR] = 0; if ((size <= 1) || @@ -1681,7 +1822,7 @@ ccl_driver (ccl, source, destination, src_bytes, dst_bytes, consumed) else { reg[RRR] = 0; - content = XVECTOR (map)->contents[point]; + content = AREF (map, point); if (NILP (content)) reg[RRR] = -1; else if (NUMBERP (content)) @@ -1703,7 +1844,7 @@ ccl_driver (ccl, source, destination, src_bytes, dst_bytes, consumed) } } break; - + default: CCL_INVALID_CMD; } @@ -1715,7 +1856,9 @@ ccl_driver (ccl, source, destination, src_bytes, dst_bytes, consumed) } ccl_error_handler: - if (destination) + /* The suppress_error member is set when e.g. a CCL-based coding + system is used for terminal output. */ + if (!ccl->suppress_error && destination) { /* We can insert an error message only if DESTINATION is specified and we still have a room to store the message @@ -1765,7 +1908,7 @@ ccl_driver (ccl, source, destination, src_bytes, dst_bytes, consumed) break; default: - sprintf(msg, "\nCCL: Unknown error type (%d).", ccl->status); + sprintf(msg, "\nCCL: Unknown error type (%d)", ccl->status); } msglen = strlen (msg); @@ -1774,13 +1917,33 @@ ccl_driver (ccl, source, destination, src_bytes, dst_bytes, consumed) bcopy (msg, dst, msglen); dst += msglen; } + + if (ccl->status == CCL_STAT_INVALID_CMD) + { +#if 0 /* If the remaining bytes contain 0x80..0x9F, copying them + results in an invalid multibyte sequence. */ + + /* Copy the remaining source data. */ + int i = src_end - src; + if (dst_bytes && (dst_end - dst) < i) + i = dst_end - dst; + bcopy (src, dst, i); + src += i; + dst += i; +#else + /* Signal that we've consumed everything. */ + src = src_end; +#endif + } } ccl_finish: ccl->ic = ic; ccl->stack_idx = stack_idx; ccl->prog = ccl_prog; - if (consumed) *consumed = src - source; + ccl->eight_bit_control = (extra_bytes > 1); + if (consumed) + *consumed = src - source; return (dst ? dst - destination : 0); } @@ -1800,11 +1963,11 @@ resolve_symbol_ccl_program (ccl) Lisp_Object result, contents, val; result = ccl; - veclen = XVECTOR (result)->size; + veclen = ASIZE (result); for (i = 0; i < veclen; i++) { - contents = XVECTOR (result)->contents[i]; + contents = AREF (result, i); if (INTEGERP (contents)) continue; else if (CONSP (contents) @@ -1820,7 +1983,7 @@ resolve_symbol_ccl_program (ccl) val = Fget (XCAR (contents), XCDR (contents)); if (NATNUMP (val)) - XVECTOR (result)->contents[i] = val; + AREF (result, i) = val; else unresolved = 1; continue; @@ -1835,17 +1998,17 @@ resolve_symbol_ccl_program (ccl) val = Fget (contents, Qtranslation_table_id); if (NATNUMP (val)) - XVECTOR (result)->contents[i] = val; + AREF (result, i) = val; else { val = Fget (contents, Qcode_conversion_map_id); if (NATNUMP (val)) - XVECTOR (result)->contents[i] = val; + AREF (result, i) = val; else { val = Fget (contents, Qccl_program_idx); if (NATNUMP (val)) - XVECTOR (result)->contents[i] = val; + AREF (result, i) = val; else unresolved = 1; } @@ -1880,22 +2043,22 @@ ccl_get_compiled_code (ccl_prog) val = Fget (ccl_prog, Qccl_program_idx); if (! NATNUMP (val) - || XINT (val) >= XVECTOR (Vccl_program_table)->size) + || XINT (val) >= ASIZE (Vccl_program_table)) return Qnil; - slot = XVECTOR (Vccl_program_table)->contents[XINT (val)]; + slot = AREF (Vccl_program_table, XINT (val)); if (! VECTORP (slot) - || XVECTOR (slot)->size != 3 - || ! VECTORP (XVECTOR (slot)->contents[1])) + || ASIZE (slot) != 3 + || ! VECTORP (AREF (slot, 1))) return Qnil; - if (NILP (XVECTOR (slot)->contents[2])) + if (NILP (AREF (slot, 2))) { - val = resolve_symbol_ccl_program (XVECTOR (slot)->contents[1]); + val = resolve_symbol_ccl_program (AREF (slot, 1)); if (! VECTORP (val)) return Qnil; - XVECTOR (slot)->contents[1] = val; - XVECTOR (slot)->contents[2] = Qt; + AREF (slot, 1) = val; + AREF (slot, 2) = Qt; } - return XVECTOR (slot)->contents[1]; + return AREF (slot, 1); } /* Setup fields of the structure pointed by CCL appropriately for the @@ -1932,15 +2095,15 @@ setup_ccl_program (ccl, ccl_prog) ccl->status = 0; ccl->stack_idx = 0; ccl->eol_type = CODING_EOL_LF; + ccl->suppress_error = 0; + ccl->eight_bit_control = 0; return 0; } -#ifdef emacs - DEFUN ("ccl-program-p", Fccl_program_p, Sccl_program_p, 1, 1, 0, - "Return t if OBJECT is a CCL program name or a compiled CCL program code.\n\ -See the documentation of `define-ccl-program' for the detail of CCL program.") - (object) + doc: /* Return t if OBJECT is a CCL program name or a compiled CCL program code. +See the documentation of `define-ccl-program' for the detail of CCL program. */) + (object) Lisp_Object object; { Lisp_Object val; @@ -1955,26 +2118,27 @@ See the documentation of `define-ccl-program' for the detail of CCL program.") val = Fget (object, Qccl_program_idx); return ((! NATNUMP (val) - || XINT (val) >= XVECTOR (Vccl_program_table)->size) + || XINT (val) >= ASIZE (Vccl_program_table)) ? Qnil : Qt); } DEFUN ("ccl-execute", Fccl_execute, Sccl_execute, 2, 2, 0, - "Execute CCL-PROGRAM with registers initialized by REGISTERS.\n\ -\n\ -CCL-PROGRAM is a CCL program name (symbol)\n\ -or a compiled code generated by `ccl-compile' (for backward compatibility,\n\ -in this case, the overhead of the execution is bigger than the former case).\n\ -No I/O commands should appear in CCL-PROGRAM.\n\ -\n\ -REGISTERS is a vector of [R0 R1 ... R7] where RN is an initial value\n\ - of Nth register.\n\ -\n\ -As side effect, each element of REGISTERS holds the value of\n\ - corresponding register after the execution.\n\ -\n\ -See the documentation of `define-ccl-program' for the detail of CCL program.") - (ccl_prog, reg) + doc: /* Execute CCL-PROGRAM with registers initialized by REGISTERS. + +CCL-PROGRAM is a CCL program name (symbol) +or compiled code generated by `ccl-compile' (for backward compatibility. +In the latter case, the execution overhead is bigger than in the former). +No I/O commands should appear in CCL-PROGRAM. + +REGISTERS is a vector of [R0 R1 ... R7] where RN is an initial value +for the Nth register. + +As side effect, each element of REGISTERS holds the value of +the corresponding register after the execution. + +See the documentation of `define-ccl-program' for a definition of CCL +programs. */) + (ccl_prog, reg) Lisp_Object ccl_prog, reg; { struct ccl_program ccl; @@ -1983,52 +2147,52 @@ See the documentation of `define-ccl-program' for the detail of CCL program.") if (setup_ccl_program (&ccl, ccl_prog) < 0) error ("Invalid CCL program"); - CHECK_VECTOR (reg, 1); - if (XVECTOR (reg)->size != 8) + CHECK_VECTOR (reg); + if (ASIZE (reg) != 8) error ("Length of vector REGISTERS is not 8"); for (i = 0; i < 8; i++) - ccl.reg[i] = (INTEGERP (XVECTOR (reg)->contents[i]) - ? XINT (XVECTOR (reg)->contents[i]) + ccl.reg[i] = (INTEGERP (AREF (reg, i)) + ? XINT (AREF (reg, i)) : 0); - ccl_driver (&ccl, (char *)0, (char *)0, 0, 0, (int *)0); + ccl_driver (&ccl, (unsigned char *)0, (unsigned char *)0, 0, 0, (int *)0); QUIT; if (ccl.status != CCL_STAT_SUCCESS) error ("Error in CCL program at %dth code", ccl.ic); for (i = 0; i < 8; i++) - XSETINT (XVECTOR (reg)->contents[i], ccl.reg[i]); + XSETINT (AREF (reg, i), ccl.reg[i]); return Qnil; } DEFUN ("ccl-execute-on-string", Fccl_execute_on_string, Sccl_execute_on_string, 3, 5, 0, - "Execute CCL-PROGRAM with initial STATUS on STRING.\n\ -\n\ -CCL-PROGRAM is a symbol registered by register-ccl-program,\n\ -or a compiled code generated by `ccl-compile' (for backward compatibility,\n\ -in this case, the execution is slower).\n\ -\n\ -Read buffer is set to STRING, and write buffer is allocated automatically.\n\ -\n\ -STATUS is a vector of [R0 R1 ... R7 IC], where\n\ - R0..R7 are initial values of corresponding registers,\n\ - IC is the instruction counter specifying from where to start the program.\n\ -If R0..R7 are nil, they are initialized to 0.\n\ -If IC is nil, it is initialized to head of the CCL program.\n\ -\n\ -If optional 4th arg CONTINUE is non-nil, keep IC on read operation\n\ -when read buffer is exausted, else, IC is always set to the end of\n\ -CCL-PROGRAM on exit.\n\ -\n\ -It returns the contents of write buffer as a string,\n\ - and as side effect, STATUS is updated.\n\ -If the optional 5th arg UNIBYTE-P is non-nil, the returned string\n\ -is a unibyte string. By default it is a multibyte string.\n\ -\n\ -See the documentation of `define-ccl-program' for the detail of CCL program.") - (ccl_prog, status, str, contin, unibyte_p) + doc: /* Execute CCL-PROGRAM with initial STATUS on STRING. + +CCL-PROGRAM is a symbol registered by register-ccl-program, +or a compiled code generated by `ccl-compile' (for backward compatibility, +in this case, the execution is slower). + +Read buffer is set to STRING, and write buffer is allocated automatically. + +STATUS is a vector of [R0 R1 ... R7 IC], where + R0..R7 are initial values of corresponding registers, + IC is the instruction counter specifying from where to start the program. +If R0..R7 are nil, they are initialized to 0. +If IC is nil, it is initialized to head of the CCL program. + +If optional 4th arg CONTINUE is non-nil, keep IC on read operation +when read buffer is exausted, else, IC is always set to the end of +CCL-PROGRAM on exit. + +It returns the contents of write buffer as a string, + and as side effect, STATUS is updated. +If the optional 5th arg UNIBYTE-P is non-nil, the returned string +is a unibyte string. By default it is a multibyte string. + +See the documentation of `define-ccl-program' for the detail of CCL program. */) + (ccl_prog, status, str, contin, unibyte_p) Lisp_Object ccl_prog, status, str, contin, unibyte_p; { Lisp_Object val; @@ -2041,35 +2205,35 @@ See the documentation of `define-ccl-program' for the detail of CCL program.") if (setup_ccl_program (&ccl, ccl_prog) < 0) error ("Invalid CCL program"); - CHECK_VECTOR (status, 1); - if (XVECTOR (status)->size != 9) + CHECK_VECTOR (status); + if (ASIZE (status) != 9) error ("Length of vector STATUS is not 9"); - CHECK_STRING (str, 2); + CHECK_STRING (str); GCPRO2 (status, str); for (i = 0; i < 8; i++) { - if (NILP (XVECTOR (status)->contents[i])) - XSETINT (XVECTOR (status)->contents[i], 0); - if (INTEGERP (XVECTOR (status)->contents[i])) - ccl.reg[i] = XINT (XVECTOR (status)->contents[i]); + if (NILP (AREF (status, i))) + XSETINT (AREF (status, i), 0); + if (INTEGERP (AREF (status, i))) + ccl.reg[i] = XINT (AREF (status, i)); } - if (INTEGERP (XVECTOR (status)->contents[i])) + if (INTEGERP (AREF (status, i))) { - i = XFASTINT (XVECTOR (status)->contents[8]); + i = XFASTINT (AREF (status, 8)); if (ccl.ic < i && i < ccl.size) ccl.ic = i; } - outbufsize = STRING_BYTES (XSTRING (str)) * ccl.buf_magnification + 256; + outbufsize = SBYTES (str) * ccl.buf_magnification + 256; outbuf = (char *) xmalloc (outbufsize); ccl.last_block = NILP (contin); ccl.multibyte = STRING_MULTIBYTE (str); - produced = ccl_driver (&ccl, XSTRING (str)->data, outbuf, - STRING_BYTES (XSTRING (str)), outbufsize, (int *) 0); + produced = ccl_driver (&ccl, SDATA (str), outbuf, + SBYTES (str), outbufsize, (int *) 0); for (i = 0; i < 8; i++) - XSET (XVECTOR (status)->contents[i], Lisp_Int, ccl.reg[i]); - XSETINT (XVECTOR (status)->contents[8], ccl.ic); + ASET (status, i, make_number (ccl.reg[i])); + ASET (status, 8, make_number (ccl.ic)); UNGCPRO; if (NILP (unibyte_p)) @@ -2094,44 +2258,48 @@ See the documentation of `define-ccl-program' for the detail of CCL program.") DEFUN ("register-ccl-program", Fregister_ccl_program, Sregister_ccl_program, 2, 2, 0, - "Register CCL program CCL_PROG as NAME in `ccl-program-table'.\n\ -CCL_PROG should be a compiled CCL program (vector), or nil.\n\ -If it is nil, just reserve NAME as a CCL program name.\n\ -Return index number of the registered CCL program.") - (name, ccl_prog) + doc: /* Register CCL program CCL_PROG as NAME in `ccl-program-table'. +CCL_PROG should be a compiled CCL program (vector), or nil. +If it is nil, just reserve NAME as a CCL program name. +Return index number of the registered CCL program. */) + (name, ccl_prog) Lisp_Object name, ccl_prog; { - int len = XVECTOR (Vccl_program_table)->size; + int len = ASIZE (Vccl_program_table); int idx; Lisp_Object resolved; - CHECK_SYMBOL (name, 0); + CHECK_SYMBOL (name); resolved = Qnil; if (!NILP (ccl_prog)) { - CHECK_VECTOR (ccl_prog, 1); + CHECK_VECTOR (ccl_prog); resolved = resolve_symbol_ccl_program (ccl_prog); - if (! NILP (resolved)) + if (NILP (resolved)) + error ("Error in CCL program"); + if (VECTORP (resolved)) { ccl_prog = resolved; resolved = Qt; } + else + resolved = Qnil; } for (idx = 0; idx < len; idx++) { Lisp_Object slot; - slot = XVECTOR (Vccl_program_table)->contents[idx]; + slot = AREF (Vccl_program_table, idx); if (!VECTORP (slot)) /* This is the first unsed slot. Register NAME here. */ break; - if (EQ (name, XVECTOR (slot)->contents[0])) + if (EQ (name, AREF (slot, 0))) { /* Update this slot. */ - XVECTOR (slot)->contents[1] = ccl_prog; - XVECTOR (slot)->contents[2] = resolved; + AREF (slot, 1) = ccl_prog; + AREF (slot, 2) = resolved; return make_number (idx); } } @@ -2144,8 +2312,8 @@ Return index number of the registered CCL program.") new_table = Fmake_vector (make_number (len * 2), Qnil); for (j = 0; j < len; j++) - XVECTOR (new_table)->contents[j] - = XVECTOR (Vccl_program_table)->contents[j]; + AREF (new_table, j) + = AREF (Vccl_program_table, j); Vccl_program_table = new_table; } @@ -2153,10 +2321,10 @@ Return index number of the registered CCL program.") Lisp_Object elt; elt = Fmake_vector (make_number (3), Qnil); - XVECTOR (elt)->contents[0] = name; - XVECTOR (elt)->contents[1] = ccl_prog; - XVECTOR (elt)->contents[2] = resolved; - XVECTOR (Vccl_program_table)->contents[idx] = elt; + AREF (elt, 0) = name; + AREF (elt, 1) = ccl_prog; + AREF (elt, 2) = resolved; + AREF (Vccl_program_table, idx) = elt; } Fput (name, Qccl_program_idx, make_number (idx)); @@ -2165,31 +2333,31 @@ Return index number of the registered CCL program.") /* Register code conversion map. A code conversion map consists of numbers, Qt, Qnil, and Qlambda. - The first element is start code point. - The rest elements are mapped numbers. + The first element is the start code point. + The other elements are mapped numbers. Symbol t means to map to an original number before mapping. Symbol nil means that the corresponding element is empty. - Symbol lambda menas to terminate mapping here. + Symbol lambda means to terminate mapping here. */ DEFUN ("register-code-conversion-map", Fregister_code_conversion_map, Sregister_code_conversion_map, 2, 2, 0, - "Register SYMBOL as code conversion map MAP.\n\ -Return index number of the registered map.") - (symbol, map) + doc: /* Register SYMBOL as code conversion map MAP. +Return index number of the registered map. */) + (symbol, map) Lisp_Object symbol, map; { - int len = XVECTOR (Vcode_conversion_map_vector)->size; + int len = ASIZE (Vcode_conversion_map_vector); int i; Lisp_Object index; - CHECK_SYMBOL (symbol, 0); - CHECK_VECTOR (map, 1); - + CHECK_SYMBOL (symbol); + CHECK_VECTOR (map); + for (i = 0; i < len; i++) { - Lisp_Object slot = XVECTOR (Vcode_conversion_map_vector)->contents[i]; + Lisp_Object slot = AREF (Vcode_conversion_map_vector, i); if (!CONSP (slot)) break; @@ -2197,7 +2365,7 @@ Return index number of the registered map.") if (EQ (symbol, XCAR (slot))) { index = make_number (i); - XCDR (slot) = map; + XSETCDR (slot, map); Fput (symbol, Qcode_conversion_map, map); Fput (symbol, Qcode_conversion_map_id, index); return index; @@ -2210,15 +2378,15 @@ Return index number of the registered map.") int j; for (j = 0; j < len; j++) - XVECTOR (new_vector)->contents[j] - = XVECTOR (Vcode_conversion_map_vector)->contents[j]; + AREF (new_vector, j) + = AREF (Vcode_conversion_map_vector, j); Vcode_conversion_map_vector = new_vector; } index = make_number (i); Fput (symbol, Qcode_conversion_map, map); Fput (symbol, Qcode_conversion_map_id, index); - XVECTOR (Vcode_conversion_map_vector)->contents[i] = Fcons (symbol, map); + AREF (Vcode_conversion_map_vector, i) = Fcons (symbol, map); return index; } @@ -2242,22 +2410,29 @@ syms_of_ccl () staticpro (&Qcode_conversion_map_id); DEFVAR_LISP ("code-conversion-map-vector", &Vcode_conversion_map_vector, - "Vector of code conversion maps."); + doc: /* Vector of code conversion maps. */); Vcode_conversion_map_vector = Fmake_vector (make_number (16), Qnil); DEFVAR_LISP ("font-ccl-encoder-alist", &Vfont_ccl_encoder_alist, - "Alist of fontname patterns vs corresponding CCL program.\n\ -Each element looks like (REGEXP . CCL-CODE),\n\ - where CCL-CODE is a compiled CCL program.\n\ -When a font whose name matches REGEXP is used for displaying a character,\n\ - CCL-CODE is executed to calculate the code point in the font\n\ - from the charset number and position code(s) of the character which are set\n\ - in CCL registers R0, R1, and R2 before the execution.\n\ -The code point in the font is set in CCL registers R1 and R2\n\ - when the execution terminated.\n\ -If the font is single-byte font, the register R2 is not used."); + doc: /* Alist of fontname patterns vs corresponding CCL program. +Each element looks like (REGEXP . CCL-CODE), + where CCL-CODE is a compiled CCL program. +When a font whose name matches REGEXP is used for displaying a character, + CCL-CODE is executed to calculate the code point in the font + from the charset number and position code(s) of the character which are set + in CCL registers R0, R1, and R2 before the execution. +The code point in the font is set in CCL registers R1 and R2 + when the execution terminated. + If the font is single-byte font, the register R2 is not used. */); Vfont_ccl_encoder_alist = Qnil; + DEFVAR_LISP ("translation-hash-table-vector", &Vtranslation_hash_table_vector, + doc: /* Vector containing all translation hash tables ever defined. +Comprises pairs (SYMBOL . TABLE) where SYMBOL and TABLE were set up by calls +to `define-translation-hash-table'. The vector is indexed by the table id +used by CCL. */); + Vtranslation_hash_table_vector = Qnil; + defsubr (&Sccl_program_p); defsubr (&Sccl_execute); defsubr (&Sccl_execute_on_string); @@ -2265,4 +2440,5 @@ If the font is single-byte font, the register R2 is not used."); defsubr (&Sregister_code_conversion_map); } -#endif /* emacs */ +/* arch-tag: bb9a37be-68ce-4576-8d3d-15d750e4a860 + (do not change this comment) */