diff src/mule-ccl.c @ 213:78f53ef88e17 r20-4b5

Import from CVS: tag r20-4b5
author cvs
date Mon, 13 Aug 2007 10:06:47 +0200
parents 3d6bfa290dbd
children f955c73f5258
line wrap: on
line diff
--- a/src/mule-ccl.c	Mon Aug 13 10:05:53 2007 +0200
+++ b/src/mule-ccl.c	Mon Aug 13 10:06:47 2007 +0200
@@ -1,639 +1,1120 @@
-/* CCL -- Code Conversion Language Interpreter
-   Copyright (C) 1992, 1995 Free Software Foundation, Inc.
-   Copyright (C) 1995 Sun Microsystems, Inc.
+/* CCL (Code Conversion Language) interpreter.
+   Copyright (C) 1995, 1997 Electrotechnical Laboratory, JAPAN.
+   Licensed to the Free Software Foundation.
 
 This file is part of XEmacs.
 
-XEmacs is free software; you can redistribute it and/or modify it
-under the terms of the GNU General Public License as published by the
-Free Software Foundation; either version 2, or (at your option) any
-later version.
+GNU Emacs is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 2, or (at your option)
+any later version.
 
-XEmacs is distributed in the hope that it will be useful, but WITHOUT
-ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
-FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
-for more details.
+GNU Emacs is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+GNU General Public License for more details.
 
 You should have received a copy of the GNU General Public License
-along with XEmacs; see the file COPYING.  If not, write to
+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.  */
 
-/* Synched up with: Mule 2.3.  Not in FSF. */
+/* Synched up with : FSF Emacs 20.2 */
+
+#include <stdio.h>
+
+#ifdef emacs
 
 #include <config.h>
 #include "lisp.h"
-
 #include "buffer.h"
+#include "mule-charset.h"
+#include "mule-ccl.h"
 #include "mule-coding.h"
 
-/* CCL operators */
-#define CCL_SetCS		0x00
-#define CCL_SetCL		0x01
-#define CCL_SetR		0x02
-#define CCL_SetA		0x03
-#define CCL_Jump		0x04
-#define CCL_JumpCond		0x05
-#define CCL_WriteJump		0x06
-#define CCL_WriteReadJump	0x07
-#define CCL_WriteCJump		0x08
-#define CCL_WriteCReadJump	0x09
-#define CCL_WriteSJump		0x0A
-#define CCL_WriteSReadJump	0x0B
-#define CCL_WriteAReadJump	0x0C
-#define CCL_Branch		0x0D
-#define CCL_Read1		0x0E
-#define CCL_Read2		0x0F
-#define CCL_ReadBranch		0x10
-#define CCL_Write1		0x11
-#define CCL_Write2		0x12
-#define CCL_WriteC		0x13
-#define CCL_WriteS		0x14
-#define CCL_WriteA		0x15
-#define CCL_End			0x16
-#define CCL_SetSelfCS		0x17
-#define CCL_SetSelfCL		0x18
-#define CCL_SetSelfR		0x19
-#define CCL_SetExprCL		0x1A
-#define CCL_SetExprR		0x1B
-#define CCL_JumpCondC		0x1C
-#define CCL_JumpCondR		0x1D
-#define CCL_ReadJumpCondC	0x1E
-#define CCL_ReadJumpCondR	0x1F
+#else  /* not emacs */
+
+#include "mulelib.h"
+
+#endif /* not emacs */
+
+/* Alist of fontname patterns vs corresponding CCL program.  */
+Lisp_Object Vfont_ccl_encoder_alist;
 
