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