/* CCL (Code Conversion Language) interpreter.
- Copyright (C) 1995, 1997 Electrotechnical Laboratory, JAPAN.
- Copyright (C) 2001, 2002 Free Software Foundation, Inc.
- Licensed to the Free Software Foundation.
+ 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.
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. */
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
{ \
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)
/* 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 \
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) \
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. */
{
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 (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)
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)
{
- op = HASH_VALUE (h, op);
- if (!CHAR_VALID_P (op, 0))
+ Lisp_Object opl;
+ opl = HASH_VALUE (h, op);
+ if (!CHAR_VALID_P (XINT (opl), 0))
CCL_INVALID_CMD;
- SPLIT_CHAR (XINT (op), reg[RRR], i, j);
+ SPLIT_CHAR (XINT (opl), reg[RRR], i, j);
if (j != -1)
i = (i << 7) | j;
reg[rrr] = i;
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)
{
- op = HASH_VALUE (h, op);
- if (!INTEGERP (op))
+ Lisp_Object opl;
+ opl = HASH_VALUE (h, op);
+ if (!INTEGERP (opl))
CCL_INVALID_CMD;
- reg[RRR] = XINT (op);
+ reg[RRR] = XINT (opl);
reg[7] = 1; /* r7 true for success */
}
else
else
continue;
}
- else
+ else
continue;
if (NILP (content))
ic = fin_ic;
}
break;
-
+
case CCL_MapMultiple:
{
Lisp_Object map, content, attrib, value;
}
}
map_vector_size = ASIZE (Vcode_conversion_map_vector);
-
+
do {
for (;map_set_rest_length > 0;i++, ic++, map_set_rest_length--)
{
else
continue;
}
- else
+ else
continue;
if (NILP (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);
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))
return Qnil;
slot = AREF (Vccl_program_table, XINT (val));
if (! VECTORP (slot)
- || ASIZE (slot) != 3
+ || 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));
{
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.
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;
{
produced = ccl_driver (&ccl, SDATA (str), outbuf,
SBYTES (str), outbufsize, (int *) 0);
for (i = 0; i < 8; i++)
- XSET (AREF (status, i), Lisp_Int, ccl.reg[i]);
- XSETINT (AREF (status, 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)
if (EQ (name, AREF (slot, 0)))
{
/* Update this slot. */
- AREF (slot, 1) = ccl_prog;
- AREF (slot, 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++)
- AREF (new_table, j)
- = AREF (Vccl_program_table, 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);
- AREF (elt, 0) = name;
- AREF (elt, 1) = ccl_prog;
- AREF (elt, 2) = resolved;
- AREF (Vccl_program_table, 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));
CHECK_SYMBOL (symbol);
CHECK_VECTOR (map);
-
+
for (i = 0; i < len; i++)
{
Lisp_Object slot = AREF (Vcode_conversion_map_vector, i);
defsubr (&Sregister_code_conversion_map);
}
-#endif /* emacs */
+/* arch-tag: bb9a37be-68ce-4576-8d3d-15d750e4a860
+ (do not change this comment) */