src/ccl.c

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