-#define CCL_PLUS	0x00
-#define CCL_MINUS	0x01
-#define CCL_MUL		0x02
-#define CCL_DIV		0x03
-#define CCL_MOD		0x04
-#define CCL_AND		0x05
-#define CCL_OR		0x06
-#define CCL_XOR		0x07
-#define CCL_LSH		0x08
-#define CCL_RSH		0x09
-#define CCL_LSH8	0x0A
-#define CCL_RSH8	0x0B
-#define CCL_DIVMOD	0x0C
-#define CCL_LS		0x10
-#define CCL_GT		0x11
-#define CCL_EQ		0x12
-#define CCL_LE		0x13
-#define CCL_GE		0x14
-#define CCL_NE		0x15
+/* Vector of CCL program names vs corresponding program data.  */
+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
+   `ccl-compile' compiles a CCL program and produces a CCL code which
+   is a vector of integers.  The structure of this vector is as
+   follows: The 1st element: buffer-magnification, a factor for the
+   size of output buffer compared with the size of input buffer.  The
+   2nd element: address of CCL code to be executed when encountered
+   with end of input stream.  The 3rd and the remaining elements: CCL
+   codes.  */
 
 /* Header of CCL compiled code */
-#define CCL_HEADER_EOF		0
-#define CCL_HEADER_MAIN		1
+#define CCL_HEADER_BUF_MAG	0
+#define CCL_HEADER_EOF		1
+#define CCL_HEADER_MAIN		2
 
-#define CCL_STAT_SUCCESS	0
-#define CCL_STAT_SUSPEND	1
-#define CCL_STAT_INVALID_CMD	2
+/* CCL code is a sequence of 28-bit non-negative integers (i.e. the
+   MSB is always 0), each contains CCL command and/or arguments in the
+   following format:
 
-#define CCL_SUCCESS			\
-  ccl->status = CCL_STAT_SUCCESS;	\
-  goto ccl_finish
-#define CCL_SUSPEND			\
-  ccl->ic = --ic;			\
-  ccl->status = CCL_STAT_SUSPEND;	\
-  goto ccl_finish
-#define CCL_INVALID_CMD			\
-  ccl->status = CCL_STAT_INVALID_CMD;	\
-  goto ccl_error_handler
+	|----------------- integer (28-bit) ------------------|
+	|------- 17-bit ------|- 3-bit --|- 3-bit --|- 5-bit -|
+	|--constant argument--|-register-|-register-|-command-|
+	   ccccccccccccccccc      RRR        rrr       XXXXX
+  or
+	|------- relative address -------|-register-|-command-|
+	       cccccccccccccccccccc          rrr       XXXXX
+  or
+	|------------- constant or other args ----------------|
+                     cccccccccccccccccccccccccccc
+
+   where, `cc...c' is a non-negative integer indicating constant value
+   (the left most `c' is always 0) or an absolute jump address, `RRR'
+   and `rrr' are CCL register number, `XXXXX' is one of the following
+   CCL commands.  */
+
+/* CCL commands
+
+   Each comment fields shows one or more lines for command syntax and
+   the following lines for semantics of the command.  In semantics, IC
+   stands for Instruction Counter.  */
+
+#define CCL_SetRegister		0x00 /* Set register a register value:
+					1:00000000000000000RRRrrrXXXXX
+					------------------------------
+					reg[rrr] = reg[RRR];
+					*/
 
-#define CCL_WRITE_CHAR(ch) do					\
-{								\
-  if (!src)							\
-    {								\
-      CCL_INVALID_CMD;						\
-    }								\
-  else								\
-    {								\
-      /* !!#### is this correct for both directions????? */	\
-      Bufbyte __buf__[MAX_EMCHAR_LEN];				\
-      int __len__;						\
-      __len__ = set_charptr_emchar (__buf__, ch);		\
-      Dynarr_add_many (dst, __buf__, __len__);			\
-    }								\
-} while (0)
+#define CCL_SetShortConst	0x01 /* Set register a short constant value:
+					1:CCCCCCCCCCCCCCCCCCCCrrrXXXXX
+					------------------------------
+					reg[rrr] = CCCCCCCCCCCCCCCCCCC;
+					*/
+
+#define CCL_SetConst		0x02 /* Set register a constant value:
+					1:00000000000000000000rrrXXXXX
+					2:CONSTANT
+					------------------------------
+					reg[rrr] = CONSTANT;
+					IC++;
+					*/
 
-#define CCL_WRITE_STRING(len) do			\
-{							\
-  if (!src)						\
-    {							\
-      CCL_INVALID_CMD;					\
-    }							\
-  else							\
-    {							\
-      for (j = 0; j < len; j++)				\
-	Dynarr_add (dst, XINT (prog[ic + 1 + j]));	\
-    }							\
-} while (0)
+#define CCL_SetArray		0x03 /* Set register an element of array:
+					1:CCCCCCCCCCCCCCCCCRRRrrrXXXXX
+					2:ELEMENT[0]
+					3:ELEMENT[1]
+					...
+					------------------------------
+					if (0 <= reg[RRR] < CC..C)
+					  reg[rrr] = ELEMENT[reg[RRR]];
+					IC += CC..C;
+					*/
 
-#define CCL_READ_CHAR(r) do		\
-{					\
-  if (!src)				\
-    {					\
-      CCL_INVALID_CMD;			\
-    }					\
-  else if (s < s_end)			\
-    r = *s++;				\
-  else if (end_flag)			\
-    {					\
-      ic = XINT (prog[CCL_HEADER_EOF]);	\
-      continue;				\
-    }					\
-  else					\
-    {					\
-      CCL_SUSPEND;			\
-    }					\
-} while (0)
+#define CCL_Jump		0x04 /* Jump:
+					1:A--D--D--R--E--S--S-000XXXXX
+					------------------------------
+					IC += ADDRESS;
+					*/
+
+/* Note: If CC..C is greater than 0, the second code is omitted.  */
+
+#define CCL_JumpCond		0x05 /* Jump conditional:
+					1:A--D--D--R--E--S--S-rrrXXXXX
+					------------------------------
+					if (!reg[rrr])
+					  IC += ADDRESS;
+					*/
 
 
-/* Run a CCL program.  The initial state and program are contained in
-   CCL.  SRC, if non-zero, specifies a source string (of size N)
-   to read bytes from, and DST, of non-zero, specifies a destination
-   Dynarr to write bytes to.  If END_FLAG is set, it means that
-   the end section of the CCL program should be run rather than
-   the normal section.
+#define CCL_WriteRegisterJump	0x06 /* Write register and jump:
+					1:A--D--D--R--E--S--S-rrrXXXXX
+					------------------------------
+					write (reg[rrr]);
+					IC += ADDRESS;
+					*/
+
+#define CCL_WriteRegisterReadJump 0x07 /* Write register, read, and jump:
+					1:A--D--D--R--E--S--S-rrrXXXXX
+					2:A--D--D--R--E--S--S-rrrYYYYY
+					-----------------------------
+					write (reg[rrr]);
+					IC++;
+					read (reg[rrr]);
+					IC += ADDRESS;
+					*/
+/* Note: If read is suspended, the resumed execution starts from the
+   second code (YYYYY == CCL_ReadJump).  */
+
+#define CCL_WriteConstJump	0x08 /* Write constant and jump:
+					1:A--D--D--R--E--S--S-000XXXXX
+					2:CONST
+					------------------------------
+					write (CONST);
+					IC += ADDRESS;
+					*/
+
+#define CCL_WriteConstReadJump	0x09 /* Write constant, read, and jump:
+					1:A--D--D--R--E--S--S-rrrXXXXX
+					2:CONST
+					3:A--D--D--R--E--S--S-rrrYYYYY
+					-----------------------------
+					write (CONST);
+					IC += 2;
+					read (reg[rrr]);
+					IC += ADDRESS;
+					*/
+/* Note: If read is suspended, the resumed execution starts from the
+   second code (YYYYY == CCL_ReadJump).  */
+
+#define CCL_WriteStringJump	0x0A /* Write string and jump:
+					1:A--D--D--R--E--S--S-000XXXXX
+					2:LENGTH
+					3:0000STRIN[0]STRIN[1]STRIN[2]
+					...
+					------------------------------
+					write_string (STRING, LENGTH);
+					IC += ADDRESS;
+					*/
+
+#define CCL_WriteArrayReadJump	0x0B /* Write an array element, read, and jump:
+					1:A--D--D--R--E--S--S-rrrXXXXX
+					2:LENGTH
+					3:ELEMENET[0]
+					4:ELEMENET[1]
+					...
+					N:A--D--D--R--E--S--S-rrrYYYYY
+					------------------------------
+					if (0 <= reg[rrr] < LENGTH)
+					  write (ELEMENT[reg[rrr]]);
+					IC += LENGTH + 2; (... pointing at N+1)
+					read (reg[rrr]);
+					IC += ADDRESS;
+					*/
+/* Note: If read is suspended, the resumed execution starts from the
+   Nth code (YYYYY == CCL_ReadJump).  */
+
+#define CCL_ReadJump		0x0C /* Read and jump:
+					1:A--D--D--R--E--S--S-rrrYYYYY
+					-----------------------------
+					read (reg[rrr]);
+					IC += ADDRESS;
+					*/
+
+#define CCL_Branch		0x0D /* Jump by branch table:
+					1:CCCCCCCCCCCCCCCCCCCCrrrXXXXX
+					2:A--D--D--R--E-S-S[0]000XXXXX
+					3:A--D--D--R--E-S-S[1]000XXXXX
+					...
+					------------------------------
+					if (0 <= reg[rrr] < CC..C)
+					  IC += ADDRESS[reg[rrr]];
+					else
+					  IC += ADDRESS[CC..C];
+					*/
+
+#define CCL_ReadRegister	0x0E /* Read bytes into registers:
+					1:CCCCCCCCCCCCCCCCCCCCrrrXXXXX
+					2:CCCCCCCCCCCCCCCCCCCCrrrXXXXX
+					...
+					------------------------------
+					while (CCC--)
+					  read (reg[rrr]);
+					*/
+
+#define CCL_WriteExprConst	0x0F  /* write result of expression:
+					1:00000OPERATION000RRR000XXXXX
+					2:CONSTANT
+					------------------------------
+					write (reg[RRR] OPERATION CONSTANT);
+					IC++;
+					*/
+
+/* Note: If the Nth read is suspended, the resumed execution starts
+   from the Nth code.  */
+
+#define CCL_ReadBranch		0x10 /* Read one byte into a register,
+					and jump by branch table:
+					1:CCCCCCCCCCCCCCCCCCCCrrrXXXXX
+					2:A--D--D--R--E-S-S[0]000XXXXX
+					3:A--D--D--R--E-S-S[1]000XXXXX
+					...
+					------------------------------
+					read (read[rrr]);
+					if (0 <= reg[rrr] < CC..C)
+					  IC += ADDRESS[reg[rrr]];
+					else
+					  IC += ADDRESS[CC..C];
+					*/
+
+#define CCL_WriteRegister	0x11 /* Write registers:
+					1:CCCCCCCCCCCCCCCCCCCrrrXXXXX
+					2:CCCCCCCCCCCCCCCCCCCrrrXXXXX
+					...
+					------------------------------
+					while (CCC--)
+					  write (reg[rrr]);
+					...
+					*/
+
+/* Note: If the Nth write is suspended, the resumed execution
+   starts from the Nth code.  */
+
+#define CCL_WriteExprRegister	0x12 /* Write result of expression
+					1:00000OPERATIONRrrRRR000XXXXX
+					------------------------------
+					write (reg[RRR] OPERATION reg[Rrr]);
+					*/
+
+#define CCL_Call		0x13 /* Write a constant:
+					1:CCCCCCCCCCCCCCCCCCCC000XXXXX
+					------------------------------
+					call (CC..C)
+					*/
+
+#define CCL_WriteConstString	0x14 /* Write a constant or a string:
+					1:CCCCCCCCCCCCCCCCCCCCrrrXXXXX
+					[2:0000STRIN[0]STRIN[1]STRIN[2]]
+					[...]
+					-----------------------------
+					if (!rrr)
+					  write (CC..C)
+					else
+					  write_string (STRING, CC..C);
+					  IC += (CC..C + 2) / 3;
+					*/
+
+#define CCL_WriteArray		0x15 /* Write an element of array:
+					1:CCCCCCCCCCCCCCCCCCCCrrrXXXXX
+					2:ELEMENT[0]
+					3:ELEMENT[1]
+					...
+					------------------------------
+					if (0 <= reg[rrr] < CC..C)
+					  write (ELEMENT[reg[rrr]]);
+					IC += CC..C;
+					*/
+
+#define CCL_End			0x16 /* Terminate:
+					1:00000000000000000000000XXXXX
+					------------------------------
+					terminate ();
+					*/
+
+/* The following two codes execute an assignment arithmetic/logical
+   operation.  The form of the operation is like REG OP= OPERAND.  */
+
+#define CCL_ExprSelfConst	0x17 /* REG OP= constant:
+					1:00000OPERATION000000rrrXXXXX
+					2:CONSTANT
+					------------------------------
+					reg[rrr] OPERATION= CONSTANT;
+					*/
+
+#define CCL_ExprSelfReg		0x18 /* REG1 OP= REG2:
+					1:00000OPERATION000RRRrrrXXXXX
+					------------------------------
+					reg[rrr] OPERATION= reg[RRR];
+					*/
+
+/* The following codes execute an arithmetic/logical operation.  The
+   form of the operation is like REG_X = REG_Y OP OPERAND2.  */
 
-   For CCL programs that do not involve code conversion (e.g.
-   converting a single character into a font index), all parameters
-   but the first will usually be 0. */
+#define CCL_SetExprConst	0x19 /* REG_X = REG_Y OP constant:
+					1:00000OPERATION000RRRrrrXXXXX
+					2:CONSTANT
+					------------------------------
+					reg[rrr] = reg[RRR] OPERATION CONSTANT;
+					IC++;
+					*/
+
+#define CCL_SetExprReg		0x1A /* REG1 = REG2 OP REG3:
+					1:00000OPERATIONRrrRRRrrrXXXXX
+					------------------------------
+					reg[rrr] = reg[RRR] OPERATION reg[Rrr];
+					*/
+
+#define CCL_JumpCondExprConst	0x1B /* Jump conditional according to
+					an operation on constant:
+					1:A--D--D--R--E--S--S-rrrXXXXX
+					2:OPERATION
+					3:CONSTANT
+					-----------------------------
+					reg[7] = reg[rrr] OPERATION CONSTANT;
+					if (!(reg[7]))
+					  IC += ADDRESS;
+					else
+					  IC += 2
+					*/
+
+#define CCL_JumpCondExprReg	0x1C /* Jump conditional according to
+					an operation on register:
+					1:A--D--D--R--E--S--S-rrrXXXXX
+					2:OPERATION
+					3:RRR
+					-----------------------------
+					reg[7] = reg[rrr] OPERATION reg[RRR];
+					if (!reg[7])
+					  IC += ADDRESS;
+					else
+					  IC += 2;
+					*/
+
+#define CCL_ReadJumpCondExprConst 0x1D /* Read and jump conditional according
+					  to an operation on constant:
+					1:A--D--D--R--E--S--S-rrrXXXXX
+					2:OPERATION
+					3:CONSTANT
+					-----------------------------
+					read (reg[rrr]);
+					reg[7] = reg[rrr] OPERATION CONSTANT;
+					if (!reg[7])
+					  IC += ADDRESS;
+					else
+					  IC += 2;
+					*/
+
+#define CCL_ReadJumpCondExprReg	0x1E /* Read and jump conditional according
+					to an operation on register:
+					1:A--D--D--R--E--S--S-rrrXXXXX
+					2:OPERATION
+					3:RRR
+					-----------------------------
+					read (reg[rrr]);
+					reg[7] = reg[rrr] OPERATION reg[RRR];
+					if (!reg[7])
+					  IC += ADDRESS;
+					else
+					  IC += 2;
+					*/
+
+#define CCL_Extention		0x1F /* Extended CCL code
+					1:ExtendedCOMMNDRrrRRRrrrXXXXX
+					2:ARGUEMENT
+					3:...
+					------------------------------
+					extended_command (rrr,RRR,Rrr,ARGS)
+				      */
+
+
+/* CCL arithmetic/logical operators. */
+#define CCL_PLUS	0x00	/* X = Y + Z */
+#define CCL_MINUS	0x01	/* X = Y - Z */
+#define CCL_MUL		0x02	/* X = Y * Z */
+#define CCL_DIV		0x03	/* X = Y / Z */
+#define CCL_MOD		0x04	/* X = Y % Z */
+#define CCL_AND		0x05	/* X = Y & Z */
+#define CCL_OR		0x06	/* X = Y | Z */
+#define CCL_XOR		0x07	/* X = Y ^ Z */
+#define CCL_LSH		0x08	/* X = Y << Z */
+#define CCL_RSH		0x09	/* X = Y >> Z */
+#define CCL_LSH8	0x0A	/* X = (Y << 8) | Z */
+#define CCL_RSH8	0x0B	/* X = Y >> 8, r[7] = Y & 0xFF  */
+#define CCL_DIVMOD	0x0C	/* X = Y / Z, r[7] = Y % Z */
+#define CCL_LS		0x10	/* X = (X < Y) */
+#define CCL_GT		0x11	/* X = (X > Y) */
+#define CCL_EQ		0x12	/* X = (X == Y) */
+#define CCL_LE		0x13	/* X = (X <= Y) */
+#define CCL_GE		0x14	/* X = (X >= Y) */
+#define CCL_NE		0x15	/* X = (X != Y) */
+
+#define CCL_ENCODE_SJIS 0x16	/* X = HIGHER_BYTE (SJIS (Y, Z))
+				   r[7] = LOWER_BYTE (SJIS (Y, Z) */
+#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 {				   	\
+    ccl->status = CCL_STAT_SUCCESS;	\
+    ccl->ic = CCL_HEADER_MAIN;		\
+    goto ccl_finish;		   	\
+  } while (0)
+
+/* 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;		 	\
+  } while (0)
+
+/* Terminate CCL program because of invalid command.  Should not occur
+   in the normal case.  */
+#define CCL_INVALID_CMD		     	\
+  do {				     	\
+    ccl->status = CCL_STAT_INVALID_CMD;	\
+    goto ccl_error_handler;	     	\
+  } while (0)
+
+/* 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 (!destination)				      	\
+      CCL_INVALID_CMD;			      	      	\
+    else				      	      	\
+      {					      	      	\
+	Bufbyte work[MAX_EMCHAR_LEN];	      	      	\
+	int len = set_charptr_emchar (work, ch);	\
+	Dynarr_add_many (destination, work, len);      	\
+      }					      	      	\
+  } while (0)
+
+/* Write a string at ccl_prog[IC] of length LEN to the current output
+   buffer.  */
+#define CCL_WRITE_STRING(len)					\
+  do {								\
+    if (!destination)						\
+      CCL_INVALID_CMD;						\
+    else							\
+      for (i = 0; i < len; i++)					\
+	Dynarr_add(destination, (XINT (ccl_prog[ic + (i / 3)])	\
+		   >> ((2 - (i % 3)) * 8)) & 0xFF);		\
+  } 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;		\
+  } while (0)
+
+
+/* Execute CCL code on SRC_BYTES length text at SOURCE.  The resulting
+   text goes to a place pointed by DESTINATION. The bytes actually
+   processed is returned as *CONSUMED.  The return value is the length
+   of the resulting text.  As a side effect, the contents of CCL registers
+   are updated.  If SOURCE or DESTINATION is NULL, only operations on
+   registers are permitted.  */
+
+#ifdef CCL_DEBUG
+#define CCL_DEBUG_BACKTRACE_LEN 256
+int ccl_backtrace_table[CCL_BACKTRACE_TABLE];
+int ccl_backtrace_idx;
+#endif
+
+struct ccl_prog_stack
+  {
+    Lisp_Object *ccl_prog;	/* Pointer to an array of CCL code.  */
+    int ic;			/* Instruction Counter.  */
+  };
 
 int
