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

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