# HG changeset patch # User Kenichi Handa # Date 932990188 0 # Node ID 8b8e54912f5c5801bb498a55d3d5feef8334c709 # Parent 6f92f7a071c97e1e836f030048710d08f1da4a22 (ccl_driver) : 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. diff -r 6f92f7a071c9 -r 8b8e54912f5c src/ccl.c --- a/src/ccl.c Mon Jul 26 11:55:53 1999 +0000 +++ b/src/ccl.c Mon Jul 26 11:56:28 1999 +0000 @@ -59,7 +59,11 @@ 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,10 +295,15 @@ */ #define CCL_Call 0x13 /* Call the CCL program whose ID is - (CC..C). - 1:CCCCCCCCCCCCCCCCCCCC000XXXXX + CC..C or cc..c. + 1:CCCCCCCCCCCCCCCCCCCCFFFXXXXX + [2:00000000cccccccccccccccccccc] ------------------------------ - call (CC..C) + if (FFF) + call (cc..c) + IC++; + else + call (CC..C) */ #define CCL_WriteConstString 0x14 /* Write a constant or a string: @@ -924,16 +933,27 @@ 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_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,20 +1639,141 @@ return (dst ? dst - destination : 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. + + 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. */ + +static Lisp_Object +resolve_symbol_ccl_program (ccl) + Lisp_Object ccl; +{ + int i, veclen, unresolved = 0; + Lisp_Object result, contents, val; + + result = ccl; + veclen = XVECTOR (result)->size; + + for (i = 0; i < veclen; i++) + { + contents = XVECTOR (result)->contents[i]; + if (INTEGERP (contents)) + continue; + else if (CONSP (contents) + && SYMBOLP (XCONS (contents)->car) + && SYMBOLP (XCONS (contents)->cdr)) + { + /* 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 (XCONS (contents)->car, XCONS (contents)->cdr); + if (NATNUMP (val)) + XVECTOR (result)->contents[i] = val; + else + unresolved = 1; + continue; + } + else if (SYMBOLP (contents)) + { + /* 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 + { + 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; + + 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 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) + 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 vec; + Lisp_Object ccl_prog; { int i; - if (VECTORP (vec)) + if (! NILP (ccl_prog)) { - struct Lisp_Vector *vp = XVECTOR (vec); + 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]); @@ -1645,64 +1786,38 @@ ccl->private_state = 0; ccl->status = 0; ccl->stack_idx = 0; + return 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. */ - -Lisp_Object -resolve_symbol_ccl_program (ccl) - Lisp_Object ccl; -{ - int i, veclen; - Lisp_Object result, contents, prop; +#ifdef emacs - 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 (EQ(result, ccl)) - result = Fcopy_sequence (ccl); +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; - prop = Fget (contents, Qtranslation_table_id); - if (NUMBERP (prop)) - { - XVECTOR (result)->contents[i] = prop; - continue; - } - prop = Fget (contents, Qcode_conversion_map_id); - if (NUMBERP (prop)) - { - XVECTOR (result)->contents[i] = prop; - continue; - } - prop = Fget (contents, Qccl_program_idx); - if (NUMBERP (prop)) - { - XVECTOR (result)->contents[i] = prop; - continue; - } - } + if (VECTORP (object)) + { + val = resolve_symbol_ccl_program (object); + return (VECTORP (val) ? Qt : Qnil); } + if (!SYMBOLP (object)) + return Qnil; - return result; + val = Fget (object, Qccl_program_idx); + return ((! NATNUMP (val) + || XINT (val) >= XVECTOR (Vccl_program_table)->size) + ? Qnil : Qt); } - -#ifdef emacs - 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 @@ { struct ccl_program ccl; int i; - Lisp_Object ccl_id; + + if (setup_ccl_program (&ccl, ccl_prog) < 0) + error ("Invalid CCL program"); - 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); - } + CHECK_VECTOR (reg, 1); + if (XVECTOR (reg)->size != 8) + error ("Length of vector REGISTERS is not 9"); - CHECK_VECTOR (reg, 2); - if (XVECTOR (reg)->size != 8) - error ("Invalid length of vector REGISTERS"); - - 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 @@ 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 @@ 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); - } - - for (i = 0; i < len; i++) - { - Lisp_Object slot = XVECTOR (Vccl_program_table)->contents[i]; - - if (!CONSP (slot)) - break; - - if (EQ (name, XCONS (slot)->car)) + resolved = resolve_symbol_ccl_program (ccl_prog); + if (! NILP (resolved)) { - XCONS (slot)->cdr = ccl_prog; - return make_number (i); + ccl_prog = resolved; + resolved = Qt; } } - if (i == len) + for (idx = 0; idx < len; idx++) { - Lisp_Object new_table = Fmake_vector (make_number (len * 2), Qnil); + Lisp_Object slot; + + slot = XVECTOR (Vccl_program_table)->contents[idx]; + if (!VECTORP (slot)) + /* This is the first unsed slot. Register NAME here. */ + break; + + if (EQ (name, XVECTOR (slot)->contents[0])) + { + /* Update this slot. */ + XVECTOR (slot)->contents[1] = ccl_prog; + XVECTOR (slot)->contents[2] = resolved; + return make_number (idx); + } + } + + if (idx == len) + { + /* 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 @@ 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);