-ccl_driver (struct ccl_program *ccl, CONST unsigned char *src,
-	    unsigned_char_dynarr *dst, int n, int end_flag)
+ccl_driver (struct ccl_program *ccl, CONST unsigned char *source, unsigned_char_dynarr *destination, int src_bytes, int *consumed)
 {
-  int code, op, rrr, cc, i, j;
-  CONST unsigned char *s = NULL, *s_end = NULL;
-  int   ic = ccl->ic;
   int *reg = ccl->reg;
-  Lisp_Object *prog = ccl->prog;
+  int ic = ccl->ic;
+  int code, field1, field2;
+  Lisp_Object *ccl_prog = ccl->prog;
+  unsigned char *src = source, *src_end = src + src_bytes;
+  int jump_address;
+  int i, j, op;
+  int stack_idx = 0;
+  /* For the moment, we only support depth 256 of stack.  */ 
+  struct ccl_prog_stack ccl_prog_stack_struct[256];
 
-  if (!ic)
+  if (ic >= ccl->eof_ic)
     ic = CCL_HEADER_MAIN;
 
-  if (src)
-    {
-      s = src;
-      s_end = s + n;
-    }
+#ifdef CCL_DEBUG
+  ccl_backtrace_idx = 0;
+#endif
 
-  while (1)
+  for (;;)
     {
-      code = XINT (prog[ic++]);
-      op = code & 0x1F;
-      rrr = (code >> 5) & 0x7;
-      cc = code >> 8;
+#ifdef CCL_DEBUG
+      ccl_backtrace_table[ccl_backtrace_idx++] = ic;
+      if (ccl_backtrace_idx >= CCL_DEBUG_BACKTRACE_LEN)
+	ccl_backtrace_idx = 0;
+      ccl_backtrace_table[ccl_backtrace_idx] = 0;
+#endif
 
-      switch (op)
+      if (!NILP (Vquit_flag) && NILP (Vinhibit_quit))
 	{
-	case CCL_SetCS:
-	  reg[rrr] = cc; continue;
-	case CCL_SetCL:
-	  reg[rrr] = XINT (prog[ic++]); continue;
-	case CCL_SetR:
-	  reg[rrr] = reg[cc]; continue;
-	case CCL_SetA:
-	  cc = reg[cc];
-	  i = XINT (prog[ic++]);
-	  if (cc >= 0 && cc < i)
-	    reg[rrr] = XINT (prog[ic + cc]);
-	  ic += i;
-	  continue;
-	case CCL_Jump:
-	  ic = cc; continue;
-	case CCL_JumpCond:
+	  /* We can't just signal Qquit, instead break the loop as if
+             the whole data is processed.  Don't reset Vquit_flag, it
+             must be handled later at a safer place.  */
+	  if (consumed)
+	    src = source + src_bytes;
+	  ccl->status = CCL_STAT_QUIT;
+	  break;
+	}
+
+      code = XINT (ccl_prog[ic]); ic++;
+      field1 = code >> 8;
+      field2 = (code & 0xFF) >> 5;
+
+#define rrr field2
+#define RRR (field1 & 7)
+#define Rrr ((field1 >> 3) & 7)
+#define ADDR field1
+
+      switch (code & 0x1F)
+	{
+	case CCL_SetRegister:	/* 00000000000000000RRRrrrXXXXX */
+	  reg[rrr] = reg[RRR];
+	  break;
+
+	case CCL_SetShortConst:	/* CCCCCCCCCCCCCCCCCCCCrrrXXXXX */
+	  reg[rrr] = field1;
+	  break;
+
+	case CCL_SetConst:	/* 00000000000000000000rrrXXXXX */
+	  reg[rrr] = XINT (ccl_prog[ic]);
+	  ic++;
+	  break;
+
+	case CCL_SetArray:	/* CCCCCCCCCCCCCCCCCCCCRRRrrrXXXXX */
+	  i = reg[RRR];
+	  j = field1 >> 3;
+	  if ((unsigned int) i < j)
+	    reg[rrr] = XINT (ccl_prog[ic + i]);
+	  ic += j;
+	  break;
+
+	case CCL_Jump:		/* A--D--D--R--E--S--S-000XXXXX */
+	  ic += ADDR;
+	  break;
+
+	case CCL_JumpCond:	/* A--D--D--R--E--S--S-rrrXXXXX */
 	  if (!reg[rrr])
-	    ic = cc;
-	  continue;
-	case CCL_WriteJump:
-	  CCL_WRITE_CHAR (reg[rrr]);
-	  ic = cc;
-	  continue;
-	case CCL_WriteReadJump:
-	  if (ccl->status != CCL_STAT_SUSPEND)
-	    {
-	      CCL_WRITE_CHAR (reg[rrr]);
-	    }
-	  else
-	    ccl->status = CCL_STAT_SUCCESS;
+	    ic += ADDR;
+	  break;
+
+	case CCL_WriteRegisterJump: /* A--D--D--R--E--S--S-rrrXXXXX */
+	  i = reg[rrr];
+	  CCL_WRITE_CHAR (i);
+	  ic += ADDR;
+	  break;
+
+	case CCL_WriteRegisterReadJump: /* A--D--D--R--E--S--S-rrrXXXXX */
+	  i = reg[rrr];
+	  CCL_WRITE_CHAR (i);
+	  ic++;
 	  CCL_READ_CHAR (reg[rrr]);
-	  ic = cc;
-	  continue;
-	case CCL_WriteCJump:
-	  CCL_WRITE_CHAR (XINT (prog[ic]));
-	  ic = cc;
-	  continue;
-	case CCL_WriteCReadJump:
-	  if (ccl->status != CCL_STAT_SUSPEND)
-	    {
-	      CCL_WRITE_CHAR (XINT (prog[ic]));
-	    }
-	  else
-	    ccl->status = CCL_STAT_SUCCESS;
+	  ic += ADDR - 1;
+	  break;
+
+	case CCL_WriteConstJump: /* A--D--D--R--E--S--S-000XXXXX */
+	  i = XINT (ccl_prog[ic]);
+	  CCL_WRITE_CHAR (i);
+	  ic += ADDR;
+	  break;
+
+	case CCL_WriteConstReadJump: /* A--D--D--R--E--S--S-rrrXXXXX */
+	  i = XINT (ccl_prog[ic]);
+	  CCL_WRITE_CHAR (i);
+	  ic++;
 	  CCL_READ_CHAR (reg[rrr]);
-	  ic = cc;
-	  continue;
-	case CCL_WriteSJump:
-	  i = XINT (prog[ic]);
-	  CCL_WRITE_STRING (i);
-	  ic = cc;
-	  continue;
-	case CCL_WriteSReadJump:
-	  if (ccl->status != CCL_STAT_SUSPEND)
+	  ic += ADDR - 1;
+	  break;
+
+	case CCL_WriteStringJump: /* A--D--D--R--E--S--S-000XXXXX */
+	  j = XINT (ccl_prog[ic]);
+	  ic++;
+	  CCL_WRITE_STRING (j);
+	  ic += ADDR - 1;
+	  break;
+
+	case CCL_WriteArrayReadJump: /* A--D--D--R--E--S--S-rrrXXXXX */
+	  i = reg[rrr];
+	  j = XINT (ccl_prog[ic]);
+	  if ((unsigned int) i < j)
 	    {
-	      i = XINT (prog[ic]);
-	      CCL_WRITE_STRING (i);
-	    }
-	  else
-	    ccl->status = CCL_STAT_SUCCESS;
-	  CCL_READ_CHAR (reg[rrr]);
-	  ic = cc;
-	  continue;
-	case CCL_WriteAReadJump:
-	  if (ccl->status != CCL_STAT_SUSPEND)
-	    {
-	      i = XINT (prog[ic]);
-	      if (reg[rrr] >= 0 && reg[rrr] < i)
-		CCL_WRITE_CHAR (XINT (prog[ic + 1 + reg[rrr]]));
+	      i = XINT (ccl_prog[ic + 1 + i]);
+	      CCL_WRITE_CHAR (i);
 	    }
-	  else
-	    ccl->status = CCL_STAT_SUCCESS;
-	  CCL_READ_CHAR (reg[rrr]);
-	  ic = cc;
-	  continue;
-	case CCL_ReadBranch:
+	  ic += j + 2;
 	  CCL_READ_CHAR (reg[rrr]);
-	case CCL_Branch:
-	  ic = XINT (prog[ic + (((unsigned int) reg[rrr] < cc)
-				? reg[rrr] : cc)]);
-	  continue;
-	case CCL_Read1:
+	  ic += ADDR - (j + 2);
+	  break;
+
+	case CCL_ReadJump:	/* A--D--D--R--E--S--S-rrrYYYYY */
 	  CCL_READ_CHAR (reg[rrr]);
-	  continue;
-	case CCL_Read2:
+	  ic += ADDR;
+	  break;
+
+	case CCL_ReadBranch:	/* CCCCCCCCCCCCCCCCCCCCrrrXXXXX */
 	  CCL_READ_CHAR (reg[rrr]);
-	  CCL_READ_CHAR (reg[cc]);
-	  continue;
-	case CCL_Write1:
-	  CCL_WRITE_CHAR (reg[rrr]);
-	  continue;
-	case CCL_Write2:
-	  CCL_WRITE_CHAR (reg[rrr]);
-	  CCL_WRITE_CHAR (reg[cc]);
-	  continue;
-	case CCL_WriteC:
-	  i = XINT (prog[ic++]);
-	  CCL_WRITE_CHAR (i);
-	  continue;
-	case CCL_WriteS:
-	  cc = XINT (prog[ic]);
-	  CCL_WRITE_STRING (cc);
-	  ic += cc + 1;
-	  continue;
-	case CCL_WriteA:
-	  i = XINT (prog[ic++]);
-	  cc = reg[rrr];
-	  if (cc >= 0 && cc < i)
-	    CCL_WRITE_CHAR (XINT (prog[ic + cc]));
-	  ic += i;
-	  continue;
-	case CCL_End:
+	  /* fall through ... */
+	case CCL_Branch:	/* CCCCCCCCCCCCCCCCCCCCrrrXXXXX */
+	  if ((unsigned int) reg[rrr] < field1)
+	    ic += XINT (ccl_prog[ic + reg[rrr]]);
+	  else
+	    ic += XINT (ccl_prog[ic + field1]);
+	  break;
+
+	case CCL_ReadRegister:	/* CCCCCCCCCCCCCCCCCCCCrrXXXXX */
+	  while (1)
+	    {
+	      CCL_READ_CHAR (reg[rrr]);
+	      if (!field1) break;
+	      code = XINT (ccl_prog[ic]); ic++;
+	      field1 = code >> 8;
+	      field2 = (code & 0xFF) >> 5;
+	    }
+	  break;
+
+	case CCL_WriteExprConst:  /* 1:00000OPERATION000RRR000XXXXX */
+	  rrr = 7;
+	  i = reg[RRR];
+	  j = XINT (ccl_prog[ic]);
+	  op = field1 >> 6;
+	  ic++;
+	  goto ccl_set_expr;
+
+	case CCL_WriteRegister:	/* CCCCCCCCCCCCCCCCCCCrrrXXXXX */
+	  while (1)
+	    {
+	      i = reg[rrr];
+	      CCL_WRITE_CHAR (i);
+	      if (!field1) break;
+	      code = XINT (ccl_prog[ic]); ic++;
+	      field1 = code >> 8;
+	      field2 = (code & 0xFF) >> 5;
+	    }
+	  break;
+
+	case CCL_WriteExprRegister: /* 1:00000OPERATIONRrrRRR000XXXXX */
+	  rrr = 7;
+	  i = reg[RRR];
+	  j = reg[Rrr];
+	  op = field1 >> 6;
+	  goto ccl_set_expr;
+
+	case CCL_Call:		/* CCCCCCCCCCCCCCCCCCCC000XXXXX */
+	  {
+	    Lisp_Object slot;
+
+	    if (stack_idx >= 256
+		|| field1 < 0
+		|| field1 >= XVECTOR_LENGTH (Vccl_program_table)
+		|| (slot = XVECTOR_DATA (Vccl_program_table)[field1],
+		    !CONSP (slot))
+		|| !VECTORP (XCDR (slot)))
+	      {
+		if (stack_idx > 0)
+		  {
+		    ccl_prog = ccl_prog_stack_struct[0].ccl_prog;
+		    ic = ccl_prog_stack_struct[0].ic;
+		  }
+		CCL_INVALID_CMD;
+	      }
+	    
+	    ccl_prog_stack_struct[stack_idx].ccl_prog = ccl_prog;
+	    ccl_prog_stack_struct[stack_idx].ic = ic;
+	    stack_idx++;
+	    ccl_prog = XVECTOR_DATA (XCDR (slot));
+	    ic = CCL_HEADER_MAIN;
+	  }
+	  break;
+
+	case CCL_WriteConstString: /* CCCCCCCCCCCCCCCCCCCCrrrXXXXX */
+	  if (!rrr)
+	    CCL_WRITE_CHAR (field1);
+	  else
+	    {
+	      CCL_WRITE_STRING (field1);
+	      ic += (field1 + 2) / 3;
+	    }
+	  break;
+
+	case CCL_WriteArray:	/* CCCCCCCCCCCCCCCCCCCCrrrXXXXX */
+	  i = reg[rrr];
+	  if ((unsigned int) i < field1)
+	    {
+	      j = XINT (ccl_prog[ic + i]);
+	      CCL_WRITE_CHAR (j);
+	    }
+	  ic += field1;
+	  break;
+
+	case CCL_End:		/* 0000000000000000000000XXXXX */
+	  if (stack_idx-- > 0)
+	    {
+	      ccl_prog = ccl_prog_stack_struct[stack_idx].ccl_prog;
+	      ic = ccl_prog_stack_struct[stack_idx].ic;
+	      break;
+	    }
 	  CCL_SUCCESS;
-	case CCL_SetSelfCS:
-	  i = cc;
-	  op = XINT (prog[ic++]);
-	  goto ccl_set_self;
-	case CCL_SetSelfCL:
-	  i = XINT (prog[ic++]);
-	  op = XINT (prog[ic++]);
-	  goto ccl_set_self;
-	case CCL_SetSelfR:
-	  i = reg[cc];
-	  op = XINT (prog[ic++]);
-	  ccl_set_self:
+
+	case CCL_ExprSelfConst: /* 00000OPERATION000000rrrXXXXX */
+	  i = XINT (ccl_prog[ic]);
+	  ic++;
+	  op = field1 >> 6;
+	  goto ccl_expr_self;
+
+	case CCL_ExprSelfReg:	/* 00000OPERATION000RRRrrrXXXXX */
+	  i = reg[RRR];
+	  op = field1 >> 6;
+
+	ccl_expr_self:
 	  switch (op)
 	    {
-	    case CCL_PLUS:   reg[rrr] += i;  break;
-	    case CCL_MINUS:  reg[rrr] -= i;  break;
-	    case CCL_MUL:    reg[rrr] *= i;  break;
-	    case CCL_DIV:    reg[rrr] /= i;  break;
-	    case CCL_MOD:    reg[rrr] %= i;  break;
-	    case CCL_AND:    reg[rrr] &= i;  break;
-	    case CCL_OR:     reg[rrr] |= i;  break;
-	    case CCL_XOR:    reg[rrr] ^= i;  break;
-	    case CCL_LSH:    reg[rrr] <<= i; break;
-	    case CCL_RSH:    reg[rrr] >>= i; break;
-	    case CCL_LSH8:   reg[rrr] <<= 8; reg[rrr] |= i; break;
-	    case CCL_RSH8:   reg[7] = reg[rrr] & 0xFF; reg[rrr] >>= 8; break;
-	    case CCL_DIVMOD: reg[7] = reg[rrr] % i;    reg[rrr] /= i;  break;
-	    case CCL_LS:     reg[rrr] = reg[rrr] < i;  break;
-	    case CCL_GT:     reg[rrr] = reg[rrr] > i;  break;
-	    case CCL_EQ:     reg[rrr] = reg[rrr] == i; break;
-	    case CCL_LE:     reg[rrr] = reg[rrr] <= i; break;
-	    case CCL_GE:     reg[rrr] = reg[rrr] >= i; break;
-	    case CCL_NE:     reg[rrr] = reg[rrr] != i; break;
+	    case CCL_PLUS: reg[rrr] += i; break;
+	    case CCL_MINUS: reg[rrr] -= i; break;
+	    case CCL_MUL: reg[rrr] *= i; break;
+	    case CCL_DIV: reg[rrr] /= i; break;
+	    case CCL_MOD: reg[rrr] %= i; break;
+	    case CCL_AND: reg[rrr] &= i; break;
+	    case CCL_OR: reg[rrr] |= i; break;
+	    case CCL_XOR: reg[rrr] ^= i; break;
+	    case CCL_LSH: reg[rrr] <<= i; break;
+	    case CCL_RSH: reg[rrr] >>= i; break;
+	    case CCL_LSH8: reg[rrr] <<= 8; reg[rrr] |= i; break;
+	    case CCL_RSH8: reg[7] = reg[rrr] & 0xFF; reg[rrr] >>= 8; break;
+	    case CCL_DIVMOD: reg[7] = reg[rrr] % i; reg[rrr] /= i; break;
+	    case CCL_LS: reg[rrr] = reg[rrr] < i; break;
+	    case CCL_GT: reg[rrr] = reg[rrr] > i; break;
+	    case CCL_EQ: reg[rrr] = reg[rrr] == i; break;
+	    case CCL_LE: reg[rrr] = reg[rrr] <= i; break;
+	    case CCL_GE: reg[rrr] = reg[rrr] >= i; break;
+	    case CCL_NE: reg[rrr] = reg[rrr] != i; break;
 	    default: CCL_INVALID_CMD;
 	    }
-	    continue;
-	case CCL_SetExprCL:
-	  i = reg[cc];
-	  j = XINT (prog[ic++]);
-	  op = XINT (prog[ic++]);
-	  cc = 0;
+	  break;
+
+	case CCL_SetExprConst:	/* 00000OPERATION000RRRrrrXXXXX */
+	  i = reg[RRR];
+	  j = XINT (ccl_prog[ic]);
+	  op = field1 >> 6;
+	  jump_address = ++ic;
 	  goto ccl_set_expr;
-	case CCL_SetExprR:
-	  i = reg[cc];
-	  j = reg[XINT (prog[ic++])];
-	  op = XINT (prog[ic++]);
-	  cc = 0;
+
+	case CCL_SetExprReg:	/* 00000OPERATIONRrrRRRrrrXXXXX */
+	  i = reg[RRR];
+	  j = reg[Rrr];
+	  op = field1 >> 6;
+	  jump_address = ic;
 	  goto ccl_set_expr;
-	case CCL_ReadJumpCondC:
+
+	case CCL_ReadJumpCondExprConst: /* A--D--D--R--E--S--S-rrrXXXXX */
 	  CCL_READ_CHAR (reg[rrr]);
-	case CCL_JumpCondC:
+	case CCL_JumpCondExprConst: /* A--D--D--R--E--S--S-rrrXXXXX */
 	  i = reg[rrr];
-	  j = XINT (prog[ic++]);
+	  op = XINT (ccl_prog[ic]);
+	  jump_address = ic++ + ADDR;
+	  j = XINT (ccl_prog[ic]);
+	  ic++;
 	  rrr = 7;
-	  op = XINT (prog[ic++]);
 	  goto ccl_set_expr;
-	case CCL_ReadJumpCondR:
+
+	case CCL_ReadJumpCondExprReg: /* A--D--D--R--E--S--S-rrrXXXXX */
 	  CCL_READ_CHAR (reg[rrr]);
-	case CCL_JumpCondR:
+	case CCL_JumpCondExprReg:
 	  i = reg[rrr];
-	  j = reg[XINT (prog[ic++])];
+	  op = XINT (ccl_prog[ic]);
+	  jump_address = ic++ + ADDR;
+	  j = reg[XINT (ccl_prog[ic])];
+	  ic++;
 	  rrr = 7;
-	  op = XINT (prog[ic++]);
-	  ccl_set_expr:
+
+	ccl_set_expr:
 	  switch (op)
 	    {
-	    case CCL_PLUS:   reg[rrr] = i + j;  break;
-	    case CCL_MINUS:  reg[rrr] = i - j;  break;
-	    case CCL_MUL:    reg[rrr] = i * j;  break;
-	    case CCL_DIV:    reg[rrr] = i / j;  break;
-	    case CCL_MOD:    reg[rrr] = i % j;  break;
-	    case CCL_AND:    reg[rrr] = i & j;  break;
-	    case CCL_OR:     reg[rrr] = i | j;  break;
-	    case CCL_XOR:    reg[rrr] = i ^ j;; break;
-	    case CCL_LSH:    reg[rrr] = i << j; break;
-	    case CCL_RSH:    reg[rrr] = i >> j; break;
-	    case CCL_LSH8:   reg[rrr] = (i << 8) | j; break;
-	    case CCL_RSH8:   reg[rrr] = i >> 8; reg[7] = i & 0xFF; break;
-	    case CCL_DIVMOD: reg[rrr] = i / j;  reg[7] = i % j;    break;
-	    case CCL_LS:     reg[rrr] = i < j;  break;
-	    case CCL_GT:     reg[rrr] = i > j;  break;
-	    case CCL_EQ:     reg[rrr] = i == j; break;
-	    case CCL_LE:     reg[rrr] = i <= j; break;
-	    case CCL_GE:     reg[rrr] = i >= j; break;
-	    case CCL_NE:     reg[rrr] = i != j; break;
+	    case CCL_PLUS: reg[rrr] = i + j; break;
+	    case CCL_MINUS: reg[rrr] = i - j; break;
+	    case CCL_MUL: reg[rrr] = i * j; break;
+	    case CCL_DIV: reg[rrr] = i / j; break;
+	    case CCL_MOD: reg[rrr] = i % j; break;
+	    case CCL_AND: reg[rrr] = i & j; break;
+	    case CCL_OR: reg[rrr] = i | j; break;
+	    case CCL_XOR: reg[rrr] = i ^ j;; break;
+	    case CCL_LSH: reg[rrr] = i << j; break;
+	    case CCL_RSH: reg[rrr] = i >> j; break;
+	    case CCL_LSH8: reg[rrr] = (i << 8) | j; break;
+	    case CCL_RSH8: reg[rrr] = i >> 8; reg[7] = i & 0xFF; break;
+	    case CCL_DIVMOD: reg[rrr] = i / j; reg[7] = i % j; break;
+	    case CCL_LS: reg[rrr] = i < j; break;
+	    case CCL_GT: reg[rrr] = i > j; break;
+	    case CCL_EQ: reg[rrr] = i == j; break;
+	    case CCL_LE: reg[rrr] = i <= j; break;
+	    case CCL_GE: reg[rrr] = i >= j; break;
+	    case CCL_NE: reg[rrr] = i != j; break;
+	    case CCL_ENCODE_SJIS: ENCODE_SJIS (i, j, reg[rrr], reg[7]); break;
+	    case CCL_DECODE_SJIS: DECODE_SJIS (i, j, reg[rrr], reg[7]); break;
 	    default: CCL_INVALID_CMD;
 	    }
-	    if (cc && !reg[rrr])
-	      ic = cc;
-	    continue;
+	  code &= 0x1F;
+	  if (code == CCL_WriteExprConst || code == CCL_WriteExprRegister)
+	    {
+	      i = reg[rrr];
+	      CCL_WRITE_CHAR (i);
+	    }
+	  else if (!reg[rrr])
+	    ic = jump_address;
+	  break;
+
 	default:
 	  CCL_INVALID_CMD;
 	}
     }
 
-  ccl_error_handler:
-  if (dst)
+ ccl_error_handler:
+  if (destination)
     {
-      char buf[200];
+      /* We can insert an error message only if DESTINATION is
+         specified and we still have a room to store the message
+         there.  */
+      char msg[256];
+
       switch (ccl->status)
 	{
 	case CCL_STAT_INVALID_CMD:
-	  sprintf (buf, "CCL: Invalid command (%x).\n", op);
+	  sprintf(msg, "\nCCL: Invalid command %x (ccl_code = %x) at %d.",
+		  code & 0x1F, code, ic);
+#ifdef CCL_DEBUG
+	  {
+	    int i = ccl_backtrace_idx - 1;
+	    int j;
+
+	    Dynarr_add_many (destination, (unsigned char *) msg, strlen (msg));
+
+	    for (j = 0; j < CCL_DEBUG_BACKTRACE_LEN; j++, i--)
+	      {
+		if (i < 0) i = CCL_DEBUG_BACKTRACE_LEN - 1;
+		if (ccl_backtrace_table[i] == 0)
+		  break;
+		sprintf(msg, " %d", ccl_backtrace_table[i]);
+		Dynarr_add_many (destination, (unsigned char *) msg, strlen (msg));
+	      }
+	  }
+#endif
+	  goto ccl_finish;
+
+	case CCL_STAT_QUIT:
+	  sprintf(msg, "\nCCL: Quited.");
 	  break;
+
 	default:
-	  sprintf (buf, "CCL: Unknown error type (%d).\n", ccl->status);
+	  sprintf(msg, "\nCCL: Unknown error type (%d).", ccl->status);
 	}
-      Dynarr_add_many (dst, (unsigned char *) buf, strlen (buf));
+
+      Dynarr_add_many (destination, (unsigned char *) msg, strlen (msg));
     }
 
-  ccl_finish:
+ ccl_finish:
   ccl->ic = ic;
-  if (dst)
-    return Dynarr_length (dst);
+  if (consumed) *consumed = src - source;
+  if (destination)
+    return Dynarr_length (destination);
   else
     return 0;
 }
 
