1 /* CCL (Code Conversion Language) interpreter.
   2    Copyright (C) 2001, 2002, 2003, 2004, 2005,
   3                  2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
   4    Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
   5      2005, 2006, 2007, 2008, 2009, 2010
   6      National Institute of Advanced Industrial Science and Technology (AIST)
   7      Registration Number H14PRO021
   8    Copyright (C) 2003
   9      National Institute of Advanced Industrial Science and Technology (AIST)
  10      Registration Number H13PRO009
  11 
  12 This file is part of GNU Emacs.
  13 
  14 GNU Emacs is free software: you can redistribute it and/or modify
  15 it under the terms of the GNU General Public License as published by
  16 the Free Software Foundation, either version 3 of the License, or
  17 (at your option) any later version.
  18 
  19 GNU Emacs is distributed in the hope that it will be useful,
  20 but WITHOUT ANY WARRANTY; without even the implied warranty of
  21 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  22 GNU General Public License for more details.
  23 
  24 You should have received a copy of the GNU General Public License
  25 along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.  */
  26 
  27 #include <config.h>
  28 
  29 #include <stdio.h>
  30 #include <setjmp.h>
  31 
  32 #include "lisp.h"
  33 #include "character.h"
  34 #include "charset.h"
  35 #include "ccl.h"
  36 #include "coding.h"
  37 
  38 Lisp_Object Qccl, Qcclp;
  39 
  40 /* This contains all code conversion map available to CCL.  */
  41 Lisp_Object Vcode_conversion_map_vector;
  42 
  43 /* Alist of fontname patterns vs corresponding CCL program.  */
  44 Lisp_Object Vfont_ccl_encoder_alist;
  45 
  46 /* This symbol is a property which associates with ccl program vector.
  47    Ex: (get 'ccl-big5-encoder 'ccl-program) returns ccl program vector.  */
  48 Lisp_Object Qccl_program;
  49 
  50 /* These symbols are properties which associate with code conversion
  51    map and their ID respectively.  */
  52 Lisp_Object Qcode_conversion_map;
  53 Lisp_Object Qcode_conversion_map_id;
  54 
  55 /* Symbols of ccl program have this property, a value of the property
  56    is an index for Vccl_protram_table. */
  57 Lisp_Object Qccl_program_idx;
  58 
  59 /* Table of registered CCL programs.  Each element is a vector of
  60    NAME, CCL_PROG, RESOLVEDP, and UPDATEDP, where NAME (symbol) is the
  61    name of the program, CCL_PROG (vector) is the compiled code of the
  62    program, RESOLVEDP (t or nil) is the flag to tell if symbols in
  63    CCL_PROG is already resolved to index numbers or not, UPDATEDP (t
  64    or nil) is the flat to tell if the CCL program is updated after it
  65    was once used.  */
  66 Lisp_Object Vccl_program_table;
  67 
  68 /* Vector of registered hash tables for translation.  */
  69 Lisp_Object Vtranslation_hash_table_vector;
  70 
  71 /* Return a hash table of id number ID.  */
  72 #define GET_HASH_TABLE(id) \
  73   (XHASH_TABLE (XCDR(XVECTOR(Vtranslation_hash_table_vector)->contents[(id)])))
  74 
  75 extern int charset_unicode;
  76 
  77 /* CCL (Code Conversion Language) is a simple language which has
  78    operations on one input buffer, one output buffer, and 7 registers.
  79    The syntax of CCL is described in `ccl.el'.  Emacs Lisp function
  80    `ccl-compile' compiles a CCL program and produces a CCL code which
  81    is a vector of integers.  The structure of this vector is as
  82    follows: The 1st element: buffer-magnification, a factor for the
  83    size of output buffer compared with the size of input buffer.  The
  84    2nd element: address of CCL code to be executed when encountered
  85    with end of input stream.  The 3rd and the remaining elements: CCL
  86    codes.  */
  87 
  88 /* Header of CCL compiled code */
  89 #define CCL_HEADER_BUF_MAG      0
  90 #define CCL_HEADER_EOF          1
  91 #define CCL_HEADER_MAIN         2
  92 
  93 /* CCL code is a sequence of 28-bit non-negative integers (i.e. the
  94    MSB is always 0), each contains CCL command and/or arguments in the
  95    following format:
  96 
  97         |----------------- integer (28-bit) ------------------|
  98         |------- 17-bit ------|- 3-bit --|- 3-bit --|- 5-bit -|
  99         |--constant argument--|-register-|-register-|-command-|
 100            ccccccccccccccccc      RRR        rrr       XXXXX
 101   or
 102         |------- relative address -------|-register-|-command-|
 103                cccccccccccccccccccc          rrr       XXXXX
 104   or
 105         |------------- constant or other args ----------------|
 106                      cccccccccccccccccccccccccccc
 107 
 108    where, `cc...c' is a non-negative integer indicating constant value
 109    (the left most `c' is always 0) or an absolute jump address, `RRR'
 110    and `rrr' are CCL register number, `XXXXX' is one of the following
 111    CCL commands.  */
 112 
 113 /* CCL commands
 114 
 115    Each comment fields shows one or more lines for command syntax and
 116    the following lines for semantics of the command.  In semantics, IC
 117    stands for Instruction Counter.  */
 118 
 119 #define CCL_SetRegister         0x00 /* Set register a register value:
 120                                         1:00000000000000000RRRrrrXXXXX
 121                                         ------------------------------
 122                                         reg[rrr] = reg[RRR];
 123                                         */
 124 
 125 #define CCL_SetShortConst       0x01 /* Set register a short constant value:
 126                                         1:CCCCCCCCCCCCCCCCCCCCrrrXXXXX
 127                                         ------------------------------
 128                                         reg[rrr] = CCCCCCCCCCCCCCCCCCC;
 129                                         */
 130 
 131 #define CCL_SetConst            0x02 /* Set register a constant value:
 132                                         1:00000000000000000000rrrXXXXX
 133                                         2:CONSTANT
 134                                         ------------------------------
 135                                         reg[rrr] = CONSTANT;
 136                                         IC++;
 137                                         */
 138 
 139 #define CCL_SetArray            0x03 /* Set register an element of array:
 140                                         1:CCCCCCCCCCCCCCCCCRRRrrrXXXXX
 141                                         2:ELEMENT[0]
 142                                         3:ELEMENT[1]
 143                                         ...
 144                                         ------------------------------
 145                                         if (0 <= reg[RRR] < CC..C)
 146                                           reg[rrr] = ELEMENT[reg[RRR]];
 147                                         IC += CC..C;
 148                                         */
 149 
 150 #define CCL_Jump                0x04 /* Jump:
 151                                         1:A--D--D--R--E--S--S-000XXXXX
 152                                         ------------------------------
 153                                         IC += ADDRESS;
 154                                         */
 155 
 156 /* Note: If CC..C is greater than 0, the second code is omitted.  */
 157 
 158 #define CCL_JumpCond            0x05 /* Jump conditional:
 159                                         1:A--D--D--R--E--S--S-rrrXXXXX
 160                                         ------------------------------
 161                                         if (!reg[rrr])
 162                                           IC += ADDRESS;
 163                                         */
 164 
 165 
 166 #define CCL_WriteRegisterJump   0x06 /* Write register and jump:
 167                                         1:A--D--D--R--E--S--S-rrrXXXXX
 168                                         ------------------------------
 169                                         write (reg[rrr]);
 170                                         IC += ADDRESS;
 171                                         */
 172 
 173 #define CCL_WriteRegisterReadJump 0x07 /* Write register, read, and jump:
 174                                         1:A--D--D--R--E--S--S-rrrXXXXX
 175                                         2:A--D--D--R--E--S--S-rrrYYYYY
 176                                         -----------------------------
 177                                         write (reg[rrr]);
 178                                         IC++;
 179                                         read (reg[rrr]);
 180                                         IC += ADDRESS;
 181                                         */
 182 /* Note: If read is suspended, the resumed execution starts from the
 183    second code (YYYYY == CCL_ReadJump).  */
 184 
 185 #define CCL_WriteConstJump      0x08 /* Write constant and jump:
 186                                         1:A--D--D--R--E--S--S-000XXXXX
 187                                         2:CONST
 188                                         ------------------------------
 189                                         write (CONST);
 190                                         IC += ADDRESS;
 191                                         */
 192 
 193 #define CCL_WriteConstReadJump  0x09 /* Write constant, read, and jump:
 194                                         1:A--D--D--R--E--S--S-rrrXXXXX
 195                                         2:CONST
 196                                         3:A--D--D--R--E--S--S-rrrYYYYY
 197                                         -----------------------------
 198                                         write (CONST);
 199                                         IC += 2;
 200                                         read (reg[rrr]);
 201                                         IC += ADDRESS;
 202                                         */
 203 /* Note: If read is suspended, the resumed execution starts from the
 204    second code (YYYYY == CCL_ReadJump).  */
 205 
 206 #define CCL_WriteStringJump     0x0A /* Write string and jump:
 207                                         1:A--D--D--R--E--S--S-000XXXXX
 208                                         2:LENGTH
 209                                         3:000MSTRIN[0]STRIN[1]STRIN[2]
 210                                         ...
 211                                         ------------------------------
 212                                         if (M)
 213                                           write_multibyte_string (STRING, LENGTH);
 214                                         else
 215                                           write_string (STRING, LENGTH);
 216                                         IC += ADDRESS;
 217                                         */
 218 
 219 #define CCL_WriteArrayReadJump  0x0B /* Write an array element, read, and jump:
 220                                         1:A--D--D--R--E--S--S-rrrXXXXX
 221                                         2:LENGTH
 222                                         3:ELEMENET[0]
 223                                         4:ELEMENET[1]
 224                                         ...
 225                                         N:A--D--D--R--E--S--S-rrrYYYYY
 226                                         ------------------------------
 227                                         if (0 <= reg[rrr] < LENGTH)
 228                                           write (ELEMENT[reg[rrr]]);
 229                                         IC += LENGTH + 2; (... pointing at N+1)
 230                                         read (reg[rrr]);
 231                                         IC += ADDRESS;
 232                                         */
 233 /* Note: If read is suspended, the resumed execution starts from the
 234    Nth code (YYYYY == CCL_ReadJump).  */
 235 
 236 #define CCL_ReadJump            0x0C /* Read and jump:
 237                                         1:A--D--D--R--E--S--S-rrrYYYYY
 238                                         -----------------------------
 239                                         read (reg[rrr]);
 240                                         IC += ADDRESS;
 241                                         */
 242 
 243 #define CCL_Branch              0x0D /* Jump by branch table:
 244                                         1:CCCCCCCCCCCCCCCCCCCCrrrXXXXX
 245                                         2:A--D--D--R--E-S-S[0]000XXXXX
 246                                         3:A--D--D--R--E-S-S[1]000XXXXX
 247                                         ...
 248                                         ------------------------------
 249                                         if (0 <= reg[rrr] < CC..C)
 250                                           IC += ADDRESS[reg[rrr]];
 251                                         else
 252                                           IC += ADDRESS[CC..C];
 253                                         */
 254 
 255 #define CCL_ReadRegister        0x0E /* Read bytes into registers:
 256                                         1:CCCCCCCCCCCCCCCCCCCCrrrXXXXX
 257                                         2:CCCCCCCCCCCCCCCCCCCCrrrXXXXX
 258                                         ...
 259                                         ------------------------------
 260                                         while (CCC--)
 261                                           read (reg[rrr]);
 262                                         */
 263 
 264 #define CCL_WriteExprConst      0x0F  /* write result of expression:
 265                                         1:00000OPERATION000RRR000XXXXX
 266                                         2:CONSTANT
 267                                         ------------------------------
 268                                         write (reg[RRR] OPERATION CONSTANT);
 269                                         IC++;
 270                                         */
 271 
 272 /* Note: If the Nth read is suspended, the resumed execution starts
 273    from the Nth code.  */
 274 
 275 #define CCL_ReadBranch          0x10 /* Read one byte into a register,
 276                                         and jump by branch table:
 277                                         1:CCCCCCCCCCCCCCCCCCCCrrrXXXXX
 278                                         2:A--D--D--R--E-S-S[0]000XXXXX
 279                                         3:A--D--D--R--E-S-S[1]000XXXXX
 280                                         ...
 281                                         ------------------------------
 282                                         read (read[rrr]);
 283                                         if (0 <= reg[rrr] < CC..C)
 284                                           IC += ADDRESS[reg[rrr]];
 285                                         else
 286                                           IC += ADDRESS[CC..C];
 287                                         */
 288 
 289 #define CCL_WriteRegister       0x11 /* Write registers:
 290                                         1:CCCCCCCCCCCCCCCCCCCrrrXXXXX
 291                                         2:CCCCCCCCCCCCCCCCCCCrrrXXXXX
 292                                         ...
 293                                         ------------------------------
 294                                         while (CCC--)
 295                                           write (reg[rrr]);
 296                                         ...
 297                                         */
 298 
 299 /* Note: If the Nth write is suspended, the resumed execution
 300    starts from the Nth code.  */
 301 
 302 #define CCL_WriteExprRegister   0x12 /* Write result of expression
 303                                         1:00000OPERATIONRrrRRR000XXXXX
 304                                         ------------------------------
 305                                         write (reg[RRR] OPERATION reg[Rrr]);
 306                                         */
 307 
 308 #define CCL_Call                0x13 /* Call the CCL program whose ID is
 309                                         CC..C or cc..c.
 310                                         1:CCCCCCCCCCCCCCCCCCCCFFFXXXXX
 311                                         [2:00000000cccccccccccccccccccc]
 312                                         ------------------------------
 313                                         if (FFF)
 314                                           call (cc..c)
 315                                           IC++;
 316                                         else
 317                                           call (CC..C)
 318                                         */
 319 
 320 #define CCL_WriteConstString    0x14 /* Write a constant or a string:
 321                                         1:CCCCCCCCCCCCCCCCCCCCrrrXXXXX
 322                                         [2:000MSTRIN[0]STRIN[1]STRIN[2]]
 323                                         [...]
 324                                         -----------------------------
 325                                         if (!rrr)
 326                                           write (CC..C)
 327                                         else
 328                                           if (M)
 329                                             write_multibyte_string (STRING, CC..C);
 330                                           else
 331                                             write_string (STRING, CC..C);
 332                                           IC += (CC..C + 2) / 3;
 333                                         */
 334 
 335 #define CCL_WriteArray          0x15 /* Write an element of array:
 336                                         1:CCCCCCCCCCCCCCCCCCCCrrrXXXXX
 337                                         2:ELEMENT[0]
 338                                         3:ELEMENT[1]
 339                                         ...
 340                                         ------------------------------
 341                                         if (0 <= reg[rrr] < CC..C)
 342                                           write (ELEMENT[reg[rrr]]);
 343                                         IC += CC..C;
 344                                         */
 345 
 346 #define CCL_End                 0x16 /* Terminate:
 347                                         1:00000000000000000000000XXXXX
 348                                         ------------------------------
 349                                         terminate ();
 350                                         */
 351 
 352 /* The following two codes execute an assignment arithmetic/logical
 353    operation.  The form of the operation is like REG OP= OPERAND.  */
 354 
 355 #define CCL_ExprSelfConst       0x17 /* REG OP= constant:
 356                                         1:00000OPERATION000000rrrXXXXX
 357                                         2:CONSTANT
 358                                         ------------------------------
 359                                         reg[rrr] OPERATION= CONSTANT;
 360                                         */
 361 
 362 #define CCL_ExprSelfReg         0x18 /* REG1 OP= REG2:
 363                                         1:00000OPERATION000RRRrrrXXXXX
 364                                         ------------------------------
 365                                         reg[rrr] OPERATION= reg[RRR];
 366                                         */
 367 
 368 /* The following codes execute an arithmetic/logical operation.  The
 369    form of the operation is like REG_X = REG_Y OP OPERAND2.  */
 370 
 371 #define CCL_SetExprConst        0x19 /* REG_X = REG_Y OP constant:
 372                                         1:00000OPERATION000RRRrrrXXXXX
 373                                         2:CONSTANT
 374                                         ------------------------------
 375                                         reg[rrr] = reg[RRR] OPERATION CONSTANT;
 376                                         IC++;
 377                                         */
 378 
 379 #define CCL_SetExprReg          0x1A /* REG1 = REG2 OP REG3:
 380                                         1:00000OPERATIONRrrRRRrrrXXXXX
 381                                         ------------------------------
 382                                         reg[rrr] = reg[RRR] OPERATION reg[Rrr];
 383                                         */
 384 
 385 #define CCL_JumpCondExprConst   0x1B /* Jump conditional according to
 386                                         an operation on constant:
 387                                         1:A--D--D--R--E--S--S-rrrXXXXX
 388                                         2:OPERATION
 389                                         3:CONSTANT
 390                                         -----------------------------
 391                                         reg[7] = reg[rrr] OPERATION CONSTANT;
 392                                         if (!(reg[7]))
 393                                           IC += ADDRESS;
 394                                         else
 395                                           IC += 2
 396                                         */
 397 
 398 #define CCL_JumpCondExprReg     0x1C /* Jump conditional according to
 399                                         an operation on register:
 400                                         1:A--D--D--R--E--S--S-rrrXXXXX
 401                                         2:OPERATION
 402                                         3:RRR
 403                                         -----------------------------
 404                                         reg[7] = reg[rrr] OPERATION reg[RRR];
 405                                         if (!reg[7])
 406                                           IC += ADDRESS;
 407                                         else
 408                                           IC += 2;
 409                                         */
 410 
 411 #define CCL_ReadJumpCondExprConst 0x1D /* Read and jump conditional according
 412                                           to an operation on constant:
 413                                         1:A--D--D--R--E--S--S-rrrXXXXX
 414                                         2:OPERATION
 415                                         3:CONSTANT
 416                                         -----------------------------
 417                                         read (reg[rrr]);
 418                                         reg[7] = reg[rrr] OPERATION CONSTANT;
 419                                         if (!reg[7])
 420                                           IC += ADDRESS;
 421                                         else
 422                                           IC += 2;
 423                                         */
 424 
 425 #define CCL_ReadJumpCondExprReg 0x1E /* Read and jump conditional according
 426                                         to an operation on register:
 427                                         1:A--D--D--R--E--S--S-rrrXXXXX
 428                                         2:OPERATION
 429                                         3:RRR
 430                                         -----------------------------
 431                                         read (reg[rrr]);
 432                                         reg[7] = reg[rrr] OPERATION reg[RRR];
 433                                         if (!reg[7])
 434                                           IC += ADDRESS;
 435                                         else
 436                                           IC += 2;
 437                                         */
 438 
 439 #define CCL_Extension           0x1F /* Extended CCL code
 440                                         1:ExtendedCOMMNDRrrRRRrrrXXXXX
 441                                         2:ARGUEMENT
 442                                         3:...
 443                                         ------------------------------
 444                                         extended_command (rrr,RRR,Rrr,ARGS)
 445                                       */
 446 
 447 /*
 448    Here after, Extended CCL Instructions.
 449    Bit length of extended command is 14.
 450    Therefore, the instruction code range is 0..16384(0x3fff).
 451  */
 452 
 453 /* Read a multibyte characeter.
 454    A code point is stored into reg[rrr].  A charset ID is stored into
 455    reg[RRR].  */
 456 
 457 #define CCL_ReadMultibyteChar2  0x00 /* Read Multibyte Character
 458                                         1:ExtendedCOMMNDRrrRRRrrrXXXXX  */
 459 
 460 /* Write a multibyte character.
 461    Write a character whose code point is reg[rrr] and the charset ID
 462    is reg[RRR].  */
 463 
 464 #define CCL_WriteMultibyteChar2 0x01 /* Write Multibyte Character
 465                                         1:ExtendedCOMMNDRrrRRRrrrXXXXX  */
 466 
 467 /* Translate a character whose code point is reg[rrr] and the charset
 468    ID is reg[RRR] by a translation table whose ID is reg[Rrr].
 469 
 470    A translated character is set in reg[rrr] (code point) and reg[RRR]
 471    (charset ID).  */
 472 
 473 #define CCL_TranslateCharacter  0x02 /* Translate a multibyte character
 474                                         1:ExtendedCOMMNDRrrRRRrrrXXXXX  */
 475 
 476 /* Translate a character whose code point is reg[rrr] and the charset
 477    ID is reg[RRR] by a translation table whose ID is ARGUMENT.
 478 
 479    A translated character is set in reg[rrr] (code point) and reg[RRR]
 480    (charset ID).  */
 481 
 482 #define CCL_TranslateCharacterConstTbl 0x03 /* Translate a multibyte character
 483                                                1:ExtendedCOMMNDRrrRRRrrrXXXXX
 484                                                2:ARGUMENT(Translation Table ID)
 485                                             */
 486 
 487 /* Iterate looking up MAPs for reg[rrr] starting from the Nth (N =
 488    reg[RRR]) MAP until some value is found.
 489 
 490    Each MAP is a Lisp vector whose element is number, nil, t, or
 491    lambda.
 492    If the element is nil, ignore the map and proceed to the next map.
 493    If the element is t or lambda, finish without changing reg[rrr].
 494    If the element is a number, set reg[rrr] to the number and finish.
 495 
 496    Detail of the map structure is descibed in the comment for
 497    CCL_MapMultiple below.  */
 498 
 499 #define CCL_IterateMultipleMap  0x10 /* Iterate multiple maps
 500                                         1:ExtendedCOMMNDXXXRRRrrrXXXXX
 501                                         2:NUMBER of MAPs
 502                                         3:MAP-ID1
 503                                         4:MAP-ID2
 504                                         ...
 505                                      */
 506 
 507 /* Map the code in reg[rrr] by MAPs starting from the Nth (N =
 508    reg[RRR]) map.
 509 
 510    MAPs are supplied in the succeeding CCL codes as follows:
 511 
 512    When CCL program gives this nested structure of map to this command:
 513         ((MAP-ID11
 514           MAP-ID12
 515           (MAP-ID121 MAP-ID122 MAP-ID123)
 516           MAP-ID13)
 517          (MAP-ID21
 518           (MAP-ID211 (MAP-ID2111) MAP-ID212)
 519           MAP-ID22)),
 520    the compiled CCL codes has this sequence:
 521         CCL_MapMultiple (CCL code of this command)
 522         16 (total number of MAPs and SEPARATORs)
 523         -7 (1st SEPARATOR)
 524         MAP-ID11
 525         MAP-ID12
 526         -3 (2nd SEPARATOR)
 527         MAP-ID121
 528         MAP-ID122
 529         MAP-ID123
 530         MAP-ID13
 531         -7 (3rd SEPARATOR)
 532         MAP-ID21
 533         -4 (4th SEPARATOR)
 534         MAP-ID211
 535         -1 (5th SEPARATOR)
 536         MAP_ID2111
 537         MAP-ID212
 538         MAP-ID22
 539 
 540    A value of each SEPARATOR follows this rule:
 541         MAP-SET := SEPARATOR [(MAP-ID | MAP-SET)]+
 542         SEPARATOR := -(number of MAP-IDs and SEPARATORs in the MAP-SET)
 543 
 544    (*)....Nest level of MAP-SET must not be over than MAX_MAP_SET_LEVEL.
 545 
 546    When some map fails to map (i.e. it doesn't have a value for
 547    reg[rrr]), the mapping is treated as identity.
 548 
 549    The mapping is iterated for all maps in each map set (set of maps
 550    separated by SEPARATOR) except in the case that lambda is
 551    encountered.  More precisely, the mapping proceeds as below:
 552 
 553    At first, VAL0 is set to reg[rrr], and it is translated by the
 554    first map to VAL1.  Then, VAL1 is translated by the next map to
 555    VAL2.  This mapping is iterated until the last map is used.  The
 556    result of the mapping is the last value of VAL?.  When the mapping
 557    process reached to the end of the map set, it moves to the next
 558    map set.  If the next does not exit, the mapping process terminates,
 559    and regard the last value as a result.
 560 
 561    But, when VALm is mapped to VALn and VALn is not a number, the
 562    mapping proceed as below:
 563 
 564    If VALn is nil, the lastest map is ignored and the mapping of VALm
 565    proceed to the next map.
 566 
 567    In VALn is t, VALm is reverted to reg[rrr] and the mapping of VALm
 568    proceed to the next map.
 569 
 570    If VALn is lambda, move to the next map set like reaching to the
 571    end of the current map set.
 572 
 573    If VALn is a symbol, call the CCL program refered by it.
 574    Then, use reg[rrr] as a mapped value except for -1, -2 and -3.
 575    Such special values are regarded as nil, t, and lambda respectively.
 576 
 577    Each map is a Lisp vector of the following format (a) or (b):
 578         (a)......[STARTPOINT VAL1 VAL2 ...]
 579         (b)......[t VAL STARTPOINT ENDPOINT],
 580    where
 581         STARTPOINT is an offset to be used for indexing a map,
 582         ENDPOINT is a maximum index number of a map,
 583         VAL and VALn is a number, nil, t, or lambda.
 584 
 585    Valid index range of a map of type (a) is:
 586         STARTPOINT <= index < STARTPOINT + map_size - 1
 587    Valid index range of a map of type (b) is:
 588         STARTPOINT <= index < ENDPOINT  */
 589 
 590 #define CCL_MapMultiple 0x11    /* Mapping by multiple code conversion maps
 591                                          1:ExtendedCOMMNDXXXRRRrrrXXXXX
 592                                          2:N-2
 593                                          3:SEPARATOR_1 (< 0)
 594                                          4:MAP-ID_1
 595                                          5:MAP-ID_2
 596                                          ...
 597                                          M:SEPARATOR_x (< 0)
 598                                          M+1:MAP-ID_y
 599                                          ...
 600                                          N:SEPARATOR_z (< 0)
 601                                       */
 602 
 603 #define MAX_MAP_SET_LEVEL 30
 604 
 605 typedef struct
 606 {
 607   int rest_length;
 608   int orig_val;
 609 } tr_stack;
 610 
 611 static tr_stack mapping_stack[MAX_MAP_SET_LEVEL];
 612 static tr_stack *mapping_stack_pointer;
 613 
 614 /* If this variable is non-zero, it indicates the stack_idx
 615    of immediately called by CCL_MapMultiple. */
 616 static int stack_idx_of_map_multiple;
 617 
 618 #define PUSH_MAPPING_STACK(restlen, orig)               \
 619 do                                                      \
 620   {                                                     \
 621     mapping_stack_pointer->rest_length = (restlen);     \
 622     mapping_stack_pointer->orig_val = (orig);           \
 623     mapping_stack_pointer++;                            \
 624   }                                                     \
 625 while (0)
 626 
 627 #define POP_MAPPING_STACK(restlen, orig)                \
 628 do                                                      \
 629   {                                                     \
 630     mapping_stack_pointer--;                            \
 631     (restlen) = mapping_stack_pointer->rest_length;     \
 632     (orig) = mapping_stack_pointer->orig_val;           \
 633   }                                                     \
 634 while (0)
 635 
 636 #define CCL_CALL_FOR_MAP_INSTRUCTION(symbol, ret_ic)            \
 637 do                                                              \
 638   {                                                             \
 639     struct ccl_program called_ccl;                              \
 640     if (stack_idx >= 256                                        \
 641         || (setup_ccl_program (&called_ccl, (symbol)) != 0))    \
 642       {                                                         \
 643         if (stack_idx > 0)                                      \
 644           {                                                     \
 645             ccl_prog = ccl_prog_stack_struct[0].ccl_prog;       \
 646             ic = ccl_prog_stack_struct[0].ic;                   \
 647             eof_ic = ccl_prog_stack_struct[0].eof_ic;           \
 648           }                                                     \
 649         CCL_INVALID_CMD;                                        \
 650       }                                                         \
 651     ccl_prog_stack_struct[stack_idx].ccl_prog = ccl_prog;       \
 652     ccl_prog_stack_struct[stack_idx].ic = (ret_ic);             \
 653     ccl_prog_stack_struct[stack_idx].eof_ic = eof_ic;           \
 654     stack_idx++;                                                \
 655     ccl_prog = called_ccl.prog;                                 \
 656     ic = CCL_HEADER_MAIN;                                       \
 657     eof_ic = XFASTINT (ccl_prog[CCL_HEADER_EOF]);               \
 658     goto ccl_repeat;                                            \
 659   }                                                             \
 660 while (0)
 661 
 662 #define CCL_MapSingle           0x12 /* Map by single code conversion map
 663                                         1:ExtendedCOMMNDXXXRRRrrrXXXXX
 664                                         2:MAP-ID
 665                                         ------------------------------
 666                                         Map reg[rrr] by MAP-ID.
 667                                         If some valid mapping is found,
 668                                           set reg[rrr] to the result,
 669                                         else
 670                                           set reg[RRR] to -1.
 671                                      */
 672 
 673 #define CCL_LookupIntConstTbl 0x13 /* Lookup multibyte character by
 674                                       integer key.  Afterwards R7 set
 675                                       to 1 if lookup succeeded.
 676                                       1:ExtendedCOMMNDRrrRRRXXXXXXXX
 677                                       2:ARGUMENT(Hash table ID) */
 678 
 679 #define CCL_LookupCharConstTbl 0x14 /* Lookup integer by multibyte
 680                                        character key.  Afterwards R7 set
 681                                        to 1 if lookup succeeded.
 682                                        1:ExtendedCOMMNDRrrRRRrrrXXXXX
 683                                        2:ARGUMENT(Hash table ID) */
 684 
 685 /* CCL arithmetic/logical operators. */
 686 #define CCL_PLUS        0x00    /* X = Y + Z */
 687 #define CCL_MINUS       0x01    /* X = Y - Z */
 688 #define CCL_MUL         0x02    /* X = Y * Z */
 689 #define CCL_DIV         0x03    /* X = Y / Z */
 690 #define CCL_MOD         0x04    /* X = Y % Z */
 691 #define CCL_AND         0x05    /* X = Y & Z */
 692 #define CCL_OR          0x06    /* X = Y | Z */
 693 #define CCL_XOR         0x07    /* X = Y ^ Z */
 694 #define CCL_LSH         0x08    /* X = Y << Z */
 695 #define CCL_RSH         0x09    /* X = Y >> Z */
 696 #define CCL_LSH8        0x0A    /* X = (Y << 8) | Z */
 697 #define CCL_RSH8        0x0B    /* X = Y >> 8, r[7] = Y & 0xFF  */
 698 #define CCL_DIVMOD      0x0C    /* X = Y / Z, r[7] = Y % Z */
 699 #define CCL_LS          0x10    /* X = (X < Y) */
 700 #define CCL_GT          0x11    /* X = (X > Y) */
 701 #define CCL_EQ          0x12    /* X = (X == Y) */
 702 #define CCL_LE          0x13    /* X = (X <= Y) */
 703 #define CCL_GE          0x14    /* X = (X >= Y) */
 704 #define CCL_NE          0x15    /* X = (X != Y) */
 705 
 706 #define CCL_DECODE_SJIS 0x16    /* X = HIGHER_BYTE (DE-SJIS (Y, Z))
 707                                    r[7] = LOWER_BYTE (DE-SJIS (Y, Z)) */
 708 #define CCL_ENCODE_SJIS 0x17    /* X = HIGHER_BYTE (SJIS (Y, Z))
 709                                    r[7] = LOWER_BYTE (SJIS (Y, Z) */
 710 
 711 /* Terminate CCL program successfully.  */
 712 #define CCL_SUCCESS                     \
 713 do                                      \
 714   {                                     \
 715     ccl->status = CCL_STAT_SUCCESS;     \
 716     goto ccl_finish;                    \
 717   }                                     \
 718 while(0)
 719 
 720 /* Suspend CCL program because of reading from empty input buffer or
 721    writing to full output buffer.  When this program is resumed, the
 722    same I/O command is executed.  */
 723 #define CCL_SUSPEND(stat)       \
 724 do                              \
 725   {                             \
 726     ic--;                       \
 727     ccl->status = stat;         \
 728     goto ccl_finish;            \
 729   }                             \
 730 while (0)
 731 
 732 /* Terminate CCL program because of invalid command.  Should not occur
 733    in the normal case.  */
 734 #ifndef CCL_DEBUG
 735 
 736 #define CCL_INVALID_CMD                 \
 737 do                                      \
 738   {                                     \
 739     ccl->status = CCL_STAT_INVALID_CMD; \
 740     goto ccl_error_handler;             \
 741   }                                     \
 742 while(0)
 743 
 744 #else
 745 
 746 #define CCL_INVALID_CMD                 \
 747 do                                      \
 748   {                                     \
 749     ccl_debug_hook (this_ic);           \
 750     ccl->status = CCL_STAT_INVALID_CMD; \
 751     goto ccl_error_handler;             \
 752   }                                     \
 753 while(0)
 754 
 755 #endif
 756 
 757 /* Encode one character CH to multibyte form and write to the current
 758    output buffer.  If CH is less than 256, CH is written as is.  */
 759 #define CCL_WRITE_CHAR(ch)                      \
 760   do {                                          \
 761     if (! dst)                                  \
 762       CCL_INVALID_CMD;                          \
 763     else if (dst < dst_end)                     \
 764       *dst++ = (ch);                            \
 765     else                                        \
 766       CCL_SUSPEND (CCL_STAT_SUSPEND_BY_DST);    \
 767   } while (0)
 768 
 769 /* Write a string at ccl_prog[IC] of length LEN to the current output
 770    buffer.  */
 771 #define CCL_WRITE_STRING(len)                                   \
 772   do {                                                          \
 773     int i;                                                      \
 774     if (!dst)                                                   \
 775       CCL_INVALID_CMD;                                          \
 776     else if (dst + len <= dst_end)                              \
 777       {                                                         \
 778         if (XFASTINT (ccl_prog[ic]) & 0x1000000)                \
 779           for (i = 0; i < len; i++)                             \
 780             *dst++ = XFASTINT (ccl_prog[ic + i]) & 0xFFFFFF;    \
 781         else                                                    \
 782           for (i = 0; i < len; i++)                             \
 783             *dst++ = ((XFASTINT (ccl_prog[ic + (i / 3)]))       \
 784                       >> ((2 - (i % 3)) * 8)) & 0xFF;           \
 785       }                                                         \
 786     else                                                        \
 787       CCL_SUSPEND (CCL_STAT_SUSPEND_BY_DST);                    \
 788   } while (0)
 789 
 790 /* Read one byte from the current input buffer into Rth register.  */
 791 #define CCL_READ_CHAR(r)                        \
 792   do {                                          \
 793     if (! src)                                  \
 794       CCL_INVALID_CMD;                          \
 795     else if (src < src_end)                     \
 796       r = *src++;                               \
 797     else if (ccl->last_block)                   \
 798       {                                         \
 799         r = -1;                                 \
 800         ic = ccl->eof_ic;                       \
 801         goto ccl_repeat;                        \
 802       }                                         \
 803     else                                        \
 804       CCL_SUSPEND (CCL_STAT_SUSPEND_BY_SRC);    \
 805     } while (0)
 806 
 807 /* Decode CODE by a charset whose id is ID.  If ID is 0, return CODE
 808    as is for backward compatibility.  Assume that we can use the
 809    variable `charset'.  */
 810 
 811 #define CCL_DECODE_CHAR(id, code)       \
 812   ((id) == 0 ? (code)                   \
 813    : (charset = CHARSET_FROM_ID ((id)), DECODE_CHAR (charset, (code))))
 814 
 815 /* Encode character C by some of charsets in CHARSET_LIST.  Set ID to
 816    the id of the used charset, ENCODED to the resulf of encoding.
 817    Assume that we can use the variable `charset'.  */
 818 
 819 #define CCL_ENCODE_CHAR(c, charset_list, id, encoded)           \
 820   do {                                                          \
 821     unsigned code;                                              \
 822                                                                 \
 823     charset = char_charset ((c), (charset_list), &code);        \
 824     if (! charset && ! NILP (charset_list))                     \
 825       charset = char_charset ((c), Qnil, &code);                \
 826     if (charset)                                                \
 827       {                                                         \
 828         (id) = CHARSET_ID (charset);                            \
 829         (encoded) = code;                                       \
 830       }                                                         \
 831    } while (0)
 832 
 833 /* Execute CCL code on characters at SOURCE (length SRC_SIZE).  The
 834    resulting text goes to a place pointed by DESTINATION, the length
 835    of which should not exceed DST_SIZE.  As a side effect, how many
 836    characters are consumed and produced are recorded in CCL->consumed
 837    and CCL->produced, and the contents of CCL registers are updated.
 838    If SOURCE or DESTINATION is NULL, only operations on registers are
 839    permitted.  */
 840 
 841 #ifdef CCL_DEBUG
 842 #define CCL_DEBUG_BACKTRACE_LEN 256
 843 int ccl_backtrace_table[CCL_DEBUG_BACKTRACE_LEN];
 844 int ccl_backtrace_idx;
 845 
 846 int
 847 ccl_debug_hook (int ic)
 848 {
 849   return ic;
 850 }
 851 
 852 #endif
 853 
 854 struct ccl_prog_stack
 855   {
 856     Lisp_Object *ccl_prog;      /* Pointer to an array of CCL code.  */
 857     int ic;                     /* Instruction Counter.  */
 858     int eof_ic;                 /* Instruction Counter to jump on EOF.  */
 859   };
 860 
 861 /* For the moment, we only support depth 256 of stack.  */
 862 static struct ccl_prog_stack ccl_prog_stack_struct[256];
 863 
 864 void
 865 ccl_driver (ccl, source, destination, src_size, dst_size, charset_list)
 866      struct ccl_program *ccl;
 867      int *source, *destination;
 868      int src_size, dst_size;
 869      Lisp_Object charset_list;
 870 {
 871   register int *reg = ccl->reg;
 872   register int ic = ccl->ic;
 873   register int code = 0, field1, field2;
 874   register Lisp_Object *ccl_prog = ccl->prog;
 875   int *src = source, *src_end = src + src_size;
 876   int *dst = destination, *dst_end = dst + dst_size;
 877   int jump_address;
 878   int i = 0, j, op;
 879   int stack_idx = ccl->stack_idx;
 880   /* Instruction counter of the current CCL code. */
 881   int this_ic = 0;
 882   struct charset *charset;
 883   int eof_ic = ccl->eof_ic;
 884   int eof_hit = 0;
 885 
 886   if (ccl->buf_magnification == 0) /* We can't read/produce any bytes.  */
 887     dst = NULL;
 888 
 889   /* Set mapping stack pointer. */
 890   mapping_stack_pointer = mapping_stack;
 891 
 892 #ifdef CCL_DEBUG
 893   ccl_backtrace_idx = 0;
 894 #endif
 895 
 896   for (;;)
 897     {
 898     ccl_repeat:
 899 #ifdef CCL_DEBUG
 900       ccl_backtrace_table[ccl_backtrace_idx++] = ic;
 901       if (ccl_backtrace_idx >= CCL_DEBUG_BACKTRACE_LEN)
 902         ccl_backtrace_idx = 0;
 903       ccl_backtrace_table[ccl_backtrace_idx] = 0;
 904 #endif
 905 
 906       if (!NILP (Vquit_flag) && NILP (Vinhibit_quit))
 907         {
 908           /* We can't just signal Qquit, instead break the loop as if
 909              the whole data is processed.  Don't reset Vquit_flag, it
 910              must be handled later at a safer place.  */
 911           if (src)
 912             src = source + src_size;
 913           ccl->status = CCL_STAT_QUIT;
 914           break;
 915         }
 916 
 917       this_ic = ic;
 918       code = XINT (ccl_prog[ic]); ic++;
 919       field1 = code >> 8;
 920       field2 = (code & 0xFF) >> 5;
 921 
 922 #define rrr field2
 923 #define RRR (field1 & 7)
 924 #define Rrr ((field1 >> 3) & 7)
 925 #define ADDR field1
 926 #define EXCMD (field1 >> 6)
 927 
 928       switch (code & 0x1F)
 929         {
 930         case CCL_SetRegister:   /* 00000000000000000RRRrrrXXXXX */
 931           reg[rrr] = reg[RRR];
 932           break;
 933 
 934         case CCL_SetShortConst: /* CCCCCCCCCCCCCCCCCCCCrrrXXXXX */
 935           reg[rrr] = field1;
 936           break;
 937 
 938         case CCL_SetConst:      /* 00000000000000000000rrrXXXXX */
 939           reg[rrr] = XINT (ccl_prog[ic]);
 940           ic++;
 941           break;
 942 
 943         case CCL_SetArray:      /* CCCCCCCCCCCCCCCCCCCCRRRrrrXXXXX */
 944           i = reg[RRR];
 945           j = field1 >> 3;
 946           if ((unsigned int) i < j)
 947             reg[rrr] = XINT (ccl_prog[ic + i]);
 948           ic += j;
 949           break;
 950 
 951         case CCL_Jump:          /* A--D--D--R--E--S--S-000XXXXX */
 952           ic += ADDR;
 953           break;
 954 
 955         case CCL_JumpCond:      /* A--D--D--R--E--S--S-rrrXXXXX */
 956           if (!reg[rrr])
 957             ic += ADDR;
 958           break;
 959 
 960         case CCL_WriteRegisterJump: /* A--D--D--R--E--S--S-rrrXXXXX */
 961           i = reg[rrr];
 962           CCL_WRITE_CHAR (i);
 963           ic += ADDR;
 964           break;
 965 
 966         case CCL_WriteRegisterReadJump: /* A--D--D--R--E--S--S-rrrXXXXX */
 967           i = reg[rrr];
 968           CCL_WRITE_CHAR (i);
 969           ic++;
 970           CCL_READ_CHAR (reg[rrr]);
 971           ic += ADDR - 1;
 972           break;
 973 
 974         case CCL_WriteConstJump: /* A--D--D--R--E--S--S-000XXXXX */
 975           i = XINT (ccl_prog[ic]);
 976           CCL_WRITE_CHAR (i);
 977           ic += ADDR;
 978           break;
 979 
 980         case CCL_WriteConstReadJump: /* A--D--D--R--E--S--S-rrrXXXXX */
 981           i = XINT (ccl_prog[ic]);
 982           CCL_WRITE_CHAR (i);
 983           ic++;
 984           CCL_READ_CHAR (reg[rrr]);
 985           ic += ADDR - 1;
 986           break;
 987 
 988         case CCL_WriteStringJump: /* A--D--D--R--E--S--S-000XXXXX */
 989           j = XINT (ccl_prog[ic]);
 990           ic++;
 991           CCL_WRITE_STRING (j);
 992           ic += ADDR - 1;
 993           break;
 994 
 995         case CCL_WriteArrayReadJump: /* A--D--D--R--E--S--S-rrrXXXXX */
 996           i = reg[rrr];
 997           j = XINT (ccl_prog[ic]);
 998           if ((unsigned int) i < j)
 999             {
1000               i = XINT (ccl_prog[ic + 1 + i]);
1001               CCL_WRITE_CHAR (i);
1002             }
1003           ic += j + 2;
1004           CCL_READ_CHAR (reg[rrr]);
1005           ic += ADDR - (j + 2);
1006           break;
1007 
1008         case CCL_ReadJump:      /* A--D--D--R--E--S--S-rrrYYYYY */
1009           CCL_READ_CHAR (reg[rrr]);
1010           ic += ADDR;
1011           break;
1012 
1013         case CCL_ReadBranch:    /* CCCCCCCCCCCCCCCCCCCCrrrXXXXX */
1014           CCL_READ_CHAR (reg[rrr]);
1015           /* fall through ... */
1016         case CCL_Branch:        /* CCCCCCCCCCCCCCCCCCCCrrrXXXXX */
1017           if ((unsigned int) reg[rrr] < field1)
1018             ic += XINT (ccl_prog[ic + reg[rrr]]);
1019           else
1020             ic += XINT (ccl_prog[ic + field1]);
1021           break;
1022 
1023         case CCL_ReadRegister:  /* CCCCCCCCCCCCCCCCCCCCrrXXXXX */
1024           while (1)
1025             {
1026               CCL_READ_CHAR (reg[rrr]);
1027               if (!field1) break;
1028               code = XINT (ccl_prog[ic]); ic++;
1029               field1 = code >> 8;
1030               field2 = (code & 0xFF) >> 5;
1031             }
1032           break;
1033 
1034         case CCL_WriteExprConst:  /* 1:00000OPERATION000RRR000XXXXX */
1035           rrr = 7;
1036           i = reg[RRR];
1037           j = XINT (ccl_prog[ic]);
1038           op = field1 >> 6;
1039           jump_address = ic + 1;
1040           goto ccl_set_expr;
1041 
1042         case CCL_WriteRegister: /* CCCCCCCCCCCCCCCCCCCrrrXXXXX */
1043           while (1)
1044             {
1045               i = reg[rrr];
1046               CCL_WRITE_CHAR (i);
1047               if (!field1) break;
1048               code = XINT (ccl_prog[ic]); ic++;
1049               field1 = code >> 8;
1050               field2 = (code & 0xFF) >> 5;
1051             }
1052           break;
1053 
1054         case CCL_WriteExprRegister: /* 1:00000OPERATIONRrrRRR000XXXXX */
1055           rrr = 7;
1056           i = reg[RRR];
1057           j = reg[Rrr];
1058           op = field1 >> 6;
1059           jump_address = ic;
1060           goto ccl_set_expr;
1061 
1062         case CCL_Call:          /* 1:CCCCCCCCCCCCCCCCCCCCFFFXXXXX */
1063           {
1064             Lisp_Object slot;
1065             int prog_id;
1066 
1067             /* If FFF is nonzero, the CCL program ID is in the
1068                following code.  */
1069             if (rrr)
1070               {
1071                 prog_id = XINT (ccl_prog[ic]);
1072                 ic++;
1073               }
1074             else
1075               prog_id = field1;
1076 
1077             if (stack_idx >= 256
1078                 || prog_id < 0
1079                 || prog_id >= ASIZE (Vccl_program_table)
1080                 || (slot = AREF (Vccl_program_table, prog_id), !VECTORP (slot))
1081                 || !VECTORP (AREF (slot, 1)))
1082               {
1083                 if (stack_idx > 0)
1084                   {
1085                     ccl_prog = ccl_prog_stack_struct[0].ccl_prog;
1086                     ic = ccl_prog_stack_struct[0].ic;
1087                     eof_ic = ccl_prog_stack_struct[0].eof_ic;
1088                   }
1089                 CCL_INVALID_CMD;
1090               }
1091 
1092             ccl_prog_stack_struct[stack_idx].ccl_prog = ccl_prog;
1093             ccl_prog_stack_struct[stack_idx].ic = ic;
1094             ccl_prog_stack_struct[stack_idx].eof_ic = eof_ic;
1095             stack_idx++;
1096             ccl_prog = XVECTOR (AREF (slot, 1))->contents;
1097             ic = CCL_HEADER_MAIN;
1098             eof_ic = XFASTINT (ccl_prog[CCL_HEADER_EOF]);
1099           }
1100           break;
1101 
1102         case CCL_WriteConstString: /* CCCCCCCCCCCCCCCCCCCCrrrXXXXX */
1103           if (!rrr)
1104             CCL_WRITE_CHAR (field1);
1105           else
1106             {
1107               CCL_WRITE_STRING (field1);
1108               ic += (field1 + 2) / 3;
1109             }
1110           break;
1111 
1112         case CCL_WriteArray:    /* CCCCCCCCCCCCCCCCCCCCrrrXXXXX */
1113           i = reg[rrr];
1114           if ((unsigned int) i < field1)
1115             {
1116               j = XINT (ccl_prog[ic + i]);
1117               CCL_WRITE_CHAR (j);
1118             }
1119           ic += field1;
1120           break;
1121 
1122         case CCL_End:           /* 0000000000000000000000XXXXX */
1123           if (stack_idx > 0)
1124             {
1125               stack_idx--;
1126               ccl_prog = ccl_prog_stack_struct[stack_idx].ccl_prog;
1127               ic = ccl_prog_stack_struct[stack_idx].ic;
1128               eof_ic = ccl_prog_stack_struct[stack_idx].eof_ic;
1129               if (eof_hit)
1130                 ic = eof_ic;
1131               break;
1132             }
1133           if (src)
1134             src = src_end;
1135           /* ccl->ic should points to this command code again to
1136              suppress further processing.  */
1137           ic--;
1138           CCL_SUCCESS;
1139 
1140         case CCL_ExprSelfConst: /* 00000OPERATION000000rrrXXXXX */
1141           i = XINT (ccl_prog[ic]);
1142           ic++;
1143           op = field1 >> 6;
1144           goto ccl_expr_self;
1145 
1146         case CCL_ExprSelfReg:   /* 00000OPERATION000RRRrrrXXXXX */
1147           i = reg[RRR];
1148           op = field1 >> 6;
1149 
1150         ccl_expr_self:
1151           switch (op)
1152             {
1153             case CCL_PLUS: reg[rrr] += i; break;
1154             case CCL_MINUS: reg[rrr] -= i; break;
1155             case CCL_MUL: reg[rrr] *= i; break;
1156             case CCL_DIV: reg[rrr] /= i; break;
1157             case CCL_MOD: reg[rrr] %= i; break;
1158             case CCL_AND: reg[rrr] &= i; break;
1159             case CCL_OR: reg[rrr] |= i; break;
1160             case CCL_XOR: reg[rrr] ^= i; break;
1161             case CCL_LSH: reg[rrr] <<= i; break;
1162             case CCL_RSH: reg[rrr] >>= i; break;
1163             case CCL_LSH8: reg[rrr] <<= 8; reg[rrr] |= i; break;
1164             case CCL_RSH8: reg[7] = reg[rrr] & 0xFF; reg[rrr] >>= 8; break;
1165             case CCL_DIVMOD: reg[7] = reg[rrr] % i; reg[rrr] /= i; break;
1166             case CCL_LS: reg[rrr] = reg[rrr] < i; break;
1167             case CCL_GT: reg[rrr] = reg[rrr] > i; break;
1168             case CCL_EQ: reg[rrr] = reg[rrr] == i; break;
1169             case CCL_LE: reg[rrr] = reg[rrr] <= i; break;
1170             case CCL_GE: reg[rrr] = reg[rrr] >= i; break;
1171             case CCL_NE: reg[rrr] = reg[rrr] != i; break;
1172             default: CCL_INVALID_CMD;
1173             }
1174           break;
1175 
1176         case CCL_SetExprConst:  /* 00000OPERATION000RRRrrrXXXXX */
1177           i = reg[RRR];
1178           j = XINT (ccl_prog[ic]);
1179           op = field1 >> 6;
1180           jump_address = ++ic;
1181           goto ccl_set_expr;
1182 
1183         case CCL_SetExprReg:    /* 00000OPERATIONRrrRRRrrrXXXXX */
1184           i = reg[RRR];
1185           j = reg[Rrr];
1186           op = field1 >> 6;
1187           jump_address = ic;
1188           goto ccl_set_expr;
1189 
1190         case CCL_ReadJumpCondExprConst: /* A--D--D--R--E--S--S-rrrXXXXX */
1191           CCL_READ_CHAR (reg[rrr]);
1192         case CCL_JumpCondExprConst: /* A--D--D--R--E--S--S-rrrXXXXX */
1193           i = reg[rrr];
1194           op = XINT (ccl_prog[ic]);
1195           jump_address = ic++ + ADDR;
1196           j = XINT (ccl_prog[ic]);
1197           ic++;
1198           rrr = 7;
1199           goto ccl_set_expr;
1200 
1201         case CCL_ReadJumpCondExprReg: /* A--D--D--R--E--S--S-rrrXXXXX */
1202           CCL_READ_CHAR (reg[rrr]);
1203         case CCL_JumpCondExprReg:
1204           i = reg[rrr];
1205           op = XINT (ccl_prog[ic]);
1206           jump_address = ic++ + ADDR;
1207           j = reg[XINT (ccl_prog[ic])];
1208           ic++;
1209           rrr = 7;
1210 
1211         ccl_set_expr:
1212           switch (op)
1213             {
1214             case CCL_PLUS: reg[rrr] = i + j; break;
1215             case CCL_MINUS: reg[rrr] = i - j; break;
1216             case CCL_MUL: reg[rrr] = i * j; break;
1217             case CCL_DIV: reg[rrr] = i / j; break;
1218             case CCL_MOD: reg[rrr] = i % j; break;
1219             case CCL_AND: reg[rrr] = i & j; break;
1220             case CCL_OR: reg[rrr] = i | j; break;
1221             case CCL_XOR: reg[rrr] = i ^ j; break;
1222             case CCL_LSH: reg[rrr] = i << j; break;
1223             case CCL_RSH: reg[rrr] = i >> j; break;
1224             case CCL_LSH8: reg[rrr] = (i << 8) | j; break;
1225             case CCL_RSH8: reg[rrr] = i >> 8; reg[7] = i & 0xFF; break;
1226             case CCL_DIVMOD: reg[rrr] = i / j; reg[7] = i % j; break;
1227             case CCL_LS: reg[rrr] = i < j; break;
1228             case CCL_GT: reg[rrr] = i > j; break;
1229             case CCL_EQ: reg[rrr] = i == j; break;
1230             case CCL_LE: reg[rrr] = i <= j; break;
1231             case CCL_GE: reg[rrr] = i >= j; break;
1232             case CCL_NE: reg[rrr] = i != j; break;
1233             case CCL_DECODE_SJIS:
1234               {
1235                 i = (i << 8) | j;
1236                 SJIS_TO_JIS (i);
1237                 reg[rrr] = i >> 8;
1238                 reg[7] = i & 0xFF;
1239                 break;
1240               }
1241             case CCL_ENCODE_SJIS:
1242               {
1243                 i = (i << 8) | j;
1244                 JIS_TO_SJIS (i);
1245                 reg[rrr] = i >> 8;
1246                 reg[7] = i & 0xFF;
1247                 break;
1248               }
1249             default: CCL_INVALID_CMD;
1250             }
1251           code &= 0x1F;
1252           if (code == CCL_WriteExprConst || code == CCL_WriteExprRegister)
1253             {
1254               i = reg[rrr];
1255               CCL_WRITE_CHAR (i);
1256               ic = jump_address;
1257             }
1258           else if (!reg[rrr])
1259             ic = jump_address;
1260           break;
1261 
1262         case CCL_Extension:
1263           switch (EXCMD)
1264             {
1265             case CCL_ReadMultibyteChar2:
1266               if (!src)
1267                 CCL_INVALID_CMD;
1268               CCL_READ_CHAR (i);
1269               CCL_ENCODE_CHAR (i, charset_list, reg[RRR], reg[rrr]);
1270               break;
1271 
1272             case CCL_WriteMultibyteChar2:
1273               if (! dst)
1274                 CCL_INVALID_CMD;
1275               i = CCL_DECODE_CHAR (reg[RRR], reg[rrr]);
1276               CCL_WRITE_CHAR (i);
1277               break;
1278 
1279             case CCL_TranslateCharacter:
1280               i = CCL_DECODE_CHAR (reg[RRR], reg[rrr]);
1281               op = translate_char (GET_TRANSLATION_TABLE (reg[Rrr]), i);
1282               CCL_ENCODE_CHAR (op, charset_list, reg[RRR], reg[rrr]);
1283               break;
1284 
1285             case CCL_TranslateCharacterConstTbl:
1286               op = XINT (ccl_prog[ic]); /* table */
1287               ic++;
1288               i = CCL_DECODE_CHAR (reg[RRR], reg[rrr]);
1289               op = translate_char (GET_TRANSLATION_TABLE (op), i);
1290               CCL_ENCODE_CHAR (op, charset_list, reg[RRR], reg[rrr]);
1291               break;
1292 
1293             case CCL_LookupIntConstTbl:
1294               op = XINT (ccl_prog[ic]); /* table */
1295               ic++;
1296               {
1297                 struct Lisp_Hash_Table *h = GET_HASH_TABLE (op);
1298 
1299                 op = hash_lookup (h, make_number (reg[RRR]), NULL);
1300                 if (op >= 0)
1301                   {
1302                     Lisp_Object opl;
1303                     opl = HASH_VALUE (h, op);
1304                     if (! CHARACTERP (opl))
1305                       CCL_INVALID_CMD;
1306                     reg[RRR] = charset_unicode;
1307                     reg[rrr] = op;
1308                     reg[7] = 1; /* r7 true for success */
1309                   }
1310                 else
1311                   reg[7] = 0;
1312               }
1313               break;
1314 
1315             case CCL_LookupCharConstTbl:
1316               op = XINT (ccl_prog[ic]); /* table */
1317               ic++;
1318               i = CCL_DECODE_CHAR (reg[RRR], reg[rrr]);
1319               {
1320                 struct Lisp_Hash_Table *h = GET_HASH_TABLE (op);
1321 
1322                 op = hash_lookup (h, make_number (i), NULL);
1323                 if (op >= 0)
1324                   {
1325                     Lisp_Object opl;
1326                     opl = HASH_VALUE (h, op);
1327                     if (!INTEGERP (opl))
1328                       CCL_INVALID_CMD;
1329                     reg[RRR] = XINT (opl);
1330                     reg[7] = 1; /* r7 true for success */
1331                   }
1332                 else
1333                   reg[7] = 0;
1334               }
1335               break;
1336 
1337             case CCL_IterateMultipleMap:
1338               {
1339                 Lisp_Object map, content, attrib, value;
1340                 int point, size, fin_ic;
1341 
1342                 j = XINT (ccl_prog[ic++]); /* number of maps. */
1343                 fin_ic = ic + j;
1344                 op = reg[rrr];
1345                 if ((j > reg[RRR]) && (j >= 0))
1346                   {
1347                     ic += reg[RRR];
1348                     i = reg[RRR];
1349                   }
1350                 else
1351                   {
1352                     reg[RRR] = -1;
1353                     ic = fin_ic;
1354                     break;
1355                   }
1356 
1357                 for (;i < j;i++)
1358                   {
1359 
1360                     size = ASIZE (Vcode_conversion_map_vector);
1361                     point = XINT (ccl_prog[ic++]);
1362                     if (point >= size) continue;
1363                     map = AREF (Vcode_conversion_map_vector, point);
1364 
1365                     /* Check map varidity.  */
1366                     if (!CONSP (map)) continue;
1367                     map = XCDR (map);
1368                     if (!VECTORP (map)) continue;
1369                     size = ASIZE (map);
1370                     if (size <= 1) continue;
1371 
1372                     content = AREF (map, 0);
1373 
1374                     /* check map type,
1375                        [STARTPOINT VAL1 VAL2 ...] or
1376                        [t ELELMENT STARTPOINT ENDPOINT]  */
1377                     if (NUMBERP (content))
1378                       {
1379                         point = XUINT (content);
1380                         point = op - point + 1;
1381                         if (!((point >= 1) && (point < size))) continue;
1382                         content = AREF (map, point);
1383                       }
1384                     else if (EQ (content, Qt))
1385                       {
1386                         if (size != 4) continue;
1387                         if ((op >= XUINT (AREF (map, 2)))
1388                             && (op < XUINT (AREF (map, 3))))
1389                           content = AREF (map, 1);
1390                         else
1391                           continue;
1392                       }
1393                     else
1394                       continue;
1395 
1396                     if (NILP (content))
1397                       continue;
1398                     else if (NUMBERP (content))
1399                       {
1400                         reg[RRR] = i;
1401                         reg[rrr] = XINT(content);
1402                         break;
1403                       }
1404                     else if (EQ (content, Qt) || EQ (content, Qlambda))
1405                       {
1406                         reg[RRR] = i;
1407                         break;
1408                       }
1409                     else if (CONSP (content))
1410                       {
1411                         attrib = XCAR (content);
1412                         value = XCDR (content);
1413                         if (!NUMBERP (attrib) || !NUMBERP (value))
1414                           continue;
1415                         reg[RRR] = i;
1416                         reg[rrr] = XUINT (value);
1417                         break;
1418                       }
1419                     else if (SYMBOLP (content))
1420                       CCL_CALL_FOR_MAP_INSTRUCTION (content, fin_ic);
1421                     else
1422                       CCL_INVALID_CMD;
1423                   }
1424                 if (i == j)
1425                   reg[RRR] = -1;
1426                 ic = fin_ic;
1427               }
1428               break;
1429 
1430             case CCL_MapMultiple:
1431               {
1432                 Lisp_Object map, content, attrib, value;
1433                 int point, size, map_vector_size;
1434                 int map_set_rest_length, fin_ic;
1435                 int current_ic = this_ic;
1436 
1437                 /* inhibit recursive call on MapMultiple. */
1438                 if (stack_idx_of_map_multiple > 0)
1439                   {
1440                     if (stack_idx_of_map_multiple <= stack_idx)
1441                       {
1442                         stack_idx_of_map_multiple = 0;
1443                         mapping_stack_pointer = mapping_stack;
1444                         CCL_INVALID_CMD;
1445                       }
1446                   }
1447                 else
1448                   mapping_stack_pointer = mapping_stack;
1449                 stack_idx_of_map_multiple = 0;
1450 
1451                 map_set_rest_length =
1452                   XINT (ccl_prog[ic++]); /* number of maps and separators. */
1453                 fin_ic = ic + map_set_rest_length;
1454                 op = reg[rrr];
1455 
1456                 if ((map_set_rest_length > reg[RRR]) && (reg[RRR] >= 0))
1457                   {
1458                     ic += reg[RRR];
1459                     i = reg[RRR];
1460                     map_set_rest_length -= i;
1461                   }
1462                 else
1463                   {
1464                     ic = fin_ic;
1465                     reg[RRR] = -1;
1466                     mapping_stack_pointer = mapping_stack;
1467                     break;
1468                   }
1469 
1470                 if (mapping_stack_pointer <= (mapping_stack + 1))
1471                   {
1472                     /* Set up initial state. */
1473                     mapping_stack_pointer = mapping_stack;
1474                     PUSH_MAPPING_STACK (0, op);
1475                     reg[RRR] = -1;
1476                   }
1477                 else
1478                   {
1479                     /* Recover after calling other ccl program. */
1480                     int orig_op;
1481 
1482                     POP_MAPPING_STACK (map_set_rest_length, orig_op);
1483                     POP_MAPPING_STACK (map_set_rest_length, reg[rrr]);
1484                     switch (op)
1485                       {
1486                       case -1:
1487                         /* Regard it as Qnil. */
1488                         op = orig_op;
1489                         i++;
1490                         ic++;
1491                         map_set_rest_length--;
1492                         break;
1493                       case -2:
1494                         /* Regard it as Qt. */
1495                         op = reg[rrr];
1496                         i++;
1497                         ic++;
1498                         map_set_rest_length--;
1499                         break;
1500                       case -3:
1501                         /* Regard it as Qlambda. */
1502                         op = orig_op;
1503                         i += map_set_rest_length;
1504                         ic += map_set_rest_length;
1505                         map_set_rest_length = 0;
1506                         break;
1507                       default:
1508                         /* Regard it as normal mapping. */
1509                         i += map_set_rest_length;
1510                         ic += map_set_rest_length;
1511                         POP_MAPPING_STACK (map_set_rest_length, reg[rrr]);
1512                         break;
1513                       }
1514                   }
1515                 map_vector_size = ASIZE (Vcode_conversion_map_vector);
1516 
1517                 do {
1518                   for (;map_set_rest_length > 0;i++, ic++, map_set_rest_length--)
1519                     {
1520                       point = XINT(ccl_prog[ic]);
1521                       if (point < 0)
1522                         {
1523                           /* +1 is for including separator. */
1524                           point = -point + 1;
1525                           if (mapping_stack_pointer
1526                               >= &mapping_stack[MAX_MAP_SET_LEVEL])
1527                             CCL_INVALID_CMD;
1528                           PUSH_MAPPING_STACK (map_set_rest_length - point,
1529                                               reg[rrr]);
1530                           map_set_rest_length = point;
1531                           reg[rrr] = op;
1532                           continue;
1533                         }
1534 
1535                       if (point >= map_vector_size) continue;
1536                       map = AREF (Vcode_conversion_map_vector, point);
1537 
1538                       /* Check map varidity.  */
1539                       if (!CONSP (map)) continue;
1540                       map = XCDR (map);
1541                       if (!VECTORP (map)) continue;
1542                       size = ASIZE (map);
1543                       if (size <= 1) continue;
1544 
1545                       content = AREF (map, 0);
1546 
1547                       /* check map type,
1548                          [STARTPOINT VAL1 VAL2 ...] or
1549                          [t ELEMENT STARTPOINT ENDPOINT]  */
1550                       if (NUMBERP (content))
1551                         {
1552                           point = XUINT (content);
1553                           point = op - point + 1;
1554                           if (!((point >= 1) && (point < size))) continue;
1555                           content = AREF (map, point);
1556                         }
1557                       else if (EQ (content, Qt))
1558                         {
1559                           if (size != 4) continue;
1560                           if ((op >= XUINT (AREF (map, 2))) &&
1561                               (op < XUINT (AREF (map, 3))))
1562                             content = AREF (map, 1);
1563                           else
1564                             continue;
1565                         }
1566                       else
1567                         continue;
1568 
1569                       if (NILP (content))
1570                         continue;
1571 
1572                       reg[RRR] = i;
1573                       if (NUMBERP (content))
1574                         {
1575                           op = XINT (content);
1576                           i += map_set_rest_length - 1;
1577                           ic += map_set_rest_length - 1;
1578                           POP_MAPPING_STACK (map_set_rest_length, reg[rrr]);
1579                           map_set_rest_length++;
1580                         }
1581                       else if (CONSP (content))
1582                         {
1583                           attrib = XCAR (content);
1584                           value = XCDR (content);
1585                           if (!NUMBERP (attrib) || !NUMBERP (value))
1586                             continue;
1587                           op = XUINT (value);
1588                           i += map_set_rest_length - 1;
1589                           ic += map_set_rest_length - 1;
1590                           POP_MAPPING_STACK (map_set_rest_length, reg[rrr]);
1591                           map_set_rest_length++;
1592                         }
1593                       else if (EQ (content, Qt))
1594                         {
1595                           op = reg[rrr];
1596                         }
1597                       else if (EQ (content, Qlambda))
1598                         {
1599                           i += map_set_rest_length;
1600                           ic += map_set_rest_length;
1601                           break;
1602                         }
1603                       else if (SYMBOLP (content))
1604                         {
1605                           if (mapping_stack_pointer
1606                               >= &mapping_stack[MAX_MAP_SET_LEVEL])
1607                             CCL_INVALID_CMD;
1608                           PUSH_MAPPING_STACK (map_set_rest_length, reg[rrr]);
1609                           PUSH_MAPPING_STACK (map_set_rest_length, op);
1610                           stack_idx_of_map_multiple = stack_idx + 1;
1611                           CCL_CALL_FOR_MAP_INSTRUCTION (content, current_ic);
1612                         }
1613                       else
1614                         CCL_INVALID_CMD;
1615                     }
1616                   if (mapping_stack_pointer <= (mapping_stack + 1))
1617                     break;
1618                   POP_MAPPING_STACK (map_set_rest_length, reg[rrr]);
1619                   i += map_set_rest_length;
1620                   ic += map_set_rest_length;
1621                   POP_MAPPING_STACK (map_set_rest_length, reg[rrr]);
1622                 } while (1);
1623 
1624                 ic = fin_ic;
1625               }
1626               reg[rrr] = op;
1627               break;
1628 
1629             case CCL_MapSingle:
1630               {
1631                 Lisp_Object map, attrib, value, content;
1632                 int size, point;
1633                 j = XINT (ccl_prog[ic++]); /* map_id */
1634                 op = reg[rrr];
1635                 if (j >= ASIZE (Vcode_conversion_map_vector))
1636                   {
1637                     reg[RRR] = -1;
1638                     break;
1639                   }
1640                 map = AREF (Vcode_conversion_map_vector, j);
1641                 if (!CONSP (map))
1642                   {
1643                     reg[RRR] = -1;
1644                     break;
1645                   }
1646                 map = XCDR (map);
1647                 if (!VECTORP (map))
1648                   {
1649                     reg[RRR] = -1;
1650                     break;
1651                   }
1652                 size = ASIZE (map);
1653                 point = XUINT (AREF (map, 0));
1654                 point = op - point + 1;
1655                 reg[RRR] = 0;
1656                 if ((size <= 1) ||
1657                     (!((point >= 1) && (point < size))))
1658                   reg[RRR] = -1;
1659                 else
1660                   {
1661                     reg[RRR] = 0;
1662                     content = AREF (map, point);
1663                     if (NILP (content))
1664                       reg[RRR] = -1;
1665                     else if (NUMBERP (content))
1666                       reg[rrr] = XINT (content);
1667                     else if (EQ (content, Qt));
1668                     else if (CONSP (content))
1669                       {
1670                         attrib = XCAR (content);
1671                         value = XCDR (content);
1672                         if (!NUMBERP (attrib) || !NUMBERP (value))
1673                           continue;
1674                         reg[rrr] = XUINT(value);
1675                         break;
1676                       }
1677                     else if (SYMBOLP (content))
1678                       CCL_CALL_FOR_MAP_INSTRUCTION (content, ic);
1679                     else
1680                       reg[RRR] = -1;
1681                   }
1682               }
1683               break;
1684 
1685             default:
1686               CCL_INVALID_CMD;
1687             }
1688           break;
1689 
1690         default:
1691           CCL_INVALID_CMD;
1692         }
1693     }
1694 
1695  ccl_error_handler:
1696   /* The suppress_error member is set when e.g. a CCL-based coding
1697      system is used for terminal output.  */
1698   if (!ccl->suppress_error && destination)
1699     {
1700       /* We can insert an error message only if DESTINATION is
1701          specified and we still have a room to store the message
1702          there.  */
1703       char msg[256];
1704       int msglen;
1705 
1706       if (!dst)
1707         dst = destination;
1708 
1709       switch (ccl->status)
1710         {
1711         case CCL_STAT_INVALID_CMD:
1712           sprintf(msg, "\nCCL: Invalid command %x (ccl_code = %x) at %d.",
1713                   code & 0x1F, code, this_ic);
1714 #ifdef CCL_DEBUG
1715           {
1716             int i = ccl_backtrace_idx - 1;
1717             int j;
1718 
1719             msglen = strlen (msg);
1720             if (dst + msglen <= (dst_bytes ? dst_end : src))
1721               {
1722                 bcopy (msg, dst, msglen);
1723                 dst += msglen;
1724               }
1725 
1726             for (j = 0; j < CCL_DEBUG_BACKTRACE_LEN; j++, i--)
1727               {
1728                 if (i < 0) i = CCL_DEBUG_BACKTRACE_LEN - 1;
1729                 if (ccl_backtrace_table[i] == 0)
1730                   break;
1731                 sprintf(msg, " %d", ccl_backtrace_table[i]);
1732                 msglen = strlen (msg);
1733                 if (dst + msglen > (dst_bytes ? dst_end : src))
1734                   break;
1735                 bcopy (msg, dst, msglen);
1736                 dst += msglen;
1737               }
1738             goto ccl_finish;
1739           }
1740 #endif
1741           break;
1742 
1743         case CCL_STAT_QUIT:
1744           if (! ccl->quit_silently)
1745             sprintf(msg, "\nCCL: Quited.");
1746           break;
1747 
1748         default:
1749           sprintf(msg, "\nCCL: Unknown error type (%d)", ccl->status);
1750         }
1751 
1752       msglen = strlen (msg);
1753       if (dst + msglen <= dst_end)
1754         {
1755           for (i = 0; i < msglen; i++)
1756             *dst++ = msg[i];
1757         }
1758 
1759       if (ccl->status == CCL_STAT_INVALID_CMD)
1760         {
1761 #if 0 /* If the remaining bytes contain 0x80..0x9F, copying them
1762          results in an invalid multibyte sequence.  */
1763 
1764           /* Copy the remaining source data.  */
1765           int i = src_end - src;
1766           if (dst_bytes && (dst_end - dst) < i)
1767             i = dst_end - dst;
1768           bcopy (src, dst, i);
1769           src += i;
1770           dst += i;
1771 #else
1772           /* Signal that we've consumed everything.  */
1773           src = src_end;
1774 #endif
1775         }
1776     }
1777 
1778  ccl_finish:
1779   ccl->ic = ic;
1780   ccl->stack_idx = stack_idx;
1781   ccl->prog = ccl_prog;
1782   ccl->consumed = src - source;
1783   if (dst != NULL)
1784     ccl->produced = dst - destination;
1785   else
1786     ccl->produced = 0;
1787 }
1788 
1789 /* Resolve symbols in the specified CCL code (Lisp vector).  This
1790    function converts symbols of code conversion maps and character
1791    translation tables embeded in the CCL code into their ID numbers.
1792 
1793    The return value is a vector (CCL itself or a new vector in which
1794    all symbols are resolved), Qt if resolving of some symbol failed,
1795    or nil if CCL contains invalid data.  */
1796 
1797 static Lisp_Object
1798 resolve_symbol_ccl_program (ccl)
1799      Lisp_Object ccl;
1800 {
1801   int i, veclen, unresolved = 0;
1802   Lisp_Object result, contents, val;
1803 
1804   result = ccl;
1805   veclen = ASIZE (result);
1806 
1807   for (i = 0; i < veclen; i++)
1808     {
1809       contents = AREF (result, i);
1810       if (INTEGERP (contents))
1811         continue;
1812       else if (CONSP (contents)
1813                && SYMBOLP (XCAR (contents))
1814                && SYMBOLP (XCDR (contents)))
1815         {
1816           /* This is the new style for embedding symbols.  The form is
1817              (SYMBOL . PROPERTY).  (get SYMBOL PROPERTY) should give
1818              an index number.  */
1819 
1820           if (EQ (result, ccl))
1821             result =  Fcopy_sequence (ccl);
1822 
1823           val = Fget (XCAR (contents), XCDR (contents));
1824           if (NATNUMP (val))
1825             ASET (result, i, val);
1826           else
1827             unresolved = 1;
1828           continue;
1829         }
1830       else if (SYMBOLP (contents))
1831         {
1832           /* This is the old style for embedding symbols.  This style
1833              may lead to a bug if, for instance, a translation table
1834              and a code conversion map have the same name.  */
1835           if (EQ (result, ccl))
1836             result = Fcopy_sequence (ccl);
1837 
1838           val = Fget (contents, Qtranslation_table_id);
1839           if (NATNUMP (val))
1840             ASET (result, i, val);
1841           else
1842             {
1843               val = Fget (contents, Qcode_conversion_map_id);
1844               if (NATNUMP (val))
1845                 ASET (result, i, val);
1846               else
1847                 {
1848                   val = Fget (contents, Qccl_program_idx);
1849                   if (NATNUMP (val))
1850                     ASET (result, i, val);
1851                   else
1852                     unresolved = 1;
1853                 }
1854             }
1855           continue;
1856         }
1857       return Qnil;
1858     }
1859 
1860   return (unresolved ? Qt : result);
1861 }
1862 
1863 /* Return the compiled code (vector) of CCL program CCL_PROG.
1864    CCL_PROG is a name (symbol) of the program or already compiled
1865    code.  If necessary, resolve symbols in the compiled code to index
1866    numbers.  If we failed to get the compiled code or to resolve
1867    symbols, return Qnil.  */
1868 
1869 static Lisp_Object
1870 ccl_get_compiled_code (ccl_prog, idx)
1871      Lisp_Object ccl_prog;
1872      int *idx;
1873 {
1874   Lisp_Object val, slot;
1875 
1876   if (VECTORP (ccl_prog))
1877     {
1878       val = resolve_symbol_ccl_program (ccl_prog);
1879       *idx = -1;
1880       return (VECTORP (val) ? val : Qnil);
1881     }
1882   if (!SYMBOLP (ccl_prog))
1883     return Qnil;
1884 
1885   val = Fget (ccl_prog, Qccl_program_idx);
1886   if (! NATNUMP (val)
1887       || XINT (val) >= ASIZE (Vccl_program_table))
1888     return Qnil;
1889   slot = AREF (Vccl_program_table, XINT (val));
1890   if (! VECTORP (slot)
1891       || ASIZE (slot) != 4
1892       || ! VECTORP (AREF (slot, 1)))
1893     return Qnil;
1894   *idx = XINT (val);
1895   if (NILP (AREF (slot, 2)))
1896     {
1897       val = resolve_symbol_ccl_program (AREF (slot, 1));
1898       if (! VECTORP (val))
1899         return Qnil;
1900       ASET (slot, 1, val);
1901       ASET (slot, 2, Qt);
1902     }
1903   return AREF (slot, 1);
1904 }
1905 
1906 /* Setup fields of the structure pointed by CCL appropriately for the
1907    execution of CCL program CCL_PROG.  CCL_PROG is the name (symbol)
1908    of the CCL program or the already compiled code (vector).
1909    Return 0 if we succeed this setup, else return -1.
1910 
1911    If CCL_PROG is nil, we just reset the structure pointed by CCL.  */
1912 int
1913 setup_ccl_program (ccl, ccl_prog)
1914      struct ccl_program *ccl;
1915      Lisp_Object ccl_prog;
1916 {
1917   int i;
1918 
1919   if (! NILP (ccl_prog))
1920     {
1921       struct Lisp_Vector *vp;
1922 
1923       ccl_prog = ccl_get_compiled_code (ccl_prog, &ccl->idx);
1924       if (! VECTORP (ccl_prog))
1925         return -1;
1926       vp = XVECTOR (ccl_prog);
1927       ccl->size = vp->size;
1928       ccl->prog = vp->contents;
1929       ccl->eof_ic = XINT (vp->contents[CCL_HEADER_EOF]);
1930       ccl->buf_magnification = XINT (vp->contents[CCL_HEADER_BUF_MAG]);
1931       if (ccl->idx >= 0)
1932         {
1933           Lisp_Object slot;
1934 
1935           slot = AREF (Vccl_program_table, ccl->idx);
1936           ASET (slot, 3, Qnil);
1937         }
1938     }
1939   ccl->ic = CCL_HEADER_MAIN;
1940   for (i = 0; i < 8; i++)
1941     ccl->reg[i] = 0;
1942   ccl->last_block = 0;
1943   ccl->private_state = 0;
1944   ccl->status = 0;
1945   ccl->stack_idx = 0;
1946   ccl->suppress_error = 0;
1947   ccl->eight_bit_control = 0;
1948   ccl->quit_silently = 0;
1949   return 0;
1950 }
1951 
1952 
1953 /* Check if CCL is updated or not.  If not, re-setup members of CCL.  */
1954 
1955 int
1956 check_ccl_update (ccl)
1957      struct ccl_program *ccl;
1958 {
1959   Lisp_Object slot, ccl_prog;
1960 
1961   if (ccl->idx < 0)
1962     return 0;
1963   slot = AREF (Vccl_program_table, ccl->idx);
1964   if (NILP (AREF (slot, 3)))
1965     return 0;
1966   ccl_prog = ccl_get_compiled_code (AREF (slot, 0), &ccl->idx);
1967   if (! VECTORP (ccl_prog))
1968     return -1;
1969   ccl->size = ASIZE (ccl_prog);
1970   ccl->prog = XVECTOR (ccl_prog)->contents;
1971   ccl->eof_ic = XINT (AREF (ccl_prog, CCL_HEADER_EOF));
1972   ccl->buf_magnification = XINT (AREF (ccl_prog, CCL_HEADER_BUF_MAG));
1973   ASET (slot, 3, Qnil);
1974   return 0;
1975 }
1976 
1977 
1978 DEFUN ("ccl-program-p", Fccl_program_p, Sccl_program_p, 1, 1, 0,
1979        doc: /* Return t if OBJECT is a CCL program name or a compiled CCL program code.
1980 See the documentation of  `define-ccl-program' for the detail of CCL program.  */)
1981      (object)
1982      Lisp_Object object;
1983 {
1984   Lisp_Object val;
1985 
1986   if (VECTORP (object))
1987     {
1988       val = resolve_symbol_ccl_program (object);
1989       return (VECTORP (val) ? Qt : Qnil);
1990     }
1991   if (!SYMBOLP (object))
1992     return Qnil;
1993 
1994   val = Fget (object, Qccl_program_idx);
1995   return ((! NATNUMP (val)
1996            || XINT (val) >= ASIZE (Vccl_program_table))
1997           ? Qnil : Qt);
1998 }
1999 
2000 DEFUN ("ccl-execute", Fccl_execute, Sccl_execute, 2, 2, 0,
2001        doc: /* Execute CCL-PROGRAM with registers initialized by REGISTERS.
2002 
2003 CCL-PROGRAM is a CCL program name (symbol)
2004 or compiled code generated by `ccl-compile' (for backward compatibility.
2005 In the latter case, the execution overhead is bigger than in the former).
2006 No I/O commands should appear in CCL-PROGRAM.
2007 
2008 REGISTERS is a vector of [R0 R1 ... R7] where RN is an initial value
2009 for the Nth register.
2010 
2011 As side effect, each element of REGISTERS holds the value of
2012 the corresponding register after the execution.
2013 
2014 See the documentation of `define-ccl-program' for a definition of CCL
2015 programs.  */)
2016      (ccl_prog, reg)
2017      Lisp_Object ccl_prog, reg;
2018 {
2019   struct ccl_program ccl;
2020   int i;
2021 
2022   if (setup_ccl_program (&ccl, ccl_prog) < 0)
2023     error ("Invalid CCL program");
2024 
2025   CHECK_VECTOR (reg);
2026   if (ASIZE (reg) != 8)
2027     error ("Length of vector REGISTERS is not 8");
2028 
2029   for (i = 0; i < 8; i++)
2030     ccl.reg[i] = (INTEGERP (AREF (reg, i))
2031                   ? XINT (AREF (reg, i))
2032                   : 0);
2033 
2034   ccl_driver (&ccl, NULL, NULL, 0, 0, Qnil);
2035   QUIT;
2036   if (ccl.status != CCL_STAT_SUCCESS)
2037     error ("Error in CCL program at %dth code", ccl.ic);
2038 
2039   for (i = 0; i < 8; i++)
2040     ASET (reg, i, make_number (ccl.reg[i]));
2041   return Qnil;
2042 }
2043 
2044 DEFUN ("ccl-execute-on-string", Fccl_execute_on_string, Sccl_execute_on_string,
2045        3, 5, 0,
2046        doc: /* Execute CCL-PROGRAM with initial STATUS on STRING.
2047 
2048 CCL-PROGRAM is a symbol registered by `register-ccl-program',
2049 or a compiled code generated by `ccl-compile' (for backward compatibility,
2050 in this case, the execution is slower).
2051 
2052 Read buffer is set to STRING, and write buffer is allocated automatically.
2053 
2054 STATUS is a vector of [R0 R1 ... R7 IC], where
2055  R0..R7 are initial values of corresponding registers,
2056  IC is the instruction counter specifying from where to start the program.
2057 If R0..R7 are nil, they are initialized to 0.
2058 If IC is nil, it is initialized to head of the CCL program.
2059 
2060 If optional 4th arg CONTINUE is non-nil, keep IC on read operation
2061 when read buffer is exausted, else, IC is always set to the end of
2062 CCL-PROGRAM on exit.
2063 
2064 It returns the contents of write buffer as a string,
2065  and as side effect, STATUS is updated.
2066 If the optional 5th arg UNIBYTE-P is non-nil, the returned string
2067 is a unibyte string.  By default it is a multibyte string.
2068 
2069 See the documentation of `define-ccl-program' for the detail of CCL program.
2070 usage: (ccl-execute-on-string CCL-PROGRAM STATUS STRING &optional CONTINUE UNIBYTE-P)  */)
2071      (ccl_prog, status, str, contin, unibyte_p)
2072      Lisp_Object ccl_prog, status, str, contin, unibyte_p;
2073 {
2074   Lisp_Object val;
2075   struct ccl_program ccl;
2076   int i;
2077   int outbufsize;
2078   unsigned char *outbuf, *outp;
2079   int str_chars, str_bytes;
2080 #define CCL_EXECUTE_BUF_SIZE 1024
2081   int source[CCL_EXECUTE_BUF_SIZE], destination[CCL_EXECUTE_BUF_SIZE];
2082   int consumed_chars, consumed_bytes, produced_chars;
2083 
2084   if (setup_ccl_program (&ccl, ccl_prog) < 0)
2085     error ("Invalid CCL program");
2086 
2087   CHECK_VECTOR (status);
2088   if (ASIZE (status) != 9)
2089     error ("Length of vector STATUS is not 9");
2090   CHECK_STRING (str);
2091 
2092   str_chars = SCHARS (str);
2093   str_bytes = SBYTES (str);
2094 
2095   for (i = 0; i < 8; i++)
2096     {
2097       if (NILP (AREF (status, i)))
2098         ASET (status, i, make_number (0));
2099       if (INTEGERP (AREF (status, i)))
2100         ccl.reg[i] = XINT (AREF (status, i));
2101     }
2102   if (INTEGERP (AREF (status, i)))
2103     {
2104       i = XFASTINT (AREF (status, 8));
2105       if (ccl.ic < i && i < ccl.size)
2106         ccl.ic = i;
2107     }
2108 
2109   outbufsize = (ccl.buf_magnification
2110                 ? str_bytes * ccl.buf_magnification + 256
2111                 : str_bytes + 256);
2112   outp = outbuf = (unsigned char *) xmalloc (outbufsize);
2113 
2114   consumed_chars = consumed_bytes = 0;
2115   produced_chars = 0;
2116   while (1)
2117     {
2118       const unsigned char *p = SDATA (str) + consumed_bytes;
2119       const unsigned char *endp = SDATA (str) + str_bytes;
2120       int i = 0;
2121       int *src, src_size;
2122 
2123       if (endp - p == str_chars - consumed_chars)
2124         while (i < CCL_EXECUTE_BUF_SIZE && p < endp)
2125           source[i++] = *p++;
2126       else
2127         while (i < CCL_EXECUTE_BUF_SIZE && p < endp)
2128           source[i++] = STRING_CHAR_ADVANCE (p);
2129       consumed_chars += i;
2130       consumed_bytes = p - SDATA (str);
2131 
2132       if (consumed_bytes == str_bytes)
2133         ccl.last_block = NILP (contin);
2134       src = source;
2135       src_size = i;
2136       while (1)
2137         {
2138           ccl_driver (&ccl, src, destination, src_size, CCL_EXECUTE_BUF_SIZE,
2139                       Qnil);
2140           produced_chars += ccl.produced;
2141           if (NILP (unibyte_p))
2142             {
2143               if (outp - outbuf + MAX_MULTIBYTE_LENGTH * ccl.produced
2144                   > outbufsize)
2145                 {
2146                   int offset = outp - outbuf;
2147                   outbufsize += MAX_MULTIBYTE_LENGTH * ccl.produced;
2148                   outbuf = (unsigned char *) xrealloc (outbuf, outbufsize);
2149                   outp = outbuf + offset;
2150                 }
2151               for (i = 0; i < ccl.produced; i++)
2152                 CHAR_STRING_ADVANCE (destination[i], outp);
2153             }
2154           else
2155             {
2156               if (outp - outbuf + ccl.produced > outbufsize)
2157                 {
2158                   int offset = outp - outbuf;
2159                   outbufsize += ccl.produced;
2160                   outbuf = (unsigned char *) xrealloc (outbuf, outbufsize);
2161                   outp = outbuf + offset;
2162                 }
2163               for (i = 0; i < ccl.produced; i++)
2164                 *outp++ = destination[i];
2165             }
2166           src += ccl.consumed;
2167           src_size -= ccl.consumed;
2168           if (ccl.status != CCL_STAT_SUSPEND_BY_DST)
2169             break;
2170         }
2171 
2172       if (ccl.status != CCL_STAT_SUSPEND_BY_SRC
2173           || str_chars == consumed_chars)
2174         break;
2175     }
2176 
2177   if (ccl.status == CCL_STAT_INVALID_CMD)
2178     error ("Error in CCL program at %dth code", ccl.ic);
2179   if (ccl.status == CCL_STAT_QUIT)
2180     error ("CCL program interrupted at %dth code", ccl.ic);
2181 
2182   for (i = 0; i < 8; i++)
2183     ASET (status, i, make_number (ccl.reg[i]));
2184   ASET (status, 8, make_number (ccl.ic));
2185 
2186   if (NILP (unibyte_p))
2187     val = make_multibyte_string ((char *) outbuf, produced_chars,
2188                                  outp - outbuf);
2189   else
2190     val = make_unibyte_string ((char *) outbuf, produced_chars);
2191   xfree (outbuf);
2192 
2193   return val;
2194 }
2195 
2196 DEFUN ("register-ccl-program", Fregister_ccl_program, Sregister_ccl_program,
2197        2, 2, 0,
2198        doc: /* Register CCL program CCL-PROG as NAME in `ccl-program-table'.
2199 CCL-PROG should be a compiled CCL program (vector), or nil.
2200 If it is nil, just reserve NAME as a CCL program name.
2201 Return index number of the registered CCL program.  */)
2202      (name, ccl_prog)
2203      Lisp_Object name, ccl_prog;
2204 {
2205   int len = ASIZE (Vccl_program_table);
2206   int idx;
2207   Lisp_Object resolved;
2208 
2209   CHECK_SYMBOL (name);
2210   resolved = Qnil;
2211   if (!NILP (ccl_prog))
2212     {
2213       CHECK_VECTOR (ccl_prog);
2214       resolved = resolve_symbol_ccl_program (ccl_prog);
2215       if (NILP (resolved))
2216         error ("Error in CCL program");
2217       if (VECTORP (resolved))
2218         {
2219           ccl_prog = resolved;
2220           resolved = Qt;
2221         }
2222       else
2223         resolved = Qnil;
2224     }
2225 
2226   for (idx = 0; idx < len; idx++)
2227     {
2228       Lisp_Object slot;
2229 
2230       slot = AREF (Vccl_program_table, idx);
2231       if (!VECTORP (slot))
2232         /* This is the first unsed slot.  Register NAME here.  */
2233         break;
2234 
2235       if (EQ (name, AREF (slot, 0)))
2236         {
2237           /* Update this slot.  */
2238           ASET (slot, 1, ccl_prog);
2239           ASET (slot, 2, resolved);
2240           ASET (slot, 3, Qt);
2241           return make_number (idx);
2242         }
2243     }
2244 
2245   if (idx == len)
2246     /* Extend the table.  */
2247     Vccl_program_table = larger_vector (Vccl_program_table, len * 2, Qnil);
2248 
2249   {
2250     Lisp_Object elt;
2251 
2252     elt = Fmake_vector (make_number (4), Qnil);
2253     ASET (elt, 0, name);
2254     ASET (elt, 1, ccl_prog);
2255     ASET (elt, 2, resolved);
2256     ASET (elt, 3, Qt);
2257     ASET (Vccl_program_table, idx, elt);
2258   }
2259 
2260   Fput (name, Qccl_program_idx, make_number (idx));
2261   return make_number (idx);
2262 }
2263 
2264 /* Register code conversion map.
2265    A code conversion map consists of numbers, Qt, Qnil, and Qlambda.
2266    The first element is the start code point.
2267    The other elements are mapped numbers.
2268    Symbol t means to map to an original number before mapping.
2269    Symbol nil means that the corresponding element is empty.
2270    Symbol lambda means to terminate mapping here.
2271 */
2272 
2273 DEFUN ("register-code-conversion-map", Fregister_code_conversion_map,
2274        Sregister_code_conversion_map,
2275        2, 2, 0,
2276        doc: /* Register SYMBOL as code conversion map MAP.
2277 Return index number of the registered map.  */)
2278      (symbol, map)
2279      Lisp_Object symbol, map;
2280 {
2281   int len = ASIZE (Vcode_conversion_map_vector);
2282   int i;
2283   Lisp_Object index;
2284 
2285   CHECK_SYMBOL (symbol);
2286   CHECK_VECTOR (map);
2287 
2288   for (i = 0; i < len; i++)
2289     {
2290       Lisp_Object slot = AREF (Vcode_conversion_map_vector, i);
2291 
2292       if (!CONSP (slot))
2293         break;
2294 
2295       if (EQ (symbol, XCAR (slot)))
2296         {
2297           index = make_number (i);
2298           XSETCDR (slot, map);
2299           Fput (symbol, Qcode_conversion_map, map);
2300           Fput (symbol, Qcode_conversion_map_id, index);
2301           return index;
2302         }
2303     }
2304 
2305   if (i == len)
2306     Vcode_conversion_map_vector = larger_vector (Vcode_conversion_map_vector,
2307                                                  len * 2, Qnil);
2308 
2309   index = make_number (i);
2310   Fput (symbol, Qcode_conversion_map, map);
2311   Fput (symbol, Qcode_conversion_map_id, index);
2312   ASET (Vcode_conversion_map_vector, i, Fcons (symbol, map));
2313   return index;
2314 }
2315 
2316 
2317 void
2318 syms_of_ccl ()
2319 {
2320   staticpro (&Vccl_program_table);
2321   Vccl_program_table = Fmake_vector (make_number (32), Qnil);
2322 
2323   Qccl = intern_c_string ("ccl");
2324   staticpro (&Qccl);
2325 
2326   Qcclp = intern_c_string ("cclp");
2327   staticpro (&Qcclp);
2328 
2329   Qccl_program = intern_c_string ("ccl-program");
2330   staticpro (&Qccl_program);
2331 
2332   Qccl_program_idx = intern_c_string ("ccl-program-idx");
2333   staticpro (&Qccl_program_idx);
2334 
2335   Qcode_conversion_map = intern_c_string ("code-conversion-map");
2336   staticpro (&Qcode_conversion_map);
2337 
2338   Qcode_conversion_map_id = intern_c_string ("code-conversion-map-id");
2339   staticpro (&Qcode_conversion_map_id);
2340 
2341   DEFVAR_LISP ("code-conversion-map-vector", &Vcode_conversion_map_vector,
2342                doc: /* Vector of code conversion maps.  */);
2343   Vcode_conversion_map_vector = Fmake_vector (make_number (16), Qnil);
2344 
2345   DEFVAR_LISP ("font-ccl-encoder-alist", &Vfont_ccl_encoder_alist,
2346                doc: /* Alist of fontname patterns vs corresponding CCL program.
2347 Each element looks like (REGEXP . CCL-CODE),
2348  where CCL-CODE is a compiled CCL program.
2349 When a font whose name matches REGEXP is used for displaying a character,
2350  CCL-CODE is executed to calculate the code point in the font
2351  from the charset number and position code(s) of the character which are set
2352  in CCL registers R0, R1, and R2 before the execution.
2353 The code point in the font is set in CCL registers R1 and R2
2354  when the execution terminated.
2355  If the font is single-byte font, the register R2 is not used.  */);
2356   Vfont_ccl_encoder_alist = Qnil;
2357 
2358   DEFVAR_LISP ("translation-hash-table-vector", &Vtranslation_hash_table_vector,
2359     doc: /* Vector containing all translation hash tables ever defined.
2360 Comprises pairs (SYMBOL . TABLE) where SYMBOL and TABLE were set up by calls
2361 to `define-translation-hash-table'.  The vector is indexed by the table id
2362 used by CCL.  */);
2363     Vtranslation_hash_table_vector = Qnil;
2364 
2365   defsubr (&Sccl_program_p);
2366   defsubr (&Sccl_execute);
2367   defsubr (&Sccl_execute_on_string);
2368   defsubr (&Sregister_ccl_program);
2369   defsubr (&Sregister_code_conversion_map);
2370 }
2371 
2372 /* arch-tag: bb9a37be-68ce-4576-8d3d-15d750e4a860
2373    (do not change this comment) */