changeset 20722:cce3ef478c64

(Vccl_translation_table_vector, Qccl_program, Qccl_translation_table, Qccl_translation_table_id): New variables. append new symbols. Qccl_translation_table and Qccl_translation_table_id. (CCL_Call): Fix the comment. (CCL_ReadMultibyteCharacter, CCL_WriteMultibyteCharacter, CCL_UnifyCharacter, CCL_UnifyCharacterConstTbl, CCL_IterateMultipleMap, CCL_TranslateMultipleMap): New macros for CCL Commands. (EXCMD): New macro. (ccl_driver): New case lable `CCL_Extention'. (setup_ccl_program): Initialize the member `private_state' of CCL. (Fregister_ccl_program): Delete unused variable IDX. (Fregister_ccl_translation_table): New function. (syms_of_ccl): Intern and staticpro Qccl_program, Qccl_translation_table, and Qccl_translation_table_id. Declare `ccl-translation-table-vector' as a Lisp variable. Declare register-ccl-translation-table as a Lisp function.

--- a/src/ccl.c	Thu Jan 22 01:26:45 1998 +0000
+++ b/src/ccl.c	Thu Jan 22 01:26:45 1998 +0000
@@ -35,9 +35,21 @@
 
 #endif /* not emacs */
 
+/* Where is stored translation tables for CCL program.  */
+Lisp_Object Vccl_translation_table_vector;
+
 /* Alist of fontname patterns vs corresponding CCL program.  */
 Lisp_Object Vfont_ccl_encoder_alist;
 
+/* This symbol is property which assocate with ccl program vector. e.g.
+   (get 'ccl-big5-encoder 'ccl-program) returns ccl program vector */
+Lisp_Object Qccl_program;
+
+/* These symbol is properties whish associate with ccl translation table and its id
+   respectively.  */
+Lisp_Object Qccl_translation_table;
+Lisp_Object Qccl_translation_table_id;
+
 /* Vector of CCL program names vs corresponding program data.  */
 Lisp_Object Vccl_program_table;
 
@@ -269,7 +281,8 @@
 					write (reg[RRR] OPERATION reg[Rrr]);
 					*/
 
-#define CCL_Call		0x13 /* Write a constant:
+#define CCL_Call		0x13 /* Call the CCL program whose ID is
+					(CC..C).
 					1:CCCCCCCCCCCCCCCCCCCC000XXXXX
 					------------------------------
 					call (CC..C)
@@ -399,6 +412,129 @@
 					extended_command (rrr,RRR,Rrr,ARGS)
 				      */
 
