emacs: src/ccl.c comparison

comparison src/ccl.c @ 25066:8b8e54912f5c

(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.

author	Kenichi Handa <handa@m17n.org>
date	Mon, 26 Jul 1999 11:56:28 +0000
parents	7b170d2184a4
children	0a7261c1d487

comparison

equal deleted inserted replaced

-:6f92f7a071c9
+:8b8e54912f5c
 /* Symbols of ccl program have this property, a value of the property
 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
 operations on one input buffer, one output buffer, and 7 registers.
 The syntax of CCL is described in `ccl.el'.  Emacs Lisp function
 					------------------------------
 					write (reg[RRR] OPERATION reg[Rrr]);
 					*/
 #define CCL_Call		0x13 /* Call the CCL program whose ID is
-					(CC..C).
+					CC..C or cc..c.
-					1:CCCCCCCCCCCCCCCCCCCC000XXXXX
+					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:
 					1:CCCCCCCCCCCCCCCCCCCCrrrXXXXX
 					[2:0000STRIN[0]STRIN[1]STRIN[2]]
 	  i = reg[RRR];
 	  j = reg[Rrr];
 	  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
+		|| prog_id < 0
-		|| field1 >= XVECTOR (Vccl_program_table)->size
+		|| prog_id >= XVECTOR (Vccl_program_table)->size
-		|| (slot = XVECTOR (Vccl_program_table)->contents[field1],
+		|| (slot = XVECTOR (Vccl_program_table)->contents[prog_id],
-		    !CONSP (slot))
+		    !VECTORP (slot))
-		|| !VECTORP (XCONS (slot)->cdr))
+		|| !VECTORP (XVECTOR (slot)->contents[1]))
 	      {
 		if (stack_idx > 0)
 		  {
 		    ccl_prog = ccl_prog_stack_struct[0].ccl_prog;
 		    ic = ccl_prog_stack_struct[0].ic;
 	      }
 	    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;
 	case CCL_WriteConstString: /* CCCCCCCCCCCCCCCCCCCCrrrXXXXX */
 ccl->prog = ccl_prog;
 if (consumed) *consumed = src - source;
 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).
+execution of CCL program CCL_PROG.  CCL_PROG is the name (symbol)
-If VEC is nil, we skip setting ups based on VEC.  */
+of the CCL program or the already compiled code (vector).
-void
+Return 0 if we succeed this setup, else return -1.
-setup_ccl_program (ccl, vec)
+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]);
 ccl->buf_magnification = XINT (vp->contents[CCL_HEADER_BUF_MAG]);
 }
 ccl->reg[i] = 0;
 ccl->last_block = 0;
 ccl->private_state = 0;
 ccl->status = 0;
 ccl->stack_idx = 0;
+return 0;
 }
-/* Resolve symbols in the specified CCL code (Lisp vector).  This
+#ifdef emacs
-function converts symbols of code conversion maps and character
-translation tables embeded in the CCL code into their ID numbers.  */
+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.")
-Lisp_Object
+(object)
-resolve_symbol_ccl_program (ccl)
+Lisp_Object object;
-Lisp_Object ccl;
 {
-int i, veclen;
+Lisp_Object val;
-Lisp_Object result, contents, prop;
+if (VECTORP (object))
-result = ccl;
-veclen = XVECTOR (result)->size;
-/* Set CCL program's table ID */
-for (i = 0; i < veclen; i++)
 {
-contents = XVECTOR (result)->contents[i];
+val = resolve_symbol_ccl_program (object);
-if (SYMBOLP (contents))
+return (VECTORP (val) ? Qt : Qnil);
-	{
-	  if (EQ(result, ccl))
-	    result = Fcopy_sequence (ccl);
-	  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 (!SYMBOLP (object))
-return result;
+return Qnil;
+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\
 of Nth register.\n\
 \n\
 (ccl_prog, reg)
 Lisp_Object ccl_prog, reg;
 {
 struct ccl_program ccl;
 int i;
-Lisp_Object ccl_id;
+if (setup_ccl_program (&ccl, ccl_prog) < 0)
-if ((SYMBOLP (ccl_prog)) &&
+error ("Invalid CCL program");
-(!NILP (ccl_id = Fget (ccl_prog, Qccl_program_idx))))
-{
+CHECK_VECTOR (reg, 1);
-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, 2);
 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])
 		  : 0);
 Lisp_Object val;
 struct ccl_program ccl;
 int i, produced;
 int outbufsize;
 char *outbuf;
-struct gcpro gcpro1, gcpro2, gcpro3;
+struct gcpro gcpro1, gcpro2;
-Lisp_Object ccl_id;
+if (setup_ccl_program (&ccl, ccl_prog) < 0)
-if ((SYMBOLP (ccl_prog)) &&
+error ("Invalid CCL program");
-(!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 (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);
+GCPRO2 (status, str);
-setup_ccl_program (&ccl, ccl_prog);
 for (i = 0; i < 8; i++)
 {
 if (NILP (XVECTOR (status)->contents[i]))
 	XSETINT (XVECTOR (status)->contents[i], 0);
 if (INTEGERP (XVECTOR (status)->contents[i]))
 return val;
 }
 DEFUN ("register-ccl-program", Fregister_ccl_program, Sregister_ccl_program,
 2, 2, 0,
-"Register CCL program PROGRAM of NAME in `ccl-program-table'.\n\
+"Register CCL program CCL_PROG as NAME in `ccl-program-table'.\n\
-PROGRAM should be a compiled code of CCL program, or nil.\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))
-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))
 	{
-	  XCONS (slot)->cdr = ccl_prog;
+	  ccl_prog = resolved;
-	  return make_number (i);
+	  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));
+Lisp_Object elt;
-return make_number (i);
+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.
 A code conversion map consists of numbers, Qt, Qnil, and Qlambda.
 The first element is start code point.
 The code point in the font is set in CCL registers R1 and R2\n\
 when the execution terminated.\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);
 defsubr (&Sregister_code_conversion_map);
 }

Mercurial > emacs

comparison src/ccl.c @ 25066:8b8e54912f5c