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

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