Commit 5232fa7b authored by Kenichi Handa's avatar Kenichi Handa
Browse files

(ccl_driver) <CCL_Call>: Now CCL program ID to call may be

stored in the following CCL code.  Adjusted for the change of
Vccl_program_table.
(resolve_symbol_ccl_program): Adjusted for the new style of
embedded symbols (SYMBOL . PROP) in CCL compiled code.   Return Qt
is resolving failed.
(ccl_get_compiled_code): New function.
(setup_ccl_program): Function type changed from `void' to `int'.
Resolve symbols in CCL_PROG.
(Fccl_program_p): New function.
(Fccl_execute): Get compiled CCL code by just calling
setup_ccl_program.
(Fccl_execute_on_string): Likewise.
(Fregister_ccl_program): Adjusted for the change of
Vccl_program_table.
parent e5e6d6fb
......@@ -59,7 +59,11 @@ Lisp_Object Qcode_conversion_map_id;
is an index for Vccl_protram_table. */
Lisp_Object Qccl_program_idx;
/* Vector of CCL program names vs corresponding program data. */
/* 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. */
Lisp_Object Vccl_program_table;
/* CCL (Code Conversion Language) is a simple language which has
......@@ -291,9 +295,14 @@ 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]
------------------------------
if (FFF)
call (cc..c)
IC++;
else
call (CC..C)
*/
......@@ -924,16 +933,27 @@ ccl_driver (ccl, source, destination, src_bytes, dst_bytes, consumed)
op = field1 >> 6;
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 >= XVECTOR (Vccl_program_table)->size
|| (slot = XVECTOR (Vccl_program_table)->contents[prog_id],
!VECTORP (slot))
|| !VECTORP (XVECTOR (slot)->contents[1]))
{
if (stack_idx > 0)
{
......@@ -946,7 +966,7 @@ ccl_driver (ccl, source, destination, src_bytes, dst_bytes, consumed)
ccl_prog_stack_struct[stack_idx].ccl_prog = ccl_prog;
ccl_prog_stack_struct[stack_idx].ic = ic;
stack_idx++;
ccl_prog = XVECTOR (XCONS (slot)->cdr)->contents;
ccl_prog = XVECTOR (XVECTOR (slot)->contents[1])->contents;
ic = CCL_HEADER_MAIN;
}
break;
......@@ -1619,90 +1639,185 @@ ccl_driver (ccl, source, destination, src_bytes, dst_bytes, consumed)
return (dst ? dst - destination : 0);
}
/* Setup fields of the structure pointed by CCL appropriately for the
execution of compiled CCL code in VEC (vector of integer).
If VEC is nil, we skip setting ups based on VEC. */
void
setup_ccl_program (ccl, vec)
struct ccl_program *ccl;
Lisp_Object vec;
{
int i;
if (VECTORP (vec))
{
struct Lisp_Vector *vp = XVECTOR (vec);
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]);
}
ccl->ic = CCL_HEADER_MAIN;
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;
}
/* 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 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. */
Lisp_Object
static Lisp_Object
resolve_symbol_ccl_program (ccl)
Lisp_Object ccl;
{
int i, veclen;
Lisp_Object result, contents, prop;
int i, veclen, unresolved = 0;
Lisp_Object result, contents, val;
result = ccl;
veclen = XVECTOR (result)->size;
/* Set CCL program's table ID */
for (i = 0; i < veclen; i++)
{
contents = XVECTOR (result)->contents[i];
if (SYMBOLP (contents))
if (INTEGERP (contents))
continue;
else if (CONSP (contents)
&& SYMBOLP (XCONS (contents)->car)
&& SYMBOLP (XCONS (contents)->cdr))
{
if (EQ(result, ccl))
/* 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);
prop = Fget (contents, Qtranslation_table_id);
if (NUMBERP (prop))
{
XVECTOR (result)->contents[i] = prop;
val = Fget (XCONS (contents)->car, XCONS (contents)->cdr);
if (NATNUMP (val))
XVECTOR (result)->contents[i] = val;
else
unresolved = 1;
continue;
}
prop = Fget (contents, Qcode_conversion_map_id);
if (NUMBERP (prop))
else if (SYMBOLP (contents))
{
XVECTOR (result)->contents[i] = prop;
continue;
}
prop = Fget (contents, Qccl_program_idx);
if (NUMBERP (prop))
/* 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))
XVECTOR (result)->contents[i] = val;
else
{
val = Fget (contents, Qcode_conversion_map_id);
if (NATNUMP (val))
XVECTOR (result)->contents[i] = val;
else
{
XVECTOR (result)->contents[i] = prop;
val = Fget (contents, Qccl_program_idx);
if (NATNUMP (val))
XVECTOR (result)->contents[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)
Lisp_Object ccl_prog;
{
Lisp_Object val, slot;
if (VECTORP (ccl_prog))
{
val = resolve_symbol_ccl_program (ccl_prog);
return (VECTORP (val) ? val : Qnil);
}
if (!SYMBOLP (ccl_prog))
return Qnil;
return result;
val = Fget (ccl_prog, Qccl_program_idx);
if (! NATNUMP (val)
|| XINT (val) >= XVECTOR (Vccl_program_table)->size)
return Qnil;
slot = XVECTOR (Vccl_program_table)->contents[XINT (val)];
if (! VECTORP (slot)
|| XVECTOR (slot)->size != 3
|| ! VECTORP (XVECTOR (slot)->contents[1]))
return Qnil;
if (NILP (XVECTOR (slot)->contents[2]))
{
val = resolve_symbol_ccl_program (XVECTOR (slot)->contents[1]);
if (! VECTORP (val))
return Qnil;
XVECTOR (slot)->contents[1] = val;
XVECTOR (slot)->contents[2] = Qt;
}
return XVECTOR (slot)->contents[1];
}
/* 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.
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 ccl_prog;
{
int i;
if (! NILP (ccl_prog))
{
struct Lisp_Vector *vp;
ccl_prog = ccl_get_compiled_code (ccl_prog);
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]);
}
ccl->ic = CCL_HEADER_MAIN;
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;
return 0;
}
#ifdef emacs
DEFUN ("ccl-program-p", Fccl_program_p, Sccl_program_p, 1, 1, 0,
"Return t if OBJECT is a CCL program name or a compiled CCL program code.")
(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) >= XVECTOR (Vccl_program_table)->size)
? Qnil : Qt);
}
DEFUN ("ccl-execute", Fccl_execute, Sccl_execute, 2, 2, 0,
"Execute CCL-PROGRAM with registers initialized by REGISTERS.\n\
\n\
CCL-PROGRAM is a symbol registered by register-ccl-program,\n\
CCL-PROGRAM is a CCL program name (symbol)\n\
or a compiled code generated by `ccl-compile' (for backward compatibility,\n\
in this case, the execution is slower).\n\
in this case, the overhead of the execution is bigger than the former case).\n\
No I/O commands should appear in CCL-PROGRAM.\n\
\n\
REGISTERS is a vector of [R0 R1 ... R7] where RN is an initial value\n\
......@@ -1715,27 +1830,14 @@ As side effect, each element of REGISTERS holds the value of\n\
{
struct ccl_program ccl;
int i;
Lisp_Object ccl_id;
if ((SYMBOLP (ccl_prog)) &&
(!NILP (ccl_id = Fget (ccl_prog, Qccl_program_idx))))
{
ccl_prog = XVECTOR (Vccl_program_table)->contents[XUINT (ccl_id)];
CHECK_LIST (ccl_prog, 0);
ccl_prog = XCONS (ccl_prog)->cdr;
CHECK_VECTOR (ccl_prog, 1);
}
else
{
CHECK_VECTOR (ccl_prog, 1);
ccl_prog = resolve_symbol_ccl_program (ccl_prog);
}
if (setup_ccl_program (&ccl, ccl_prog) < 0)
error ("Invalid CCL program");
CHECK_VECTOR (reg, 2);
CHECK_VECTOR (reg, 1);
if (XVECTOR (reg)->size != 8)
error ("Invalid length of vector REGISTERS");
error ("Length of vector REGISTERS is not 9");
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])
......@@ -1783,30 +1885,18 @@ is a unibyte string. By default it is a multibyte string.")
int i, produced;
int outbufsize;
char *outbuf;
struct gcpro gcpro1, gcpro2, gcpro3;
Lisp_Object ccl_id;
struct gcpro gcpro1, gcpro2;
if ((SYMBOLP (ccl_prog)) &&
(!NILP (ccl_id = Fget (ccl_prog, Qccl_program_idx))))
{
ccl_prog = XVECTOR (Vccl_program_table)->contents[XUINT (ccl_id)];
CHECK_LIST (ccl_prog, 0);
ccl_prog = XCONS (ccl_prog)->cdr;
CHECK_VECTOR (ccl_prog, 1);
}
else
{
CHECK_VECTOR (ccl_prog, 1);
ccl_prog = resolve_symbol_ccl_program (ccl_prog);
}
if (setup_ccl_program (&ccl, ccl_prog) < 0)
error ("Invalid CCL program");
CHECK_VECTOR (status, 1);
if (XVECTOR (status)->size != 9)
error ("Invalid length of vector STATUS");
error ("Length of vector STATUS is not 9");
CHECK_STRING (str, 2);
GCPRO3 (ccl_prog, status, str);
setup_ccl_program (&ccl, ccl_prog);
GCPRO2 (status, str);
for (i = 0; i < 8; i++)
{
if (NILP (XVECTOR (status)->contents[i]))
......@@ -1848,50 +1938,73 @@ 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\
"Register CCL program CCL_PROG as NAME in `ccl-program-table'.\n\
CCL_PROG should be a compiled CCL program (vector), or nil.\n\
If it is nil, just reserve NAME as a CCL program name.\n\
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 idx;
Lisp_Object resolved;
CHECK_SYMBOL (name, 0);
resolved = Qnil;
if (!NILP (ccl_prog))
{
CHECK_VECTOR (ccl_prog, 1);
ccl_prog = resolve_symbol_ccl_program (ccl_prog);
resolved = resolve_symbol_ccl_program (ccl_prog);
if (! NILP (resolved))
{
ccl_prog = resolved;
resolved = Qt;
}
}
for (i = 0; i < len; i++)
for (idx = 0; idx < len; idx++)
{
Lisp_Object slot = XVECTOR (Vccl_program_table)->contents[i];
Lisp_Object slot;
if (!CONSP (slot))
slot = XVECTOR (Vccl_program_table)->contents[idx];
if (!VECTORP (slot))
/* This is the first unsed slot. Register NAME here. */
break;
if (EQ (name, XCONS (slot)->car))
if (EQ (name, XVECTOR (slot)->contents[0]))
{
XCONS (slot)->cdr = ccl_prog;
return make_number (i);
/* Update this slot. */
XVECTOR (slot)->contents[1] = ccl_prog;
XVECTOR (slot)->contents[2] = resolved;
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];
Vccl_program_table = new_table;
}
XVECTOR (Vccl_program_table)->contents[i] = Fcons (name, ccl_prog);
Fput (name, Qccl_program_idx, make_number (i));
return make_number (i);
{
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;
}
Fput (name, Qccl_program_idx, make_number (idx));
return make_number (idx);
}
/* Register code conversion map.
......@@ -1989,6 +2102,7 @@ The code point in the font is set in CCL registers R1 and R2\n\
If the font is single-byte font, the register R2 is not used.");
Vfont_ccl_encoder_alist = Qnil;
defsubr (&Sccl_program_p);
defsubr (&Sccl_execute);
defsubr (&Sccl_execute_on_string);
defsubr (&Sregister_ccl_program);
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment