#include <config.h>
#include <stdio.h>
#include "lisp.h"
#include "charset.h"
#include "ccl.h"
#include "coding.h"
Lisp_Object Vcode_conversion_map_vector;
Lisp_Object Vfont_ccl_encoder_alist;
Lisp_Object Qccl_program;
Lisp_Object Qcode_conversion_map;
Lisp_Object Qcode_conversion_map_id;
Lisp_Object Qccl_program_idx;
Lisp_Object Vccl_program_table;
Lisp_Object Vtranslation_hash_table_vector;
#define GET_HASH_TABLE(id) \
(XHASH_TABLE (XCDR(XVECTOR(Vtranslation_hash_table_vector)->contents[(id)])))
#define CCL_HEADER_BUF_MAG 0
#define CCL_HEADER_EOF 1
#define CCL_HEADER_MAIN 2
#define CCL_SetRegister 0x00
#define CCL_SetShortConst 0x01
#define CCL_SetConst 0x02
#define CCL_SetArray 0x03
#define CCL_Jump 0x04
#define CCL_JumpCond 0x05
#define CCL_WriteRegisterJump 0x06
#define CCL_WriteRegisterReadJump 0x07
#define CCL_WriteConstJump 0x08
#define CCL_WriteConstReadJump 0x09
#define CCL_WriteStringJump 0x0A
#define CCL_WriteArrayReadJump 0x0B
#define CCL_ReadJump 0x0C
#define CCL_Branch 0x0D
#define CCL_ReadRegister 0x0E
#define CCL_WriteExprConst 0x0F
#define CCL_ReadBranch 0x10
#define CCL_WriteRegister 0x11
#define CCL_WriteExprRegister 0x12
#define CCL_Call 0x13
#define CCL_WriteConstString 0x14
#define CCL_WriteArray 0x15
#define CCL_End 0x16
#define CCL_ExprSelfConst 0x17
#define CCL_ExprSelfReg 0x18
#define CCL_SetExprConst 0x19
#define CCL_SetExprReg 0x1A
#define CCL_JumpCondExprConst 0x1B
#define CCL_JumpCondExprReg 0x1C
#define CCL_ReadJumpCondExprConst 0x1D
#define CCL_ReadJumpCondExprReg 0x1E
#define CCL_Extension 0x1F
#define CCL_ReadMultibyteChar2 0x00
#define CCL_WriteMultibyteChar2 0x01
#define CCL_TranslateCharacter 0x02
#define CCL_TranslateCharacterConstTbl 0x03
#define CCL_IterateMultipleMap 0x10
#define CCL_MapMultiple 0x11
#define MAX_MAP_SET_LEVEL 30
typedef struct
{
int rest_length;
int orig_val;
} tr_stack;
static tr_stack mapping_stack[MAX_MAP_SET_LEVEL];
static tr_stack *mapping_stack_pointer;
static int stack_idx_of_map_multiple;
#define PUSH_MAPPING_STACK(restlen, orig) \
do \
{ \
mapping_stack_pointer->rest_length = (restlen); \
mapping_stack_pointer->orig_val = (orig); \
mapping_stack_pointer++; \
} \
while (0)
#define POP_MAPPING_STACK(restlen, orig) \
do \
{ \
mapping_stack_pointer--; \
(restlen) = mapping_stack_pointer->rest_length; \
(orig) = mapping_stack_pointer->orig_val; \
} \
while (0)
#define CCL_CALL_FOR_MAP_INSTRUCTION(symbol, ret_ic) \
do \
{ \
struct ccl_program called_ccl; \
if (stack_idx >= 256 \
|| (setup_ccl_program (&called_ccl, (symbol)) != 0)) \
{ \
if (stack_idx > 0) \
{ \
ccl_prog = ccl_prog_stack_struct[0].ccl_prog; \
ic = ccl_prog_stack_struct[0].ic; \
eof_ic = ccl_prog_stack_struct[0].eof_ic; \
} \
CCL_INVALID_CMD; \
} \
ccl_prog_stack_struct[stack_idx].ccl_prog = ccl_prog; \
ccl_prog_stack_struct[stack_idx].ic = (ret_ic); \
ccl_prog_stack_struct[stack_idx].eof_ic = eof_ic; \
stack_idx++; \
ccl_prog = called_ccl.prog; \
ic = CCL_HEADER_MAIN; \
eof_ic = XFASTINT (ccl_prog[CCL_HEADER_EOF]); \
goto ccl_repeat; \
} \
while (0)
#define CCL_MapSingle 0x12
#define CCL_LookupIntConstTbl 0x13
#define CCL_LookupCharConstTbl 0x14
#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
#define CCL_DECODE_SJIS 0x16
#define CCL_ENCODE_SJIS 0x17
#define CCL_SUCCESS \
do \
{ \
ccl->status = CCL_STAT_SUCCESS; \
goto ccl_finish; \
} \
while(0)
#define CCL_SUSPEND(stat) \
do \
{ \
ic--; \
ccl->status = stat; \
goto ccl_finish; \
} \
while (0)
#ifndef CCL_DEBUG
#define CCL_INVALID_CMD \
do \
{ \
ccl->status = CCL_STAT_INVALID_CMD; \
goto ccl_error_handler; \
} \
while(0)
#else
#define CCL_INVALID_CMD \
do \
{ \
ccl_debug_hook (this_ic); \
ccl->status = CCL_STAT_INVALID_CMD; \
goto ccl_error_handler; \
} \
while(0)
#endif
#define CCL_WRITE_CHAR(ch) \
do { \
int bytes = SINGLE_BYTE_CHAR_P (ch) ? 1: CHAR_BYTES (ch); \
if (!dst) \
CCL_INVALID_CMD; \
else if (dst + bytes + extra_bytes < (dst_bytes ? dst_end : src)) \
{ \
if (bytes == 1) \
{ \
*dst++ = (ch); \
if (extra_bytes && (ch) >= 0x80 && (ch) < 0xA0) \
\
extra_bytes++; \
} \
else if (CHAR_VALID_P (ch, 0)) \
dst += CHAR_STRING (ch, dst); \
else \
CCL_INVALID_CMD; \
} \
else \
CCL_SUSPEND (CCL_STAT_SUSPEND_BY_DST); \
} while (0)
#define CCL_WRITE_MULTIBYTE_CHAR(ch) \
do { \
int bytes = CHAR_BYTES (ch); \
if (!dst) \
CCL_INVALID_CMD; \
else if (dst + bytes + extra_bytes < (dst_bytes ? dst_end : src)) \
{ \
if (CHAR_VALID_P ((ch), 0)) \
dst += CHAR_STRING ((ch), dst); \
else \
CCL_INVALID_CMD; \
} \
else \
CCL_SUSPEND (CCL_STAT_SUSPEND_BY_DST); \
} while (0)
#define CCL_WRITE_STRING(len) \
do { \
if (!dst) \
CCL_INVALID_CMD; \
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_STAT_SUSPEND_BY_DST); \
} while (0)
#define CCL_READ_CHAR(REG) \
do { \
if (!src) \
CCL_INVALID_CMD; \
else if (src < src_end) \
{ \
REG = *src++; \
if (REG == '\n' \
&& ccl->eol_type != CODING_EOL_LF) \
{ \
\
if (ccl->eol_type == CODING_EOL_CRLF) \
{ \
if (ccl->cr_consumed) \
ccl->cr_consumed = 0; \
else \
{ \
ccl->cr_consumed = 1; \
REG = '\r'; \
src--; \
} \
} \
else \
REG = '\r'; \
} \
if (REG == LEADING_CODE_8_BIT_CONTROL \
&& ccl->multibyte) \
REG = *src++ - 0x20; \
} \
else if (ccl->last_block) \
{ \
REG = -1; \
ic = eof_ic; \
goto ccl_repeat; \
} \
else \
CCL_SUSPEND (CCL_STAT_SUSPEND_BY_SRC); \
} while (0)
#define CCL_MAKE_CHAR(charset, code, c) \
do { \
if (charset == CHARSET_ASCII) \
c = code & 0xFF; \
else if (CHARSET_DEFINED_P (charset) \
&& (code & 0x7F) >= 32 \
&& (code < 256 || ((code >> 7) & 0x7F) >= 32)) \
{ \
int c1 = code & 0x7F, c2 = 0; \
\
if (code >= 256) \
c2 = c1, c1 = (code >> 7) & 0x7F; \
c = MAKE_CHAR (charset, c1, c2); \
} \
else \
c = code & 0xFF; \
} while (0)
#ifdef CCL_DEBUG
#define CCL_DEBUG_BACKTRACE_LEN 256
int ccl_backtrace_table[CCL_DEBUG_BACKTRACE_LEN];
int ccl_backtrace_idx;
int
ccl_debug_hook (int ic)
{
return ic;
}
#endif
struct ccl_prog_stack
{
Lisp_Object *ccl_prog;
int ic;
int eof_ic;
};
static struct ccl_prog_stack ccl_prog_stack_struct[256];
int
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 = 0, field1, field2;
register Lisp_Object *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 = 0, j, op;
int stack_idx = ccl->stack_idx;
int this_ic = 0;
int extra_bytes = ccl->eight_bit_control;
int eof_ic = ccl->eof_ic;
int eof_hit = 0;
if (ic >= eof_ic)
ic = CCL_HEADER_MAIN;
if (ccl->buf_magnification == 0)
dst = NULL;
mapping_stack_pointer = mapping_stack;
#ifdef CCL_DEBUG
ccl_backtrace_idx = 0;
#endif
for (;;)
{
ccl_repeat:
#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))
{
if (consumed)
src = source + src_bytes;
ccl->status = CCL_STAT_QUIT;
break;
}
this_ic = ic;
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
#define EXCMD (field1 >> 6)
switch (code & 0x1F)
{
case CCL_SetRegister:
reg[rrr] = reg[RRR];
break;
case CCL_SetShortConst:
reg[rrr] = field1;
break;
case CCL_SetConst:
reg[rrr] = XINT (ccl_prog[ic]);
ic++;
break;
case CCL_SetArray:
i = reg[RRR];
j = field1 >> 3;
if ((unsigned int) i < j)
reg[rrr] = XINT (ccl_prog[ic + i]);
ic += j;
break;
case CCL_Jump:
ic += ADDR;
break;
case CCL_JumpCond:
if (!reg[rrr])
ic += ADDR;
break;
case CCL_WriteRegisterJump:
i = reg[rrr];
CCL_WRITE_CHAR (i);
ic += ADDR;
break;
case CCL_WriteRegisterReadJump:
i = reg[rrr];
CCL_WRITE_CHAR (i);
ic++;
CCL_READ_CHAR (reg[rrr]);
ic += ADDR - 1;
break;
case CCL_WriteConstJump:
i = XINT (ccl_prog[ic]);
CCL_WRITE_CHAR (i);
ic += ADDR;
break;
case CCL_WriteConstReadJump:
i = XINT (ccl_prog[ic]);
CCL_WRITE_CHAR (i);
ic++;
CCL_READ_CHAR (reg[rrr]);
ic += ADDR - 1;
break;
case CCL_WriteStringJump:
j = XINT (ccl_prog[ic]);
ic++;
CCL_WRITE_STRING (j);
ic += ADDR - 1;
break;
case CCL_WriteArrayReadJump:
i = reg[rrr];
j = XINT (ccl_prog[ic]);
if ((unsigned int) i < j)
{
i = XINT (ccl_prog[ic + 1 + i]);
CCL_WRITE_CHAR (i);
}
ic += j + 2;
CCL_READ_CHAR (reg[rrr]);
ic += ADDR - (j + 2);
break;
case CCL_ReadJump:
CCL_READ_CHAR (reg[rrr]);
ic += ADDR;
break;
case CCL_ReadBranch:
CCL_READ_CHAR (reg[rrr]);
case CCL_Branch:
if ((unsigned int) reg[rrr] < field1)
ic += XINT (ccl_prog[ic + reg[rrr]]);
else
ic += XINT (ccl_prog[ic + field1]);
break;
case CCL_ReadRegister:
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:
rrr = 7;
i = reg[RRR];
j = XINT (ccl_prog[ic]);
op = field1 >> 6;
jump_address = ic + 1;
goto ccl_set_expr;
case CCL_WriteRegister:
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:
rrr = 7;
i = reg[RRR];
j = reg[Rrr];
op = field1 >> 6;
jump_address = ic;
goto ccl_set_expr;
case CCL_Call:
{
Lisp_Object slot;
int prog_id;
if (rrr)
{
prog_id = XINT (ccl_prog[ic]);
ic++;
}
else
prog_id = field1;
if (stack_idx >= 256
|| prog_id < 0
|| prog_id >= ASIZE (Vccl_program_table)
|| (slot = AREF (Vccl_program_table, prog_id), !VECTORP (slot))
|| !VECTORP (AREF (slot, 1)))
{
if (stack_idx > 0)
{
ccl_prog = ccl_prog_stack_struct[0].ccl_prog;
ic = ccl_prog_stack_struct[0].ic;
eof_ic = ccl_prog_stack_struct[0].eof_ic;
}
CCL_INVALID_CMD;
}
ccl_prog_stack_struct[stack_idx].ccl_prog = ccl_prog;
ccl_prog_stack_struct[stack_idx].ic = ic;
ccl_prog_stack_struct[stack_idx].eof_ic = eof_ic;
stack_idx++;
ccl_prog = XVECTOR (AREF (slot, 1))->contents;
ic = CCL_HEADER_MAIN;
eof_ic = XFASTINT (ccl_prog[CCL_HEADER_EOF]);
}
break;
case CCL_WriteConstString:
if (!rrr)
CCL_WRITE_CHAR (field1);
else
{
CCL_WRITE_STRING (field1);
ic += (field1 + 2) / 3;
}
break;
case CCL_WriteArray:
i = reg[rrr];
if ((unsigned int) i < field1)
{
j = XINT (ccl_prog[ic + i]);
CCL_WRITE_CHAR (j);
}
ic += field1;
break;
case CCL_End:
if (stack_idx > 0)
{
stack_idx--;
ccl_prog = ccl_prog_stack_struct[stack_idx].ccl_prog;
ic = ccl_prog_stack_struct[stack_idx].ic;
eof_ic = ccl_prog_stack_struct[stack_idx].eof_ic;
if (eof_hit)
ic = eof_ic;
break;
}
if (src)
src = src_end;
ic--;
CCL_SUCCESS;
case CCL_ExprSelfConst:
i = XINT (ccl_prog[ic]);
ic++;
op = field1 >> 6;
goto ccl_expr_self;
case CCL_ExprSelfReg:
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:
i = reg[RRR];
j = XINT (ccl_prog[ic]);
op = field1 >> 6;
jump_address = ++ic;
goto ccl_set_expr;
case CCL_SetExprReg:
i = reg[RRR];
j = reg[Rrr];
op = field1 >> 6;
jump_address = ic;
goto ccl_set_expr;
case CCL_ReadJumpCondExprConst:
CCL_READ_CHAR (reg[rrr]);
case CCL_JumpCondExprConst:
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:
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_DECODE_SJIS: DECODE_SJIS (i, j, reg[rrr], reg[7]); break;
case CCL_ENCODE_SJIS: ENCODE_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);
ic = jump_address;
}
else if (!reg[rrr])
ic = jump_address;
break;
case CCL_Extension:
switch (EXCMD)
{
case CCL_ReadMultibyteChar2:
if (!src)
CCL_INVALID_CMD;
if (src >= src_end)
{
src++;
goto ccl_read_multibyte_character_suspend;
}
if (!ccl->multibyte)
{
int bytes;
if (!UNIBYTE_STR_AS_MULTIBYTE_P (src, src_end - src, bytes))
{
reg[RRR] = CHARSET_8_BIT_CONTROL;
reg[rrr] = *src++;
break;
}
}
i = *src++;
if (i == '\n' && ccl->eol_type != CODING_EOL_LF)
{
if (ccl->eol_type == CODING_EOL_CRLF)
{
if (ccl->cr_consumed)
ccl->cr_consumed = 0;
else
{
ccl->cr_consumed = 1;
i = '\r';
src--;
}
}
else
i = '\r';
reg[rrr] = i;
reg[RRR] = CHARSET_ASCII;
}
else if (i < 0x80)
{
reg[rrr] = i;
reg[RRR] = CHARSET_ASCII;
}
else if (i <= MAX_CHARSET_OFFICIAL_DIMENSION2)
{
int dimension = BYTES_BY_CHAR_HEAD (i) - 1;
if (dimension == 0)
{
reg[RRR] = CHARSET_8_BIT_GRAPHIC;
reg[rrr] = i;
}
else if (src + dimension > src_end)
goto ccl_read_multibyte_character_suspend;
else
{
reg[RRR] = i;
i = (*src++ & 0x7F);
if (dimension == 1)
reg[rrr] = i;
else
reg[rrr] = ((i << 7) | (*src++ & 0x7F));
}
}
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 if (i == LEADING_CODE_8_BIT_CONTROL)
{
if (src >= src_end)
goto ccl_read_multibyte_character_suspend;
reg[RRR] = CHARSET_8_BIT_CONTROL;
reg[rrr] = (*src++ - 0x20);
}
else if (i >= 0xA0)
{
reg[RRR] = CHARSET_8_BIT_GRAPHIC;
reg[rrr] = i;
}
else
{
reg[RRR] = CHARSET_ASCII;
reg[rrr] = i;
}
break;
ccl_read_multibyte_character_suspend:
if (src <= src_end && !ccl->multibyte && ccl->last_block)
{
reg[RRR] = CHARSET_8_BIT_CONTROL;
reg[rrr] = i;
break;
}
src--;
if (ccl->last_block)
{
ic = eof_ic;
eof_hit = 1;
goto ccl_repeat;
}
else
CCL_SUSPEND (CCL_STAT_SUSPEND_BY_SRC);
break;
case CCL_WriteMultibyteChar2:
i = reg[RRR];
if (i == CHARSET_ASCII
|| i == CHARSET_8_BIT_CONTROL
|| i == CHARSET_8_BIT_GRAPHIC)
i = reg[rrr] & 0xFF;
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_MULTIBYTE_CHAR (i);
break;
case CCL_TranslateCharacter:
CCL_MAKE_CHAR (reg[RRR], reg[rrr], i);
op = translate_char (GET_TRANSLATION_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_TranslateCharacterConstTbl:
op = XINT (ccl_prog[ic]);
ic++;
CCL_MAKE_CHAR (reg[RRR], reg[rrr], i);
op = translate_char (GET_TRANSLATION_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_LookupIntConstTbl:
op = XINT (ccl_prog[ic]);
ic++;
{
struct Lisp_Hash_Table *h = GET_HASH_TABLE (op);
op = hash_lookup (h, make_number (reg[RRR]), NULL);
if (op >= 0)
{
Lisp_Object opl;
opl = HASH_VALUE (h, op);
if (!CHAR_VALID_P (XINT (opl), 0))
CCL_INVALID_CMD;
SPLIT_CHAR (XINT (opl), reg[RRR], i, j);
if (j != -1)
i = (i << 7) | j;
reg[rrr] = i;
reg[7] = 1;
}
else
reg[7] = 0;
}
break;
case CCL_LookupCharConstTbl:
op = XINT (ccl_prog[ic]);
ic++;
CCL_MAKE_CHAR (reg[RRR], reg[rrr], i);
{
struct Lisp_Hash_Table *h = GET_HASH_TABLE (op);
op = hash_lookup (h, make_number (i), NULL);
if (op >= 0)
{
Lisp_Object opl;
opl = HASH_VALUE (h, op);
if (!INTEGERP (opl))
CCL_INVALID_CMD;
reg[RRR] = XINT (opl);
reg[7] = 1;
}
else
reg[7] = 0;
}
break;
case CCL_IterateMultipleMap:
{
Lisp_Object map, content, attrib, value;
int point, size, fin_ic;
j = XINT (ccl_prog[ic++]);
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 = ASIZE (Vcode_conversion_map_vector);
point = XINT (ccl_prog[ic++]);
if (point >= size) continue;
map = AREF (Vcode_conversion_map_vector, point);
if (!CONSP (map)) continue;
map = XCDR (map);
if (!VECTORP (map)) continue;
size = ASIZE (map);
if (size <= 1) continue;
content = AREF (map, 0);
if (NUMBERP (content))
{
point = XUINT (content);
point = op - point + 1;
if (!((point >= 1) && (point < size))) continue;
content = AREF (map, point);
}
else if (EQ (content, Qt))
{
if (size != 4) continue;
if ((op >= XUINT (AREF (map, 2)))
&& (op < XUINT (AREF (map, 3))))
content = AREF (map, 1);
else
continue;
}
else
continue;
if (NILP (content))
continue;
else if (NUMBERP (content))
{
reg[RRR] = i;
reg[rrr] = XINT(content);
break;
}
else if (EQ (content, Qt) || EQ (content, Qlambda))
{
reg[RRR] = i;
break;
}
else if (CONSP (content))
{
attrib = XCAR (content);
value = XCDR (content);
if (!NUMBERP (attrib) || !NUMBERP (value))
continue;
reg[RRR] = i;
reg[rrr] = XUINT (value);
break;
}
else if (SYMBOLP (content))
CCL_CALL_FOR_MAP_INSTRUCTION (content, fin_ic);
else
CCL_INVALID_CMD;
}
if (i == j)
reg[RRR] = -1;
ic = fin_ic;
}
break;
case CCL_MapMultiple:
{
Lisp_Object map, content, attrib, value;
int point, size, map_vector_size;
int map_set_rest_length, fin_ic;
int current_ic = this_ic;
if (stack_idx_of_map_multiple > 0)
{
if (stack_idx_of_map_multiple <= stack_idx)
{
stack_idx_of_map_multiple = 0;
mapping_stack_pointer = mapping_stack;
CCL_INVALID_CMD;
}
}
else
mapping_stack_pointer = mapping_stack;
stack_idx_of_map_multiple = 0;
map_set_rest_length =
XINT (ccl_prog[ic++]);
fin_ic = ic + map_set_rest_length;
op = reg[rrr];
if ((map_set_rest_length > reg[RRR]) && (reg[RRR] >= 0))
{
ic += reg[RRR];
i = reg[RRR];
map_set_rest_length -= i;
}
else
{
ic = fin_ic;
reg[RRR] = -1;
mapping_stack_pointer = mapping_stack;
break;
}
if (mapping_stack_pointer <= (mapping_stack + 1))
{
mapping_stack_pointer = mapping_stack;
PUSH_MAPPING_STACK (0, op);
reg[RRR] = -1;
}
else
{
int orig_op;
POP_MAPPING_STACK (map_set_rest_length, orig_op);
POP_MAPPING_STACK (map_set_rest_length, reg[rrr]);
switch (op)
{
case -1:
op = orig_op;
i++;
ic++;
map_set_rest_length--;
break;
case -2:
op = reg[rrr];
i++;
ic++;
map_set_rest_length--;
break;
case -3:
op = orig_op;
i += map_set_rest_length;
ic += map_set_rest_length;
map_set_rest_length = 0;
break;
default:
i += map_set_rest_length;
ic += map_set_rest_length;
POP_MAPPING_STACK (map_set_rest_length, reg[rrr]);
break;
}
}
map_vector_size = ASIZE (Vcode_conversion_map_vector);
do {
for (;map_set_rest_length > 0;i++, ic++, map_set_rest_length--)
{
point = XINT(ccl_prog[ic]);
if (point < 0)
{
point = -point + 1;
if (mapping_stack_pointer
>= &mapping_stack[MAX_MAP_SET_LEVEL])
CCL_INVALID_CMD;
PUSH_MAPPING_STACK (map_set_rest_length - point,
reg[rrr]);
map_set_rest_length = point;
reg[rrr] = op;
continue;
}
if (point >= map_vector_size) continue;
map = AREF (Vcode_conversion_map_vector, point);
if (!CONSP (map)) continue;
map = XCDR (map);
if (!VECTORP (map)) continue;
size = ASIZE (map);
if (size <= 1) continue;
content = AREF (map, 0);
if (NUMBERP (content))
{
point = XUINT (content);
point = op - point + 1;
if (!((point >= 1) && (point < size))) continue;
content = AREF (map, point);
}
else if (EQ (content, Qt))
{
if (size != 4) continue;
if ((op >= XUINT (AREF (map, 2))) &&
(op < XUINT (AREF (map, 3))))
content = AREF (map, 1);
else
continue;
}
else
continue;
if (NILP (content))
continue;
reg[RRR] = i;
if (NUMBERP (content))
{
op = XINT (content);
i += map_set_rest_length - 1;
ic += map_set_rest_length - 1;
POP_MAPPING_STACK (map_set_rest_length, reg[rrr]);
map_set_rest_length++;
}
else if (CONSP (content))
{
attrib = XCAR (content);
value = XCDR (content);
if (!NUMBERP (attrib) || !NUMBERP (value))
continue;
op = XUINT (value);
i += map_set_rest_length - 1;
ic += map_set_rest_length - 1;
POP_MAPPING_STACK (map_set_rest_length, reg[rrr]);
map_set_rest_length++;
}
else if (EQ (content, Qt))
{
op = reg[rrr];
}
else if (EQ (content, Qlambda))
{
i += map_set_rest_length;
ic += map_set_rest_length;
break;
}
else if (SYMBOLP (content))
{
if (mapping_stack_pointer
>= &mapping_stack[MAX_MAP_SET_LEVEL])
CCL_INVALID_CMD;
PUSH_MAPPING_STACK (map_set_rest_length, reg[rrr]);
PUSH_MAPPING_STACK (map_set_rest_length, op);
stack_idx_of_map_multiple = stack_idx + 1;
CCL_CALL_FOR_MAP_INSTRUCTION (content, current_ic);
}
else
CCL_INVALID_CMD;
}
if (mapping_stack_pointer <= (mapping_stack + 1))
break;
POP_MAPPING_STACK (map_set_rest_length, reg[rrr]);
i += map_set_rest_length;
ic += map_set_rest_length;
POP_MAPPING_STACK (map_set_rest_length, reg[rrr]);
} while (1);
ic = fin_ic;
}
reg[rrr] = op;
break;
case CCL_MapSingle:
{
Lisp_Object map, attrib, value, content;
int size, point;
j = XINT (ccl_prog[ic++]);
op = reg[rrr];
if (j >= ASIZE (Vcode_conversion_map_vector))
{
reg[RRR] = -1;
break;
}
map = AREF (Vcode_conversion_map_vector, j);
if (!CONSP (map))
{
reg[RRR] = -1;
break;
}
map = XCDR (map);
if (!VECTORP (map))
{
reg[RRR] = -1;
break;
}
size = ASIZE (map);
point = XUINT (AREF (map, 0));
point = op - point + 1;
reg[RRR] = 0;
if ((size <= 1) ||
(!((point >= 1) && (point < size))))
reg[RRR] = -1;
else
{
reg[RRR] = 0;
content = AREF (map, point);
if (NILP (content))
reg[RRR] = -1;
else if (NUMBERP (content))
reg[rrr] = XINT (content);
else if (EQ (content, Qt));
else if (CONSP (content))
{
attrib = XCAR (content);
value = XCDR (content);
if (!NUMBERP (attrib) || !NUMBERP (value))
continue;
reg[rrr] = XUINT(value);
break;
}
else if (SYMBOLP (content))
CCL_CALL_FOR_MAP_INSTRUCTION (content, ic);
else
reg[RRR] = -1;
}
}
break;
default:
CCL_INVALID_CMD;
}
break;
default:
CCL_INVALID_CMD;
}
}
ccl_error_handler:
if (!ccl->suppress_error && destination)
{
char msg[256];
int msglen;
if (!dst)
dst = destination;
switch (ccl->status)
{
case CCL_STAT_INVALID_CMD:
sprintf(msg, "\nCCL: Invalid command %x (ccl_code = %x) at %d.",
code & 0x1F, code, this_ic);
#ifdef CCL_DEBUG
{
int i = ccl_backtrace_idx - 1;
int j;
msglen = strlen (msg);
if (dst + msglen <= (dst_bytes ? dst_end : src))
{
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_bytes ? dst_end : src))
break;
bcopy (msg, dst, msglen);
dst += msglen;
}
goto ccl_finish;
}
#endif
break;
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_bytes ? dst_end : src))
{
bcopy (msg, dst, msglen);
dst += msglen;
}
if (ccl->status == CCL_STAT_INVALID_CMD)
{
#if 0
int i = src_end - src;
if (dst_bytes && (dst_end - dst) < i)
i = dst_end - dst;
bcopy (src, dst, i);
src += i;
dst += i;
#else
src = src_end;
#endif
}
}
ccl_finish:
ccl->ic = ic;
ccl->stack_idx = stack_idx;
ccl->prog = ccl_prog;
ccl->eight_bit_control = (extra_bytes > 1);
if (consumed)
*consumed = src - source;
return (dst ? dst - destination : 0);
}
static Lisp_Object
resolve_symbol_ccl_program (ccl)
Lisp_Object ccl;
{
int i, veclen, unresolved = 0;
Lisp_Object result, contents, val;
result = ccl;
veclen = ASIZE (result);
for (i = 0; i < veclen; i++)
{
contents = AREF (result, i);
if (INTEGERP (contents))
continue;
else if (CONSP (contents)
&& SYMBOLP (XCAR (contents))
&& SYMBOLP (XCDR (contents)))
{
if (EQ (result, ccl))
result = Fcopy_sequence (ccl);
val = Fget (XCAR (contents), XCDR (contents));
if (NATNUMP (val))
AREF (result, i) = val;
else
unresolved = 1;
continue;
}
else if (SYMBOLP (contents))
{
if (EQ (result, ccl))
result = Fcopy_sequence (ccl);
val = Fget (contents, Qtranslation_table_id);
if (NATNUMP (val))
AREF (result, i) = val;
else
{
val = Fget (contents, Qcode_conversion_map_id);
if (NATNUMP (val))
AREF (result, i) = val;
else
{
val = Fget (contents, Qccl_program_idx);
if (NATNUMP (val))
AREF (result, i) = val;
else
unresolved = 1;
}
}
continue;
}
return Qnil;
}
return (unresolved ? Qt : result);
}
static Lisp_Object
ccl_get_compiled_code (ccl_prog, idx)
Lisp_Object ccl_prog;
int *idx;
{
Lisp_Object val, slot;
if (VECTORP (ccl_prog))
{
val = resolve_symbol_ccl_program (ccl_prog);
*idx = -1;
return (VECTORP (val) ? val : Qnil);
}
if (!SYMBOLP (ccl_prog))
return Qnil;
val = Fget (ccl_prog, Qccl_program_idx);
if (! NATNUMP (val)
|| XINT (val) >= ASIZE (Vccl_program_table))
return Qnil;
slot = AREF (Vccl_program_table, XINT (val));
if (! VECTORP (slot)
|| ASIZE (slot) != 4
|| ! VECTORP (AREF (slot, 1)))
return Qnil;
*idx = XINT (val);
if (NILP (AREF (slot, 2)))
{
val = resolve_symbol_ccl_program (AREF (slot, 1));
if (! VECTORP (val))
return Qnil;
AREF (slot, 1) = val;
AREF (slot, 2) = Qt;
}
return AREF (slot, 1);
}
int
setup_ccl_program (ccl, ccl_prog)
struct ccl_program *ccl;
Lisp_Object ccl_prog;
{
int i;
if (! NILP (ccl_prog))
{
struct Lisp_Vector *vp;
ccl_prog = ccl_get_compiled_code (ccl_prog, &ccl->idx);
if (! VECTORP (ccl_prog))
return -1;
vp = XVECTOR (ccl_prog);
ccl->size = vp->size;
ccl->prog = vp->contents;
ccl->eof_ic = XINT (vp->contents[CCL_HEADER_EOF]);
ccl->buf_magnification = XINT (vp->contents[CCL_HEADER_BUF_MAG]);
if (ccl->idx >= 0)
{
Lisp_Object slot;
slot = AREF (Vccl_program_table, ccl->idx);
ASET (slot, 3, Qnil);
}
}
ccl->ic = CCL_HEADER_MAIN;
for (i = 0; i < 8; i++)
ccl->reg[i] = 0;
ccl->last_block = 0;
ccl->private_state = 0;
ccl->status = 0;
ccl->stack_idx = 0;
ccl->eol_type = CODING_EOL_LF;
ccl->suppress_error = 0;
ccl->eight_bit_control = 0;
return 0;
}
int
check_ccl_update (ccl)
struct ccl_program *ccl;
{
Lisp_Object slot, ccl_prog;
if (ccl->idx < 0)
return 0;
slot = AREF (Vccl_program_table, ccl->idx);
if (NILP (AREF (slot, 3)))
return 0;
ccl_prog = ccl_get_compiled_code (AREF (slot, 0), &ccl->idx);
if (! VECTORP (ccl_prog))
return -1;
ccl->size = ASIZE (ccl_prog);
ccl->prog = XVECTOR (ccl_prog)->contents;
ccl->eof_ic = XINT (AREF (ccl_prog, CCL_HEADER_EOF));
ccl->buf_magnification = XINT (AREF (ccl_prog, CCL_HEADER_BUF_MAG));
ASET (slot, 3, Qnil);
return 0;
}
DEFUN ("ccl-program-p", Fccl_program_p, Sccl_program_p, 1, 1, 0,
doc: )
(object)
Lisp_Object object;
{
Lisp_Object val;
if (VECTORP (object))
{
val = resolve_symbol_ccl_program (object);
return (VECTORP (val) ? Qt : Qnil);
}
if (!SYMBOLP (object))
return Qnil;
val = Fget (object, Qccl_program_idx);
return ((! NATNUMP (val)
|| XINT (val) >= ASIZE (Vccl_program_table))
? Qnil : Qt);
}
DEFUN ("ccl-execute", Fccl_execute, Sccl_execute, 2, 2, 0,
doc: )
(ccl_prog, reg)
Lisp_Object ccl_prog, reg;
{
struct ccl_program ccl;
int i;
if (setup_ccl_program (&ccl, ccl_prog) < 0)
error ("Invalid CCL program");
CHECK_VECTOR (reg);
if (ASIZE (reg) != 8)
error ("Length of vector REGISTERS is not 8");
for (i = 0; i < 8; i++)
ccl.reg[i] = (INTEGERP (AREF (reg, i))
? XINT (AREF (reg, i))
: 0);
ccl_driver (&ccl, (unsigned char *)0, (unsigned 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 (AREF (reg, i), ccl.reg[i]);
return Qnil;
}
DEFUN ("ccl-execute-on-string", Fccl_execute_on_string, Sccl_execute_on_string,
3, 5, 0,
doc: )
(ccl_prog, status, str, contin, unibyte_p)
Lisp_Object ccl_prog, status, str, contin, unibyte_p;
{
Lisp_Object val;
struct ccl_program ccl;
int i, produced;
int outbufsize;
char *outbuf;
struct gcpro gcpro1, gcpro2;
if (setup_ccl_program (&ccl, ccl_prog) < 0)
error ("Invalid CCL program");
CHECK_VECTOR (status);
if (ASIZE (status) != 9)
error ("Length of vector STATUS is not 9");
CHECK_STRING (str);
GCPRO2 (status, str);
for (i = 0; i < 8; i++)
{
if (NILP (AREF (status, i)))
XSETINT (AREF (status, i), 0);
if (INTEGERP (AREF (status, i)))
ccl.reg[i] = XINT (AREF (status, i));
}
if (INTEGERP (AREF (status, i)))
{
i = XFASTINT (AREF (status, 8));
if (ccl.ic < i && i < ccl.size)
ccl.ic = i;
}
outbufsize = SBYTES (str) * ccl.buf_magnification + 256;
outbuf = (char *) xmalloc (outbufsize);
ccl.last_block = NILP (contin);
ccl.multibyte = STRING_MULTIBYTE (str);
produced = ccl_driver (&ccl, SDATA (str), outbuf,
SBYTES (str), outbufsize, (int *) 0);
for (i = 0; i < 8; i++)
ASET (status, i, make_number (ccl.reg[i]));
ASET (status, 8, make_number (ccl.ic));
UNGCPRO;
if (NILP (unibyte_p))
{
int nchars;
produced = str_as_multibyte (outbuf, outbufsize, produced, &nchars);
val = make_multibyte_string (outbuf, nchars, produced);
}
else
val = make_unibyte_string (outbuf, produced);
xfree (outbuf);
QUIT;
if (ccl.status == CCL_STAT_SUSPEND_BY_DST)
error ("Output buffer for the CCL programs overflow");
if (ccl.status != CCL_STAT_SUCCESS
&& ccl.status != CCL_STAT_SUSPEND_BY_SRC)
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,
doc: )
(name, ccl_prog)
Lisp_Object name, ccl_prog;
{
int len = ASIZE (Vccl_program_table);
int idx;
Lisp_Object resolved;
CHECK_SYMBOL (name);
resolved = Qnil;
if (!NILP (ccl_prog))
{
CHECK_VECTOR (ccl_prog);
resolved = resolve_symbol_ccl_program (ccl_prog);
if (NILP (resolved))
error ("Error in CCL program");
if (VECTORP (resolved))
{
ccl_prog = resolved;
resolved = Qt;
}
else
resolved = Qnil;
}
for (idx = 0; idx < len; idx++)
{
Lisp_Object slot;
slot = AREF (Vccl_program_table, idx);
if (!VECTORP (slot))
break;
if (EQ (name, AREF (slot, 0)))
{
ASET (slot, 1, ccl_prog);
ASET (slot, 2, resolved);
ASET (slot, 3, Qt);
return make_number (idx);
}
}
if (idx == len)
{
Lisp_Object new_table;
int j;
new_table = Fmake_vector (make_number (len * 2), Qnil);
for (j = 0; j < len; j++)
ASET (new_table, j, AREF (Vccl_program_table, j));
Vccl_program_table = new_table;
}
{
Lisp_Object elt;
elt = Fmake_vector (make_number (4), Qnil);
ASET (elt, 0, name);
ASET (elt, 1, ccl_prog);
ASET (elt, 2, resolved);
ASET (elt, 3, Qt);
ASET (Vccl_program_table, idx, elt);
}
Fput (name, Qccl_program_idx, make_number (idx));
return make_number (idx);
}
DEFUN ("register-code-conversion-map", Fregister_code_conversion_map,
Sregister_code_conversion_map,
2, 2, 0,
doc: )
(symbol, map)
Lisp_Object symbol, map;
{
int len = ASIZE (Vcode_conversion_map_vector);
int i;
Lisp_Object index;
CHECK_SYMBOL (symbol);
CHECK_VECTOR (map);
for (i = 0; i < len; i++)
{
Lisp_Object slot = AREF (Vcode_conversion_map_vector, i);
if (!CONSP (slot))
break;
if (EQ (symbol, XCAR (slot)))
{
index = make_number (i);
XSETCDR (slot, map);
Fput (symbol, Qcode_conversion_map, map);
Fput (symbol, Qcode_conversion_map_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++)
AREF (new_vector, j)
= AREF (Vcode_conversion_map_vector, j);
Vcode_conversion_map_vector = new_vector;
}
index = make_number (i);
Fput (symbol, Qcode_conversion_map, map);
Fput (symbol, Qcode_conversion_map_id, index);
AREF (Vcode_conversion_map_vector, i) = Fcons (symbol, map);
return index;
}
void
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_program_idx = intern ("ccl-program-idx");
staticpro (&Qccl_program_idx);
Qcode_conversion_map = intern ("code-conversion-map");
staticpro (&Qcode_conversion_map);
Qcode_conversion_map_id = intern ("code-conversion-map-id");
staticpro (&Qcode_conversion_map_id);
DEFVAR_LISP ("code-conversion-map-vector", &Vcode_conversion_map_vector,
doc: );
Vcode_conversion_map_vector = Fmake_vector (make_number (16), Qnil);
DEFVAR_LISP ("font-ccl-encoder-alist", &Vfont_ccl_encoder_alist,
doc: );
Vfont_ccl_encoder_alist = Qnil;
DEFVAR_LISP ("translation-hash-table-vector", &Vtranslation_hash_table_vector,
doc: );
Vtranslation_hash_table_vector = Qnil;
defsubr (&Sccl_program_p);
defsubr (&Sccl_execute);
defsubr (&Sccl_execute_on_string);
defsubr (&Sregister_ccl_program);
defsubr (&Sregister_code_conversion_map);
}