+/* 
+   From here, Extended CCL Instruction.
+   Bit length of extended command is 14.
+   Therefore the instruction code begins from 0 to 16384(0x3fff).
+ */
+
+#define CCL_ReadMultibyteCharacter  0x00 /* Read Multibyte Character
+					    1:ExtendedCOMMNDRrrRRRrrrXXXXX
+
+					    Read a multibyte characeter.
+					    A code point is stored
+					    into rrr register. 
+					    A charset ID is stored
+					    into RRR register.
+					 */
+#define CCL_WriteMultibyteCharacter 0x01 /* Write Multibyte Character
+					    1:ExtendedCOMMNDRrrRRRrrrXXXXX
+
+					    Write a multibyte character.
+					    Write a character whose code point
+					    is in rrr register, and its charset ID
+					    is in RRR charset.
+					 */
+#define CCL_UnifyCharacter          0x02 /* Unify Multibyte Character
+					    1:ExtendedCOMMNDRrrRRRrrrXXXXX
+
+					    Unify a character where its code point
+					    is in rrr register, and its charset ID
+					    is in RRR register with the table of
+					    the unification table ID
+					    in Rrr register.
+
+					    Return a unified character where its
+					    code point is in rrr register, and its
+					    charset ID is in RRR register.
+					 */
+#define CCL_UnifyCharacterConstTbl  0x03 /* Unify Multibyte Character
+					    1:ExtendedCOMMNDRrrRRRrrrXXXXX
+					    2:ARGUMENT(Unification Table ID)
+
+					    Unify a character where its code point
+					    is in rrr register, and its charset ID
+					    is in RRR register with the table of
+					    the unification table ID
+					    in 2nd argument.
+
+					    Return a unified character where its
+					    code point is in rrr register, and its
+					    charset ID is in RRR register.
+					 */
+#define CCL_IterateMultipleMap      0x10 /* Iterate Multiple Map
+					    1:ExtendedCOMMNDXXXRRRrrrXXXXX
+					    2:NUMBER of TABLES
+					    3:TABLE-ID1
+					    4:TABLE-ID2
+					    ...
+					    
+					    iterate to lookup tables from a number
+					    until finding a value.
+
+					    Each table consists of a vector
+					    whose element is number or
+					    nil or t or lambda.
+					    If the element is nil,
+					    its table is neglected.
+					    In the case of t or lambda,
+					    return the original value.
+					    
+					  */
+#define CCL_TranslateMultipleMap    0x11 /* Translate Multiple Map
+					    1:ExtendedCOMMNDXXXRRRrrrXXXXX
+					    2:NUMBER of TABLE-IDs and SEPARATERs
+					    (i.e. m1+m2+m3+...mk+k-1)
+					    3:TABLE-ID 1,1
+					    4:TABLE-ID 1,2
+					    ...
+					    m1+2:TABLE-ID 1,m1
+					    m1+3: -1     (SEPARATOR)
+					    m1+4:TABLE-ID 2,1
+					    ...
+					    m1+m2+4:TABLE-ID 2,m2
+					    m1+m2+5: -1
+					    ...
+					    m1+m2+...+mk+k+1:TABLE-ID k,mk
+					    
+					    Translate the code point in
+					    rrr register by tables.
+					    Translation starts from the table
+					    where RRR register points out.
+
+					    We translate the given value
+					    from the tables which are separated
+					    by -1.
+					    When each translation is failed to find
+					    any values, we regard the traslation
+					    as identity.
+
+					    We iterate to traslate by using each
+					    table set(tables separated by -1)
+					    until lookup the last table except
+					    lookup lambda.
+
+					    Each table consists of a vector
+					    whose element is number
+					    or nil or t or lambda.
+					    If the element is nil,
+					    it is neglected and use the next table.
+					    In the case of t,
+					    it is translated to the original value.
+					    In the case of lambda,
+					    it cease the translation and return the
+					    current value.
+
+					  */
+#define CCL_TranslateSingleMap       0x12 /* Translate Single Map
+					    1:ExtendedCOMMNDXXXRRRrrrXXXXX
+					    2:TABLE-ID
+					    
+					    Translate a number in rrr register.
+					    If it is not found any translation,
+					    set RRR register -1 but rrr register
+					    is not changed.
+					  */
 
 /* CCL arithmetic/logical operators. */
 #define CCL_PLUS	0x00	/* X = Y + Z */
@@ -426,14 +562,6 @@
 #define CCL_DECODE_SJIS 0x17	/* X = HIGHER_BYTE (DE-SJIS (Y, Z))
 				   r[7] = LOWER_BYTE (DE-SJIS (Y, Z)) */
 
