Initial revision

1 files changed, 1140 insertions, 0 deletions

diff --git a/src/ccl.c b/src/ccl.c
new file mode 100644
index 00000000000..11c1ae500d6
--- /dev/null
+++ b/src/ccl.c
@@ -0,0 +1,1140 @@
+/* CCL (Code Conversion Language) interpreter.
+   Ver.1.0
+
+   Copyright (C) 1995 Free Software Foundation, Inc.
+   Copyright (C) 1995 Electrotechnical Laboratory, JAPAN.
+
+   This program 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.
+
+   This program 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 this program; if not, write to the Free Software
+   Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.  */
+
+#include <stdio.h>
+
+#ifdef emacs
+
+#include <config.h>
+#include "lisp.h"
+#include "charset.h"
+#include "ccl.h"
+#include "coding.h"
+
+#else  /* not emacs */
+
+#include "mulelib.h"
+
+#endif /* not emacs */
+
+/* Alist of fontname patterns vs corresponding CCL program.  */
+Lisp_Object Vfont_ccl_encoder_alist;
+
+/* 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_BUF_MAG	0
+#define CCL_HEADER_EOF		1
+#define CCL_HEADER_MAIN		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:
+
+	|----------------- 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_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_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_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;
+					*/
+
+
+#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
+   Mth 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.  */
+
+#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 negative, write one byte -CH.  */
+#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;			      	\
+      }					      	\
+  } while (0)
+
+/* Write a string at ccl_prog[IC] of length LEN to the current output
+   buffer.  */
+#define CCL_WRITE_STRING(len)				\
+  do {							\
+    if (!dst)						\
+      CCL_INVALID_CMD;					\
+    else if (dst + len <= dst_end)			\
+      for (i = 0; i < len; i++)				\
+	*dst++ = ((XFASTINT (ccl_prog[ic + (i / 3)]))	\
+		  >> ((2 - (i % 3)) * 8)) & 0xFF;	\
+    else						\
+      CCL_SUSPEND;					\
+  } 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 length of which
+   should not exceed DST_BYTES.  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
+  {
+    int *ccl_prog;		/* Pointer to an array of CCL code.  */
+    int ic;			/* Instruction Counter.  */
+  };
+
+ccl_driver (ccl, source, destination, src_bytes, dst_bytes, consumed)
+     struct ccl_program *ccl;
+     unsigned char *source, *destination;
+     int src_bytes, dst_bytes;
+     int *consumed;
+{
+  register int *reg = ccl->reg;
+  register int ic = ccl->ic;
+  register int code, field1, field2;
+  register int *ccl_prog = ccl->prog;
+  unsigned char *src = source, *src_end = src + src_bytes;
+  unsigned char *dst = destination, *dst_end = dst + dst_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 >= ccl->eof_ic)
+    ic = CCL_HEADER_MAIN;
+
+#ifdef CCL_DEBUG
+  ccl_backtrace_idx = 0;
+#endif
+
+  for (;;)
+    {
+#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
+
+      if (!NILP (Vquit_flag) && NILP (Vinhibit_quit))
+	{
+	  /* 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 += 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 += 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 += 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 = ccl_prog[ic++];
+	  if ((unsigned int) i < j)
+	    {
+	      i = XINT (ccl_prog[ic + i]);
+	      CCL_WRITE_CHAR (i);
+	    }
+	  ic += j + 1;
+	  CCL_READ_CHAR (reg[rrr]);
+	  ic += ADDR - (j + 2);
+	  break;
+
+	case CCL_ReadJump:	/* A--D--D--R--E--S--S-rrrYYYYY */
+	  CCL_READ_CHAR (reg[rrr]);
+	  ic += ADDR;
+	  break;
+
+	case CCL_ReadBranch:	/* CCCCCCCCCCCCCCCCCCCCrrrXXXXX */
+	  CCL_READ_CHAR (reg[rrr]);
+	  /* 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 (Vccl_program_table)->size
+		|| (slot = XVECTOR (Vccl_program_table)->contents[field1],
+		    !CONSP (slot))
+		|| !VECTORP (XCONS (slot)->cdr))
+	      {
+		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 (XCONS (slot)->cdr)->contents;
+	    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_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;
+	    default: CCL_INVALID_CMD;
+	    }
+	  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_SetExprReg:	/* 00000OPERATIONRrrRRRrrrXXXXX */
+	  i = reg[RRR];
+	  j = reg[Rrr];
+	  op = field1 >> 6;
+	  jump_address = ic;
+	  goto ccl_set_expr;
+
+	case CCL_ReadJumpCondExprConst: /* A--D--D--R--E--S--S-rrrXXXXX */
+	  CCL_READ_CHAR (reg[rrr]);
+	case CCL_JumpCondExprConst: /* A--D--D--R--E--S--S-rrrXXXXX */
+	  i = reg[rrr];
+	  op = XINT (ccl_prog[ic]);
+	  jump_address = ic++ + ADDR;
+	  j = XINT (ccl_prog[ic]);
+	  ic++;
+	  rrr = 7;
+	  goto ccl_set_expr;
+
+	case CCL_ReadJumpCondExprReg: /* A--D--D--R--E--S--S-rrrXXXXX */
+	  CCL_READ_CHAR (reg[rrr]);
+	case CCL_JumpCondExprReg:
+	  i = reg[rrr];
+	  op = XINT (ccl_prog[ic]);
+	  jump_address = ic++ + ADDR;
+	  j = reg[XINT (ccl_prog[ic])];
+	  ic++;
+	  rrr = 7;
+
+	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_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;
+	    }
+	  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 (destination)
+    {
+      /* 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];
+      int msglen;
+
+      switch (ccl->status)
+	{
+	case CCL_STAT_INVALID_CMD:
+	  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;
+
+	    msglen = strlen (msg);
+	    if (dst + msglen <= dst_end)
+	      {
+		bcopy (msg, dst, msglen);
+		dst += msglen;
+	      }
+
+	    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]);
+		msglen = strlen (msg);
+		if (dst + msglen > dst_end)
+		  break;
+		bcopy (msg, dst, msglen);
+		dst += msglen;
+	      }
+	  }
+	  goto ccl_finish;
+#endif
+
+	case CCL_STAT_QUIT:
+	  sprintf(msg, "\nCCL: Quited.");
+	  break;
+
+	default:
+	  sprintf(msg, "\nCCL: Unknown error type (%d).", ccl->status);
+	}
+
+      msglen = strlen (msg);
+      if (dst + msglen <= dst_end)
+	{
+	  bcopy (msg, dst, msglen);
+	  dst += msglen;
+	}
+    }
+
+ ccl_finish:
+  ccl->ic = ic;
+  if (consumed) *consumed = src - source;
+  return dst - destination;
+}
+
+/* Setup fields of the structure pointed by CCL appropriately for the
+   execution of compiled CCL code in VEC (vector of integer).  */
+setup_ccl_program (ccl, vec)
+     struct ccl_program *ccl;
+     Lisp_Object vec;
+{
+  int i;
+
+  ccl->size = XVECTOR (vec)->size;
+  ccl->prog = XVECTOR (vec)->contents;
+  ccl->ic = CCL_HEADER_MAIN;
+  ccl->eof_ic = XINT (XVECTOR (vec)->contents[CCL_HEADER_EOF]);
+  ccl->buf_magnification = XINT (XVECTOR (vec)->contents[CCL_HEADER_BUF_MAG]);
+  for (i = 0; i < 8; i++)
+    ccl->reg[i] = 0;
+  ccl->last_block = 0;
+  ccl->status = 0;
+}
+
+#ifdef emacs
+
+DEFUN ("ccl-execute", Fccl_execute, Sccl_execute, 2, 2, 0,
+  "Execute CCL-PROGRAM with registers initialized by REGISTERS.\n\
+CCL-PROGRAM is a compiled code generated by `ccl-compile',\n\
+ no I/O commands should appear in the CCL program.\n\
+REGISTERS is a vector of [R0 R1 ... R7] where RN is an initial value\n\
+ of Nth register.\n\
+As side effect, each element of REGISTER holds the value of\n\
+ corresponding register after the execution.")
+  (ccl_prog, reg)
+     Lisp_Object ccl_prog, reg;
+{
+  struct ccl_program ccl;
+  int i;
+
+  CHECK_VECTOR (ccl_prog, 0);
+  CHECK_VECTOR (reg, 1);
+  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])
+		  : 0);
+
+  ccl_driver (&ccl, (char *)0, (char *)0, 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 (reg)->contents[i], ccl.reg[i]);
+  return Qnil;
+}
+
+DEFUN ("ccl-execute-on-string", Fccl_execute_on_string, Sccl_execute_on_string,
+       3, 3, 0,
+  "Execute CCL-PROGRAM with initial STATUS on STRING.\n\
+CCL-PROGRAM is a compiled code generated by `ccl-compile'.\n\
+Read buffer is set to STRING, and write buffer is allocated automatically.\n\
+STATUS is a vector of [R0 R1 ... R7 IC], where\n\
+ R0..R7 are initial values of corresponding registers,\n\
+ IC is the instruction counter specifying from where to start the program.\n\
+If R0..R7 are nil, they are initialized to 0.\n\
+If IC is nil, it is initialized to head of the CCL program.\n\
+Returns the contents of write buffer as a string,\n\
+ and as side effect, STATUS is updated.")
+  (ccl_prog, status, str)
+     Lisp_Object ccl_prog, status, str;
+{
+  Lisp_Object val;
+  struct ccl_program ccl;
+  int i, produced;
+  int outbufsize;
+  char *outbuf;
+  struct gcpro gcpro1, gcpro2, gcpro3;
+
+  CHECK_VECTOR (ccl_prog, 0);
+  CHECK_VECTOR (status, 1);
+  if (XVECTOR (status)->size != 9)
+    error ("Invalid length of vector STATUS");
+  CHECK_STRING (str, 2);
+  GCPRO3 (ccl_prog, 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]))
+	ccl.reg[i] = XINT (XVECTOR (status)->contents[i]);
+    }
+  if (INTEGERP (XVECTOR (status)->contents[i]))
+    {
+      i = XFASTINT (XVECTOR (status)->contents[8]);
+      if (ccl.ic < i && i < ccl.size)
+	ccl.ic = i;
+    }
+  outbufsize = XSTRING (str)->size * ccl.buf_magnification + 256;
+  outbuf = (char *) xmalloc (outbufsize);
+  if (!outbuf)
+    error ("Not enough memory");
+  ccl.last_block = 1;
+  produced = ccl_driver (&ccl, XSTRING (str)->data, outbuf,
+			 XSTRING (str)->size, outbufsize, (int *)0);
+  for (i = 0; i < 8; i++)
+    XSET (XVECTOR (status)->contents[i], Lisp_Int, ccl.reg[i]);
+  XSETINT (XVECTOR (status)->contents[8], ccl.ic);
+  UNGCPRO;
+
+  val = make_string (outbuf, 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, Sregister_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)
+     Lisp_Object name, ccl_prog;
+{
+  int len = XVECTOR (Vccl_program_table)->size;
+  int i, idx;
+
+  CHECK_SYMBOL (name, 0);
+  if (!NILP (ccl_prog))
+    CHECK_VECTOR (ccl_prog, 1);
+  
+  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;
+	  return make_number (i);
+	}
+    }
+
+  if (i == len)
+    {
+      Lisp_Object new_table = Fmake_vector (len * 2, Qnil);
+      int j;
+
+      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);
+  return make_number (i);
+}
+
+syms_of_ccl ()
+{
+  staticpro (&Vccl_program_table);
+  Vccl_program_table = Fmake_vector (32, 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\
+ where CCL-CODE is a compiled CCL program.\n\
+When a font whose name matches REGEXP is used for displaying a character,\n\
+ CCL-CODE is executed to calculate the code point in the font\n\
+ from the charset number and position code(s) of the character which are set\n\
+ in CCL registers R0, R1, and R2 before the execution.\n\
+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_execute);
+  defsubr (&Sccl_execute_on_string);
+  defsubr (&Sregister_ccl_program);
+}
+
+#endif  /* emacs */