/* CCL (Code Conversion Language) interpreter.
- Copyright (C) 2001-2011 Free Software Foundation, Inc.
+ Copyright (C) 2001-2012 Free Software Foundation, Inc.
Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
2005, 2006, 2007, 2008, 2009, 2010, 2011
National Institute of Advanced Industrial Science and Technology (AIST)
#include <config.h>
#include <stdio.h>
-#include <setjmp.h>
+#include <limits.h>
#include "lisp.h"
#include "character.h"
/* This symbol is a property which associates with ccl program vector.
Ex: (get 'ccl-big5-encoder 'ccl-program) returns ccl program vector. */
-Lisp_Object Qccl_program;
+static Lisp_Object Qccl_program;
/* 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;
+static Lisp_Object Qcode_conversion_map;
+static 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;
+ is an index for Vccl_program_table. */
+static 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
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;
+static Lisp_Object Vccl_program_table;
/* Return a hash table of id number ID. */
#define GET_HASH_TABLE(id) \
- (XHASH_TABLE (XCDR(XVECTOR(Vtranslation_hash_table_vector)->contents[(id)])))
+ (XHASH_TABLE (XCDR (AREF (Vtranslation_hash_table_vector, (id)))))
/* CCL (Code Conversion Language) is a simple language which has
operations on one input buffer, one output buffer, and 7 registers.
#define CCL_HEADER_EOF 1
#define CCL_HEADER_MAIN 2
-/* CCL code is a sequence of 28-bit non-negative integers (i.e. the
- MSB is always 0), each contains CCL command and/or arguments in the
- following format:
+/* CCL code is a sequence of 28-bit integers. Each contains a CCL
+ command and/or arguments in the following format:
|----------------- integer (28-bit) ------------------|
|------- 17-bit ------|- 3-bit --|- 3-bit --|- 5-bit -|
|------------- constant or other args ----------------|
cccccccccccccccccccccccccccc
- where, `cc...c' is a non-negative integer indicating constant value
- (the left most `c' is always 0) or an absolute jump address, `RRR'
+ where `cc...c' is a 17-bit, 20-bit, or 28-bit integer indicating a
+ constant value or a relative/absolute jump address, `RRR'
and `rrr' are CCL register number, `XXXXX' is one of the following
CCL commands. */
+#define CCL_CODE_MAX ((1 << (28 - 1)) - 1)
+#define CCL_CODE_MIN (-1 - CCL_CODE_MAX)
+
/* CCL commands
Each comment fields shows one or more lines for command syntax and
#define CCL_WriteArrayReadJump 0x0B /* Write an array element, read, and jump:
1:A--D--D--R--E--S--S-rrrXXXXX
2:LENGTH
- 3:ELEMENET[0]
- 4:ELEMENET[1]
+ 3:ELEMENT[0]
+ 4:ELEMENT[1]
...
N:A--D--D--R--E--S--S-rrrYYYYY
------------------------------
#define CCL_Extension 0x1F /* Extended CCL code
1:ExtendedCOMMNDRrrRRRrrrXXXXX
- 2:ARGUEMENT
+ 2:ARGUMENT
3:...
------------------------------
extended_command (rrr,RRR,Rrr,ARGS)
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
+ Detail of the map structure is described in the comment for
CCL_MapMultiple below. */
#define CCL_IterateMultipleMap 0x10 /* Iterate multiple maps
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
+ If VALn is nil, the last 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
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.
+ If VALn is a symbol, call the CCL program referred 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.
ccl->status = CCL_STAT_SUCCESS; \
goto ccl_finish; \
} \
-while(0)
+while (0)
/* Suspend CCL program because of reading from empty input buffer or
writing to full output buffer. When this program is resumed, the
ccl->status = CCL_STAT_INVALID_CMD; \
goto ccl_error_handler; \
} \
-while(0)
+while (0)
#else
ccl->status = CCL_STAT_INVALID_CMD; \
goto ccl_error_handler; \
} \
-while(0)
+while (0)
#endif
+/* Use "&" rather than "&&" to suppress a bogus GCC warning; see
+ <http://gcc.gnu.org/bugzilla/show_bug.cgi?id=43772>. */
+#define ASCENDING_ORDER(lo, med, hi) (((lo) <= (med)) & ((med) <= (hi)))
+
+#define GET_CCL_RANGE(var, ccl_prog, ic, lo, hi) \
+ do \
+ { \
+ EMACS_INT prog_word = XINT ((ccl_prog)[ic]); \
+ if (! ASCENDING_ORDER (lo, prog_word, hi)) \
+ CCL_INVALID_CMD; \
+ (var) = prog_word; \
+ } \
+ while (0)
+
+#define GET_CCL_CODE(code, ccl_prog, ic) \
+ GET_CCL_RANGE (code, ccl_prog, ic, CCL_CODE_MIN, CCL_CODE_MAX)
+
+#define IN_INT_RANGE(val) ASCENDING_ORDER (INT_MIN, val, INT_MAX)
+
/* 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) \
: (charset = CHARSET_FROM_ID ((id)), DECODE_CHAR (charset, (code))))
/* Encode character C by some of charsets in CHARSET_LIST. Set ID to
- the id of the used charset, ENCODED to the resulf of encoding.
+ the id of the used charset, ENCODED to the result of encoding.
Assume that we can use the variable `charset'. */
#define CCL_ENCODE_CHAR(c, charset_list, id, encoded) \
}
this_ic = ic;
- code = XINT (ccl_prog[ic]); ic++;
+ GET_CCL_CODE (code, ccl_prog, ic++);
field1 = code >> 8;
field2 = (code & 0xFF) >> 5;
break;
case CCL_SetConst: /* 00000000000000000000rrrXXXXX */
- reg[rrr] = XINT (ccl_prog[ic]);
- ic++;
+ reg[rrr] = XINT (ccl_prog[ic++]);
break;
case CCL_SetArray: /* CCCCCCCCCCCCCCCCCCCCRRRrrrXXXXX */
i = reg[RRR];
j = field1 >> 3;
- if ((unsigned int) i < j)
+ if (0 <= i && i < j)
reg[rrr] = XINT (ccl_prog[ic + i]);
ic += j;
break;
break;
case CCL_WriteStringJump: /* A--D--D--R--E--S--S-000XXXXX */
- j = XINT (ccl_prog[ic]);
- ic++;
+ j = XINT (ccl_prog[ic++]);
CCL_WRITE_STRING (j);
ic += ADDR - 1;
break;
case CCL_WriteArrayReadJump: /* A--D--D--R--E--S--S-rrrXXXXX */
i = reg[rrr];
j = XINT (ccl_prog[ic]);
- if ((unsigned int) i < j)
+ if (0 <= i && i < j)
{
i = XINT (ccl_prog[ic + 1 + i]);
CCL_WRITE_CHAR (i);
CCL_READ_CHAR (reg[rrr]);
/* fall through ... */
case CCL_Branch: /* CCCCCCCCCCCCCCCCCCCCrrrXXXXX */
- if ((unsigned int) reg[rrr] < field1)
- ic += XINT (ccl_prog[ic + reg[rrr]]);
- else
- ic += XINT (ccl_prog[ic + field1]);
+ {
+ int ioff = 0 <= reg[rrr] && reg[rrr] < field1 ? reg[rrr] : field1;
+ int incr = XINT (ccl_prog[ic + ioff]);
+ ic += incr;
+ }
break;
case CCL_ReadRegister: /* CCCCCCCCCCCCCCCCCCCCrrXXXXX */
{
CCL_READ_CHAR (reg[rrr]);
if (!field1) break;
- code = XINT (ccl_prog[ic]); ic++;
+ GET_CCL_CODE (code, ccl_prog, ic++);
field1 = code >> 8;
field2 = (code & 0xFF) >> 5;
}
i = reg[rrr];
CCL_WRITE_CHAR (i);
if (!field1) break;
- code = XINT (ccl_prog[ic]); ic++;
+ GET_CCL_CODE (code, ccl_prog, ic++);
field1 = code >> 8;
field2 = (code & 0xFF) >> 5;
}
/* If FFF is nonzero, the CCL program ID is in the
following code. */
if (rrr)
- {
- prog_id = XINT (ccl_prog[ic]);
- ic++;
- }
+ prog_id = XINT (ccl_prog[ic++]);
else
prog_id = field1;
case CCL_WriteArray: /* CCCCCCCCCCCCCCCCCCCCrrrXXXXX */
i = reg[rrr];
- if ((unsigned int) i < field1)
+ if (0 <= i && i < field1)
{
j = XINT (ccl_prog[ic + i]);
CCL_WRITE_CHAR (j);
CCL_SUCCESS;
case CCL_ExprSelfConst: /* 00000OPERATION000000rrrXXXXX */
- i = XINT (ccl_prog[ic]);
- ic++;
+ i = XINT (ccl_prog[ic++]);
op = field1 >> 6;
goto ccl_expr_self;
case CCL_SetExprConst: /* 00000OPERATION000RRRrrrXXXXX */
i = reg[RRR];
- j = XINT (ccl_prog[ic]);
+ j = XINT (ccl_prog[ic++]);
op = field1 >> 6;
- jump_address = ++ic;
+ jump_address = ic;
goto ccl_set_expr;
case CCL_SetExprReg: /* 00000OPERATIONRrrRRRrrrXXXXX */
CCL_READ_CHAR (reg[rrr]);
case CCL_JumpCondExprConst: /* A--D--D--R--E--S--S-rrrXXXXX */
i = reg[rrr];
- op = XINT (ccl_prog[ic]);
- jump_address = ic++ + ADDR;
- j = XINT (ccl_prog[ic]);
- ic++;
+ jump_address = ic + ADDR;
+ op = XINT (ccl_prog[ic++]);
+ j = XINT (ccl_prog[ic++]);
rrr = 7;
goto ccl_set_expr;
CCL_READ_CHAR (reg[rrr]);
case CCL_JumpCondExprReg:
i = reg[rrr];
- op = XINT (ccl_prog[ic]);
- jump_address = ic++ + ADDR;
- j = reg[XINT (ccl_prog[ic])];
- ic++;
+ jump_address = ic + ADDR;
+ op = XINT (ccl_prog[ic++]);
+ GET_CCL_RANGE (j, ccl_prog, ic++, 0, 7);
+ j = reg[j];
rrr = 7;
ccl_set_expr:
break;
case CCL_TranslateCharacterConstTbl:
- op = XINT (ccl_prog[ic]); /* table */
- ic++;
- i = CCL_DECODE_CHAR (reg[RRR], reg[rrr]);
- op = translate_char (GET_TRANSLATION_TABLE (op), i);
- CCL_ENCODE_CHAR (op, charset_list, reg[RRR], reg[rrr]);
+ {
+ ptrdiff_t eop;
+ GET_CCL_RANGE (eop, ccl_prog, ic++, 0,
+ (VECTORP (Vtranslation_table_vector)
+ ? ASIZE (Vtranslation_table_vector)
+ : -1));
+ i = CCL_DECODE_CHAR (reg[RRR], reg[rrr]);
+ op = translate_char (GET_TRANSLATION_TABLE (eop), i);
+ CCL_ENCODE_CHAR (op, charset_list, reg[RRR], reg[rrr]);
+ }
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)
+ ptrdiff_t eop;
+ struct Lisp_Hash_Table *h;
+ GET_CCL_RANGE (eop, ccl_prog, ic++, 0,
+ (VECTORP (Vtranslation_hash_table_vector)
+ ? ASIZE (Vtranslation_hash_table_vector)
+ : -1));
+ h = GET_HASH_TABLE (eop);
+
+ eop = hash_lookup (h, make_number (reg[RRR]), NULL);
+ if (eop >= 0)
{
Lisp_Object opl;
- opl = HASH_VALUE (h, op);
- if (! CHARACTERP (opl))
+ opl = HASH_VALUE (h, eop);
+ if (! (IN_INT_RANGE (eop) && CHARACTERP (opl)))
CCL_INVALID_CMD;
reg[RRR] = charset_unicode;
- reg[rrr] = op;
+ reg[rrr] = eop;
reg[7] = 1; /* r7 true for success */
}
else
break;
case CCL_LookupCharConstTbl:
- op = XINT (ccl_prog[ic]); /* table */
- ic++;
- i = CCL_DECODE_CHAR (reg[RRR], reg[rrr]);
{
- struct Lisp_Hash_Table *h = GET_HASH_TABLE (op);
-
- op = hash_lookup (h, make_number (i), NULL);
- if (op >= 0)
+ ptrdiff_t eop;
+ struct Lisp_Hash_Table *h;
+ GET_CCL_RANGE (eop, ccl_prog, ic++, 0,
+ (VECTORP (Vtranslation_hash_table_vector)
+ ? ASIZE (Vtranslation_hash_table_vector)
+ : -1));
+ i = CCL_DECODE_CHAR (reg[RRR], reg[rrr]);
+ h = GET_HASH_TABLE (eop);
+
+ eop = hash_lookup (h, make_number (i), NULL);
+ if (eop >= 0)
{
Lisp_Object opl;
- opl = HASH_VALUE (h, op);
- if (!INTEGERP (opl))
+ opl = HASH_VALUE (h, eop);
+ if (! (INTEGERP (opl) && IN_INT_RANGE (XINT (opl))))
CCL_INVALID_CMD;
reg[RRR] = XINT (opl);
reg[7] = 1; /* r7 true for success */
case CCL_IterateMultipleMap:
{
Lisp_Object map, content, attrib, value;
- int point, size, fin_ic;
+ EMACS_INT point;
+ ptrdiff_t size;
+ int fin_ic;
j = XINT (ccl_prog[ic++]); /* number of maps. */
fin_ic = ic + j;
for (;i < j;i++)
{
-
+ if (!VECTORP (Vcode_conversion_map_vector)) continue;
size = ASIZE (Vcode_conversion_map_vector);
point = XINT (ccl_prog[ic++]);
- if (point >= size) continue;
+ if (! (0 <= point && point < size)) continue;
map = AREF (Vcode_conversion_map_vector, point);
/* Check map validity. */
/* check map type,
[STARTPOINT VAL1 VAL2 ...] or
[t ELEMENT STARTPOINT ENDPOINT] */
- if (NUMBERP (content))
+ if (INTEGERP (content))
{
- point = XUINT (content);
- point = op - point + 1;
- if (!((point >= 1) && (point < size))) continue;
- content = AREF (map, point);
+ point = XINT (content);
+ if (!(point <= op && op - point + 1 < size)) continue;
+ content = AREF (map, op - point + 1);
}
else if (EQ (content, Qt))
{
if (size != 4) continue;
- if ((op >= XUINT (AREF (map, 2)))
- && (op < XUINT (AREF (map, 3))))
+ if (INTEGERP (AREF (map, 2))
+ && XINT (AREF (map, 2)) <= op
+ && INTEGERP (AREF (map, 3))
+ && op < XINT (AREF (map, 3)))
content = AREF (map, 1);
else
continue;
if (NILP (content))
continue;
- else if (NUMBERP (content))
+ else if (INTEGERP (content) && IN_INT_RANGE (XINT (content)))
{
reg[RRR] = i;
- reg[rrr] = XINT(content);
+ reg[rrr] = XINT (content);
break;
}
else if (EQ (content, Qt) || EQ (content, Qlambda))
{
attrib = XCAR (content);
value = XCDR (content);
- if (!NUMBERP (attrib) || !NUMBERP (value))
+ if (! (INTEGERP (attrib) && INTEGERP (value)
+ && IN_INT_RANGE (XINT (value))))
continue;
reg[RRR] = i;
- reg[rrr] = XUINT (value);
+ reg[rrr] = XINT (value);
break;
}
else if (SYMBOLP (content))
case CCL_MapMultiple:
{
Lisp_Object map, content, attrib, value;
- int point, size, map_vector_size;
+ EMACS_INT point;
+ ptrdiff_t size, map_vector_size;
int map_set_rest_length, fin_ic;
int current_ic = this_ic;
mapping_stack_pointer = mapping_stack;
stack_idx_of_map_multiple = 0;
- map_set_rest_length =
- XINT (ccl_prog[ic++]); /* number of maps and separators. */
+ /* Get number of maps and separators. */
+ map_set_rest_length = XINT (ccl_prog[ic++]);
+
fin_ic = ic + map_set_rest_length;
op = reg[rrr];
break;
}
}
+ if (!VECTORP (Vcode_conversion_map_vector))
+ CCL_INVALID_CMD;
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]);
+ point = XINT (ccl_prog[ic]);
if (point < 0)
{
/* +1 is for including separator. */
/* check map type,
[STARTPOINT VAL1 VAL2 ...] or
[t ELEMENT STARTPOINT ENDPOINT] */
- if (NUMBERP (content))
+ if (INTEGERP (content))
{
- point = XUINT (content);
- point = op - point + 1;
- if (!((point >= 1) && (point < size))) continue;
- content = AREF (map, point);
+ point = XINT (content);
+ if (!(point <= op && op - point + 1 < size)) continue;
+ content = AREF (map, op - point + 1);
}
else if (EQ (content, Qt))
{
if (size != 4) continue;
- if ((op >= XUINT (AREF (map, 2))) &&
- (op < XUINT (AREF (map, 3))))
+ if (INTEGERP (AREF (map, 2))
+ && XINT (AREF (map, 2)) <= op
+ && INTEGERP (AREF (map, 3))
+ && op < XINT (AREF (map, 3)))
content = AREF (map, 1);
else
continue;
continue;
reg[RRR] = i;
- if (NUMBERP (content))
+ if (INTEGERP (content) && IN_INT_RANGE (XINT (content)))
{
op = XINT (content);
i += map_set_rest_length - 1;
{
attrib = XCAR (content);
value = XCDR (content);
- if (!NUMBERP (attrib) || !NUMBERP (value))
+ if (! (INTEGERP (attrib) && INTEGERP (value)
+ && IN_INT_RANGE (XINT (value))))
continue;
- op = XUINT (value);
+ op = XINT (value);
i += map_set_rest_length - 1;
ic += map_set_rest_length - 1;
POP_MAPPING_STACK (map_set_rest_length, reg[rrr]);
case CCL_MapSingle:
{
Lisp_Object map, attrib, value, content;
- int size, point;
+ int point;
j = XINT (ccl_prog[ic++]); /* map_id */
op = reg[rrr];
- if (j >= ASIZE (Vcode_conversion_map_vector))
+ if (! (VECTORP (Vcode_conversion_map_vector)
+ && j < ASIZE (Vcode_conversion_map_vector)))
{
reg[RRR] = -1;
break;
break;
}
map = XCDR (map);
- if (!VECTORP (map))
+ if (! (VECTORP (map)
+ && 0 < ASIZE (map)
+ && INTEGERP (AREF (map, 0))
+ && XINT (AREF (map, 0)) <= op
+ && op - XINT (AREF (map, 0)) + 1 < ASIZE (map)))
{
reg[RRR] = -1;
break;
}
- size = ASIZE (map);
- point = XUINT (AREF (map, 0));
- point = op - point + 1;
+ point = op - XINT (AREF (map, 0)) + 1;
reg[RRR] = 0;
- if ((size <= 1) ||
- (!((point >= 1) && (point < size))))
+ content = AREF (map, point);
+ if (NILP (content))
reg[RRR] = -1;
- else
+ else if (TYPE_RANGED_INTEGERP (int, content))
+ reg[rrr] = XINT (content);
+ else if (EQ (content, Qt));
+ else if (CONSP (content))
{
- reg[RRR] = 0;
- content = AREF (map, point);
- if (NILP (content))
- reg[RRR] = -1;
- else if (NUMBERP (content))
- reg[rrr] = XINT (content);
- else if (EQ (content, Qt));
- else if (CONSP (content))
- {
- 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;
+ attrib = XCAR (content);
+ value = XCDR (content);
+ if (!INTEGERP (attrib)
+ || !TYPE_RANGED_INTEGERP (int, value))
+ continue;
+ reg[rrr] = XINT (value);
+ break;
}
+ else if (SYMBOLP (content))
+ CCL_CALL_FOR_MAP_INSTRUCTION (content, ic);
+ else
+ reg[RRR] = -1;
}
break;
switch (ccl->status)
{
case CCL_STAT_INVALID_CMD:
- sprintf(msg, "\nCCL: Invalid command %x (ccl_code = %x) at %d.",
- code & 0x1F, code, this_ic);
+ msglen = sprintf (msg,
+ "\nCCL: Invalid command %x (ccl_code = %x) at %d.",
+ code & 0x1F, code, this_ic);
#ifdef CCL_DEBUG
{
int i = ccl_backtrace_idx - 1;
int j;
- msglen = strlen (msg);
if (dst + msglen <= (dst_bytes ? dst_end : src))
{
memcpy (dst, msg, msglen);
if (i < 0) i = CCL_DEBUG_BACKTRACE_LEN - 1;
if (ccl_backtrace_table[i] == 0)
break;
- sprintf(msg, " %d", ccl_backtrace_table[i]);
- msglen = strlen (msg);
+ msglen = sprintf (msg, " %d", ccl_backtrace_table[i]);
if (dst + msglen > (dst_bytes ? dst_end : src))
break;
memcpy (dst, msg, msglen);
break;
case CCL_STAT_QUIT:
- if (! ccl->quit_silently)
- sprintf(msg, "\nCCL: Quited.");
+ msglen = ccl->quit_silently ? 0 : sprintf (msg, "\nCCL: Quitted.");
break;
default:
- sprintf(msg, "\nCCL: Unknown error type (%d)", ccl->status);
+ msglen = sprintf (msg, "\nCCL: Unknown error type (%d)", ccl->status);
}
- msglen = strlen (msg);
- if (dst + msglen <= dst_end)
+ if (msglen <= dst_end - dst)
{
for (i = 0; i < msglen; i++)
*dst++ = msg[i];
/* 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.
+ translation tables embedded 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,
+ The return value is 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
int i, veclen, unresolved = 0;
Lisp_Object result, contents, val;
- result = ccl;
+ if (! (CCL_HEADER_MAIN < ASIZE (ccl) && ASIZE (ccl) <= INT_MAX))
+ return Qnil;
+ result = Fcopy_sequence (ccl);
veclen = ASIZE (result);
for (i = 0; i < veclen; i++)
{
contents = AREF (result, i);
- if (INTEGERP (contents))
+ if (TYPE_RANGED_INTEGERP (int, contents))
continue;
else if (CONSP (contents)
&& SYMBOLP (XCAR (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))
+ if (RANGED_INTEGERP (0, val, INT_MAX))
ASET (result, i, val);
else
unresolved = 1;
/* 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))
+ if (RANGED_INTEGERP (0, val, INT_MAX))
ASET (result, i, val);
else
{
val = Fget (contents, Qcode_conversion_map_id);
- if (NATNUMP (val))
+ if (RANGED_INTEGERP (0, val, INT_MAX))
ASET (result, i, val);
else
{
val = Fget (contents, Qccl_program_idx);
- if (NATNUMP (val))
+ if (RANGED_INTEGERP (0, val, INT_MAX))
ASET (result, i, val);
else
unresolved = 1;
return Qnil;
}
+ if (! (0 <= XINT (AREF (result, CCL_HEADER_BUF_MAG))
+ && ASCENDING_ORDER (0, XINT (AREF (result, CCL_HEADER_EOF)),
+ ASIZE (ccl))))
+ return Qnil;
+
return (unresolved ? Qt : result);
}
symbols, return Qnil. */
static Lisp_Object
-ccl_get_compiled_code (Lisp_Object ccl_prog, int *idx)
+ccl_get_compiled_code (Lisp_Object ccl_prog, ptrdiff_t *idx)
{
Lisp_Object val, slot;
if (! VECTORP (ccl_prog))
return -1;
vp = XVECTOR (ccl_prog);
- ccl->size = vp->size;
+ ccl->size = vp->header.size;
ccl->prog = vp->contents;
ccl->eof_ic = XINT (vp->contents[CCL_HEADER_EOF]);
ccl->buf_magnification = XINT (vp->contents[CCL_HEADER_BUF_MAG]);
}
-/* Check if CCL is updated or not. If not, re-setup members of CCL. */
-
-int
-check_ccl_update (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. */)
error ("Length of vector REGISTERS is not 8");
for (i = 0; i < 8; i++)
- ccl.reg[i] = (INTEGERP (AREF (reg, i))
+ ccl.reg[i] = (TYPE_RANGED_INTEGERP (int, AREF (reg, i))
? XINT (AREF (reg, i))
: 0);
Lisp_Object val;
struct ccl_program ccl;
int i;
- EMACS_INT outbufsize;
+ ptrdiff_t outbufsize;
unsigned char *outbuf, *outp;
- EMACS_INT str_chars, str_bytes;
+ ptrdiff_t str_chars, str_bytes;
#define CCL_EXECUTE_BUF_SIZE 1024
int source[CCL_EXECUTE_BUF_SIZE], destination[CCL_EXECUTE_BUF_SIZE];
- EMACS_INT consumed_chars, consumed_bytes, produced_chars;
+ ptrdiff_t consumed_chars, consumed_bytes, produced_chars;
+ int buf_magnification;
if (setup_ccl_program (&ccl, ccl_prog) < 0)
error ("Invalid CCL program");
{
if (NILP (AREF (status, i)))
ASET (status, i, make_number (0));
- if (INTEGERP (AREF (status, i)))
+ if (TYPE_RANGED_INTEGERP (int, AREF (status, i)))
ccl.reg[i] = XINT (AREF (status, i));
}
if (INTEGERP (AREF (status, i)))
ccl.ic = i;
}
+ buf_magnification = ccl.buf_magnification ? ccl.buf_magnification : 1;
+
+ if ((min (PTRDIFF_MAX, SIZE_MAX) - 256) / buf_magnification < str_bytes)
+ memory_full (SIZE_MAX);
outbufsize = (ccl.buf_magnification
? str_bytes * ccl.buf_magnification + 256
: str_bytes + 256);
- outp = outbuf = (unsigned char *) xmalloc (outbufsize);
+ outp = outbuf = xmalloc (outbufsize);
consumed_chars = consumed_bytes = 0;
produced_chars = 0;
src_size = j;
while (1)
{
+ int max_expansion = NILP (unibyte_p) ? MAX_MULTIBYTE_LENGTH : 1;
+ ptrdiff_t offset, shortfall;
ccl_driver (&ccl, src, destination, src_size, CCL_EXECUTE_BUF_SIZE,
Qnil);
produced_chars += ccl.produced;
+ offset = outp - outbuf;
+ shortfall = ccl.produced * max_expansion - (outbufsize - offset);
+ if (0 < shortfall)
+ {
+ outbuf = xpalloc (outbuf, &outbufsize, shortfall, -1, 1);
+ outp = outbuf + offset;
+ }
if (NILP (unibyte_p))
{
- if (outp - outbuf + MAX_MULTIBYTE_LENGTH * ccl.produced
- > outbufsize)
- {
- EMACS_INT offset = outp - outbuf;
- outbufsize += MAX_MULTIBYTE_LENGTH * ccl.produced;
- outbuf = (unsigned char *) xrealloc (outbuf, outbufsize);
- outp = outbuf + offset;
- }
for (j = 0; j < ccl.produced; j++)
CHAR_STRING_ADVANCE (destination[j], outp);
}
else
{
- if (outp - outbuf + ccl.produced > outbufsize)
- {
- EMACS_INT offset = outp - outbuf;
- outbufsize += ccl.produced;
- outbuf = (unsigned char *) xrealloc (outbuf, outbufsize);
- outp = outbuf + offset;
- }
for (j = 0; j < ccl.produced; j++)
*outp++ = destination[j];
}
Return index number of the registered CCL program. */)
(Lisp_Object name, Lisp_Object ccl_prog)
{
- int len = ASIZE (Vccl_program_table);
- int idx;
+ ptrdiff_t len = ASIZE (Vccl_program_table);
+ ptrdiff_t idx;
Lisp_Object resolved;
CHECK_SYMBOL (name);
if (idx == len)
/* Extend the table. */
- Vccl_program_table = larger_vector (Vccl_program_table, len * 2, Qnil);
+ Vccl_program_table = larger_vector (Vccl_program_table, 1, -1);
{
Lisp_Object elt;
Return index number of the registered map. */)
(Lisp_Object symbol, Lisp_Object map)
{
- int len = ASIZE (Vcode_conversion_map_vector);
- int i;
+ ptrdiff_t len;
+ ptrdiff_t i;
Lisp_Object idx;
CHECK_SYMBOL (symbol);
CHECK_VECTOR (map);
+ if (! VECTORP (Vcode_conversion_map_vector))
+ error ("Invalid code-conversion-map-vector");
+
+ len = ASIZE (Vcode_conversion_map_vector);
for (i = 0; i < len; i++)
{
if (i == len)
Vcode_conversion_map_vector = larger_vector (Vcode_conversion_map_vector,
- len * 2, Qnil);
+ 1, -1);
idx = make_number (i);
Fput (symbol, Qcode_conversion_map, map);
staticpro (&Vccl_program_table);
Vccl_program_table = Fmake_vector (make_number (32), Qnil);
- Qccl = intern_c_string ("ccl");
- staticpro (&Qccl);
-
- Qcclp = intern_c_string ("cclp");
- staticpro (&Qcclp);
-
- Qccl_program = intern_c_string ("ccl-program");
- staticpro (&Qccl_program);
-
- Qccl_program_idx = intern_c_string ("ccl-program-idx");
- staticpro (&Qccl_program_idx);
-
- Qcode_conversion_map = intern_c_string ("code-conversion-map");
- staticpro (&Qcode_conversion_map);
-
- Qcode_conversion_map_id = intern_c_string ("code-conversion-map-id");
- staticpro (&Qcode_conversion_map_id);
+ DEFSYM (Qccl, "ccl");
+ DEFSYM (Qcclp, "cclp");
+ DEFSYM (Qccl_program, "ccl-program");
+ DEFSYM (Qccl_program_idx, "ccl-program-idx");
+ DEFSYM (Qcode_conversion_map, "code-conversion-map");
+ DEFSYM (Qcode_conversion_map_id, "code-conversion-map-id");
DEFVAR_LISP ("code-conversion-map-vector", Vcode_conversion_map_vector,
doc: /* Vector of code conversion maps. */);