-/* Macros for exit status of CCL program.  */
-#define CCL_STAT_SUCCESS	0 /* Terminated successfully.  */
-#define CCL_STAT_SUSPEND	1 /* Terminated because of empty input
-				     buffer or full output buffer.  */
-#define CCL_STAT_INVALID_CMD	2 /* Terminated because of invalid
-				     command.  */
-#define CCL_STAT_QUIT		3 /* Terminated because of quit.  */
-
 /* Terminate CCL program successfully.  */
 #define CCL_SUCCESS		   	\
   do {				   	\
@@ -445,11 +573,11 @@
 /* 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		 	\
-  do {				 	\
-    ic--;			 	\
-    ccl->status = CCL_STAT_SUSPEND;	\
-    goto ccl_finish;		 	\
+#define CCL_SUSPEND(stat)	\
+  do {				\
+    ic--;			\
+    ccl->status = stat;		\
+    goto ccl_finish;		\
   } while (0)
 
 /* Terminate CCL program because of invalid command.  Should not occur
@@ -462,22 +590,22 @@
 
 /* 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)		      	\
-  do {					      	\
-    if (!dst)				      	\
-      CCL_INVALID_CMD;			      	\
-    else				      	\
-      {					      	\
-	unsigned char work[4], *str;	      	\
-	int len = CHAR_STRING (ch, work, str);	\
-	if (dst + len <= dst_end)	      	\
-	  {				      	\
-	    bcopy (str, dst, len);	      	\
-	    dst += len;			      	\
-	  }				      	\
-	else				      	\
-	  CCL_SUSPEND;			      	\
-      }					      	\
+#define CCL_WRITE_CHAR(ch)				\
+  do {							\
+    if (!dst)						\
+      CCL_INVALID_CMD;					\
+    else						\
+      {							\
+	unsigned char work[4], *str;			\
+	int len = CHAR_STRING (ch, work, str);		\
+	if (dst + len <= (dst_bytes ? dst_end : src))	\
+	  {						\
+	    bcopy (str, dst, len);			\
+	    dst += len;					\
+	  }						\
+	else						\
+	  CCL_SUSPEND (CCL_STAT_SUSPEND_BY_DST);	\
+      }							\
   } while (0)
 
 /* Write a string at ccl_prog[IC] of length LEN to the current output
@@ -486,28 +614,28 @@
   do {							\
     if (!dst)						\
       CCL_INVALID_CMD;					\
-    else if (dst + len <= dst_end)			\
+    else if (dst + len <= (dst_bytes ? dst_end : src))	\
       for (i = 0; i < len; i++)				\
 	*dst++ = ((XFASTINT (ccl_prog[ic + (i / 3)]))	\
 		  >> ((2 - (i % 3)) * 8)) & 0xFF;	\
     else						\
-      CCL_SUSPEND;					\
+      CCL_SUSPEND (CCL_STAT_SUSPEND_BY_DST);		\
   } while (0)
 
 /* Read one byte from the current input buffer into Rth register.  */
-#define CCL_READ_CHAR(r)	\
-  do {				\
-    if (!src)			\
-      CCL_INVALID_CMD;		\
-    else if (src < src_end)	\
-      r = *src++;		\
-    else if (ccl->last_block)	\
-      {				\
-        ic = ccl->eof_ic;	\
-        goto ccl_finish;	\
-      }				\
-    else			\
-      CCL_SUSPEND;		\
+#define CCL_READ_CHAR(r)			\
+  do {						\
+    if (!src)					\
+      CCL_INVALID_CMD;				\
+    else if (src < src_end)			\
+      r = *src++;				\
+    else if (ccl->last_block)			\
+      {						\
+        ic = ccl->eof_ic;			\
+        goto ccl_finish;			\
+      }						\
+    else					\
+      CCL_SUSPEND (CCL_STAT_SUSPEND_BY_SRC);	\
   } while (0)
 
 
@@ -584,6 +712,7 @@
 #define RRR (field1 & 7)
 #define Rrr ((field1 >> 3) & 7)
 #define ADDR field1
+#define EXCMD (field1 >> 6)
 
       switch (code & 0x1F)
 	{
@@ -881,6 +1010,387 @@
 	    ic = jump_address;
 	  break;
 
+	case CCL_Extention:
+	  switch (EXCMD)
+	    {
+	    case CCL_ReadMultibyteCharacter:
+	      if (!src)
+		CCL_INVALID_CMD;
+	      do {
+		if (src >= src_end)
+		  goto ccl_read_multibyte_character_suspend;
+	      
+		i = *src++;
+		if (i == LEADING_CODE_COMPOSITION)
+		  {
+		    if (src >= src_end)
+		      goto ccl_read_multibyte_character_suspend;
+		    if (*src == 0xFF)
+		      {
+			ccl->private_state = COMPOSING_WITH_RULE_HEAD;
+			src++;
+		      }
+		    else
+		      ccl->private_state = COMPOSING_NO_RULE_HEAD;
+		  }
+		if (ccl->private_state != 0)
+		  {
+		    /* composite character */
+		    if (*src < 0xA0)
+		      ccl->private_state = 0;
+		    else
+		      {
+			if (i == 0xA0)
+			  {
+			    if (src >= src_end)
+			      goto ccl_read_multibyte_character_suspend;
+			    i = *src++ & 0x7F;
+			  }
+			else
+			  i -= 0x20;
+
+			if (COMPOSING_WITH_RULE_RULE == ccl->private_state)
+			  {
+			    ccl->private_state = COMPOSING_WITH_RULE_HEAD;
+			    continue;
+			  }
+			else if (COMPOSING_WITH_RULE_HEAD == ccl->private_state)
+			  ccl->private_state = COMPOSING_WITH_RULE_RULE;
+		      }
+		  }
+		if (i < 0x80)
+		  {
+		    /* ASCII */
+		    reg[rrr] = i;
+		    reg[RRR] = CHARSET_ASCII;
+		  }
+		else if (i <= MAX_CHARSET_OFFICIAL_DIMENSION1)
+		  {
+		    if (src >= src_end)
+		      goto ccl_read_multibyte_character_suspend;
+		    reg[RRR] = i;
+		    reg[rrr] = (*src++ & 0x7F);
+		  }
+		else if (i <= MAX_CHARSET_OFFICIAL_DIMENSION2)
+		  {
+		    if ((src + 1) >= src_end)
+		      goto ccl_read_multibyte_character_suspend;
+		    reg[RRR] = i;
+		    i = (*src++ & 0x7F);
+		    reg[rrr] = ((i << 7) | (*src & 0x7F));
+		    src++;
+		  }
+		else if ((i == LEADING_CODE_PRIVATE_11) ||
+			 (i == LEADING_CODE_PRIVATE_12))
+		  {
+		    if ((src + 1) >= src_end)
+		      goto ccl_read_multibyte_character_suspend;
+		    reg[RRR] = *src++;
+		    reg[rrr] = (*src++ & 0x7F);
+		  }
+		else if ((i == LEADING_CODE_PRIVATE_21) ||
+			 (i == LEADING_CODE_PRIVATE_22))
+		  {
+		    if ((src + 2) >= src_end)
+		      goto ccl_read_multibyte_character_suspend;
+		    reg[RRR] = *src++;
+		    i = (*src++ & 0x7F);
+		    reg[rrr] = ((i << 7) | (*src & 0x7F));
+		    src++;
+		  }
+		else
+		  {
+		    /* INVALID CODE 
+		       Returned charset is -1.*/
+		    reg[RRR] = -1;
+		  }
+	      } while (0);
+	      break;
+
+	    ccl_read_multibyte_character_suspend:
+	      src--;
+	      if (ccl->last_block)
+		{
+		  ic = ccl->eof_ic;
+		  goto ccl_finish;
+		}
+	      else
+		CCL_SUSPEND (CCL_STAT_SUSPEND_BY_SRC);
+
+	      break;
+
+	    case CCL_WriteMultibyteCharacter:
+	      i = reg[RRR]; /* charset */
+	      if (i == CHARSET_ASCII)
+		i = reg[rrr] & 0x7F;
+	      else if (i == CHARSET_COMPOSITION)
+		i = MAKE_COMPOSITE_CHAR (reg[rrr]);
+	      else if (CHARSET_DIMENSION (i) == 1)
+		i = ((i - 0x70) << 7) | (reg[rrr] & 0x7F);
+	      else if (i < MIN_CHARSET_PRIVATE_DIMENSION2)
+		i = ((i - 0x8F) << 14) | reg[rrr];
+	      else
+		i = ((i - 0xE0) << 14) | reg[rrr];
+
+	      CCL_WRITE_CHAR (i);
+
+	      break;
+
+	    case CCL_UnifyCharacter:
+	      i = reg[RRR]; /* charset */
+	      if (i == CHARSET_ASCII)
+		i = reg[rrr] & 0x7F;
+	      else if (i == CHARSET_COMPOSITION)
+		{
+		  reg[RRR] = -1;
+		  break;
+		}
+	      else if (CHARSET_DIMENSION (i) == 1)
+		i = ((i - 0x70) << 7) | (reg[rrr] & 0x7F);
+	      else if (i < MIN_CHARSET_PRIVATE_DIMENSION2)
+		i = ((i - 0x8F) << 14) | (reg[rrr] & 0x3FFF);
+	      else
+		i = ((i - 0xE0) << 14) | (reg[rrr] & 0x3FFF);
+
+	      op = unify_char (UNIFICATION_ID_TABLE (reg[Rrr]), i, -1, 0, 0);
+	      SPLIT_CHAR (op, reg[RRR], i, j);
+	      if (j != -1)
+		i = (i << 7) | j;
+	      
+	      reg[rrr] = i;
+	      break;
+
+	    case CCL_UnifyCharacterConstTbl:
+	      op = XINT (ccl_prog[ic]); /* table */
+	      ic++;
+	      i = reg[RRR]; /* charset */
+	      if (i == CHARSET_ASCII)
+		i = reg[rrr] & 0x7F;
+	      else if (i == CHARSET_COMPOSITION)
+		{
+		  reg[RRR] = -1;
+		  break;
+		}
+	      else if (CHARSET_DIMENSION (i) == 1)
+		i = ((i - 0x70) << 7) | (reg[rrr] & 0x7F);
+	      else if (i < MIN_CHARSET_PRIVATE_DIMENSION2)
+		i = ((i - 0x8F) << 14) | (reg[rrr] & 0x3FFF);
+	      else
+		i = ((i - 0xE0) << 14) | (reg[rrr] & 0x3FFF);
+
+	      op = unify_char (UNIFICATION_ID_TABLE (op), i, -1, 0, 0);
+	      SPLIT_CHAR (op, reg[RRR], i, j);
+	      if (j != -1)
+		i = (i << 7) | j;
+	      
+	      reg[rrr] = i;
+	      break;
+
+	    case CCL_IterateMultipleMap:
+	      {
+		Lisp_Object table, content, attrib, value;
+		int point, size, fin_ic;
+
+		j = XINT (ccl_prog[ic++]); /* number of tables. */
+		fin_ic = ic + j;
+		op = reg[rrr];
+		if ((j > reg[RRR]) && (j >= 0))
+		  {
+		    ic += reg[RRR];
+		    i = reg[RRR];
+		  }
+		else
+		  {
+		    reg[RRR] = -1;
+		    ic = fin_ic;
+		    break;
+		  }
+
+		for (;i < j;i++)
+		  {
+
+		    size = XVECTOR (Vccl_translation_table_vector)->size;
+		    point = ccl_prog[ic++];
+		    if (point >= size) continue;
+		    table = XVECTOR (Vccl_translation_table_vector)->
+		      contents[point];
+		    if (!CONSP (table)) continue;
+		    table = XCONS(table)->cdr;
+		    if (!VECTORP (table)) continue;
+		    size = XVECTOR (table)->size;
+		    if (size <= 1) continue;
+		    point = XUINT (XVECTOR (table)->contents[0]);
+		    point = op - point + 1;
+		    if (!((point >= 1) && (point < size))) continue;
+		    content = XVECTOR (table)->contents[point];
+
+		    if (NILP (content))
+		      continue;
+		    else if (NUMBERP (content))
+		      {
+			reg[RRR] = i;
+			reg[rrr] = XUINT(content);
+			break;
+		      }
+		    else if (EQ (content, Qt) || EQ (content, Qlambda))
+		      {
+			reg[RRR] = i;
+			break;
+		      }
+		    else if (CONSP (content))
+		      {
+			attrib = XCONS (content)->car;
+			value = XCONS (content)->cdr;
+			if (!NUMBERP (attrib) || !NUMBERP (value))
+			  continue;
+			reg[RRR] = i;
+			reg[rrr] = XUINT(value);
+			break;
+		      }
+		  }
+		if (i == j)
+		  reg[RRR] = -1;
+		ic = fin_ic;
+	      }
+	      break;
+	      
+	    case CCL_TranslateMultipleMap:
+	      {
+		Lisp_Object table, content, attrib, value;
+		int point, size, table_vector_size;
+		int skip_to_next, fin_ic;
+
+		j = XINT (ccl_prog[ic++]); /* number of tables and separators. */
+		fin_ic = ic + j;
+		if ((j > reg[RRR]) && (j >= 0))
+		  {
+		    ic += reg[RRR];
+		    i = reg[RRR];
+		  }
+		else
+		  {
+		    ic = fin_ic;
+		    reg[RRR] = -1;
+		    break;
+		  }
+		op = reg[rrr];
+		reg[RRR] = -1;
+		skip_to_next = 0;
+		table_vector_size = XVECTOR (Vccl_translation_table_vector)->size;
+		for (;i < j;i++)
+		  {
+		    point = ccl_prog[ic++];
+		    if (XINT(point) == -1)
+		      {
+			skip_to_next = 0;
+			continue;
+		      }
+		    if (skip_to_next) continue;
+		    if (point >= table_vector_size) continue;
+		    table = XVECTOR (Vccl_translation_table_vector)->
+		      contents[point];
+		    if (!CONSP (table)) continue;
+		    table = XCONS (table)->cdr;
+		    if (!VECTORP (table)) continue;
+		    size = XVECTOR (table)->size;
+		    if (size <= 1) continue;
+		    point = XUINT (XVECTOR (table)->contents[0]);
+		    point = op - point + 1;
+		    if (!((point >= 1) && (point < size))) continue;
+		    content = XVECTOR (table)->contents[point];
+
+		    if (NILP (content))
+		      continue;
+		    else if (NUMBERP (content))
+		      {
+			op = XUINT (content);
+			reg[RRR] = i;
+			skip_to_next = 1;
+		      }
+		    else if (CONSP (content))
+		      {
+			attrib = XCONS (content)->car;
+			value = XCONS (content)->cdr;
+			if (!NUMBERP (attrib) || !NUMBERP (value))
+			  continue;
+			reg[RRR] = i;
+			op = XUINT (value);
+		      
+		      }
+		    else if (EQ (content, Qt))
+		      {
+			reg[RRR] = i;
+			op = reg[rrr];
+			skip_to_next = 1;
+		      }
+		    else if (EQ (content, Qlambda))
+		      break;
+		  }
+		ic = fin_ic;
+	      }
+	      reg[rrr] = op;
+	      break;
+
+	    case CCL_TranslateSingleMap:
+	      {
+		Lisp_Object table, attrib, value, content;
+		int size, point;
+		j = XINT (ccl_prog[ic++]); /* table_id */
+		op = reg[rrr];
+		if (j >= XVECTOR (Vccl_translation_table_vector)->size)
+		  {
+		    reg[RRR] = -1;
+		    break;
+		  }
+		table = XVECTOR (Vccl_translation_table_vector)->
+		  contents[j];
+		if (!CONSP (table))
+		  {
+		    reg[RRR] = -1;
+		    break;
+		  }
+		table = XCONS(table)->cdr;
+		if (!VECTORP (table))
+		  {
+		    reg[RRR] = -1;
+		    break;
+		  }
+		size = XVECTOR (table)->size;
+		point = XUINT (XVECTOR (table)->contents[0]);
+		point = op - point + 1;
+		reg[RRR] = 0;
+		if ((size <= 1) ||
+		    (!((point >= 1) && (point < size))))
+		  reg[RRR] = -1;
+		else
+		  {
+		    content = XVECTOR (table)->contents[point];
+		    if (NILP (content))
+		      reg[RRR] = -1;
+		    else if (NUMBERP (content))
+		      reg[rrr] = XUINT (content);
+		    else if (EQ (content, Qt))
+		      reg[RRR] = i;
+		    else if (CONSP (content))
+		      {
+			attrib = XCONS (content)->car;
+			value = XCONS (content)->cdr;
+			if (!NUMBERP (attrib) || !NUMBERP (value))
+			  continue;
+			reg[rrr] = XUINT(value);
+			break;
+		      }
+		    else
+		      reg[RRR] = -1;
+		  }
+	      }
+	      break;
+	      
+	    default:
+	      CCL_INVALID_CMD;
+	    }
+	  break;
+
 	default:
 	  CCL_INVALID_CMD;
 	}
@@ -906,7 +1416,7 @@
 	    int j;
 
 	    msglen = strlen (msg);
-	    if (dst + msglen <= dst_end)
+	    if (dst + msglen <= (dst_bytes ? dst_end : src))
 	      {
 		bcopy (msg, dst, msglen);
 		dst += msglen;
@@ -919,7 +1429,7 @@
 		  break;
 		sprintf(msg, " %d", ccl_backtrace_table[i]);
 		msglen = strlen (msg);
-		if (dst + msglen > dst_end)
+		if (dst + msglen > (dst_bytes ? dst_end : src))
 		  break;
 		bcopy (msg, dst, msglen);
 		dst += msglen;
@@ -937,7 +1447,7 @@
 	}
 
       msglen = strlen (msg);
-      if (dst + msglen <= dst_end)
+      if (dst + msglen <= (dst_bytes ? dst_end : src))
 	{
 	  bcopy (msg, dst, msglen);
 	  dst += msglen;
@@ -967,6 +1477,7 @@
   for (i = 0; i < 8; i++)
     ccl->reg[i] = 0;
   ccl->last_block = 0;
+  ccl->private_state = 0;
   ccl->status = 0;
 }
 
@@ -1069,7 +1580,8 @@
   free (outbuf);
   QUIT;
   if (ccl.status != CCL_STAT_SUCCESS
-      && ccl.status != CCL_STAT_SUSPEND)
+      && ccl.status != CCL_STAT_SUSPEND_BY_SRC
+      && ccl.status != CCL_STAT_SUSPEND_BY_DST)
     error ("Error in CCL program at %dth code", ccl.ic);
 
   return val;
@@ -1084,7 +1596,7 @@
      Lisp_Object name, ccl_prog;
 {
   int len = XVECTOR (Vccl_program_table)->size;
-  int i, idx;
+  int i;
 
   CHECK_SYMBOL (name, 0);
   if (!NILP (ccl_prog))
@@ -1119,11 +1631,86 @@
   return make_number (i);
 }
 
+/* register CCL translation table.
+   CCL translation table consists of numbers and Qt and Qnil and Qlambda.
+   The first element is start code point.
+   The rest elements are translated numbers.
+   Qt shows that an original number before translation.
+   Qnil shows that an empty element.
+   Qlambda makes translation stopped.
+*/
+
+DEFUN ("register-ccl-translation-table", Fregister_ccl_translation_table,
+       Sregister_ccl_translation_table,
+       2, 2, 0,
+  "Register CCL translation table.\n\
+TABLE should be a vector. SYMBOL is used for pointing the translation table out.\n\
+Return index number of the registered translation table.")
+  (symbol, table)
+     Lisp_Object symbol, table;
+{
+  int len = XVECTOR (Vccl_translation_table_vector)->size;
+  int i;
+  Lisp_Object index;
+
+  CHECK_SYMBOL (symbol, 0);
+  CHECK_VECTOR (table, 1);
+  
+  for (i = 0; i < len; i++)
+    {
+      Lisp_Object slot = XVECTOR (Vccl_translation_table_vector)->contents[i];
+
+      if (!CONSP (slot))
+	break;
+
+      if (EQ (symbol, XCONS (slot)->car))
+	{
+	  index = make_number (i);
+	  XCONS (slot)->cdr = table;
+	  Fput (symbol, Qccl_translation_table, table);
+	  Fput (symbol, Qccl_translation_table_id, index);
+	  return index;
+	}
+    }
+
+  if (i == len)
+    {
+      Lisp_Object new_vector = Fmake_vector (make_number (len * 2), Qnil);
+      int j;
+
+      for (j = 0; j < len; j++)
+	XVECTOR (new_vector)->contents[j]
+	  = XVECTOR (Vccl_translation_table_vector)->contents[j];
+      Vccl_translation_table_vector = new_vector;
+    }
+
+  index = make_number (i);
+  Fput (symbol, Qccl_translation_table, table);
+  Fput (symbol, Qccl_translation_table_id, index);
+  XVECTOR (Vccl_translation_table_vector)->contents[i] = Fcons (symbol, table);
+  return index;
+}
+
+
 syms_of_ccl ()
 {
   staticpro (&Vccl_program_table);
   Vccl_program_table = Fmake_vector (make_number (32), Qnil);
 
+  Qccl_program = intern("ccl-program");
+  staticpro(&Qccl_program);
+
+  Qccl_translation_table = intern ("ccl-translation-table");
+  staticpro (&Qccl_translation_table);
+
+  Qccl_translation_table_id = intern ("ccl-translation-table-id");
+  staticpro (&Qccl_translation_table_id);
+
+  DEFVAR_LISP ("ccl-translation-table-vector", &Vccl_translation_table_vector,
+    "Where is stored translation tables for CCL program.\n\
+Because CCL program can't access these tables except by the index of the vector.");
+  Vccl_translation_table_vector = Fmake_vector (XFASTINT (16), Qnil);
+
   DEFVAR_LISP ("font-ccl-encoder-alist", &Vfont_ccl_encoder_alist,
     "Alist of fontname patterns vs corresponding CCL program.\n\
 Each element looks like (REGEXP . CCL-CODE),\n\
@@ -1140,6 +1727,7 @@
   defsubr (&Sccl_execute);
   defsubr (&Sccl_execute_on_string);
   defsubr (&Sregister_ccl_program);
+  defsubr (&Sregister_ccl_translation_table);
 }
 
 #endif  /* emacs */