-/* Set up CCL to execute CCL program VAL, with initial register values
-   coming from REGS (NUMREGS of them are specified) and initial
-   instruction counter coming from INITIAL_IC (a value of 0 means
-   start at the beginning of the program, wherever that is).
-   */
-
+/* Setup fields of the structure pointed by CCL appropriately for the
+   execution of compiled CCL code in VEC (vector of integer).  */
 void
-set_ccl_program (struct ccl_program *ccl, Lisp_Object val, int *regs,
-		 int numregs, int initial_ic)
+setup_ccl_program (ccl, vec)
+     struct ccl_program *ccl;
+     Lisp_Object vec;
 {
   int i;
 
-  ccl->saved_vector = val;
-  ccl->prog = XVECTOR_DATA (val);
-  ccl->size = XVECTOR_LENGTH (val);
-  if (initial_ic == 0)
-    ccl->ic = CCL_HEADER_MAIN;
-  else
-    ccl->ic = initial_ic;
-  for (i = 0; i < numregs; i++)
-    ccl->reg[i] = regs[i];
-  for (; i < 8; i++)
+  ccl->size = XVECTOR_LENGTH (vec);
+  ccl->prog = XVECTOR_DATA (vec);
+  ccl->ic = CCL_HEADER_MAIN;
+  ccl->eof_ic = XINT (XVECTOR_DATA (vec)[CCL_HEADER_EOF]);
+  ccl->buf_magnification = XINT (XVECTOR_DATA (vec)[CCL_HEADER_BUF_MAG]);
+  for (i = 0; i < 8; i++)
     ccl->reg[i] = 0;
-  ccl->end_flag = 0;
+  ccl->last_block = 0;
   ccl->status = 0;
 }
 
 #ifdef emacs
 
