/* CCL (Code Conversion Language) interpreter.
- Copyright (C) 2001-2011 Free Software Foundation, Inc.
+ Copyright (C) 2001-2016 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)
GNU Emacs is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
-the Free Software Foundation, either version 3 of the License, or
-(at your option) any later version.
+the Free Software Foundation, either version 3 of the License, or (at
+your option) any later version.
GNU Emacs is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
#include <config.h>
#include <stdio.h>
-#include <setjmp.h>
#include <limits.h>
#include "lisp.h"
#include "ccl.h"
#include "coding.h"
-Lisp_Object Qccl, Qcclp;
-
-/* This symbol is a property which associates with ccl program vector.
- Ex: (get 'ccl-big5-encoder 'ccl-program) returns ccl program vector. */
-static Lisp_Object Qccl_program;
-
-/* These symbols are properties which associate with code conversion
- map and their ID respectively. */
-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. */
-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
name of the program, CCL_PROG (vector) is the compiled code of the
/* 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_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.
{ \
struct ccl_program called_ccl; \
if (stack_idx >= 256 \
- || (setup_ccl_program (&called_ccl, (symbol)) != 0)) \
+ || ! setup_ccl_program (&called_ccl, (symbol))) \
{ \
if (stack_idx > 0) \
{ \
#define GET_CCL_CODE(code, ccl_prog, ic) \
GET_CCL_RANGE (code, ccl_prog, ic, CCL_CODE_MIN, CCL_CODE_MAX)
-#define GET_CCL_INT(var, ccl_prog, ic) \
- GET_CCL_RANGE (var, ccl_prog, ic, INT_MIN, INT_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
: (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) \
break;
case CCL_SetConst: /* 00000000000000000000rrrXXXXX */
- GET_CCL_INT (reg[rrr], ccl_prog, ic++);
+ reg[rrr] = XINT (ccl_prog[ic++]);
break;
case CCL_SetArray: /* CCCCCCCCCCCCCCCCCCCCRRRrrrXXXXX */
i = reg[RRR];
j = field1 >> 3;
if (0 <= i && i < j)
- GET_CCL_INT (reg[rrr], ccl_prog, ic + i);
+ reg[rrr] = XINT (ccl_prog[ic + i]);
ic += j;
break;
break;
case CCL_WriteConstJump: /* A--D--D--R--E--S--S-000XXXXX */
- GET_CCL_INT (i, ccl_prog, ic);
+ i = XINT (ccl_prog[ic]);
CCL_WRITE_CHAR (i);
ic += ADDR;
break;
case CCL_WriteConstReadJump: /* A--D--D--R--E--S--S-rrrXXXXX */
- GET_CCL_INT (i, ccl_prog, ic);
+ i = XINT (ccl_prog[ic]);
CCL_WRITE_CHAR (i);
ic++;
CCL_READ_CHAR (reg[rrr]);
break;
case CCL_WriteStringJump: /* A--D--D--R--E--S--S-000XXXXX */
- GET_CCL_INT (j, ccl_prog, 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];
- GET_CCL_INT (j, ccl_prog, ic);
+ j = XINT (ccl_prog[ic]);
if (0 <= i && i < j)
{
- GET_CCL_INT (i, ccl_prog, ic + 1 + i);
+ i = XINT (ccl_prog[ic + 1 + i]);
CCL_WRITE_CHAR (i);
}
ic += j + 2;
/* fall through ... */
case CCL_Branch: /* CCCCCCCCCCCCCCCCCCCCrrrXXXXX */
{
- int incr;
- GET_CCL_INT (incr, ccl_prog,
- ic + (0 <= reg[rrr] && reg[rrr] < field1
- ? reg[rrr]
- : field1));
+ int ioff = 0 <= reg[rrr] && reg[rrr] < field1 ? reg[rrr] : field1;
+ int incr = XINT (ccl_prog[ic + ioff]);
ic += incr;
}
break;
case CCL_WriteExprConst: /* 1:00000OPERATION000RRR000XXXXX */
rrr = 7;
i = reg[RRR];
- GET_CCL_INT (j, ccl_prog, ic);
+ j = XINT (ccl_prog[ic]);
op = field1 >> 6;
jump_address = ic + 1;
goto ccl_set_expr;
/* If FFF is nonzero, the CCL program ID is in the
following code. */
if (rrr)
- GET_CCL_INT (prog_id, ccl_prog, ic++);
+ prog_id = XINT (ccl_prog[ic++]);
else
prog_id = field1;
i = reg[rrr];
if (0 <= i && i < field1)
{
- GET_CCL_INT (j, ccl_prog, ic + i);
+ j = XINT (ccl_prog[ic + i]);
CCL_WRITE_CHAR (j);
}
ic += field1;
CCL_SUCCESS;
case CCL_ExprSelfConst: /* 00000OPERATION000000rrrXXXXX */
- GET_CCL_INT (i, ccl_prog, ic++);
+ i = XINT (ccl_prog[ic++]);
op = field1 >> 6;
goto ccl_expr_self;
case CCL_SetExprConst: /* 00000OPERATION000RRRrrrXXXXX */
i = reg[RRR];
- GET_CCL_INT (j, ccl_prog, ic++);
+ j = XINT (ccl_prog[ic++]);
op = field1 >> 6;
jump_address = ic;
goto ccl_set_expr;
case CCL_JumpCondExprConst: /* A--D--D--R--E--S--S-rrrXXXXX */
i = reg[rrr];
jump_address = ic + ADDR;
- GET_CCL_INT (op, ccl_prog, ic++);
- GET_CCL_INT (j, ccl_prog, ic++);
+ op = XINT (ccl_prog[ic++]);
+ j = XINT (ccl_prog[ic++]);
rrr = 7;
goto ccl_set_expr;
case CCL_JumpCondExprReg:
i = reg[rrr];
jump_address = ic + ADDR;
- GET_CCL_INT (op, ccl_prog, ic++);
+ op = XINT (ccl_prog[ic++]);
GET_CCL_RANGE (j, ccl_prog, ic++, 0, 7);
j = reg[j];
rrr = 7;
case CCL_TranslateCharacterConstTbl:
{
- EMACS_INT eop;
+ ptrdiff_t eop;
GET_CCL_RANGE (eop, ccl_prog, ic++, 0,
(VECTORP (Vtranslation_table_vector)
? ASIZE (Vtranslation_table_vector)
case CCL_IterateMultipleMap:
{
Lisp_Object map, content, attrib, value;
- EMACS_INT point, size;
+ EMACS_INT point;
+ ptrdiff_t size;
int fin_ic;
- GET_CCL_INT (j, ccl_prog, ic++); /* number of maps. */
+ j = XINT (ccl_prog[ic++]); /* number of maps. */
fin_ic = ic + j;
op = reg[rrr];
if ((j > reg[RRR]) && (j >= 0))
for (;i < j;i++)
{
-
+ if (!VECTORP (Vcode_conversion_map_vector)) continue;
size = ASIZE (Vcode_conversion_map_vector);
point = XINT (ccl_prog[ic++]);
if (! (0 <= point && point < size)) continue;
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;
stack_idx_of_map_multiple = 0;
/* Get number of maps and separators. */
- GET_CCL_INT (map_set_rest_length, ccl_prog, ic++);
+ 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--)
{
- GET_CCL_INT (point, ccl_prog, ic);
+ point = XINT (ccl_prog[ic]);
if (point < 0)
{
/* +1 is for including separator. */
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;
}
map = XCDR (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;
}
- point = XINT (AREF (map, 0));
- point = op - point + 1;
+ point = op - XINT (AREF (map, 0)) + 1;
reg[RRR] = 0;
content = AREF (map, point);
if (NILP (content))
reg[RRR] = -1;
- else if (INTEGERP (content))
+ else if (TYPE_RANGED_INTEGERP (int, content))
reg[rrr] = XINT (content);
else if (EQ (content, Qt));
else if (CONSP (content))
{
attrib = XCAR (content);
value = XCDR (content);
- if (!INTEGERP (attrib) || !INTEGERP (value))
+ if (!INTEGERP (attrib)
+ || !TYPE_RANGED_INTEGERP (int, value))
continue;
reg[rrr] = XINT (value);
break;
}
ccl_error_handler:
- /* The suppress_error member is set when e.g. a CCL-based coding
- system is used for terminal output. */
- if (!ccl->suppress_error && destination)
+ if (destination)
{
/* We can insert an error message only if DESTINATION is
specified and we still have a room to store the message
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 & 0x1Fu, code + 0u, 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 (msglen <= dst_end - dst)
{
for (i = 0; i < msglen; 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;
/* Setup fields of the structure pointed by CCL appropriately for the
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.
+ Return true iff successful.
- If CCL_PROG is nil, we just reset the structure pointed by CCL. */
-int
+ If CCL_PROG is nil, just reset the structure pointed by CCL. */
+bool
setup_ccl_program (struct ccl_program *ccl, Lisp_Object ccl_prog)
{
int i;
ccl_prog = ccl_get_compiled_code (ccl_prog, &ccl->idx);
if (! VECTORP (ccl_prog))
- return -1;
+ return false;
vp = XVECTOR (ccl_prog);
ccl->size = vp->header.size;
ccl->prog = vp->contents;
ccl->ic = CCL_HEADER_MAIN;
for (i = 0; i < 8; i++)
ccl->reg[i] = 0;
- ccl->last_block = 0;
- ccl->private_state = 0;
+ ccl->last_block = false;
ccl->status = 0;
ccl->stack_idx = 0;
- ccl->suppress_error = 0;
- ccl->eight_bit_control = 0;
- ccl->quit_silently = 0;
- return 0;
+ ccl->quit_silently = false;
+ return true;
}
struct ccl_program ccl;
int i;
- if (setup_ccl_program (&ccl, ccl_prog) < 0)
+ if (! setup_ccl_program (&ccl, ccl_prog))
error ("Invalid CCL program");
CHECK_VECTOR (reg);
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);
ptrdiff_t consumed_chars, consumed_bytes, produced_chars;
int buf_magnification;
- if (setup_ccl_program (&ccl, ccl_prog) < 0)
+ if (! setup_ccl_program (&ccl, ccl_prog))
error ("Invalid CCL program");
CHECK_VECTOR (status);
{
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)))
}
buf_magnification = ccl.buf_magnification ? ccl.buf_magnification : 1;
-
- if ((min (PTRDIFF_MAX, SIZE_MAX) - 256) / buf_magnification < str_bytes)
+ outbufsize = str_bytes;
+ if (INT_MULTIPLY_WRAPV (buf_magnification, outbufsize, &outbufsize)
+ || INT_ADD_WRAPV (256, outbufsize, &outbufsize))
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;
produced_chars += ccl.produced;
offset = outp - outbuf;
shortfall = ccl.produced * max_expansion - (outbufsize - offset);
- if (0 < shortfall)
+ if (shortfall > 0)
{
outbuf = xpalloc (outbuf, &outbufsize, shortfall, -1, 1);
outp = outbuf + offset;
ASET (status, i, make_number (ccl.reg[i]));
ASET (status, 8, make_number (ccl.ic));
- if (NILP (unibyte_p))
- val = make_multibyte_string ((char *) outbuf, produced_chars,
- outp - outbuf);
- else
- val = make_unibyte_string ((char *) outbuf, produced_chars);
+ val = make_specified_string ((const char *) outbuf, produced_chars,
+ outp - outbuf, NILP (unibyte_p));
xfree (outbuf);
return val;
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;
+ Lisp_Object elt = make_uninit_vector (4);
- elt = Fmake_vector (make_number (4), Qnil);
ASET (elt, 0, name);
ASET (elt, 1, ccl_prog);
ASET (elt, 2, resolved);
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);
DEFSYM (Qccl, "ccl");
DEFSYM (Qcclp, "cclp");
- DEFSYM (Qccl_program, "ccl-program");
+
+ /* Symbols of ccl program have this property, a value of the property
+ is an index for Vccl_program_table. */
DEFSYM (Qccl_program_idx, "ccl-program-idx");
+
+ /* These symbols are properties which associate with code conversion
+ map and their ID respectively. */
DEFSYM (Qcode_conversion_map, "code-conversion-map");
DEFSYM (Qcode_conversion_map_id, "code-conversion-map-id");