/* CCL (Code Conversion Language) interpreter.
- Copyright (C) 1995, 1997 Electrotechnical Laboratory, JAPAN.
- Copyright (C) 2001 Free Software Foundation, Inc.
- Licensed to the Free Software Foundation.
+ Copyright (C) 2001, 2002, 2003, 2004, 2005,
+ 2006, 2007 Free Software Foundation, Inc.
+ Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
+ 2005, 2006, 2007
+ National Institute of Advanced Industrial Science and Technology (AIST)
+ Registration Number H14PRO021
This file is part of GNU Emacs.
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. */
+the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+Boston, MA 02110-1301, USA. */
-#ifdef emacs
#include <config.h>
-#endif
#include <stdio.h>
-#ifdef emacs
-
#include "lisp.h"
#include "charset.h"
#include "ccl.h"
#include "coding.h"
-#else /* not emacs */
-
-#include "mulelib.h"
-
-#endif /* not emacs */
-
/* This contains all code conversion map available to CCL. */
Lisp_Object Vcode_conversion_map_vector;
Lisp_Object Qccl_program_idx;
/* Table of registered CCL programs. Each element is a vector of
- NAME, CCL_PROG, and RESOLVEDP 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. */
+ 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
extended_command (rrr,RRR,Rrr,ARGS)
*/
-/*
+/*
Here after, Extended CCL Instructions.
Bit length of extended command is 14.
Therefore, the instruction code range is 0..16384(0x3fff).
3:MAP-ID1
4:MAP-ID2
...
- */
+ */
/* Map the code in reg[rrr] by MAPs starting from the Nth (N =
reg[RRR]) map.
where
STARTPOINT is an offset to be used for indexing a map,
ENDPOINT is a maximum index number of a map,
- VAL and VALn is a number, nil, t, or lambda.
+ VAL and VALn is a number, nil, t, or lambda.
Valid index range of a map of type (a) is:
STARTPOINT <= index < STARTPOINT + map_size - 1
static int stack_idx_of_map_multiple;
#define PUSH_MAPPING_STACK(restlen, orig) \
- do { \
+do \
+ { \
mapping_stack_pointer->rest_length = (restlen); \
mapping_stack_pointer->orig_val = (orig); \
mapping_stack_pointer++; \
- } while (0)
+ } \
+while (0)
#define POP_MAPPING_STACK(restlen, orig) \
- do { \
+do \
+ { \
mapping_stack_pointer--; \
(restlen) = mapping_stack_pointer->rest_length; \
(orig) = mapping_stack_pointer->orig_val; \
- } while (0)
+ } \
+while (0)
#define CCL_CALL_FOR_MAP_INSTRUCTION(symbol, ret_ic) \
-if (1) \
+do \
{ \
struct ccl_program called_ccl; \
if (stack_idx >= 256 \
{ \
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; \
} \
-else
+while (0)
#define CCL_MapSingle 0x12 /* Map by single code conversion map
1:ExtendedCOMMNDXXXRRRrrrXXXXX
set reg[RRR] to -1.
*/
+#define CCL_LookupIntConstTbl 0x13 /* Lookup multibyte character by
+ integer key. Afterwards R7 set
+ to 1 iff lookup succeeded.
+ 1:ExtendedCOMMNDRrrRRRXXXXXXXX
+ 2:ARGUMENT(Hash table ID) */
+
+#define CCL_LookupCharConstTbl 0x14 /* Lookup integer by multibyte
+ character key. Afterwards R7 set
+ to 1 iff lookup succeeded.
+ 1:ExtendedCOMMNDRrrRRRrrrXXXXX
+ 2:ARGUMENT(Hash table ID) */
+
/* CCL arithmetic/logical operators. */
#define CCL_PLUS 0x00 /* X = Y + Z */
#define CCL_MINUS 0x01 /* X = Y - Z */
/* Terminate CCL program successfully. */
#define CCL_SUCCESS \
-if (1) \
+do \
{ \
ccl->status = CCL_STAT_SUCCESS; \
goto ccl_finish; \
} \
-else
+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) \
-if (1) \
+do \
{ \
ic--; \
ccl->status = stat; \
goto ccl_finish; \
} \
-else
+while (0)
/* Terminate CCL program because of invalid command. Should not occur
in the normal case. */
+#ifndef CCL_DEBUG
+
+#define CCL_INVALID_CMD \
+do \
+ { \
+ ccl->status = CCL_STAT_INVALID_CMD; \
+ goto ccl_error_handler; \
+ } \
+while(0)
+
+#else
+
#define CCL_INVALID_CMD \
-if (1) \
+do \
{ \
+ ccl_debug_hook (this_ic); \
ccl->status = CCL_STAT_INVALID_CMD; \
goto ccl_error_handler; \
} \
-else
+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. */
if (bytes == 1) \
{ \
*dst++ = (ch); \
- if ((ch) >= 0x80 && (ch) < 0xA0) \
+ if (extra_bytes && (ch) >= 0x80 && (ch) < 0xA0) \
/* We may have to convert this eight-bit char to \
multibyte form later. */ \
extra_bytes++; \
} \
else if (ccl->last_block) \
{ \
- ic = ccl->eof_ic; \
+ REG = -1; \
+ ic = eof_ic; \
goto ccl_repeat; \
} \
else \
#ifdef CCL_DEBUG
#define CCL_DEBUG_BACKTRACE_LEN 256
-int ccl_backtrace_table[CCL_BACKTRACE_TABLE];
+int ccl_backtrace_table[CCL_DEBUG_BACKTRACE_LEN];
int ccl_backtrace_idx;
+
+int
+ccl_debug_hook (int ic)
+{
+ return ic;
+}
+
#endif
struct ccl_prog_stack
{
Lisp_Object *ccl_prog; /* Pointer to an array of CCL code. */
int ic; /* Instruction Counter. */
+ int eof_ic; /* Instruction Counter to jump on EOF. */
};
-/* For the moment, we only support depth 256 of stack. */
+/* For the moment, we only support depth 256 of stack. */
static struct ccl_prog_stack ccl_prog_stack_struct[256];
int
each of them will be converted to multibyte form of 2-byte
sequence. For that conversion, we remember how many more bytes
we must keep in DESTINATION in this variable. */
- int extra_bytes = 0;
+ int extra_bytes = ccl->eight_bit_control;
+ int eof_ic = ccl->eof_ic;
+ int eof_hit = 0;
- if (ic >= ccl->eof_ic)
+ if (ic >= eof_ic)
ic = CCL_HEADER_MAIN;
if (ccl->buf_magnification == 0) /* We can't produce any bytes. */
if (stack_idx >= 256
|| prog_id < 0
- || prog_id >= XVECTOR (Vccl_program_table)->size
- || (slot = XVECTOR (Vccl_program_table)->contents[prog_id],
- !VECTORP (slot))
- || !VECTORP (XVECTOR (slot)->contents[1]))
+ || prog_id >= ASIZE (Vccl_program_table)
+ || (slot = AREF (Vccl_program_table, prog_id), !VECTORP (slot))
+ || !VECTORP (AREF (slot, 1)))
{
if (stack_idx > 0)
{
ccl_prog = ccl_prog_stack_struct[0].ccl_prog;
ic = ccl_prog_stack_struct[0].ic;
+ eof_ic = ccl_prog_stack_struct[0].eof_ic;
}
CCL_INVALID_CMD;
}
-
+
ccl_prog_stack_struct[stack_idx].ccl_prog = ccl_prog;
ccl_prog_stack_struct[stack_idx].ic = ic;
+ ccl_prog_stack_struct[stack_idx].eof_ic = eof_ic;
stack_idx++;
- ccl_prog = XVECTOR (XVECTOR (slot)->contents[1])->contents;
+ ccl_prog = XVECTOR (AREF (slot, 1))->contents;
ic = CCL_HEADER_MAIN;
+ eof_ic = XFASTINT (ccl_prog[CCL_HEADER_EOF]);
}
break;
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)
case CCL_MOD: reg[rrr] = i % j; break;
case CCL_AND: reg[rrr] = i & j; break;
case CCL_OR: reg[rrr] = i | j; break;
- case CCL_XOR: reg[rrr] = i ^ j;; break;
+ case CCL_XOR: reg[rrr] = i ^ j; break;
case CCL_LSH: reg[rrr] = i << j; break;
case CCL_RSH: reg[rrr] = i >> j; break;
case CCL_LSH8: reg[rrr] = (i << 8) | j; break;
src++;
goto ccl_read_multibyte_character_suspend;
}
-
+
if (!ccl->multibyte)
{
int bytes;
i = *src++;
if (i == '\n' && ccl->eol_type != CODING_EOL_LF)
{
- /* We are encoding. */
+ /* We are encoding. */
if (ccl->eol_type == CODING_EOL_CRLF)
{
if (ccl->cr_consumed)
src--;
if (ccl->last_block)
{
- ic = ccl->eof_ic;
+ ic = eof_ic;
+ eof_hit = 1;
goto ccl_repeat;
}
else
SPLIT_CHAR (op, reg[RRR], i, j);
if (j != -1)
i = (i << 7) | j;
-
+
reg[rrr] = i;
break;
SPLIT_CHAR (op, reg[RRR], i, j);
if (j != -1)
i = (i << 7) | j;
-
+
reg[rrr] = i;
break;
+ case CCL_LookupIntConstTbl:
+ op = XINT (ccl_prog[ic]); /* table */
+ ic++;
+ {
+ struct Lisp_Hash_Table *h = GET_HASH_TABLE (op);
+
+ op = hash_lookup (h, make_number (reg[RRR]), NULL);
+ if (op >= 0)
+ {
+ Lisp_Object opl;
+ opl = HASH_VALUE (h, op);
+ if (!CHAR_VALID_P (XINT (opl), 0))
+ CCL_INVALID_CMD;
+ SPLIT_CHAR (XINT (opl), reg[RRR], i, j);
+ if (j != -1)
+ i = (i << 7) | j;
+ reg[rrr] = i;
+ reg[7] = 1; /* r7 true for success */
+ }
+ else
+ reg[7] = 0;
+ }
+ break;
+
+ case CCL_LookupCharConstTbl:
+ op = XINT (ccl_prog[ic]); /* table */
+ ic++;
+ CCL_MAKE_CHAR (reg[RRR], reg[rrr], i);
+ {
+ struct Lisp_Hash_Table *h = GET_HASH_TABLE (op);
+
+ op = hash_lookup (h, make_number (i), NULL);
+ if (op >= 0)
+ {
+ Lisp_Object opl;
+ opl = HASH_VALUE (h, op);
+ if (!INTEGERP (opl))
+ CCL_INVALID_CMD;
+ reg[RRR] = XINT (opl);
+ reg[7] = 1; /* r7 true for success */
+ }
+ else
+ reg[7] = 0;
+ }
+ break;
+
case CCL_IterateMultipleMap:
{
Lisp_Object map, content, attrib, value;
for (;i < j;i++)
{
- size = XVECTOR (Vcode_conversion_map_vector)->size;
+ size = ASIZE (Vcode_conversion_map_vector);
point = XINT (ccl_prog[ic++]);
if (point >= size) continue;
- map =
- XVECTOR (Vcode_conversion_map_vector)->contents[point];
+ map = AREF (Vcode_conversion_map_vector, point);
/* Check map varidity. */
if (!CONSP (map)) continue;
map = XCDR (map);
if (!VECTORP (map)) continue;
- size = XVECTOR (map)->size;
+ size = ASIZE (map);
if (size <= 1) continue;
- content = XVECTOR (map)->contents[0];
+ content = AREF (map, 0);
/* check map type,
[STARTPOINT VAL1 VAL2 ...] or
point = XUINT (content);
point = op - point + 1;
if (!((point >= 1) && (point < size))) continue;
- content = XVECTOR (map)->contents[point];
+ content = AREF (map, point);
}
else if (EQ (content, Qt))
{
if (size != 4) continue;
- if ((op >= XUINT (XVECTOR (map)->contents[2]))
- && (op < XUINT (XVECTOR (map)->contents[3])))
- content = XVECTOR (map)->contents[1];
+ if ((op >= XUINT (AREF (map, 2)))
+ && (op < XUINT (AREF (map, 3))))
+ content = AREF (map, 1);
else
continue;
}
- else
+ else
continue;
if (NILP (content))
ic = fin_ic;
}
break;
-
+
case CCL_MapMultiple:
{
Lisp_Object map, content, attrib, value;
break;
}
}
- map_vector_size = XVECTOR (Vcode_conversion_map_vector)->size;
-
+ map_vector_size = ASIZE (Vcode_conversion_map_vector);
+
do {
for (;map_set_rest_length > 0;i++, ic++, map_set_rest_length--)
{
}
if (point >= map_vector_size) continue;
- map = (XVECTOR (Vcode_conversion_map_vector)
- ->contents[point]);
+ map = AREF (Vcode_conversion_map_vector, point);
/* Check map varidity. */
if (!CONSP (map)) continue;
map = XCDR (map);
if (!VECTORP (map)) continue;
- size = XVECTOR (map)->size;
+ size = ASIZE (map);
if (size <= 1) continue;
- content = XVECTOR (map)->contents[0];
+ content = AREF (map, 0);
/* check map type,
[STARTPOINT VAL1 VAL2 ...] or
point = XUINT (content);
point = op - point + 1;
if (!((point >= 1) && (point < size))) continue;
- content = XVECTOR (map)->contents[point];
+ content = AREF (map, point);
}
else if (EQ (content, Qt))
{
if (size != 4) continue;
- if ((op >= XUINT (XVECTOR (map)->contents[2])) &&
- (op < XUINT (XVECTOR (map)->contents[3])))
- content = XVECTOR (map)->contents[1];
+ if ((op >= XUINT (AREF (map, 2))) &&
+ (op < XUINT (AREF (map, 3))))
+ content = AREF (map, 1);
else
continue;
}
- else
+ else
continue;
if (NILP (content))
int size, point;
j = XINT (ccl_prog[ic++]); /* map_id */
op = reg[rrr];
- if (j >= XVECTOR (Vcode_conversion_map_vector)->size)
+ if (j >= ASIZE (Vcode_conversion_map_vector))
{
reg[RRR] = -1;
break;
}
- map = XVECTOR (Vcode_conversion_map_vector)->contents[j];
+ map = AREF (Vcode_conversion_map_vector, j);
if (!CONSP (map))
{
reg[RRR] = -1;
reg[RRR] = -1;
break;
}
- size = XVECTOR (map)->size;
- point = XUINT (XVECTOR (map)->contents[0]);
+ size = ASIZE (map);
+ point = XUINT (AREF (map, 0));
point = op - point + 1;
reg[RRR] = 0;
if ((size <= 1) ||
else
{
reg[RRR] = 0;
- content = XVECTOR (map)->contents[point];
+ content = AREF (map, point);
if (NILP (content))
reg[RRR] = -1;
else if (NUMBERP (content))
}
}
break;
-
+
default:
CCL_INVALID_CMD;
}
break;
default:
- sprintf(msg, "\nCCL: Unknown error type (%d).", ccl->status);
+ sprintf(msg, "\nCCL: Unknown error type (%d)", ccl->status);
}
msglen = strlen (msg);
bcopy (msg, dst, msglen);
dst += msglen;
}
-
+
if (ccl->status == CCL_STAT_INVALID_CMD)
{
#if 0 /* If the remaining bytes contain 0x80..0x9F, copying them
ccl->ic = ic;
ccl->stack_idx = stack_idx;
ccl->prog = ccl_prog;
- ccl->eight_bit_control = (extra_bytes > 0);
+ ccl->eight_bit_control = (extra_bytes > 1);
if (consumed)
*consumed = src - source;
return (dst ? dst - destination : 0);
Lisp_Object result, contents, val;
result = ccl;
- veclen = XVECTOR (result)->size;
+ veclen = ASIZE (result);
for (i = 0; i < veclen; i++)
{
- contents = XVECTOR (result)->contents[i];
+ contents = AREF (result, i);
if (INTEGERP (contents))
continue;
else if (CONSP (contents)
val = Fget (XCAR (contents), XCDR (contents));
if (NATNUMP (val))
- XVECTOR (result)->contents[i] = val;
+ AREF (result, i) = val;
else
unresolved = 1;
continue;
val = Fget (contents, Qtranslation_table_id);
if (NATNUMP (val))
- XVECTOR (result)->contents[i] = val;
+ AREF (result, i) = val;
else
{
val = Fget (contents, Qcode_conversion_map_id);
if (NATNUMP (val))
- XVECTOR (result)->contents[i] = val;
+ AREF (result, i) = val;
else
{
val = Fget (contents, Qccl_program_idx);
if (NATNUMP (val))
- XVECTOR (result)->contents[i] = val;
+ AREF (result, i) = val;
else
unresolved = 1;
}
symbols, return Qnil. */
static Lisp_Object
-ccl_get_compiled_code (ccl_prog)
+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))
val = Fget (ccl_prog, Qccl_program_idx);
if (! NATNUMP (val)
- || XINT (val) >= XVECTOR (Vccl_program_table)->size)
+ || XINT (val) >= ASIZE (Vccl_program_table))
return Qnil;
- slot = XVECTOR (Vccl_program_table)->contents[XINT (val)];
+ slot = AREF (Vccl_program_table, XINT (val));
if (! VECTORP (slot)
- || XVECTOR (slot)->size != 3
- || ! VECTORP (XVECTOR (slot)->contents[1]))
+ || ASIZE (slot) != 4
+ || ! VECTORP (AREF (slot, 1)))
return Qnil;
- if (NILP (XVECTOR (slot)->contents[2]))
+ *idx = XINT (val);
+ if (NILP (AREF (slot, 2)))
{
- val = resolve_symbol_ccl_program (XVECTOR (slot)->contents[1]);
+ val = resolve_symbol_ccl_program (AREF (slot, 1));
if (! VECTORP (val))
return Qnil;
- XVECTOR (slot)->contents[1] = val;
- XVECTOR (slot)->contents[2] = Qt;
+ AREF (slot, 1) = val;
+ AREF (slot, 2) = Qt;
}
- return XVECTOR (slot)->contents[1];
+ return AREF (slot, 1);
}
/* Setup fields of the structure pointed by CCL appropriately for the
{
struct Lisp_Vector *vp;
- ccl_prog = ccl_get_compiled_code (ccl_prog);
+ ccl_prog = ccl_get_compiled_code (ccl_prog, &ccl->idx);
if (! VECTORP (ccl_prog))
return -1;
vp = XVECTOR (ccl_prog);
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;
for (i = 0; i < 8; i++)
ccl->stack_idx = 0;
ccl->eol_type = CODING_EOL_LF;
ccl->suppress_error = 0;
+ ccl->eight_bit_control = 0;
+ return 0;
+}
+
+
+/* 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;
}
-#ifdef emacs
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.
val = Fget (object, Qccl_program_idx);
return ((! NATNUMP (val)
- || XINT (val) >= XVECTOR (Vccl_program_table)->size)
+ || XINT (val) >= ASIZE (Vccl_program_table))
? Qnil : Qt);
}
error ("Invalid CCL program");
CHECK_VECTOR (reg);
- if (XVECTOR (reg)->size != 8)
+ if (ASIZE (reg) != 8)
error ("Length of vector REGISTERS is not 8");
for (i = 0; i < 8; i++)
- ccl.reg[i] = (INTEGERP (XVECTOR (reg)->contents[i])
- ? XINT (XVECTOR (reg)->contents[i])
+ ccl.reg[i] = (INTEGERP (AREF (reg, i))
+ ? XINT (AREF (reg, i))
: 0);
ccl_driver (&ccl, (unsigned char *)0, (unsigned char *)0, 0, 0, (int *)0);
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;
}
3, 5, 0,
doc: /* Execute CCL-PROGRAM with initial STATUS on STRING.
-CCL-PROGRAM is a symbol registered by register-ccl-program,
+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).
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. */)
+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;
{
error ("Invalid CCL program");
CHECK_VECTOR (status);
- if (XVECTOR (status)->size != 9)
+ if (ASIZE (status) != 9)
error ("Length of vector STATUS is not 9");
CHECK_STRING (str);
for (i = 0; i < 8; i++)
{
- if (NILP (XVECTOR (status)->contents[i]))
- XSETINT (XVECTOR (status)->contents[i], 0);
- if (INTEGERP (XVECTOR (status)->contents[i]))
- ccl.reg[i] = XINT (XVECTOR (status)->contents[i]);
+ if (NILP (AREF (status, i)))
+ XSETINT (AREF (status, i), 0);
+ if (INTEGERP (AREF (status, i)))
+ ccl.reg[i] = XINT (AREF (status, i));
}
- if (INTEGERP (XVECTOR (status)->contents[i]))
+ if (INTEGERP (AREF (status, i)))
{
- i = XFASTINT (XVECTOR (status)->contents[8]);
+ i = XFASTINT (AREF (status, 8));
if (ccl.ic < i && i < ccl.size)
ccl.ic = i;
}
- outbufsize = STRING_BYTES (XSTRING (str)) * ccl.buf_magnification + 256;
+ outbufsize = SBYTES (str) * ccl.buf_magnification + 256;
outbuf = (char *) xmalloc (outbufsize);
ccl.last_block = NILP (contin);
ccl.multibyte = STRING_MULTIBYTE (str);
- produced = ccl_driver (&ccl, XSTRING (str)->data, outbuf,
- STRING_BYTES (XSTRING (str)), outbufsize, (int *) 0);
+ produced = ccl_driver (&ccl, SDATA (str), outbuf,
+ SBYTES (str), outbufsize, (int *) 0);
for (i = 0; i < 8; i++)
- XSET (XVECTOR (status)->contents[i], Lisp_Int, ccl.reg[i]);
- XSETINT (XVECTOR (status)->contents[8], ccl.ic);
+ ASET (status, i, make_number (ccl.reg[i]));
+ ASET (status, 8, make_number (ccl.ic));
UNGCPRO;
if (NILP (unibyte_p))
DEFUN ("register-ccl-program", Fregister_ccl_program, Sregister_ccl_program,
2, 2, 0,
- doc: /* Register CCL program CCL_PROG as NAME in `ccl-program-table'.
-CCL_PROG should be a compiled CCL program (vector), or nil.
+ doc: /* Register CCL program CCL-PROG as NAME in `ccl-program-table'.
+CCL-PROG should be a compiled CCL program (vector), or nil.
If it is nil, just reserve NAME as a CCL program name.
Return index number of the registered CCL program. */)
(name, ccl_prog)
Lisp_Object name, ccl_prog;
{
- int len = XVECTOR (Vccl_program_table)->size;
+ int len = ASIZE (Vccl_program_table);
int idx;
Lisp_Object resolved;
{
Lisp_Object slot;
- slot = XVECTOR (Vccl_program_table)->contents[idx];
+ slot = AREF (Vccl_program_table, idx);
if (!VECTORP (slot))
/* This is the first unsed slot. Register NAME here. */
break;
- if (EQ (name, XVECTOR (slot)->contents[0]))
+ if (EQ (name, AREF (slot, 0)))
{
/* Update this slot. */
- XVECTOR (slot)->contents[1] = ccl_prog;
- XVECTOR (slot)->contents[2] = resolved;
+ ASET (slot, 1, ccl_prog);
+ ASET (slot, 2, resolved);
+ ASET (slot, 3, Qt);
return make_number (idx);
}
}
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;
}
{
Lisp_Object elt;
- elt = Fmake_vector (make_number (3), Qnil);
- XVECTOR (elt)->contents[0] = name;
- XVECTOR (elt)->contents[1] = ccl_prog;
- XVECTOR (elt)->contents[2] = resolved;
- XVECTOR (Vccl_program_table)->contents[idx] = elt;
+ 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));
(symbol, map)
Lisp_Object symbol, map;
{
- int len = XVECTOR (Vcode_conversion_map_vector)->size;
+ int len = ASIZE (Vcode_conversion_map_vector);
int i;
Lisp_Object index;
CHECK_SYMBOL (symbol);
CHECK_VECTOR (map);
-
+
for (i = 0; i < len; i++)
{
- Lisp_Object slot = XVECTOR (Vcode_conversion_map_vector)->contents[i];
+ Lisp_Object slot = AREF (Vcode_conversion_map_vector, i);
if (!CONSP (slot))
break;
int j;
for (j = 0; j < len; j++)
- XVECTOR (new_vector)->contents[j]
- = XVECTOR (Vcode_conversion_map_vector)->contents[j];
+ AREF (new_vector, j)
+ = AREF (Vcode_conversion_map_vector, j);
Vcode_conversion_map_vector = new_vector;
}
index = make_number (i);
Fput (symbol, Qcode_conversion_map, map);
Fput (symbol, Qcode_conversion_map_id, index);
- XVECTOR (Vcode_conversion_map_vector)->contents[i] = Fcons (symbol, map);
+ AREF (Vcode_conversion_map_vector, i) = Fcons (symbol, map);
return index;
}
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_code_conversion_map);
}
-#endif /* emacs */
+/* arch-tag: bb9a37be-68ce-4576-8d3d-15d750e4a860
+ (do not change this comment) */