-static void
-set_ccl_program_from_lisp_values (struct ccl_program *ccl,
-				  Lisp_Object prog,
-				  Lisp_Object status)
+DEFUN ("ccl-execute", Fccl_execute, 2, 2, 0, /*
+Execute CCL-PROGRAM with registers initialized by REGISTERS.
+CCL-PROGRAM is a compiled code generated by `ccl-compile',
+ no I/O commands should appear in the CCL program.
+REGISTERS is a vector of [R0 R1 ... R7] where RN is an initial value
+ of Nth register.
+As side effect, each element of REGISTER holds the value of
+ corresponding register after the execution.
+*/
+  (ccl_prog, reg))
 {
+  struct ccl_program ccl;
   int i;
-  int intregs[8];
-  int ic;
+
+  CHECK_VECTOR (ccl_prog);
+  CHECK_VECTOR (reg);
+  if (XVECTOR_LENGTH (reg) != 8)
+    error ("Invalid length of vector REGISTERS");
+
+  setup_ccl_program (&ccl, ccl_prog);
+  for (i = 0; i < 8; i++)
+    ccl.reg[i] = (INTP (XVECTOR_DATA (reg)[i])
+		  ? XINT (XVECTOR_DATA (reg)[i])
+		  : 0);
+
+  ccl_driver (&ccl, (CONST unsigned char *)0, (unsigned_char_dynarr *)0,
+	      0, (int *)0);
+  QUIT;
+  if (ccl.status != CCL_STAT_SUCCESS)
+    error ("Error in CCL program at %dth code", ccl.ic);
+
+  for (i = 0; i < 8; i++)
+    XSETINT (XVECTOR_DATA (reg)[i], ccl.reg[i]);
+  return Qnil;
+}
 
