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