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