-  CHECK_VECTOR (prog);
+DEFUN ("ccl-execute-on-string", Fccl_execute_on_string, 3, 4, 0, /*
+Execute CCL-PROGRAM with initial STATUS on STRING.
+CCL-PROGRAM is a compiled code generated by `ccl-compile'.
+Read buffer is set to STRING, and write buffer is allocated automatically.
+STATUS is a vector of [R0 R1 ... R7 IC], where
+ R0..R7 are initial values of corresponding registers,
+ IC is the instruction counter specifying from where to start the program.
+If R0..R7 are nil, they are initialized to 0.
+If IC is nil, it is initialized to head of the CCL program.
+Returns the contents of write buffer as a string,
+ and as side effect, STATUS is updated.
+If optional 4th arg CONTINUE is non-nil, keep IC on read operation
+when read buffer is exausted, else, IC is always set to the end of
+CCL-PROGRAM on exit.
+*/
+  (ccl_prog, status, str, contin))
+{
+  Lisp_Object val;
+  struct ccl_program ccl;
+  int i, produced;
+  unsigned_char_dynarr *outbuf;
+  struct gcpro gcpro1, gcpro2, gcpro3;
+
+  CHECK_VECTOR (ccl_prog);
   CHECK_VECTOR (status);
+  if (XVECTOR_LENGTH (status) != 9)
+    error ("Invalid length of vector STATUS");
+  CHECK_STRING (str);
+  GCPRO3 (ccl_prog, status, str);
 
-  if (XVECTOR_LENGTH (status) != 9)
-    signal_simple_error ("Must specify values for the eight registers and IC",
-			 status);
+  setup_ccl_program (&ccl, ccl_prog);
   for (i = 0; i < 8; i++)
     {
-      Lisp_Object regval = XVECTOR_DATA (status)[i];
-      if (NILP (regval))
-	intregs[i] = 0;
-      else
+      if (NILP (XVECTOR_DATA (status)[i]))
+	XSETINT (XVECTOR_DATA (status)[i], 0);
+      if (INTP (XVECTOR_DATA (status)[i]))
+	ccl.reg[i] = XINT (XVECTOR_DATA (status)[i]);
+    }
+  if (INTP (XVECTOR_DATA (status)[8]))
+    {
+      i = XINT (XVECTOR_DATA (status)[8]);
+      if (ccl.ic < i && i < ccl.size)
+	ccl.ic = i;
+    }
+  outbuf = Dynarr_new (unsigned_char);
+  ccl.last_block = NILP (contin);
+  produced = ccl_driver (&ccl, XSTRING_DATA (str), outbuf,
+			 XSTRING_LENGTH (str), (int *)0);
+  for (i = 0; i < 8; i++)
+    XVECTOR_DATA (status)[i] = make_int(ccl.reg[i]);
+  XSETINT (XVECTOR_DATA (status)[8], ccl.ic);
+  UNGCPRO;
+
+  val = make_string (Dynarr_atp (outbuf, 0), produced);
+  free (outbuf);
+  QUIT;
+  if (ccl.status != CCL_STAT_SUCCESS
+      && ccl.status != CCL_STAT_SUSPEND)
+    error ("Error in CCL program at %dth code", ccl.ic);
+
+  return val;
+}
+
+DEFUN ("register-ccl-program", Fregister_ccl_program, 2, 2, 0, /*
+Register CCL program PROGRAM of NAME in `ccl-program-table'.
+PROGRAM should be a compiled code of CCL program, or nil.
+Return index number of the registered CCL program.
+*/
+  (name, ccl_prog))
+{
+  int len = XVECTOR_LENGTH (Vccl_program_table);
+  int i;
+
+  CHECK_SYMBOL (name);
+  if (!NILP (ccl_prog))
+    CHECK_VECTOR (ccl_prog);
+  
+  for (i = 0; i < len; i++)
+    {
+      Lisp_Object slot = XVECTOR_DATA (Vccl_program_table)[i];
+
+      if (!CONSP (slot))
+	break;
+
+      if (EQ (name, XCAR (slot)))
 	{
-	  CHECK_INT (regval);
-	  intregs[i] = XINT (regval);
+	  XCDR (slot) = ccl_prog;
+	  return make_int (i);
 	}
     }
 
-  {
-    Lisp_Object lic = XVECTOR_DATA (status)[8];
-    if (NILP (lic))
-      ic = 0;
-    else
-      {
-	CHECK_NATNUM (lic);
-	ic = XINT (lic);
-      }
-  }
-
-  set_ccl_program (ccl, prog, intregs, 8, ic);
-}
-
-static void
-set_lisp_status_from_ccl_program (Lisp_Object status,
-				  struct ccl_program *ccl)
-{
-  int i;
-
-  for (i = 0; i < 8; i++)
-    XVECTOR_DATA (status)[i] = make_int (ccl->reg[i]);
-  XVECTOR_DATA (status)[8] = make_int (ccl->ic);
-}
-
-
-DEFUN ("execute-ccl-program", Fexecute_ccl_program, 2, 2, 0, /*
-Execute CCL-PROGRAM with registers initialized by STATUS.
-CCL-PROGRAM is a vector of compiled CCL code created by `ccl-compile'.
-STATUS must be a vector of nine values, specifying the initial value
- for the R0, R1 .. R7 registers and for the instruction counter IC.
-A nil value for a register initializer causes the register to be set
-to 0.  A nil value for the IC initializer causes execution to start
- at the beginning of the program.
-When the program is done, STATUS is modified (by side-effect) to contain
- the ending values for the corresponding registers and IC.
-*/
-       (ccl_program, status))
-{
-  struct ccl_program ccl;
-
-  set_ccl_program_from_lisp_values (&ccl, ccl_program, status);
-  ccl_driver (&ccl, 0, 0, 0, 0);
-  set_lisp_status_from_ccl_program (status, &ccl);
-  return Qnil;
-}
+  if (i == len)
+    {
+      Lisp_Object new_table = Fmake_vector (make_int (len * 2), Qnil);
+      int j;
 
-DEFUN ("execute-ccl-program-string", Fexecute_ccl_program_string, 3, 3, 0, /*
-Execute CCL-PROGRAM with initial STATUS on STRING.
-CCL-PROGRAM is a vector of compiled CCL code created by `ccl-compile'.
-STATUS must be a vector of nine values, specifying the initial value
- for the R0, R1 .. R7 registers and for the instruction counter IC.
-A nil value for a register initializer causes the register to be set
-to 0.  A nil value for the IC initializer causes execution to start
- at the beginning of the program.
-When the program is done, STATUS is modified (by side-effect) to contain
- the ending values for the corresponding registers and IC.
-Returns the resulting string.
-*/
-       (ccl_program, status, str))
-{
-  struct ccl_program ccl;
-  Lisp_Object val;
-  int len;
-  unsigned_char_dynarr *outbuf;
-
-  set_ccl_program_from_lisp_values (&ccl, ccl_program, status);
-  CHECK_STRING (str);
+      for (j = 0; j < len; j++)
+	XVECTOR_DATA (new_table)[j]
+	  = XVECTOR_DATA (Vccl_program_table)[j];
+      Vccl_program_table = new_table;
+    }
 
-  outbuf = Dynarr_new (unsigned_char);
-  len = ccl_driver (&ccl, XSTRING_DATA (str), outbuf, XSTRING_LENGTH (str), 0);
-  ccl_driver (&ccl, (unsigned char *) "", outbuf, 0, 1);
-  set_lisp_status_from_ccl_program (status, &ccl);
-
-  val = make_string (Dynarr_atp (outbuf, 0), len);
-  Dynarr_free (outbuf);
-  return val;
-}
-
-DEFUN ("ccl-reset-elapsed-time", Fccl_reset_elapsed_time, 0, 0, 0, /*
-Reset the internal value which holds the time elapsed by CCL interpreter.
-*/
-       ())
-{
-  error ("Not yet implemented; use `current-process-time'");
-  return Qnil;
-}
-
-DEFUN ("ccl-elapsed-time", Fccl_elapsed_time, 0, 0, 0, /*
-Return the time elapsed by CCL interpreter as cons of user and system time.
-This measures processor time, not real time.  Both values are floating point
-numbers measured in seconds.  If only one overall value can be determined,
-the return value will be a cons of that value and 0.
-*/
-       ())
-{
-  error ("Not yet implemented; use `current-process-time'");
-  return Qnil;
+  XVECTOR_DATA (Vccl_program_table)[i] = Fcons (name, ccl_prog);
+  return make_int (i);
 }
 
 void
 syms_of_mule_ccl (void)
 {
-  DEFSUBR (Fexecute_ccl_program);
-  DEFSUBR (Fexecute_ccl_program_string);
-  DEFSUBR (Fccl_reset_elapsed_time);
-  DEFSUBR (Fccl_elapsed_time);
+  staticpro (&Vccl_program_table);
+  Vccl_program_table = Fmake_vector (make_int (32), Qnil);
+
+  DEFVAR_LISP ("font-ccl-encoder-alist", &Vfont_ccl_encoder_alist /*
+Alist of fontname patterns vs corresponding CCL program.
+Each element looks like (REGEXP . CCL-CODE),
+ where CCL-CODE is a compiled CCL program.
+When a font whose name matches REGEXP is used for displaying a character,
+ CCL-CODE is executed to calculate the code point in the font
+ from the charset number and position code(s) of the character which are set
+ in CCL registers R0, R1, and R2 before the execution.
+The code point in the font is set in CCL registers R1 and R2
+ when the execution terminated.
+If the font is single-byte font, the register R2 is not used.
+*/ );
+  Vfont_ccl_encoder_alist = Qnil;
+
+  DEFSUBR (Fccl_execute);
+  DEFSUBR (Fccl_execute_on_string);
+  DEFSUBR (Fregister_ccl_program);
 }
 
