Mercurial > hg > xemacs-beta

comparison src/mule-ccl.c @ 213:78f53ef88e17 r20-4b5

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r20-4b5
author cvs
date Mon, 13 Aug 2007 10:06:47 +0200
parents 3d6bfa290dbd
children f955c73f5258
comparison
equal deleted inserted replaced
212:d8688acf4c5b 213:78f53ef88e17
1 /* CCL -- Code Conversion Language Interpreter 1 /* CCL (Code Conversion Language) interpreter.
2 Copyright (C) 1992, 1995 Free Software Foundation, Inc. 2 Copyright (C) 1995, 1997 Electrotechnical Laboratory, JAPAN.
3 Copyright (C) 1995 Sun Microsystems, Inc. 3 Licensed to the Free Software Foundation.
4 4
5 This file is part of XEmacs. 5 This file is part of XEmacs.
6 6
7 XEmacs is free software; you can redistribute it and/or modify it 7 GNU Emacs is free software; you can redistribute it and/or modify
8 under the terms of the GNU General Public License as published by the 8 it under the terms of the GNU General Public License as published by
9 Free Software Foundation; either version 2, or (at your option) any 9 the Free Software Foundation; either version 2, or (at your option)
10 later version. 10 any later version.
11 11
12 XEmacs is distributed in the hope that it will be useful, but WITHOUT 12 GNU Emacs is distributed in the hope that it will be useful,
13 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or 13 but WITHOUT ANY WARRANTY; without even the implied warranty of
14 FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License 14 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 for more details. 15 GNU General Public License for more details.
16 16
17 You should have received a copy of the GNU General Public License 17 You should have received a copy of the GNU General Public License
18 along with XEmacs; see the file COPYING. If not, write to 18 along with GNU Emacs; see the file COPYING. If not, write to
19 the Free Software Foundation, Inc., 59 Temple Place - Suite 330, 19 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
20 Boston, MA 02111-1307, USA. */ 20 Boston, MA 02111-1307, USA. */
21 21
22 /* Synched up with: Mule 2.3. Not in FSF. */ 22 /* Synched up with : FSF Emacs 20.2 */
23
24 #include <stdio.h>
25
26 #ifdef emacs
23 27
24 #include <config.h> 28 #include <config.h>
25 #include "lisp.h" 29 #include "lisp.h"
26
27 #include "buffer.h" 30 #include "buffer.h"
31 #include "mule-charset.h"
32 #include "mule-ccl.h"
28 #include "mule-coding.h" 33 #include "mule-coding.h"
29 34
30 /* CCL operators */ 35 #else /* not emacs */
31 #define CCL_SetCS 0x00 36
32 #define CCL_SetCL 0x01 37 #include "mulelib.h"
33 #define CCL_SetR 0x02 38
34 #define CCL_SetA 0x03 39 #endif /* not emacs */
35 #define CCL_Jump 0x04 40
36 #define CCL_JumpCond 0x05 41 /* Alist of fontname patterns vs corresponding CCL program. */
37 #define CCL_WriteJump 0x06 42 Lisp_Object Vfont_ccl_encoder_alist;
38 #define CCL_WriteReadJump 0x07 43
39 #define CCL_WriteCJump 0x08 44 /* Vector of CCL program names vs corresponding program data. */
40 #define CCL_WriteCReadJump 0x09 45 Lisp_Object Vccl_program_table;
41 #define CCL_WriteSJump 0x0A 46
42 #define CCL_WriteSReadJump 0x0B 47 /* CCL (Code Conversion Language) is a simple language which has
43 #define CCL_WriteAReadJump 0x0C 48 operations on one input buffer, one output buffer, and 7 registers.
44 #define CCL_Branch 0x0D 49 The syntax of CCL is described in `ccl.el'. Emacs Lisp function
45 #define CCL_Read1 0x0E 50 `ccl-compile' compiles a CCL program and produces a CCL code which
46 #define CCL_Read2 0x0F 51 is a vector of integers. The structure of this vector is as
47 #define CCL_ReadBranch 0x10 52 follows: The 1st element: buffer-magnification, a factor for the
48 #define CCL_Write1 0x11 53 size of output buffer compared with the size of input buffer. The
49 #define CCL_Write2 0x12 54 2nd element: address of CCL code to be executed when encountered
50 #define CCL_WriteC 0x13 55 with end of input stream. The 3rd and the remaining elements: CCL
51 #define CCL_WriteS 0x14 56 codes. */
52 #define CCL_WriteA 0x15
53 #define CCL_End 0x16
54 #define CCL_SetSelfCS 0x17
55 #define CCL_SetSelfCL 0x18
56 #define CCL_SetSelfR 0x19
57 #define CCL_SetExprCL 0x1A
58 #define CCL_SetExprR 0x1B
59 #define CCL_JumpCondC 0x1C
60 #define CCL_JumpCondR 0x1D
61 #define CCL_ReadJumpCondC 0x1E
62 #define CCL_ReadJumpCondR 0x1F
63
64 #define CCL_PLUS 0x00
65 #define CCL_MINUS 0x01
66 #define CCL_MUL 0x02
67 #define CCL_DIV 0x03
68 #define CCL_MOD 0x04
69 #define CCL_AND 0x05
70 #define CCL_OR 0x06
71 #define CCL_XOR 0x07
72 #define CCL_LSH 0x08
73 #define CCL_RSH 0x09
74 #define CCL_LSH8 0x0A
75 #define CCL_RSH8 0x0B
76 #define CCL_DIVMOD 0x0C
77 #define CCL_LS 0x10
78 #define CCL_GT 0x11
79 #define CCL_EQ 0x12
80 #define CCL_LE 0x13
81 #define CCL_GE 0x14
82 #define CCL_NE 0x15
83 57
84 /* Header of CCL compiled code */ 58 /* Header of CCL compiled code */
85 #define CCL_HEADER_EOF 0 59 #define CCL_HEADER_BUF_MAG 0
86 #define CCL_HEADER_MAIN 1 60 #define CCL_HEADER_EOF 1
87 61 #define CCL_HEADER_MAIN 2
88 #define CCL_STAT_SUCCESS 0 62
89 #define CCL_STAT_SUSPEND 1 63 /* CCL code is a sequence of 28-bit non-negative integers (i.e. the
90 #define CCL_STAT_INVALID_CMD 2 64 MSB is always 0), each contains CCL command and/or arguments in the
91 65 following format:
92 #define CCL_SUCCESS \ 66
93 ccl->status = CCL_STAT_SUCCESS; \ 67 |----------------- integer (28-bit) ------------------|
94 goto ccl_finish 68 |------- 17-bit ------|- 3-bit --|- 3-bit --|- 5-bit -|
95 #define CCL_SUSPEND \ 69 |--constant argument--|-register-|-register-|-command-|
96 ccl->ic = --ic; \ 70 ccccccccccccccccc RRR rrr XXXXX
97 ccl->status = CCL_STAT_SUSPEND; \ 71 or
98 goto ccl_finish 72 |------- relative address -------|-register-|-command-|
99 #define CCL_INVALID_CMD \ 73 cccccccccccccccccccc rrr XXXXX
100 ccl->status = CCL_STAT_INVALID_CMD; \ 74 or
101 goto ccl_error_handler 75 |------------- constant or other args ----------------|
102 76 cccccccccccccccccccccccccccc
103 #define CCL_WRITE_CHAR(ch) do \ 77
104 { \ 78 where, `cc...c' is a non-negative integer indicating constant value
105 if (!src) \ 79 (the left most `c' is always 0) or an absolute jump address, `RRR'
106 { \ 80 and `rrr' are CCL register number, `XXXXX' is one of the following
81 CCL commands. */
82
83 /* CCL commands
84
85 Each comment fields shows one or more lines for command syntax and
86 the following lines for semantics of the command. In semantics, IC
87 stands for Instruction Counter. */
88
89 #define CCL_SetRegister 0x00 /* Set register a register value:
90 1:00000000000000000RRRrrrXXXXX
91 ------------------------------
92 reg[rrr] = reg[RRR];
93 */
94
95 #define CCL_SetShortConst 0x01 /* Set register a short constant value:
96 1:CCCCCCCCCCCCCCCCCCCCrrrXXXXX
97 ------------------------------
98 reg[rrr] = CCCCCCCCCCCCCCCCCCC;
99 */
100
101 #define CCL_SetConst 0x02 /* Set register a constant value:
102 1:00000000000000000000rrrXXXXX
103 2:CONSTANT
104 ------------------------------
105 reg[rrr] = CONSTANT;
106 IC++;
107 */
108
109 #define CCL_SetArray 0x03 /* Set register an element of array:
110 1:CCCCCCCCCCCCCCCCCRRRrrrXXXXX
111 2:ELEMENT[0]
112 3:ELEMENT[1]
113 ...
114 ------------------------------
115 if (0 <= reg[RRR] < CC..C)
116 reg[rrr] = ELEMENT[reg[RRR]];
117 IC += CC..C;
118 */
119
120 #define CCL_Jump 0x04 /* Jump:
121 1:A--D--D--R--E--S--S-000XXXXX
122 ------------------------------
123 IC += ADDRESS;
124 */
125
126 /* Note: If CC..C is greater than 0, the second code is omitted. */
127
128 #define CCL_JumpCond 0x05 /* Jump conditional:
129 1:A--D--D--R--E--S--S-rrrXXXXX
130 ------------------------------
131 if (!reg[rrr])
132 IC += ADDRESS;
133 */
134
135
136 #define CCL_WriteRegisterJump 0x06 /* Write register and jump:
137 1:A--D--D--R--E--S--S-rrrXXXXX
138 ------------------------------
139 write (reg[rrr]);
140 IC += ADDRESS;
141 */
142
143 #define CCL_WriteRegisterReadJump 0x07 /* Write register, read, and jump:
144 1:A--D--D--R--E--S--S-rrrXXXXX
145 2:A--D--D--R--E--S--S-rrrYYYYY
146 -----------------------------
147 write (reg[rrr]);
148 IC++;
149 read (reg[rrr]);
150 IC += ADDRESS;
151 */
152 /* Note: If read is suspended, the resumed execution starts from the
153 second code (YYYYY == CCL_ReadJump). */
154
155 #define CCL_WriteConstJump 0x08 /* Write constant and jump:
156 1:A--D--D--R--E--S--S-000XXXXX
157 2:CONST
158 ------------------------------
159 write (CONST);
160 IC += ADDRESS;
161 */
162
163 #define CCL_WriteConstReadJump 0x09 /* Write constant, read, and jump:
164 1:A--D--D--R--E--S--S-rrrXXXXX
165 2:CONST
166 3:A--D--D--R--E--S--S-rrrYYYYY
167 -----------------------------
168 write (CONST);
169 IC += 2;
170 read (reg[rrr]);
171 IC += ADDRESS;
172 */
173 /* Note: If read is suspended, the resumed execution starts from the
174 second code (YYYYY == CCL_ReadJump). */
175
176 #define CCL_WriteStringJump 0x0A /* Write string and jump:
177 1:A--D--D--R--E--S--S-000XXXXX
178 2:LENGTH
179 3:0000STRIN[0]STRIN[1]STRIN[2]
180 ...
181 ------------------------------
182 write_string (STRING, LENGTH);
183 IC += ADDRESS;
184 */
185
186 #define CCL_WriteArrayReadJump 0x0B /* Write an array element, read, and jump:
187 1:A--D--D--R--E--S--S-rrrXXXXX
188 2:LENGTH
189 3:ELEMENET[0]
190 4:ELEMENET[1]
191 ...
192 N:A--D--D--R--E--S--S-rrrYYYYY
193 ------------------------------
194 if (0 <= reg[rrr] < LENGTH)
195 write (ELEMENT[reg[rrr]]);
196 IC += LENGTH + 2; (... pointing at N+1)
197 read (reg[rrr]);
198 IC += ADDRESS;
199 */
200 /* Note: If read is suspended, the resumed execution starts from the
201 Nth code (YYYYY == CCL_ReadJump). */
202
203 #define CCL_ReadJump 0x0C /* Read and jump:
204 1:A--D--D--R--E--S--S-rrrYYYYY
205 -----------------------------
206 read (reg[rrr]);
207 IC += ADDRESS;
208 */
209
210 #define CCL_Branch 0x0D /* Jump by branch table:
211 1:CCCCCCCCCCCCCCCCCCCCrrrXXXXX
212 2:A--D--D--R--E-S-S[0]000XXXXX
213 3:A--D--D--R--E-S-S[1]000XXXXX
214 ...
215 ------------------------------
216 if (0 <= reg[rrr] < CC..C)
217 IC += ADDRESS[reg[rrr]];
218 else
219 IC += ADDRESS[CC..C];
220 */
221
222 #define CCL_ReadRegister 0x0E /* Read bytes into registers:
223 1:CCCCCCCCCCCCCCCCCCCCrrrXXXXX
224 2:CCCCCCCCCCCCCCCCCCCCrrrXXXXX
225 ...
226 ------------------------------
227 while (CCC--)
228 read (reg[rrr]);
229 */
230
231 #define CCL_WriteExprConst 0x0F /* write result of expression:
232 1:00000OPERATION000RRR000XXXXX
233 2:CONSTANT
234 ------------------------------
235 write (reg[RRR] OPERATION CONSTANT);
236 IC++;
237 */
238
239 /* Note: If the Nth read is suspended, the resumed execution starts
240 from the Nth code. */
241
242 #define CCL_ReadBranch 0x10 /* Read one byte into a register,
243 and jump by branch table:
244 1:CCCCCCCCCCCCCCCCCCCCrrrXXXXX
245 2:A--D--D--R--E-S-S[0]000XXXXX
246 3:A--D--D--R--E-S-S[1]000XXXXX
247 ...
248 ------------------------------
249 read (read[rrr]);
250 if (0 <= reg[rrr] < CC..C)
251 IC += ADDRESS[reg[rrr]];
252 else
253 IC += ADDRESS[CC..C];
254 */
255
256 #define CCL_WriteRegister 0x11 /* Write registers:
257 1:CCCCCCCCCCCCCCCCCCCrrrXXXXX
258 2:CCCCCCCCCCCCCCCCCCCrrrXXXXX
259 ...
260 ------------------------------
261 while (CCC--)
262 write (reg[rrr]);
263 ...
264 */
265
266 /* Note: If the Nth write is suspended, the resumed execution
267 starts from the Nth code. */
268
269 #define CCL_WriteExprRegister 0x12 /* Write result of expression
270 1:00000OPERATIONRrrRRR000XXXXX
271 ------------------------------
272 write (reg[RRR] OPERATION reg[Rrr]);
273 */
274
275 #define CCL_Call 0x13 /* Write a constant:
276 1:CCCCCCCCCCCCCCCCCCCC000XXXXX
277 ------------------------------
278 call (CC..C)
279 */
280
281 #define CCL_WriteConstString 0x14 /* Write a constant or a string:
282 1:CCCCCCCCCCCCCCCCCCCCrrrXXXXX
283 [2:0000STRIN[0]STRIN[1]STRIN[2]]
284 [...]
285 -----------------------------
286 if (!rrr)
287 write (CC..C)
288 else
289 write_string (STRING, CC..C);
290 IC += (CC..C + 2) / 3;
291 */
292
293 #define CCL_WriteArray 0x15 /* Write an element of array:
294 1:CCCCCCCCCCCCCCCCCCCCrrrXXXXX
295 2:ELEMENT[0]
296 3:ELEMENT[1]
297 ...
298 ------------------------------
299 if (0 <= reg[rrr] < CC..C)
300 write (ELEMENT[reg[rrr]]);
301 IC += CC..C;
302 */
303
304 #define CCL_End 0x16 /* Terminate:
305 1:00000000000000000000000XXXXX
306 ------------------------------
307 terminate ();
308 */
309
310 /* The following two codes execute an assignment arithmetic/logical
311 operation. The form of the operation is like REG OP= OPERAND. */
312
313 #define CCL_ExprSelfConst 0x17 /* REG OP= constant:
314 1:00000OPERATION000000rrrXXXXX
315 2:CONSTANT
316 ------------------------------
317 reg[rrr] OPERATION= CONSTANT;
318 */
319
320 #define CCL_ExprSelfReg 0x18 /* REG1 OP= REG2:
321 1:00000OPERATION000RRRrrrXXXXX
322 ------------------------------
323 reg[rrr] OPERATION= reg[RRR];
324 */
325
326 /* The following codes execute an arithmetic/logical operation. The
327 form of the operation is like REG_X = REG_Y OP OPERAND2. */
328
329 #define CCL_SetExprConst 0x19 /* REG_X = REG_Y OP constant:
330 1:00000OPERATION000RRRrrrXXXXX
331 2:CONSTANT
332 ------------------------------
333 reg[rrr] = reg[RRR] OPERATION CONSTANT;
334 IC++;
335 */
336
337 #define CCL_SetExprReg 0x1A /* REG1 = REG2 OP REG3:
338 1:00000OPERATIONRrrRRRrrrXXXXX
339 ------------------------------
340 reg[rrr] = reg[RRR] OPERATION reg[Rrr];
341 */
342
343 #define CCL_JumpCondExprConst 0x1B /* Jump conditional according to
344 an operation on constant:
345 1:A--D--D--R--E--S--S-rrrXXXXX
346 2:OPERATION
347 3:CONSTANT
348 -----------------------------
349 reg[7] = reg[rrr] OPERATION CONSTANT;
350 if (!(reg[7]))
351 IC += ADDRESS;
352 else
353 IC += 2
354 */
355
356 #define CCL_JumpCondExprReg 0x1C /* Jump conditional according to
357 an operation on register:
358 1:A--D--D--R--E--S--S-rrrXXXXX
359 2:OPERATION
360 3:RRR
361 -----------------------------
362 reg[7] = reg[rrr] OPERATION reg[RRR];
363 if (!reg[7])
364 IC += ADDRESS;
365 else
366 IC += 2;
367 */
368
369 #define CCL_ReadJumpCondExprConst 0x1D /* Read and jump conditional according
370 to an operation on constant:
371 1:A--D--D--R--E--S--S-rrrXXXXX
372 2:OPERATION
373 3:CONSTANT
374 -----------------------------
375 read (reg[rrr]);
376 reg[7] = reg[rrr] OPERATION CONSTANT;
377 if (!reg[7])
378 IC += ADDRESS;
379 else
380 IC += 2;
381 */
382
383 #define CCL_ReadJumpCondExprReg 0x1E /* Read and jump conditional according
384 to an operation on register:
385 1:A--D--D--R--E--S--S-rrrXXXXX
386 2:OPERATION
387 3:RRR
388 -----------------------------
389 read (reg[rrr]);
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_Extention 0x1F /* Extended CCL code
398 1:ExtendedCOMMNDRrrRRRrrrXXXXX
399 2:ARGUEMENT
400 3:...
401 ------------------------------
402 extended_command (rrr,RRR,Rrr,ARGS)
403 */
404
405
406 /* CCL arithmetic/logical operators. */
407 #define CCL_PLUS 0x00 /* X = Y + Z */
408 #define CCL_MINUS 0x01 /* X = Y - Z */
409 #define CCL_MUL 0x02 /* X = Y * Z */
410 #define CCL_DIV 0x03 /* X = Y / Z */
411 #define CCL_MOD 0x04 /* X = Y % Z */
412 #define CCL_AND 0x05 /* X = Y & Z */
413 #define CCL_OR 0x06 /* X = Y | Z */
414 #define CCL_XOR 0x07 /* X = Y ^ Z */
415 #define CCL_LSH 0x08 /* X = Y << Z */
416 #define CCL_RSH 0x09 /* X = Y >> Z */
417 #define CCL_LSH8 0x0A /* X = (Y << 8) | Z */
418 #define CCL_RSH8 0x0B /* X = Y >> 8, r[7] = Y & 0xFF */
419 #define CCL_DIVMOD 0x0C /* X = Y / Z, r[7] = Y % Z */
420 #define CCL_LS 0x10 /* X = (X < Y) */
421 #define CCL_GT 0x11 /* X = (X > Y) */
422 #define CCL_EQ 0x12 /* X = (X == Y) */
423 #define CCL_LE 0x13 /* X = (X <= Y) */
424 #define CCL_GE 0x14 /* X = (X >= Y) */
425 #define CCL_NE 0x15 /* X = (X != Y) */
426
427 #define CCL_ENCODE_SJIS 0x16 /* X = HIGHER_BYTE (SJIS (Y, Z))
428 r[7] = LOWER_BYTE (SJIS (Y, Z) */
429 #define CCL_DECODE_SJIS 0x17 /* X = HIGHER_BYTE (DE-SJIS (Y, Z))
430 r[7] = LOWER_BYTE (DE-SJIS (Y, Z)) */
431
432 /* Macros for exit status of CCL program. */
433 #define CCL_STAT_SUCCESS 0 /* Terminated successfully. */
434 #define CCL_STAT_SUSPEND 1 /* Terminated because of empty input
435 buffer or full output buffer. */
436 #define CCL_STAT_INVALID_CMD 2 /* Terminated because of invalid
437 command. */
438 #define CCL_STAT_QUIT 3 /* Terminated because of quit. */
439
440 /* Terminate CCL program successfully. */
441 #define CCL_SUCCESS \
442 do { \
443 ccl->status = CCL_STAT_SUCCESS; \
444 ccl->ic = CCL_HEADER_MAIN; \
445 goto ccl_finish; \
446 } while (0)
447
448 /* Suspend CCL program because of reading from empty input buffer or
449 writing to full output buffer. When this program is resumed, the
450 same I/O command is executed. */
451 #define CCL_SUSPEND \
452 do { \
453 ic--; \
454 ccl->status = CCL_STAT_SUSPEND; \
455 goto ccl_finish; \
456 } while (0)
457
458 /* Terminate CCL program because of invalid command. Should not occur
459 in the normal case. */
460 #define CCL_INVALID_CMD \
461 do { \
462 ccl->status = CCL_STAT_INVALID_CMD; \
463 goto ccl_error_handler; \
464 } while (0)
465
466 /* Encode one character CH to multibyte form and write to the current
467 output buffer. If CH is less than 256, CH is written as is. */
468 #define CCL_WRITE_CHAR(ch) \
469 do { \
470 if (!destination) \
471 CCL_INVALID_CMD; \
472 else \
473 { \
474 Bufbyte work[MAX_EMCHAR_LEN]; \
475 int len = set_charptr_emchar (work, ch); \
476 Dynarr_add_many (destination, work, len); \
477 } \
478 } while (0)
479
480 /* Write a string at ccl_prog[IC] of length LEN to the current output
481 buffer. */
482 #define CCL_WRITE_STRING(len) \
483 do { \
484 if (!destination) \
107 CCL_INVALID_CMD; \ 485 CCL_INVALID_CMD; \
108 } \ 486 else \
109 else \ 487 for (i = 0; i < len; i++) \
110 { \ 488 Dynarr_add(destination, (XINT (ccl_prog[ic + (i / 3)]) \
111 /* !!#### is this correct for both directions????? */ \ 489 >> ((2 - (i % 3)) * 8)) & 0xFF); \
112 Bufbyte __buf__[MAX_EMCHAR_LEN]; \ 490 } while (0)
113 int __len__; \ 491
114 __len__ = set_charptr_emchar (__buf__, ch); \ 492 /* Read one byte from the current input buffer into Rth register. */
115 Dynarr_add_many (dst, __buf__, __len__); \ 493 #define CCL_READ_CHAR(r) \
116 } \ 494 do { \
117 } while (0) 495 if (!src) \
118 496 CCL_INVALID_CMD; \
119 #define CCL_WRITE_STRING(len) do \ 497 else if (src < src_end) \
120 { \ 498 r = *src++; \
121 if (!src) \ 499 else if (ccl->last_block) \
122 { \ 500 { \
123 CCL_INVALID_CMD; \ 501 ic = ccl->eof_ic; \
124 } \ 502 goto ccl_finish; \
125 else \ 503 } \
126 { \ 504 else \
127 for (j = 0; j < len; j++) \ 505 CCL_SUSPEND; \
128 Dynarr_add (dst, XINT (prog[ic + 1 + j])); \ 506 } while (0)
129 } \ 507
130 } while (0) 508
131 509 /* Execute CCL code on SRC_BYTES length text at SOURCE. The resulting
132 #define CCL_READ_CHAR(r) do \ 510 text goes to a place pointed by DESTINATION. The bytes actually
133 { \ 511 processed is returned as *CONSUMED. The return value is the length
134 if (!src) \ 512 of the resulting text. As a side effect, the contents of CCL registers
135 { \ 513 are updated. If SOURCE or DESTINATION is NULL, only operations on
136 CCL_INVALID_CMD; \ 514 registers are permitted. */
137 } \ 515
138 else if (s < s_end) \ 516 #ifdef CCL_DEBUG
139 r = *s++; \ 517 #define CCL_DEBUG_BACKTRACE_LEN 256
140 else if (end_flag) \ 518 int ccl_backtrace_table[CCL_BACKTRACE_TABLE];
141 { \ 519 int ccl_backtrace_idx;
142 ic = XINT (prog[CCL_HEADER_EOF]); \ 520 #endif
143 continue; \ 521
144 } \ 522 struct ccl_prog_stack
145 else \ 523 {
146 { \ 524 Lisp_Object *ccl_prog; /* Pointer to an array of CCL code. */
147 CCL_SUSPEND; \ 525 int ic; /* Instruction Counter. */
148 } \ 526 };
149 } while (0)
150
151
152 /* Run a CCL program. The initial state and program are contained in
153 CCL. SRC, if non-zero, specifies a source string (of size N)
154 to read bytes from, and DST, of non-zero, specifies a destination
155 Dynarr to write bytes to. If END_FLAG is set, it means that
156 the end section of the CCL program should be run rather than
157 the normal section.
158
159 For CCL programs that do not involve code conversion (e.g.
160 converting a single character into a font index), all parameters
161 but the first will usually be 0. */
162 527
163 int 528 int
164 ccl_driver (struct ccl_program *ccl, CONST unsigned char *src, 529 ccl_driver (struct ccl_program *ccl, CONST unsigned char *source, unsigned_char_dynarr *destination, int src_bytes, int *consumed)
165 unsigned_char_dynarr *dst, int n, int end_flag)
166 { 530 {
167 int code, op, rrr, cc, i, j;
168 CONST unsigned char *s = NULL, *s_end = NULL;
169 int ic = ccl->ic;
170 int *reg = ccl->reg; 531 int *reg = ccl->reg;
171 Lisp_Object *prog = ccl->prog; 532 int ic = ccl->ic;
172 533 int code, field1, field2;
173 if (!ic) 534 Lisp_Object *ccl_prog = ccl->prog;
535 unsigned char *src = source, *src_end = src + src_bytes;
536 int jump_address;
537 int i, j, op;
538 int stack_idx = 0;
539 /* For the moment, we only support depth 256 of stack. */
540 struct ccl_prog_stack ccl_prog_stack_struct[256];
541
542 if (ic >= ccl->eof_ic)
174 ic = CCL_HEADER_MAIN; 543 ic = CCL_HEADER_MAIN;
175 544
176 if (src) 545 #ifdef CCL_DEBUG
546 ccl_backtrace_idx = 0;
547 #endif
548
549 for (;;)
177 { 550 {
178 s = src; 551 #ifdef CCL_DEBUG
179 s_end = s + n; 552 ccl_backtrace_table[ccl_backtrace_idx++] = ic;
180 } 553 if (ccl_backtrace_idx >= CCL_DEBUG_BACKTRACE_LEN)
181 554 ccl_backtrace_idx = 0;
182 while (1) 555 ccl_backtrace_table[ccl_backtrace_idx] = 0;
183 { 556 #endif
184 code = XINT (prog[ic++]); 557
185 op = code & 0x1F; 558 if (!NILP (Vquit_flag) && NILP (Vinhibit_quit))
186 rrr = (code >> 5) & 0x7;
187 cc = code >> 8;
188
189 switch (op)
190 { 559 {
191 case CCL_SetCS: 560 /* We can't just signal Qquit, instead break the loop as if
192 reg[rrr] = cc; continue; 561 the whole data is processed. Don't reset Vquit_flag, it
193 case CCL_SetCL: 562 must be handled later at a safer place. */
194 reg[rrr] = XINT (prog[ic++]); continue; 563 if (consumed)
195 case CCL_SetR: 564 src = source + src_bytes;
196 reg[rrr] = reg[cc]; continue; 565 ccl->status = CCL_STAT_QUIT;
197 case CCL_SetA: 566 break;
198 cc = reg[cc]; 567 }
199 i = XINT (prog[ic++]); 568
200 if (cc >= 0 && cc < i) 569 code = XINT (ccl_prog[ic]); ic++;
201 reg[rrr] = XINT (prog[ic + cc]); 570 field1 = code >> 8;
202 ic += i; 571 field2 = (code & 0xFF) >> 5;
203 continue; 572
204 case CCL_Jump: 573 #define rrr field2
205 ic = cc; continue; 574 #define RRR (field1 & 7)
206 case CCL_JumpCond: 575 #define Rrr ((field1 >> 3) & 7)
576 #define ADDR field1
577
578 switch (code & 0x1F)
579 {
580 case CCL_SetRegister: /* 00000000000000000RRRrrrXXXXX */
581 reg[rrr] = reg[RRR];
582 break;
583
584 case CCL_SetShortConst: /* CCCCCCCCCCCCCCCCCCCCrrrXXXXX */
585 reg[rrr] = field1;
586 break;
587
588 case CCL_SetConst: /* 00000000000000000000rrrXXXXX */
589 reg[rrr] = XINT (ccl_prog[ic]);
590 ic++;
591 break;
592
593 case CCL_SetArray: /* CCCCCCCCCCCCCCCCCCCCRRRrrrXXXXX */
594 i = reg[RRR];
595 j = field1 >> 3;
596 if ((unsigned int) i < j)
597 reg[rrr] = XINT (ccl_prog[ic + i]);
598 ic += j;
599 break;
600
601 case CCL_Jump: /* A--D--D--R--E--S--S-000XXXXX */
602 ic += ADDR;
603 break;
604
605 case CCL_JumpCond: /* A--D--D--R--E--S--S-rrrXXXXX */
207 if (!reg[rrr]) 606 if (!reg[rrr])
208 ic = cc; 607 ic += ADDR;
209 continue; 608 break;
210 case CCL_WriteJump: 609
211 CCL_WRITE_CHAR (reg[rrr]); 610 case CCL_WriteRegisterJump: /* A--D--D--R--E--S--S-rrrXXXXX */
212 ic = cc; 611 i = reg[rrr];
213 continue; 612 CCL_WRITE_CHAR (i);
214 case CCL_WriteReadJump: 613 ic += ADDR;
215 if (ccl->status != CCL_STAT_SUSPEND) 614 break;
615
616 case CCL_WriteRegisterReadJump: /* A--D--D--R--E--S--S-rrrXXXXX */
617 i = reg[rrr];
618 CCL_WRITE_CHAR (i);
619 ic++;
620 CCL_READ_CHAR (reg[rrr]);
621 ic += ADDR - 1;
622 break;
623
624 case CCL_WriteConstJump: /* A--D--D--R--E--S--S-000XXXXX */
625 i = XINT (ccl_prog[ic]);
626 CCL_WRITE_CHAR (i);
627 ic += ADDR;
628 break;
629
630 case CCL_WriteConstReadJump: /* A--D--D--R--E--S--S-rrrXXXXX */
631 i = XINT (ccl_prog[ic]);
632 CCL_WRITE_CHAR (i);
633 ic++;
634 CCL_READ_CHAR (reg[rrr]);
635 ic += ADDR - 1;
636 break;
637
638 case CCL_WriteStringJump: /* A--D--D--R--E--S--S-000XXXXX */
639 j = XINT (ccl_prog[ic]);
640 ic++;
641 CCL_WRITE_STRING (j);
642 ic += ADDR - 1;
643 break;
644
645 case CCL_WriteArrayReadJump: /* A--D--D--R--E--S--S-rrrXXXXX */
646 i = reg[rrr];
647 j = XINT (ccl_prog[ic]);
648 if ((unsigned int) i < j)
216 { 649 {
217 CCL_WRITE_CHAR (reg[rrr]); 650 i = XINT (ccl_prog[ic + 1 + i]);
651 CCL_WRITE_CHAR (i);
218 } 652 }
653 ic += j + 2;
654 CCL_READ_CHAR (reg[rrr]);
655 ic += ADDR - (j + 2);
656 break;
657
658 case CCL_ReadJump: /* A--D--D--R--E--S--S-rrrYYYYY */
659 CCL_READ_CHAR (reg[rrr]);
660 ic += ADDR;
661 break;
662
663 case CCL_ReadBranch: /* CCCCCCCCCCCCCCCCCCCCrrrXXXXX */
664 CCL_READ_CHAR (reg[rrr]);
665 /* fall through ... */
666 case CCL_Branch: /* CCCCCCCCCCCCCCCCCCCCrrrXXXXX */
667 if ((unsigned int) reg[rrr] < field1)
668 ic += XINT (ccl_prog[ic + reg[rrr]]);
219 else 669 else
220 ccl->status = CCL_STAT_SUCCESS; 670 ic += XINT (ccl_prog[ic + field1]);
221 CCL_READ_CHAR (reg[rrr]); 671 break;
222 ic = cc; 672
223 continue; 673 case CCL_ReadRegister: /* CCCCCCCCCCCCCCCCCCCCrrXXXXX */
224 case CCL_WriteCJump: 674 while (1)
225 CCL_WRITE_CHAR (XINT (prog[ic]));
226 ic = cc;
227 continue;
228 case CCL_WriteCReadJump:
229 if (ccl->status != CCL_STAT_SUSPEND)
230 { 675 {
231 CCL_WRITE_CHAR (XINT (prog[ic])); 676 CCL_READ_CHAR (reg[rrr]);
677 if (!field1) break;
678 code = XINT (ccl_prog[ic]); ic++;
679 field1 = code >> 8;
680 field2 = (code & 0xFF) >> 5;
232 } 681 }
682 break;
683
684 case CCL_WriteExprConst: /* 1:00000OPERATION000RRR000XXXXX */
685 rrr = 7;
686 i = reg[RRR];
687 j = XINT (ccl_prog[ic]);
688 op = field1 >> 6;
689 ic++;
690 goto ccl_set_expr;
691
692 case CCL_WriteRegister: /* CCCCCCCCCCCCCCCCCCCrrrXXXXX */
693 while (1)
694 {
695 i = reg[rrr];
696 CCL_WRITE_CHAR (i);
697 if (!field1) break;
698 code = XINT (ccl_prog[ic]); ic++;
699 field1 = code >> 8;
700 field2 = (code & 0xFF) >> 5;
701 }
702 break;
703
704 case CCL_WriteExprRegister: /* 1:00000OPERATIONRrrRRR000XXXXX */
705 rrr = 7;
706 i = reg[RRR];
707 j = reg[Rrr];
708 op = field1 >> 6;
709 goto ccl_set_expr;
710
711 case CCL_Call: /* CCCCCCCCCCCCCCCCCCCC000XXXXX */
712 {
713 Lisp_Object slot;
714
715 if (stack_idx >= 256
716 || field1 < 0
717 || field1 >= XVECTOR_LENGTH (Vccl_program_table)
718 || (slot = XVECTOR_DATA (Vccl_program_table)[field1],
719 !CONSP (slot))
720 || !VECTORP (XCDR (slot)))
721 {
722 if (stack_idx > 0)
723 {
724 ccl_prog = ccl_prog_stack_struct[0].ccl_prog;
725 ic = ccl_prog_stack_struct[0].ic;
726 }
727 CCL_INVALID_CMD;
728 }
729
730 ccl_prog_stack_struct[stack_idx].ccl_prog = ccl_prog;
731 ccl_prog_stack_struct[stack_idx].ic = ic;
732 stack_idx++;
733 ccl_prog = XVECTOR_DATA (XCDR (slot));
734 ic = CCL_HEADER_MAIN;
735 }
736 break;
737
738 case CCL_WriteConstString: /* CCCCCCCCCCCCCCCCCCCCrrrXXXXX */
739 if (!rrr)
740 CCL_WRITE_CHAR (field1);
233 else 741 else
234 ccl->status = CCL_STAT_SUCCESS;
235 CCL_READ_CHAR (reg[rrr]);
236 ic = cc;
237 continue;
238 case CCL_WriteSJump:
239 i = XINT (prog[ic]);
240 CCL_WRITE_STRING (i);
241 ic = cc;
242 continue;
243 case CCL_WriteSReadJump:
244 if (ccl->status != CCL_STAT_SUSPEND)
245 { 742 {
246 i = XINT (prog[ic]); 743 CCL_WRITE_STRING (field1);
247 CCL_WRITE_STRING (i); 744 ic += (field1 + 2) / 3;
248 } 745 }
249 else 746 break;
250 ccl->status = CCL_STAT_SUCCESS; 747
251 CCL_READ_CHAR (reg[rrr]); 748 case CCL_WriteArray: /* CCCCCCCCCCCCCCCCCCCCrrrXXXXX */
252 ic = cc; 749 i = reg[rrr];
253 continue; 750 if ((unsigned int) i < field1)
254 case CCL_WriteAReadJump:
255 if (ccl->status != CCL_STAT_SUSPEND)
256 { 751 {
257 i = XINT (prog[ic]); 752 j = XINT (ccl_prog[ic + i]);
258 if (reg[rrr] >= 0 && reg[rrr] < i) 753 CCL_WRITE_CHAR (j);
259 CCL_WRITE_CHAR (XINT (prog[ic + 1 + reg[rrr]]));
260 } 754 }
261 else 755 ic += field1;
262 ccl->status = CCL_STAT_SUCCESS; 756 break;
263 CCL_READ_CHAR (reg[rrr]); 757
264 ic = cc; 758 case CCL_End: /* 0000000000000000000000XXXXX */
265 continue; 759 if (stack_idx-- > 0)
266 case CCL_ReadBranch: 760 {
267 CCL_READ_CHAR (reg[rrr]); 761 ccl_prog = ccl_prog_stack_struct[stack_idx].ccl_prog;
268 case CCL_Branch: 762 ic = ccl_prog_stack_struct[stack_idx].ic;
269 ic = XINT (prog[ic + (((unsigned int) reg[rrr] < cc) 763 break;
270 ? reg[rrr] : cc)]); 764 }
271 continue;
272 case CCL_Read1:
273 CCL_READ_CHAR (reg[rrr]);
274 continue;
275 case CCL_Read2:
276 CCL_READ_CHAR (reg[rrr]);
277 CCL_READ_CHAR (reg[cc]);
278 continue;
279 case CCL_Write1:
280 CCL_WRITE_CHAR (reg[rrr]);
281 continue;
282 case CCL_Write2:
283 CCL_WRITE_CHAR (reg[rrr]);
284 CCL_WRITE_CHAR (reg[cc]);
285 continue;
286 case CCL_WriteC:
287 i = XINT (prog[ic++]);
288 CCL_WRITE_CHAR (i);
289 continue;
290 case CCL_WriteS:
291 cc = XINT (prog[ic]);
292 CCL_WRITE_STRING (cc);
293 ic += cc + 1;
294 continue;
295 case CCL_WriteA:
296 i = XINT (prog[ic++]);
297 cc = reg[rrr];
298 if (cc >= 0 && cc < i)
299 CCL_WRITE_CHAR (XINT (prog[ic + cc]));
300 ic += i;
301 continue;
302 case CCL_End:
303 CCL_SUCCESS; 765 CCL_SUCCESS;
304 case CCL_SetSelfCS: 766
305 i = cc; 767 case CCL_ExprSelfConst: /* 00000OPERATION000000rrrXXXXX */
306 op = XINT (prog[ic++]); 768 i = XINT (ccl_prog[ic]);
307 goto ccl_set_self; 769 ic++;
308 case CCL_SetSelfCL: 770 op = field1 >> 6;
309 i = XINT (prog[ic++]); 771 goto ccl_expr_self;
310 op = XINT (prog[ic++]); 772
311 goto ccl_set_self; 773 case CCL_ExprSelfReg: /* 00000OPERATION000RRRrrrXXXXX */
312 case CCL_SetSelfR: 774 i = reg[RRR];
313 i = reg[cc]; 775 op = field1 >> 6;
314 op = XINT (prog[ic++]); 776
315 ccl_set_self: 777 ccl_expr_self:
316 switch (op) 778 switch (op)
317 { 779 {
318 case CCL_PLUS: reg[rrr] += i; break; 780 case CCL_PLUS: reg[rrr] += i; break;
319 case CCL_MINUS: reg[rrr] -= i; break; 781 case CCL_MINUS: reg[rrr] -= i; break;
320 case CCL_MUL: reg[rrr] *= i; break; 782 case CCL_MUL: reg[rrr] *= i; break;
321 case CCL_DIV: reg[rrr] /= i; break; 783 case CCL_DIV: reg[rrr] /= i; break;
322 case CCL_MOD: reg[rrr] %= i; break; 784 case CCL_MOD: reg[rrr] %= i; break;
323 case CCL_AND: reg[rrr] &= i; break; 785 case CCL_AND: reg[rrr] &= i; break;
324 case CCL_OR: reg[rrr] |= i; break; 786 case CCL_OR: reg[rrr] |= i; break;
325 case CCL_XOR: reg[rrr] ^= i; break; 787 case CCL_XOR: reg[rrr] ^= i; break;
326 case CCL_LSH: reg[rrr] <<= i; break; 788 case CCL_LSH: reg[rrr] <<= i; break;
327 case CCL_RSH: reg[rrr] >>= i; break; 789 case CCL_RSH: reg[rrr] >>= i; break;
328 case CCL_LSH8: reg[rrr] <<= 8; reg[rrr] |= i; break; 790 case CCL_LSH8: reg[rrr] <<= 8; reg[rrr] |= i; break;
329 case CCL_RSH8: reg[7] = reg[rrr] & 0xFF; reg[rrr] >>= 8; break; 791 case CCL_RSH8: reg[7] = reg[rrr] & 0xFF; reg[rrr] >>= 8; break;
330 case CCL_DIVMOD: reg[7] = reg[rrr] % i; reg[rrr] /= i; break; 792 case CCL_DIVMOD: reg[7] = reg[rrr] % i; reg[rrr] /= i; break;
331 case CCL_LS: reg[rrr] = reg[rrr] < i; break; 793 case CCL_LS: reg[rrr] = reg[rrr] < i; break;
332 case CCL_GT: reg[rrr] = reg[rrr] > i; break; 794 case CCL_GT: reg[rrr] = reg[rrr] > i; break;
333 case CCL_EQ: reg[rrr] = reg[rrr] == i; break; 795 case CCL_EQ: reg[rrr] = reg[rrr] == i; break;
334 case CCL_LE: reg[rrr] = reg[rrr] <= i; break; 796 case CCL_LE: reg[rrr] = reg[rrr] <= i; break;
335 case CCL_GE: reg[rrr] = reg[rrr] >= i; break; 797 case CCL_GE: reg[rrr] = reg[rrr] >= i; break;
336 case CCL_NE: reg[rrr] = reg[rrr] != i; break; 798 case CCL_NE: reg[rrr] = reg[rrr] != i; break;
337 default: CCL_INVALID_CMD; 799 default: CCL_INVALID_CMD;
338 } 800 }
339 continue; 801 break;
340 case CCL_SetExprCL: 802
341 i = reg[cc]; 803 case CCL_SetExprConst: /* 00000OPERATION000RRRrrrXXXXX */
342 j = XINT (prog[ic++]); 804 i = reg[RRR];
343 op = XINT (prog[ic++]); 805 j = XINT (ccl_prog[ic]);
344 cc = 0; 806 op = field1 >> 6;
807 jump_address = ++ic;
345 goto ccl_set_expr; 808 goto ccl_set_expr;
346 case CCL_SetExprR: 809
347 i = reg[cc]; 810 case CCL_SetExprReg: /* 00000OPERATIONRrrRRRrrrXXXXX */
348 j = reg[XINT (prog[ic++])]; 811 i = reg[RRR];
349 op = XINT (prog[ic++]); 812 j = reg[Rrr];
350 cc = 0; 813 op = field1 >> 6;
814 jump_address = ic;
351 goto ccl_set_expr; 815 goto ccl_set_expr;
352 case CCL_ReadJumpCondC: 816
817 case CCL_ReadJumpCondExprConst: /* A--D--D--R--E--S--S-rrrXXXXX */
353 CCL_READ_CHAR (reg[rrr]); 818 CCL_READ_CHAR (reg[rrr]);
354 case CCL_JumpCondC: 819 case CCL_JumpCondExprConst: /* A--D--D--R--E--S--S-rrrXXXXX */
355 i = reg[rrr]; 820 i = reg[rrr];
356 j = XINT (prog[ic++]); 821 op = XINT (ccl_prog[ic]);
822 jump_address = ic++ + ADDR;
823 j = XINT (ccl_prog[ic]);
824 ic++;
357 rrr = 7; 825 rrr = 7;
358 op = XINT (prog[ic++]);
359 goto ccl_set_expr; 826 goto ccl_set_expr;
360 case CCL_ReadJumpCondR: 827
828 case CCL_ReadJumpCondExprReg: /* A--D--D--R--E--S--S-rrrXXXXX */
361 CCL_READ_CHAR (reg[rrr]); 829 CCL_READ_CHAR (reg[rrr]);
362 case CCL_JumpCondR: 830 case CCL_JumpCondExprReg:
363 i = reg[rrr]; 831 i = reg[rrr];
364 j = reg[XINT (prog[ic++])]; 832 op = XINT (ccl_prog[ic]);
833 jump_address = ic++ + ADDR;
834 j = reg[XINT (ccl_prog[ic])];
835 ic++;
365 rrr = 7; 836 rrr = 7;
366 op = XINT (prog[ic++]); 837
367 ccl_set_expr: 838 ccl_set_expr:
368 switch (op) 839 switch (op)
369 { 840 {
370 case CCL_PLUS: reg[rrr] = i + j; break; 841 case CCL_PLUS: reg[rrr] = i + j; break;
371 case CCL_MINUS: reg[rrr] = i - j; break; 842 case CCL_MINUS: reg[rrr] = i - j; break;
372 case CCL_MUL: reg[rrr] = i * j; break; 843 case CCL_MUL: reg[rrr] = i * j; break;
373 case CCL_DIV: reg[rrr] = i / j; break; 844 case CCL_DIV: reg[rrr] = i / j; break;
374 case CCL_MOD: reg[rrr] = i % j; break; 845 case CCL_MOD: reg[rrr] = i % j; break;
375 case CCL_AND: reg[rrr] = i & j; break; 846 case CCL_AND: reg[rrr] = i & j; break;
376 case CCL_OR: reg[rrr] = i | j; break; 847 case CCL_OR: reg[rrr] = i | j; break;
377 case CCL_XOR: reg[rrr] = i ^ j;; break; 848 case CCL_XOR: reg[rrr] = i ^ j;; break;
378 case CCL_LSH: reg[rrr] = i << j; break; 849 case CCL_LSH: reg[rrr] = i << j; break;
379 case CCL_RSH: reg[rrr] = i >> j; break; 850 case CCL_RSH: reg[rrr] = i >> j; break;
380 case CCL_LSH8: reg[rrr] = (i << 8) | j; break; 851 case CCL_LSH8: reg[rrr] = (i << 8) | j; break;
381 case CCL_RSH8: reg[rrr] = i >> 8; reg[7] = i & 0xFF; break; 852 case CCL_RSH8: reg[rrr] = i >> 8; reg[7] = i & 0xFF; break;
382 case CCL_DIVMOD: reg[rrr] = i / j; reg[7] = i % j; break; 853 case CCL_DIVMOD: reg[rrr] = i / j; reg[7] = i % j; break;
383 case CCL_LS: reg[rrr] = i < j; break; 854 case CCL_LS: reg[rrr] = i < j; break;
384 case CCL_GT: reg[rrr] = i > j; break; 855 case CCL_GT: reg[rrr] = i > j; break;
385 case CCL_EQ: reg[rrr] = i == j; break; 856 case CCL_EQ: reg[rrr] = i == j; break;
386 case CCL_LE: reg[rrr] = i <= j; break; 857 case CCL_LE: reg[rrr] = i <= j; break;
387 case CCL_GE: reg[rrr] = i >= j; break; 858 case CCL_GE: reg[rrr] = i >= j; break;
388 case CCL_NE: reg[rrr] = i != j; break; 859 case CCL_NE: reg[rrr] = i != j; break;
860 case CCL_ENCODE_SJIS: ENCODE_SJIS (i, j, reg[rrr], reg[7]); break;
861 case CCL_DECODE_SJIS: DECODE_SJIS (i, j, reg[rrr], reg[7]); break;
389 default: CCL_INVALID_CMD; 862 default: CCL_INVALID_CMD;
390 } 863 }
391 if (cc && !reg[rrr]) 864 code &= 0x1F;
392 ic = cc; 865 if (code == CCL_WriteExprConst || code == CCL_WriteExprRegister)
393 continue; 866 {
867 i = reg[rrr];
868 CCL_WRITE_CHAR (i);
869 }
870 else if (!reg[rrr])
871 ic = jump_address;
872 break;
873
394 default: 874 default:
395 CCL_INVALID_CMD; 875 CCL_INVALID_CMD;
396 } 876 }
397 } 877 }
398 878
399 ccl_error_handler: 879 ccl_error_handler:
400 if (dst) 880 if (destination)
401 { 881 {
402 char buf[200]; 882 /* We can insert an error message only if DESTINATION is
883 specified and we still have a room to store the message
884 there. */
885 char msg[256];
886
403 switch (ccl->status) 887 switch (ccl->status)
404 { 888 {
405 case CCL_STAT_INVALID_CMD: 889 case CCL_STAT_INVALID_CMD:
406 sprintf (buf, "CCL: Invalid command (%x).\n", op); 890 sprintf(msg, "\nCCL: Invalid command %x (ccl_code = %x) at %d.",
407 break; 891 code & 0x1F, code, ic);
892 #ifdef CCL_DEBUG
893 {
894 int i = ccl_backtrace_idx - 1;
895 int j;
896
897 Dynarr_add_many (destination, (unsigned char *) msg, strlen (msg));
898
899 for (j = 0; j < CCL_DEBUG_BACKTRACE_LEN; j++, i--)
900 {
901 if (i < 0) i = CCL_DEBUG_BACKTRACE_LEN - 1;
902 if (ccl_backtrace_table[i] == 0)
903 break;
904 sprintf(msg, " %d", ccl_backtrace_table[i]);
905 Dynarr_add_many (destination, (unsigned char *) msg, strlen (msg));
906 }
907 }
908 #endif
909 goto ccl_finish;
910
911 case CCL_STAT_QUIT:
912 sprintf(msg, "\nCCL: Quited.");
913 break;
914
408 default: 915 default:
409 sprintf (buf, "CCL: Unknown error type (%d).\n", ccl->status); 916 sprintf(msg, "\nCCL: Unknown error type (%d).", ccl->status);
410 } 917 }
411 Dynarr_add_many (dst, (unsigned char *) buf, strlen (buf)); 918
919 Dynarr_add_many (destination, (unsigned char *) msg, strlen (msg));
412 } 920 }
413 921
414 ccl_finish: 922 ccl_finish:
415 ccl->ic = ic; 923 ccl->ic = ic;
416 if (dst) 924 if (consumed) *consumed = src - source;
417 return Dynarr_length (dst); 925 if (destination)
926 return Dynarr_length (destination);
418 else 927 else
419 return 0; 928 return 0;
420 } 929 }
421 930
422 /* Set up CCL to execute CCL program VAL, with initial register values 931 /* Setup fields of the structure pointed by CCL appropriately for the
423 coming from REGS (NUMREGS of them are specified) and initial 932 execution of compiled CCL code in VEC (vector of integer). */
424 instruction counter coming from INITIAL_IC (a value of 0 means
425 start at the beginning of the program, wherever that is).
426 */
427
428 void 933 void
429 set_ccl_program (struct ccl_program *ccl, Lisp_Object val, int *regs, 934 setup_ccl_program (ccl, vec)
430 int numregs, int initial_ic) 935 struct ccl_program *ccl;
936 Lisp_Object vec;
431 { 937 {
432 int i; 938 int i;
433 939
434 ccl->saved_vector = val; 940 ccl->size = XVECTOR_LENGTH (vec);
435 ccl->prog = XVECTOR_DATA (val); 941 ccl->prog = XVECTOR_DATA (vec);
436 ccl->size = XVECTOR_LENGTH (val); 942 ccl->ic = CCL_HEADER_MAIN;
437 if (initial_ic == 0) 943 ccl->eof_ic = XINT (XVECTOR_DATA (vec)[CCL_HEADER_EOF]);
438 ccl->ic = CCL_HEADER_MAIN; 944 ccl->buf_magnification = XINT (XVECTOR_DATA (vec)[CCL_HEADER_BUF_MAG]);
439 else 945 for (i = 0; i < 8; i++)
440 ccl->ic = initial_ic;
441 for (i = 0; i < numregs; i++)
442 ccl->reg[i] = regs[i];
443 for (; i < 8; i++)
444 ccl->reg[i] = 0; 946 ccl->reg[i] = 0;
445 ccl->end_flag = 0; 947 ccl->last_block = 0;
446 ccl->status = 0; 948 ccl->status = 0;
447 } 949 }
448 950
449 #ifdef emacs 951 #ifdef emacs
450 952
451 static void 953 DEFUN ("ccl-execute", Fccl_execute, 2, 2, 0, /*
452 set_ccl_program_from_lisp_values (struct ccl_program *ccl, 954 Execute CCL-PROGRAM with registers initialized by REGISTERS.
453 Lisp_Object prog, 955 CCL-PROGRAM is a compiled code generated by `ccl-compile',
454 Lisp_Object status) 956 no I/O commands should appear in the CCL program.
957 REGISTERS is a vector of [R0 R1 ... R7] where RN is an initial value
958 of Nth register.
959 As side effect, each element of REGISTER holds the value of
960 corresponding register after the execution.
961 */
962 (ccl_prog, reg))
455 { 963 {
964 struct ccl_program ccl;
456 int i; 965 int i;
457 int intregs[8]; 966
458 int ic; 967 CHECK_VECTOR (ccl_prog);
459 968 CHECK_VECTOR (reg);
460 CHECK_VECTOR (prog); 969 if (XVECTOR_LENGTH (reg) != 8)
970 error ("Invalid length of vector REGISTERS");
971
972 setup_ccl_program (&ccl, ccl_prog);
973 for (i = 0; i < 8; i++)
974 ccl.reg[i] = (INTP (XVECTOR_DATA (reg)[i])
975 ? XINT (XVECTOR_DATA (reg)[i])
976 : 0);
977
978 ccl_driver (&ccl, (CONST unsigned char *)0, (unsigned_char_dynarr *)0,
979 0, (int *)0);
980 QUIT;
981 if (ccl.status != CCL_STAT_SUCCESS)
982 error ("Error in CCL program at %dth code", ccl.ic);
983
984 for (i = 0; i < 8; i++)
985 XSETINT (XVECTOR_DATA (reg)[i], ccl.reg[i]);
986 return Qnil;
987 }
988
989 DEFUN ("ccl-execute-on-string", Fccl_execute_on_string, 3, 4, 0, /*
990 Execute CCL-PROGRAM with initial STATUS on STRING.
991 CCL-PROGRAM is a compiled code generated by `ccl-compile'.
992 Read buffer is set to STRING, and write buffer is allocated automatically.
993 STATUS is a vector of [R0 R1 ... R7 IC], where
994 R0..R7 are initial values of corresponding registers,
995 IC is the instruction counter specifying from where to start the program.
996 If R0..R7 are nil, they are initialized to 0.
997 If IC is nil, it is initialized to head of the CCL program.
998 Returns the contents of write buffer as a string,
999 and as side effect, STATUS is updated.
1000 If optional 4th arg CONTINUE is non-nil, keep IC on read operation
1001 when read buffer is exausted, else, IC is always set to the end of
1002 CCL-PROGRAM on exit.
1003 */
1004 (ccl_prog, status, str, contin))
1005 {
1006 Lisp_Object val;
1007 struct ccl_program ccl;
1008 int i, produced;
1009 unsigned_char_dynarr *outbuf;
1010 struct gcpro gcpro1, gcpro2, gcpro3;
1011
1012 CHECK_VECTOR (ccl_prog);
461 CHECK_VECTOR (status); 1013 CHECK_VECTOR (status);
462
463 if (XVECTOR_LENGTH (status) != 9) 1014 if (XVECTOR_LENGTH (status) != 9)
464 signal_simple_error ("Must specify values for the eight registers and IC", 1015 error ("Invalid length of vector STATUS");
465 status); 1016 CHECK_STRING (str);
1017 GCPRO3 (ccl_prog, status, str);
1018
1019 setup_ccl_program (&ccl, ccl_prog);
466 for (i = 0; i < 8; i++) 1020 for (i = 0; i < 8; i++)
467 { 1021 {
468 Lisp_Object regval = XVECTOR_DATA (status)[i]; 1022 if (NILP (XVECTOR_DATA (status)[i]))
469 if (NILP (regval)) 1023 XSETINT (XVECTOR_DATA (status)[i], 0);
470 intregs[i] = 0; 1024 if (INTP (XVECTOR_DATA (status)[i]))
471 else 1025 ccl.reg[i] = XINT (XVECTOR_DATA (status)[i]);
1026 }
1027 if (INTP (XVECTOR_DATA (status)[8]))
1028 {
1029 i = XINT (XVECTOR_DATA (status)[8]);
1030 if (ccl.ic < i && i < ccl.size)
1031 ccl.ic = i;
1032 }
1033 outbuf = Dynarr_new (unsigned_char);
1034 ccl.last_block = NILP (contin);
1035 produced = ccl_driver (&ccl, XSTRING_DATA (str), outbuf,
1036 XSTRING_LENGTH (str), (int *)0);
1037 for (i = 0; i < 8; i++)
1038 XVECTOR_DATA (status)[i] = make_int(ccl.reg[i]);
1039 XSETINT (XVECTOR_DATA (status)[8], ccl.ic);
1040 UNGCPRO;
1041
1042 val = make_string (Dynarr_atp (outbuf, 0), produced);
1043 free (outbuf);
1044 QUIT;
1045 if (ccl.status != CCL_STAT_SUCCESS
1046 && ccl.status != CCL_STAT_SUSPEND)
1047 error ("Error in CCL program at %dth code", ccl.ic);
1048
1049 return val;
1050 }
1051
1052 DEFUN ("register-ccl-program", Fregister_ccl_program, 2, 2, 0, /*
1053 Register CCL program PROGRAM of NAME in `ccl-program-table'.
1054 PROGRAM should be a compiled code of CCL program, or nil.
1055 Return index number of the registered CCL program.
1056 */
1057 (name, ccl_prog))
1058 {
1059 int len = XVECTOR_LENGTH (Vccl_program_table);
1060 int i;
1061
1062 CHECK_SYMBOL (name);
1063 if (!NILP (ccl_prog))
1064 CHECK_VECTOR (ccl_prog);
1065
1066 for (i = 0; i < len; i++)
1067 {
1068 Lisp_Object slot = XVECTOR_DATA (Vccl_program_table)[i];
1069
1070 if (!CONSP (slot))
1071 break;
1072
1073 if (EQ (name, XCAR (slot)))
472 { 1074 {
473 CHECK_INT (regval); 1075 XCDR (slot) = ccl_prog;
474 intregs[i] = XINT (regval); 1076 return make_int (i);
475 } 1077 }
476 } 1078 }
477 1079
478 { 1080 if (i == len)
479 Lisp_Object lic = XVECTOR_DATA (status)[8]; 1081 {
480 if (NILP (lic)) 1082 Lisp_Object new_table = Fmake_vector (make_int (len * 2), Qnil);
481 ic = 0; 1083 int j;
482 else 1084
483 { 1085 for (j = 0; j < len; j++)
484 CHECK_NATNUM (lic); 1086 XVECTOR_DATA (new_table)[j]
485 ic = XINT (lic); 1087 = XVECTOR_DATA (Vccl_program_table)[j];
486 } 1088 Vccl_program_table = new_table;
487 } 1089 }
488 1090
489 set_ccl_program (ccl, prog, intregs, 8, ic); 1091 XVECTOR_DATA (Vccl_program_table)[i] = Fcons (name, ccl_prog);
490 } 1092 return make_int (i);
491
492 static void
493 set_lisp_status_from_ccl_program (Lisp_Object status,
494 struct ccl_program *ccl)
495 {
496 int i;
497
498 for (i = 0; i < 8; i++)
499 XVECTOR_DATA (status)[i] = make_int (ccl->reg[i]);
500 XVECTOR_DATA (status)[8] = make_int (ccl->ic);
501 }
502
503
504 DEFUN ("execute-ccl-program", Fexecute_ccl_program, 2, 2, 0, /*
505 Execute CCL-PROGRAM with registers initialized by STATUS.
506 CCL-PROGRAM is a vector of compiled CCL code created by `ccl-compile'.
507 STATUS must be a vector of nine values, specifying the initial value
508 for the R0, R1 .. R7 registers and for the instruction counter IC.
509 A nil value for a register initializer causes the register to be set
510 to 0. A nil value for the IC initializer causes execution to start
511 at the beginning of the program.
512 When the program is done, STATUS is modified (by side-effect) to contain
513 the ending values for the corresponding registers and IC.
514 */
515 (ccl_program, status))
516 {
517 struct ccl_program ccl;
518
519 set_ccl_program_from_lisp_values (&ccl, ccl_program, status);
520 ccl_driver (&ccl, 0, 0, 0, 0);
521 set_lisp_status_from_ccl_program (status, &ccl);
522 return Qnil;
523 }
524
525 DEFUN ("execute-ccl-program-string", Fexecute_ccl_program_string, 3, 3, 0, /*
526 Execute CCL-PROGRAM with initial STATUS on STRING.
527 CCL-PROGRAM is a vector of compiled CCL code created by `ccl-compile'.
528 STATUS must be a vector of nine values, specifying the initial value
529 for the R0, R1 .. R7 registers and for the instruction counter IC.
530 A nil value for a register initializer causes the register to be set
531 to 0. A nil value for the IC initializer causes execution to start
532 at the beginning of the program.
533 When the program is done, STATUS is modified (by side-effect) to contain
534 the ending values for the corresponding registers and IC.
535 Returns the resulting string.
536 */
537 (ccl_program, status, str))
538 {
539 struct ccl_program ccl;
540 Lisp_Object val;
541 int len;
542 unsigned_char_dynarr *outbuf;
543
544 set_ccl_program_from_lisp_values (&ccl, ccl_program, status);
545 CHECK_STRING (str);
546
547 outbuf = Dynarr_new (unsigned_char);
548 len = ccl_driver (&ccl, XSTRING_DATA (str), outbuf, XSTRING_LENGTH (str), 0);
549 ccl_driver (&ccl, (unsigned char *) "", outbuf, 0, 1);
550 set_lisp_status_from_ccl_program (status, &ccl);
551
552 val = make_string (Dynarr_atp (outbuf, 0), len);
553 Dynarr_free (outbuf);
554 return val;
555 }
556
557 DEFUN ("ccl-reset-elapsed-time", Fccl_reset_elapsed_time, 0, 0, 0, /*
558 Reset the internal value which holds the time elapsed by CCL interpreter.
559 */
560 ())
561 {
562 error ("Not yet implemented; use `current-process-time'");
563 return Qnil;
564 }
565
566 DEFUN ("ccl-elapsed-time", Fccl_elapsed_time, 0, 0, 0, /*
567 Return the time elapsed by CCL interpreter as cons of user and system time.
568 This measures processor time, not real time. Both values are floating point
569 numbers measured in seconds. If only one overall value can be determined,
570 the return value will be a cons of that value and 0.
571 */
572 ())
573 {
574 error ("Not yet implemented; use `current-process-time'");
575 return Qnil;
576 } 1093 }
577 1094
578 void 1095 void
579 syms_of_mule_ccl (void) 1096 syms_of_mule_ccl (void)
580 { 1097 {
581 DEFSUBR (Fexecute_ccl_program); 1098 staticpro (&Vccl_program_table);
582 DEFSUBR (Fexecute_ccl_program_string); 1099 Vccl_program_table = Fmake_vector (make_int (32), Qnil);
583 DEFSUBR (Fccl_reset_elapsed_time); 1100
584 DEFSUBR (Fccl_elapsed_time); 1101 DEFVAR_LISP ("font-ccl-encoder-alist", &Vfont_ccl_encoder_alist /*
1102 Alist of fontname patterns vs corresponding CCL program.
1103 Each element looks like (REGEXP . CCL-CODE),
1104 where CCL-CODE is a compiled CCL program.
1105 When a font whose name matches REGEXP is used for displaying a character,
1106 CCL-CODE is executed to calculate the code point in the font
1107 from the charset number and position code(s) of the character which are set
1108 in CCL registers R0, R1, and R2 before the execution.
1109 The code point in the font is set in CCL registers R1 and R2
1110 when the execution terminated.
1111 If the font is single-byte font, the register R2 is not used.
1112 */ );
1113 Vfont_ccl_encoder_alist = Qnil;
1114
1115 DEFSUBR (Fccl_execute);
1116 DEFSUBR (Fccl_execute_on_string);
1117 DEFSUBR (Fregister_ccl_program);
585 } 1118 }
586 1119
587 #else /* not emacs */ 1120 #endif /* emacs */
588 #ifdef standalone
589
590 #define INBUF_SIZE 1024
591 #define MAX_CCL_CODE_SIZE 4096
592
593 void
594 main (int argc, char **argv)
595 {
596 FILE *progf;
597 char inbuf[INBUF_SIZE];
598 unsigned_char_dynarr *outbuf;
599 struct ccl_program ccl;
600 int i;
601 Lisp_Object ccl_prog = make_vector (MAX_CCL_CODE_SIZE);
602
603 if (argc < 2)
604 {
605 fprintf (stderr,
606 "Usage: %s ccl_program_file_name <infile >outfile\n",
607 argv[0]);
608 exit (1);
609 }
610
611 if ((progf = fopen (argv[1], "r")) == NULL)
612 {
613 fprintf (stderr, "%s: Can't read file %s", argv[0], argv[1]);
614 exit (1);
615 }
616
617 XVECTOR_LENGTH (ccl_prog) = 0;
618 while (fscanf (progf, "%x", &i) == 1)
619 XVECTOR_DATA (ccl_prog)[XVECTOR_LENGTH (ccl_prog)++] = make_int (i);
620 set_ccl_program (&ccl, ccl_prog, 0, 0, 0);
621
622 outbuf = Dynarr_new (unsigned char);
623
624 while ((i = fread (inbuf, 1, INBUF_SIZE, stdin)) == INBUF_SIZE)
625 {
626 i = ccl_driver (&ccl, inbuf, outbuf, INBUF_SIZE, 0);
627 fwrite (Dynarr_atp (outbuf, 0), 1, i, stdout);
628 }
629 if (i)
630 {
631 i = ccl_driver (&ccl, inbuf, outbuf, i, 1);
632 fwrite (Dynarr_atp (outbuf, 0), 1, i, stdout);
633 }
634
635 fclose (progf);
636 exit (0);
637 }
638 #endif /* standalone */
639 #endif /* not emacs */