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     for (i = 0; i < len; i++)                           \
 693       Dynarr_add(destination,                           \
 694                  (XINT (ccl_prog[ic + (i / 3)])         \
 695                   >> ((2 - (i % 3)) * 8)) & 0xFF);      \
 696 } while (0)
 697
 698 /* Read one byte from the current input buffer into Rth register.  */
 699 #define CCL_READ_CHAR(r) do {                   \
 700   if (!src && !ccl->last_block)                 \
 701     {                                           \
 702       ccl->status = CCL_STAT_INVALID_CMD;       \
 703       goto ccl_error_handler;                   \
 704     }                                           \
 705   else if (src < src_end)                       \
 706     r = *src++;                                 \
 707   else if (ccl->last_block)                     \
 708     {                                           \
 709       ic = ccl->eof_ic;                         \
 710       goto ccl_repeat;                          \
 711     }                                           \
 712   else                                          \
 713     /* Suspend CCL program because of           \
 714        reading from empty input buffer or       \
 715        writing to full output buffer.           \
 716        When this program is resumed, the        \
 717        same I/O command is executed.  */        \
 718     {                                           \
 719       ic--;                                     \
 720       ccl->status = CCL_STAT_SUSPEND_BY_SRC;    \
 721       goto ccl_finish;                          \
 722     }                                           \
 723 } while (0)
 724
 725
 726 /* Execute CCL code on SRC_BYTES length text at SOURCE.  The resulting
 727    text goes to a place pointed by DESTINATION. The bytes actually
 728    processed is returned as *CONSUMED.  The return value is the length
 729    of the resulting text.  As a side effect, the contents of CCL registers
 730    are updated.  If SOURCE or DESTINATION is NULL, only operations on
 731    registers are permitted.  */
 732
 733 #ifdef CCL_DEBUG
 734 #define CCL_DEBUG_BACKTRACE_LEN 256
 735 int ccl_backtrace_table[CCL_BACKTRACE_TABLE];
 736 int ccl_backtrace_idx;
 737 #endif
 738
 739 struct ccl_prog_stack
 740   {
 741     Lisp_Object *ccl_prog;      /* Pointer to an array of CCL code.  */
 742     int ic;                     /* Instruction Counter.  */
 743   };
 744
 745 /* For the moment, we only support depth 256 of stack.  */
 746 static struct ccl_prog_stack ccl_prog_stack_struct[256];
 747
 748 int
 749 ccl_driver (struct ccl_program *ccl, CONST unsigned char *source,
 750             unsigned_char_dynarr *destination, int src_bytes,
 751             int *consumed, int conversion_mode)
 752 {
 753   int *reg = ccl->reg;
 754   int ic = ccl->ic;
 755   int code = -1; /* init to illegal value,  */
 756   int field1, field2;
 757   Lisp_Object *ccl_prog = ccl->prog;
 758   CONST unsigned char *src = source, *src_end = src + src_bytes;
 759   int jump_address = 0; /* shut up the compiler */
 760   int i, j, op;
 761   int stack_idx = ccl->stack_idx;
 762   /* Instruction counter of the current CCL code. */
 763   int this_ic;
 764
 765   if (ic >= ccl->eof_ic)
 766     ic = CCL_HEADER_MAIN;
 767
 768 #if 0 /* not for XEmacs ? */
 769   if (ccl->buf_magnification ==0) /* We can't produce any bytes.  */
 770     dst = NULL;
 771 #endif
 772
 773 #ifdef CCL_DEBUG
 774   ccl_backtrace_idx = 0;
 775 #endif
 776
 777   for (;;)
 778     {
 779     ccl_repeat:
 780 #ifdef CCL_DEBUG
 781       ccl_backtrace_table[ccl_backtrace_idx++] = ic;
 782       if (ccl_backtrace_idx >= CCL_DEBUG_BACKTRACE_LEN)
 783         ccl_backtrace_idx = 0;
 784       ccl_backtrace_table[ccl_backtrace_idx] = 0;
 785 #endif
 786
 787       if (!NILP (Vquit_flag) && NILP (Vinhibit_quit))
 788         {
 789           /* We can't just signal Qquit, instead break the loop as if
 790              the whole data is processed.  Don't reset Vquit_flag, it
 791              must be handled later at a safer place.  */
 792           if (consumed)
 793             src = source + src_bytes;
 794           ccl->status = CCL_STAT_QUIT;
 795           break;
 796         }
 797
 798       this_ic = ic;
 799       code = XINT (ccl_prog[ic]); ic++;
 800       field1 = code >> 8;
 801       field2 = (code & 0xFF) >> 5;
 802
 803 #define rrr field2
 804 #define RRR (field1 & 7)
 805 #define Rrr ((field1 >> 3) & 7)
 806 #define ADDR field1
 807 #define EXCMD (field1 >> 6)
 808
 809       switch (code & 0x1F)
 810         {
 811         case CCL_SetRegister:   /* 00000000000000000RRRrrrXXXXX */
 812           reg[rrr] = reg[RRR];
 813           break;
 814
 815         case CCL_SetShortConst: /* CCCCCCCCCCCCCCCCCCCCrrrXXXXX */
 816           reg[rrr] = field1;
 817           break;
 818
 819         case CCL_SetConst:      /* 00000000000000000000rrrXXXXX */
 820           reg[rrr] = XINT (ccl_prog[ic]);
 821           ic++;
 822           break;
 823
 824         case CCL_SetArray:      /* CCCCCCCCCCCCCCCCCCCCRRRrrrXXXXX */
 825           i = reg[RRR];
 826           j = field1 >> 3;
 827           if ((unsigned int) i < j)
 828             reg[rrr] = XINT (ccl_prog[ic + i]);
 829           ic += j;
 830           break;
 831
 832         case CCL_Jump:          /* A--D--D--R--E--S--S-000XXXXX */
 833           ic += ADDR;
 834           break;
 835
 836         case CCL_JumpCond:      /* A--D--D--R--E--S--S-rrrXXXXX */
 837           if (!reg[rrr])
 838             ic += ADDR;
 839           break;
 840
 841         case CCL_WriteRegisterJump: /* A--D--D--R--E--S--S-rrrXXXXX */
 842           i = reg[rrr];
 843           CCL_WRITE_CHAR (i);
 844           ic += ADDR;
 845           break;
 846
 847         case CCL_WriteRegisterReadJump: /* A--D--D--R--E--S--S-rrrXXXXX */
 848           i = reg[rrr];
 849           CCL_WRITE_CHAR (i);
 850           ic++;
 851           CCL_READ_CHAR (reg[rrr]);
 852           ic += ADDR - 1;
 853           break;
 854
 855         case CCL_WriteConstJump: /* A--D--D--R--E--S--S-000XXXXX */
 856           i = XINT (ccl_prog[ic]);
 857           CCL_WRITE_CHAR (i);
 858           ic += ADDR;
 859           break;
 860
 861         case CCL_WriteConstReadJump: /* A--D--D--R--E--S--S-rrrXXXXX */
 862           i = XINT (ccl_prog[ic]);
 863           CCL_WRITE_CHAR (i);
 864           ic++;
 865           CCL_READ_CHAR (reg[rrr]);
 866           ic += ADDR - 1;
 867           break;
 868
 869         case CCL_WriteStringJump: /* A--D--D--R--E--S--S-000XXXXX */
 870           j = XINT (ccl_prog[ic]);
 871           ic++;
 872           CCL_WRITE_STRING (j);
 873           ic += ADDR - 1;
 874           break;
 875
 876         case CCL_WriteArrayReadJump: /* A--D--D--R--E--S--S-rrrXXXXX */
 877           i = reg[rrr];
 878           j = XINT (ccl_prog[ic]);
 879           if ((unsigned int) i < j)
 880             {
 881               i = XINT (ccl_prog[ic + 1 + i]);
 882               CCL_WRITE_CHAR (i);
 883             }
 884           ic += j + 2;
 885           CCL_READ_CHAR (reg[rrr]);
 886           ic += ADDR - (j + 2);
 887           break;
 888
 889         case CCL_ReadJump:      /* A--D--D--R--E--S--S-rrrYYYYY */
 890           CCL_READ_CHAR (reg[rrr]);
 891           ic += ADDR;
 892           break;
 893
 894         case CCL_ReadBranch:    /* CCCCCCCCCCCCCCCCCCCCrrrXXXXX */
 895           CCL_READ_CHAR (reg[rrr]);
 896           /* fall through ... */
 897         case CCL_Branch:        /* CCCCCCCCCCCCCCCCCCCCrrrXXXXX */
 898           if ((unsigned int) reg[rrr] < field1)
 899             ic += XINT (ccl_prog[ic + reg[rrr]]);
 900           else
 901             ic += XINT (ccl_prog[ic + field1]);
 902           break;
 903
 904         case CCL_ReadRegister:  /* CCCCCCCCCCCCCCCCCCCCrrXXXXX */
 905           while (1)
 906             {
 907               CCL_READ_CHAR (reg[rrr]);
 908               if (!field1) break;
 909               code = XINT (ccl_prog[ic]); ic++;
 910               field1 = code >> 8;
 911               field2 = (code & 0xFF) >> 5;
 912             }
 913           break;
 914
 915         case CCL_WriteExprConst:  /* 1:00000OPERATION000RRR000XXXXX */
 916           rrr = 7;
 917           i = reg[RRR];
 918           j = XINT (ccl_prog[ic]);
 919           op = field1 >> 6;
 920           ic++;
 921           goto ccl_set_expr;
 922
 923         case CCL_WriteRegister: /* CCCCCCCCCCCCCCCCCCCrrrXXXXX */
 924           while (1)
 925             {
 926               i = reg[rrr];
 927               CCL_WRITE_CHAR (i);
 928               if (!field1) break;
 929               code = XINT (ccl_prog[ic]); ic++;
 930               field1 = code >> 8;
 931               field2 = (code & 0xFF) >> 5;
 932             }
 933           break;
 934
 935         case CCL_WriteExprRegister: /* 1:00000OPERATIONRrrRRR000XXXXX */
 936           rrr = 7;
 937           i = reg[RRR];
 938           j = reg[Rrr];
 939           op = field1 >> 6;
 940           goto ccl_set_expr;
 941
 942         case CCL_Call:          /* CCCCCCCCCCCCCCCCCCCC000XXXXX */
 943           {
 944             Lisp_Object slot;
 945
 946             if (stack_idx >= 256
 947                 || field1 < 0
 948                 || field1 >= XVECTOR_LENGTH (Vccl_program_table)
 949                 || (slot = XVECTOR_DATA (Vccl_program_table)[field1],
 950                     !CONSP (slot))
 951                 || !VECTORP (XCDR (slot)))
 952               {
 953                 if (stack_idx > 0)
 954                   {
 955                     ccl_prog = ccl_prog_stack_struct[0].ccl_prog;
 956                     ic = ccl_prog_stack_struct[0].ic;
 957                   }
 958                 ccl->status = CCL_STAT_INVALID_CMD;
 959                 goto ccl_error_handler;
 960               }
 961
 962             ccl_prog_stack_struct[stack_idx].ccl_prog = ccl_prog;
 963             ccl_prog_stack_struct[stack_idx].ic = ic;
 964             stack_idx++;
 965             ccl_prog = XVECTOR_DATA (XCDR (slot));
 966             ic = CCL_HEADER_MAIN;
 967           }
 968           break;
 969
 970         case CCL_WriteConstString: /* CCCCCCCCCCCCCCCCCCCCrrrXXXXX */
 971           if (!rrr)
 972             CCL_WRITE_CHAR (field1);
 973           else
 974             {
 975               CCL_WRITE_STRING (field1);
 976               ic += (field1 + 2) / 3;
 977             }
 978           break;
 979
 980         case CCL_WriteArray:    /* CCCCCCCCCCCCCCCCCCCCrrrXXXXX */
 981           i = reg[rrr];
 982           if ((unsigned int) i < field1)
 983             {
 984               j = XINT (ccl_prog[ic + i]);
 985               CCL_WRITE_CHAR (j);
 986             }
 987           ic += field1;
 988           break;
 989
 990         case CCL_End:           /* 0000000000000000000000XXXXX */
 991           if (stack_idx-- > 0)
 992             {
 993               ccl_prog = ccl_prog_stack_struct[stack_idx].ccl_prog;
 994               ic = ccl_prog_stack_struct[stack_idx].ic;
 995               break;
 996             }
 997           if (src)
 998             src = src_end;
 999           /* ccl->ic should points to this command code again to
1000              suppress further processing.  */
1001           ic--;
1002           /* Terminate CCL program successfully.  */
1003           ccl->status = CCL_STAT_SUCCESS;
1004           goto ccl_finish;
1005
1006         case CCL_ExprSelfConst: /* 00000OPERATION000000rrrXXXXX */
1007           i = XINT (ccl_prog[ic]);
1008           ic++;
1009           op = field1 >> 6;
1010           goto ccl_expr_self;
1011
1012         case CCL_ExprSelfReg:   /* 00000OPERATION000RRRrrrXXXXX */
1013           i = reg[RRR];
1014           op = field1 >> 6;
1015
1016         ccl_expr_self:
1017           switch (op)
1018             {
1019             case CCL_PLUS: reg[rrr] += i; break;
1020             case CCL_MINUS: reg[rrr] -= i; break;
1021             case CCL_MUL: reg[rrr] *= i; break;
1022             case CCL_DIV: reg[rrr] /= i; break;
1023             case CCL_MOD: reg[rrr] %= i; break;
1024             case CCL_AND: reg[rrr] &= i; break;
1025             case CCL_OR: reg[rrr] |= i; break;
1026             case CCL_XOR: reg[rrr] ^= i; break;
1027             case CCL_LSH: reg[rrr] <<= i; break;
1028             case CCL_RSH: reg[rrr] >>= i; break;
1029             case CCL_LSH8: reg[rrr] <<= 8; reg[rrr] |= i; break;
1030             case CCL_RSH8: reg[7] = reg[rrr] & 0xFF; reg[rrr] >>= 8; break;
1031             case CCL_DIVMOD: reg[7] = reg[rrr] % i; reg[rrr] /= i; break;
1032             case CCL_LS: reg[rrr] = reg[rrr] < i; break;
1033             case CCL_GT: reg[rrr] = reg[rrr] > i; break;
1034             case CCL_EQ: reg[rrr] = reg[rrr] == i; break;
1035             case CCL_LE: reg[rrr] = reg[rrr] <= i; break;
1036             case CCL_GE: reg[rrr] = reg[rrr] >= i; break;
1037             case CCL_NE: reg[rrr] = reg[rrr] != i; break;
1038             default:
1039               ccl->status = CCL_STAT_INVALID_CMD;
1040               goto ccl_error_handler;
1041             }
1042           break;
1043
1044         case CCL_SetExprConst:  /* 00000OPERATION000RRRrrrXXXXX */
1045           i = reg[RRR];
1046           j = XINT (ccl_prog[ic]);
1047           op = field1 >> 6;
1048           jump_address = ++ic;
1049           goto ccl_set_expr;
1050
1051         case CCL_SetExprReg:    /* 00000OPERATIONRrrRRRrrrXXXXX */
1052           i = reg[RRR];
1053           j = reg[Rrr];
1054           op = field1 >> 6;
1055           jump_address = ic;
1056           goto ccl_set_expr;
1057
1058         case CCL_ReadJumpCondExprConst: /* A--D--D--R--E--S--S-rrrXXXXX */
1059           CCL_READ_CHAR (reg[rrr]);
1060         case CCL_JumpCondExprConst: /* A--D--D--R--E--S--S-rrrXXXXX */
1061           i = reg[rrr];
1062           op = XINT (ccl_prog[ic]);
1063           jump_address = ic++ + ADDR;
1064           j = XINT (ccl_prog[ic]);
1065           ic++;
1066           rrr = 7;
1067           goto ccl_set_expr;
1068
1069         case CCL_ReadJumpCondExprReg: /* A--D--D--R--E--S--S-rrrXXXXX */
1070           CCL_READ_CHAR (reg[rrr]);
1071         case CCL_JumpCondExprReg:
1072           i = reg[rrr];
1073           op = XINT (ccl_prog[ic]);
1074           jump_address = ic++ + ADDR;
1075           j = reg[XINT (ccl_prog[ic])];
1076           ic++;
1077           rrr = 7;
1078
1079         ccl_set_expr:
1080           switch (op)
1081             {
1082             case CCL_PLUS: reg[rrr] = i + j; break;
1083             case CCL_MINUS: reg[rrr] = i - j; break;
1084             case CCL_MUL: reg[rrr] = i * j; break;
1085             case CCL_DIV: reg[rrr] = i / j; break;
1086             case CCL_MOD: reg[rrr] = i % j; break;
1087             case CCL_AND: reg[rrr] = i & j; break;
1088             case CCL_OR: reg[rrr] = i | j; break;
1089             case CCL_XOR: reg[rrr] = i ^ j; break;
1090             case CCL_LSH: reg[rrr] = i << j; break;
1091             case CCL_RSH: reg[rrr] = i >> j; break;
1092             case CCL_LSH8: reg[rrr] = (i << 8) | j; break;
1093             case CCL_RSH8: reg[rrr] = i >> 8; reg[7] = i & 0xFF; break;
1094             case CCL_DIVMOD: reg[rrr] = i / j; reg[7] = i % j; break;
1095             case CCL_LS: reg[rrr] = i < j; break;
1096             case CCL_GT: reg[rrr] = i > j; break;
1097             case CCL_EQ: reg[rrr] = i == j; break;
1098             case CCL_LE: reg[rrr] = i <= j; break;
1099             case CCL_GE: reg[rrr] = i >= j; break;
1100             case CCL_NE: reg[rrr] = i != j; break;
1101             case CCL_DECODE_SJIS: DECODE_SJIS (i, j, reg[rrr], reg[7]); break;
1102             case CCL_ENCODE_SJIS: ENCODE_SJIS (i, j, reg[rrr], reg[7]); break;
1103             default:
1104               ccl->status = CCL_STAT_INVALID_CMD;
1105               goto ccl_error_handler;
1106             }
1107           code &= 0x1F;
1108           if (code == CCL_WriteExprConst || code == CCL_WriteExprRegister)
1109             {
1110               i = reg[rrr];
1111               CCL_WRITE_CHAR (i);
1112             }
1113           else if (!reg[rrr])
1114             ic = jump_address;
1115           break;
1116
1117         case CCL_Extention:
1118           switch (EXCMD)
1119             {
1120 #ifndef UTF2000
1121             case CCL_ReadMultibyteChar2:
1122               if (!src)
1123                 CCL_INVALID_CMD;
1124
1125               do {
1126                 if (src >= src_end)
1127                   {
1128                     src++;
1129                     goto ccl_read_multibyte_character_suspend;
1130                   }
1131
1132                 i = *src++;
1133 #if 0
1134                 if (i == LEADING_CODE_COMPOSITION)
1135                   {
1136                     if (src >= src_end)
1137                       goto ccl_read_multibyte_character_suspend;
1138                     if (*src == 0xFF)
1139                       {
1140                         ccl->private_state = COMPOSING_WITH_RULE_HEAD;
1141                         src++;
1142                       }
1143                     else
1144                       ccl->private_state = COMPOSING_NO_RULE_HEAD;
1145
1146                     continue;
1147                   }
1148                 if (ccl->private_state != COMPOSING_NO)
1149                   {
1150                     /* composite character */
1151                     if (i < 0xA0)
1152                       ccl->private_state = COMPOSING_NO;
1153                     else
1154                       {
1155                         if (COMPOSING_WITH_RULE_RULE == ccl->private_state)
1156                           {
1157                             ccl->private_state = COMPOSING_WITH_RULE_HEAD;
1158                             continue;
1159                           }
1160                         else if (COMPOSING_WITH_RULE_HEAD == ccl->private_state)
1161                           ccl->private_state = COMPOSING_WITH_RULE_RULE;
1162
1163                         if (i == 0xA0)
1164                           {
1165                             if (src >= src_end)
1166                               goto ccl_read_multibyte_character_suspend;
1167                             i = *src++ & 0x7F;
1168                           }
1169                         else
1170                           i -= 0x20;
1171                       }
1172                   }
1173 #endif
1174
1175                 if (i < 0x80)
1176                   {
1177                     /* ASCII */
1178                     reg[rrr] = i;
1179                     reg[RRR] = LEADING_BYTE_ASCII;
1180                   }
1181                 else if (i <= MAX_LEADING_BYTE_OFFICIAL_1)
1182                   {
1183                     if (src >= src_end)
1184                       goto ccl_read_multibyte_character_suspend;
1185                     reg[RRR] = i;
1186                     reg[rrr] = (*src++ & 0x7F);
1187                   }
1188                 else if (i <= MAX_LEADING_BYTE_OFFICIAL_2)
1189                   {
1190                     if ((src + 1) >= src_end)
1191                       goto ccl_read_multibyte_character_suspend;
1192                     reg[RRR] = i;
1193                     i = (*src++ & 0x7F);
1194                     reg[rrr] = ((i << 7) | (*src & 0x7F));
1195                     src++;
1196                   }
1197                 else if (i == PRE_LEADING_BYTE_PRIVATE_1)
1198                   {
1199                     if ((src + 1) >= src_end)
1200                       goto ccl_read_multibyte_character_suspend;
1201                     reg[RRR] = *src++;
1202                     reg[rrr] = (*src++ & 0x7F);
1203                   }
1204                 else if (i == PRE_LEADING_BYTE_PRIVATE_2)
1205                   {
1206                     if ((src + 2) >= src_end)
1207                       goto ccl_read_multibyte_character_suspend;
1208                     reg[RRR] = *src++;
1209                     i = (*src++ & 0x7F);
1210                     reg[rrr] = ((i << 7) | (*src & 0x7F));
1211                     src++;
1212                   }
1213                 else
1214                   {
1215                     /* INVALID CODE.  Return a single byte character.  */
1216                     reg[RRR] = LEADING_BYTE_ASCII;
1217                     reg[rrr] = i;
1218                   }
1219                 break;
1220               } while (1);
1221               break;
1222
1223             ccl_read_multibyte_character_suspend:
1224               src--;
1225               if (ccl->last_block)
1226                 {
1227                   ic = ccl->eof_ic;
1228                   goto ccl_repeat;
1229                 }
1230               else
1231                 CCL_SUSPEND (CCL_STAT_SUSPEND_BY_SRC);
1232
1233               break;
1234 #endif
1235
1236 #ifndef UTF2000
1237             case CCL_WriteMultibyteChar2:
1238               i = reg[RRR]; /* charset */
1239               if (i == LEADING_BYTE_ASCII)
1240                 i = reg[rrr] & 0xFF;
1241 #if 0
1242               else if (i == CHARSET_COMPOSITION)
1243                 i = MAKE_COMPOSITE_CHAR (reg[rrr]);
1244 #endif
1245               else if (XCHARSET_DIMENSION (CHARSET_BY_LEADING_BYTE (i)) == 1)
1246                 i = ((i - FIELD2_TO_OFFICIAL_LEADING_BYTE) << 7)
1247                   | (reg[rrr] & 0x7F);
1248               else if (i < MIN_LEADING_BYTE_OFFICIAL_2)
1249                 i = ((i - FIELD1_TO_OFFICIAL_LEADING_BYTE) << 14) | reg[rrr];
1250               else
1251                 i = ((i - FIELD1_TO_PRIVATE_LEADING_BYTE) << 14) | reg[rrr];
1252
1253               CCL_WRITE_CHAR (i);
1254
1255               break;
1256 #endif
1257
1258 #if 0
1259             case CCL_TranslateCharacter:
1260               i = reg[RRR]; /* charset */
1261               if (i == LEADING_BYTE_ASCII)
1262                 i = reg[rrr];
1263               else if (i == CHARSET_COMPOSITION)
1264                 {
1265                   reg[RRR] = -1;
1266                   break;
1267                 }
1268               else if (CHARSET_DIMENSION (i) == 1)
1269                 i = ((i - 0x70) << 7) | (reg[rrr] & 0x7F);
1270               else if (i < MIN_LEADING_BYTE_OFFICIAL_2)
1271                 i = ((i - 0x8F) << 14) | (reg[rrr] & 0x3FFF);
1272               else
1273                 i = ((i - 0xE0) << 14) | (reg[rrr] & 0x3FFF);
1274
1275               op = translate_char (GET_TRANSLATION_TABLE (reg[Rrr]),
1276                                    i, -1, 0, 0);
1277               SPLIT_CHAR (op, reg[RRR], i, j);
1278               if (j != -1)
1279                 i = (i << 7) | j;
1280
1281               reg[rrr] = i;
1282               break;
1283
1284             case CCL_TranslateCharacterConstTbl:
1285               op = XINT (ccl_prog[ic]); /* table */
1286               ic++;
1287               i = reg[RRR]; /* charset */
1288               if (i == LEADING_BYTE_ASCII)
1289                 i = reg[rrr];
1290               else if (i == CHARSET_COMPOSITION)
1291                 {
1292                   reg[RRR] = -1;
1293                   break;
1294                 }
1295               else if (CHARSET_DIMENSION (i) == 1)
1296                 i = ((i - 0x70) << 7) | (reg[rrr] & 0x7F);
1297               else if (i < MIN_LEADING_BYTE_OFFICIAL_2)
1298                 i = ((i - 0x8F) << 14) | (reg[rrr] & 0x3FFF);
1299               else
1300                 i = ((i - 0xE0) << 14) | (reg[rrr] & 0x3FFF);
1301
1302               op = translate_char (GET_TRANSLATION_TABLE (op), i, -1, 0, 0);
1303               SPLIT_CHAR (op, reg[RRR], i, j);
1304               if (j != -1)
1305                 i = (i << 7) | j;
1306
1307               reg[rrr] = i;
1308               break;
1309
1310             case CCL_IterateMultipleMap:
1311               {
1312                 Lisp_Object map, content, attrib, value;
1313                 int point, size, fin_ic;
1314
1315                 j = XINT (ccl_prog[ic++]); /* number of maps. */
1316                 fin_ic = ic + j;
1317                 op = reg[rrr];
1318                 if ((j > reg[RRR]) && (j >= 0))
1319                   {
1320                     ic += reg[RRR];
1321                     i = reg[RRR];
1322                   }
1323                 else
1324                   {
1325                     reg[RRR] = -1;
1326                     ic = fin_ic;
1327                     break;
1328                   }
1329
1330                 for (;i < j;i++)
1331                   {
1332
1333                     size = XVECTOR (Vcode_conversion_map_vector)->size;
1334                     point = XINT (ccl_prog[ic++]);
1335                     if (point >= size) continue;
1336                     map =
1337                       XVECTOR (Vcode_conversion_map_vector)->contents[point];
1338
1339                     /* Check map varidity.  */
1340                     if (!CONSP (map)) continue;
1341                     map = XCONS(map)->cdr;
1342                     if (!VECTORP (map)) continue;
1343                     size = XVECTOR (map)->size;
1344                     if (size <= 1) continue;
1345
1346                     content = XVECTOR (map)->contents[0];
1347
1348                     /* check map type,
1349                        [STARTPOINT VAL1 VAL2 ...] or
1350                        [t ELELMENT STARTPOINT ENDPOINT]  */
1351                     if (NUMBERP (content))
1352                       {
1353                         point = XUINT (content);
1354                         point = op - point + 1;
1355                         if (!((point >= 1) && (point < size))) continue;
1356                         content = XVECTOR (map)->contents[point];
1357                       }
1358                     else if (EQ (content, Qt))
1359                       {
1360                         if (size != 4) continue;
1361                         if ((op >= XUINT (XVECTOR (map)->contents[2]))
1362                             && (op < XUINT (XVECTOR (map)->contents[3])))
1363                           content = XVECTOR (map)->contents[1];
1364                         else
1365                           continue;
1366                       }
1367                     else
1368                       continue;
1369
1370                     if (NILP (content))
1371                       continue;
1372                     else if (NUMBERP (content))
1373                       {
1374                         reg[RRR] = i;
1375                         reg[rrr] = XINT(content);
1376                         break;
1377                       }
1378                     else if (EQ (content, Qt) || EQ (content, Qlambda))
1379                       {
1380                         reg[RRR] = i;
1381                         break;
1382                       }
1383                     else if (CONSP (content))
1384                       {
1385                         attrib = XCONS (content)->car;
1386                         value = XCONS (content)->cdr;
1387                         if (!NUMBERP (attrib) || !NUMBERP (value))
1388                           continue;
1389                         reg[RRR] = i;
1390                         reg[rrr] = XUINT (value);
1391                         break;
1392                       }
1393                   }
1394                 if (i == j)
1395                   reg[RRR] = -1;
1396                 ic = fin_ic;
1397               }
1398               break;
1399
1400             case CCL_MapMultiple:
1401               {
1402                 Lisp_Object map, content, attrib, value;
1403                 int point, size, map_vector_size;
1404                 int map_set_rest_length, fin_ic;
1405
1406                 map_set_rest_length =
1407                   XINT (ccl_prog[ic++]); /* number of maps and separators. */
1408                 fin_ic = ic + map_set_rest_length;
1409                 if ((map_set_rest_length > reg[RRR]) && (reg[RRR] >= 0))
1410                   {
1411                     ic += reg[RRR];
1412                     i = reg[RRR];
1413                     map_set_rest_length -= i;
1414                   }
1415                 else
1416                   {
1417                     ic = fin_ic;
1418                     reg[RRR] = -1;
1419                     break;
1420                   }
1421                 mapping_stack_pointer = mapping_stack;
1422                 op = reg[rrr];
1423                 PUSH_MAPPING_STACK (0, op);
1424                 reg[RRR] = -1;
1425                 map_vector_size = XVECTOR (Vcode_conversion_map_vector)->size;
1426                 for (;map_set_rest_length > 0;i++, map_set_rest_length--)
1427                   {
1428                     point = XINT(ccl_prog[ic++]);
1429                     if (point < 0)
1430                       {
1431                         point = -point;
1432                         if (mapping_stack_pointer
1433                             >= &mapping_stack[MAX_MAP_SET_LEVEL])
1434                           {
1435                             CCL_INVALID_CMD;
1436                           }
1437                         PUSH_MAPPING_STACK (map_set_rest_length - point,
1438                                             reg[rrr]);
1439                         map_set_rest_length = point + 1;
1440                         reg[rrr] = op;
1441                         continue;
1442                       }
1443
1444                     if (point >= map_vector_size) continue;
1445                     map = (XVECTOR (Vcode_conversion_map_vector)
1446                            ->contents[point]);
1447
1448                     /* Check map varidity.  */
1449                     if (!CONSP (map)) continue;
1450                     map = XCONS (map)->cdr;
1451                     if (!VECTORP (map)) continue;
1452                     size = XVECTOR (map)->size;
1453                     if (size <= 1) continue;
1454
1455                     content = XVECTOR (map)->contents[0];
1456
1457                     /* check map type,
1458                        [STARTPOINT VAL1 VAL2 ...] or
1459                        [t ELEMENT STARTPOINT ENDPOINT]  */
1460                     if (NUMBERP (content))
1461                       {
1462                         point = XUINT (content);
1463                         point = op - point + 1;
1464                         if (!((point >= 1) && (point < size))) continue;
1465                         content = XVECTOR (map)->contents[point];
1466                       }
1467                     else if (EQ (content, Qt))
1468                       {
1469                         if (size != 4) continue;
1470                         if ((op >= XUINT (XVECTOR (map)->contents[2])) &&
1471                             (op < XUINT (XVECTOR (map)->contents[3])))
1472                           content = XVECTOR (map)->contents[1];
1473                         else
1474                           continue;
1475                       }
1476                     else
1477                       continue;
1478
1479                     if (NILP (content))
1480                       continue;
1481                     else if (NUMBERP (content))
1482                       {
1483                         op = XINT (content);
1484                         reg[RRR] = i;
1485                         i += map_set_rest_length;
1486                         POP_MAPPING_STACK (map_set_rest_length, reg[rrr]);
1487                       }
1488                     else if (CONSP (content))
1489                       {
1490                         attrib = XCONS (content)->car;
1491                         value = XCONS (content)->cdr;
1492                         if (!NUMBERP (attrib) || !NUMBERP (value))
1493                           continue;
1494                         reg[RRR] = i;
1495                         op = XUINT (value);
1496                         i += map_set_rest_length;
1497                         POP_MAPPING_STACK (map_set_rest_length, reg[rrr]);
1498                       }
1499                     else if (EQ (content, Qt))
1500                       {
1501                         reg[RRR] = i;
1502                         op = reg[rrr];
1503                         i += map_set_rest_length;
1504                         POP_MAPPING_STACK (map_set_rest_length, reg[rrr]);
1505                       }
1506                     else if (EQ (content, Qlambda))
1507                       {
1508                         break;
1509                       }
1510                     else
1511                       CCL_INVALID_CMD;
1512                   }
1513                 ic = fin_ic;
1514               }
1515               reg[rrr] = op;
1516               break;
1517
1518             case CCL_MapSingle:
1519               {
1520                 Lisp_Object map, attrib, value, content;
1521                 int size, point;
1522                 j = XINT (ccl_prog[ic++]); /* map_id */
1523                 op = reg[rrr];
1524                 if (j >= XVECTOR (Vcode_conversion_map_vector)->size)
1525                   {
1526                     reg[RRR] = -1;
1527                     break;
1528                   }
1529                 map = XVECTOR (Vcode_conversion_map_vector)->contents[j];
1530                 if (!CONSP (map))
1531                   {
1532                     reg[RRR] = -1;
1533                     break;
1534                   }
1535                 map = XCONS(map)->cdr;
1536                 if (!VECTORP (map))
1537                   {
1538                     reg[RRR] = -1;
1539                     break;
1540                   }
1541                 size = XVECTOR (map)->size;
1542                 point = XUINT (XVECTOR (map)->contents[0]);
1543                 point = op - point + 1;
1544                 reg[RRR] = 0;
1545                 if ((size <= 1) ||
1546                     (!((point >= 1) && (point < size))))
1547                   reg[RRR] = -1;
1548                 else
1549                   {
1550                     content = XVECTOR (map)->contents[point];
1551                     if (NILP (content))
1552                       reg[RRR] = -1;
1553                     else if (NUMBERP (content))
1554                       reg[rrr] = XINT (content);
1555                     else if (EQ (content, Qt))
1556                       reg[RRR] = i;
1557                     else if (CONSP (content))
1558                       {
1559                         attrib = XCONS (content)->car;
1560                         value = XCONS (content)->cdr;
1561                         if (!NUMBERP (attrib) || !NUMBERP (value))
1562                           continue;
1563                         reg[rrr] = XUINT(value);
1564                         break;
1565                       }
1566                     else
1567                       reg[RRR] = -1;
1568                   }
1569               }
1570               break;
1571 #endif
1572
1573             default:
1574               CCL_INVALID_CMD;
1575             }
1576           break;
1577
1578         default:
1579           ccl->status = CCL_STAT_INVALID_CMD;
1580           goto ccl_error_handler;
1581         }
1582     }
1583
1584  ccl_error_handler:
1585   if (destination)
1586     {
1587       /* We can insert an error message only if DESTINATION is
1588          specified and we still have a room to store the message
1589          there.  */
1590       char msg[256];
1591
1592 #if 0 /* not for XEmacs ? */
1593       if (!dst)
1594         dst = destination;
1595 #endif
1596
1597       switch (ccl->status)
1598         {
1599           /* Terminate CCL program because of invalid command.
1600              Should not occur in the normal case.  */
1601         case CCL_STAT_INVALID_CMD:
1602           sprintf(msg, "\nCCL: Invalid command %x (ccl_code = %x) at %d.",
1603                   code & 0x1F, code, this_ic);
1604 #ifdef CCL_DEBUG
1605           {
1606             int i = ccl_backtrace_idx - 1;
1607             int j;
1608
1609             Dynarr_add_many (destination, (unsigned char *) msg, strlen (msg));
1610
1611             for (j = 0; j < CCL_DEBUG_BACKTRACE_LEN; j++, i--)
1612               {
1613                 if (i < 0) i = CCL_DEBUG_BACKTRACE_LEN - 1;
1614                 if (ccl_backtrace_table[i] == 0)
1615                   break;
1616                 sprintf(msg, " %d", ccl_backtrace_table[i]);
1617                 Dynarr_add_many (destination, (unsigned char *) msg, strlen (msg));
1618               }
1619             goto ccl_finish;
1620           }
1621 #endif
1622           break;
1623
1624         case CCL_STAT_QUIT:
1625           sprintf(msg, "\nCCL: Quited.");
1626           break;
1627
1628         default:
1629           sprintf(msg, "\nCCL: Unknown error type (%d).", ccl->status);
1630         }
1631
1632       Dynarr_add_many (destination, (unsigned char *) msg, strlen (msg));
1633     }
1634
1635  ccl_finish:
1636   ccl->ic = ic;
1637   ccl->stack_idx = stack_idx;
1638   ccl->prog = ccl_prog;
1639   if (consumed) *consumed = src - source;
1640   if (destination)
1641     return Dynarr_length (destination);
1642   else
1643     return 0;
1644 }
1645
1646 /* Setup fields of the structure pointed by CCL appropriately for the
1647    execution of compiled CCL code in VEC (vector of integer).
1648    If VEC is nil, we skip setting ups based on VEC.  */
1649 void
1650 setup_ccl_program (struct ccl_program *ccl, Lisp_Object vec)
1651 {
1652   int i;
1653
1654   if (VECTORP (vec))
1655     {
1656       ccl->size = XVECTOR_LENGTH (vec);
1657       ccl->prog = XVECTOR_DATA (vec);
1658       ccl->eof_ic = XINT (XVECTOR_DATA (vec)[CCL_HEADER_EOF]);
1659       ccl->buf_magnification = XINT (XVECTOR_DATA (vec)[CCL_HEADER_BUF_MAG]);
1660     }
1661   ccl->ic = CCL_HEADER_MAIN;
1662   for (i = 0; i < 8; i++)
1663     ccl->reg[i] = 0;
1664   ccl->last_block = 0;
1665   ccl->private_state = 0;
1666   ccl->status = 0;
1667   ccl->stack_idx = 0;
1668 }
1669
1670 /* Resolve symbols in the specified CCL code (Lisp vector).  This
1671    function converts symbols of code conversion maps and character
1672    translation tables embeded in the CCL code into their ID numbers.  */
1673
1674 Lisp_Object
1675 resolve_symbol_ccl_program (Lisp_Object ccl)
1676 {
1677   int i, veclen;
1678   Lisp_Object result, contents /*, prop */;
1679
1680   result = ccl;
1681   veclen = XVECTOR_LENGTH (result);
1682
1683   /* Set CCL program's table ID */
1684   for (i = 0; i < veclen; i++)
1685     {
1686       contents = XVECTOR_DATA (result)[i];
1687       if (SYMBOLP (contents))
1688         {
1689           if (EQ(result, ccl))
1690             result = Fcopy_sequence (ccl);
1691
1692 #if 0
1693           prop = Fget (contents, Qtranslation_table_id);
1694           if (NUMBERP (prop))
1695             {
1696               XVECTOR_DATA (result)[i] = prop;
1697               continue;
1698             }
1699           prop = Fget (contents, Qcode_conversion_map_id);
1700           if (NUMBERP (prop))
1701             {
1702               XVECTOR_DATA (result)[i] = prop;
1703               continue;
1704             }
1705           prop = Fget (contents, Qccl_program_idx);
1706           if (NUMBERP (prop))
1707             {
1708               XVECTOR_DATA (result)[i] = prop;
1709               continue;
1710             }
1711 #endif
1712         }
1713     }
1714
1715   return result;
1716 }
1717
1718
1719 #ifdef emacs
1720
1721 DEFUN ("ccl-execute", Fccl_execute, 2, 2, 0, /*
1722 Execute CCL-PROGRAM with registers initialized by REGISTERS.
1723
1724 CCL-PROGRAM is a symbol registered by register-ccl-program,
1725 or a compiled code generated by `ccl-compile' (for backward compatibility,
1726 in this case, the execution is slower).
1727 No I/O commands should appear in CCL-PROGRAM.
1728
1729 REGISTERS is a vector of [R0 R1 ... R7] where RN is an initial value
1730  of Nth register.
1731
1732 As side effect, each element of REGISTER holds the value of
1733  corresponding register after the execution.
1734 */
1735   (ccl_prog, reg))
1736 {
1737   struct ccl_program ccl;
1738   int i;
1739   Lisp_Object ccl_id;
1740
1741   if ((SYMBOLP (ccl_prog)) &&
1742       (!NILP (ccl_id = Fget (ccl_prog, Qccl_program_idx, Qnil))))
1743     {
1744       ccl_prog = XVECTOR_DATA (Vccl_program_table)[XUINT (ccl_id)];
1745       CHECK_LIST (ccl_prog);
1746       ccl_prog = XCDR (ccl_prog);
1747       CHECK_VECTOR (ccl_prog);
1748     }
1749   else
1750     {
1751       CHECK_VECTOR (ccl_prog);
1752       ccl_prog = resolve_symbol_ccl_program (ccl_prog);
1753     }
1754
1755   CHECK_VECTOR (reg);
1756   if (XVECTOR_LENGTH (reg) != 8)
1757     error ("Invalid length of vector REGISTERS");
1758
1759   setup_ccl_program (&ccl, ccl_prog);
1760   for (i = 0; i < 8; i++)
1761     ccl.reg[i] = (INTP (XVECTOR_DATA (reg)[i])
1762                   ? XINT (XVECTOR_DATA (reg)[i])
1763                   : 0);
1764
1765   ccl_driver (&ccl, (CONST unsigned char *)0, (unsigned_char_dynarr *)0,
1766               0, (int *)0, CCL_MODE_ENCODING);
1767   QUIT;
1768   if (ccl.status != CCL_STAT_SUCCESS)
1769     error ("Error in CCL program at %dth code", ccl.ic);
1770
1771   for (i = 0; i < 8; i++)
1772     XSETINT (XVECTOR_DATA (reg)[i], ccl.reg[i]);
1773   return Qnil;
1774 }
1775
1776 DEFUN ("ccl-execute-on-string", Fccl_execute_on_string, 3, 4, 0, /*
1777 Execute CCL-PROGRAM with initial STATUS on STRING.
1778
1779 CCL-PROGRAM is a symbol registered by register-ccl-program,
1780 or a compiled code generated by `ccl-compile' (for backward compatibility,
1781 in this case, the execution is slower).
1782
1783 Read buffer is set to STRING, and write buffer is allocated automatically.
1784
1785 If IC is nil, it is initialized to head of the CCL program.\n\
1786 STATUS is a vector of [R0 R1 ... R7 IC], where
1787  R0..R7 are initial values of corresponding registers,
1788  IC is the instruction counter specifying from where to start the program.
1789 If R0..R7 are nil, they are initialized to 0.
1790 If IC is nil, it is initialized to head of the CCL program.
1791
1792 If optional 4th arg CONTINUE is non-nil, keep IC on read operation
1793 when read buffer is exausted, else, IC is always set to the end of
1794 CCL-PROGRAM on exit.
1795
1796 It returns the contents of write buffer as a string,
1797  and as side effect, STATUS is updated.
1798 */
1799   (ccl_prog, status, str, contin))
1800 {
1801   Lisp_Object val;
1802   struct ccl_program ccl;
1803   int i, produced;
1804   unsigned_char_dynarr *outbuf;
1805   struct gcpro gcpro1, gcpro2, gcpro3;
1806   Lisp_Object ccl_id;
1807
1808   if ((SYMBOLP (ccl_prog)) &&
1809       (!NILP (ccl_id = Fget (ccl_prog, Qccl_program_idx, Qnil))))
1810     {
1811       ccl_prog = XVECTOR (Vccl_program_table)->contents[XUINT (ccl_id)];
1812       CHECK_LIST (ccl_prog);
1813       ccl_prog = XCDR (ccl_prog);
1814       CHECK_VECTOR (ccl_prog);
1815     }
1816   else
1817     {
1818       CHECK_VECTOR (ccl_prog);
1819       ccl_prog = resolve_symbol_ccl_program (ccl_prog);
1820     }
1821
1822   CHECK_VECTOR (status);
1823   if (XVECTOR_LENGTH (status) != 9)
1824     signal_simple_error ("Vector should be of length 9", status);
1825   CHECK_STRING (str);
1826   GCPRO3 (ccl_prog, status, str);
1827
1828   setup_ccl_program (&ccl, ccl_prog);
1829   for (i = 0; i < 8; i++)
1830     {
1831       if (NILP (XVECTOR_DATA (status)[i]))
1832         XSETINT (XVECTOR_DATA (status)[i], 0);
1833       if (INTP (XVECTOR_DATA (status)[i]))
1834         ccl.reg[i] = XINT (XVECTOR_DATA (status)[i]);
1835     }
1836   if (INTP (XVECTOR_DATA (status)[8]))
1837     {
1838       i = XINT (XVECTOR_DATA (status)[8]);
1839       if (ccl.ic < i && i < ccl.size)
1840         ccl.ic = i;
1841     }
1842   outbuf = Dynarr_new (unsigned_char);
1843   ccl.last_block = NILP (contin);
1844   produced = ccl_driver (&ccl, XSTRING_DATA (str), outbuf,
1845                          XSTRING_LENGTH (str), (int *)0, CCL_MODE_ENCODING);
1846   for (i = 0; i < 8; i++)
1847     XVECTOR_DATA (status)[i] = make_int(ccl.reg[i]);
1848   XSETINT (XVECTOR_DATA (status)[8], ccl.ic);
1849   UNGCPRO;
1850
1851   val = make_string (Dynarr_atp (outbuf, 0), produced);
1852   Dynarr_free (outbuf);
1853   QUIT;
1854   if (ccl.status != CCL_STAT_SUCCESS
1855       && ccl.status != CCL_STAT_SUSPEND_BY_SRC
1856       && ccl.status != CCL_STAT_SUSPEND_BY_DST)
1857     error ("Error in CCL program at %dth code", ccl.ic);
1858
1859   return val;
1860 }
1861
1862 DEFUN ("register-ccl-program", Fregister_ccl_program, 2, 2, 0, /*
1863 Register CCL program PROGRAM of NAME in `ccl-program-table'.
1864 PROGRAM should be a compiled code of CCL program, or nil.
1865 Return index number of the registered CCL program.
1866 */
1867   (name, ccl_prog))
1868 {
1869   int len = XVECTOR_LENGTH (Vccl_program_table);
1870   int i;
1871
1872   CHECK_SYMBOL (name);
1873   if (!NILP (ccl_prog))
1874     {
1875       CHECK_VECTOR (ccl_prog);
1876       ccl_prog = resolve_symbol_ccl_program (ccl_prog);
1877     }
1878
1879   for (i = 0; i < len; i++)
1880     {
1881       Lisp_Object slot = XVECTOR_DATA (Vccl_program_table)[i];
1882
1883       if (!CONSP (slot))
1884         break;
1885
1886       if (EQ (name, XCAR (slot)))
1887         {
1888           XCDR (slot) = ccl_prog;
1889           return make_int (i);
1890         }
1891     }
1892
1893   if (i == len)
1894     {
1895       Lisp_Object new_table = Fmake_vector (make_int (len * 2), Qnil);
1896       int j;
1897
1898       for (j = 0; j < len; j++)
1899         XVECTOR_DATA (new_table)[j]
1900           = XVECTOR_DATA (Vccl_program_table)[j];
1901       Vccl_program_table = new_table;
1902     }
1903
1904   XVECTOR_DATA (Vccl_program_table)[i] = Fcons (name, ccl_prog);
1905   Fput (name, Qccl_program_idx, make_int (i));
1906   return make_int (i);
1907 }
1908
1909 #if 0
1910 /* Register code conversion map.
1911    A code conversion map consists of numbers, Qt, Qnil, and Qlambda.
1912    The first element is start code point.
1913    The rest elements are mapped numbers.
1914    Symbol t means to map to an original number before mapping.
1915    Symbol nil means that the corresponding element is empty.
1916    Symbol lambda menas to terminate mapping here.
1917 */
1918
1919 DEFUN ("register-code-conversion-map", Fregister_code_conversion_map,
1920        Sregister_code_conversion_map,
1921        2, 2, 0,
1922   "Register SYMBOL as code conversion map MAP.\n\
1923 Return index number of the registered map.")
1924   (symbol, map)
1925      Lisp_Object symbol, map;
1926 {
1927   int len = XVECTOR (Vcode_conversion_map_vector)->size;
1928   int i;
1929   Lisp_Object index;
1930
1931   CHECK_SYMBOL (symbol, 0);
1932   CHECK_VECTOR (map, 1);
1933
1934   for (i = 0; i < len; i++)
1935     {
1936       Lisp_Object slot = XVECTOR (Vcode_conversion_map_vector)->contents[i];
1937
1938       if (!CONSP (slot))
1939         break;
1940
1941       if (EQ (symbol, XCONS (slot)->car))
1942         {
1943           index = make_int (i);
1944           XCONS (slot)->cdr = map;
1945           Fput (symbol, Qcode_conversion_map, map);
1946           Fput (symbol, Qcode_conversion_map_id, index);
1947           return index;
1948         }
1949     }
1950
1951   if (i == len)
1952     {
1953       Lisp_Object new_vector = Fmake_vector (make_int (len * 2), Qnil);
1954       int j;
1955
1956       for (j = 0; j < len; j++)
1957         XVECTOR (new_vector)->contents[j]
1958           = XVECTOR (Vcode_conversion_map_vector)->contents[j];
1959       Vcode_conversion_map_vector = new_vector;
1960     }
1961
1962   index = make_int (i);
1963   Fput (symbol, Qcode_conversion_map, map);
1964   Fput (symbol, Qcode_conversion_map_id, index);
1965   XVECTOR (Vcode_conversion_map_vector)->contents[i] = Fcons (symbol, map);
1966   return index;
1967 }
1968 #endif
1969
1970
1971 void
1972 syms_of_mule_ccl (void)
1973 {
1974   DEFSUBR (Fccl_execute);
1975   DEFSUBR (Fccl_execute_on_string);
1976   DEFSUBR (Fregister_ccl_program);
1977 #if 0
1978   DEFSUBR (&Fregister_code_conversion_map);
1979 #endif
1980 }
1981
1982 void
1983 vars_of_mule_ccl (void)
1984 {
1985   staticpro (&Vccl_program_table);
1986   Vccl_program_table = Fmake_vector (make_int (32), Qnil);
1987
1988   Qccl_program = intern ("ccl-program");
1989   staticpro (&Qccl_program);
1990
1991   Qccl_program_idx = intern ("ccl-program-idx");
1992   staticpro (&Qccl_program_idx);
1993
1994 #if 0
1995   Qcode_conversion_map = intern ("code-conversion-map");
1996   staticpro (&Qcode_conversion_map);
1997
1998   Qcode_conversion_map_id = intern ("code-conversion-map-id");
1999   staticpro (&Qcode_conversion_map_id);
2000
2001   DEFVAR_LISP ("code-conversion-map-vector", &Vcode_conversion_map_vector /*
2002 Vector of code conversion maps.*/ );
2003   Vcode_conversion_map_vector = Fmake_vector (make_int (16), Qnil);
2004 #endif
2005
2006   DEFVAR_LISP ("font-ccl-encoder-alist", &Vfont_ccl_encoder_alist /*
2007 Alist of fontname patterns vs corresponding CCL program.
2008 Each element looks like (REGEXP . CCL-CODE),
2009  where CCL-CODE is a compiled CCL program.
2010 When a font whose name matches REGEXP is used for displaying a character,
2011  CCL-CODE is executed to calculate the code point in the font
2012  from the charset number and position code(s) of the character which are set
2013  in CCL registers R0, R1, and R2 before the execution.
2014 The code point in the font is set in CCL registers R1 and R2
2015  when the execution terminated.
2016 If the font is single-byte font, the register R2 is not used.
2017 */ );
2018   Vfont_ccl_encoder_alist = Qnil;
2019 }
2020
2021 #endif  /* emacs */