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_Extention           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 = 0;
 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     goto ccl_repeat;                                            \
 638   } while (0)
 639
 640 #define CCL_MapSingle           0x12 /* Map by single code conversion map
 641                                         1:ExtendedCOMMNDXXXRRRrrrXXXXX
 642                                         2:MAP-ID
 643                                         ------------------------------
 644                                         Map reg[rrr] by MAP-ID.
 645                                         If some valid mapping is found,
 646                                           set reg[rrr] to the result,
 647                                         else
 648                                           set reg[RRR] to -1.
 649                                      */
 650
 651 /* CCL arithmetic/logical operators. */
 652 #define CCL_PLUS        0x00    /* X = Y + Z */
 653 #define CCL_MINUS       0x01    /* X = Y - Z */
 654 #define CCL_MUL         0x02    /* X = Y * Z */
 655 #define CCL_DIV         0x03    /* X = Y / Z */
 656 #define CCL_MOD         0x04    /* X = Y % Z */
 657 #define CCL_AND         0x05    /* X = Y & Z */
 658 #define CCL_OR          0x06    /* X = Y | Z */
 659 #define CCL_XOR         0x07    /* X = Y ^ Z */
 660 #define CCL_LSH         0x08    /* X = Y << Z */
 661 #define CCL_RSH         0x09    /* X = Y >> Z */
 662 #define CCL_LSH8        0x0A    /* X = (Y << 8) | Z */
 663 #define CCL_RSH8        0x0B    /* X = Y >> 8, r[7] = Y & 0xFF  */
 664 #define CCL_DIVMOD      0x0C    /* X = Y / Z, r[7] = Y % Z */
 665 #define CCL_LS          0x10    /* X = (X < Y) */
 666 #define CCL_GT          0x11    /* X = (X > Y) */
 667 #define CCL_EQ          0x12    /* X = (X == Y) */
 668 #define CCL_LE          0x13    /* X = (X <= Y) */
 669 #define CCL_GE          0x14    /* X = (X >= Y) */
 670 #define CCL_NE          0x15    /* X = (X != Y) */
 671
 672 #define CCL_DECODE_SJIS 0x16    /* X = HIGHER_BYTE (DE-SJIS (Y, Z))
 673                                    r[7] = LOWER_BYTE (DE-SJIS (Y, Z)) */
 674 #define CCL_ENCODE_SJIS 0x17    /* X = HIGHER_BYTE (SJIS (Y, Z))
 675                                    r[7] = LOWER_BYTE (SJIS (Y, Z) */
 676
 677 /* Terminate CCL program successfully.  */
 678 #define CCL_SUCCESS                     \
 679   do {                                  \
 680     ccl->status = CCL_STAT_SUCCESS;     \
 681     goto ccl_finish;                    \
 682   } while (0)
 683
 684 /* Suspend CCL program because of reading from empty input buffer or
 685    writing to full output buffer.  When this program is resumed, the
 686    same I/O command is executed.  */
 687 #define CCL_SUSPEND(stat)       \
 688   do {                          \
 689     ic--;                       \
 690     ccl->status = stat;         \
 691     goto ccl_finish;            \
 692   } while (0)
 693
 694 /* Terminate CCL program because of invalid command.  Should not occur
 695    in the normal case.  */
 696 #define CCL_INVALID_CMD                 \
 697   do {                                  \
 698     ccl->status = CCL_STAT_INVALID_CMD; \
 699     goto ccl_error_handler;             \
 700   } while (0)
 701
 702 /* Encode one character CH to multibyte form and write to the current
 703    output buffer.  At encoding time, if CH is less than 256, CH is
 704    written as is.  At decoding time, if CH cannot be regarded as an
 705    ASCII character, write it in multibyte form.  */
 706 #define CCL_WRITE_CHAR(ch)                                      \
 707   do {                                                          \
 708     if (!destination)                                           \
 709       CCL_INVALID_CMD;                                          \
 710     if (conversion_mode == CCL_MODE_ENCODING)                   \
 711       {                                                         \
 712         if (ch == '\n')                                         \
 713           {                                                     \
 714             if (ccl->eol_type == CCL_CODING_EOL_CRLF)           \
 715               {                                                 \
 716                 Dynarr_add (destination, '\r');                 \
 717                 Dynarr_add (destination, '\n');                 \
 718               }                                                 \
 719             else if (ccl->eol_type == CCL_CODING_EOL_CR)        \
 720               Dynarr_add (destination, '\r');                   \
 721             else                                                \
 722               Dynarr_add (destination, '\n');                   \
 723           }                                                     \
 724         else if (ch < 0x100)                                    \
 725           {                                                     \
 726             Dynarr_add (destination, ch);                       \
 727           }                                                     \
 728         else                                                    \
 729           {                                                     \
 730             Bufbyte work[MAX_EMCHAR_LEN];                       \
 731             int len;                                            \
 732             len = non_ascii_set_charptr_emchar (work, ch);      \
 733             Dynarr_add_many (destination, work, len);           \
 734           }                                                     \
 735       }                                                         \
 736     else                                                        \
 737       {                                                         \
 738         if (!CHAR_MULTIBYTE_P(ch))                              \
 739           {                                                     \
 740             Dynarr_add (destination, ch);                       \
 741           }                                                     \
 742         else                                                    \
 743           {                                                     \
 744             Bufbyte work[MAX_EMCHAR_LEN];                       \
 745             int len;                                            \
 746             len = non_ascii_set_charptr_emchar (work, ch);      \
 747             Dynarr_add_many (destination, work, len);           \
 748           }                                                     \
 749       }                                                         \
 750   } while (0)
 751
 752 /* Write a string at ccl_prog[IC] of length LEN to the current output
 753    buffer.  But this macro treat this string as a binary.  Therefore,
 754    cannot handle a multibyte string except for Control-1 characters. */
 755 #define CCL_WRITE_STRING(len)                                   \
 756   do {                                                          \
 757     Bufbyte work[MAX_EMCHAR_LEN];                               \
 758     int ch, bytes;                                              \
 759     if (!destination)                                           \
 760       CCL_INVALID_CMD;                                          \
 761     else if (conversion_mode == CCL_MODE_ENCODING)              \
 762       {                                                         \
 763         for (i = 0; i < len; i++)                               \
 764           {                                                     \
 765             ch = ((XINT (ccl_prog[ic + (i / 3)]))               \
 766                   >> ((2 - (i % 3)) * 8)) & 0xFF;               \
 767             if (ch == '\n')                                     \
 768               {                                                 \
 769                 if (ccl->eol_type == CCL_CODING_EOL_CRLF)       \
 770                   {                                             \
 771                     Dynarr_add (destination, '\r');             \
 772                     Dynarr_add (destination, '\n');             \
 773                   }                                             \
 774                 else if (ccl->eol_type == CCL_CODING_EOL_CR)    \
 775                   Dynarr_add (destination, '\r');               \
 776                 else                                            \
 777                   Dynarr_add (destination, '\n');               \
 778               }                                                 \
 779             if (ch < 0x100)                                     \
 780               {                                                 \
 781                 Dynarr_add (destination, ch);                   \
 782               }                                                 \
 783             else                                                \
 784               {                                                 \
 785                 bytes = non_ascii_set_charptr_emchar (work, ch); \
 786                 Dynarr_add_many (destination, work, len);       \
 787               }                                                 \
 788           }                                                     \
 789       }                                                         \
 790     else                                                        \
 791       {                                                         \
 792         for (i = 0; i < len; i++)                               \
 793           {                                                     \
 794             ch = ((XINT (ccl_prog[ic + (i / 3)]))               \
 795                   >> ((2 - (i % 3)) * 8)) & 0xFF;               \
 796             if (!CHAR_MULTIBYTE_P(ch))                          \
 797               {                                                 \
 798                 Dynarr_add (destination, ch);                   \
 799               }                                                 \
 800             else                                                \
 801               {                                                 \
 802                 bytes = non_ascii_set_charptr_emchar (work, ch); \
 803                 Dynarr_add_many (destination, work, len);       \
 804               }                                                 \
 805           }                                                     \
 806       }                                                         \
 807   } while (0)
 808
 809 /* Read one byte from the current input buffer into Rth register.  */
 810 #define CCL_READ_CHAR(r)                                \
 811   do {                                                  \
 812     if (!src)                                           \
 813       CCL_INVALID_CMD;                                  \
 814     if (src < src_end)                                  \
 815       r = *src++;                                       \
 816     else                                                \
 817       {                                                 \
 818         if (ccl->last_block)                            \
 819           {                                             \
 820             ic = ccl->eof_ic;                           \
 821             goto ccl_repeat;                            \
 822           }                                             \
 823         else                                            \
 824           CCL_SUSPEND (CCL_STAT_SUSPEND_BY_SRC);        \
 825       }                                                 \
 826   } while (0)
 827
 828
 829 /* Set C to the character code made from CHARSET and CODE.  This is
 830    like MAKE_CHAR but check the validity of CHARSET and CODE.  If they
 831    are not valid, set C to (CODE & 0xFF) because that is usually the
 832    case that CCL_ReadMultibyteChar2 read an invalid code and it set
 833    CODE to that invalid byte.  */
 834
 835 /* On XEmacs, TranslateCharacter is not supported.  Thus, this
 836    macro is not used.  */
 837 #if 0
 838 #define CCL_MAKE_CHAR(charset, code, c)                         \
 839   do {                                                          \
 840     if (charset == CHARSET_ASCII)                               \
 841       c = code & 0xFF;                                          \
 842     else if (CHARSET_DEFINED_P (charset)                        \
 843              && (code & 0x7F) >= 32                             \
 844              && (code < 256 || ((code >> 7) & 0x7F) >= 32))     \
 845       {                                                         \
 846         int c1 = code & 0x7F, c2 = 0;                           \
 847                                                                 \
 848         if (code >= 256)                                        \
 849           c2 = c1, c1 = (code >> 7) & 0x7F;                     \
 850         c = MAKE_CHAR (charset, c1, c2);                        \
 851       }                                                         \
 852     else                                                        \
 853       c = code & 0xFF;                                          \
 854   } while (0)
 855 #endif
 856
 857
 858 /* Execute CCL code on SRC_BYTES length text at SOURCE.  The resulting
 859    text goes to a place pointed by DESTINATION, the length of which
 860    should not exceed DST_BYTES.  The bytes actually processed is
 861    returned as *CONSUMED.  The return value is the length of the
 862    resulting text.  As a side effect, the contents of CCL registers
 863    are updated.  If SOURCE or DESTINATION is NULL, only operations on
 864    registers are permitted.  */
 865
 866 #ifdef CCL_DEBUG
 867 #define CCL_DEBUG_BACKTRACE_LEN 256
 868 int ccl_backtrace_table[CCL_BACKTRACE_TABLE];
 869 int ccl_backtrace_idx;
 870 #endif
 871
 872 struct ccl_prog_stack
 873   {
 874     Lisp_Object *ccl_prog;      /* Pointer to an array of CCL code.  */
 875     int ic;                     /* Instruction Counter.  */
 876   };
 877
 878 /* For the moment, we only support depth 256 of stack.  */
 879 static struct ccl_prog_stack ccl_prog_stack_struct[256];
 880
 881 int
 882 ccl_driver (struct ccl_program *ccl,
 883             const unsigned char *source,
 884             unsigned_char_dynarr *destination,
 885             int src_bytes,
 886             int *consumed,
 887             int conversion_mode)
 888 {
 889   register int *reg = ccl->reg;
 890   register int ic = ccl->ic;
 891   register int code = -1;
 892   register int field1, field2;
 893   register Lisp_Object *ccl_prog = ccl->prog;
 894   const unsigned char *src = source, *src_end = src + src_bytes;
 895   int jump_address;
 896   int i, j, op;
 897   int stack_idx = ccl->stack_idx;
 898   /* Instruction counter of the current CCL code. */
 899   int this_ic = 0;
 900
 901   if (ic >= ccl->eof_ic)
 902     ic = CCL_HEADER_MAIN;
 903
 904   if (ccl->buf_magnification ==0) /* We can't produce any bytes.  */
 905     destination = NULL;
 906
 907   /* Set mapping stack pointer. */
 908   mapping_stack_pointer = mapping_stack;
 909
 910 #ifdef CCL_DEBUG
 911   ccl_backtrace_idx = 0;
 912 #endif
 913
 914   for (;;)
 915     {
 916     ccl_repeat:
 917 #ifdef CCL_DEBUG
 918       ccl_backtrace_table[ccl_backtrace_idx++] = ic;
 919       if (ccl_backtrace_idx >= CCL_DEBUG_BACKTRACE_LEN)
 920         ccl_backtrace_idx = 0;
 921       ccl_backtrace_table[ccl_backtrace_idx] = 0;
 922 #endif
 923
 924       if (!NILP (Vquit_flag) && NILP (Vinhibit_quit))
 925         {
 926           /* We can't just signal Qquit, instead break the loop as if
 927              the whole data is processed.  Don't reset Vquit_flag, it
 928              must be handled later at a safer place.  */
 929           if (consumed)
 930             src = source + src_bytes;
 931           ccl->status = CCL_STAT_QUIT;
 932           break;
 933         }
 934
 935       this_ic = ic;
 936       code = XINT (ccl_prog[ic]); ic++;
 937       field1 = code >> 8;
 938       field2 = (code & 0xFF) >> 5;
 939
 940 #define rrr field2
 941 #define RRR (field1 & 7)
 942 #define Rrr ((field1 >> 3) & 7)
 943 #define ADDR field1
 944 #define EXCMD (field1 >> 6)
 945
 946       switch (code & 0x1F)
 947         {
 948         case CCL_SetRegister:   /* 00000000000000000RRRrrrXXXXX */
 949           reg[rrr] = reg[RRR];
 950           break;
 951
 952         case CCL_SetShortConst: /* CCCCCCCCCCCCCCCCCCCCrrrXXXXX */
 953           reg[rrr] = field1;
 954           break;
 955
 956         case CCL_SetConst:      /* 00000000000000000000rrrXXXXX */
 957           reg[rrr] = XINT (ccl_prog[ic]);
 958           ic++;
 959           break;
 960
 961         case CCL_SetArray:      /* CCCCCCCCCCCCCCCCCCCCRRRrrrXXXXX */
 962           i = reg[RRR];
 963           j = field1 >> 3;
 964           if ((unsigned int) i < j)
 965             reg[rrr] = XINT (ccl_prog[ic + i]);
 966           ic += j;
 967           break;
 968
 969         case CCL_Jump:          /* A--D--D--R--E--S--S-000XXXXX */
 970           ic += ADDR;
 971           break;
 972
 973         case CCL_JumpCond:      /* A--D--D--R--E--S--S-rrrXXXXX */
 974           if (!reg[rrr])
 975             ic += ADDR;
 976           break;
 977
 978         case CCL_WriteRegisterJump: /* A--D--D--R--E--S--S-rrrXXXXX */
 979           i = reg[rrr];
 980           CCL_WRITE_CHAR (i);
 981           ic += ADDR;
 982           break;
 983
 984         case CCL_WriteRegisterReadJump: /* A--D--D--R--E--S--S-rrrXXXXX */
 985           i = reg[rrr];
 986           CCL_WRITE_CHAR (i);
 987           ic++;
 988           CCL_READ_CHAR (reg[rrr]);
 989           ic += ADDR - 1;
 990           break;
 991
 992         case CCL_WriteConstJump: /* A--D--D--R--E--S--S-000XXXXX */
 993           i = XINT (ccl_prog[ic]);
 994           CCL_WRITE_CHAR (i);
 995           ic += ADDR;
 996           break;
 997
 998         case CCL_WriteConstReadJump: /* A--D--D--R--E--S--S-rrrXXXXX */
 999           i = XINT (ccl_prog[ic]);
1000           CCL_WRITE_CHAR (i);
1001           ic++;
1002           CCL_READ_CHAR (reg[rrr]);
1003           ic += ADDR - 1;
1004           break;
1005
1006         case CCL_WriteStringJump: /* A--D--D--R--E--S--S-000XXXXX */
1007           j = XINT (ccl_prog[ic]);
1008           ic++;
1009           CCL_WRITE_STRING (j);
1010           ic += ADDR - 1;
1011           break;
1012
1013         case CCL_WriteArrayReadJump: /* A--D--D--R--E--S--S-rrrXXXXX */
1014           i = reg[rrr];
1015           j = XINT (ccl_prog[ic]);
1016           if ((unsigned int) i < j)
1017             {
1018               i = XINT (ccl_prog[ic + 1 + i]);
1019               CCL_WRITE_CHAR (i);
1020             }
1021           ic += j + 2;
1022           CCL_READ_CHAR (reg[rrr]);
1023           ic += ADDR - (j + 2);
1024           break;
1025
1026         case CCL_ReadJump:      /* A--D--D--R--E--S--S-rrrYYYYY */
1027           CCL_READ_CHAR (reg[rrr]);
1028           ic += ADDR;
1029           break;
1030
1031         case CCL_ReadBranch:    /* CCCCCCCCCCCCCCCCCCCCrrrXXXXX */
1032           CCL_READ_CHAR (reg[rrr]);
1033           /* fall through ... */
1034         case CCL_Branch:        /* CCCCCCCCCCCCCCCCCCCCrrrXXXXX */
1035           if ((unsigned int) reg[rrr] < field1)
1036             ic += XINT (ccl_prog[ic + reg[rrr]]);
1037           else
1038             ic += XINT (ccl_prog[ic + field1]);
1039           break;
1040
1041         case CCL_ReadRegister:  /* CCCCCCCCCCCCCCCCCCCCrrXXXXX */
1042           while (1)
1043             {
1044               CCL_READ_CHAR (reg[rrr]);
1045               if (!field1) break;
1046               code = XINT (ccl_prog[ic]); ic++;
1047               field1 = code >> 8;
1048               field2 = (code & 0xFF) >> 5;
1049             }
1050           break;
1051
1052         case CCL_WriteExprConst:  /* 1:00000OPERATION000RRR000XXXXX */
1053           rrr = 7;
1054           i = reg[RRR];
1055           j = XINT (ccl_prog[ic]);
1056           op = field1 >> 6;
1057           jump_address = ic + 1;
1058           goto ccl_set_expr;
1059
1060         case CCL_WriteRegister: /* CCCCCCCCCCCCCCCCCCCrrrXXXXX */
1061           while (1)
1062             {
1063               i = reg[rrr];
1064               CCL_WRITE_CHAR (i);
1065               if (!field1) break;
1066               code = XINT (ccl_prog[ic]); ic++;
1067               field1 = code >> 8;
1068               field2 = (code & 0xFF) >> 5;
1069             }
1070           break;
1071
1072         case CCL_WriteExprRegister: /* 1:00000OPERATIONRrrRRR000XXXXX */
1073           rrr = 7;
1074           i = reg[RRR];
1075           j = reg[Rrr];
1076           op = field1 >> 6;
1077           jump_address = ic;
1078           goto ccl_set_expr;
1079
1080         case CCL_Call:          /* 1:CCCCCCCCCCCCCCCCCCCCFFFXXXXX */
1081           {
1082             Lisp_Object slot;
1083             int prog_id;
1084
1085             /* If FFF is nonzero, the CCL program ID is in the
1086                following code.  */
1087             if (rrr)
1088               {
1089                 prog_id = XINT (ccl_prog[ic]);
1090                 ic++;
1091               }
1092             else
1093               prog_id = field1;
1094
1095             if (stack_idx >= 256
1096                 || prog_id < 0
1097                 || prog_id >= XVECTOR (Vccl_program_table)->size
1098                 || (slot = XVECTOR (Vccl_program_table)->contents[prog_id],
1099                     !VECTORP (slot))
1100                 || !VECTORP (XVECTOR (slot)->contents[1]))
1101               {
1102                 if (stack_idx > 0)
1103                   {
1104                     ccl_prog = ccl_prog_stack_struct[0].ccl_prog;
1105                     ic = ccl_prog_stack_struct[0].ic;
1106                   }
1107                 CCL_INVALID_CMD;
1108               }
1109
1110             ccl_prog_stack_struct[stack_idx].ccl_prog = ccl_prog;
1111             ccl_prog_stack_struct[stack_idx].ic = ic;
1112             stack_idx++;
1113             ccl_prog = XVECTOR (XVECTOR (slot)->contents[1])->contents;
1114             ic = CCL_HEADER_MAIN;
1115           }
1116           break;
1117
1118         case CCL_WriteConstString: /* CCCCCCCCCCCCCCCCCCCCrrrXXXXX */
1119           if (!rrr)
1120             CCL_WRITE_CHAR (field1);
1121           else
1122             {
1123               CCL_WRITE_STRING (field1);
1124               ic += (field1 + 2) / 3;
1125             }
1126           break;
1127
1128         case CCL_WriteArray:    /* CCCCCCCCCCCCCCCCCCCCrrrXXXXX */
1129           i = reg[rrr];
1130           if ((unsigned int) i < field1)
1131             {
1132               j = XINT (ccl_prog[ic + i]);
1133               CCL_WRITE_CHAR (j);
1134             }
1135           ic += field1;
1136           break;
1137
1138         case CCL_End:           /* 0000000000000000000000XXXXX */
1139           if (stack_idx > 0)
1140             {
1141               stack_idx--;
1142               ccl_prog = ccl_prog_stack_struct[stack_idx].ccl_prog;
1143               ic = ccl_prog_stack_struct[stack_idx].ic;
1144               break;
1145             }
1146           if (src)
1147             src = src_end;
1148           /* ccl->ic should points to this command code again to
1149              suppress further processing.  */
1150           ic--;
1151           CCL_SUCCESS;
1152
1153         case CCL_ExprSelfConst: /* 00000OPERATION000000rrrXXXXX */
1154           i = XINT (ccl_prog[ic]);
1155           ic++;
1156           op = field1 >> 6;
1157           goto ccl_expr_self;
1158
1159         case CCL_ExprSelfReg:   /* 00000OPERATION000RRRrrrXXXXX */
1160           i = reg[RRR];
1161           op = field1 >> 6;
1162
1163         ccl_expr_self:
1164           switch (op)
1165             {
1166             case CCL_PLUS: reg[rrr] += i; break;
1167             case CCL_MINUS: reg[rrr] -= i; break;
1168             case CCL_MUL: reg[rrr] *= i; break;
1169             case CCL_DIV: reg[rrr] /= i; break;
1170             case CCL_MOD: reg[rrr] %= i; break;
1171             case CCL_AND: reg[rrr] &= i; break;
1172             case CCL_OR: reg[rrr] |= i; break;
1173             case CCL_XOR: reg[rrr] ^= i; break;
1174             case CCL_LSH: reg[rrr] <<= i; break;
1175             case CCL_RSH: reg[rrr] >>= i; break;
1176             case CCL_LSH8: reg[rrr] <<= 8; reg[rrr] |= i; break;
1177             case CCL_RSH8: reg[7] = reg[rrr] & 0xFF; reg[rrr] >>= 8; break;
1178             case CCL_DIVMOD: reg[7] = reg[rrr] % i; reg[rrr] /= i; break;
1179             case CCL_LS: reg[rrr] = reg[rrr] < i; break;
1180             case CCL_GT: reg[rrr] = reg[rrr] > i; break;
1181             case CCL_EQ: reg[rrr] = reg[rrr] == i; break;
1182             case CCL_LE: reg[rrr] = reg[rrr] <= i; break;
1183             case CCL_GE: reg[rrr] = reg[rrr] >= i; break;
1184             case CCL_NE: reg[rrr] = reg[rrr] != i; break;
1185             default: CCL_INVALID_CMD;
1186             }
1187           break;
1188
1189         case CCL_SetExprConst:  /* 00000OPERATION000RRRrrrXXXXX */
1190           i = reg[RRR];
1191           j = XINT (ccl_prog[ic]);
1192           op = field1 >> 6;
1193           jump_address = ++ic;
1194           goto ccl_set_expr;
1195
1196         case CCL_SetExprReg:    /* 00000OPERATIONRrrRRRrrrXXXXX */
1197           i = reg[RRR];
1198           j = reg[Rrr];
1199           op = field1 >> 6;
1200           jump_address = ic;
1201           goto ccl_set_expr;
1202
1203         case CCL_ReadJumpCondExprConst: /* A--D--D--R--E--S--S-rrrXXXXX */
1204           CCL_READ_CHAR (reg[rrr]);
1205         case CCL_JumpCondExprConst: /* A--D--D--R--E--S--S-rrrXXXXX */
1206           i = reg[rrr];
1207           op = XINT (ccl_prog[ic]);
1208           jump_address = ic++ + ADDR;
1209           j = XINT (ccl_prog[ic]);
1210           ic++;
1211           rrr = 7;
1212           goto ccl_set_expr;
1213
1214         case CCL_ReadJumpCondExprReg: /* A--D--D--R--E--S--S-rrrXXXXX */
1215           CCL_READ_CHAR (reg[rrr]);
1216         case CCL_JumpCondExprReg:
1217           i = reg[rrr];
1218           op = XINT (ccl_prog[ic]);
1219           jump_address = ic++ + ADDR;
1220           j = reg[XINT (ccl_prog[ic])];
1221           ic++;
1222           rrr = 7;
1223
1224         ccl_set_expr:
1225           switch (op)
1226             {
1227             case CCL_PLUS: reg[rrr] = i + j; break;
1228             case CCL_MINUS: reg[rrr] = i - j; break;
1229             case CCL_MUL: reg[rrr] = i * j; break;
1230             case CCL_DIV: reg[rrr] = i / j; break;
1231             case CCL_MOD: reg[rrr] = i % j; break;
1232             case CCL_AND: reg[rrr] = i & j; break;
1233             case CCL_OR: reg[rrr] = i | j; break;
1234             case CCL_XOR: reg[rrr] = i ^ j;; break;
1235             case CCL_LSH: reg[rrr] = i << j; break;
1236             case CCL_RSH: reg[rrr] = i >> j; break;
1237             case CCL_LSH8: reg[rrr] = (i << 8) | j; break;
1238             case CCL_RSH8: reg[rrr] = i >> 8; reg[7] = i & 0xFF; break;
1239             case CCL_DIVMOD: reg[rrr] = i / j; reg[7] = i % j; break;
1240             case CCL_LS: reg[rrr] = i < j; break;
1241             case CCL_GT: reg[rrr] = i > j; break;
1242             case CCL_EQ: reg[rrr] = i == j; break;
1243             case CCL_LE: reg[rrr] = i <= j; break;
1244             case CCL_GE: reg[rrr] = i >= j; break;
1245             case CCL_NE: reg[rrr] = i != j; break;
1246             case CCL_DECODE_SJIS:
1247               /* DECODE_SJIS set MSB for internal format
1248                  as opposed to Emacs.  */
1249               DECODE_SJIS (i, j, reg[rrr], reg[7]);
1250               reg[rrr] &= 0x7F;
1251               reg[7] &= 0x7F;
1252               break;
1253             case CCL_ENCODE_SJIS:
1254               /* ENCODE_SJIS assumes MSB of SJIS-char is set
1255                  as opposed to Emacs.  */
1256               ENCODE_SJIS (i | 0x80, j | 0x80, reg[rrr], reg[7]);
1257               break;
1258             default: CCL_INVALID_CMD;
1259             }
1260           code &= 0x1F;
1261           if (code == CCL_WriteExprConst || code == CCL_WriteExprRegister)
1262             {
1263               i = reg[rrr];
1264               CCL_WRITE_CHAR (i);
1265               ic = jump_address;
1266             }
1267           else if (!reg[rrr])
1268             ic = jump_address;
1269           break;
1270
1271         case CCL_Extention:
1272           switch (EXCMD)
1273             {
1274 #ifndef UTF2000
1275             case CCL_ReadMultibyteChar2:
1276               if (!src)
1277                 CCL_INVALID_CMD;
1278
1279               do {
1280                 if (src >= src_end)
1281                   {
1282                     src++;
1283                     goto ccl_read_multibyte_character_suspend;
1284                   }
1285
1286                 i = *src++;
1287                 if (i < 0x80)
1288                   {
1289                     /* ASCII */
1290                     reg[rrr] = i;
1291                     reg[RRR] = LEADING_BYTE_ASCII;
1292                   }
1293                 else if (i <= MAX_LEADING_BYTE_OFFICIAL_1)
1294                   {
1295                     if (src >= src_end)
1296                       goto ccl_read_multibyte_character_suspend;
1297                     reg[RRR] = i;
1298                     reg[rrr] = (*src++ & 0x7F);
1299                   }
1300                 else if (i <= MAX_LEADING_BYTE_OFFICIAL_2)
1301                   {
1302                     if ((src + 1) >= src_end)
1303                       goto ccl_read_multibyte_character_suspend;
1304                     reg[RRR] = i;
1305                     i = (*src++ & 0x7F);
1306                     reg[rrr] = ((i << 7) | (*src & 0x7F));
1307                     src++;
1308                   }
1309                 else if (i == PRE_LEADING_BYTE_PRIVATE_1)
1310                   {
1311                     if ((src + 1) >= src_end)
1312                       goto ccl_read_multibyte_character_suspend;
1313                     reg[RRR] = *src++;
1314                     reg[rrr] = (*src++ & 0x7F);
1315                   }
1316                 else if (i == PRE_LEADING_BYTE_PRIVATE_2)
1317                   {
1318                     if ((src + 2) >= src_end)
1319                       goto ccl_read_multibyte_character_suspend;
1320                     reg[RRR] = *src++;
1321                     i = (*src++ & 0x7F);
1322                     reg[rrr] = ((i << 7) | (*src & 0x7F));
1323                     src++;
1324                   }
1325                 else
1326                   {
1327                     /* INVALID CODE.  Return a single byte character.  */
1328                     reg[RRR] = LEADING_BYTE_ASCII;
1329                     reg[rrr] = i;
1330                   }
1331                 break;
1332               } while (1);
1333               break;
1334
1335             ccl_read_multibyte_character_suspend:
1336               src--;
1337               if (ccl->last_block)
1338                 {
1339                   ic = ccl->eof_ic;
1340                   goto ccl_repeat;
1341                 }
1342               else
1343                 CCL_SUSPEND (CCL_STAT_SUSPEND_BY_SRC);
1344
1345               break;
1346 #endif
1347
1348 #ifndef UTF2000
1349             case CCL_WriteMultibyteChar2:
1350               i = reg[RRR]; /* charset */
1351               if (i == LEADING_BYTE_ASCII)
1352                 i = reg[rrr] & 0xFF;
1353               else if (XCHARSET_DIMENSION (CHARSET_BY_LEADING_BYTE (i)) == 1)
1354                 i = (((i - FIELD2_TO_OFFICIAL_LEADING_BYTE) << 7)
1355                      | (reg[rrr] & 0x7F));
1356               else if (i < MAX_LEADING_BYTE_OFFICIAL_2)
1357                 i = ((i - FIELD1_TO_OFFICIAL_LEADING_BYTE) << 14) | reg[rrr];
1358               else
1359                 i = ((i - FIELD1_TO_PRIVATE_LEADING_BYTE) << 14) | reg[rrr];
1360
1361               CCL_WRITE_CHAR (i);
1362
1363               break;
1364 #endif
1365
1366             case CCL_TranslateCharacter:
1367 #if 0
1368               /* XEmacs does not have translate_char, and its
1369                  equivalent nor.  We do nothing on this operation. */
1370               CCL_MAKE_CHAR (reg[RRR], reg[rrr], i);
1371               op = translate_char (GET_TRANSLATION_TABLE (reg[Rrr]),
1372                                    i, -1, 0, 0);
1373               SPLIT_CHAR (op, reg[RRR], i, j);
1374               if (j != -1)
1375                 i = (i << 7) | j;
1376
1377               reg[rrr] = i;
1378 #endif
1379               break;
1380
1381             case CCL_TranslateCharacterConstTbl:
1382 #if 0
1383               /* XEmacs does not have translate_char, and its
1384                  equivalent nor.  We do nothing on this operation. */
1385               op = XINT (ccl_prog[ic]); /* table */
1386               ic++;
1387               CCL_MAKE_CHAR (reg[RRR], reg[rrr], i);
1388               op = translate_char (GET_TRANSLATION_TABLE (op), i, -1, 0, 0);
1389               SPLIT_CHAR (op, reg[RRR], i, j);
1390               if (j != -1)
1391                 i = (i << 7) | j;
1392
1393               reg[rrr] = i;
1394 #endif
1395               break;
1396
1397             case CCL_IterateMultipleMap:
1398               {
1399                 Lisp_Object map, content, attrib, value;
1400                 int point, size, fin_ic;
1401
1402                 j = XINT (ccl_prog[ic++]); /* number of maps. */
1403                 fin_ic = ic + j;
1404                 op = reg[rrr];
1405                 if ((j > reg[RRR]) && (j >= 0))
1406                   {
1407                     ic += reg[RRR];
1408                     i = reg[RRR];
1409                   }
1410                 else
1411                   {
1412                     reg[RRR] = -1;
1413                     ic = fin_ic;
1414                     break;
1415                   }
1416
1417                 for (;i < j;i++)
1418                   {
1419
1420                     size = XVECTOR (Vcode_conversion_map_vector)->size;
1421                     point = XINT (ccl_prog[ic++]);
1422                     if (point >= size) continue;
1423                     map =
1424                       XVECTOR (Vcode_conversion_map_vector)->contents[point];
1425
1426                     /* Check map validity.  */
1427                     if (!CONSP (map)) continue;
1428                     map = XCDR (map);
1429                     if (!VECTORP (map)) continue;
1430                     size = XVECTOR (map)->size;
1431                     if (size <= 1) continue;
1432
1433                     content = XVECTOR (map)->contents[0];
1434
1435                     /* check map type,
1436                        [STARTPOINT VAL1 VAL2 ...] or
1437                        [t ELEMENT STARTPOINT ENDPOINT]  */
1438                     if (INTP (content))
1439                       {
1440                         point = XUINT (content);
1441                         point = op - point + 1;
1442                         if (!((point >= 1) && (point < size))) continue;
1443                         content = XVECTOR (map)->contents[point];
1444                       }
1445                     else if (EQ (content, Qt))
1446                       {
1447                         if (size != 4) continue;
1448                         if ((op >= XUINT (XVECTOR (map)->contents[2]))
1449                             && (op < XUINT (XVECTOR (map)->contents[3])))
1450                           content = XVECTOR (map)->contents[1];
1451                         else
1452                           continue;
1453                       }
1454                     else
1455                       continue;
1456
1457                     if (NILP (content))
1458                       continue;
1459                     else if (INTP (content))
1460                       {
1461                         reg[RRR] = i;
1462                         reg[rrr] = XINT(content);
1463                         break;
1464                       }
1465                     else if (EQ (content, Qt) || EQ (content, Qlambda))
1466                       {
1467                         reg[RRR] = i;
1468                         break;
1469                       }
1470                     else if (CONSP (content))
1471                       {
1472                         attrib = XCAR (content);
1473                         value = XCDR (content);
1474                         if (!INTP (attrib) || !INTP (value))
1475                           continue;
1476                         reg[RRR] = i;
1477                         reg[rrr] = XUINT (value);
1478                         break;
1479                       }
1480                     else if (SYMBOLP (content))
1481                       CCL_CALL_FOR_MAP_INSTRUCTION (content, fin_ic);
1482                     else
1483                       CCL_INVALID_CMD;
1484                   }
1485                 if (i == j)
1486                   reg[RRR] = -1;
1487                 ic = fin_ic;
1488               }
1489               break;
1490
1491             case CCL_MapMultiple:
1492               {
1493                 Lisp_Object map, content, attrib, value;
1494                 int point, size, map_vector_size;
1495                 int map_set_rest_length, fin_ic;
1496                 int current_ic = this_ic;
1497
1498                 /* inhibit recursive call on MapMultiple. */
1499                 if (stack_idx_of_map_multiple > 0)
1500                   {
1501                     if (stack_idx_of_map_multiple <= stack_idx)
1502                       {
1503                         stack_idx_of_map_multiple = 0;
1504                         mapping_stack_pointer = mapping_stack;
1505                         CCL_INVALID_CMD;
1506                       }
1507                   }
1508                 else
1509                   mapping_stack_pointer = mapping_stack;
1510                 stack_idx_of_map_multiple = 0;
1511
1512                 map_set_rest_length =
1513                   XINT (ccl_prog[ic++]); /* number of maps and separators. */
1514                 fin_ic = ic + map_set_rest_length;
1515                 op = reg[rrr];
1516
1517                 if ((map_set_rest_length > reg[RRR]) && (reg[RRR] >= 0))
1518                   {
1519                     ic += reg[RRR];
1520                     i = reg[RRR];
1521                     map_set_rest_length -= i;
1522                   }
1523                 else
1524                   {
1525                     ic = fin_ic;
1526                     reg[RRR] = -1;
1527                     mapping_stack_pointer = mapping_stack;
1528                     break;
1529                   }
1530
1531                 if (mapping_stack_pointer <= (mapping_stack + 1))
1532                   {
1533                     /* Set up initial state. */
1534                     mapping_stack_pointer = mapping_stack;
1535                     PUSH_MAPPING_STACK (0, op);
1536                     reg[RRR] = -1;
1537                   }
1538                 else
1539                   {
1540                     /* Recover after calling other ccl program. */
1541                     int orig_op;
1542
1543                     POP_MAPPING_STACK (map_set_rest_length, orig_op);
1544                     POP_MAPPING_STACK (map_set_rest_length, reg[rrr]);
1545                     switch (op)
1546                       {
1547                       case -1:
1548                         /* Regard it as Qnil. */
1549                         op = orig_op;
1550                         i++;
1551                         ic++;
1552                         map_set_rest_length--;
1553                         break;
1554                       case -2:
1555                         /* Regard it as Qt. */
1556                         op = reg[rrr];
1557                         i++;
1558                         ic++;
1559                         map_set_rest_length--;
1560                         break;
1561                       case -3:
1562                         /* Regard it as Qlambda. */
1563                         op = orig_op;
1564                         i += map_set_rest_length;
1565                         ic += map_set_rest_length;
1566                         map_set_rest_length = 0;
1567                         break;
1568                       default:
1569                         /* Regard it as normal mapping. */
1570                         i += map_set_rest_length;
1571                         ic += map_set_rest_length;
1572                         POP_MAPPING_STACK (map_set_rest_length, reg[rrr]);
1573                         break;
1574                       }
1575                   }
1576                 map_vector_size = XVECTOR (Vcode_conversion_map_vector)->size;
1577
1578                 do {
1579                   for (;map_set_rest_length > 0;i++, ic++, map_set_rest_length--)
1580                     {
1581                       point = XINT(ccl_prog[ic]);
1582                       if (point < 0)
1583                         {
1584                           /* +1 is for including separator. */
1585                           point = -point + 1;
1586                           if (mapping_stack_pointer
1587                               >= &mapping_stack[MAX_MAP_SET_LEVEL])
1588                             CCL_INVALID_CMD;
1589                           PUSH_MAPPING_STACK (map_set_rest_length - point,
1590                                               reg[rrr]);
1591                           map_set_rest_length = point;
1592                           reg[rrr] = op;
1593                           continue;
1594                         }
1595
1596                       if (point >= map_vector_size) continue;
1597                       map = (XVECTOR (Vcode_conversion_map_vector)
1598                              ->contents[point]);
1599
1600                       /* Check map validity.  */
1601                       if (!CONSP (map)) continue;
1602                       map = XCDR (map);
1603                       if (!VECTORP (map)) continue;
1604                       size = XVECTOR (map)->size;
1605                       if (size <= 1) continue;
1606
1607                       content = XVECTOR (map)->contents[0];
1608
1609                       /* check map type,
1610                          [STARTPOINT VAL1 VAL2 ...] or
1611                          [t ELEMENT STARTPOINT ENDPOINT]  */
1612                       if (INTP (content))
1613                         {
1614                           point = XUINT (content);
1615                           point = op - point + 1;
1616                           if (!((point >= 1) && (point < size))) continue;
1617                           content = XVECTOR (map)->contents[point];
1618                         }
1619                       else if (EQ (content, Qt))
1620                         {
1621                           if (size != 4) continue;
1622                           if ((op >= XUINT (XVECTOR (map)->contents[2])) &&
1623                               (op < XUINT (XVECTOR (map)->contents[3])))
1624                             content = XVECTOR (map)->contents[1];
1625                           else
1626                             continue;
1627                         }
1628                       else
1629                         continue;
1630
1631                       if (NILP (content))
1632                         continue;
1633
1634                       reg[RRR] = i;
1635                       if (INTP (content))
1636                         {
1637                           op = XINT (content);
1638                           i += map_set_rest_length - 1;
1639                           ic += map_set_rest_length - 1;
1640                           POP_MAPPING_STACK (map_set_rest_length, reg[rrr]);
1641                           map_set_rest_length++;
1642                         }
1643                       else if (CONSP (content))
1644                         {
1645                           attrib = XCAR (content);
1646                           value = XCDR (content);
1647                           if (!INTP (attrib) || !INTP (value))
1648                             continue;
1649                           op = XUINT (value);
1650                           i += map_set_rest_length - 1;
1651                           ic += map_set_rest_length - 1;
1652                           POP_MAPPING_STACK (map_set_rest_length, reg[rrr]);
1653                           map_set_rest_length++;
1654                         }
1655                       else if (EQ (content, Qt))
1656                         {
1657                           op = reg[rrr];
1658                         }
1659                       else if (EQ (content, Qlambda))
1660                         {
1661                           i += map_set_rest_length;
1662                           ic += map_set_rest_length;
1663                           break;
1664                         }
1665                       else if (SYMBOLP (content))
1666                         {
1667                           if (mapping_stack_pointer
1668                               >= &mapping_stack[MAX_MAP_SET_LEVEL])
1669                             CCL_INVALID_CMD;
1670                           PUSH_MAPPING_STACK (map_set_rest_length, reg[rrr]);
1671                           PUSH_MAPPING_STACK (map_set_rest_length, op);
1672                           stack_idx_of_map_multiple = stack_idx + 1;
1673                           CCL_CALL_FOR_MAP_INSTRUCTION (content, current_ic);
1674                         }
1675                       else
1676                         CCL_INVALID_CMD;
1677                     }
1678                   if (mapping_stack_pointer <= (mapping_stack + 1))
1679                     break;
1680                   POP_MAPPING_STACK (map_set_rest_length, reg[rrr]);
1681                   i += map_set_rest_length;
1682                   ic += map_set_rest_length;
1683                   POP_MAPPING_STACK (map_set_rest_length, reg[rrr]);
1684                 } while (1);
1685
1686                 ic = fin_ic;
1687               }
1688               reg[rrr] = op;
1689               break;
1690
1691             case CCL_MapSingle:
1692               {
1693                 Lisp_Object map, attrib, value, content;
1694                 int size, point;
1695                 j = XINT (ccl_prog[ic++]); /* map_id */
1696                 op = reg[rrr];
1697                 if (j >= XVECTOR (Vcode_conversion_map_vector)->size)
1698                   {
1699                     reg[RRR] = -1;
1700                     break;
1701                   }
1702                 map = XVECTOR (Vcode_conversion_map_vector)->contents[j];
1703                 if (!CONSP (map))
1704                   {
1705                     reg[RRR] = -1;
1706                     break;
1707                   }
1708                 map = XCDR (map);
1709                 if (!VECTORP (map))
1710                   {
1711                     reg[RRR] = -1;
1712                     break;
1713                   }
1714                 size = XVECTOR (map)->size;
1715                 point = XUINT (XVECTOR (map)->contents[0]);
1716                 point = op - point + 1;
1717                 reg[RRR] = 0;
1718                 if ((size <= 1) ||
1719                     (!((point >= 1) && (point < size))))
1720                   reg[RRR] = -1;
1721                 else
1722                   {
1723                     reg[RRR] = 0;
1724                     content = XVECTOR (map)->contents[point];
1725                     if (NILP (content))
1726                       reg[RRR] = -1;
1727                     else if (INTP (content))
1728                       reg[rrr] = XINT (content);
1729                     else if (EQ (content, Qt));
1730                     else if (CONSP (content))
1731                       {
1732                         attrib = XCAR (content);
1733                         value = XCDR (content);
1734                         if (!INTP (attrib) || !INTP (value))
1735                           continue;
1736                         reg[rrr] = XUINT(value);
1737                         break;
1738                       }
1739                     else if (SYMBOLP (content))
1740                       CCL_CALL_FOR_MAP_INSTRUCTION (content, ic);
1741                     else
1742                       reg[RRR] = -1;
1743                   }
1744               }
1745               break;
1746
1747             default:
1748               CCL_INVALID_CMD;
1749             }
1750           break;
1751
1752         default:
1753           CCL_INVALID_CMD;
1754         }
1755     }
1756
1757  ccl_error_handler:
1758   if (destination)
1759     {
1760       /* We can insert an error message only if DESTINATION is
1761          specified and we still have a room to store the message
1762          there.  */
1763       char msg[256];
1764
1765       switch (ccl->status)
1766         {
1767         case CCL_STAT_INVALID_CMD:
1768           sprintf(msg, "\nCCL: Invalid command %x (ccl_code = %x) at %d.",
1769                   code & 0x1F, code, this_ic);
1770 #ifdef CCL_DEBUG
1771           {
1772             int i = ccl_backtrace_idx - 1;
1773             int j;
1774
1775             Dynarr_add_many (destination, (unsigned char *) msg, strlen (msg));
1776
1777             for (j = 0; j < CCL_DEBUG_BACKTRACE_LEN; j++, i--)
1778               {
1779                 if (i < 0) i = CCL_DEBUG_BACKTRACE_LEN - 1;
1780                 if (ccl_backtrace_table[i] == 0)
1781                   break;
1782                 sprintf(msg, " %d", ccl_backtrace_table[i]);
1783                 Dynarr_add_many (destination, (unsigned char *) msg, strlen (msg));
1784               }
1785             goto ccl_finish;
1786           }
1787 #endif
1788           break;
1789
1790         case CCL_STAT_QUIT:
1791           sprintf(msg, "\nCCL: Exited.");
1792           break;
1793
1794         default:
1795           sprintf(msg, "\nCCL: Unknown error type (%d).", ccl->status);
1796         }
1797
1798       Dynarr_add_many (destination, (unsigned char *) msg, strlen (msg));
1799     }
1800
1801  ccl_finish:
1802   ccl->ic = ic;
1803   ccl->stack_idx = stack_idx;
1804   ccl->prog = ccl_prog;
1805   if (consumed) *consumed = src - source;
1806   if (!destination)
1807     return 0;
1808   return Dynarr_length (destination);
1809 }
1810
1811 /* Resolve symbols in the specified CCL code (Lisp vector).  This
1812    function converts symbols of code conversion maps and character
1813    translation tables embedded in the CCL code into their ID numbers.
1814
1815    The return value is a vector (CCL itself or a new vector in which
1816    all symbols are resolved), Qt if resolving of some symbol failed,
1817    or nil if CCL contains invalid data.  */
1818
1819 static Lisp_Object
1820 resolve_symbol_ccl_program (Lisp_Object ccl)
1821 {
1822   int i, veclen, unresolved = 0;
1823   Lisp_Object result, contents, val;
1824
1825   result = ccl;
1826   veclen = XVECTOR (result)->size;
1827
1828   for (i = 0; i < veclen; i++)
1829     {
1830       contents = XVECTOR (result)->contents[i];
1831       if (INTP (contents))
1832         continue;
1833       else if (CONSP (contents)
1834                && SYMBOLP (XCAR (contents))
1835                && SYMBOLP (XCDR (contents)))
1836         {
1837           /* This is the new style for embedding symbols.  The form is
1838              (SYMBOL . PROPERTY).  (get SYMBOL PROPERTY) should give
1839              an index number.  */
1840
1841           if (EQ (result, ccl))
1842             result =  Fcopy_sequence (ccl);
1843
1844           val = Fget (XCAR (contents), XCDR (contents), Qnil);
1845           if (NATNUMP (val))
1846             XVECTOR (result)->contents[i] = val;
1847           else
1848             unresolved = 1;
1849           continue;
1850         }
1851       else if (SYMBOLP (contents))
1852         {
1853           /* This is the old style for embedding symbols.  This style
1854              may lead to a bug if, for instance, a translation table
1855              and a code conversion map have the same name.  */
1856           if (EQ (result, ccl))
1857             result = Fcopy_sequence (ccl);
1858
1859           val = Fget (contents, Qcode_conversion_map_id, Qnil);
1860           if (NATNUMP (val))
1861             XVECTOR (result)->contents[i] = val;
1862           else
1863             {
1864               val = Fget (contents, Qccl_program_idx, Qnil);
1865               if (NATNUMP (val))
1866                 XVECTOR (result)->contents[i] = val;
1867               else
1868                 unresolved = 1;
1869             }
1870           continue;
1871         }
1872       return Qnil;
1873     }
1874
1875   return (unresolved ? Qt : result);
1876 }
1877
1878 /* Return the compiled code (vector) of CCL program CCL_PROG.
1879    CCL_PROG is a name (symbol) of the program or already compiled
1880    code.  If necessary, resolve symbols in the compiled code to index
1881    numbers.  If we failed to get the compiled code or to resolve
1882    symbols, return Qnil.  */
1883
1884 static Lisp_Object
1885 ccl_get_compiled_code (Lisp_Object ccl_prog)
1886 {
1887   Lisp_Object val, slot;
1888
1889   if (VECTORP (ccl_prog))
1890     {
1891       val = resolve_symbol_ccl_program (ccl_prog);
1892       return (VECTORP (val) ? val : Qnil);
1893     }
1894   if (!SYMBOLP (ccl_prog))
1895     return Qnil;
1896
1897   val = Fget (ccl_prog, Qccl_program_idx, Qnil);
1898   if (! NATNUMP (val)
1899       || XINT (val) >= XVECTOR_LENGTH (Vccl_program_table))
1900     return Qnil;
1901   slot = XVECTOR_DATA (Vccl_program_table)[XINT (val)];
1902   if (! VECTORP (slot)
1903       || XVECTOR (slot)->size != 3
1904       || ! VECTORP (XVECTOR_DATA (slot)[1]))
1905     return Qnil;
1906   if (NILP (XVECTOR_DATA (slot)[2]))
1907     {
1908       val = resolve_symbol_ccl_program (XVECTOR_DATA (slot)[1]);
1909       if (! VECTORP (val))
1910         return Qnil;
1911       XVECTOR_DATA (slot)[1] = val;
1912       XVECTOR_DATA (slot)[2] = Qt;
1913     }
1914   return XVECTOR_DATA (slot)[1];
1915 }
1916
1917 /* Setup fields of the structure pointed by CCL appropriately for the
1918    execution of CCL program CCL_PROG.  CCL_PROG is the name (symbol)
1919    of the CCL program or the already compiled code (vector).
1920    Return 0 if we succeed this setup, else return -1.
1921
1922    If CCL_PROG is nil, we just reset the structure pointed by CCL.  */
1923 int
1924 setup_ccl_program (struct ccl_program *ccl, Lisp_Object ccl_prog)
1925 {
1926   int i;
1927
1928   if (! NILP (ccl_prog))
1929     {
1930       ccl_prog = ccl_get_compiled_code (ccl_prog);
1931       if (! VECTORP (ccl_prog))
1932         return -1;
1933       ccl->size = XVECTOR_LENGTH (ccl_prog);
1934       ccl->prog = XVECTOR_DATA (ccl_prog);
1935       ccl->eof_ic = XINT (XVECTOR_DATA (ccl_prog)[CCL_HEADER_EOF]);
1936       ccl->buf_magnification = XINT (XVECTOR_DATA (ccl_prog)[CCL_HEADER_BUF_MAG]);
1937     }
1938   ccl->ic = CCL_HEADER_MAIN;
1939   for (i = 0; i < 8; i++)
1940     ccl->reg[i] = 0;
1941   ccl->last_block = 0;
1942   ccl->private_state = 0;
1943   ccl->status = 0;
1944   ccl->stack_idx = 0;
1945   ccl->eol_type = CCL_CODING_EOL_LF;
1946   return 0;
1947 }
1948
1949 #ifdef emacs
1950
1951 DEFUN ("ccl-program-p", Fccl_program_p, 1, 1, 0, /*
1952 Return t if OBJECT is a CCL program name or a compiled CCL program code.
1953 See the documentation of  `define-ccl-program' for the detail of CCL program.
1954 */
1955        (object))
1956 {
1957   Lisp_Object val;
1958
1959   if (VECTORP (object))
1960     {
1961       val = resolve_symbol_ccl_program (object);
1962       return (VECTORP (val) ? Qt : Qnil);
1963     }
1964   if (!SYMBOLP (object))
1965     return Qnil;
1966
1967   val = Fget (object, Qccl_program_idx, Qnil);
1968   return ((! NATNUMP (val)
1969            || XINT (val) >= XVECTOR_LENGTH (Vccl_program_table))
1970           ? Qnil : Qt);
1971 }
1972
1973 DEFUN ("ccl-execute", Fccl_execute, 2, 2, 0, /*
1974 Execute CCL-PROGRAM with registers initialized by REGISTERS.
1975
1976 CCL-PROGRAM is a CCL program name (symbol)
1977 or a compiled code generated by `ccl-compile' (for backward compatibility,
1978 in this case, the overhead of the execution is bigger than the former case).
1979 No I/O commands should appear in CCL-PROGRAM.
1980
1981 REGISTERS is a vector of [R0 R1 ... R7] where RN is an initial value
1982  of Nth register.
1983
1984 As side effect, each element of REGISTERS holds the value of
1985  corresponding register after the execution.
1986
1987 See the documentation of `define-ccl-program' for the detail of CCL program.
1988 */
1989        (ccl_prog, reg))
1990 {
1991   struct ccl_program ccl;
1992   int i;
1993
1994   if (setup_ccl_program (&ccl, ccl_prog) < 0)
1995     error ("Invalid CCL program");
1996
1997   CHECK_VECTOR (reg);
1998   if (XVECTOR_LENGTH (reg) != 8)
1999     error ("Length of vector REGISTERS is not 8");
2000
2001   for (i = 0; i < 8; i++)
2002     ccl.reg[i] = (INTP (XVECTOR_DATA (reg)[i])
2003                   ? XINT (XVECTOR_DATA (reg)[i])
2004                   : 0);
2005
2006   ccl_driver (&ccl, (const unsigned char *)0,
2007               (unsigned_char_dynarr *)0, 0, (int *)0,
2008               CCL_MODE_ENCODING);
2009   QUIT;
2010   if (ccl.status != CCL_STAT_SUCCESS)
2011     error ("Error in CCL program at %dth code", ccl.ic);
2012
2013   for (i = 0; i < 8; i++)
2014     XSETINT (XVECTOR (reg)->contents[i], ccl.reg[i]);
2015   return Qnil;
2016 }
2017
2018 DEFUN ("ccl-execute-on-string", Fccl_execute_on_string,
2019        3, 4, 0, /*
2020 Execute CCL-PROGRAM with initial STATUS on STRING.
2021
2022 CCL-PROGRAM is a symbol registered by register-ccl-program,
2023 or a compiled code generated by `ccl-compile' (for backward compatibility,
2024 in this case, the execution is slower).
2025
2026 Read buffer is set to STRING, and write buffer is allocated automatically.
2027
2028 STATUS is a vector of [R0 R1 ... R7 IC], where
2029  R0..R7 are initial values of corresponding registers,
2030  IC is the instruction counter specifying from where to start the program.
2031 If R0..R7 are nil, they are initialized to 0.
2032 If IC is nil, it is initialized to head of the CCL program.
2033
2034 If optional 4th arg CONTINUE is non-nil, keep IC on read operation
2035 when read buffer is exhausted, else, IC is always set to the end of
2036 CCL-PROGRAM on exit.
2037
2038 It returns the contents of write buffer as a string,
2039  and as side effect, STATUS is updated.
2040
2041 See the documentation of `define-ccl-program' for the detail of CCL program.
2042 */
2043        (ccl_prog, status, string, continue_))
2044 {
2045   Lisp_Object val;
2046   struct ccl_program ccl;
2047   int i, produced;
2048   unsigned_char_dynarr *outbuf;
2049   struct gcpro gcpro1, gcpro2;
2050
2051   if (setup_ccl_program (&ccl, ccl_prog) < 0)
2052     error ("Invalid CCL program");
2053
2054   CHECK_VECTOR (status);
2055   if (XVECTOR (status)->size != 9)
2056     error ("Length of vector STATUS is not 9");
2057   CHECK_STRING (string);
2058
2059   GCPRO2 (status, string);
2060
2061   for (i = 0; i < 8; i++)
2062     {
2063       if (NILP (XVECTOR_DATA (status)[i]))
2064         XSETINT (XVECTOR_DATA (status)[i], 0);
2065       if (INTP (XVECTOR_DATA (status)[i]))
2066         ccl.reg[i] = XINT (XVECTOR_DATA (status)[i]);
2067     }
2068   if (INTP (XVECTOR (status)->contents[i]))
2069     {
2070       i = XINT (XVECTOR_DATA (status)[8]);
2071       if (ccl.ic < i && i < ccl.size)
2072         ccl.ic = i;
2073     }
2074   outbuf = Dynarr_new (unsigned_char);
2075   ccl.last_block = NILP (continue_);
2076   produced = ccl_driver (&ccl, XSTRING_DATA (string), outbuf,
2077                          XSTRING_LENGTH (string),
2078                          (int *) 0,
2079                          CCL_MODE_DECODING);
2080   for (i = 0; i < 8; i++)
2081     XSETINT (XVECTOR_DATA (status)[i], ccl.reg[i]);
2082   XSETINT (XVECTOR_DATA (status)[8], ccl.ic);
2083   UNGCPRO;
2084
2085   val = make_string (Dynarr_atp (outbuf, 0), produced);
2086   Dynarr_free (outbuf);
2087   QUIT;
2088   if (ccl.status == CCL_STAT_SUSPEND_BY_DST)
2089     error ("Output buffer for the CCL programs overflow");
2090   if (ccl.status != CCL_STAT_SUCCESS
2091       && ccl.status != CCL_STAT_SUSPEND_BY_SRC)
2092     error ("Error in CCL program at %dth code", ccl.ic);
2093
2094   return val;
2095 }
2096
2097 DEFUN ("register-ccl-program", Fregister_ccl_program,
2098        2, 2, 0, /*
2099 Register CCL program CCL-PROG as NAME in `ccl-program-table'.
2100 CCL-PROG should be a compiled CCL program (vector), or nil.
2101 If it is nil, just reserve NAME as a CCL program name.
2102 Return index number of the registered CCL program.
2103 */
2104        (name, ccl_prog))
2105 {
2106   int len = XVECTOR_LENGTH (Vccl_program_table);
2107   int idx;
2108   Lisp_Object resolved;
2109
2110   CHECK_SYMBOL (name);
2111   resolved = Qnil;
2112   if (!NILP (ccl_prog))
2113     {
2114       CHECK_VECTOR (ccl_prog);
2115       resolved = resolve_symbol_ccl_program (ccl_prog);
2116       if (! NILP (resolved))
2117         {
2118           ccl_prog = resolved;
2119           resolved = Qt;
2120         }
2121     }
2122
2123   for (idx = 0; idx < len; idx++)
2124     {
2125       Lisp_Object slot;
2126
2127       slot = XVECTOR_DATA (Vccl_program_table)[idx];
2128       if (!VECTORP (slot))
2129         /* This is the first unused slot.  Register NAME here.  */
2130         break;
2131
2132       if (EQ (name, XVECTOR_DATA (slot)[0]))
2133         {
2134           /* Update this slot.  */
2135           XVECTOR_DATA (slot)[1] = ccl_prog;
2136           XVECTOR_DATA (slot)[2] = resolved;
2137           return make_int (idx);
2138         }
2139     }
2140
2141   if (idx == len)
2142     {
2143       /* Extend the table.  */
2144       Lisp_Object new_table;
2145       int j;
2146
2147       new_table = Fmake_vector (make_int (len * 2), Qnil);
2148       for (j = 0; j < len; j++)
2149         XVECTOR_DATA (new_table)[j]
2150           = XVECTOR_DATA (Vccl_program_table)[j];
2151       Vccl_program_table = new_table;
2152     }
2153
2154   {
2155     Lisp_Object elt;
2156
2157     elt = Fmake_vector (make_int (3), Qnil);
2158     XVECTOR_DATA (elt)[0] = name;
2159     XVECTOR_DATA (elt)[1] = ccl_prog;
2160     XVECTOR_DATA (elt)[2] = resolved;
2161     XVECTOR_DATA (Vccl_program_table)[idx] = elt;
2162   }
2163
2164   Fput (name, Qccl_program_idx, make_int (idx));
2165   return make_int (idx);
2166 }
2167
2168 /* Register code conversion map.
2169    A code conversion map consists of numbers, Qt, Qnil, and Qlambda.
2170    The first element is start code point.
2171    The rest elements are mapped numbers.
2172    Symbol t means to map to an original number before mapping.
2173    Symbol nil means that the corresponding element is empty.
2174    Symbol lambda means to terminate mapping here.
2175 */
2176
2177 DEFUN ("register-code-conversion-map", Fregister_code_conversion_map,
2178        2, 2, 0, /*
2179 Register SYMBOL as code conversion map MAP.
2180 Return index number of the registered map.
2181 */
2182        (symbol, map))
2183 {
2184   int len = XVECTOR_LENGTH (Vcode_conversion_map_vector);
2185   int i;
2186   Lisp_Object idx;
2187
2188   CHECK_SYMBOL (symbol);
2189   CHECK_VECTOR (map);
2190
2191   for (i = 0; i < len; i++)
2192     {
2193       Lisp_Object slot = XVECTOR_DATA (Vcode_conversion_map_vector)[i];
2194
2195       if (!CONSP (slot))
2196         break;
2197
2198       if (EQ (symbol, XCAR (slot)))
2199         {
2200           idx = make_int (i);
2201           XCDR (slot) = map;
2202           Fput (symbol, Qcode_conversion_map, map);
2203           Fput (symbol, Qcode_conversion_map_id, idx);
2204           return idx;
2205         }
2206     }
2207
2208   if (i == len)
2209     {
2210       Lisp_Object new_vector = Fmake_vector (make_int (len * 2), Qnil);
2211       int j;
2212
2213       for (j = 0; j < len; j++)
2214         XVECTOR_DATA (new_vector)[j]
2215           = XVECTOR_DATA (Vcode_conversion_map_vector)[j];
2216       Vcode_conversion_map_vector = new_vector;
2217     }
2218
2219   idx = make_int (i);
2220   Fput (symbol, Qcode_conversion_map, map);
2221   Fput (symbol, Qcode_conversion_map_id, idx);
2222   XVECTOR_DATA (Vcode_conversion_map_vector)[i] = Fcons (symbol, map);
2223   return idx;
2224 }
2225
2226
2227 void
2228 syms_of_mule_ccl (void)
2229 {
2230   DEFSUBR (Fccl_program_p);
2231   DEFSUBR (Fccl_execute);
2232   DEFSUBR (Fccl_execute_on_string);
2233   DEFSUBR (Fregister_ccl_program);
2234   DEFSUBR (Fregister_code_conversion_map);
2235 }
2236
2237 void
2238 vars_of_mule_ccl (void)
2239 {
2240   staticpro (&Vccl_program_table);
2241   Vccl_program_table = Fmake_vector (make_int (32), Qnil);
2242
2243   defsymbol (&Qccl_program, "ccl-program");
2244   defsymbol (&Qccl_program_idx, "ccl-program-idx");
2245   defsymbol (&Qcode_conversion_map, "code-conversion-map");
2246   defsymbol (&Qcode_conversion_map_id, "code-conversion-map-id");
2247
2248   DEFVAR_LISP ("code-conversion-map-vector", &Vcode_conversion_map_vector /*
2249 Vector of code conversion maps.
2250 */ );
2251   Vcode_conversion_map_vector = Fmake_vector (make_int (16), Qnil);
2252
2253   DEFVAR_LISP ("font-ccl-encoder-alist", &Vfont_ccl_encoder_alist /*
2254 Alist of fontname patterns vs corresponding CCL program.
2255 Each element looks like (REGEXP . CCL-CODE),
2256  where CCL-CODE is a compiled CCL program.
2257 When a font whose name matches REGEXP is used for displaying a character,
2258  CCL-CODE is executed to calculate the code point in the font
2259  from the charset number and position code(s) of the character which are set
2260  in CCL registers R0, R1, and R2 before the execution.
2261 The code point in the font is set in CCL registers R1 and R2
2262  when the execution terminated.
2263 If the font is single-byte font, the register R2 is not used.
2264 */ );
2265   Vfont_ccl_encoder_alist = Qnil;
2266 }
2267
2268 #endif  /* emacs */