git.chise.org Git - chise/xemacs-chise.git.1/blob - src/mule-ccl.c

   1 /* CCL (Code Conversion Language) interpreter.
   2    Copyright (C) 1995, 1997 Electrotechnical Laboratory, JAPAN.
   3    Licensed to the Free Software Foundation.
   4
   5 This file is part of XEmacs.
   6
   7 GNU Emacs is free software; you can redistribute it and/or modify
   8 it under the terms of the GNU General Public License as published by
   9 the Free Software Foundation; either version 2, or (at your option)
  10 any later version.
  11
  12 GNU Emacs is distributed in the hope that it will be useful,
  13 but WITHOUT ANY WARRANTY; without even the implied warranty of
  14 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  15 GNU General Public License for more details.
  16
  17 You should have received a copy of the GNU General Public License
  18 along with GNU Emacs; see the file COPYING.  If not, write to
  19 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  20 Boston, MA 02111-1307, USA.  */
  21
  22 /* Synched up with : FSF Emacs 20.2 */
  23
  24 #ifdef emacs
  25
  26 #include <config.h>
  27 #include "lisp.h"
  28 #include "buffer.h"
  29 #include "mule-charset.h"
  30 #include "mule-ccl.h"
  31 #include "file-coding.h"
  32
  33 #else  /* not emacs */
  34
  35 #include <stdio.h>
  36 #include "mulelib.h"
  37
  38 #endif /* not emacs */
  39
  40 /* Alist of fontname patterns vs corresponding CCL program.  */
  41 Lisp_Object Vfont_ccl_encoder_alist;
  42
  43 /* Vector of CCL program names vs corresponding program data.  */
  44 Lisp_Object Vccl_program_table;
  45
  46 /* CCL (Code Conversion Language) is a simple language which has
  47    operations on one input buffer, one output buffer, and 7 registers.
  48    The syntax of CCL is described in `ccl.el'.  Emacs Lisp function
  49    `ccl-compile' compiles a CCL program and produces a CCL code which
  50    is a vector of integers.  The structure of this vector is as
  51    follows: The 1st element: buffer-magnification, a factor for the
  52    size of output buffer compared with the size of input buffer.  The
  53    2nd element: address of CCL code to be executed when encountered
  54    with end of input stream.  The 3rd and the remaining elements: CCL
  55    codes.  */
  56
  57 /* Header of CCL compiled code */
  58 #define CCL_HEADER_BUF_MAG      0
  59 #define CCL_HEADER_EOF          1
  60 #define CCL_HEADER_MAIN         2
  61
  62 /* CCL code is a sequence of 28-bit non-negative integers (i.e. the
  63    MSB is always 0), each contains CCL command and/or arguments in the
  64    following format:
  65
  66         |----------------- integer (28-bit) ------------------|
  67         |------- 17-bit ------|- 3-bit --|- 3-bit --|- 5-bit -|
  68         |--constant argument--|-register-|-register-|-command-|
  69            ccccccccccccccccc      RRR        rrr       XXXXX
  70   or
  71         |------- relative address -------|-register-|-command-|
  72                cccccccccccccccccccc          rrr       XXXXX
  73   or
  74         |------------- constant or other args ----------------|
  75                      cccccccccccccccccccccccccccc
  76
  77    where, `cc...c' is a non-negative integer indicating constant value
  78    (the left most `c' is always 0) or an absolute jump address, `RRR'
  79    and `rrr' are CCL register number, `XXXXX' is one of the following
  80    CCL commands.  */
  81
  82 /* CCL commands
  83
  84    Each comment fields shows one or more lines for command syntax and
  85    the following lines for semantics of the command.  In semantics, IC
  86    stands for Instruction Counter.  */
  87
  88 #define CCL_SetRegister         0x00 /* Set register a register value:
  89                                         1:00000000000000000RRRrrrXXXXX
  90                                         ------------------------------
  91                                         reg[rrr] = reg[RRR];
  92                                         */
  93
  94 #define CCL_SetShortConst       0x01 /* Set register a short constant value:
  95                                         1:CCCCCCCCCCCCCCCCCCCCrrrXXXXX
  96                                         ------------------------------
  97                                         reg[rrr] = CCCCCCCCCCCCCCCCCCC;
  98                                         */
  99
 100 #define CCL_SetConst            0x02 /* Set register a constant value:
 101                                         1:00000000000000000000rrrXXXXX
 102                                         2:CONSTANT
 103                                         ------------------------------
 104                                         reg[rrr] = CONSTANT;
 105                                         IC++;
 106                                         */
 107
 108 #define CCL_SetArray            0x03 /* Set register an element of array:
 109                                         1:CCCCCCCCCCCCCCCCCRRRrrrXXXXX
 110                                         2:ELEMENT[0]
 111                                         3:ELEMENT[1]
 112                                         ...
 113                                         ------------------------------
 114                                         if (0 <= reg[RRR] < CC..C)
 115                                           reg[rrr] = ELEMENT[reg[RRR]];
 116                                         IC += CC..C;
 117                                         */
 118
 119 #define CCL_Jump                0x04 /* Jump:
 120                                         1:A--D--D--R--E--S--S-000XXXXX
 121                                         ------------------------------
 122                                         IC += ADDRESS;
 123                                         */
 124
 125 /* Note: If CC..C is greater than 0, the second code is omitted.  */
 126
 127 #define CCL_JumpCond            0x05 /* Jump conditional:
 128                                         1:A--D--D--R--E--S--S-rrrXXXXX
 129                                         ------------------------------
 130                                         if (!reg[rrr])
 131                                           IC += ADDRESS;
 132                                         */
 133
 134
 135 #define CCL_WriteRegisterJump   0x06 /* Write register and jump:
 136                                         1:A--D--D--R--E--S--S-rrrXXXXX
 137                                         ------------------------------
 138                                         write (reg[rrr]);
 139                                         IC += ADDRESS;
 140                                         */
 141
 142 #define CCL_WriteRegisterReadJump 0x07 /* Write register, read, and jump:
 143                                         1:A--D--D--R--E--S--S-rrrXXXXX
 144                                         2:A--D--D--R--E--S--S-rrrYYYYY
 145                                         -----------------------------
 146                                         write (reg[rrr]);
 147                                         IC++;
 148                                         read (reg[rrr]);
 149                                         IC += ADDRESS;
 150                                         */
 151 /* Note: If read is suspended, the resumed execution starts from the
 152    second code (YYYYY == CCL_ReadJump).  */
 153
 154 #define CCL_WriteConstJump      0x08 /* Write constant and jump:
 155                                         1:A--D--D--R--E--S--S-000XXXXX
 156                                         2:CONST
 157                                         ------------------------------
 158                                         write (CONST);
 159                                         IC += ADDRESS;
 160                                         */
 161
 162 #define CCL_WriteConstReadJump  0x09 /* Write constant, read, and jump:
 163                                         1:A--D--D--R--E--S--S-rrrXXXXX
 164                                         2:CONST
 165                                         3:A--D--D--R--E--S--S-rrrYYYYY
 166                                         -----------------------------
 167                                         write (CONST);
 168                                         IC += 2;
 169                                         read (reg[rrr]);
 170                                         IC += ADDRESS;
 171                                         */
 172 /* Note: If read is suspended, the resumed execution starts from the
 173    second code (YYYYY == CCL_ReadJump).  */
 174
 175 #define CCL_WriteStringJump     0x0A /* Write string and jump:
 176                                         1:A--D--D--R--E--S--S-000XXXXX
 177                                         2:LENGTH
 178                                         3:0000STRIN[0]STRIN[1]STRIN[2]
 179                                         ...
 180                                         ------------------------------
 181                                         write_string (STRING, LENGTH);
 182                                         IC += ADDRESS;
 183                                         */
 184
 185 #define CCL_WriteArrayReadJump  0x0B /* Write an array element, read, and jump:
 186                                         1:A--D--D--R--E--S--S-rrrXXXXX
 187                                         2:LENGTH
 188                                         3:ELEMENET[0]
 189                                         4:ELEMENET[1]
 190                                         ...
 191                                         N:A--D--D--R--E--S--S-rrrYYYYY
 192                                         ------------------------------
 193                                         if (0 <= reg[rrr] < LENGTH)
 194                                           write (ELEMENT[reg[rrr]]);
 195                                         IC += LENGTH + 2; (... pointing at N+1)
 196                                         read (reg[rrr]);
 197                                         IC += ADDRESS;
 198                                         */
 199 /* Note: If read is suspended, the resumed execution starts from the
 200    Nth code (YYYYY == CCL_ReadJump).  */
 201
 202 #define CCL_ReadJump            0x0C /* Read and jump:
 203                                         1:A--D--D--R--E--S--S-rrrYYYYY
 204                                         -----------------------------
 205                                         read (reg[rrr]);
 206                                         IC += ADDRESS;
 207                                         */
 208
 209 #define CCL_Branch              0x0D /* Jump by branch table:
 210                                         1:CCCCCCCCCCCCCCCCCCCCrrrXXXXX
 211                                         2:A--D--D--R--E-S-S[0]000XXXXX
 212                                         3:A--D--D--R--E-S-S[1]000XXXXX
 213                                         ...
 214                                         ------------------------------
 215                                         if (0 <= reg[rrr] < CC..C)
 216                                           IC += ADDRESS[reg[rrr]];
 217                                         else
 218                                           IC += ADDRESS[CC..C];
 219                                         */
 220
 221 #define CCL_ReadRegister        0x0E /* Read bytes into registers:
 222                                         1:CCCCCCCCCCCCCCCCCCCCrrrXXXXX
 223                                         2:CCCCCCCCCCCCCCCCCCCCrrrXXXXX
 224                                         ...
 225                                         ------------------------------
 226                                         while (CCC--)
 227                                           read (reg[rrr]);
 228                                         */
 229
 230 #define CCL_WriteExprConst      0x0F  /* write result of expression:
 231                                         1:00000OPERATION000RRR000XXXXX
 232                                         2:CONSTANT
 233                                         ------------------------------
 234                                         write (reg[RRR] OPERATION CONSTANT);
 235                                         IC++;
 236                                         */
 237
 238 /* Note: If the Nth read is suspended, the resumed execution starts
 239    from the Nth code.  */
 240
 241 #define CCL_ReadBranch          0x10 /* Read one byte into a register,
 242                                         and jump by branch table:
 243                                         1:CCCCCCCCCCCCCCCCCCCCrrrXXXXX
 244                                         2:A--D--D--R--E-S-S[0]000XXXXX
 245                                         3:A--D--D--R--E-S-S[1]000XXXXX
 246                                         ...
 247                                         ------------------------------
 248                                         read (read[rrr]);
 249                                         if (0 <= reg[rrr] < CC..C)
 250                                           IC += ADDRESS[reg[rrr]];
 251                                         else
 252                                           IC += ADDRESS[CC..C];
 253                                         */
 254
 255 #define CCL_WriteRegister       0x11 /* Write registers:
 256                                         1:CCCCCCCCCCCCCCCCCCCrrrXXXXX
 257                                         2:CCCCCCCCCCCCCCCCCCCrrrXXXXX
 258                                         ...
 259                                         ------------------------------
 260                                         while (CCC--)
 261                                           write (reg[rrr]);
 262                                         ...
 263                                         */
 264
 265 /* Note: If the Nth write is suspended, the resumed execution
 266    starts from the Nth code.  */
 267
 268 #define CCL_WriteExprRegister   0x12 /* Write result of expression
 269                                         1:00000OPERATIONRrrRRR000XXXXX
 270                                         ------------------------------
 271                                         write (reg[RRR] OPERATION reg[Rrr]);
 272                                         */
 273
 274 #define CCL_Call                0x13 /* Write a constant:
 275                                         1:CCCCCCCCCCCCCCCCCCCC000XXXXX
 276                                         ------------------------------
 277                                         call (CC..C)
 278                                         */
 279
 280 #define CCL_WriteConstString    0x14 /* Write a constant or a string:
 281                                         1:CCCCCCCCCCCCCCCCCCCCrrrXXXXX
 282                                         [2:0000STRIN[0]STRIN[1]STRIN[2]]
 283                                         [...]
 284                                         -----------------------------
 285                                         if (!rrr)
 286                                           write (CC..C)
 287                                         else
 288                                           write_string (STRING, CC..C);
 289                                           IC += (CC..C + 2) / 3;
 290                                         */
 291
 292 #define CCL_WriteArray          0x15 /* Write an element of array:
 293                                         1:CCCCCCCCCCCCCCCCCCCCrrrXXXXX
 294                                         2:ELEMENT[0]
 295                                         3:ELEMENT[1]
 296                                         ...
 297                                         ------------------------------
 298                                         if (0 <= reg[rrr] < CC..C)
 299                                           write (ELEMENT[reg[rrr]]);
 300                                         IC += CC..C;
 301                                         */
 302
 303 #define CCL_End                 0x16 /* Terminate:
 304                                         1:00000000000000000000000XXXXX
 305                                         ------------------------------
 306                                         terminate ();
 307                                         */
 308
 309 /* The following two codes execute an assignment arithmetic/logical
 310    operation.  The form of the operation is like REG OP= OPERAND.  */
 311
 312 #define CCL_ExprSelfConst       0x17 /* REG OP= constant:
 313                                         1:00000OPERATION000000rrrXXXXX
 314                                         2:CONSTANT
 315                                         ------------------------------
 316                                         reg[rrr] OPERATION= CONSTANT;
 317                                         */
 318
 319 #define CCL_ExprSelfReg         0x18 /* REG1 OP= REG2:
 320                                         1:00000OPERATION000RRRrrrXXXXX
 321                                         ------------------------------
 322                                         reg[rrr] OPERATION= reg[RRR];
 323                                         */
 324
 325 /* The following codes execute an arithmetic/logical operation.  The
 326    form of the operation is like REG_X = REG_Y OP OPERAND2.  */
 327
 328 #define CCL_SetExprConst        0x19 /* REG_X = REG_Y OP constant:
 329                                         1:00000OPERATION000RRRrrrXXXXX
 330                                         2:CONSTANT
 331                                         ------------------------------
 332                                         reg[rrr] = reg[RRR] OPERATION CONSTANT;
 333                                         IC++;
 334                                         */
 335
 336 #define CCL_SetExprReg          0x1A /* REG1 = REG2 OP REG3:
 337                                         1:00000OPERATIONRrrRRRrrrXXXXX
 338                                         ------------------------------
 339                                         reg[rrr] = reg[RRR] OPERATION reg[Rrr];
 340                                         */
 341
 342 #define CCL_JumpCondExprConst   0x1B /* Jump conditional according to
 343                                         an operation on constant:
 344                                         1:A--D--D--R--E--S--S-rrrXXXXX
 345                                         2:OPERATION
 346                                         3:CONSTANT
 347                                         -----------------------------
 348                                         reg[7] = reg[rrr] OPERATION CONSTANT;
 349                                         if (!(reg[7]))
 350                                           IC += ADDRESS;
 351                                         else
 352                                           IC += 2
 353                                         */
 354
 355 #define CCL_JumpCondExprReg     0x1C /* Jump conditional according to
 356                                         an operation on register:
 357                                         1:A--D--D--R--E--S--S-rrrXXXXX
 358                                         2:OPERATION
 359                                         3:RRR
 360                                         -----------------------------
 361                                         reg[7] = reg[rrr] OPERATION reg[RRR];
 362                                         if (!reg[7])
 363                                           IC += ADDRESS;
 364                                         else
 365                                           IC += 2;
 366                                         */
 367
 368 #define CCL_ReadJumpCondExprConst 0x1D /* Read and jump conditional according
 369                                           to an operation on constant:
 370                                         1:A--D--D--R--E--S--S-rrrXXXXX
 371                                         2:OPERATION
 372                                         3:CONSTANT
 373                                         -----------------------------
 374                                         read (reg[rrr]);
 375                                         reg[7] = reg[rrr] OPERATION CONSTANT;
 376                                         if (!reg[7])
 377                                           IC += ADDRESS;
 378                                         else
 379                                           IC += 2;
 380                                         */
 381
 382 #define CCL_ReadJumpCondExprReg 0x1E /* Read and jump conditional according
 383                                         to an operation on register:
 384                                         1:A--D--D--R--E--S--S-rrrXXXXX
 385                                         2:OPERATION
 386                                         3:RRR
 387                                         -----------------------------
 388                                         read (reg[rrr]);
 389                                         reg[7] = reg[rrr] OPERATION reg[RRR];
 390                                         if (!reg[7])
 391                                           IC += ADDRESS;
 392                                         else
 393                                           IC += 2;
 394                                         */
 395
 396 #define CCL_Extention           0x1F /* Extended CCL code
 397                                         1:ExtendedCOMMNDRrrRRRrrrXXXXX
 398                                         2:ARGUEMENT
 399                                         3:...
 400                                         ------------------------------
 401                                         extended_command (rrr,RRR,Rrr,ARGS)
 402                                       */
 403
 404
 405 /* CCL arithmetic/logical operators. */
 406 #define CCL_PLUS        0x00    /* X = Y + Z */
 407 #define CCL_MINUS       0x01    /* X = Y - Z */
 408 #define CCL_MUL         0x02    /* X = Y * Z */
 409 #define CCL_DIV         0x03    /* X = Y / Z */
 410 #define CCL_MOD         0x04    /* X = Y % Z */
 411 #define CCL_AND         0x05    /* X = Y & Z */
 412 #define CCL_OR          0x06    /* X = Y | Z */
 413 #define CCL_XOR         0x07    /* X = Y ^ Z */
 414 #define CCL_LSH         0x08    /* X = Y << Z */
 415 #define CCL_RSH         0x09    /* X = Y >> Z */
 416 #define CCL_LSH8        0x0A    /* X = (Y << 8) | Z */
 417 #define CCL_RSH8        0x0B    /* X = Y >> 8, r[7] = Y & 0xFF  */
 418 #define CCL_DIVMOD      0x0C    /* X = Y / Z, r[7] = Y % Z */
 419 #define CCL_LS          0x10    /* X = (X < Y) */
 420 #define CCL_GT          0x11    /* X = (X > Y) */
 421 #define CCL_EQ          0x12    /* X = (X == Y) */
 422 #define CCL_LE          0x13    /* X = (X <= Y) */
 423 #define CCL_GE          0x14    /* X = (X >= Y) */
 424 #define CCL_NE          0x15    /* X = (X != Y) */
 425
 426 #define CCL_ENCODE_SJIS 0x16    /* X = HIGHER_BYTE (SJIS (Y, Z))
 427                                    r[7] = LOWER_BYTE (SJIS (Y, Z) */
 428 #define CCL_DECODE_SJIS 0x17    /* X = HIGHER_BYTE (DE-SJIS (Y, Z))
 429                                    r[7] = LOWER_BYTE (DE-SJIS (Y, Z)) */
 430
 431 /* Macros for exit status of CCL program.  */
 432 #define CCL_STAT_SUCCESS        0 /* Terminated successfully.  */
 433 #define CCL_STAT_SUSPEND        1 /* Terminated because of empty input
 434                                      buffer or full output buffer.  */
 435 #define CCL_STAT_INVALID_CMD    2 /* Terminated because of invalid
 436                                      command.  */
 437 #define CCL_STAT_QUIT           3 /* Terminated because of quit.  */
 438
 439 /* Encode one character CH to multibyte form and write to the current
 440    output buffer.  If CH is less than 256, CH is written as is.  */
 441 #define CCL_WRITE_CHAR(ch) do {                         \
 442   if (!destination)                                     \
 443     {                                                   \
 444       ccl->status = CCL_STAT_INVALID_CMD;               \
 445       goto ccl_error_handler;                           \
 446     }                                                   \
 447   else                                                  \
 448     {                                                   \
 449       Bufbyte work[MAX_EMCHAR_LEN];                     \
 450       int len = ( ch < ( conversion_mode == CCL_MODE_ENCODING ? \
 451                          256 : 128 ) ) ?                        \
 452         simple_set_charptr_emchar (work, ch) :          \
 453         non_ascii_set_charptr_emchar (work, ch);        \
 454       Dynarr_add_many (destination, work, len);         \
 455     }                                                   \
 456 } while (0)
 457
 458 /* Write a string at ccl_prog[IC] of length LEN to the current output
 459    buffer.  */
 460 #define CCL_WRITE_STRING(len) do {                      \
 461   if (!destination)                                     \
 462     {                                                   \
 463       ccl->status = CCL_STAT_INVALID_CMD;               \
 464       goto ccl_error_handler;                           \
 465     }                                                   \
 466   else                                                  \
 467     for (i = 0; i < len; i++)                           \
 468       Dynarr_add(destination,                           \
 469                  (XINT (ccl_prog[ic + (i / 3)])         \
 470                   >> ((2 - (i % 3)) * 8)) & 0xFF);      \
 471 } while (0)
 472
 473 /* Read one byte from the current input buffer into Rth register.  */
 474 #define CCL_READ_CHAR(r) do {                   \
 475   if (!src)                                     \
 476     {                                           \
 477       ccl->status = CCL_STAT_INVALID_CMD;       \
 478       goto ccl_error_handler;                   \
 479     }                                           \
 480   else if (src < src_end)                       \
 481     r = *src++;                                 \
 482   else if (ccl->last_block)                     \
 483     {                                           \
 484       ic = ccl->eof_ic;                         \
 485       goto ccl_finish;                          \
 486     }                                           \
 487   else                                          \
 488     /* Suspend CCL program because of           \
 489        reading from empty input buffer or       \
 490        writing to full output buffer.           \
 491        When this program is resumed, the        \
 492        same I/O command is executed.  */        \
 493     {                                           \
 494       ic--;                                     \
 495       ccl->status = CCL_STAT_SUSPEND;           \
 496       goto ccl_finish;                          \
 497     }                                           \
 498 } while (0)
 499
 500
 501 /* Execute CCL code on SRC_BYTES length text at SOURCE.  The resulting
 502    text goes to a place pointed by DESTINATION. The bytes actually
 503    processed is returned as *CONSUMED.  The return value is the length
 504    of the resulting text.  As a side effect, the contents of CCL registers
 505    are updated.  If SOURCE or DESTINATION is NULL, only operations on
 506    registers are permitted.  */
 507
 508 #ifdef CCL_DEBUG
 509 #define CCL_DEBUG_BACKTRACE_LEN 256
 510 int ccl_backtrace_table[CCL_BACKTRACE_TABLE];
 511 int ccl_backtrace_idx;
 512 #endif
 513
 514 struct ccl_prog_stack
 515   {
 516     Lisp_Object *ccl_prog;      /* Pointer to an array of CCL code.  */
 517     int ic;                     /* Instruction Counter.  */
 518   };
 519
 520 int
 521 ccl_driver (struct ccl_program *ccl, CONST unsigned char *source, unsigned_char_dynarr *destination, int src_bytes, int *consumed, int conversion_mode)
 522 {
 523   int *reg = ccl->reg;
 524   int ic = ccl->ic;
 525   int code = -1; /* init to illegal value,  */
 526   int field1, field2;
 527   Lisp_Object *ccl_prog = ccl->prog;
 528   CONST unsigned char *src = source, *src_end = src + src_bytes;
 529   int jump_address = 0; /* shut up the compiler */
 530
 531   int i, j, op;
 532   int stack_idx = 0;
 533   /* For the moment, we only support depth 256 of stack.  */
 534   struct ccl_prog_stack ccl_prog_stack_struct[256];
 535
 536   if (ic >= ccl->eof_ic)
 537     ic = CCL_HEADER_MAIN;
 538
 539 #ifdef CCL_DEBUG
 540   ccl_backtrace_idx = 0;
 541 #endif
 542
 543   for (;;)
 544     {
 545 #ifdef CCL_DEBUG
 546       ccl_backtrace_table[ccl_backtrace_idx++] = ic;
 547       if (ccl_backtrace_idx >= CCL_DEBUG_BACKTRACE_LEN)
 548         ccl_backtrace_idx = 0;
 549       ccl_backtrace_table[ccl_backtrace_idx] = 0;
 550 #endif
 551
 552       if (!NILP (Vquit_flag) && NILP (Vinhibit_quit))
 553         {
 554           /* We can't just signal Qquit, instead break the loop as if
 555              the whole data is processed.  Don't reset Vquit_flag, it
 556              must be handled later at a safer place.  */
 557           if (consumed)
 558             src = source + src_bytes;
 559           ccl->status = CCL_STAT_QUIT;
 560           break;
 561         }
 562
 563       code = XINT (ccl_prog[ic]); ic++;
 564       field1 = code >> 8;
 565       field2 = (code & 0xFF) >> 5;
 566
 567 #define rrr field2
 568 #define RRR (field1 & 7)
 569 #define Rrr ((field1 >> 3) & 7)
 570 #define ADDR field1
 571
 572       switch (code & 0x1F)
 573         {
 574         case CCL_SetRegister:   /* 00000000000000000RRRrrrXXXXX */
 575           reg[rrr] = reg[RRR];
 576           break;
 577
 578         case CCL_SetShortConst: /* CCCCCCCCCCCCCCCCCCCCrrrXXXXX */
 579           reg[rrr] = field1;
 580           break;
 581
 582         case CCL_SetConst:      /* 00000000000000000000rrrXXXXX */
 583           reg[rrr] = XINT (ccl_prog[ic]);
 584           ic++;
 585           break;
 586
 587         case CCL_SetArray:      /* CCCCCCCCCCCCCCCCCCCCRRRrrrXXXXX */
 588           i = reg[RRR];
 589           j = field1 >> 3;
 590           if ((unsigned int) i < j)
 591             reg[rrr] = XINT (ccl_prog[ic + i]);
 592           ic += j;
 593           break;
 594
 595         case CCL_Jump:          /* A--D--D--R--E--S--S-000XXXXX */
 596           ic += ADDR;
 597           break;
 598
 599         case CCL_JumpCond:      /* A--D--D--R--E--S--S-rrrXXXXX */
 600           if (!reg[rrr])
 601             ic += ADDR;
 602           break;
 603
 604         case CCL_WriteRegisterJump: /* A--D--D--R--E--S--S-rrrXXXXX */
 605           i = reg[rrr];
 606           CCL_WRITE_CHAR (i);
 607           ic += ADDR;
 608           break;
 609
 610         case CCL_WriteRegisterReadJump: /* A--D--D--R--E--S--S-rrrXXXXX */
 611           i = reg[rrr];
 612           CCL_WRITE_CHAR (i);
 613           ic++;
 614           CCL_READ_CHAR (reg[rrr]);
 615           ic += ADDR - 1;
 616           break;
 617
 618         case CCL_WriteConstJump: /* A--D--D--R--E--S--S-000XXXXX */
 619           i = XINT (ccl_prog[ic]);
 620           CCL_WRITE_CHAR (i);
 621           ic += ADDR;
 622           break;
 623
 624         case CCL_WriteConstReadJump: /* A--D--D--R--E--S--S-rrrXXXXX */
 625           i = XINT (ccl_prog[ic]);
 626           CCL_WRITE_CHAR (i);
 627           ic++;
 628           CCL_READ_CHAR (reg[rrr]);
 629           ic += ADDR - 1;
 630           break;
 631
 632         case CCL_WriteStringJump: /* A--D--D--R--E--S--S-000XXXXX */
 633           j = XINT (ccl_prog[ic]);
 634           ic++;
 635           CCL_WRITE_STRING (j);
 636           ic += ADDR - 1;
 637           break;
 638
 639         case CCL_WriteArrayReadJump: /* A--D--D--R--E--S--S-rrrXXXXX */
 640           i = reg[rrr];
 641           j = XINT (ccl_prog[ic]);
 642           if ((unsigned int) i < j)
 643             {
 644               i = XINT (ccl_prog[ic + 1 + i]);
 645               CCL_WRITE_CHAR (i);
 646             }
 647           ic += j + 2;
 648           CCL_READ_CHAR (reg[rrr]);
 649           ic += ADDR - (j + 2);
 650           break;
 651
 652         case CCL_ReadJump:      /* A--D--D--R--E--S--S-rrrYYYYY */
 653           CCL_READ_CHAR (reg[rrr]);
 654           ic += ADDR;
 655           break;
 656
 657         case CCL_ReadBranch:    /* CCCCCCCCCCCCCCCCCCCCrrrXXXXX */
 658           CCL_READ_CHAR (reg[rrr]);
 659           /* fall through ... */
 660         case CCL_Branch:        /* CCCCCCCCCCCCCCCCCCCCrrrXXXXX */
 661           if ((unsigned int) reg[rrr] < field1)
 662             ic += XINT (ccl_prog[ic + reg[rrr]]);
 663           else
 664             ic += XINT (ccl_prog[ic + field1]);
 665           break;
 666
 667         case CCL_ReadRegister:  /* CCCCCCCCCCCCCCCCCCCCrrXXXXX */
 668           while (1)
 669             {
 670               CCL_READ_CHAR (reg[rrr]);
 671               if (!field1) break;
 672               code = XINT (ccl_prog[ic]); ic++;
 673               field1 = code >> 8;
 674               field2 = (code & 0xFF) >> 5;
 675             }
 676           break;
 677
 678         case CCL_WriteExprConst:  /* 1:00000OPERATION000RRR000XXXXX */
 679           rrr = 7;
 680           i = reg[RRR];
 681           j = XINT (ccl_prog[ic]);
 682           op = field1 >> 6;
 683           ic++;
 684           goto ccl_set_expr;
 685
 686         case CCL_WriteRegister: /* CCCCCCCCCCCCCCCCCCCrrrXXXXX */
 687           while (1)
 688             {
 689               i = reg[rrr];
 690               CCL_WRITE_CHAR (i);
 691               if (!field1) break;
 692               code = XINT (ccl_prog[ic]); ic++;
 693               field1 = code >> 8;
 694               field2 = (code & 0xFF) >> 5;
 695             }
 696           break;
 697
 698         case CCL_WriteExprRegister: /* 1:00000OPERATIONRrrRRR000XXXXX */
 699           rrr = 7;
 700           i = reg[RRR];
 701           j = reg[Rrr];
 702           op = field1 >> 6;
 703           goto ccl_set_expr;
 704
 705         case CCL_Call:          /* CCCCCCCCCCCCCCCCCCCC000XXXXX */
 706           {
 707             Lisp_Object slot;
 708
 709             if (stack_idx >= 256
 710                 || field1 < 0
 711                 || field1 >= XVECTOR_LENGTH (Vccl_program_table)
 712                 || (slot = XVECTOR_DATA (Vccl_program_table)[field1],
 713                     !CONSP (slot))
 714                 || !VECTORP (XCDR (slot)))
 715               {
 716                 if (stack_idx > 0)
 717                   {
 718                     ccl_prog = ccl_prog_stack_struct[0].ccl_prog;
 719                     ic = ccl_prog_stack_struct[0].ic;
 720                   }
 721                 ccl->status = CCL_STAT_INVALID_CMD;
 722                 goto ccl_error_handler;
 723               }
 724
 725             ccl_prog_stack_struct[stack_idx].ccl_prog = ccl_prog;
 726             ccl_prog_stack_struct[stack_idx].ic = ic;
 727             stack_idx++;
 728             ccl_prog = XVECTOR_DATA (XCDR (slot));
 729             ic = CCL_HEADER_MAIN;
 730           }
 731           break;
 732
 733         case CCL_WriteConstString: /* CCCCCCCCCCCCCCCCCCCCrrrXXXXX */
 734           if (!rrr)
 735             CCL_WRITE_CHAR (field1);
 736           else
 737             {
 738               CCL_WRITE_STRING (field1);
 739               ic += (field1 + 2) / 3;
 740             }
 741           break;
 742
 743         case CCL_WriteArray:    /* CCCCCCCCCCCCCCCCCCCCrrrXXXXX */
 744           i = reg[rrr];
 745           if ((unsigned int) i < field1)
 746             {
 747               j = XINT (ccl_prog[ic + i]);
 748               CCL_WRITE_CHAR (j);
 749             }
 750           ic += field1;
 751           break;
 752
 753         case CCL_End:           /* 0000000000000000000000XXXXX */
 754           if (stack_idx-- > 0)
 755             {
 756               ccl_prog = ccl_prog_stack_struct[stack_idx].ccl_prog;
 757               ic = ccl_prog_stack_struct[stack_idx].ic;
 758               break;
 759             }
 760           /* Terminate CCL program successfully.  */
 761           ccl->status = CCL_STAT_SUCCESS;
 762           ccl->ic = CCL_HEADER_MAIN;
 763           goto ccl_finish;
 764
 765         case CCL_ExprSelfConst: /* 00000OPERATION000000rrrXXXXX */
 766           i = XINT (ccl_prog[ic]);
 767           ic++;
 768           op = field1 >> 6;
 769           goto ccl_expr_self;
 770
 771         case CCL_ExprSelfReg:   /* 00000OPERATION000RRRrrrXXXXX */
 772           i = reg[RRR];
 773           op = field1 >> 6;
 774
 775         ccl_expr_self:
 776           switch (op)
 777             {
 778             case CCL_PLUS: reg[rrr] += i; break;
 779             case CCL_MINUS: reg[rrr] -= i; break;
 780             case CCL_MUL: reg[rrr] *= i; break;
 781             case CCL_DIV: reg[rrr] /= i; break;
 782             case CCL_MOD: reg[rrr] %= i; break;
 783             case CCL_AND: reg[rrr] &= i; break;
 784             case CCL_OR: reg[rrr] |= i; break;
 785             case CCL_XOR: reg[rrr] ^= i; break;
 786             case CCL_LSH: reg[rrr] <<= i; break;
 787             case CCL_RSH: reg[rrr] >>= i; break;
 788             case CCL_LSH8: reg[rrr] <<= 8; reg[rrr] |= i; break;
 789             case CCL_RSH8: reg[7] = reg[rrr] & 0xFF; reg[rrr] >>= 8; break;
 790             case CCL_DIVMOD: reg[7] = reg[rrr] % i; reg[rrr] /= i; break;
 791             case CCL_LS: reg[rrr] = reg[rrr] < i; break;
 792             case CCL_GT: reg[rrr] = reg[rrr] > i; break;
 793             case CCL_EQ: reg[rrr] = reg[rrr] == i; break;
 794             case CCL_LE: reg[rrr] = reg[rrr] <= i; break;
 795             case CCL_GE: reg[rrr] = reg[rrr] >= i; break;
 796             case CCL_NE: reg[rrr] = reg[rrr] != i; break;
 797             default:
 798               ccl->status = CCL_STAT_INVALID_CMD;
 799               goto ccl_error_handler;
 800             }
 801           break;
 802
 803         case CCL_SetExprConst:  /* 00000OPERATION000RRRrrrXXXXX */
 804           i = reg[RRR];
 805           j = XINT (ccl_prog[ic]);
 806           op = field1 >> 6;
 807           jump_address = ++ic;
 808           goto ccl_set_expr;
 809
 810         case CCL_SetExprReg:    /* 00000OPERATIONRrrRRRrrrXXXXX */
 811           i = reg[RRR];
 812           j = reg[Rrr];
 813           op = field1 >> 6;
 814           jump_address = ic;
 815           goto ccl_set_expr;
 816
 817         case CCL_ReadJumpCondExprConst: /* A--D--D--R--E--S--S-rrrXXXXX */
 818           CCL_READ_CHAR (reg[rrr]);
 819         case CCL_JumpCondExprConst: /* A--D--D--R--E--S--S-rrrXXXXX */
 820           i = reg[rrr];
 821           op = XINT (ccl_prog[ic]);
 822           jump_address = ic++ + ADDR;
 823           j = XINT (ccl_prog[ic]);
 824           ic++;
 825           rrr = 7;
 826           goto ccl_set_expr;
 827
 828         case CCL_ReadJumpCondExprReg: /* A--D--D--R--E--S--S-rrrXXXXX */
 829           CCL_READ_CHAR (reg[rrr]);
 830         case CCL_JumpCondExprReg:
 831           i = reg[rrr];
 832           op = XINT (ccl_prog[ic]);
 833           jump_address = ic++ + ADDR;
 834           j = reg[XINT (ccl_prog[ic])];
 835           ic++;
 836           rrr = 7;
 837
 838         ccl_set_expr:
 839           switch (op)
 840             {
 841             case CCL_PLUS: reg[rrr] = i + j; break;
 842             case CCL_MINUS: reg[rrr] = i - j; break;
 843             case CCL_MUL: reg[rrr] = i * j; break;
 844             case CCL_DIV: reg[rrr] = i / j; break;
 845             case CCL_MOD: reg[rrr] = i % j; break;
 846             case CCL_AND: reg[rrr] = i & j; break;
 847             case CCL_OR: reg[rrr] = i | j; break;
 848             case CCL_XOR: reg[rrr] = i ^ j; break;
 849             case CCL_LSH: reg[rrr] = i << j; break;
 850             case CCL_RSH: reg[rrr] = i >> j; break;
 851             case CCL_LSH8: reg[rrr] = (i << 8) | j; break;
 852             case CCL_RSH8: reg[rrr] = i >> 8; reg[7] = i & 0xFF; break;
 853             case CCL_DIVMOD: reg[rrr] = i / j; reg[7] = i % j; break;
 854             case CCL_LS: reg[rrr] = i < j; break;
 855             case CCL_GT: reg[rrr] = i > j; break;
 856             case CCL_EQ: reg[rrr] = i == j; break;
 857             case CCL_LE: reg[rrr] = i <= j; break;
 858             case CCL_GE: reg[rrr] = i >= j; break;
 859             case CCL_NE: reg[rrr] = i != j; break;
 860             case CCL_ENCODE_SJIS: ENCODE_SJIS (i, j, reg[rrr], reg[7]); break;
 861             case CCL_DECODE_SJIS: DECODE_SJIS (i, j, reg[rrr], reg[7]); break;
 862             default:
 863               ccl->status = CCL_STAT_INVALID_CMD;
 864               goto ccl_error_handler;
 865             }
 866           code &= 0x1F;
 867           if (code == CCL_WriteExprConst || code == CCL_WriteExprRegister)
 868             {
 869               i = reg[rrr];
 870               CCL_WRITE_CHAR (i);
 871             }
 872           else if (!reg[rrr])
 873             ic = jump_address;
 874           break;
 875
 876         default:
 877           ccl->status = CCL_STAT_INVALID_CMD;
 878           goto ccl_error_handler;
 879         }
 880     }
 881
 882  ccl_error_handler:
 883   if (destination)
 884     {
 885       /* We can insert an error message only if DESTINATION is
 886          specified and we still have a room to store the message
 887          there.  */
 888       char msg[256];
 889
 890       switch (ccl->status)
 891         {
 892           /* Terminate CCL program because of invalid command.
 893              Should not occur in the normal case.  */
 894         case CCL_STAT_INVALID_CMD:
 895           sprintf(msg, "\nCCL: Invalid command %x (ccl_code = %x) at %d.",
 896                   code & 0x1F, code, ic);
 897 #ifdef CCL_DEBUG
 898           {
 899             int i = ccl_backtrace_idx - 1;
 900             int j;
 901
 902             Dynarr_add_many (destination, (unsigned char *) msg, strlen (msg));
 903
 904             for (j = 0; j < CCL_DEBUG_BACKTRACE_LEN; j++, i--)
 905               {
 906                 if (i < 0) i = CCL_DEBUG_BACKTRACE_LEN - 1;
 907                 if (ccl_backtrace_table[i] == 0)
 908                   break;
 909                 sprintf(msg, " %d", ccl_backtrace_table[i]);
 910                 Dynarr_add_many (destination, (unsigned char *) msg, strlen (msg));
 911               }
 912           }
 913 #endif
 914           goto ccl_finish;
 915
 916         case CCL_STAT_QUIT:
 917           sprintf(msg, "\nCCL: Quited.");
 918           break;
 919
 920         default:
 921           sprintf(msg, "\nCCL: Unknown error type (%d).", ccl->status);
 922         }
 923
 924       Dynarr_add_many (destination, (unsigned char *) msg, strlen (msg));
 925     }
 926
 927  ccl_finish:
 928   ccl->ic = ic;
 929   if (consumed) *consumed = src - source;
 930   if (destination)
 931     return Dynarr_length (destination);
 932   else
 933     return 0;
 934 }
 935
 936 /* Setup fields of the structure pointed by CCL appropriately for the
 937    execution of compiled CCL code in VEC (vector of integer).  */
 938 void
 939 setup_ccl_program (struct ccl_program *ccl, Lisp_Object vec)
 940 {
 941   int i;
 942
 943   ccl->size = XVECTOR_LENGTH (vec);
 944   ccl->prog = XVECTOR_DATA (vec);
 945   ccl->ic = CCL_HEADER_MAIN;
 946   ccl->eof_ic = XINT (XVECTOR_DATA (vec)[CCL_HEADER_EOF]);
 947   ccl->buf_magnification = XINT (XVECTOR_DATA (vec)[CCL_HEADER_BUF_MAG]);
 948   for (i = 0; i < 8; i++)
 949     ccl->reg[i] = 0;
 950   ccl->last_block = 0;
 951   ccl->status = 0;
 952 }
 953
 954 #ifdef emacs
 955
 956 DEFUN ("ccl-execute", Fccl_execute, 2, 2, 0, /*
 957 Execute CCL-PROGRAM with registers initialized by REGISTERS.
 958 CCL-PROGRAM is a compiled code generated by `ccl-compile',
 959  no I/O commands should appear in the CCL program.
 960 REGISTERS is a vector of [R0 R1 ... R7] where RN is an initial value
 961  of Nth register.
 962 As side effect, each element of REGISTER holds the value of
 963  corresponding register after the execution.
 964 */
 965   (ccl_prog, reg))
 966 {
 967   struct ccl_program ccl;
 968   int i;
 969
 970   CHECK_VECTOR (ccl_prog);
 971   CHECK_VECTOR (reg);
 972   if (XVECTOR_LENGTH (reg) != 8)
 973     signal_simple_error ("Vector should be of length 8", reg);
 974
 975   setup_ccl_program (&ccl, ccl_prog);
 976   for (i = 0; i < 8; i++)
 977     ccl.reg[i] = (INTP (XVECTOR_DATA (reg)[i])
 978                   ? XINT (XVECTOR_DATA (reg)[i])
 979                   : 0);
 980
 981   ccl_driver (&ccl, (CONST unsigned char *)0, (unsigned_char_dynarr *)0,
 982               0, (int *)0, CCL_MODE_ENCODING);
 983   QUIT;
 984   if (ccl.status != CCL_STAT_SUCCESS)
 985     error ("Error in CCL program at %dth code", ccl.ic);
 986
 987   for (i = 0; i < 8; i++)
 988     XSETINT (XVECTOR_DATA (reg)[i], ccl.reg[i]);
 989   return Qnil;
 990 }
 991
 992 DEFUN ("ccl-execute-on-string", Fccl_execute_on_string, 3, 4, 0, /*
 993 Execute CCL-PROGRAM with initial STATUS on STRING.
 994 CCL-PROGRAM is a compiled code generated by `ccl-compile'.
 995 Read buffer is set to STRING, and write buffer is allocated automatically.
 996 STATUS is a vector of [R0 R1 ... R7 IC], where
 997  R0..R7 are initial values of corresponding registers,
 998  IC is the instruction counter specifying from where to start the program.
 999 If R0..R7 are nil, they are initialized to 0.
1000 If IC is nil, it is initialized to head of the CCL program.
1001 Returns the contents of write buffer as a string,
1002  and as side effect, STATUS is updated.
1003 If optional 4th arg CONTINUE is non-nil, keep IC on read operation
1004 when read buffer is exausted, else, IC is always set to the end of
1005 CCL-PROGRAM on exit.
1006 */
1007   (ccl_prog, status, str, contin))
1008 {
1009   Lisp_Object val;
1010   struct ccl_program ccl;
1011   int i, produced;
1012   unsigned_char_dynarr *outbuf;
1013   struct gcpro gcpro1, gcpro2, gcpro3;
1014
1015   CHECK_VECTOR (ccl_prog);
1016   CHECK_VECTOR (status);
1017   if (XVECTOR_LENGTH (status) != 9)
1018     signal_simple_error ("Vector should be of length 9", status);
1019   CHECK_STRING (str);
1020   GCPRO3 (ccl_prog, status, str);
1021
1022   setup_ccl_program (&ccl, ccl_prog);
1023   for (i = 0; i < 8; i++)
1024     {
1025       if (NILP (XVECTOR_DATA (status)[i]))
1026         XSETINT (XVECTOR_DATA (status)[i], 0);
1027       if (INTP (XVECTOR_DATA (status)[i]))
1028         ccl.reg[i] = XINT (XVECTOR_DATA (status)[i]);
1029     }
1030   if (INTP (XVECTOR_DATA (status)[8]))
1031     {
1032       i = XINT (XVECTOR_DATA (status)[8]);
1033       if (ccl.ic < i && i < ccl.size)
1034         ccl.ic = i;
1035     }
1036   outbuf = Dynarr_new (unsigned_char);
1037   ccl.last_block = NILP (contin);
1038   produced = ccl_driver (&ccl, XSTRING_DATA (str), outbuf,
1039                          XSTRING_LENGTH (str), (int *)0, CCL_MODE_ENCODING);
1040   for (i = 0; i < 8; i++)
1041     XVECTOR_DATA (status)[i] = make_int(ccl.reg[i]);
1042   XSETINT (XVECTOR_DATA (status)[8], ccl.ic);
1043   UNGCPRO;
1044
1045   val = make_string (Dynarr_atp (outbuf, 0), produced);
1046   Dynarr_free (outbuf);
1047   QUIT;
1048   if (ccl.status != CCL_STAT_SUCCESS
1049       && ccl.status != CCL_STAT_SUSPEND)
1050     error ("Error in CCL program at %dth code", ccl.ic);
1051
1052   return val;
1053 }
1054
1055 DEFUN ("register-ccl-program", Fregister_ccl_program, 2, 2, 0, /*
1056 Register CCL program PROGRAM of NAME in `ccl-program-table'.
1057 PROGRAM should be a compiled code of CCL program, or nil.
1058 Return index number of the registered CCL program.
1059 */
1060   (name, ccl_prog))
1061 {
1062   int len = XVECTOR_LENGTH (Vccl_program_table);
1063   int i;
1064
1065   CHECK_SYMBOL (name);
1066   if (!NILP (ccl_prog))
1067     CHECK_VECTOR (ccl_prog);
1068
1069   for (i = 0; i < len; i++)
1070     {
1071       Lisp_Object slot = XVECTOR_DATA (Vccl_program_table)[i];
1072
1073       if (!CONSP (slot))
1074         break;
1075
1076       if (EQ (name, XCAR (slot)))
1077         {
1078           XCDR (slot) = ccl_prog;
1079           return make_int (i);
1080         }
1081     }
1082
1083   if (i == len)
1084     {
1085       Lisp_Object new_table = Fmake_vector (make_int (len * 2), Qnil);
1086       int j;
1087
1088       for (j = 0; j < len; j++)
1089         XVECTOR_DATA (new_table)[j]
1090           = XVECTOR_DATA (Vccl_program_table)[j];
1091       Vccl_program_table = new_table;
1092     }
1093
1094   XVECTOR_DATA (Vccl_program_table)[i] = Fcons (name, ccl_prog);
1095   return make_int (i);
1096 }
1097
1098 void
1099 syms_of_mule_ccl (void)
1100 {
1101   DEFSUBR (Fccl_execute);
1102   DEFSUBR (Fccl_execute_on_string);
1103   DEFSUBR (Fregister_ccl_program);
1104 }
1105
1106 void
1107 vars_of_mule_ccl (void)
1108 {
1109   staticpro (&Vccl_program_table);
1110   Vccl_program_table = Fmake_vector (make_int (32), Qnil);
1111
1112   DEFVAR_LISP ("font-ccl-encoder-alist", &Vfont_ccl_encoder_alist /*
1113 Alist of fontname patterns vs corresponding CCL program.
1114 Each element looks like (REGEXP . CCL-CODE),
1115  where CCL-CODE is a compiled CCL program.
1116 When a font whose name matches REGEXP is used for displaying a character,
1117  CCL-CODE is executed to calculate the code point in the font
1118  from the charset number and position code(s) of the character which are set
1119  in CCL registers R0, R1, and R2 before the execution.
1120 The code point in the font is set in CCL registers R1 and R2
1121  when the execution terminated.
1122 If the font is single-byte font, the register R2 is not used.
1123 */ );
1124   Vfont_ccl_encoder_alist = Qnil;
1125 }
1126
1127 #endif  /* emacs */