Mercurial > hg > xemacs-beta

comparison src/mule-ccl.c @ 70:131b0175ea99 r20-0b30

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r20-0b30
author cvs
date Mon, 13 Aug 2007 09:02:59 +0200
parents
children 538048ae2ab8
comparison
equal deleted inserted replaced
69:804d1389bcd6 70:131b0175ea99
1 /* CCL -- Code Conversion Language Interpreter
2 Copyright (C) 1992, 1995 Free Software Foundation, Inc.
3 Copyright (C) 1995 Sun Microsystems, Inc.
4
5 This file is part of XEmacs.
6
7 XEmacs is free software; you can redistribute it and/or modify it
8 under the terms of the GNU General Public License as published by the
9 Free Software Foundation; either version 2, or (at your option) any
10 later version.
11
12 XEmacs is distributed in the hope that it will be useful, but WITHOUT
13 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
14 FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
15 for more details.
16
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
19 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
20 Boston, MA 02111-1307, USA. */
21
22 /* Synched up with: Mule 2.3. Not in FSF. */
23
24 #include <config.h>
25 #include "lisp.h"
26
27 #include "buffer.h"
28 #include "mule-coding.h"
29
30 /* CCL operators */
31 #define CCL_SetCS 0x00
32 #define CCL_SetCL 0x01
33 #define CCL_SetR 0x02
34 #define CCL_SetA 0x03
35 #define CCL_Jump 0x04
36 #define CCL_JumpCond 0x05
37 #define CCL_WriteJump 0x06
38 #define CCL_WriteReadJump 0x07
39 #define CCL_WriteCJump 0x08
40 #define CCL_WriteCReadJump 0x09
41 #define CCL_WriteSJump 0x0A
42 #define CCL_WriteSReadJump 0x0B
43 #define CCL_WriteAReadJump 0x0C
44 #define CCL_Branch 0x0D
45 #define CCL_Read1 0x0E
46 #define CCL_Read2 0x0F
47 #define CCL_ReadBranch 0x10
48 #define CCL_Write1 0x11
49 #define CCL_Write2 0x12
50 #define CCL_WriteC 0x13
51 #define CCL_WriteS 0x14
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
84 /* Header of CCL compiled code */
85 #define CCL_HEADER_EOF 0
86 #define CCL_HEADER_MAIN 1
87
88 #define CCL_STAT_SUCCESS 0
89 #define CCL_STAT_SUSPEND 1
90 #define CCL_STAT_INVALID_CMD 2
91
92 #define CCL_SUCCESS \
93 ccl->status = CCL_STAT_SUCCESS; \
94 goto ccl_finish
95 #define CCL_SUSPEND \
96 ccl->ic = --ic; \
97 ccl->status = CCL_STAT_SUSPEND; \
98 goto ccl_finish
99 #define CCL_INVALID_CMD \
100 ccl->status = CCL_STAT_INVALID_CMD; \
101 goto ccl_error_handler
102
103 #define CCL_WRITE_CHAR(ch) do \
104 { \
105 if (!src) \
106 { \
107 CCL_INVALID_CMD; \
108 } \
109 else \
110 { \
111 /* !!#### is this correct for both directions????? */ \
112 Bufbyte __buf__[MAX_EMCHAR_LEN]; \
113 int __len__; \
114 __len__ = set_charptr_emchar (__buf__, ch); \
115 Dynarr_add_many (dst, __buf__, __len__); \
116 } \
117 } while (0)
118
119 #define CCL_WRITE_STRING(len) do \
120 { \
121 if (!src) \
122 { \
123 CCL_INVALID_CMD; \
124 } \
125 else \
126 { \
127 for (j = 0; j < len; j++) \
128 Dynarr_add (dst, XINT (prog[ic + 1 + j])); \
129 } \
130 } while (0)
131
132 #define CCL_READ_CHAR(r) do \
133 { \
134 if (!src) \
135 { \
136 CCL_INVALID_CMD; \
137 } \
138 else if (s < s_end) \
139 r = *s++; \
140 else if (end_flag) \
141 { \
142 ic = XINT (prog[CCL_HEADER_EOF]); \
143 continue; \
144 } \
145 else \
146 { \
147 CCL_SUSPEND; \
148 } \
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
163 int
164 ccl_driver (struct ccl_program *ccl, CONST unsigned char *src,
165 unsigned_char_dynarr *dst, int n, int end_flag)
166 {
167 int code, op, rrr, cc, i, j;
168 CONST unsigned char *s, *s_end;
169 int ic = ccl->ic;
170 int *reg = ccl->reg;
171 Lisp_Object *prog = ccl->prog;
172
173 if (!ic)
174 ic = CCL_HEADER_MAIN;
175
176 if (src)
177 {
178 s = src;
179 s_end = s + n;
180 }
181
182 while (1)
183 {
184 code = XINT (prog[ic++]);
185 op = code & 0x1F;
186 rrr = (code >> 5) & 0x7;
187 cc = code >> 8;
188
189 switch (op)
190 {
191 case CCL_SetCS:
192 reg[rrr] = cc; continue;
193 case CCL_SetCL:
194 reg[rrr] = XINT (prog[ic++]); continue;
195 case CCL_SetR:
196 reg[rrr] = reg[cc]; continue;
197 case CCL_SetA:
198 cc = reg[cc];
199 i = XINT (prog[ic++]);
200 if (cc >= 0 && cc < i)
201 reg[rrr] = XINT (prog[ic + cc]);
202 ic += i;
203 continue;
204 case CCL_Jump:
205 ic = cc; continue;
206 case CCL_JumpCond:
207 if (!reg[rrr])
208 ic = cc;
209 continue;
210 case CCL_WriteJump:
211 CCL_WRITE_CHAR (reg[rrr]);
212 ic = cc;
213 continue;
214 case CCL_WriteReadJump:
215 if (ccl->status != CCL_STAT_SUSPEND)
216 {
217 CCL_WRITE_CHAR (reg[rrr]);
218 }
219 else
220 ccl->status = CCL_STAT_SUCCESS;
221 CCL_READ_CHAR (reg[rrr]);
222 ic = cc;
223 continue;
224 case CCL_WriteCJump:
225 CCL_WRITE_CHAR (XINT (prog[ic]));
226 ic = cc;
227 continue;
228 case CCL_WriteCReadJump:
229 if (ccl->status != CCL_STAT_SUSPEND)
230 {
231 CCL_WRITE_CHAR (XINT (prog[ic]));
232 }
233 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 {
246 i = XINT (prog[ic]);
247 CCL_WRITE_STRING (i);
248 }
249 else
250 ccl->status = CCL_STAT_SUCCESS;
251 CCL_READ_CHAR (reg[rrr]);
252 ic = cc;
253 continue;
254 case CCL_WriteAReadJump:
255 if (ccl->status != CCL_STAT_SUSPEND)
256 {
257 i = XINT (prog[ic]);
258 if (reg[rrr] >= 0 && reg[rrr] < i)
259 CCL_WRITE_CHAR (XINT (prog[ic + 1 + reg[rrr]]));
260 }
261 else
262 ccl->status = CCL_STAT_SUCCESS;
263 CCL_READ_CHAR (reg[rrr]);
264 ic = cc;
265 continue;
266 case CCL_ReadBranch:
267 CCL_READ_CHAR (reg[rrr]);
268 case CCL_Branch:
269 ic = XINT (prog[ic + (((unsigned int) reg[rrr] < cc)
270 ? reg[rrr] : cc)]);
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;
304 case CCL_SetSelfCS:
305 i = cc;
306 op = XINT (prog[ic++]);
307 goto ccl_set_self;
308 case CCL_SetSelfCL:
309 i = XINT (prog[ic++]);
310 op = XINT (prog[ic++]);
311 goto ccl_set_self;
312 case CCL_SetSelfR:
313 i = reg[cc];
314 op = XINT (prog[ic++]);
315 ccl_set_self:
316 switch (op)
317 {
318 case CCL_PLUS: reg[rrr] += i; break;
319 case CCL_MINUS: reg[rrr] -= i; break;
320 case CCL_MUL: reg[rrr] *= i; break;
321 case CCL_DIV: reg[rrr] /= i; break;
322 case CCL_MOD: reg[rrr] %= i; break;
323 case CCL_AND: reg[rrr] &= i; break;
324 case CCL_OR: reg[rrr] |= i; break;
325 case CCL_XOR: reg[rrr] ^= i; break;
326 case CCL_LSH: reg[rrr] <<= i; break;
327 case CCL_RSH: reg[rrr] >>= i; break;
328 case CCL_LSH8: reg[rrr] <<= 8; reg[rrr] |= i; break;
329 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;
331 case CCL_LS: reg[rrr] = reg[rrr] < i; break;
332 case CCL_GT: reg[rrr] = reg[rrr] > i; break;
333 case CCL_EQ: reg[rrr] = reg[rrr] == i; break;
334 case CCL_LE: reg[rrr] = reg[rrr] <= i; break;
335 case CCL_GE: reg[rrr] = reg[rrr] >= i; break;
336 case CCL_NE: reg[rrr] = reg[rrr] != i; break;
337 default: CCL_INVALID_CMD;
338 }
339 continue;
340 case CCL_SetExprCL:
341 i = reg[cc];
342 j = XINT (prog[ic++]);
343 op = XINT (prog[ic++]);
344 cc = 0;
345 goto ccl_set_expr;
346 case CCL_SetExprR:
347 i = reg[cc];
348 j = reg[XINT (prog[ic++])];
349 op = XINT (prog[ic++]);
350 cc = 0;
351 goto ccl_set_expr;
352 case CCL_ReadJumpCondC:
353 CCL_READ_CHAR (reg[rrr]);
354 case CCL_JumpCondC:
355 i = reg[rrr];
356 j = XINT (prog[ic++]);
357 rrr = 7;
358 op = XINT (prog[ic++]);
359 goto ccl_set_expr;
360 case CCL_ReadJumpCondR:
361 CCL_READ_CHAR (reg[rrr]);
362 case CCL_JumpCondR:
363 i = reg[rrr];
364 j = reg[XINT (prog[ic++])];
365 rrr = 7;
366 op = XINT (prog[ic++]);
367 ccl_set_expr:
368 switch (op)
369 {
370 case CCL_PLUS: reg[rrr] = i + j; break;
371 case CCL_MINUS: reg[rrr] = i - j; break;
372 case CCL_MUL: reg[rrr] = i * j; break;
373 case CCL_DIV: reg[rrr] = i / j; break;
374 case CCL_MOD: reg[rrr] = i % j; break;
375 case CCL_AND: reg[rrr] = i & j; break;
376 case CCL_OR: reg[rrr] = i | j; break;
377 case CCL_XOR: reg[rrr] = i ^ j;; break;
378 case CCL_LSH: reg[rrr] = i << j; break;
379 case CCL_RSH: reg[rrr] = i >> j; break;
380 case CCL_LSH8: reg[rrr] = (i << 8) | j; break;
381 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;
383 case CCL_LS: reg[rrr] = i < j; break;
384 case CCL_GT: reg[rrr] = i > j; break;
385 case CCL_EQ: reg[rrr] = i == j; break;
386 case CCL_LE: reg[rrr] = i <= j; break;
387 case CCL_GE: reg[rrr] = i >= j; break;
388 case CCL_NE: reg[rrr] = i != j; break;
389 default: CCL_INVALID_CMD;
390 }
391 if (cc && !reg[rrr])
392 ic = cc;
393 continue;
394 default:
395 CCL_INVALID_CMD;
396 }
397 }
398
399 ccl_error_handler:
400 if (dst)
401 {
402 char buf[200];
403 switch (ccl->status)
404 {
405 case CCL_STAT_INVALID_CMD:
406 sprintf (buf, "CCL: Invalid command (%x).\n", op);
407 break;
408 default:
409 sprintf (buf, "CCL: Unknown error type (%d).\n", ccl->status);
410 }
411 Dynarr_add_many (dst, (unsigned char *) buf, strlen (buf));
412 }
413
414 ccl_finish:
415 ccl->ic = ic;
416 if (dst)
417 return Dynarr_length (dst);
418 else
419 return 0;
420 }
421
422 /* Set up CCL to execute CCL program VAL, with initial register values
423 coming from REGS (NUMREGS of them are specified) and initial
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
429 set_ccl_program (struct ccl_program *ccl, Lisp_Object val, int *regs,
430 int numregs, int initial_ic)
431 {
432 int i;
433
434 ccl->saved_vector = val;
435 ccl->prog = XVECTOR (val)->contents;
436 ccl->size = XVECTOR (val)->size;
437 if (initial_ic == 0)
438 ccl->ic = CCL_HEADER_MAIN;
439 else
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;
445 ccl->end_flag = 0;
446 ccl->status = 0;
447 }
448
449 #ifdef emacs
450
451 static void
452 set_ccl_program_from_lisp_values (struct ccl_program *ccl,
453 Lisp_Object prog,
454 Lisp_Object status)
455 {
456 int i;
457 int intregs[8];
458 int ic;
459
460 CHECK_VECTOR (prog);
461 CHECK_VECTOR (status);
462
463 if (vector_length (XVECTOR (status)) != 9)
464 signal_simple_error ("Must specify values for the eight registers and IC",
465 status);
466 for (i = 0; i < 8; i++)
467 {
468 Lisp_Object regval = XVECTOR (status)->contents[i];
469 if (NILP (regval))
470 intregs[i] = 0;
471 else
472 {
473 CHECK_INT (regval);
474 intregs[i] = XINT (regval);
475 }
476 }
477
478 {
479 Lisp_Object lic = XVECTOR (status)->contents[8];
480 if (NILP (lic))
481 ic = 0;
482 else
483 {
484 CHECK_NATNUM (lic);
485 ic = XINT (lic);
486 }
487 }
488
489 set_ccl_program (ccl, prog, intregs, 8, ic);
490 }
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 (status)->contents[i] = make_int (ccl->reg[i]);
500 XVECTOR (status)->contents[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 }
577
578 void
579 syms_of_mule_ccl (void)
580 {
581 DEFSUBR (Fexecute_ccl_program);
582 DEFSUBR (Fexecute_ccl_program_string);
583 DEFSUBR (Fccl_reset_elapsed_time);
584 DEFSUBR (Fccl_elapsed_time);
585 }
586
587 #else /* not emacs */
588 #ifdef standalone
589
590 #include <alloca.h>
591
592 #define INBUF_SIZE 1024
593 #define MAX_CCL_CODE_SIZE 4096
594
595 void
596 main (int argc, char **argv)
597 {
598 FILE *progf;
599 char inbuf[INBUF_SIZE];
600 unsigned_char_dynarr *outbuf;
601 struct ccl_program ccl;
602 int i;
603 Lisp_Object ccl_prog = make_vector (MAX_CCL_CODE_SIZE);
604
605 if (argc < 2)
606 {
607 fprintf (stderr,
608 "Usage: %s ccl_program_file_name <infile >outfile\n",
609 argv[0]);
610 exit (1);
611 }
612
613 if ((progf = fopen (argv[1], "r")) == NULL)
614 {
615 fprintf (stderr, "%s: Can't read file %s", argv[0], argv[1]);
616 exit (1);
617 }
618
619 XVECTOR (ccl_prog)->size = 0;
620 while (fscanf (progf, "%x", &i) == 1)
621 XVECTOR (ccl_prog)->contents[XVECTOR (ccl_prog)->size++] = make_int (i);
622 set_ccl_program (&ccl, ccl_prog, 0, 0, 0);
623
624 outbuf = Dynarr_new (unsigned char);
625
626 while ((i = fread (inbuf, 1, INBUF_SIZE, stdin)) == INBUF_SIZE)
627 {
628 i = ccl_driver (&ccl, inbuf, outbuf, INBUF_SIZE, 0);
629 fwrite (Dynarr_atp (outbuf, 0), 1, i, stdout);
630 }
631 if (i)
632 {
633 i = ccl_driver (&ccl, inbuf, outbuf, i, 1);
634 fwrite (Dynarr_atp (outbuf, 0), 1, i, stdout);
635 }
636
637 fclose (progf);
638 exit (0);
639 }
640 #endif /* standalone */
641 #endif /* not emacs */