X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/dfcf069d565c347abf3cb7cec80e6ed8432037ba..ae18726b83b7cd4f71981dfd2329575bd3eed6ca:/src/ccl.c diff --git a/src/ccl.c b/src/ccl.c index d68367f5f9..779755cf39 100644 --- a/src/ccl.c +++ b/src/ccl.c @@ -1,6 +1,9 @@ /* CCL (Code Conversion Language) interpreter. - Copyright (C) 1995, 1997 Electrotechnical Laboratory, JAPAN. - Licensed to the Free Software Foundation. + Copyright (C) 2001, 2002, 2003, 2004, 2005, + 2006 Free Software Foundation, Inc. + Copyright (C) 1995, 1997, 1998, 2003, 2004, 2005 + National Institute of Advanced Industrial Science and Technology (AIST) + Registration Number H14PRO021 This file is part of GNU Emacs. @@ -16,48 +19,53 @@ GNU General Public License for more details. You should have received a copy of the GNU General Public License 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. */ - -#include - -#ifdef emacs +the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, +Boston, MA 02110-1301, USA. */ #include -#ifdef STDC_HEADERS -#include -#endif +#include #include "lisp.h" #include "charset.h" #include "ccl.h" #include "coding.h" -#else /* not emacs */ - -#include "mulelib.h" - -#endif /* not emacs */ - -/* Where is stored translation tables for CCL program. */ -Lisp_Object Vccl_translation_table_vector; +/* This contains all code conversion map available to CCL. */ +Lisp_Object Vcode_conversion_map_vector; /* Alist of fontname patterns vs corresponding CCL program. */ Lisp_Object Vfont_ccl_encoder_alist; -/* This symbol is property which assocate with ccl program vector. e.g. - (get 'ccl-big5-encoder 'ccl-program) returns ccl program vector */ +/* This symbol is a property which assocates with ccl program vector. + Ex: (get 'ccl-big5-encoder 'ccl-program) returns ccl program vector. */ Lisp_Object Qccl_program; -/* These symbol is properties whish associate with ccl translation table and its id - respectively. */ -Lisp_Object Qccl_translation_table; -Lisp_Object Qccl_translation_table_id; - -/* Vector of CCL program names vs corresponding program data. */ +/* These symbols are properties which associate with code conversion + map and their ID respectively. */ +Lisp_Object Qcode_conversion_map; +Lisp_Object Qcode_conversion_map_id; + +/* Symbols of ccl program have this property, a value of the property + is an index for Vccl_protram_table. */ +Lisp_Object Qccl_program_idx; + +/* Table of registered CCL programs. Each element is a vector of + NAME, CCL_PROG, RESOLVEDP, and UPDATEDP, where NAME (symbol) is the + name of the program, CCL_PROG (vector) is the compiled code of the + program, RESOLVEDP (t or nil) is the flag to tell if symbols in + CCL_PROG is already resolved to index numbers or not, UPDATEDP (t + or nil) is the flat to tell if the CCL program is updated after it + was once used. */ 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 @@ -287,10 +295,15 @@ Lisp_Object Vccl_program_table; */ #define CCL_Call 0x13 /* Call the CCL program whose ID is - (CC..C). - 1:CCCCCCCCCCCCCCCCCCCC000XXXXX + CC..C or cc..c. + 1:CCCCCCCCCCCCCCCCCCCCFFFXXXXX + [2:00000000cccccccccccccccccccc] ------------------------------ - call (CC..C) + if (FFF) + call (cc..c) + IC++; + else + call (CC..C) */ #define CCL_WriteConstString 0x14 /* Write a constant or a string: @@ -409,7 +422,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:... @@ -417,129 +430,243 @@ Lisp_Object Vccl_program_table; extended_command (rrr,RRR,Rrr,ARGS) */ -/* - From here, Extended CCL Instruction. +/* + Here after, Extended CCL Instructions. Bit length of extended command is 14. - Therefore the instruction code begins from 0 to 16384(0x3fff). + Therefore, the instruction code range is 0..16384(0x3fff). */ -#define CCL_ReadMultibyteCharacter 0x00 /* Read Multibyte Character - 1:ExtendedCOMMNDRrrRRRrrrXXXXX - - Read a multibyte characeter. - A code point is stored - into rrr register. - A charset ID is stored - into RRR register. - */ -#define CCL_WriteMultibyteCharacter 0x01 /* Write Multibyte Character - 1:ExtendedCOMMNDRrrRRRrrrXXXXX - - Write a multibyte character. - Write a character whose code point - is in rrr register, and its charset ID - is in RRR charset. - */ -#define CCL_UnifyCharacter 0x02 /* Unify Multibyte Character - 1:ExtendedCOMMNDRrrRRRrrrXXXXX - - Unify a character where its code point - is in rrr register, and its charset ID - is in RRR register with the table of - the unification table ID - in Rrr register. - - Return a unified character where its - code point is in rrr register, and its - charset ID is in RRR register. - */ -#define CCL_UnifyCharacterConstTbl 0x03 /* Unify Multibyte Character - 1:ExtendedCOMMNDRrrRRRrrrXXXXX - 2:ARGUMENT(Unification Table ID) - - Unify a character where its code point - is in rrr register, and its charset ID - is in RRR register with the table of - the unification table ID - in 2nd argument. - - Return a unified character where its - code point is in rrr register, and its - charset ID is in RRR register. - */ -#define CCL_IterateMultipleMap 0x10 /* Iterate Multiple Map - 1:ExtendedCOMMNDXXXRRRrrrXXXXX - 2:NUMBER of TABLES - 3:TABLE-ID1 - 4:TABLE-ID2 - ... - - iterate to lookup tables from a number - until finding a value. - - Each table consists of a vector - whose element is number or - nil or t or lambda. - If the element is nil, - its table is neglected. - In the case of t or lambda, - return the original value. - - */ -#define CCL_TranslateMultipleMap 0x11 /* Translate Multiple Map - 1:ExtendedCOMMNDXXXRRRrrrXXXXX - 2:NUMBER of TABLE-IDs and SEPARATERs - (i.e. m1+m2+m3+...mk+k-1) - 3:TABLE-ID 1,1 - 4:TABLE-ID 1,2 - ... - m1+2:TABLE-ID 1,m1 - m1+3: -1 (SEPARATOR) - m1+4:TABLE-ID 2,1 - ... - m1+m2+4:TABLE-ID 2,m2 - m1+m2+5: -1 - ... - m1+m2+...+mk+k+1:TABLE-ID k,mk - - Translate the code point in - rrr register by tables. - Translation starts from the table - where RRR register points out. - - We translate the given value - from the tables which are separated - by -1. - When each translation is failed to find - any values, we regard the traslation - as identity. - - We iterate to traslate by using each - table set(tables separated by -1) - until lookup the last table except - lookup lambda. - - Each table consists of a vector - whose element is number - or nil or t or lambda. - If the element is nil, - it is neglected and use the next table. - In the case of t, - it is translated to the original value. - In the case of lambda, - it cease the translation and return the - current value. - - */ -#define CCL_TranslateSingleMap 0x12 /* Translate Single Map - 1:ExtendedCOMMNDXXXRRRrrrXXXXX - 2:TABLE-ID - - Translate a number in rrr register. - If it is not found any translation, - set RRR register -1 but rrr register - is not changed. - */ +/* Read a multibyte characeter. + A code point is stored into reg[rrr]. A charset ID is stored into + reg[RRR]. */ + +#define CCL_ReadMultibyteChar2 0x00 /* Read Multibyte Character + 1:ExtendedCOMMNDRrrRRRrrrXXXXX */ + +/* Write a multibyte character. + Write a character whose code point is reg[rrr] and the charset ID + is reg[RRR]. */ + +#define CCL_WriteMultibyteChar2 0x01 /* Write Multibyte Character + 1:ExtendedCOMMNDRrrRRRrrrXXXXX */ + +/* Translate a character whose code point is reg[rrr] and the charset + ID is reg[RRR] by a translation table whose ID is reg[Rrr]. + + A translated character is set in reg[rrr] (code point) and reg[RRR] + (charset ID). */ + +#define CCL_TranslateCharacter 0x02 /* Translate a multibyte character + 1:ExtendedCOMMNDRrrRRRrrrXXXXX */ + +/* Translate a character whose code point is reg[rrr] and the charset + ID is reg[RRR] by a translation table whose ID is ARGUMENT. + + A translated character is set in reg[rrr] (code point) and reg[RRR] + (charset ID). */ + +#define CCL_TranslateCharacterConstTbl 0x03 /* Translate a multibyte character + 1:ExtendedCOMMNDRrrRRRrrrXXXXX + 2:ARGUMENT(Translation Table ID) + */ + +/* Iterate looking up MAPs for reg[rrr] starting from the Nth (N = + reg[RRR]) MAP until some value is found. + + Each MAP is a Lisp vector whose element is number, nil, t, or + lambda. + If the element is nil, ignore the map and proceed to the next map. + If the element is t or lambda, finish without changing reg[rrr]. + If the element is a number, set reg[rrr] to the number and finish. + + Detail of the map structure is descibed in the comment for + CCL_MapMultiple below. */ + +#define CCL_IterateMultipleMap 0x10 /* Iterate multiple maps + 1:ExtendedCOMMNDXXXRRRrrrXXXXX + 2:NUMBER of MAPs + 3:MAP-ID1 + 4:MAP-ID2 + ... + */ + +/* Map the code in reg[rrr] by MAPs starting from the Nth (N = + reg[RRR]) map. + + MAPs are supplied in the succeeding CCL codes as follows: + + When CCL program gives this nested structure of map to this command: + ((MAP-ID11 + MAP-ID12 + (MAP-ID121 MAP-ID122 MAP-ID123) + MAP-ID13) + (MAP-ID21 + (MAP-ID211 (MAP-ID2111) MAP-ID212) + MAP-ID22)), + the compiled CCL codes has this sequence: + CCL_MapMultiple (CCL code of this command) + 16 (total number of MAPs and SEPARATORs) + -7 (1st SEPARATOR) + MAP-ID11 + MAP-ID12 + -3 (2nd SEPARATOR) + MAP-ID121 + MAP-ID122 + MAP-ID123 + MAP-ID13 + -7 (3rd SEPARATOR) + MAP-ID21 + -4 (4th SEPARATOR) + MAP-ID211 + -1 (5th SEPARATOR) + MAP_ID2111 + MAP-ID212 + MAP-ID22 + + A value of each SEPARATOR follows this rule: + MAP-SET := SEPARATOR [(MAP-ID | MAP-SET)]+ + SEPARATOR := -(number of MAP-IDs and SEPARATORs in the MAP-SET) + + (*)....Nest level of MAP-SET must not be over than MAX_MAP_SET_LEVEL. + + When some map fails to map (i.e. it doesn't have a value for + reg[rrr]), the mapping is treated as identity. + + The mapping is iterated for all maps in each map set (set of maps + separated by SEPARATOR) except in the case that lambda is + encountered. More precisely, the mapping proceeds as below: + + At first, VAL0 is set to reg[rrr], and it is translated by the + first map to VAL1. Then, VAL1 is translated by the next map to + VAL2. This mapping is iterated until the last map is used. The + result of the mapping is the last value of VAL?. When the mapping + process reached to the end of the map set, it moves to the next + map set. If the next does not exit, the mapping process terminates, + and regard the last value as a result. + + But, when VALm is mapped to VALn and VALn is not a number, the + mapping proceed as below: + + If VALn is nil, the lastest map is ignored and the mapping of VALm + proceed to the next map. + + In VALn is t, VALm is reverted to reg[rrr] and the mapping of VALm + proceed to the next map. + + If VALn is lambda, move to the next map set like reaching to the + end of the current map set. + + If VALn is a symbol, call the CCL program refered by it. + Then, use reg[rrr] as a mapped value except for -1, -2 and -3. + Such special values are regarded as nil, t, and lambda respectively. + + Each map is a Lisp vector of the following format (a) or (b): + (a)......[STARTPOINT VAL1 VAL2 ...] + (b)......[t VAL STARTPOINT ENDPOINT], + 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. + + Valid index range of a map of type (a) is: + STARTPOINT <= index < STARTPOINT + map_size - 1 + Valid index range of a map of type (b) is: + STARTPOINT <= index < ENDPOINT */ + +#define CCL_MapMultiple 0x11 /* Mapping by multiple code conversion maps + 1:ExtendedCOMMNDXXXRRRrrrXXXXX + 2:N-2 + 3:SEPARATOR_1 (< 0) + 4:MAP-ID_1 + 5:MAP-ID_2 + ... + M:SEPARATOR_x (< 0) + M+1:MAP-ID_y + ... + N:SEPARATOR_z (< 0) + */ + +#define MAX_MAP_SET_LEVEL 30 + +typedef struct +{ + int rest_length; + int orig_val; +} tr_stack; + +static tr_stack mapping_stack[MAX_MAP_SET_LEVEL]; +static tr_stack *mapping_stack_pointer; + +/* If this variable is non-zero, it indicates the stack_idx + of immediately called by CCL_MapMultiple. */ +static int stack_idx_of_map_multiple; + +#define PUSH_MAPPING_STACK(restlen, orig) \ +do \ + { \ + mapping_stack_pointer->rest_length = (restlen); \ + mapping_stack_pointer->orig_val = (orig); \ + mapping_stack_pointer++; \ + } \ +while (0) + +#define POP_MAPPING_STACK(restlen, orig) \ +do \ + { \ + mapping_stack_pointer--; \ + (restlen) = mapping_stack_pointer->rest_length; \ + (orig) = mapping_stack_pointer->orig_val; \ + } \ +while (0) + +#define CCL_CALL_FOR_MAP_INSTRUCTION(symbol, ret_ic) \ +do \ + { \ + struct ccl_program called_ccl; \ + if (stack_idx >= 256 \ + || (setup_ccl_program (&called_ccl, (symbol)) != 0)) \ + { \ + 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 = (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) + +#define CCL_MapSingle 0x12 /* Map by single code conversion map + 1:ExtendedCOMMNDXXXRRRrrrXXXXX + 2:MAP-ID + ------------------------------ + Map reg[rrr] by MAP-ID. + If some valid mapping is found, + set reg[rrr] to the result, + else + 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 */ @@ -562,55 +689,100 @@ Lisp_Object Vccl_program_table; #define CCL_GE 0x14 /* X = (X >= Y) */ #define CCL_NE 0x15 /* X = (X != Y) */ -#define CCL_ENCODE_SJIS 0x16 /* X = HIGHER_BYTE (SJIS (Y, Z)) - r[7] = LOWER_BYTE (SJIS (Y, Z) */ -#define CCL_DECODE_SJIS 0x17 /* X = HIGHER_BYTE (DE-SJIS (Y, Z)) +#define CCL_DECODE_SJIS 0x16 /* X = HIGHER_BYTE (DE-SJIS (Y, Z)) r[7] = LOWER_BYTE (DE-SJIS (Y, Z)) */ +#define CCL_ENCODE_SJIS 0x17 /* X = HIGHER_BYTE (SJIS (Y, Z)) + r[7] = LOWER_BYTE (SJIS (Y, Z) */ /* Terminate CCL program successfully. */ -#define CCL_SUCCESS \ - do { \ +#define CCL_SUCCESS \ +do \ + { \ ccl->status = CCL_STAT_SUCCESS; \ - ccl->ic = CCL_HEADER_MAIN; \ - 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. */ -#define CCL_WRITE_CHAR(ch) \ - do { \ - if (!dst) \ - CCL_INVALID_CMD; \ - else \ - { \ - unsigned char work[4], *str; \ - int len = CHAR_STRING (ch, work, str); \ - if (dst + len <= (dst_bytes ? dst_end : src)) \ - { \ - bcopy (str, dst, len); \ - dst += len; \ - } \ - else \ - CCL_SUSPEND (CCL_STAT_SUSPEND_BY_DST); \ - } \ +#define CCL_WRITE_CHAR(ch) \ + do { \ + int bytes = SINGLE_BYTE_CHAR_P (ch) ? 1: CHAR_BYTES (ch); \ + if (!dst) \ + CCL_INVALID_CMD; \ + else if (dst + bytes + extra_bytes < (dst_bytes ? dst_end : src)) \ + { \ + if (bytes == 1) \ + { \ + *dst++ = (ch); \ + if (extra_bytes && (ch) >= 0x80 && (ch) < 0xA0) \ + /* We may have to convert this eight-bit char to \ + multibyte form later. */ \ + extra_bytes++; \ + } \ + 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); \ } while (0) /* Write a string at ccl_prog[IC] of length LEN to the current output @@ -627,20 +799,69 @@ Lisp_Object Vccl_program_table; 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) \ - do { \ - if (!src) \ - CCL_INVALID_CMD; \ - else if (src < src_end) \ - r = *src++; \ - else if (ccl->last_block) \ - { \ - ic = ccl->eof_ic; \ - goto ccl_finish; \ - } \ - else \ - CCL_SUSPEND (CCL_STAT_SUSPEND_BY_SRC); \ +/* 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) \ + { \ + REG = *src++; \ + if (REG == '\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; \ + REG = '\r'; \ + src--; \ + } \ + } \ + else \ + REG = '\r'; \ + } \ + if (REG == LEADING_CODE_8_BIT_CONTROL \ + && ccl->multibyte) \ + REG = *src++ - 0x20; \ + } \ + else if (ccl->last_block) \ + { \ + REG = -1; \ + ic = eof_ic; \ + goto ccl_repeat; \ + } \ + else \ + CCL_SUSPEND (CCL_STAT_SUSPEND_BY_SRC); \ + } while (0) + + +/* Set C to the character code made from CHARSET and CODE. This is + like MAKE_CHAR but check the validity of CHARSET and CODE. If they + are not valid, set C to (CODE & 0xFF) because that is usually the + case that CCL_ReadMultibyteChar2 read an invalid code and it set + CODE to that invalid byte. */ + +#define CCL_MAKE_CHAR(charset, code, c) \ + do { \ + if (charset == CHARSET_ASCII) \ + c = code & 0xFF; \ + else if (CHARSET_DEFINED_P (charset) \ + && (code & 0x7F) >= 32 \ + && (code < 256 || ((code >> 7) & 0x7F) >= 32)) \ + { \ + int c1 = code & 0x7F, c2 = 0; \ + \ + if (code >= 256) \ + c2 = c1, c1 = (code >> 7) & 0x7F; \ + c = MAKE_CHAR (charset, c1, c2); \ + } \ + else \ + c = code & 0xFF; \ } while (0) @@ -654,16 +875,27 @@ Lisp_Object Vccl_program_table; #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. */ +static struct ccl_prog_stack ccl_prog_stack_struct[256]; + int ccl_driver (ccl, source, destination, src_bytes, dst_bytes, consumed) struct ccl_program *ccl; @@ -673,25 +905,39 @@ 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 stack_idx = 0; - /* For the moment, we only support depth 256 of stack. */ - struct ccl_prog_stack ccl_prog_stack_struct[256]; - - if (ic >= ccl->eof_ic) + int i = 0, j, op; + int stack_idx = ccl->stack_idx; + /* Instruction counter of the current CCL code. */ + 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 = ccl->eight_bit_control; + int eof_ic = ccl->eof_ic; + int eof_hit = 0; + + if (ic >= eof_ic) ic = CCL_HEADER_MAIN; + if (ccl->buf_magnification == 0) /* We can't produce any bytes. */ + dst = NULL; + + /* Set mapping stack pointer. */ + mapping_stack_pointer = mapping_stack; + #ifdef CCL_DEBUG ccl_backtrace_idx = 0; #endif for (;;) { + ccl_repeat: #ifdef CCL_DEBUG ccl_backtrace_table[ccl_backtrace_idx++] = ic; if (ccl_backtrace_idx >= CCL_DEBUG_BACKTRACE_LEN) @@ -710,6 +956,7 @@ ccl_driver (ccl, source, destination, src_bytes, dst_bytes, consumed) break; } + this_ic = ic; code = XINT (ccl_prog[ic]); ic++; field1 = code >> 8; field2 = (code & 0xFF) >> 5; @@ -831,7 +1078,7 @@ ccl_driver (ccl, source, destination, src_bytes, dst_bytes, consumed) i = reg[RRR]; j = XINT (ccl_prog[ic]); op = field1 >> 6; - ic++; + jump_address = ic + 1; goto ccl_set_expr; case CCL_WriteRegister: /* CCCCCCCCCCCCCCCCCCCrrrXXXXX */ @@ -851,32 +1098,46 @@ ccl_driver (ccl, source, destination, src_bytes, dst_bytes, consumed) i = reg[RRR]; j = reg[Rrr]; op = field1 >> 6; + jump_address = ic; goto ccl_set_expr; - case CCL_Call: /* CCCCCCCCCCCCCCCCCCCC000XXXXX */ + case CCL_Call: /* 1:CCCCCCCCCCCCCCCCCCCCFFFXXXXX */ { Lisp_Object slot; + int prog_id; + + /* If FFF is nonzero, the CCL program ID is in the + following code. */ + if (rrr) + { + prog_id = XINT (ccl_prog[ic]); + ic++; + } + else + prog_id = field1; if (stack_idx >= 256 - || field1 < 0 - || field1 >= XVECTOR (Vccl_program_table)->size - || (slot = XVECTOR (Vccl_program_table)->contents[field1], - !CONSP (slot)) - || !VECTORP (XCONS (slot)->cdr)) + || prog_id < 0 + || 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 (XCONS (slot)->cdr)->contents; + ccl_prog = XVECTOR (AREF (slot, 1))->contents; ic = CCL_HEADER_MAIN; + eof_ic = XFASTINT (ccl_prog[CCL_HEADER_EOF]); } break; @@ -901,12 +1162,21 @@ ccl_driver (ccl, source, destination, src_bytes, dst_bytes, consumed) break; case CCL_End: /* 0000000000000000000000XXXXX */ - if (stack_idx-- > 0) + if (stack_idx > 0) { + 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) + src = src_end; + /* ccl->ic should points to this command code again to + suppress further processing. */ + ic--; CCL_SUCCESS; case CCL_ExprSelfConst: /* 00000OPERATION000000rrrXXXXX */ @@ -1002,8 +1272,8 @@ ccl_driver (ccl, source, destination, src_bytes, dst_bytes, consumed) case CCL_LE: reg[rrr] = i <= j; break; case CCL_GE: reg[rrr] = i >= j; break; case CCL_NE: reg[rrr] = i != j; break; - case CCL_ENCODE_SJIS: ENCODE_SJIS (i, j, reg[rrr], reg[7]); break; case CCL_DECODE_SJIS: DECODE_SJIS (i, j, reg[rrr], reg[7]); break; + case CCL_ENCODE_SJIS: ENCODE_SJIS (i, j, reg[rrr], reg[7]); break; default: CCL_INVALID_CMD; } code &= 0x1F; @@ -1011,126 +1281,146 @@ ccl_driver (ccl, source, destination, src_bytes, dst_bytes, consumed) { i = reg[rrr]; CCL_WRITE_CHAR (i); + ic = jump_address; } else if (!reg[rrr]) ic = jump_address; break; - case CCL_Extention: + case CCL_Extension: switch (EXCMD) { - case CCL_ReadMultibyteCharacter: + case CCL_ReadMultibyteChar2: if (!src) CCL_INVALID_CMD; - do { - if (src >= src_end) + + if (src >= src_end) + { + src++; goto ccl_read_multibyte_character_suspend; - - i = *src++; - if (i == LEADING_CODE_COMPOSITION) - { - if (src >= src_end) - goto ccl_read_multibyte_character_suspend; - if (*src == 0xFF) - { - ccl->private_state = COMPOSING_WITH_RULE_HEAD; - src++; - } - else - ccl->private_state = COMPOSING_NO_RULE_HEAD; - } - if (ccl->private_state != 0) - { - /* composite character */ - if (*src < 0xA0) - ccl->private_state = 0; - else - { - if (i == 0xA0) - { - if (src >= src_end) - goto ccl_read_multibyte_character_suspend; - i = *src++ & 0x7F; - } - else - i -= 0x20; + } - if (COMPOSING_WITH_RULE_RULE == ccl->private_state) - { - ccl->private_state = COMPOSING_WITH_RULE_HEAD; - continue; - } - else if (COMPOSING_WITH_RULE_HEAD == ccl->private_state) - ccl->private_state = COMPOSING_WITH_RULE_RULE; - } - } - 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 - { - /* INVALID CODE - Returned charset is -1.*/ - reg[RRR] = -1; - } - } while (0); + 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; + 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; - goto ccl_finish; + ic = eof_ic; + eof_hit = 1; + goto ccl_repeat; } else CCL_SUSPEND (CCL_STAT_SUSPEND_BY_SRC); break; - case CCL_WriteMultibyteCharacter: + case CCL_WriteMultibyteChar2: i = reg[RRR]; /* charset */ - if (i == CHARSET_ASCII) - i = reg[rrr] & 0x7F; - else if (i == CHARSET_COMPOSITION) - i = MAKE_COMPOSITE_CHAR (reg[rrr]); + if (i == CHARSET_ASCII + || i == CHARSET_8_BIT_CONTROL + || i == CHARSET_8_BIT_GRAPHIC) + i = reg[rrr] & 0xFF; else if (CHARSET_DIMENSION (i) == 1) i = ((i - 0x70) << 7) | (reg[rrr] & 0x7F); else if (i < MIN_CHARSET_PRIVATE_DIMENSION2) @@ -1138,66 +1428,85 @@ 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; - case CCL_UnifyCharacter: - i = reg[RRR]; /* charset */ - if (i == CHARSET_ASCII) - i = reg[rrr] & 0x7F; - else if (i == CHARSET_COMPOSITION) - { - reg[RRR] = -1; - break; - } - else if (CHARSET_DIMENSION (i) == 1) - i = ((i - 0x70) << 7) | (reg[rrr] & 0x7F); - else if (i < MIN_CHARSET_PRIVATE_DIMENSION2) - i = ((i - 0x8F) << 14) | (reg[rrr] & 0x3FFF); - else - i = ((i - 0xE0) << 14) | (reg[rrr] & 0x3FFF); - - op = unify_char (UNIFICATION_ID_TABLE (reg[Rrr]), i, -1, 0, 0); + case CCL_TranslateCharacter: + CCL_MAKE_CHAR (reg[RRR], reg[rrr], i); + op = translate_char (GET_TRANSLATION_TABLE (reg[Rrr]), + i, -1, 0, 0); SPLIT_CHAR (op, reg[RRR], i, j); if (j != -1) i = (i << 7) | j; - + reg[rrr] = i; break; - case CCL_UnifyCharacterConstTbl: + case CCL_TranslateCharacterConstTbl: op = XINT (ccl_prog[ic]); /* table */ ic++; - i = reg[RRR]; /* charset */ - if (i == CHARSET_ASCII) - i = reg[rrr] & 0x7F; - else if (i == CHARSET_COMPOSITION) - { - reg[RRR] = -1; - break; - } - else if (CHARSET_DIMENSION (i) == 1) - i = ((i - 0x70) << 7) | (reg[rrr] & 0x7F); - else if (i < MIN_CHARSET_PRIVATE_DIMENSION2) - i = ((i - 0x8F) << 14) | (reg[rrr] & 0x3FFF); - else - i = ((i - 0xE0) << 14) | (reg[rrr] & 0x3FFF); - - op = unify_char (UNIFICATION_ID_TABLE (op), i, -1, 0, 0); + CCL_MAKE_CHAR (reg[RRR], reg[rrr], i); + op = translate_char (GET_TRANSLATION_TABLE (op), i, -1, 0, 0); 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 table, content, attrib, value; + Lisp_Object map, content, attrib, value; int point, size, fin_ic; - j = XINT (ccl_prog[ic++]); /* number of tables. */ + j = XINT (ccl_prog[ic++]); /* number of maps. */ fin_ic = ic + j; op = reg[rrr]; if ((j > reg[RRR]) && (j >= 0)) @@ -1215,27 +1524,48 @@ ccl_driver (ccl, source, destination, src_bytes, dst_bytes, consumed) for (;i < j;i++) { - size = XVECTOR (Vccl_translation_table_vector)->size; - point = ccl_prog[ic++]; + size = ASIZE (Vcode_conversion_map_vector); + point = XINT (ccl_prog[ic++]); if (point >= size) continue; - table = XVECTOR (Vccl_translation_table_vector)-> - contents[point]; - if (!CONSP (table)) continue; - table = XCONS(table)->cdr; - if (!VECTORP (table)) continue; - size = XVECTOR (table)->size; + map = AREF (Vcode_conversion_map_vector, point); + + /* Check map varidity. */ + if (!CONSP (map)) continue; + map = XCDR (map); + if (!VECTORP (map)) continue; + size = ASIZE (map); if (size <= 1) continue; - point = XUINT (XVECTOR (table)->contents[0]); - point = op - point + 1; - if (!((point >= 1) && (point < size))) continue; - content = XVECTOR (table)->contents[point]; + + content = AREF (map, 0); + + /* check map type, + [STARTPOINT VAL1 VAL2 ...] or + [t ELELMENT STARTPOINT ENDPOINT] */ + if (NUMBERP (content)) + { + point = XUINT (content); + point = op - point + 1; + if (!((point >= 1) && (point < size))) continue; + content = AREF (map, point); + } + else if (EQ (content, Qt)) + { + if (size != 4) continue; + if ((op >= XUINT (AREF (map, 2))) + && (op < XUINT (AREF (map, 3)))) + content = AREF (map, 1); + else + continue; + } + else + continue; if (NILP (content)) continue; else if (NUMBERP (content)) { reg[RRR] = i; - reg[rrr] = XUINT(content); + reg[rrr] = XINT(content); break; } else if (EQ (content, Qt) || EQ (content, Qlambda)) @@ -1245,124 +1575,249 @@ ccl_driver (ccl, source, destination, src_bytes, dst_bytes, consumed) } else if (CONSP (content)) { - attrib = XCONS (content)->car; - value = XCONS (content)->cdr; + attrib = XCAR (content); + value = XCDR (content); if (!NUMBERP (attrib) || !NUMBERP (value)) continue; reg[RRR] = i; - reg[rrr] = XUINT(value); + reg[rrr] = XUINT (value); break; } + else if (SYMBOLP (content)) + CCL_CALL_FOR_MAP_INSTRUCTION (content, fin_ic); + else + CCL_INVALID_CMD; } if (i == j) reg[RRR] = -1; ic = fin_ic; } break; - - case CCL_TranslateMultipleMap: + + case CCL_MapMultiple: { - Lisp_Object table, content, attrib, value; - int point, size, table_vector_size; - int skip_to_next, fin_ic; + Lisp_Object map, content, attrib, value; + int point, size, map_vector_size; + int map_set_rest_length, fin_ic; + int current_ic = this_ic; - j = XINT (ccl_prog[ic++]); /* number of tables and separators. */ - fin_ic = ic + j; - if ((j > reg[RRR]) && (j >= 0)) + /* inhibit recursive call on MapMultiple. */ + if (stack_idx_of_map_multiple > 0) + { + if (stack_idx_of_map_multiple <= stack_idx) + { + stack_idx_of_map_multiple = 0; + mapping_stack_pointer = mapping_stack; + CCL_INVALID_CMD; + } + } + else + mapping_stack_pointer = mapping_stack; + stack_idx_of_map_multiple = 0; + + map_set_rest_length = + XINT (ccl_prog[ic++]); /* number of maps and separators. */ + fin_ic = ic + map_set_rest_length; + op = reg[rrr]; + + if ((map_set_rest_length > reg[RRR]) && (reg[RRR] >= 0)) { ic += reg[RRR]; i = reg[RRR]; + map_set_rest_length -= i; } else { ic = fin_ic; reg[RRR] = -1; + mapping_stack_pointer = mapping_stack; break; } - op = reg[rrr]; - reg[RRR] = -1; - skip_to_next = 0; - table_vector_size = XVECTOR (Vccl_translation_table_vector)->size; - for (;i < j;i++) + + if (mapping_stack_pointer <= (mapping_stack + 1)) { - point = ccl_prog[ic++]; - if (XINT(point) == -1) - { - skip_to_next = 0; - continue; - } - if (skip_to_next) continue; - if (point >= table_vector_size) continue; - table = XVECTOR (Vccl_translation_table_vector)-> - contents[point]; - if (!CONSP (table)) continue; - table = XCONS (table)->cdr; - if (!VECTORP (table)) continue; - size = XVECTOR (table)->size; - if (size <= 1) continue; - point = XUINT (XVECTOR (table)->contents[0]); - point = op - point + 1; - if (!((point >= 1) && (point < size))) continue; - content = XVECTOR (table)->contents[point]; + /* Set up initial state. */ + mapping_stack_pointer = mapping_stack; + PUSH_MAPPING_STACK (0, op); + reg[RRR] = -1; + } + else + { + /* Recover after calling other ccl program. */ + int orig_op; - if (NILP (content)) - continue; - else if (NUMBERP (content)) - { - op = XUINT (content); - reg[RRR] = i; - skip_to_next = 1; - } - else if (CONSP (content)) + POP_MAPPING_STACK (map_set_rest_length, orig_op); + POP_MAPPING_STACK (map_set_rest_length, reg[rrr]); + switch (op) { - attrib = XCONS (content)->car; - value = XCONS (content)->cdr; - if (!NUMBERP (attrib) || !NUMBERP (value)) - continue; - reg[RRR] = i; - op = XUINT (value); - - } - else if (EQ (content, Qt)) - { - reg[RRR] = i; + case -1: + /* Regard it as Qnil. */ + op = orig_op; + i++; + ic++; + map_set_rest_length--; + break; + case -2: + /* Regard it as Qt. */ op = reg[rrr]; - skip_to_next = 1; + i++; + ic++; + map_set_rest_length--; + break; + case -3: + /* Regard it as Qlambda. */ + op = orig_op; + i += map_set_rest_length; + ic += map_set_rest_length; + map_set_rest_length = 0; + break; + default: + /* Regard it as normal mapping. */ + i += map_set_rest_length; + ic += map_set_rest_length; + POP_MAPPING_STACK (map_set_rest_length, reg[rrr]); + break; } - else if (EQ (content, Qlambda)) - break; } + map_vector_size = ASIZE (Vcode_conversion_map_vector); + + do { + for (;map_set_rest_length > 0;i++, ic++, map_set_rest_length--) + { + point = XINT(ccl_prog[ic]); + if (point < 0) + { + /* +1 is for including separator. */ + point = -point + 1; + if (mapping_stack_pointer + >= &mapping_stack[MAX_MAP_SET_LEVEL]) + CCL_INVALID_CMD; + PUSH_MAPPING_STACK (map_set_rest_length - point, + reg[rrr]); + map_set_rest_length = point; + reg[rrr] = op; + continue; + } + + if (point >= map_vector_size) continue; + map = AREF (Vcode_conversion_map_vector, point); + + /* Check map varidity. */ + if (!CONSP (map)) continue; + map = XCDR (map); + if (!VECTORP (map)) continue; + size = ASIZE (map); + if (size <= 1) continue; + + content = AREF (map, 0); + + /* check map type, + [STARTPOINT VAL1 VAL2 ...] or + [t ELEMENT STARTPOINT ENDPOINT] */ + if (NUMBERP (content)) + { + point = XUINT (content); + point = op - point + 1; + if (!((point >= 1) && (point < size))) continue; + content = AREF (map, point); + } + else if (EQ (content, Qt)) + { + if (size != 4) continue; + if ((op >= XUINT (AREF (map, 2))) && + (op < XUINT (AREF (map, 3)))) + content = AREF (map, 1); + else + continue; + } + else + continue; + + if (NILP (content)) + continue; + + reg[RRR] = i; + if (NUMBERP (content)) + { + op = XINT (content); + i += map_set_rest_length - 1; + ic += map_set_rest_length - 1; + POP_MAPPING_STACK (map_set_rest_length, reg[rrr]); + map_set_rest_length++; + } + else if (CONSP (content)) + { + attrib = XCAR (content); + value = XCDR (content); + if (!NUMBERP (attrib) || !NUMBERP (value)) + continue; + op = XUINT (value); + i += map_set_rest_length - 1; + ic += map_set_rest_length - 1; + POP_MAPPING_STACK (map_set_rest_length, reg[rrr]); + map_set_rest_length++; + } + else if (EQ (content, Qt)) + { + op = reg[rrr]; + } + else if (EQ (content, Qlambda)) + { + i += map_set_rest_length; + ic += map_set_rest_length; + break; + } + else if (SYMBOLP (content)) + { + if (mapping_stack_pointer + >= &mapping_stack[MAX_MAP_SET_LEVEL]) + CCL_INVALID_CMD; + PUSH_MAPPING_STACK (map_set_rest_length, reg[rrr]); + PUSH_MAPPING_STACK (map_set_rest_length, op); + stack_idx_of_map_multiple = stack_idx + 1; + CCL_CALL_FOR_MAP_INSTRUCTION (content, current_ic); + } + else + CCL_INVALID_CMD; + } + if (mapping_stack_pointer <= (mapping_stack + 1)) + break; + POP_MAPPING_STACK (map_set_rest_length, reg[rrr]); + i += map_set_rest_length; + ic += map_set_rest_length; + POP_MAPPING_STACK (map_set_rest_length, reg[rrr]); + } while (1); + ic = fin_ic; } reg[rrr] = op; break; - case CCL_TranslateSingleMap: + case CCL_MapSingle: { - Lisp_Object table, attrib, value, content; + Lisp_Object map, attrib, value, content; int size, point; - j = XINT (ccl_prog[ic++]); /* table_id */ + j = XINT (ccl_prog[ic++]); /* map_id */ op = reg[rrr]; - if (j >= XVECTOR (Vccl_translation_table_vector)->size) + if (j >= ASIZE (Vcode_conversion_map_vector)) { reg[RRR] = -1; break; } - table = XVECTOR (Vccl_translation_table_vector)-> - contents[j]; - if (!CONSP (table)) + map = AREF (Vcode_conversion_map_vector, j); + if (!CONSP (map)) { reg[RRR] = -1; break; } - table = XCONS(table)->cdr; - if (!VECTORP (table)) + map = XCDR (map); + if (!VECTORP (map)) { reg[RRR] = -1; break; } - size = XVECTOR (table)->size; - point = XUINT (XVECTOR (table)->contents[0]); + size = ASIZE (map); + point = XUINT (AREF (map, 0)); point = op - point + 1; reg[RRR] = 0; if ((size <= 1) || @@ -1370,28 +1825,30 @@ ccl_driver (ccl, source, destination, src_bytes, dst_bytes, consumed) reg[RRR] = -1; else { - content = XVECTOR (table)->contents[point]; + reg[RRR] = 0; + content = AREF (map, point); if (NILP (content)) reg[RRR] = -1; else if (NUMBERP (content)) - reg[rrr] = XUINT (content); - else if (EQ (content, Qt)) - reg[RRR] = i; + reg[rrr] = XINT (content); + else if (EQ (content, Qt)); else if (CONSP (content)) { - attrib = XCONS (content)->car; - value = XCONS (content)->cdr; + attrib = XCAR (content); + value = XCDR (content); if (!NUMBERP (attrib) || !NUMBERP (value)) continue; reg[rrr] = XUINT(value); break; } + else if (SYMBOLP (content)) + CCL_CALL_FOR_MAP_INSTRUCTION (content, ic); else reg[RRR] = -1; } } break; - + default: CCL_INVALID_CMD; } @@ -1403,7 +1860,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 @@ -1411,11 +1870,14 @@ ccl_driver (ccl, source, destination, src_bytes, dst_bytes, consumed) char msg[256]; int msglen; + if (!dst) + dst = destination; + switch (ccl->status) { case CCL_STAT_INVALID_CMD: sprintf(msg, "\nCCL: Invalid command %x (ccl_code = %x) at %d.", - code & 0x1F, code, ic); + code & 0x1F, code, this_ic); #ifdef CCL_DEBUG { int i = ccl_backtrace_idx - 1; @@ -1440,16 +1902,17 @@ ccl_driver (ccl, source, destination, src_bytes, dst_bytes, consumed) bcopy (msg, dst, msglen); dst += msglen; } + goto ccl_finish; } #endif - goto ccl_finish; + break; case CCL_STAT_QUIT: sprintf(msg, "\nCCL: Quited."); break; default: - sprintf(msg, "\nCCL: Unknown error type (%d).", ccl->status); + sprintf(msg, "\nCCL: Unknown error type (%d)", ccl->status); } msglen = strlen (msg); @@ -1458,92 +1921,319 @@ 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; - if (consumed) *consumed = src - source; - return dst - destination; + ccl->stack_idx = stack_idx; + ccl->prog = ccl_prog; + ccl->eight_bit_control = (extra_bytes > 1); + if (consumed) + *consumed = src - source; + return (dst ? dst - destination : 0); +} + +/* Resolve symbols in the specified CCL code (Lisp vector). This + function converts symbols of code conversion maps and character + translation tables embeded in the CCL code into their ID numbers. + + The return value is a vector (CCL itself or a new vector in which + all symbols are resolved), Qt if resolving of some symbol failed, + or nil if CCL contains invalid data. */ + +static Lisp_Object +resolve_symbol_ccl_program (ccl) + Lisp_Object ccl; +{ + int i, veclen, unresolved = 0; + Lisp_Object result, contents, val; + + result = ccl; + veclen = ASIZE (result); + + for (i = 0; i < veclen; i++) + { + contents = AREF (result, i); + if (INTEGERP (contents)) + continue; + else if (CONSP (contents) + && SYMBOLP (XCAR (contents)) + && SYMBOLP (XCDR (contents))) + { + /* This is the new style for embedding symbols. The form is + (SYMBOL . PROPERTY). (get SYMBOL PROPERTY) should give + an index number. */ + + if (EQ (result, ccl)) + result = Fcopy_sequence (ccl); + + val = Fget (XCAR (contents), XCDR (contents)); + if (NATNUMP (val)) + AREF (result, i) = val; + else + unresolved = 1; + continue; + } + else if (SYMBOLP (contents)) + { + /* This is the old style for embedding symbols. This style + may lead to a bug if, for instance, a translation table + and a code conversion map have the same name. */ + if (EQ (result, ccl)) + result = Fcopy_sequence (ccl); + + val = Fget (contents, Qtranslation_table_id); + if (NATNUMP (val)) + AREF (result, i) = val; + else + { + val = Fget (contents, Qcode_conversion_map_id); + if (NATNUMP (val)) + AREF (result, i) = val; + else + { + val = Fget (contents, Qccl_program_idx); + if (NATNUMP (val)) + AREF (result, i) = val; + else + unresolved = 1; + } + } + continue; + } + return Qnil; + } + + return (unresolved ? Qt : result); +} + +/* Return the compiled code (vector) of CCL program CCL_PROG. + CCL_PROG is a name (symbol) of the program or already compiled + code. If necessary, resolve symbols in the compiled code to index + numbers. If we failed to get the compiled code or to resolve + symbols, return Qnil. */ + +static Lisp_Object +ccl_get_compiled_code (ccl_prog, idx) + Lisp_Object ccl_prog; + int *idx; +{ + Lisp_Object val, slot; + + if (VECTORP (ccl_prog)) + { + val = resolve_symbol_ccl_program (ccl_prog); + *idx = -1; + return (VECTORP (val) ? val : Qnil); + } + if (!SYMBOLP (ccl_prog)) + return Qnil; + + val = Fget (ccl_prog, Qccl_program_idx); + if (! NATNUMP (val) + || XINT (val) >= ASIZE (Vccl_program_table)) + return Qnil; + slot = AREF (Vccl_program_table, XINT (val)); + if (! VECTORP (slot) + || ASIZE (slot) != 4 + || ! VECTORP (AREF (slot, 1))) + return Qnil; + *idx = XINT (val); + if (NILP (AREF (slot, 2))) + { + val = resolve_symbol_ccl_program (AREF (slot, 1)); + if (! VECTORP (val)) + return Qnil; + AREF (slot, 1) = val; + AREF (slot, 2) = Qt; + } + return AREF (slot, 1); } /* Setup fields of the structure pointed by CCL appropriately for the - execution of compiled CCL code in VEC (vector of integer). */ -void -setup_ccl_program (ccl, vec) + execution of CCL program CCL_PROG. CCL_PROG is the name (symbol) + of the CCL program or the already compiled code (vector). + Return 0 if we succeed this setup, else return -1. + + If CCL_PROG is nil, we just reset the structure pointed by CCL. */ +int +setup_ccl_program (ccl, ccl_prog) struct ccl_program *ccl; - Lisp_Object vec; + Lisp_Object ccl_prog; { int i; - ccl->size = XVECTOR (vec)->size; - ccl->prog = XVECTOR (vec)->contents; + if (! NILP (ccl_prog)) + { + struct Lisp_Vector *vp; + + ccl_prog = ccl_get_compiled_code (ccl_prog, &ccl->idx); + if (! VECTORP (ccl_prog)) + return -1; + vp = XVECTOR (ccl_prog); + ccl->size = vp->size; + ccl->prog = vp->contents; + ccl->eof_ic = XINT (vp->contents[CCL_HEADER_EOF]); + ccl->buf_magnification = XINT (vp->contents[CCL_HEADER_BUF_MAG]); + if (ccl->idx >= 0) + { + Lisp_Object slot; + + slot = AREF (Vccl_program_table, ccl->idx); + ASET (slot, 3, Qnil); + } + } ccl->ic = CCL_HEADER_MAIN; - ccl->eof_ic = XINT (XVECTOR (vec)->contents[CCL_HEADER_EOF]); - ccl->buf_magnification = XINT (XVECTOR (vec)->contents[CCL_HEADER_BUF_MAG]); for (i = 0; i < 8; i++) ccl->reg[i] = 0; ccl->last_block = 0; ccl->private_state = 0; 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 + +/* Check if CCL is updated or not. If not, re-setup members of CCL. */ + +int +check_ccl_update (ccl) + struct ccl_program *ccl; +{ + Lisp_Object slot, ccl_prog; + + if (ccl->idx < 0) + return 0; + slot = AREF (Vccl_program_table, ccl->idx); + if (NILP (AREF (slot, 3))) + return 0; + ccl_prog = ccl_get_compiled_code (AREF (slot, 0), &ccl->idx); + if (! VECTORP (ccl_prog)) + return -1; + ccl->size = ASIZE (ccl_prog); + ccl->prog = XVECTOR (ccl_prog)->contents; + ccl->eof_ic = XINT (AREF (ccl_prog, CCL_HEADER_EOF)); + ccl->buf_magnification = XINT (AREF (ccl_prog, CCL_HEADER_BUF_MAG)); + ASET (slot, 3, Qnil); + return 0; +} + + +DEFUN ("ccl-program-p", Fccl_program_p, Sccl_program_p, 1, 1, 0, + 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; + + if (VECTORP (object)) + { + val = resolve_symbol_ccl_program (object); + return (VECTORP (val) ? Qt : Qnil); + } + if (!SYMBOLP (object)) + return Qnil; + + val = Fget (object, Qccl_program_idx); + return ((! NATNUMP (val) + || 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\ -CCL-PROGRAM is a compiled code generated by `ccl-compile',\n\ - no I/O commands should appear in the CCL program.\n\ -REGISTERS is a vector of [R0 R1 ... R7] where RN is an initial value\n\ - of Nth register.\n\ -As side effect, each element of REGISTER holds the value of\n\ - corresponding register after the execution.") - (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; int i; - CHECK_VECTOR (ccl_prog, 0); - CHECK_VECTOR (reg, 1); - if (XVECTOR (reg)->size != 8) - error ("Invalid length of vector REGISTERS"); + if (setup_ccl_program (&ccl, ccl_prog) < 0) + error ("Invalid CCL program"); + + CHECK_VECTOR (reg); + if (ASIZE (reg) != 8) + error ("Length of vector REGISTERS is not 8"); - setup_ccl_program (&ccl, ccl_prog); 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\ -CCL-PROGRAM is a compiled code generated by `ccl-compile'.\n\ -Read buffer is set to STRING, and write buffer is allocated automatically.\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 CONTIN 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.") - (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. +usage: (ccl-execute-on-string CCL-PROGRAM STATUS STRING &optional CONTINUE UNIBYTE-P) */) + (ccl_prog, status, str, contin, unibyte_p) Lisp_Object ccl_prog, status, str, contin, unibyte_p; { Lisp_Object val; @@ -1551,50 +2241,57 @@ is a unibyte string. By default it is a multibyte string.") int i, produced; int outbufsize; char *outbuf; - struct gcpro gcpro1, gcpro2, gcpro3; + struct gcpro gcpro1, gcpro2; - CHECK_VECTOR (ccl_prog, 0); - CHECK_VECTOR (status, 1); - if (XVECTOR (status)->size != 9) - error ("Invalid length of vector STATUS"); - CHECK_STRING (str, 2); - GCPRO3 (ccl_prog, status, str); + if (setup_ccl_program (&ccl, ccl_prog) < 0) + error ("Invalid CCL program"); + + CHECK_VECTOR (status); + if (ASIZE (status) != 9) + error ("Length of vector STATUS is not 9"); + CHECK_STRING (str); + + GCPRO2 (status, str); - setup_ccl_program (&ccl, ccl_prog); 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); - if (!outbuf) - error ("Not enough memory"); ccl.last_block = NILP (contin); - produced = ccl_driver (&ccl, XSTRING (str)->data, outbuf, - STRING_BYTES (XSTRING (str)), outbufsize, (int *)0); + ccl.multibyte = STRING_MULTIBYTE (str); + 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)) - val = make_string (outbuf, produced); + { + int nchars; + + produced = str_as_multibyte (outbuf, outbufsize, produced, &nchars); + val = make_multibyte_string (outbuf, nchars, produced); + } else val = make_unibyte_string (outbuf, produced); - free (outbuf); + xfree (outbuf); QUIT; + if (ccl.status == CCL_STAT_SUSPEND_BY_DST) + error ("Output buffer for the CCL programs overflow"); if (ccl.status != CCL_STAT_SUCCESS - && ccl.status != CCL_STAT_SUSPEND_BY_SRC - && ccl.status != CCL_STAT_SUSPEND_BY_DST) + && ccl.status != CCL_STAT_SUSPEND_BY_SRC) error ("Error in CCL program at %dth code", ccl.ic); return val; @@ -1602,86 +2299,117 @@ is a unibyte string. By default it is a multibyte string.") DEFUN ("register-ccl-program", Fregister_ccl_program, Sregister_ccl_program, 2, 2, 0, - "Register CCL program PROGRAM of NAME in `ccl-program-table'.\n\ -PROGRAM should be a compiled code of CCL program, or nil.\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 i; + 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); - - for (i = 0; i < len; i++) { - Lisp_Object slot = XVECTOR (Vccl_program_table)->contents[i]; + CHECK_VECTOR (ccl_prog); + resolved = resolve_symbol_ccl_program (ccl_prog); + if (NILP (resolved)) + error ("Error in CCL program"); + if (VECTORP (resolved)) + { + ccl_prog = resolved; + resolved = Qt; + } + else + resolved = Qnil; + } - if (!CONSP (slot)) + for (idx = 0; idx < len; idx++) + { + Lisp_Object slot; + + slot = AREF (Vccl_program_table, idx); + if (!VECTORP (slot)) + /* This is the first unsed slot. Register NAME here. */ break; - if (EQ (name, XCONS (slot)->car)) + if (EQ (name, AREF (slot, 0))) { - XCONS (slot)->cdr = ccl_prog; - return make_number (i); + /* Update this slot. */ + ASET (slot, 1, ccl_prog); + ASET (slot, 2, resolved); + ASET (slot, 3, Qt); + return make_number (idx); } } - if (i == len) + if (idx == len) { - Lisp_Object new_table = Fmake_vector (make_number (len * 2), Qnil); + /* Extend the table. */ + Lisp_Object new_table; int j; + 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]; + ASET (new_table, j, AREF (Vccl_program_table, j)); Vccl_program_table = new_table; } - XVECTOR (Vccl_program_table)->contents[i] = Fcons (name, ccl_prog); - return make_number (i); + { + Lisp_Object elt; + + elt = Fmake_vector (make_number (4), Qnil); + ASET (elt, 0, name); + ASET (elt, 1, ccl_prog); + ASET (elt, 2, resolved); + ASET (elt, 3, Qt); + ASET (Vccl_program_table, idx, elt); + } + + Fput (name, Qccl_program_idx, make_number (idx)); + return make_number (idx); } -/* register CCL translation table. - CCL translation table consists of numbers and Qt and Qnil and Qlambda. - The first element is start code point. - The rest elements are translated numbers. - Qt shows that an original number before translation. - Qnil shows that an empty element. - Qlambda makes translation stopped. +/* Register code conversion map. + A code conversion map consists of numbers, Qt, Qnil, and Qlambda. + 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 means to terminate mapping here. */ -DEFUN ("register-ccl-translation-table", Fregister_ccl_translation_table, - Sregister_ccl_translation_table, +DEFUN ("register-code-conversion-map", Fregister_code_conversion_map, + Sregister_code_conversion_map, 2, 2, 0, - "Register CCL translation table.\n\ -TABLE should be a vector. SYMBOL is used for pointing the translation table out.\n\ -Return index number of the registered translation table.") - (symbol, table) - Lisp_Object symbol, table; + doc: /* Register SYMBOL as code conversion map MAP. +Return index number of the registered map. */) + (symbol, map) + Lisp_Object symbol, map; { - int len = XVECTOR (Vccl_translation_table_vector)->size; + int len = ASIZE (Vcode_conversion_map_vector); int i; Lisp_Object index; - CHECK_SYMBOL (symbol, 0); - CHECK_VECTOR (table, 1); - + CHECK_SYMBOL (symbol); + CHECK_VECTOR (map); + for (i = 0; i < len; i++) { - Lisp_Object slot = XVECTOR (Vccl_translation_table_vector)->contents[i]; + Lisp_Object slot = AREF (Vcode_conversion_map_vector, i); if (!CONSP (slot)) break; - if (EQ (symbol, XCONS (slot)->car)) + if (EQ (symbol, XCAR (slot))) { index = make_number (i); - XCONS (slot)->cdr = table; - Fput (symbol, Qccl_translation_table, table); - Fput (symbol, Qccl_translation_table_id, index); + XSETCDR (slot, map); + Fput (symbol, Qcode_conversion_map, map); + Fput (symbol, Qcode_conversion_map_id, index); return index; } } @@ -1692,15 +2420,15 @@ Return index number of the registered translation table.") int j; for (j = 0; j < len; j++) - XVECTOR (new_vector)->contents[j] - = XVECTOR (Vccl_translation_table_vector)->contents[j]; - Vccl_translation_table_vector = new_vector; + AREF (new_vector, j) + = AREF (Vcode_conversion_map_vector, j); + Vcode_conversion_map_vector = new_vector; } index = make_number (i); - Fput (symbol, Qccl_translation_table, table); - Fput (symbol, Qccl_translation_table_id, index); - XVECTOR (Vccl_translation_table_vector)->contents[i] = Fcons (symbol, table); + Fput (symbol, Qcode_conversion_map, map); + Fput (symbol, Qcode_conversion_map_id, index); + AREF (Vcode_conversion_map_vector, i) = Fcons (symbol, map); return index; } @@ -1711,37 +2439,48 @@ syms_of_ccl () staticpro (&Vccl_program_table); Vccl_program_table = Fmake_vector (make_number (32), Qnil); - Qccl_program = intern("ccl-program"); - staticpro(&Qccl_program); + Qccl_program = intern ("ccl-program"); + staticpro (&Qccl_program); - Qccl_translation_table = intern ("ccl-translation-table"); - staticpro (&Qccl_translation_table); + Qccl_program_idx = intern ("ccl-program-idx"); + staticpro (&Qccl_program_idx); - Qccl_translation_table_id = intern ("ccl-translation-table-id"); - staticpro (&Qccl_translation_table_id); + Qcode_conversion_map = intern ("code-conversion-map"); + staticpro (&Qcode_conversion_map); - DEFVAR_LISP ("ccl-translation-table-vector", &Vccl_translation_table_vector, - "Where is stored translation tables for CCL program.\n\ -Because CCL program can't access these tables except by the index of the vector."); - Vccl_translation_table_vector = Fmake_vector (XFASTINT (16), Qnil); + Qcode_conversion_map_id = intern ("code-conversion-map-id"); + staticpro (&Qcode_conversion_map_id); + + DEFVAR_LISP ("code-conversion-map-vector", &Vcode_conversion_map_vector, + 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); defsubr (&Sregister_ccl_program); - defsubr (&Sregister_ccl_translation_table); + defsubr (&Sregister_code_conversion_map); } -#endif /* emacs */ +/* arch-tag: bb9a37be-68ce-4576-8d3d-15d750e4a860 + (do not change this comment) */