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

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