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