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

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