-#else  /* not emacs */
-#ifdef standalone
-
-#define INBUF_SIZE 1024
-#define MAX_CCL_CODE_SIZE 4096
-
-void
-main (int argc, char **argv)
-{
-  FILE *progf;
-  char inbuf[INBUF_SIZE];
-  unsigned_char_dynarr *outbuf;
-  struct ccl_program ccl;
-  int i;
-  Lisp_Object ccl_prog = make_vector (MAX_CCL_CODE_SIZE);
-
-  if (argc < 2)
-    {
-      fprintf (stderr,
-	       "Usage: %s ccl_program_file_name <infile >outfile\n",
-	       argv[0]);
-      exit (1);
-    }
-
-  if ((progf = fopen (argv[1], "r")) == NULL)
-    {
-      fprintf (stderr, "%s: Can't read file %s", argv[0], argv[1]);
-      exit (1);
-    }
-
-  XVECTOR_LENGTH (ccl_prog) = 0;
-  while (fscanf (progf, "%x", &i) == 1)
-    XVECTOR_DATA (ccl_prog)[XVECTOR_LENGTH (ccl_prog)++] = make_int (i);
-  set_ccl_program (&ccl, ccl_prog, 0, 0, 0);
-
-  outbuf = Dynarr_new (unsigned char);
-
-  while ((i = fread (inbuf, 1, INBUF_SIZE, stdin)) == INBUF_SIZE)
-    {
-      i = ccl_driver (&ccl, inbuf, outbuf, INBUF_SIZE, 0);
-      fwrite (Dynarr_atp (outbuf, 0), 1, i, stdout);
-    }
-  if (i)
-    {
-      i = ccl_driver (&ccl, inbuf, outbuf, i, 1);
-      fwrite (Dynarr_atp (outbuf, 0), 1, i, stdout);
-    }
-
-  fclose (progf);
-  exit (0);
-}
-#endif  /* standalone */
-#endif  /* not emacs */
+#endif  /* emacs */